tests/testthat/test-errors.R

success_result <- function(verb, the_call, columns, row_redux_call, description) {
  row_redux_message <- ""
  if (!is.na(row_redux_call))
    row_redux_message <- paste0(" on ", row_redux_call, " row reduction")
  msg <- paste0("verification [", the_call, "]", row_redux_message, " passed!")
  success <- list(
    verb = verb,
    message = msg,
    call = the_call,
    columns = columns,
    row_redux_call = row_redux_call,
    description = description
  )
  class(success) <- c("assertr_success", "success", "condition")
  list(success)
}

get_assertr_success <- function(assertion) {
  attr(assertion, "assertr_success")
}

test_that("success_append appends varification result to data", {
  expect_equal(
    get_assertr_success(success_append(mtcars, "method", "rule", "column", "redux", NA)),
    success_result("method", "rule", "column", "redux", NA)
  )
})

test_that("success_report works fine with verification methods", {
  # single assert rule outside chain
  expect_output(
    assert(mtcars, in_set(0, 1), am, success_fun=success_report),
    "assert: verification \\[in_set\\(0, 1\\)\\] passed! Verified columns: am "
  )

  # single assert rule inside chain
  expect_output(
    mtcars %>% chain_start(store_success=TRUE) %>% assert(in_set(0, 1), am) %>% chain_end(success_report),
    "1 result verified: \\nassert: verification \\[in_set\\(0, 1\\)\\] passed! Verified columns: am "
  )

  # single assert rule inside chain without store_success
  expect_output(
    mtcars %>% chain_start %>% assert(in_set(0, 1), am) %>% chain_end(success_report),
    "No success results stored."
  )

  # two assert rules outside chain
  expect_output(
    assert(mtcars, in_set(0, 1), am, success_fun=success_report) %>%
      assert(in_set(0, 1), vs, success_fun=success_report),
    paste0(
      "assert: verification \\[in_set\\(0, 1\\)\\] passed! Verified columns: am \\nassert: verification ",
      "\\[in_set\\(0, 1\\)\\] passed! Verified columns: vs "
    )
  )

  # two assert rules inside chain
  expect_output(
    mtcars %>% chain_start(store_success=TRUE) %>%
      assert(in_set(0, 1), am) %>%
      assert(in_set(0, 1), vs) %>%
      chain_end(success_report),
    paste0(
      "2 results verified: \\nassert: verification \\[in_set\\(0, 1\\)\\] passed! Verified columns: am \\nassert: ",
      "verification \\[in_set\\(0, 1\\)\\] passed! Verified columns: vs "
    )
  )

  # two assert rules inside chain without store_success=TRUE
  expect_output(
    mtcars %>% chain_start() %>%
      assert(in_set(0, 1), am) %>%
      assert(in_set(0, 1), vs) %>%
      chain_end(success_report),
    "No success results stored."
  )

  # single verify rule outside chain
  expect_output(
    mtcars %>% verify(drat > 2, success_fun=success_report),
    "verify: verification \\[drat > 2\\] passed!"
  )

  # single verify rule inside chain
  expect_output(
    mtcars %>% chain_start(store_success=TRUE) %>% verify(drat > 2) %>% chain_end(success_report),
    "1 result verified: \\nverify: verification \\[drat > 2\\] passed!"
  )

  # single verify rule inside chain without store_success
  expect_output(
    mtcars %>% chain_start %>% verify(drat > 2) %>% chain_end(success_report),
    "No success results stored."
  )

  # two verify rules outside chain
  expect_output(
    mtcars %>%
    verify(drat > 2, success_fun=success_report) %>%
      verify(am %in% c(0, 1), success_fun=success_report),
    "verify: verification \\[drat > 2\\] passed!\\nverify: verification \\[am %in% c\\(0, 1\\)\\] passed!"
  )

  # two verify rules inside chain
  expect_output(
    mtcars %>% chain_start(store_success=TRUE) %>%
      verify(drat > 2) %>%
      verify(am %in% c(0, 1)) %>%
      chain_end(success_report),
    "2 results verified: \\nverify: verification \\[drat > 2\\] passed!\\nverify: verification \\[am %in% c\\(0, 1\\)\\] passed!"
  )

  # two verify rules inside chain without store_success=TRUE
  expect_output(
    mtcars %>% chain_start() %>%
      verify(drat > 2) %>%
      verify(am %in% c(0, 1)) %>%
      chain_end(success_report),
    "No success results stored."
  )

  # single assert_rows rule outside chain
  expect_output(
    assert_rows(mtcars, rowSums, within_bounds(0,2), vs, am, success_fun=success_report),
    "assert_rows: verification \\[within_bounds\\(0, 2\\)\\] on rowSums row reduction passed! Verified columns: vs am "
  )

  # single assert_rows rule inside chain
  expect_output(
    mtcars %>% chain_start(store_success=TRUE) %>%
      assert_rows(rowSums, within_bounds(0,2), vs, am, success_fun=success_report) %>%
      chain_end(success_report),
    paste0(
      "1 result verified: \\nassert_rows: verification \\[within_bounds\\(0, 2\\)\\] on rowSums row reduction passed! ",
      "Verified columns: vs am ")
  )

  # single assert_rows rule inside chain without store_success
  expect_output(
    mtcars %>% chain_start %>% assert_rows(rowSums, within_bounds(0,2), vs, am) %>% chain_end(success_report),
    "No success results stored."
  )

  # two assert_rows rules outside chain
  expect_output(
    mtcars %>%
      assert_rows(rowSums, within_bounds(0,2), vs, am, success_fun=success_report) %>%
      assert_rows(num_row_NAs, within_bounds(0,.1), vs, am, success_fun=success_report),
    paste0(
      "assert_rows: verification \\[within_bounds\\(0, 2\\)\\] on rowSums row reduction passed! Verified columns: vs am ",
      "\\nassert_rows: verification \\[within_bounds\\(0, 0.1\\)\\] on num_row_NAs row reduction passed! Verified columns: vs am "
    )

  )

  # two assert_rows rules inside chain
  expect_output(
    mtcars %>% chain_start(store_success=TRUE) %>%
      assert_rows(rowSums, within_bounds(0,2), vs, am, success_fun=success_report) %>%
      assert_rows(num_row_NAs, within_bounds(0,.1), vs, am, success_fun=success_report) %>%
      chain_end(success_report),
    paste0(
      "2 results verified: \\nassert_rows: verification \\[within_bounds\\(0, 2\\)\\] on rowSums row reduction passed! ",
      "Verified columns: vs am \\nassert_rows: verification \\[within_bounds\\(0, 0.1\\)\\] on num_row_NAs row reduction ",
      "passed! Verified columns: vs am "
    )
  )

  # two assert_rows rules inside chain without store_success=TRUE
  expect_output(
    mtcars %>% chain_start() %>%
      verify(drat > 2) %>%
      verify(am %in% c(0, 1)) %>%
      chain_end(success_report),
    "No success results stored."
  )

  # single insist rule outside chain
  expect_output(
    insist(mtcars, within_n_sds(5), vs, success_fun=success_report),
    "insist: verification \\[within_n_sds\\(5\\)\\] passed! Verified columns: vs "
  )

  # single insist rule inside chain
  expect_output(
    mtcars %>% chain_start(store_success=TRUE) %>%
      insist(within_n_sds(5), vs, success_fun=success_report) %>%
      chain_end(success_report),
    "1 result verified: \\ninsist: verification \\[within_n_sds\\(5\\)\\] passed! Verified columns: vs "
  )

  # single insist rule inside chain without store_success
  expect_output(
    mtcars %>% chain_start %>% insist(within_n_sds(5), vs) %>% chain_end(success_report),
    "No success results stored."
  )

  # two insist rules outside chain
  expect_output(
    mtcars %>%
      insist(within_n_sds(5), vs, success_fun=success_report) %>%
      insist(within_n_sds(5), am, success_fun=success_report),
    paste0(
      "insist: verification \\[within_n_sds\\(5\\)\\] passed! Verified columns: vs \\n",
      "insist: verification \\[within_n_sds\\(5\\)\\] passed! Verified columns: am "
    )
  )

  # two insist rules inside chain
  expect_output(
    mtcars %>% chain_start(store_success=TRUE) %>%
      insist(within_n_sds(5), vs, success_fun=success_report) %>%
      insist(within_n_sds(5), am, success_fun=success_report) %>%
      chain_end(success_report),
    paste0(
      "2 results verified: \\n",
      "insist: verification \\[within_n_sds\\(5\\)\\] passed! Verified columns: vs \\n",
      "insist: verification \\[within_n_sds\\(5\\)\\] passed! Verified columns: am "
    )
  )

  # two insist rules inside chain without store_success=TRUE
  expect_output(
    mtcars %>% chain_start() %>%
      insist(within_n_sds(5), vs) %>%
      insist(within_n_sds(5), am) %>%
      chain_end(success_report),
    "No success results stored."
  )

  # single insist_rows rule outside chain
  expect_output(
    insist_rows(iris, maha_dist, within_n_sds(6), Sepal.Length:Petal.Length, success_fun=success_report),
    "insist_rows: verification \\[within_n_sds\\(6\\)\\] on maha_dist row reduction passed! Verified columns: Sepal.Length Sepal.Width Petal.Length "
  )

  # single insist_rows rule inside chain
  expect_output(
    iris %>% chain_start(store_success=TRUE) %>%
      insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length) %>%
      chain_end(success_report),
    paste0(
      "1 result verified: \\ninsist_rows: verification \\[within_n_sds\\(6\\)\\] on maha_dist row reduction passed! ",
      "Verified columns: Sepal.Length Sepal.Width Petal.Length "
    )
  )

  # single insist_rows rule inside chain without store_success
  expect_output(
    iris %>% chain_start %>% insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length) %>% chain_end(success_report),
    "No success results stored."
  )

  # two insist_rows rules outside chain
  expect_output(
    iris %>%
      insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length, success_fun=success_report) %>%
      insist_rows(maha_dist, within_n_sds(7), Sepal.Length:Petal.Length, success_fun=success_report),
    paste0(
      "insist_rows: verification \\[within_n_sds\\(6\\)\\] on maha_dist row reduction passed! ",
      "Verified columns: Sepal.Length Sepal.Width Petal.Length \\n",
      "insist_rows: verification \\[within_n_sds\\(7\\)\\] on maha_dist row reduction passed! ",
      "Verified columns: Sepal.Length Sepal.Width Petal.Length "
    )
  )

  # two insist_rows rules inside chain
  expect_output(
    iris %>% chain_start(store_success=TRUE) %>%
      insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length) %>%
      insist_rows(maha_dist, within_n_sds(7), Sepal.Length:Petal.Length) %>%
      chain_end(success_report),
    paste0(
      "2 results verified: \\n",
      "insist_rows: verification \\[within_n_sds\\(6\\)\\] on maha_dist row reduction passed! ",
      "Verified columns: Sepal.Length Sepal.Width Petal.Length \\n",
      "insist_rows: verification \\[within_n_sds\\(7\\)\\] on maha_dist row reduction passed! ",
      "Verified columns: Sepal.Length Sepal.Width Petal.Length "
    )
  )

  # two insist_rows rules inside chain without store_success=TRUE
  expect_output(
    iris %>% chain_start() %>%
      insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length) %>%
      insist_rows(maha_dist, within_n_sds(7), Sepal.Length:Petal.Length) %>%
      chain_end(success_report),
    "No success results stored."
  )

})

