#' Create a factor based on specified level:index pairs
#'
#' \code{refactor_by_idx} changes \code{x} to a factor, and specifies level
#' order based the 1:1 pairing of \code{levs} and \code{idx}
#'
#' @param x A vector that will be converted to a factor based with level order
#' specified by \code{levs}:\code{idx} pairing
#' \code{from}.
#' @param levs The levels contained in \code{x}
#' @param idx The order in which \code{levs} will be incorporated into the
#' new factor
#' @return A factor with levels ordered according to \code{levs}:\code{idx}
#' pairing
#' @export
refactor_by_idx <- function(x, levs, idx) {
stopifnot(length(levs) == length(idx),
sum(duplicated(levs)) == 0,
sum(duplicated(idx)) == 0)
idx <- order(idx)
x <- factor(x, levels = levs[idx])
return(x)
}
#' Combine the levels or unique values of multiple columns into a vector
#'
#' A function designed to collect the factor levels
#' and unique values within a series of columns and combine them into one
#' vector. This may be useful when trying to construct a table using
#' \code{htmlTable_td}.
#'
#' @param x A dataframe
#' @param cols The columns from which to grab unique values and factor levels
#' @param rev Specifies which columns will have a reversed order
#' @return Returns a vector of unique values and levels ordered in a manner
#' consistent with the columns from which they were derived.
#' @export
get_factor_levels <- function(x, cols, rev = FALSE) {
stopifnot(is.numeric(rev) | is.logical(rev))
# Create a vector of logicals based on the input into rev
if (is.logical(rev)) {
if (length(rev) == 1) {
rev <- rep(rev, length(cols))
} else if (length(rev) != length(cols)) {
stop(paste0("If rev is logical, it must be of length 1 or the same",
" lengths as cols"))
}
} else {
tmp_rev <- rep(FALSE, length(cols))
tmp_rev[rev] <- TRUE
rev <- tmp_rev
}
names(rev) <- cols
# Create a vector of levels (revered order of specific columns based on
# rev argument)
levs <- NULL
for (col in cols) {
if (is.factor(x[, col])) {
tmp_lev <- levels(x[, col])
} else {
tmp_lev <- sort(unique(x[, col]))
}
if (rev[names(rev) == col]) {tmp_lev <- rev(tmp_lev)}
levs <- c(levs, tmp_lev)
}
return(unique(levs))
}
#' Function to retrieve the first level from one or more columns in a data.frame
#'
#' \code{get_first_levels} is a function that may be used to retrieve the first
#' level from one or more columns in a data.frame
#'
#' @param x A dataframe
#' @param cols The columns from which to retrieve first levels
#' @return Returns a vector of first levels
#' @export
get_first_levels <- function(x, cols) {
# Create a vector of levels (revered order of specific columns based on
# rev argument)
levs <- NULL
for (col in cols) {
if (is.factor(x[, col])) {
levs <- c(levs, levels(x[, col])[1])
} else {
levs <- c(levs, sort(unique(x[, col]))[1])
}
}
names(levs) <- cols
return(levs)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.