validation.R
In ruler: Tidy Data Validation Reports

## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.path = "README-"
)

library(ruler, quietly = TRUE, warn.conflicts = FALSE)
library(dplyr, quietly = TRUE, warn.conflicts = FALSE)

# Packs from previous vignette
my_data_packs <- data_packs(
  my_data_pack_1 = . %>% summarise(
    nrow_low = nrow(.) > 10,
    nrow_high = nrow(.) < 30,
    ncol = ncol(.) == 12
  )
)

my_group_packs <- group_packs(
  . %>% group_by(vs, am) %>%
    summarise(any_cyl_6 = any(cyl == 6)),
  .group_vars = c("vs", "am")
)

is_integerish <- function(x) {
  all(x == as.integer(x))
}

my_col_packs <- col_packs(
  my_col_pack_1 = . %>% summarise_if(
    is_integerish,
    rules(mean_low = mean(.) > 0.5)
  ),
  . %>% summarise_at(vars(vs = "vs"), rules(sum(.) > 300))
)

z_score <- function(x) {
  (x - mean(x)) / sd(x)
}

my_row_packs <- row_packs(
  my_row_pack_1 = . %>% mutate(rowMean = rowMeans(.)) %>%
    transmute(is_common_row_mean = abs(z_score(rowMean)) < 1) %>%
    slice(10:15)
)

my_cell_packs <- cell_packs(
  my_cell_pack_1 = . %>% transmute_if(
    is_integerish,
    rules(is_common = abs(z_score(.)) < 1)
  ) %>%
    slice(20:24)
)

## ----Simple expose------------------------------------------------------------
mtcars %>%
  expose(my_group_packs) %>%
  get_exposure()

## ----Expose can not remove obeyers--------------------------------------------
mtcars %>%
  expose(my_group_packs, .remove_obeyers = FALSE) %>%
  get_exposure()

## ----Renaming pack------------------------------------------------------------
mtcars %>%
  expose(new_group_pack = my_group_packs[[1]]) %>%
  get_report()

## ----Two-step expose----------------------------------------------------------
mtcars_one_step <- mtcars %>%
  expose(my_data_packs, my_col_packs)

mtcars_two_step <- mtcars %>%
  expose(my_data_packs) %>%
  expose(my_col_packs)

identical(mtcars_one_step, mtcars_two_step)

## ----Expose can guess---------------------------------------------------------
mtcars %>%
  expose(some_data_pack = . %>% summarise(nrow = nrow(.) == 10)) %>%
  get_exposure()

## ----Expose can change rule separator-----------------------------------------
regular_col_packs <- col_packs(
  . %>% summarise_all(rules(mean(.) > 1))
)

irregular_col_packs <- col_packs(
  . %>% summarise_all(rules(mean(.) > 1, .prefix = "a_a_"))
)

regular_report <- mtcars %>%
  expose(regular_col_packs) %>%
  get_report()

irregular_report <- mtcars %>%
  expose(irregular_col_packs, .rule_sep = inside_punct("a_a_")) %>%
  get_report()

identical(regular_report, irregular_report)

# Note suffix '_' after column names
mtcars %>%
  expose(irregular_col_packs, .rule_sep = "a_a_") %>%
  get_report()

## ----Acting after exposure----------------------------------------------------
trigger_one_pack <- function(.tbl) {
  packs_number <- .tbl %>%
    get_packs_info() %>%
    nrow()

  packs_number > 1
}

actor_one_pack <- function(.tbl) {
  cat("More than one pack was applied.\n")

  invisible(.tbl)
}

mtcars %>%
  expose(my_col_packs, my_row_packs) %>%
  act_after_exposure(
    .trigger = trigger_one_pack,
    .actor = actor_one_pack
  ) %>%
  invisible()