Nothing
# Tidy recoding: Hardcoded(dplyr less flexible)
# This is for use with na_summary
# Will need to figure out how to avoid it, later
# metric here is just a name that actually means nothing
utils::globalVariables(c("all_of","metric","value","name", ":="))
# .....
#' @title Helper functions in package mde
#' @inheritParams recode_na_as
#' @param x data.frame object
#' @param column_check If TRUE, pattern search is performed columnwise.
#' Defaults to FALSE.
#' @export
recode_selectors <- function(x,column_check=TRUE,
pattern_type=NULL,pattern=NULL,
case_sensitive=FALSE,...){
# If using for column checks, use names
if (!is.null(pattern_type)) {
if (!pattern_type %in% c("starts_with","ends_with","contains","regex")){
stop("pattern_type should be one of starts_with,ends_with,contains or regex")
}
if(is.null(pattern)) stop("Both a pattern type and pattern should be provided..")
}
use_pattern <- switch(pattern_type,
ends_with = paste0(pattern,"$",
collapse = ""),
starts_with = paste0("^",
pattern,collapse=""),
contains = pattern,
regex = pattern)
if (column_check) {
grep(use_pattern,names(x),ignore.case = !case_sensitive,...)
}
else{
grepl(use_pattern,x,ignore.case = !case_sensitive,...)
}
}
# make changes
#' @title Helper functions in package mde
#' @param x A data.frame object
#' @param original_value Value to replace
#' @param new_value Replacement value.
#' @inheritParams recode_selectors
#' @export
recode_helper <- function(x,pattern_type=NULL,pattern=NULL,
original_value,
new_value,case_sensitive=FALSE,...){
x %>%
mutate(across(recode_selectors(x,column_check=TRUE,
pattern=pattern,
pattern_type=pattern_type,
case_sensitive = case_sensitive,
...),~ifelse(. %in% original_value,
new_value,.)))
}
#' Checks that all values are NA
#' @param x A vector or data.frame column
#' @description This is a helper function to check if all column/vector values
#' are NA
#' @return Boolean TRUE or FALSE depending on the nature of the column/vector
#' @examples
#' test <- data.frame(A=c(NA, 2), B= c(NA, NA))
#' all_na(test)
#' test_vec <- c("NA",NA,"nope")
#' test_numeric <- c(NA, 2)
#' all_na(test_vec)
#' all_na(test_numeric)
#' @export
all_na <- function(x) UseMethod("all_na")
#' @export
all_na.data.frame <- function(x) sapply(x, all_na)
#' @export
all_na.default <- function(x) all(is.na(x))
# skip tests on old releases
skip_on_oldrel <- function(version="3.6.3", msg = NULL) {
current_version <- utils::packageVersion("base")
if (current_version <= version) {
msg <- paste("R version",current_version,
"not supported. Please upgrade to R> 3.6.3")
testthat::skip(msg)
}
}
#' Get mean missingness.
#' @param x A vector whose mean NA is required.
#' @param as_percent Boolean? Report means as percents, defaults to TRUE.
#' @examples get_na_means(airquality)
#' @export
get_na_means <- function(x, as_percent=TRUE) UseMethod("get_na_means")
#' @export
get_na_means.numeric <- function(x, as_percent=TRUE){
res <-mean(is.na(x))
if(as_percent) res<-res * 100
res
}
#' @export
get_na_means.character <- get_na_means.numeric
#' @export
get_na_means.factor <- get_na_means.numeric
#' @export
get_na_means.POSIXct <- get_na_means.numeric
#' @export
get_na_means.data.frame <- function(x, as_percent=TRUE){
res <- colMeans(is.na(x))
if(as_percent) res <- res * 100
res
}
check_column_existence <- function(df, target_columns=NULL, unique_name=NULL){
if(!all(target_columns %in% names(df))){
stop(paste0("All columns ", unique_name, " should exist in the data set."))
}
}
switches <- function(target_value=NULL,sign,percent_na = 50){
UseMethod("switches")
}
switches.data.frame <- function(target_value=NULL,sign, percent_na = 50){
available_options <- c("gteq","lteq","gt","lt","eq")
if(! sign %in% available_options ) {
stop(paste(paste(c("I was expecting one of ",
available_options),collapse=" "),"not",sign))
}
res<- switch(sign,
gteq = which(target_value >=percent_na),
lteq = which(target_value <=percent_na),
gt = which(target_value >percent_na),
lt = which(target_value <percent_na),
eq = which(target_value == percent_na))
res
}
switches.numeric <- function(target_value=NULL,sign, percent_na = 50){
available_options <- c("gteq","lteq","gt","lt","eq")
if(! sign %in% available_options ) {
stop(paste(paste(c("I was expecting one of ",
available_options),collapse=" "), "not",sign)) }
res<- switch(sign,
gteq = target_value >=percent_na,
lteq = target_value <=percent_na,
gt = target_value >percent_na,
lt = target_value <percent_na,
eq = target_value == percent_na)
res
}
switches.double <- switches.numeric
unexpected_argument <- function(arg, acceptable_values){
if(!arg %in% acceptable_values){
stop(paste0("Use either ",acceptable_values[1], " or ",
acceptable_values[2]," not ", arg))
}
}
#' Get NA counts for a given character, numeric, factor, etc.
#' @param x A vector whose number of missing values is to be determined.
#' @examples
#' na_counts(airquality$Ozone)
#' @export
na_counts <- function(x) UseMethod("na_counts")
#' @export
na_counts.numeric <- function(x) sum(is.na(x))
#' @export
na_counts.character <- function(x) sum(is.na(x))
#' @export
na_counts.factor <- na_counts.numeric
#' @export
na_counts.POSIXct <- na_counts.numeric
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.