fn_case: Case statements applying a function to all inputs

In incase: Pipe-Friendly Vector Replacement with Case Statements

Case statements applying a function to all inputs

Description

Case statements applying a function to all inputs

Usage

fn_case(x, fn, ..., preserve = FALSE, default = NA)

Arguments

x	A vector
fn	A function to apply to the left-hand side of each formula in ... Either a quoted or unquoted function name, an anonymous function, or a purrr-style formula. The function should take two inputs, the first being x and the second being the left-hand side of the formula. The function should return a logical vector, either of length 1 or the same length as x.
...	<dynamic-dots> A sequence of two-sided formulas or named arguments. Formulas: Elements of x that return TRUE when passed to fn with the left hand side (LHS) of each formula will be replaced with the value in the right hand side (RHS). The LHS must evaluate to a logical vector when passed to fn with x. The RHS must be of length 1 or the same length as all other RHS. Named arguments: named arguments are passed as additional arguments to the function fn.
preserve	If TRUE, unmatched elements of x will be returned unmodified. (The elements may have their type coerced to be compatible with replacement values.) If FALSE, unmatched elements of x will be replaced with default. Defaults to FALSE.
default	If preserve is FALSE, a value to replace unmatched elements of x. Defaults to NA.

Value

A vector of length 1 or n, matching the length of the logical input or output vectors. Inconsistent lengths will generate an error.

See Also

fn_case_fct() to return a factor and fn_case_list() to return a list

fn_switch_case(), which applies a function to each formula's LHS, but not x

switch_case(), a simpler alternative for exact matching

grep_case(), a simpler alternative for regex pattern matching

in_case(), a pipeable alternative to dplyr::case_when()

Examples

# Replicate switch_case()
parties <- sample(c("d", "r", "i", "g", "l"), 20, replace = TRUE)

fn_case(
  parties,
  fn = `%in%`,
  "d" ~ "Democrat",
  "r" ~ "Republican",
  "i" ~ "Independent",
  "g" ~ "Green",
  "l" ~ "Libertarian"
)

# Replicate grep_case()
countries <- c(
  "France", "Ostdeutschland", "Westdeutschland", "Nederland",
  "Belgie (Vlaanderen)", "Belgique (Wallonie)", "Luxembourg", "Italia"
)

fn_case(
  countries,
  fn = function(x, pattern, ...) {grepl(pattern, x, ...)},
  "Deutschland" ~ "Germany",
  "Belgi(qu)?e" ~ "Belgium",
  "Nederland"   ~ "Netherlands",
  "Italia"      ~ "Italy",
  preserve      = TRUE,
  ignore.case   = TRUE
)

fn_case(
  countries,
  fn = ~ grepl(.y, .x),
  "Deutschland" ~ "Germany",
  "Belgi(qu)?e" ~ "Belgium",
  "Nederland"   ~ "Netherlands",
  "Italia"      ~ "Italy",
  preserve      = TRUE,
  ignore.case   = TRUE
)

# Recode values in a range
time    <- runif(10, 1, 12)
hours   <- time %/% 1
minutes <- time %% 1 * 60

hours <- hours %>%
  if_case(minutes > 32.5, (. + 1) %% 12, .) %>%
  switch_case(0 ~ 12, preserve = TRUE)

minutes %>%
  fn_case(
    fn = ~ abs(.x - .y) <= 2.5,
    0  ~ "o'clock",
    60 ~ "o'clock",
    30 ~ "half past",
    15 ~ "quarter past",
    45 ~ "quarter to",
    5  ~ "five past",
    10 ~ "ten past",
    20 ~ "twenty past",
    25 ~ "twenty-five past",
    55 ~ "five to",
    50 ~ "ten to",
    40 ~ "twenty to",
    35 ~ "twenty-five to"
  ) %>%
  switch_case(
    "o'clock" ~ paste(hours, .),
    default   = paste(., hours)
  )

# Replicate vctrs::vec_ptype_abbr() (used for tibble column labels)
# Based on a contribution by Patrice Kiener
in_herits <- function(x) {
  fn_case(
    x,
    fn = inherits,
    "factor"     ~ "fct",
    "character"  ~ "chr",
    "numeric"    ~ "dbl",
    "integer"    ~ "int",
    "logical"    ~ "lgl",
    "complex"    ~ "cpl",
    "raw"        ~ "raw",
    "matrix"     ~ "mat",
    "array"      ~ "arr",
    "data.frame" ~ "df",
    "list"       ~ "lst",
    "function"   ~ "fn",
    default      = class(x)[[1]]
  )
}

in_herits(1:3)
in_herits(letters[1:3])
in_herits(fn_case)

incase documentation built on Aug. 21, 2023, 9:09 a.m.