R/act24_preferences.R

In PAHPLabResearch/FLASH: FLASH: Free Living Activity Study for Health

#' @rdname assign_primary_activities
#' @param iMatches subset of \code{\link{get_activity_info}} output consisting
#'   of a listing of incomplete matchings that have been converted to character
#' @keywords internal
get_s.prefs <- function(apps, iMatches) {

  mapply(
    function(x, y) {
      x[x %in% apps$colleges] %>% # Restrict to valid primary activities
      sample(., length(.)) %>% # Randomize preference
      .[seq_len(apps$n_colleges)] %>% # Pad NA's
      matrix(apps$n_colleges, 1, dimnames = list(NULL, y)) # Format
    },
    x = iMatches,
    y = apps$students,
    SIMPLIFY = FALSE
  ) %>%
  do.call(cbind, .)

}

#' @rdname assign_primary_activities
#' @keywords internal
get_c.prefs <- function(apps, iMatches, bkgd) {

  lapply(
    apps$colleges,
    function(x,y) {                   # For each college:

      sapply(y, function(z) x %in% z) %>% # 1. Find indices for
      which(.) %T>%             # corresponding unlabeled times;
      {stopifnot( # 2. verify there's at least one such index;
        length(.) > 0
      )} %>%
      apps$students[.] %>% # 3. Pull out timestamp for each index;
      {.[order( # 4. Determine preference via bkgd;
        match(., bkgd$student)
      )]} %>%
      .[seq_len(apps$n_students)] %>% # 5. Pad NA's;
      matrix( # 6. Format the preferences for that college
        apps$n_students, 1, dimnames = list(NULL, x)
      )

    },
    y = iMatches
  ) %>%
  do.call(cbind, .)

}

#' @rdname assign_primary_activities
#' @param apps application information obtained from
#'   \code{\link{get_applications}}
#' @keywords internal
get_preferences <- function(apps, info, bkgd) {

  iMatches <-
    info$incomplete %>%
    info$matches[.] %>%
    lapply(as.character)

  apps %>%
  c(
    list(s.prefs = get_s.prefs(apps, iMatches)),
    list(c.prefs = get_c.prefs(apps, iMatches, bkgd))
  )

}