civilyticsR/R/utils.R

#' 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 a vector
#' @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 a numeric vector
#' @export
#'
#' @examples
#' grade_level_to_num(c("KG", "Pre-K", "12", "10", "09"))
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 recoded race categories following NCES race codes
#' @export
#'
#' @examples
#' race_short_names(c("Black", "Hispanic Or Latino", "Two Or More Races"))
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)
}