In RLesur/casewhen: Create Reusable 'dplyr' 'case_when()' Functions

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.path = "man/figures/README-",
  out.width = "100%"
)

casewhen

The goal of casewhen is to create reusable dplyr::case_when() functions.
SAS users may recognise a behavior close to the SAS FORMATS.

Installation

You can install the development version from GitHub with:

# install.packages("devtools")
devtools::install_github("RLesur/casewhen")

Motivation

During data wrangling with dplyr, one may use several times identical case_when() clauses in different steps. This can lead to a non-DRY code.
This package provides a convenient mean to define and reuse dplyr::case_when() functions.

Examples

With casewhen, you can easily create reusable dplyr::case_when() functions with the function create_case_when():

library(dplyr)
library(casewhen)

people <- tribble(
  ~name, ~sex, ~seek,
  "Mary", "F", "M",
  "Henry", "M", "F"
)

cw_sex <- create_case_when(
  x == "F" ~ "Woman",
  x == "M" ~ "Man",
  TRUE ~ as.character(x),
  vars = "x"
)

people %>% 
  mutate(sex_label = cw_sex(sex), 
         seek_label = cw_sex(seek))

Reusing a case_when() function is mainly convenient when the same transformation is performed across different datasets.

cw_sexyverse <- create_case_when(
  x == "F" | x == "female" & y == "Human" ~ "Woman",
  x == "M" | x == "male" & y == "Human" ~ "Man",
  TRUE ~ as.character(x),
  vars = c("x", "y")
)

people %>% 
  mutate(sex_label = cw_sexyverse(sex, "Human"))

starwars %>%
  mutate(sex_label = cw_sexyverse(gender, species)) %>%
  select(name, gender, species, sex_label) %>%
  head()

`dbplyr` support

You only have to register the case_when functions to your connection:

knitr::knit_hooks$set(
  message = function(x, options) {
    x <- sub("<SQL>", "", x)
    x <- gsub("CASE\n", "\n    CASE\n", x, fixed = TRUE)
    x <- gsub("\nWHEN", "\n      WHEN", x, fixed = TRUE)
    x <- gsub("\nEND", "\n    END", x, fixed = TRUE)
    paste0("**`<SQL>`**\n```sql", paste0(x, collapse = "\n"), "```")
  }
)

con <- 
  DBI::dbConnect(RSQLite::SQLite(), ":memory:") %>%
  add_case_when(cw_sex, cw_sexyverse)

people_db <- copy_to(con, people)
starwars_db <- copy_to(con, starwars %>% select(name, gender, species))

people_db %>% 
  mutate(sex_label = cw_sex(sex), 
         seek_label = cw_sex(seek)) %>%
  show_query()

people_db %>%
  mutate(sex_label = cw_sexyverse(sex, "Human")) %>%
  show_query()

starwars_db %>%
  mutate(sex_label = cw_sexyverse(gender, species)) %>%
  show_query()

DBI::dbDisconnect(con)