success_df <- function(verb, message, call, columns, row_redux_call, description) {
  data.frame(
    verb = verb,
    message = message,
    call = call,
    columns = columns,
    row_redux_call = row_redux_call,
    description = description,
    stringsAsFactors = FALSE
  )
}

test_that("success_df_return works fine with verification methods", {
  # single assert rule outside chain
  expect_equal(
    assert(mtcars, in_set(0, 1), am, success_fun=success_df_return),
    success_df("assert", "verification [in_set(0, 1)] passed!", "in_set(0, 1)", "am", NA, NA)
  )

  # single assert rule inside chain
  expect_equal(
    mtcars %>% chain_start(store_success=TRUE) %>% assert(in_set(0, 1), am) %>% chain_end(success_df_return),
    success_df("assert", "verification [in_set(0, 1)] passed!", "in_set(0, 1)", "am", NA, NA)
  )

  # single assert rule inside chain without store_success
  expect_error(
    mtcars %>% chain_start %>% assert(in_set(0, 1), am) %>% chain_end(success_df_return),
    "No success results stored."
  )

  # two assert rules inside chain
  expect_equal(
    mtcars %>% chain_start(store_success=TRUE) %>%
      assert(in_set(0, 1), am) %>%
      assert(in_set(0, 1), vs) %>%
      chain_end(success_df_return),
    success_df(
      rep("assert", 2), rep("verification [in_set(0, 1)] passed!", 2),
      rep("in_set(0, 1)", 2), c("am", "vs"), rep(NA, 2), rep(NA, 2))
  )

  # two assert rules inside chain without store_success=TRUE
  expect_error(
    mtcars %>% chain_start() %>%
      assert(in_set(0, 1), am) %>%
      assert(in_set(0, 1), vs) %>%
      chain_end(success_df_return),
    "No success results stored."
  )

  # single verify rule outside chain
  expect_equal(
    mtcars %>% verify(drat > 2, success_fun=success_df_return),
    success_df("verify", "verification [drat > 2] passed!", "drat > 2", NA, NA, NA)
  )

  # single verify rule inside chain
  expect_equal(
    mtcars %>% chain_start(store_success=TRUE) %>% verify(drat > 2) %>% chain_end(success_df_return),
    success_df("verify", "verification [drat > 2] passed!", "drat > 2", NA, NA, NA)
  )

  # single verify rule inside chain without store_success
  expect_error(
    mtcars %>% chain_start %>% verify(drat > 2) %>% chain_end(success_df_return),
    "No success results stored."
  )

  # two verify rules inside chain
  expect_equal(
    mtcars %>% chain_start(store_success=TRUE) %>%
      verify(drat > 2) %>%
      verify(am %in% c(0, 1)) %>%
      chain_end(success_df_return),
    success_df(
      rep("verify", 2), c("verification [drat > 2] passed!", "verification [am %in% c(0, 1)] passed!"),
      c("drat > 2", "am %in% c(0, 1)"), rep(NA, 2), rep(NA, 2), rep(NA, 2))
  )

  # two verify rules inside chain without store_success=TRUE
  expect_error(
    mtcars %>% chain_start() %>%
      verify(drat > 2) %>%
      verify(am %in% c(0, 1)) %>%
      chain_end(success_df_return),
    "No success results stored."
  )

  # single assert_rows rule outside chain
  expect_equal(
    assert_rows(mtcars, rowSums, within_bounds(0,2), vs, am, success_fun=success_df_return),
    success_df(
      "assert_rows", "verification [within_bounds(0, 2)] on rowSums row reduction passed!",
      "within_bounds(0, 2)", "vs, am", "rowSums", NA)
  )

  # single assert_rows rule inside chain
  expect_equal(
    mtcars %>% chain_start(store_success=TRUE) %>%
      assert_rows(rowSums, within_bounds(0,2), vs, am) %>%
      chain_end(success_df_return),
    success_df(
      "assert_rows", "verification [within_bounds(0, 2)] on rowSums row reduction passed!",
      "within_bounds(0, 2)", "vs, am", "rowSums", NA)
  )

  # single assert_rows rule inside chain without store_success
  expect_error(
    mtcars %>% chain_start %>% assert_rows(rowSums, within_bounds(0,2), vs, am) %>% chain_end(success_df_return),
    "No success results stored."
  )

  # two assert_rows rules inside chain
  expect_equal(
    mtcars %>% chain_start(store_success=TRUE) %>%
      assert_rows(rowSums, within_bounds(0,2), vs, am) %>%
      assert_rows(num_row_NAs, within_bounds(0,.1), vs, am) %>%
      chain_end(success_df_return),
    success_df(
      rep("assert_rows", 2),
      c("verification [within_bounds(0, 2)] on rowSums row reduction passed!", "verification [within_bounds(0, 0.1)] on num_row_NAs row reduction passed!"),
      c("within_bounds(0, 2)", "within_bounds(0, 0.1)"), rep("vs, am", 2), c("rowSums", "num_row_NAs"), rep(NA, 2)
    )
  )

  # two assert_rows rules inside chain without store_success=TRUE
  expect_error(
    mtcars %>% chain_start() %>%
      verify(drat > 2) %>%
      verify(am %in% c(0, 1)) %>%
      chain_end(success_df_return),
    "No success results stored."
  )

  # single insist rule outside chain
  expect_equal(
    insist(mtcars, within_n_sds(5), vs, success_fun=success_df_return),
    success_df("insist", "verification [within_n_sds(5)] passed!", "within_n_sds(5)", "vs", NA, NA)
  )

  # single insist rule inside chain
  expect_equal(
    mtcars %>% chain_start(store_success=TRUE) %>%
      insist(within_n_sds(5), vs) %>%
      chain_end(success_df_return),
    success_df("insist", "verification [within_n_sds(5)] passed!", "within_n_sds(5)", "vs", NA, NA)
  )

  # single insist rule inside chain without store_success
  expect_error(
    mtcars %>% chain_start %>% insist(within_n_sds(5), vs) %>% chain_end(success_df_return),
    "No success results stored."
  )

  # two insist rules inside chain
  expect_equal(
    mtcars %>% chain_start(store_success=TRUE) %>%
      insist(within_n_sds(5), vs) %>%
      insist(within_n_sds(5), am) %>%
      chain_end(success_df_return),
    success_df(
      rep("insist", 2), rep("verification [within_n_sds(5)] passed!", 2), rep("within_n_sds(5)", 2), c("vs", "am"), rep(NA, 2), rep(NA, 2)
    )
  )

  # two insist rules inside chain without store_success=TRUE
  expect_error(
    mtcars %>% chain_start() %>%
      insist(within_n_sds(5), vs) %>%
      insist(within_n_sds(5), am) %>%
      chain_end(success_df_return),
    "No success results stored."
  )

  # single insist_rows rule outside chain
  expect_equal(
    insist_rows(iris, maha_dist, within_n_sds(6), Sepal.Length:Petal.Length, success_fun=success_df_return),
    success_df("insist_rows", "verification [within_n_sds(6)] on maha_dist row reduction passed!", "within_n_sds(6)",
               "Sepal.Length, Sepal.Width, Petal.Length", "maha_dist", NA)
  )

  # single insist_rows rule inside chain
  expect_equal(
    iris %>% chain_start(store_success=TRUE) %>%
      insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length) %>%
      chain_end(success_df_return),
    success_df("insist_rows", "verification [within_n_sds(6)] on maha_dist row reduction passed!", "within_n_sds(6)",
               "Sepal.Length, Sepal.Width, Petal.Length", "maha_dist", NA)
  )

  # single insist_rows rule inside chain without store_success
  expect_error(
    iris %>% chain_start %>% insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length) %>% chain_end(success_df_return),
    "No success results stored."
  )

  # two insist_rows rules inside chain
  expect_equal(
    iris %>% chain_start(store_success=TRUE) %>%
      insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length) %>%
      insist_rows(maha_dist, within_n_sds(7), Sepal.Length:Petal.Length) %>%
      chain_end(success_df_return),
    rbind(
      success_df("insist_rows", "verification [within_n_sds(6)] on maha_dist row reduction passed!", "within_n_sds(6)",
                 "Sepal.Length, Sepal.Width, Petal.Length", "maha_dist", NA),
      success_df("insist_rows", "verification [within_n_sds(7)] on maha_dist row reduction passed!", "within_n_sds(7)",
                 "Sepal.Length, Sepal.Width, Petal.Length", "maha_dist", NA)
    )
  )

  # two insist_rows rules inside chain without store_success=TRUE
  expect_error(
    iris %>% chain_start %>%
      insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length) %>%
      insist_rows(maha_dist, within_n_sds(7), Sepal.Length:Petal.Length) %>%
      chain_end(success_df_return),
    "No success results stored."
  )

})


