R/list_scales.R

Defines functions list_scales

Documented in list_scales

#' List scales
#'
#' @param data The target data frame
#' @param labels If TRUE, scale labels instead of abreviations are shown.
#' @param n_items If TRUE, number of items for each scale, subscale, and sub_subscale is shown
#' @param char_na Charcter for NA is.
#'
#' @return A data.frame with scales on different levels
#' @export
list_scales <- function(data, levels = c("scale", "subscale", "subscale_2"), labels = FALSE, n_items = FALSE, char_na = "") {

  if (labels) levels <- c(levels, paste0(levels, "_label"))
  filter <- .get_dic_items(data)
  out <- select(data, filter)
  out <- sapply(out, function(x)
    cbind(sapply(levels, function(y) dic_attr(x, .opt[[y]])))
  )
  out <- as.matrix(out)
  if (length(levels) > 1) out <- t(out)
  out <- as.data.frame(out)
  names(out) <- levels

  if (n_items) {
    n_scale <- list()
    for (i in 1:length(levels)) {
      n_scale[[i]] <- out %>%
        select(levels[i]) %>%
        table() %>%
        as.data.frame()
    }

    for (i in 1:length(levels)) {
      if (nrow(n_scale[[i]]) > 0) {
        by <- "."
        names(by) <- levels[i]
        rn <- "Freq"
        names(rn) <- paste0("n ", levels[i])
        out <- out %>%
          full_join(n_scale[[i]], by = by) %>%
          rename(!!!rn)
      }
    }
  }

  out <- out %>%
    unique() %>%
    as_tibble()

  out <- out[, colSums(is.na(out)) != nrow(out)]
  out[] <- lapply(out, as.character)
  out[is.na(out)] <- char_na

  out <- out[order(out[[1]]),]

  out
}
jazznbass/scaledic documentation built on Sept. 20, 2021, 7:43 p.m.