diff --git a/NAMESPACE b/NAMESPACE index 8d2851b..2acc84c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,7 +2,6 @@ export("%nin%") export("%nn%") -export(add_ifelse) export(age_days) export(arrows) export(bracks) @@ -22,7 +21,6 @@ export(combine) export(common_regex) export(construct_regex) export(count_days) -export(count_missing) export(count_prop) export(count_prop_multi) export(count_wide) @@ -80,8 +78,6 @@ export(rename_seq) export(roundup) export(search_in) export(search_in_if) -export(search_in_if_args) -export(show_missing) export(single_line_string) export(sorted_bars) export(splitter) diff --git a/R/colon.R b/R/colon.R deleted file mode 100644 index dc63c14..0000000 --- a/R/colon.R +++ /dev/null @@ -1,29 +0,0 @@ -#' Create Integer Sequence Beginning at 1 -#' -#' @param n `` Ending number of sequence -#' -#' @returns `` vector of numbers from 1 to `n` -#' -#' @examples -#' colon(50) -#' -#' colon(-20) -#' -#' colon(0 + 150 - 145) -#' -#' colon(20.9) -#' -#' colon(20.1) -#' -#' @autoglobal -#' -#' @export -colon <- function(n) { - - if (!rlang::is_integerish(n, n = length(n))) { - rlang::warn( - message = "`n` has been coerced to an integer.", - class = "non_int") - } - 1:n -} diff --git a/R/combine.R b/R/combine.R deleted file mode 100644 index b16302d..0000000 --- a/R/combine.R +++ /dev/null @@ -1,42 +0,0 @@ -#' Combine multiple columns into one -#' -#' @param df `` or `` -#' -#' @param name new column name, unquoted, default is `combined` -#' -#' @param columns `` vector of columns to combine -#' -#' @param sep separator between combined row data, default is `"-"` -#' -#' @returns A `` or `` with combined columns -#' -#' @examples -#' x <- fuimus:::forager_data()[-5] -#' -#' x[1, 2] <- "" -#' -#' x -#' -#' x |> -#' combine( -#' name = id_payer, -#' columns = c('claim_id', 'payer')) -#' -#' @autoglobal -#' -#' @export -combine <- function(df, name = combined, columns, sep = "-") { - - x <- tidyr::unite( - df, - col = {{ name }}, - dplyr::any_of(columns), - remove = TRUE, - na.rm = TRUE, - sep = sep) - - x |> - dplyr::mutate( - {{ name }} := dplyr::na_if({{ name }}, "") - ) -} diff --git a/R/counts.R b/R/counts.R deleted file mode 100644 index 1d60a6a..0000000 --- a/R/counts.R +++ /dev/null @@ -1,180 +0,0 @@ -#' Count and calculate proportion of each group -#' -#' @param df A `` or `` -#' -#' @param var A `` or `` specifying the column to count -#' -#' @param sort A `` indicating whether to sort the output by frequency, -#' default is `FALSE` -#' -#' @param na.rm A `` indicating whether to remove missing values from -#' the count, default is `FALSE` -#' -#' @examples -#' fuimus:::forager_data() |> -#' count_prop(payer, sort = TRUE) -#' -#' @autoglobal -#' -#' @export -count_prop <- function(df, - var, - sort = FALSE, - na.rm = FALSE) { - df |> - dplyr::count( - {{ var }}, - sort = sort - ) |> - dplyr::mutate( - prop = n / sum(n, na.rm = na.rm) - ) -} - -#' Count and calculate proportion of each group -#' -#' @param df A `` or `` -#' -#' @param rows A `` or `` specifying the rows to count -#' -#' @param cols A `` or `` specifying the columns to count -#' -#' @param sort A `` indicating whether to sort the output by frequency, -#' default is `FALSE` -#' -#' @param na.rm A `` indicating whether to remove missing values from -#' the count, default is `FALSE` -#' -#' @examples -#' fuimus:::forager_data(10) |> -#' count_prop_multi( -#' c(ins_class), -#' payer, -#' sort = TRUE) -#' -#' @autoglobal -#' -#' @export -count_prop_multi <- function(df, - rows, - cols, - sort = FALSE, - na.rm = FALSE) { - df |> - dplyr::count( - dplyr::pick( - c( - {{ rows }}, - {{ cols }} - ) - ), - sort = sort - ) |> - dplyr::mutate(prop = n / sum(n, na.rm = na.rm)) -} - -#' Count rows and columns and pivot to wide format -#' -#' @param df A `` or `` -#' -#' @param rows A `` or `` specifying the rows to count -#' -#' @param cols A `` or `` specifying the columns to count -#' -#' @examples -#' fuimus:::forager_data(10) |> -#' count_wide( -#' c(ins_class), -#' payer) -#' -#' @autoglobal -#' -#' @export -count_wide <- function(df, rows, cols) { - - df |> - dplyr::count( - dplyr::pick( - c({{ rows }}, {{ cols }}) - ) - ) |> - tidyr::pivot_wider( - names_from = {{ cols }}, - values_from = n, - names_sort = TRUE, - values_fill = 0 - ) -} - -#' Count missing values -#' -#' @param df A `` or `` -#' -#' @param group_vars A `` or `` vector of the variables to -#' group by -#' -#' @param x_var A `` or `` vector of the variable to count -#' missing values for -#' -#' @returns A `` or `` with the count of missing values -#' -#' @examples -#' dplyr::tibble(x = 1:10, -#' y = 1:10, -#' z = letters[1:10]) |> -#' count_missing(z, x) -#' @autoglobal -#' -#' @export -count_missing <- function(df, - group_vars, - x_var) { - df |> - dplyr::group_by( - dplyr::pick({{ group_vars }})) |> - dplyr::summarize( - n_miss = sum(is.na({{ x_var }})), - .groups = "drop" - ) -} - -#' Show missing values -#' -#' @param df A `` or `` -#' -#' @param group_vars A `` or `` vector of the variables to -#' group by -#' -#' @param summary_vars A `` or `` vector of the variables to -#' summarize; default is [dplyr::everything()] -#' -#' @examples -#' dplyr::tibble(x = 1:10, -#' y = 1:10, -#' z = c(letters[1:10])) |> -#' show_missing(z) -#' -#' @autoglobal -#' -#' @export -show_missing <- function(df, - group_vars, - summary_vars = dplyr::everything()) { - df |> - dplyr::group_by( - dplyr::pick( - {{ group_vars }} - ) - ) |> - dplyr::summarize( - dplyr::across( - {{ summary_vars }}, \(x) sum(is.na(x) - ) - ), - .groups = "drop" - ) |> - dplyr::select( - dplyr::where(\(x) any(x > 0) - ) - ) -} diff --git a/R/df.R b/R/df.R index 9381ecd..f229b95 100644 --- a/R/df.R +++ b/R/df.R @@ -5,7 +5,11 @@ #' @returns A `` or `` with numeric columns coerced to character #' #' @examples -#' df_2_chr(dplyr::tibble(x = 20:35)) +#' dplyr::tibble( +#' int = 1:10, +#' chr = letters[1:10], +#' date = rep(Sys.Date()), nrow(int)) |> +#' df_2_chr() #' #' @autoglobal #' @@ -14,7 +18,7 @@ df_2_chr <- function(df) { df |> dplyr::mutate( dplyr::across( - dplyr::where(is.numeric), as.character)) + dplyr::everything(), as.character)) } #' Get the types of each column in a data frame @@ -22,7 +26,11 @@ df_2_chr <- function(df) { #' @param df A data frame #' #' @examples -#' dplyr::tibble(x = 1:10, y = 1:10) |> df_types() +#' dplyr::tibble( +#' int = 1:10, +#' chr = letters[1:10], +#' date = rep(Sys.Date()), nrow(int)) |> +#' df_types() #' #' @export #' @@ -34,3 +42,177 @@ df_types <- function(df) { n_miss = purrr::map_int(df, \(x) sum(is.na(x))) ) } + +#' Pivot data frame to long format for easy printing +#' +#' @param df `` or `` to pivot long +#' +#' @param cols `` vector of columns to pivot long, default is [dplyr::everything()] +#' +#' @returns a `` or `` in long format +#' +#' @examples +#' dplyr::tibble( +#' int = 1:10, +#' chr = letters[1:10], +#' date = rep(Sys.Date()), nrow(int)) |> +#' display_long() +#' +#' @autoglobal +#' +#' @export +display_long <- function(df, cols = dplyr::everything()) { + + df |> dplyr::mutate( + dplyr::across( + dplyr::everything(), as.character)) |> + tidyr::pivot_longer({{ cols }}) +} + +#' Combine multiple columns into one +#' +#' @param df `` or `` +#' +#' @param name new column name, unquoted, default is `combined` +#' +#' @param columns `` vector of columns to combine +#' +#' @param sep separator between combined row data, default is `"-"` +#' +#' @returns A `` or `` with combined columns +#' +#' @examples +#' x <- fuimus:::forager_data()[-5] +#' +#' x[1, 2] <- "" +#' +#' x +#' +#' x |> +#' combine( +#' name = id_payer, +#' columns = c('claim_id', 'payer')) +#' +#' @autoglobal +#' +#' @export +combine <- function(df, name = combined, columns, sep = "-") { + + x <- tidyr::unite( + df, + col = {{ name }}, + dplyr::any_of(columns), + remove = TRUE, + na.rm = TRUE, + sep = sep) + + x |> + dplyr::mutate( + {{ name }} := dplyr::na_if({{ name }}, "") + ) +} + +#' Count and calculate proportion of each group +#' +#' @param df A `` or `` +#' +#' @param var A `` or `` specifying the column to count +#' +#' @param sort A `` indicating whether to sort the output by frequency, +#' default is `FALSE` +#' +#' @param na.rm A `` indicating whether to remove missing values from +#' the count, default is `FALSE` +#' +#' @examples +#' fuimus:::forager_data() |> +#' count_prop(payer, sort = TRUE) +#' +#' @autoglobal +#' +#' @export +count_prop <- function(df, + var, + sort = FALSE, + na.rm = FALSE) { + df |> + dplyr::count( + {{ var }}, + sort = sort + ) |> + dplyr::mutate( + prop = n / sum(n, na.rm = na.rm) + ) +} + +#' Count and calculate proportion of each group +#' +#' @param df A `` or `` +#' +#' @param rows A `` or `` specifying the rows to count +#' +#' @param cols A `` or `` specifying the columns to count +#' +#' @param sort A `` indicating whether to sort the output by frequency, +#' default is `FALSE` +#' +#' @param na.rm A `` indicating whether to remove missing values from +#' the count, default is `FALSE` +#' +#' @examples +#' fuimus:::forager_data(10) |> +#' count_prop_multi( +#' c(ins_class), +#' payer, +#' sort = TRUE) +#' +#' @autoglobal +#' +#' @export +count_prop_multi <- function(df, + rows, + cols, + sort = FALSE, + na.rm = FALSE) { + df |> + dplyr::count( + dplyr::pick( + c( + {{ rows }}, + {{ cols }} + )), + sort = sort + ) |> + dplyr::mutate(prop = n / sum(n, na.rm = na.rm)) +} + +#' Count rows and columns and pivot to wide format +#' +#' @param df A `` or `` +#' +#' @param rows A `` or `` specifying the rows to count +#' +#' @param cols A `` or `` specifying the columns to count +#' +#' @examples +#' fuimus:::forager_data(10) |> +#' count_wide(c(ins_class), payer) +#' +#' @autoglobal +#' +#' @export +count_wide <- function(df, rows, cols) { + + df |> + dplyr::count( + dplyr::pick( + c({{ rows }}, {{ cols }}) + ) + ) |> + tidyr::pivot_wider( + names_from = {{ cols }}, + values_from = n, + names_sort = TRUE, + values_fill = 0 + ) +} diff --git a/R/display_long.R b/R/display_long.R deleted file mode 100644 index 156fd8c..0000000 --- a/R/display_long.R +++ /dev/null @@ -1,28 +0,0 @@ -#' Pivot data frame to long format for easy printing -#' -#' @param df `` or `` to pivot long -#' -#' @param cols `` vector of columns to pivot long, default is [dplyr::everything()] -#' -#' @returns a `` or `` in long format -#' -#' @examples -#' x <- dplyr::tibble( -#' a = 1:10, -#' b = letters[1:10], -#' c = 11:20, -#' d = LETTERS[1:10], -#' e = 21:30) -#' -#' display_long(x) -#' -#' @autoglobal -#' -#' @export -display_long <- function(df, cols = dplyr::everything()) { - - df |> dplyr::mutate( - dplyr::across( - dplyr::everything(), as.character)) |> - tidyr::pivot_longer({{ cols }}) -} diff --git a/R/fs_ops.R b/R/fs_ops.R deleted file mode 100644 index 7726220..0000000 --- a/R/fs_ops.R +++ /dev/null @@ -1,32 +0,0 @@ -#' Test if a path is a directory -#' -#' @param x `` directory path to check -#' -#' @returns named `` vector, where the names give the paths. If the given -#' object does not exist, `NA` is returned. -#' -#' @examples -#' is_directory("C:/") -#' -#' @autoglobal -#' -#' @noRd -is_directory <- function(x) { - fs::is_dir(x) -} - -#' Test if a path is readable -#' -#' @param x `` vector of one or more paths -#' -#' @returns `` vector, with names corresponding to input path. -#' -#' @examples -#' is_readable("D:/") -#' -#' @autoglobal -#' -#' @noRd -is_readable <- function(x) { - fs::file_exists(x) -} diff --git a/R/generated-globals.R b/R/generated-globals.R index c2e6145..51e739c 100644 --- a/R/generated-globals.R +++ b/R/generated-globals.R @@ -1,9 +1,9 @@ # Generated by roxyglobals: do not edit by hand utils::globalVariables(c( - # # # + # # # # @@ -38,10 +38,10 @@ utils::globalVariables(c( "mad", # "med", + # # # # - # "n", # "nuniq", diff --git a/R/print_list.R b/R/print_list.R deleted file mode 100644 index b8db2b2..0000000 --- a/R/print_list.R +++ /dev/null @@ -1,28 +0,0 @@ -#' Print a named list -#' -#' @param ls `` to print -#' -#' @param prefix `` to prepend to each line -#' -#' @returns `` invisibly -#' -#' @examples -#' print_ls(list(a = 1, b = 2, c = 3)) -#' -#' @autoglobal -#' -#' @export -print_ls <- function(ls, prefix = "") { - - if (length(ls) == 0) cat("\n") - - ns <- names(ls) - - if (length(ns) != length(ls)) stop("all elements must be named") - - ls <- lapply(ls, as.character) - - cat(sprintf("%s%s : %s", prefix, format(ns), ls), sep = "\n") - - invisible(ls) -} diff --git a/R/programming.R b/R/programming.R new file mode 100644 index 0000000..a3f4fd2 --- /dev/null +++ b/R/programming.R @@ -0,0 +1,111 @@ +#' Search in data frame +#' +#' @param df A `` or `` +#' +#' @param dfcol A `` or `` specifying the column to search in +#' +#' @param search A `` or `` specifying the search term +#' +#' @returns A `` or `` +#' +#' @examples +#' x <- dplyr::tibble(y = 1:10, +#' z = letters[1:10]) +#' +#' search_in(df = x, +#' dfcol = x$z, +#' search = c("a", "j")) +#' +#' @autoglobal +#' +#' @export +search_in <- function(df, dfcol, search) { + vctrs::vec_slice( + df, + vctrs::vec_in( + dfcol, + collapse::funique( + search + ) + ) + ) +} + +#' Search in data frame column if search term is not `NULL` +#' +#' @param df A `` or `` +#' +#' @param dfcol A `` or `` specifying the column to search in +#' +#' @param search A `` or `` specifying the search term +#' +#' @returns A `` or `` +#' +#' @examples +#' x <- dplyr::tibble( +#' y = 1:10, +#' z = letters[1:10]) +#' +#' search_in_if(df = x, +#' dfcol = x$z, +#' search = c("a", "j")) +#' +#' search_in_if(df = x, +#' dfcol = x$z, +#' search = NULL) +#' +#' @autoglobal +#' +#' @export +search_in_if <- function(df, dfcol, search) { + + if (!is.null(search)) { + + vctrs::vec_slice(df, + vctrs::vec_in(dfcol, + collapse::funique(search))) + + } else { df } + +} + +#' Search a data frame column by string +#' +#' @param df `` or `` +#' +#' @param col column name as string or unquoted +#' +#' @param search string to search for, can be a regular expression, e.g. `'^[A-Z]'` +#' +#' @param ignore ignore case, default is `TRUE` +#' +#' @param ... additional arguments +#' +#' @returns `` or `` +#' +#' @examples +#' x <- dplyr::tibble(y = 1:10, z = letters[1:10]) +#' +#' srchcol(df = x, col = "z", search = "[a|j]") +#' +#' @autoglobal +#' +#' @export +srchcol <- function(df, + col, + search, + ignore = TRUE, + ...) { + dplyr::filter( + df, + stringr::str_detect( + !!rlang::sym( + col + ), + stringr::regex( + search, + ignore_case = ignore + ) + ) + ) +} diff --git a/R/regex.R b/R/regex.R index 2e5f7b0..c10fee3 100644 --- a/R/regex.R +++ b/R/regex.R @@ -209,3 +209,45 @@ pos_nchar <- function(x) { ) } + +#' Common Regular expressions +#' +#' @param x `` regex name +#' +#' @returns `` string of a regex +#' +#' @examples +#' common_regex("url") +#' +#' common_regex("month") +#' +#' common_regex("month_date") +#' +#' @autoglobal +#' +#' @export +common_regex <- function(x = c("month_date", "month", "url")) { + + x <- match.arg(x) + + reg <- list( + month_date = single_line_string( + "(Jan(?:uary)?|Feb(?:ruary)?|Mar(?:ch)?|Apr(?:il)?|May|Jun(?:e)?| + Jul(?:y)?|Aug(?:ust)?|Sep(?:tember)?|Oct(?:ober)?|Nov(?:ember)?| + Dec(?:ember)?)\\s+(\\d{1,2})\\,\\s+(\\d{4})" + ), + month = single_line_string( + "(Jan(?:uary)?|Feb(?:ruary)?|Mar(?:ch)?|Apr(?:il)?|May|Jun(?:e)?| + Jul(?:y)?|Aug(?:ust)?|Sep(?:tember)?|Oct(?:ober)?|Nov(?:ember)?| + Dec(?:ember)?)" + ), + url = single_line_string( + "^(?:(?:http(?:s)?|ftp)://)(?:\\S+(?::(?:\\S)*)?@)?(?:(?:[a-z0-9 + \u00a1-\uffff](?:-)*)*(?:[a-z0-9\u00a1-\uffff])+)(?:\\.(?:[a-z0-9 + \u00a1-\uffff](?:-)*)*(?:[a-z0-9\u00a1-\uffff])+)*(?:\\.(?:[a-z0-9 + \u00a1-\uffff]){2,})(?::(?:\\d){2,5})?(?:/(?:\\S)*)?$" + ) + ) + + reg[[x]] +} diff --git a/R/string_ops.R b/R/string_ops.R index fd513a5..b0c051e 100644 --- a/R/string_ops.R +++ b/R/string_ops.R @@ -45,48 +45,6 @@ invert_named <- function(x) { rlang::set_names(names(x), unname(x)) } -#' Common Regular expressions -#' -#' @param x `` regex name -#' -#' @returns `` string of a regex -#' -#' @examples -#' common_regex("url") -#' -#' common_regex("month") -#' -#' common_regex("month_date") -#' -#' @autoglobal -#' -#' @export -common_regex <- function(x = c("month_date", "month", "url")) { - - x <- match.arg(x) - - reg <- list( - month_date = single_line_string( - "(Jan(?:uary)?|Feb(?:ruary)?|Mar(?:ch)?|Apr(?:il)?|May|Jun(?:e)?| - Jul(?:y)?|Aug(?:ust)?|Sep(?:tember)?|Oct(?:ober)?|Nov(?:ember)?| - Dec(?:ember)?)\\s+(\\d{1,2})\\,\\s+(\\d{4})" - ), - month = single_line_string( - "(Jan(?:uary)?|Feb(?:ruary)?|Mar(?:ch)?|Apr(?:il)?|May|Jun(?:e)?| - Jul(?:y)?|Aug(?:ust)?|Sep(?:tember)?|Oct(?:ober)?|Nov(?:ember)?| - Dec(?:ember)?)" - ), - url = single_line_string( - "^(?:(?:http(?:s)?|ftp)://)(?:\\S+(?::(?:\\S)*)?@)?(?:(?:[a-z0-9 - \u00a1-\uffff](?:-)*)*(?:[a-z0-9\u00a1-\uffff])+)(?:\\.(?:[a-z0-9 - \u00a1-\uffff](?:-)*)*(?:[a-z0-9\u00a1-\uffff])+)*(?:\\.(?:[a-z0-9 - \u00a1-\uffff]){2,})(?::(?:\\d){2,5})?(?:/(?:\\S)*)?$" - ) - ) - - reg[[x]] -} - #' Convert various character strings to `NA` #' #' @param x `` vector to convert @@ -124,41 +82,6 @@ remove_quotes <- function(x) { stringfish::sf_gsub(x, '["\']', "") } -#' Wrapper for `as.character(glue(x))` -#' -#' @param ... dots to pass to glue function -#' -#' @returns `` vector -#' -#' @autoglobal -#' -#' @export -glue_chr <- function(...) { - as.character( - glue::glue( - ..., - .envir = parent.frame(1)) ) -} - -#' Wrapper for `as.character(glue_data(x))` -#' -#' @param ... dots to pass to glue function -#' -#' @param .x `` vector to pass to glue_data() -#' -#' @returns `` vector -#' -#' @autoglobal -#' -#' @export -glue_data_chr <- function(.x, ...) { - as.character( - glue::glue_data( - .x = .x, - ..., - .envir = parent.frame(1))) -} - #' Pad numbers with zeroes #' #' @param x `` vector of numbers @@ -265,13 +188,13 @@ create_vec <- function(x, #' #' @examples #' rename_seq( -#' n = 10, -#' new = "id_issuer_", -#' between = " = ", -#' old = "Other.ID.Issuer.", -#' enclose = c("x = c(", ")"), -#' collapse = ",\n ", -#' style = TRUE) +#' n = 10, +#' new = "id_issuer_", +#' between = " = ", +#' old = "Other.ID.Issuer.", +#' enclose = c("x = c(", ")"), +#' collapse = ",\n ", +#' style = TRUE) #' #' @autoglobal #' @@ -323,12 +246,7 @@ rename_seq <- function(n, #' #' @export single_line_string <- function(x) { - - stringr::str_remove_all( - x, - r"(\n\s*)" - ) - + stringr::str_remove_all(x, r"(\n\s*)") } #' Wrapper for [paste0()] that collapses result @@ -360,9 +278,7 @@ collapser <- function(x) { #' #' @export delister <- function(x) { - unlist( - x, - use.names = FALSE) + unlist(x, use.names = FALSE) } #' Wrapper for [strsplit()] that unlists and unnames results @@ -395,11 +311,7 @@ delister <- function(x) { #' @export splitter <- function(x) { - res <- strsplit( - unlist( - x, - use.names = FALSE - ), "") + res <- strsplit(unlist(x, use.names = FALSE), "") if (length(res) == 1) { return(res[[1]]) @@ -438,7 +350,6 @@ parens <- function(x) { #' Wrapper for [paste0()] that adds angle brackets #' -#' #' @param x `` string #' #' @autoglobal @@ -449,3 +360,32 @@ parens <- function(x) { arrows <- function(x) { paste0(r"--{<}--", x, r"--{>}--") } + +#' Print a named list +#' +#' @param ls `` to print +#' +#' @param prefix `` to prepend to each line +#' +#' @returns `` invisibly +#' +#' @examples +#' print_ls(list(a = 1, b = 2, c = 3)) +#' +#' @autoglobal +#' +#' @export +print_ls <- function(ls, prefix = "") { + + if (length(ls) == 0) cat("\n") + + ns <- names(ls) + + if (length(ns) != length(ls)) stop("all elements must be named") + + ls <- lapply(ls, as.character) + + cat(sprintf("%s%s : %s", prefix, format(ns), ls), sep = "\n") + + invisible(ls) +} diff --git a/R/search_ins.R b/R/unused.R similarity index 53% rename from R/search_ins.R rename to R/unused.R index 649ff76..c3bfeb7 100644 --- a/R/search_ins.R +++ b/R/unused.R @@ -1,74 +1,3 @@ -#' Search in data frame -#' -#' @param df A `` or `` -#' -#' @param dfcol A `` or `` specifying the column to search in -#' -#' @param search A `` or `` specifying the search term -#' -#' @returns A `` or `` -#' -#' @examples -#' x <- dplyr::tibble(y = 1:10, -#' z = letters[1:10]) -#' -#' search_in(df = x, -#' dfcol = x$z, -#' search = c("a", "j")) -#' -#' @autoglobal -#' -#' @export -search_in <- function(df, dfcol, search) { - vctrs::vec_slice( - df, - vctrs::vec_in( - dfcol, - collapse::funique( - search - ) - ) - ) -} - -#' Search in data frame column if search term is not `NULL` -#' -#' @param df A `` or `` -#' -#' @param dfcol A `` or `` specifying the column to search in -#' -#' @param search A `` or `` specifying the search term -#' -#' @returns A `` or `` -#' -#' @examples -#' x <- dplyr::tibble( -#' y = 1:10, -#' z = letters[1:10]) -#' -#' search_in_if(df = x, -#' dfcol = x$z, -#' search = c("a", "j")) -#' -#' search_in_if(df = x, -#' dfcol = x$z, -#' search = NULL) -#' -#' @autoglobal -#' -#' @export -search_in_if <- function(df, dfcol, search) { - - if (!is.null(search)) { - - vctrs::vec_slice(df, - vctrs::vec_in(dfcol, - collapse::funique(search))) - - } else { df } - -} - #' Search in data frame column if search term is not `NULL` #' #' @param df A `` or `` @@ -105,7 +34,7 @@ search_in_if <- function(df, dfcol, search) { #' #' @autoglobal #' -#' @export +#' @noRd search_in_if_args <- function(df, dfcol, search, @@ -122,8 +51,8 @@ search_in_if_args <- function(df, } vctrs::vec_slice(df, - vctrs::vec_in(dfcol, - collapse::funique(search))) + vctrs::vec_in(dfcol, + collapse::funique(search))) } else { df @@ -149,58 +78,122 @@ search_in_if_args <- function(df, #' dfcol = df$mue_service_type, #' by = mue_service_type) #' -#' @keywords internal -#' #' @autoglobal #' -#' @export +#' @noRd add_ifelse <- function(x, df, dfcol, by) { if (vctrs::vec_is_empty(x)) { NULL } else { vctrs::vec_slice(df, - vctrs::vec_in(dfcol, x)) |> - tidyr::nest(.by = {{ by }}) } + vctrs::vec_in(dfcol, x)) |> + tidyr::nest(.by = {{ by }}) } } -#' Search a data frame column by string +#' Test if a path is a directory +#' +#' @param x `` directory path to check #' -#' @param df `` or `` +#' @returns named `` vector, where the names give the paths. If the given +#' object does not exist, `NA` is returned. #' -#' @param col column name as string or unquoted +#' @examples +#' is_directory("C:/") #' -#' @param search string to search for, can be a regular expression, e.g. `'^[A-Z]'` +#' @autoglobal #' -#' @param ignore ignore case, default is `TRUE` +#' @noRd +is_directory <- function(x) { + fs::is_dir(x) +} + +#' Test if a path is readable #' -#' @param ... additional arguments +#' @param x `` vector of one or more paths #' -#' @returns `` or `` +#' @returns `` vector, with names corresponding to input path. #' #' @examples -#' x <- dplyr::tibble(y = 1:10, z = letters[1:10]) +#' is_readable("D:/") +#' +#' @autoglobal +#' +#' @noRd +is_readable <- function(x) { + fs::file_exists(x) +} + + +#' Count missing values #' -#' srchcol(df = x, col = "z", search = "[a|j]") +#' @param df A `` or `` +#' +#' @param group_vars A `` or `` vector of the variables to +#' group by +#' +#' @param x_var A `` or `` vector of the variable to count +#' missing values for +#' +#' @returns A `` or `` with the count of missing values +#' +#' @examples +#' dplyr::tibble(x = 1:10, +#' y = 1:10, +#' z = letters[1:10]) |> +#' count_missing(z, x) +#' @autoglobal +#' +#' @noRd +count_missing <- function(df, + group_vars, + x_var) { + df |> + dplyr::group_by( + dplyr::pick({{ group_vars }})) |> + dplyr::summarize( + n_miss = sum(is.na({{ x_var }})), + .groups = "drop" + ) +} + +#' Show missing values +#' +#' @param df A `` or `` +#' +#' @param group_vars A `` or `` vector of the variables to +#' group by +#' +#' @param summary_vars A `` or `` vector of the variables to +#' summarize; default is [dplyr::everything()] +#' +#' @examples +#' dplyr::tibble(x = 1:10, +#' y = 1:10, +#' z = c(letters[1:10])) |> +#' show_missing(z) #' #' @autoglobal #' -#' @export -srchcol <- function(df, - col, - search, - ignore = TRUE, - ...) { - dplyr::filter( - df, - stringr::str_detect( - !!rlang::sym( - col +#' @noRd +show_missing <- function(df, + group_vars, + summary_vars = dplyr::everything()) { + df |> + dplyr::group_by( + dplyr::pick( + {{ group_vars }} + ) + ) |> + dplyr::summarize( + dplyr::across( + {{ summary_vars }}, \(x) sum(is.na(x) + ) ), - stringr::regex( - search, - ignore_case = ignore + .groups = "drop" + ) |> + dplyr::select( + dplyr::where(\(x) any(x > 0) ) ) - ) } diff --git a/R/wrappers.R b/R/wrappers.R index 1e543d6..a7373e3 100644 --- a/R/wrappers.R +++ b/R/wrappers.R @@ -193,3 +193,69 @@ na_min <- function(...) { na_max <- function(...) { base::max(..., na.rm = TRUE) } + + +#' Wrapper for `as.character(glue::glue(x))` +#' +#' @param ... dots to pass to glue function +#' +#' @returns `` vector +#' +#' @autoglobal +#' +#' @export +glue_chr <- function(...) { + as.character( + glue::glue( + ..., + .envir = parent.frame(1)) ) +} + +#' Wrapper for `as.character(glue::glue_data(x))` +#' +#' @param ... dots to pass to glue function +#' +#' @param .x `` vector to pass to glue_data() +#' +#' @returns `` vector +#' +#' @autoglobal +#' +#' @export +glue_data_chr <- function(.x, ...) { + as.character( + glue::glue_data( + .x = .x, + ..., + .envir = parent.frame(1))) +} + +#' Create Integer Sequence Beginning at 1 +#' +#' @param n `` Ending number of sequence +#' +#' @returns `` vector of numbers from 1 to `n` +#' +#' @examples +#' colon(50) +#' +#' colon(-20) +#' +#' colon(0 + 150 - 145) +#' +#' colon(20.9) +#' +#' colon(20.1) +#' +#' @autoglobal +#' +#' @export +colon <- function(n) { + + if (!rlang::is_integerish(n, n = length(n))) { + rlang::warn( + message = "`n` has been coerced to an integer.", + class = "non_int") + } + 1:n +} diff --git a/man/add_ifelse.Rd b/man/add_ifelse.Rd deleted file mode 100644 index f4c478f..0000000 --- a/man/add_ifelse.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/search_ins.R -\name{add_ifelse} -\alias{add_ifelse} -\title{Search in data frame column if search term is not \code{NULL}} -\usage{ -add_ifelse(x, df, dfcol, by) -} -\arguments{ -\item{x}{A \verb{} or \verb{} specifying the search term} - -\item{df}{A \verb{} or \verb{}} - -\item{dfcol}{A \verb{} or \verb{} specifying the column to search in} - -\item{by}{A \verb{} or \verb{} specifying the column to nest by} -} -\value{ -A \verb{} or \verb{} -} -\description{ -Search in data frame column if search term is not \code{NULL} -} -\examples{ -\dontshow{if (FALSE) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} - -add_ifelse(x = "Practitioner", - df = df, - dfcol = df$mue_service_type, - by = mue_service_type) -\dontshow{\}) # examplesIf} -} -\keyword{internal} diff --git a/man/colon.Rd b/man/colon.Rd index 34e2896..7e4234f 100644 --- a/man/colon.Rd +++ b/man/colon.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/colon.R +% Please edit documentation in R/wrappers.R \name{colon} \alias{colon} \title{Create Integer Sequence Beginning at 1} diff --git a/man/combine.Rd b/man/combine.Rd index d461df3..d77aedc 100644 --- a/man/combine.Rd +++ b/man/combine.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/combine.R +% Please edit documentation in R/df.R \name{combine} \alias{combine} \title{Combine multiple columns into one} diff --git a/man/common_regex.Rd b/man/common_regex.Rd index 76d02a6..b69b144 100644 --- a/man/common_regex.Rd +++ b/man/common_regex.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/string_ops.R +% Please edit documentation in R/regex.R \name{common_regex} \alias{common_regex} \title{Common Regular expressions} diff --git a/man/count_missing.Rd b/man/count_missing.Rd deleted file mode 100644 index d668474..0000000 --- a/man/count_missing.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/counts.R -\name{count_missing} -\alias{count_missing} -\title{Count missing values} -\usage{ -count_missing(df, group_vars, x_var) -} -\arguments{ -\item{df}{A \verb{} or \verb{}} - -\item{group_vars}{A \verb{} or \verb{} vector of the variables to -group by} - -\item{x_var}{A \verb{} or \verb{} vector of the variable to count -missing values for} -} -\value{ -A \verb{} or \verb{} with the count of missing values -} -\description{ -Count missing values -} -\examples{ -dplyr::tibble(x = 1:10, - y = 1:10, - z = letters[1:10]) |> - count_missing(z, x) -} diff --git a/man/count_prop.Rd b/man/count_prop.Rd index 9c0c700..62b417d 100644 --- a/man/count_prop.Rd +++ b/man/count_prop.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/counts.R +% Please edit documentation in R/df.R \name{count_prop} \alias{count_prop} \title{Count and calculate proportion of each group} diff --git a/man/count_prop_multi.Rd b/man/count_prop_multi.Rd index b337abf..33c0011 100644 --- a/man/count_prop_multi.Rd +++ b/man/count_prop_multi.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/counts.R +% Please edit documentation in R/df.R \name{count_prop_multi} \alias{count_prop_multi} \title{Count and calculate proportion of each group} diff --git a/man/count_wide.Rd b/man/count_wide.Rd index cde5f7d..3d5e6cd 100644 --- a/man/count_wide.Rd +++ b/man/count_wide.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/counts.R +% Please edit documentation in R/df.R \name{count_wide} \alias{count_wide} \title{Count rows and columns and pivot to wide format} @@ -18,8 +18,6 @@ Count rows and columns and pivot to wide format } \examples{ fuimus:::forager_data(10) |> - count_wide( - c(ins_class), - payer) + count_wide(c(ins_class), payer) } diff --git a/man/df_2_chr.Rd b/man/df_2_chr.Rd index 2a5ffd1..6faa04e 100644 --- a/man/df_2_chr.Rd +++ b/man/df_2_chr.Rd @@ -16,6 +16,10 @@ A \verb{} or \verb{} with numeric columns coerced to charact Coerce numeric columns to character } \examples{ -df_2_chr(dplyr::tibble(x = 20:35)) +dplyr::tibble( + int = 1:10, + chr = letters[1:10], + date = rep(Sys.Date()), nrow(int)) |> +df_2_chr() } diff --git a/man/df_types.Rd b/man/df_types.Rd index b76cab3..39019a0 100644 --- a/man/df_types.Rd +++ b/man/df_types.Rd @@ -13,6 +13,10 @@ df_types(df) Get the types of each column in a data frame } \examples{ -dplyr::tibble(x = 1:10, y = 1:10) |> df_types() +dplyr::tibble( + int = 1:10, + chr = letters[1:10], + date = rep(Sys.Date()), nrow(int)) |> +df_types() } diff --git a/man/display_long.Rd b/man/display_long.Rd index 7bdd55b..42b1c58 100644 --- a/man/display_long.Rd +++ b/man/display_long.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/display_long.R +% Please edit documentation in R/df.R \name{display_long} \alias{display_long} \title{Pivot data frame to long format for easy printing} @@ -18,13 +18,10 @@ a \verb{} or \verb{} in long format Pivot data frame to long format for easy printing } \examples{ -x <- dplyr::tibble( - a = 1:10, - b = letters[1:10], - c = 11:20, - d = LETTERS[1:10], - e = 21:30) - -display_long(x) +dplyr::tibble( + int = 1:10, + chr = letters[1:10], + date = rep(Sys.Date()), nrow(int)) |> +display_long() } diff --git a/man/glue_chr.Rd b/man/glue_chr.Rd index e3eb233..9a76023 100644 --- a/man/glue_chr.Rd +++ b/man/glue_chr.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/string_ops.R +% Please edit documentation in R/wrappers.R \name{glue_chr} \alias{glue_chr} -\title{Wrapper for \code{as.character(glue(x))}} +\title{Wrapper for \code{as.character(glue::glue(x))}} \usage{ glue_chr(...) } @@ -13,5 +13,5 @@ glue_chr(...) \verb{} vector } \description{ -Wrapper for \code{as.character(glue(x))} +Wrapper for \code{as.character(glue::glue(x))} } diff --git a/man/glue_data_chr.Rd b/man/glue_data_chr.Rd index d41bd55..058f67f 100644 --- a/man/glue_data_chr.Rd +++ b/man/glue_data_chr.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/string_ops.R +% Please edit documentation in R/wrappers.R \name{glue_data_chr} \alias{glue_data_chr} -\title{Wrapper for \code{as.character(glue_data(x))}} +\title{Wrapper for \code{as.character(glue::glue_data(x))}} \usage{ glue_data_chr(.x, ...) } @@ -15,5 +15,5 @@ glue_data_chr(.x, ...) \verb{} vector } \description{ -Wrapper for \code{as.character(glue_data(x))} +Wrapper for \code{as.character(glue::glue_data(x))} } diff --git a/man/print_ls.Rd b/man/print_ls.Rd index 01a61fd..bf2bf22 100644 --- a/man/print_ls.Rd +++ b/man/print_ls.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/print_list.R +% Please edit documentation in R/string_ops.R \name{print_ls} \alias{print_ls} \title{Print a named list} diff --git a/man/rename_seq.Rd b/man/rename_seq.Rd index 0810d74..6d61857 100644 --- a/man/rename_seq.Rd +++ b/man/rename_seq.Rd @@ -37,12 +37,12 @@ Generate a sequence of numbers with a new prefix } \examples{ rename_seq( -n = 10, -new = "id_issuer_", -between = " = ", -old = "Other.ID.Issuer.", -enclose = c("x = c(", ")"), -collapse = ",\n ", -style = TRUE) + n = 10, + new = "id_issuer_", + between = " = ", + old = "Other.ID.Issuer.", + enclose = c("x = c(", ")"), + collapse = ",\n ", + style = TRUE) } diff --git a/man/search_in.Rd b/man/search_in.Rd index 223dcb3..9970f1f 100644 --- a/man/search_in.Rd +++ b/man/search_in.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/search_ins.R +% Please edit documentation in R/programming.R \name{search_in} \alias{search_in} \title{Search in data frame} diff --git a/man/search_in_if.Rd b/man/search_in_if.Rd index 7485a0a..c1403d0 100644 --- a/man/search_in_if.Rd +++ b/man/search_in_if.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/search_ins.R +% Please edit documentation in R/programming.R \name{search_in_if} \alias{search_in_if} \title{Search in data frame column if search term is not \code{NULL}} diff --git a/man/search_in_if_args.Rd b/man/search_in_if_args.Rd deleted file mode 100644 index 37fc3b6..0000000 --- a/man/search_in_if_args.Rd +++ /dev/null @@ -1,46 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/search_ins.R -\name{search_in_if_args} -\alias{search_in_if_args} -\title{Search in data frame column if search term is not \code{NULL}} -\usage{ -search_in_if_args(df, dfcol, search, args = NULL, multiple = FALSE) -} -\arguments{ -\item{df}{A \verb{} or \verb{}} - -\item{dfcol}{A \verb{} or \verb{} specifying the column to search in} - -\item{search}{A \verb{} or \verb{} specifying the search term} - -\item{args}{A \verb{} vector of argument options; default is \code{NULL}} - -\item{multiple}{A \verb{} indicating if multiple \code{search} args are -allowed; default is \code{FALSE}} -} -\value{ -A \verb{} or \verb{} -} -\description{ -Search in data frame column if search term is not \code{NULL} -} -\examples{ -x <- dplyr::tibble(y = 1:10, z = letters[1:10]) - -search_in_if_args(df = x, dfcol = x$z, search = c("a", "j")) - -search_in_if_args(df = x, dfcol = x$z, search = NULL) - -search_in_if_args(df = x, - dfcol = x$z, - search = c("a", "j"), - args = c("a", "j"), - multiple = TRUE) - -try(search_in_if_args(df = x, - dfcol = x$z, - search = c("a", "j"), - args = c("a", "z"), - multiple = FALSE)) - -} diff --git a/man/show_missing.Rd b/man/show_missing.Rd deleted file mode 100644 index 3688274..0000000 --- a/man/show_missing.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/counts.R -\name{show_missing} -\alias{show_missing} -\title{Show missing values} -\usage{ -show_missing(df, group_vars, summary_vars = dplyr::everything()) -} -\arguments{ -\item{df}{A \verb{} or \verb{}} - -\item{group_vars}{A \verb{} or \verb{} vector of the variables to -group by} - -\item{summary_vars}{A \verb{} or \verb{} vector of the variables to -summarize; default is \code{\link[dplyr:reexports]{dplyr::everything()}}} -} -\description{ -Show missing values -} -\examples{ -dplyr::tibble(x = 1:10, - y = 1:10, - z = c(letters[1:10])) |> - show_missing(z) - -} diff --git a/man/srchcol.Rd b/man/srchcol.Rd index b8fe9c4..aaa31bf 100644 --- a/man/srchcol.Rd +++ b/man/srchcol.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/search_ins.R +% Please edit documentation in R/programming.R \name{srchcol} \alias{srchcol} \title{Search a data frame column by string}