# defects

defect_result <- function(verb, the_call, columns, row_redux_call, description) {
  row_redux_message <- ""
  if (!is.na(row_redux_call))
    row_redux_message <- paste0(" on ", row_redux_call, " row reduction")
  msg <- paste0("verification [", the_call, "]", row_redux_message, " omitted due to data defect!")
  defect <- list(
    verb = verb,
    message = msg,
    call = the_call,
    columns = columns,
    row_redux_call = row_redux_call,
    description = description
  )
  class(defect) <- c("assertr_defect", "defect", "condition")
  list(defect)
}

get_assertr_defect <- function(assertion) {
  attr(assertion, "assertr_defect")
}

test_that("success_defect appends omitted verification due to defect of data", {
  expect_equal(
    get_assertr_defect(defect_append(NULL, mtcars, "method", "rule", "column", "redux", NA)),
    defect_result("method", "rule", "column", "redux", NA)
  )
})

test_that("defect_report works fine with verification methods", {
  defective_data <- mtcars %>%
    assert(in_set(0, 2), vs, obligatory=TRUE, error_fun=error_append)
  defective_data_in_chain <- mtcars %>% chain_start() %>%
    assert(in_set(0, 2), vs, obligatory=TRUE)
  not_defective_data <- mtcars %>%
    assert(in_set(0, 2), vs, error_fun=error_append)
  not_defective_data_in_chain <- mtcars %>% chain_start() %>%
    assert(in_set(0, 2), vs)

  # single assert rule on defective data outside chain
  expect_output(
    defective_data %>%
      assert(in_set(0, 1), am, defect_fun=defect_report),
    "assert: verification \\[in_set\\(0, 1\\)\\] omitted due to data defect! Columns passed to assertion: am "
  )

  # single assert rule on defective data inside chain
  expect_output(
    defective_data_in_chain %>%
      assert(in_set(0, 1), am) %>%
      chain_end(error_fun=defect_report),
    "1 assertion omitted: \\nassert: verification \\[in_set\\(0, 1\\)\\] omitted due to data defect! Columns passed to assertion: am "
  )

  # single assert rule inside chain without marking rule as obligatory
  expect_output(
    not_defective_data_in_chain %>% chain_end(error_fun=defect_report),
    "No rules run on defective data."
  )

  # two assert rules on defective data outside chain
  expect_output(
    defective_data %>%
      assert(in_set(0, 1), am, defect_fun=defect_report) %>%
      assert(in_set(0, 1), vs, defect_fun=defect_report),
    paste0(
      "assert: verification \\[in_set\\(0, 1\\)\\] omitted due to data defect! Columns passed to assertion: am \\n",
      "assert: verification \\[in_set\\(0, 1\\)\\] omitted due to data defect! Columns passed to assertion: vs "
    )
  )

  # two assert rule on defective data inside chain
  expect_output(
    defective_data_in_chain %>%
      assert(in_set(0, 1), am) %>%
      assert(in_set(0, 1), vs) %>%
      chain_end(error_fun=defect_report),
    paste0(
      "2 assertions omitted: \\n",
      "assert: verification \\[in_set\\(0, 1\\)\\] omitted due to data defect! Columns passed to assertion: am \\n",
      "assert: verification \\[in_set\\(0, 1\\)\\] omitted due to data defect! Columns passed to assertion: vs "
    )
  )

  # two assert rule on defective data inside chain without store_success=TRUE
  expect_output(
    not_defective_data_in_chain %>%
      assert(in_set(0, 1), vs) %>%
      chain_end(error_fun=defect_report),
    "No rules run on defective data."
  )

  # single verify rule on defective data outside chain
  expect_output(
    defective_data %>%
      verify(drat > 2, defect_fun=defect_report),
    "verify: verification \\[drat > 2\\] omitted due to data defect!"
  )

  # single verify rule on defective data inside chain
  expect_output(
    defective_data_in_chain %>% verify(drat > 2) %>% chain_end(error_fun=defect_report),
    "1 assertion omitted: \\nverify: verification \\[drat > 2\\] omitted due to data defect!"
  )

  # single verify rule on not defective data inside chain
  expect_output(
    not_defective_data_in_chain %>% verify(drat > 2) %>% chain_end(error_fun=defect_report),
    "No rules run on defective data."
  )

  # two verify rules on defective data outside chain
  expect_output(
    defective_data %>%
      verify(drat > 2, defect_fun=defect_report) %>%
      verify(am %in% c(0, 1), defect_fun=defect_report),
    "verify: verification \\[drat > 2\\] omitted due to data defect!\\nverify: verification \\[am %in% c\\(0, 1\\)\\] omitted due to data defect!"
  )

  # two verify rules on defective data inside chain
  expect_output(
    defective_data_in_chain %>%
      verify(drat > 2) %>%
      verify(am %in% c(0, 1)) %>%
      chain_end(error_fun=defect_report),
    paste0(
      "2 assertions omitted: \\n",
      "verify: verification \\[drat > 2\\] omitted due to data defect!\\n",
      "verify: verification \\[am %in% c\\(0, 1\\)\\] omitted due to data defect!"
    )
  )

  # two verify rules on not defective data inside chain
  expect_output(
    not_defective_data_in_chain %>%
      verify(drat > 2) %>%
      verify(am %in% c(0, 1)) %>%
      chain_end(error_fun=defect_report),
    "No rules run on defective data."
  )

  # single assert_rows defective rule outside chain
  expect_output(
    defective_data %>%
    assert_rows(rowSums, within_bounds(0,2), vs, am, defect_fun=defect_report),
    "assert_rows: verification \\[within_bounds\\(0, 2\\)\\] on rowSums row reduction omitted due to data defect! Columns passed to assertion: vs am "
  )

  # single assert_rows defective rule inside chain
  expect_output(
    defective_data_in_chain %>%
      assert_rows(rowSums, within_bounds(0,2), vs, am) %>%
      chain_end(error_fun=defect_report),
    paste0(
      "1 assertion omitted: \\nassert_rows: verification \\[within_bounds\\(0, 2\\)\\] on rowSums row reduction omitted due to data defect! ",
      "Columns passed to assertion: vs am ")
  )

  # single assert_rows on not defective data inside chain
  expect_output(
    not_defective_data_in_chain %>% assert_rows(rowSums, within_bounds(0,2), vs, am) %>% chain_end(error_fun=defect_report),
    "No rules run on defective data."
  )

  # two assert_rows rule on defective data outside chain
  expect_output(
    defective_data %>%
      assert_rows(rowSums, within_bounds(0,2), vs, am, defect_fun=defect_report) %>%
      assert_rows(num_row_NAs, within_bounds(0,.1), vs, am, defect_fun=defect_report),
    paste0(
      "assert_rows: verification \\[within_bounds\\(0, 2\\)\\] on rowSums row reduction omitted due to data defect! Columns passed to assertion: vs am ",
      "\\nassert_rows: verification \\[within_bounds\\(0, 0.1\\)\\] on num_row_NAs row reduction omitted due to data defect! Columns passed to assertion: vs am "
    )
  )

  # two assert_rows rules on defective data inside chain
  expect_output(
    defective_data_in_chain %>%
      assert_rows(rowSums, within_bounds(0,2), vs, am) %>%
      assert_rows(num_row_NAs, within_bounds(0,.1), vs, am) %>%
      chain_end(error_fun=defect_report),
    paste0(
      "2 assertions omitted: \\nassert_rows: verification \\[within_bounds\\(0, 2\\)\\] on rowSums row reduction omitted due to data defect! ",
      "Columns passed to assertion: vs am \\nassert_rows: verification \\[within_bounds\\(0, 0.1\\)\\] on num_row_NAs row reduction ",
      "omitted due to data defect! Columns passed to assertion: vs am "
    )
  )

  # two assert_rows rule on not defective data inside chain
  expect_output(
    not_defective_data_in_chain %>%
      assert_rows(rowSums, within_bounds(0,2), vs, am) %>%
      assert_rows(num_row_NAs, within_bounds(0,.1), vs, am) %>%
      chain_end(error_fun=defect_report),
    "No rules run on defective data."
  )

  # single insist rule on defective data outside chain
  expect_output(
    defective_data %>%
      insist(within_n_sds(5), vs, defect_fun=defect_report),
    "insist: verification \\[within_n_sds\\(5\\)\\] omitted due to data defect! Columns passed to assertion: vs "
  )

  # single insist rule on defective data inside chain
  expect_output(
    defective_data_in_chain %>%
      insist(within_n_sds(5), vs) %>%
      chain_end(error_fun=defect_report),
    "1 assertion omitted: \\ninsist: verification \\[within_n_sds\\(5\\)\\] omitted due to data defect! Columns passed to assertion: vs "
  )

  # single insist rule on non defective data inside chain
  expect_output(
    not_defective_data_in_chain %>% insist(within_n_sds(5), vs) %>% chain_end(error_fun=defect_report),
    "No rules run on defective data."
  )

  # two insist rule on defective data outside chain
  expect_output(
    defective_data %>%
      insist(within_n_sds(5), vs, defect_fun=defect_report) %>%
      insist(within_n_sds(5), am, defect_fun=defect_report),
    paste0(
      "insist: verification \\[within_n_sds\\(5\\)\\] omitted due to data defect! Columns passed to assertion: vs \\n",
      "insist: verification \\[within_n_sds\\(5\\)\\] omitted due to data defect! Columns passed to assertion: am "
    )
  )

  # two insist rule on defective data inside chain
  expect_output(
    defective_data_in_chain %>%
      insist(within_n_sds(5), vs) %>%
      insist(within_n_sds(5), am) %>%
      chain_end(error_fun=defect_report),
    paste0(
      "2 assertions omitted: \\n",
      "insist: verification \\[within_n_sds\\(5\\)\\] omitted due to data defect! Columns passed to assertion: vs \\n",
      "insist: verification \\[within_n_sds\\(5\\)\\] omitted due to data defect! Columns passed to assertion: am "
    )
  )

  # two insist rule on non defective data inside chain
  expect_output(
    not_defective_data_in_chain %>%
      insist(within_n_sds(5), vs) %>%
      insist(within_n_sds(5), am) %>%
      chain_end(error_fun=defect_report),
    "No rules run on defective data."
  )

  # single insist_rows on defective data outside chain
  expect_output(
    iris %>%
      insist_rows(maha_dist, within_n_sds(3), Sepal.Length:Petal.Length, obligatory=TRUE, error_fun=error_append) %>%
      insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length, defect_fun=defect_report),
    "insist_rows: verification \\[within_n_sds\\(6\\)\\] on maha_dist row reduction omitted due to data defect! Columns passed to assertion: Sepal.Length:Petal.Length "
  )

  # single insist_rows on defective data inside chain
  expect_output(
    iris %>% chain_start %>%
      insist_rows(maha_dist, within_n_sds(3), Sepal.Length:Petal.Length, obligatory=TRUE) %>%
      insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length) %>%
      chain_end(error_fun=defect_report),
    paste0(
      "1 assertion omitted: \\ninsist_rows: verification \\[within_n_sds\\(6\\)\\] on maha_dist row reduction omitted due to data defect! ",
      "Columns passed to assertion: Sepal.Length:Petal.Length "
    )
  )

  # single insist_rows on not defective data inside chain
  expect_output(
    iris %>% chain_start %>%
      insist_rows(maha_dist, within_n_sds(3), Sepal.Length:Petal.Length, error_fun=error_append) %>%
      insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length) %>% chain_end(error_fun=defect_report),
    "No rules run on defective data."
  )

  # two insist_rows rule on not defective data outside chain
  expect_silent(
    iris %>%
      insist_rows(maha_dist, within_n_sds(3), Sepal.Length:Petal.Length, error_fun=error_append) %>%
      insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length, defect_fun=defect_report) %>%
      insist_rows(maha_dist, within_n_sds(7), Sepal.Length:Petal.Length, defect_fun=defect_report)
  )

  # two insist_rows rule on defective data inside chain
  expect_output(
    iris %>% chain_start %>%
      insist_rows(maha_dist, within_n_sds(3), Sepal.Length:Petal.Length, obligatory=TRUE, error_fun=error_append) %>%
      insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length) %>%
      insist_rows(maha_dist, within_n_sds(7), Sepal.Length:Petal.Length) %>%
      chain_end(error_fun=defect_report),
    paste0(
      "2 assertions omitted: \\n",
      "insist_rows: verification \\[within_n_sds\\(6\\)\\] on maha_dist row reduction omitted due to data defect! ",
      "Columns passed to assertion: Sepal.Length:Petal.Length \\n",
      "insist_rows: verification \\[within_n_sds\\(7\\)\\] on maha_dist row reduction omitted due to data defect! ",
      "Columns passed to assertion: Sepal.Length:Petal.Length "
    )
  )

  # two insist_rows rule on non defective data inside chain
  expect_output(
    iris %>% chain_start %>%
      insist_rows(maha_dist, within_n_sds(3), Sepal.Length:Petal.Length, error_fun=error_append) %>%
      insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length) %>%
      insist_rows(maha_dist, within_n_sds(7), Sepal.Length:Petal.Length) %>%
      chain_end(error_fun=defect_report),
    "No rules run on defective data."
  )

})

