R/detabulate.R

In jmbarbone/qpm: Quantitative Psychological Methods

#' Detabulate
#'
#' Takes a data.frame which consists of tabulated values
#'
#' @param x A data.frame of tabulated values.
#' @param names An optional character vector to specify the names
#'
#' @export

detabulate <- function(x, names = NULL, count = NULL) {
  x <- t(x)
  colnames(x) <- if_null(colnames(x), seq_len(ncol(x)))
  df <- expand.grid(rows = try_numeric(rownames(x)),
                    columns = try_numeric(colnames(x)),
                    stringsAsFactors = FALSE)
  counts <- if_null(count, as.vector(x))
  df <- cbind(df, counts)
  res <- as.data.frame(mapply(rep, df[2:1], df[3]), stringsAsFactors = FALSE)
  if(!is.null(names)) names(res) <- names
  res
}

#' Expand tab
#'
#' Takes a data.frame and expands it's value by a specific.
#' If the column name is passed to `count` the column will be removed from the output.
#'
#' @param x A data.frame to duplicate rows
#' @param count Either a vector of counts the same length as the original data.frame,
#'   a single value to apply to all columns,
#'   or the character name of the column that contains the count.
#'
#' @rdname detabulate
#'
#' @export
#'
#' @examples
#' # nonsensical examples
#' expand_tab(airquality, "Month") %>% head()
#' expand_tab(airquality, airquality[5])
#' expand_tab(airquality, 10)
#' expand_tab(airquality, airquality$Month)

expand_tab <- function(x, count) {
  UseMethod("expand_tab", count)
}

#' @export
expand_tab.default <- function(x, count) {
  as.data.frame(mapply(rep, x, data.frame(count)), stringsAsFactors = FALSE)
}

#' @export
expand_tab.character <- function(x, count) {
  col_int <- which(colnames(x) == count)
  as.data.frame(mapply(rep, x[-col_int], x[col_int]), stringsAsFactors = FALSE)
}

#' @export
expand_tab.data.frame <- function(x, count) {
  col_int <- which(colnames(x) == names(count))
  as.data.frame(mapply(rep, x[-col_int], x[col_int]), stringsAsFactors = FALSE)
}

# expand_tab <- function(x, count) {
#   switch(class(count),
#          data.frame = {
#            col_int <- which(colnames(x) == names(count))
#            as.data.frame(mapply(rep, x[-col_int], x[col_int]), stringsAsFactors = FALSE)
#          },
#          character = {
#            col_int <- which(colnames(x) == count)
#            as.data.frame(mapply(rep, x[-col_int], x[col_int]), stringsAsFactors = FALSE)
#          },
#          # default
#          {
#            as.data.frame(mapply(rep, x, data.frame(count)), stringsAsFactors = FALSE)
#          })
# }