#' Safe maximum #' Take the max but ignore missing values #' #' @param x a numeric vector which may contain NA values #' #' @return the maximum non-missing value #' @export #' #' @examples #' safe_max(1:10) #' safe_max(c(1:10, NA))# 10 safe_max <- function(x) { if (all(is.na(x))) { return(NA) } else { max(x, na.rm = TRUE) } } #' Prettify proportion data #' Make data expresed as proportions print out as prettily formatted characters with percentages #' #' @param x a numeric vector of proportions to convert to percentages #' @param ndigit a vector of length 1 indicating the number of digits to display in the percent, by #' default it represents the digits after the decimal point in the percentage form #' #' @return a character vector with a % attached #' @export #' #' @examples #' pretty_per(0.2, ndigit = 1) #' pretty_per(c(0.2, 0.332423, 0.4, 0.342342), ndigit = 2) pretty_per <- function(x, ndigit = 1) { if (any(x >= 100) & !all(is.na(x))) { message("Values over 100 found, did you mean to use proportions?") } x <- format(round(x, digits = ndigit + 2) * 100, nsmall = ndigit) x <- paste0(x, "%") x[x == "NA%"] <- " - " x <- trimws(x) return(x) } #' Zero out missing values #' #' @param x a numeric vector with missing values #' #' @return a numeric vector with missing values replaced by 0 #' @export #' #' @examples #' na_zero(1:10) #' na_zero(c(NA, NA, 2:10)) na_zero <- function(x) { x[is.na(x)] <- 0 return(x) } #' Prettify count data #' Make integers propertly formatted as strings which include commas suitable for printing #' @param x a numeric vector #' #' @return a character vector with commas introduced in place positions in the numbers #' @export #' #' @examples #' pretty_count(10) #' pretty_count(1000) #' pretty_count(1e8) pretty_count <- function(x) { x <- prettyNum(x, big.mark = ",") return(x) } #' Unsuppress data using sampling #' #' @param x #' @param replace_char the character you want to replace in the vector #' @param zeros the number of zeroes to oversample when replacing replace_char #' @param max_value the numeric maximum value the replacement for the "*" can be #' @return a numeric vector with no characters representing suppressed values #' @export #' #' @examples #' suppr_data <- c("2", "8", "*", "*", "7", "9", "100") #' star_subs(suppr_data, zeros = 1, max_value = 10) #' star_subs(suppr_data, zeros = 1, max_value = 200) star_subs <- function(x, replace_char = "*", zeros = 15, max_value = 20) { x[x == "*"] <- sample(c(rep("0", zeros), as.character(0:max_value)), sum(x==replace_char), replace = TRUE) x <- as.numeric(x) return(x) } #' Recode grade level from character to numeric #' #' @param x character description of grade levels from NCES style data #' #' @return #' @export #' #' @examples grade_level_to_num <- function(x) { # Cannot generate new levels if it is a factor so we coerce to character first x <- as.character(x) x[x %in% c("KG", "Kindergarten")] <- "0" x[x %in% c("Pre-K", "Pre-k", "Preschool", "Pre-Kindergarten")] <- "-1" x[x %in% c("Adult", "Adult Education")] <- "13" y <- as.numeric(x) return(y) } #' Recode NCES race categories to shorter names #' #' @param x a character vector with NCES race codes, often from Urban Institute #' #' @return #' @export #' #' @examples race_short_names <- function(x) { x <- as.character(x) x[x %in% c("Black", "Black Or African American", "Black or African American", "African American")] <- "black" x[x %in% c("Hispanic", "Hispanic Or Latino", "Hispanic or Latino")] <- "hisp_lat" x[x %in% c("White", "white", "White and Not Hispanic")] <- "white" x[x %in% c("Asian", "Asian American")] <- "asian" x[x %in% c("Two Or More Races", "Two or More Races")] <- "two_or_more" x[x %in% c("Native Hawaiian Or Other Pacific Islander", "Native Hawaiian or Other Pacific Islander", "Native Hawaiian Pacific Islander")] <- "native_haw" x[x %in% c("American Indian", "American Indian Or Alaska Native", "American Indian or Alaska Native", "American Indian or Native Alaskan")] <- "amind" x[x %in% c("Not Reported")] <- "other" return(x) }