defect_df <- function(verb, message, call, columns, row_redux_call, description) {
  data.frame(
    verb = verb,
    message = message,
    call = call,
    columns = columns,
    row_redux_call = row_redux_call,
    description = description,
    stringsAsFactors = FALSE
  )
}

test_that("defect_df_return works fine with verification methods", {
  defective_data <- mtcars %>%
    assert(in_set(0, 2), vs, obligatory=TRUE, error_fun=error_append)
  defective_data_in_chain <- mtcars %>% chain_start() %>%
    assert(in_set(0, 2), vs, obligatory=TRUE)
  not_defective_data <- mtcars %>%
    assert(in_set(0, 2), vs, error_fun=error_append)
  not_defective_data_in_chain <- mtcars %>% chain_start() %>%
    assert(in_set(0, 2), vs)

  # single assert rule outside chain
  expect_equal(
    defective_data %>%
    assert(in_set(0, 1), am, defect_fun=defect_df_return),
    defect_df("assert", "verification [in_set(0, 1)] omitted due to data defect!", "in_set(0, 1)", "am", NA, NA)
  )

  # single assert rule inside chain
  expect_equal(
    defective_data_in_chain %>% assert(in_set(0, 1), am) %>% chain_end(error_fun=defect_df_return),
    defect_df("assert", "verification [in_set(0, 1)] omitted due to data defect!", "in_set(0, 1)", "am", NA, NA)
  )

  # single assert rule on not defective data inside chain
  expect_error(
    not_defective_data_in_chain %>% assert(in_set(0, 1), am) %>% chain_end(error_fun=defect_df_return),
    "No rules run on defective data."
  )

  # two assert rules on defective data inside chain
  expect_equal(
    defective_data_in_chain %>%
      assert(in_set(0, 1), am) %>%
      assert(in_set(0, 1), vs) %>%
      chain_end(error_fun=defect_df_return),
    defect_df(
      rep("assert", 2), rep("verification [in_set(0, 1)] omitted due to data defect!", 2),
      rep("in_set(0, 1)", 2), c("am", "vs"), rep(NA, 2), rep(NA, 2))
  )

  # two assert rules on not defective data inside chain
  expect_error(
    not_defective_data_in_chain %>%
      assert(in_set(0, 1), am) %>%
      assert(in_set(0, 1), vs) %>%
      chain_end(error_fun=defect_df_return),
    "No rules run on defective data."
  )

  # single verify rule on defective data outside chain
  expect_equal(
    defective_data %>% verify(drat > 2, defect_fun=defect_df_return),
    defect_df("verify", "verification [drat > 2] omitted due to data defect!", "drat > 2", NA, NA, NA)
  )

  # single verify rule on defective data inside chain
  expect_equal(
    defective_data_in_chain %>% verify(drat > 2) %>% chain_end(error_fun=defect_df_return),
    defect_df("verify", "verification [drat > 2] omitted due to data defect!", "drat > 2", NA, NA, NA)
  )

  # single verify rule on not defective data inside chain without store_defect
  expect_error(
    not_defective_data_in_chain %>% verify(drat > 2) %>% chain_end(error_fun=defect_df_return),
    "No rules run on defective data."
  )

  # two verify rules on defective data inside chain
  expect_equal(
    defective_data_in_chain %>%
      verify(drat > 2) %>%
      verify(am %in% c(0, 1)) %>%
      chain_end(error_fun=defect_df_return),
    defect_df(
      rep("verify", 2), c("verification [drat > 2] omitted due to data defect!", "verification [am %in% c(0, 1)] omitted due to data defect!"),
      c("drat > 2", "am %in% c(0, 1)"), rep(NA, 2), rep(NA, 2), rep(NA, 2))
  )

  # two verify rules on not defective data inside
  expect_error(
    not_defective_data_in_chain %>%
      verify(drat > 2) %>%
      verify(am %in% c(0, 1)) %>%
      chain_end(error_fun=defect_df_return),
    "No rules run on defective data."
  )

  # single assert_rows rule on defective data outside chain
  expect_equal(
    defective_data %>%
      assert_rows(rowSums, within_bounds(0,2), vs, am, defect_fun=defect_df_return),
    defect_df("assert_rows", "verification [within_bounds(0, 2)] on rowSums row reduction omitted due to data defect!",
              "within_bounds(0, 2)", "vs, am", "rowSums", NA)
  )

  # single assert_rows rule on defective data inside chain
  expect_equal(
    defective_data_in_chain %>%
      assert_rows(rowSums, within_bounds(0,2), vs, am) %>%
      chain_end(error_fun=defect_df_return),
    defect_df("assert_rows", "verification [within_bounds(0, 2)] on rowSums row reduction omitted due to data defect!",
              "within_bounds(0, 2)", "vs, am", "rowSums", NA)
  )

  # single assert_rows rule on defective data inside chain without store_defect
  expect_error(
    not_defective_data_in_chain %>% assert_rows(rowSums, within_bounds(0,2), vs, am) %>% chain_end(error_fun=defect_df_return),
    "No rules run on defective data."
  )

  # two assert_rows rules on defective data inside chain
  expect_equal(
    defective_data_in_chain %>%
      assert_rows(rowSums, within_bounds(0,2), vs, am) %>%
      assert_rows(num_row_NAs, within_bounds(0,.1), vs, am) %>%
      chain_end(error_fun=defect_df_return),
    defect_df(
      rep("assert_rows", 2),
      c("verification [within_bounds(0, 2)] on rowSums row reduction omitted due to data defect!", "verification [within_bounds(0, 0.1)] on num_row_NAs row reduction omitted due to data defect!"),
      c("within_bounds(0, 2)", "within_bounds(0, 0.1)"), rep("vs, am", 2), c("rowSums", "num_row_NAs"), rep(NA, 2)
    )
  )

  # two assert_rows rules on defective data inside chain without store_defect=TRUE
  expect_error(
    not_defective_data_in_chain %>%
      verify(drat > 2) %>%
      verify(am %in% c(0, 1)) %>%
      chain_end(error_fun=defect_df_return),
    "No rules run on defective data."
  )

  # single insist rule on defective data outside chain
  expect_equal(
    defective_data %>%
      insist(within_n_sds(5), vs, defect_fun=defect_df_return),
    defect_df("insist", "verification [within_n_sds(5)] omitted due to data defect!", "within_n_sds(5)", "vs", NA, NA)
  )

  # single insist rule on defective data inside chain
  expect_equal(
    defective_data_in_chain %>%
      insist(within_n_sds(5), vs) %>%
      chain_end(error_fun=defect_df_return),
    defect_df("insist", "verification [within_n_sds(5)] omitted due to data defect!", "within_n_sds(5)", "vs", NA, NA)
  )

  # single insist rule on defective data inside chain without store_defect
  expect_error(
    not_defective_data_in_chain %>% insist(within_n_sds(5), vs) %>% chain_end(error_fun=defect_df_return),
    "No rules run on defective data."
  )

  # two insist rules on defective data inside chain
  expect_equal(
    defective_data_in_chain %>%
      insist(within_n_sds(5), vs) %>%
      insist(within_n_sds(5), am) %>%
      chain_end(error_fun=defect_df_return),
    defect_df(
      rep("insist", 2), rep("verification [within_n_sds(5)] omitted due to data defect!", 2), rep("within_n_sds(5)", 2), c("vs", "am"), rep(NA, 2), rep(NA, 2)
    )
  )

  # two insist rules on defective data inside chain without store_defect=TRUE
  expect_error(
    not_defective_data_in_chain %>%
      insist(within_n_sds(5), vs) %>%
      insist(within_n_sds(5), am) %>%
      chain_end(error_fun=defect_df_return),
    "No rules run on defective data."
  )

  # single insist_rows rule on defective data outside chain
  expect_equal(
    iris %>%
      insist_rows(maha_dist, within_n_sds(3), Sepal.Length:Petal.Length, obligatory=TRUE, error_fun=error_append) %>%
      insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length, defect_fun=defect_df_return),
    defect_df("insist_rows", "verification [within_n_sds(6)] on maha_dist row reduction omitted due to data defect!", "within_n_sds(6)",
               "Sepal.Length:Petal.Length", "maha_dist", NA)
  )

  # single insist_rows rule on defective data inside chain
  expect_equal(
    iris %>% chain_start %>%
      insist_rows(maha_dist, within_n_sds(3), Sepal.Length:Petal.Length, obligatory=TRUE, error_fun=error_append) %>%
      insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length) %>%
      chain_end(error_fun=defect_df_return),
    defect_df("insist_rows", "verification [within_n_sds(6)] on maha_dist row reduction omitted due to data defect!", "within_n_sds(6)",
               "Sepal.Length:Petal.Length", "maha_dist", NA)
  )

  # single insist_rows rule on defective data inside chain without store_defect
  expect_error(
    iris %>% chain_start %>%
      insist_rows(maha_dist, within_n_sds(3), Sepal.Length:Petal.Length, error_fun=error_append) %>%
      insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length) %>% chain_end(error_fun=defect_df_return),
    "No rules run on defective data."
  )

  # two insist_rows rules on defective data inside chain
  expect_equal(
    iris %>% chain_start %>%
      insist_rows(maha_dist, within_n_sds(3), Sepal.Length:Petal.Length, obligatory=TRUE, error_fun=error_append) %>%
      insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length) %>%
      insist_rows(maha_dist, within_n_sds(7), Sepal.Length:Petal.Length) %>%
      chain_end(error_fun=defect_df_return),
    rbind(
      defect_df("insist_rows", "verification [within_n_sds(6)] on maha_dist row reduction omitted due to data defect!", "within_n_sds(6)",
                 "Sepal.Length:Petal.Length", "maha_dist", NA),
      defect_df("insist_rows", "verification [within_n_sds(7)] on maha_dist row reduction omitted due to data defect!", "within_n_sds(7)",
                 "Sepal.Length:Petal.Length", "maha_dist", NA)
    )
  )

  # two insist_rows rules on defective data inside chain without store_defect=TRUE
  expect_error(
    iris %>% chain_start %>%
      insist_rows(maha_dist, within_n_sds(3), Sepal.Length:Petal.Length, error_fun=error_append) %>%
      insist_rows(maha_dist, within_n_sds(6), Sepal.Length:Petal.Length) %>%
      insist_rows(maha_dist, within_n_sds(7), Sepal.Length:Petal.Length) %>%
      chain_end(error_fun=defect_df_return),
    "No rules run on defective data."
  )

})
ropenscilabs/assertr documentation built on April 15, 2024, 5:54 a.m.