scrutiny: Error Detection in Science

df1 <- pigs1

df1_grim_up_or_down       <- grim_map(df1, rounding = "up_or_down")
df1_grim_up               <- grim_map(df1, rounding = "up")
df1_grim_down             <- grim_map(df1, rounding = "down")
df1_grim_even             <- grim_map(df1, rounding = "even")
df1_grim_ceiling_or_floor <- grim_map(df1, rounding = "ceiling_or_floor")
df1_grim_ceiling          <- grim_map(df1, rounding = "ceiling")
df1_grim_floor            <- grim_map(df1, rounding = "floor")
df1_grim_trunc            <- grim_map(df1, rounding = "trunc")
df1_grim_anti_trunc       <- grim_map(df1, rounding = "anti_trunc")


df1_grim <- grim_map(df1)


test_that("A tibble is returned", {
  expect_s3_class(df1_grim, c("tbl_df", "tbl", "data.frame"))
})



test_that("It has the correct function-general class", {
  expect_s3_class(df1_grim, "scr_grim_map")
})

test_that("It has the correct rounding-specific class", {
  df1_grim_up_or_down       %>% expect_s3_class("scr_rounding_up_or_down")
  df1_grim_up               %>% expect_s3_class("scr_rounding_up")
  df1_grim_down             %>% expect_s3_class("scr_rounding_down")
  df1_grim_ceiling_or_floor %>% expect_s3_class("scr_rounding_ceiling_or_floor")
  df1_grim_ceiling          %>% expect_s3_class("scr_rounding_ceiling")
  df1_grim_floor            %>% expect_s3_class("scr_rounding_floor")
  df1_grim_trunc            %>% expect_s3_class("scr_rounding_trunc")
  df1_grim_anti_trunc       %>% expect_s3_class("scr_rounding_anti_trunc")
})


t <- TRUE
f <- FALSE

consistency_exp <- c(t, f, f, f, f, t, f, t, f, f, t, f)

test_that("`consistency` has the correct values", {
  df1_grim$consistency %>% expect_equal(consistency_exp)
})



df2 <- df1 %>%
  dplyr::mutate(n = n * 100)

df2_grim <- grim_map(df2)

# Comparison with what `grim_ratio()` would return -- it can be negative:
test_that("`probability` is zero if `ratio` would be negative", {
  (df2_grim$probability == 0) %>% all() %>% expect_true()
})



x <- rnorm(500, 65, 15) %>%
  censor(30, 90) %>%
  round() %>%
  as.character()

n <- rnorm(500, 50, 20) %>%
  censor(20, 90) %>%
  round()

df3 <- tibble::tibble(x, n)

df3_percent_true <- grim_map(df3, percent = TRUE, show_rec = TRUE) %>%
  suppressMessages()

df3_percent_false <- grim_map(df3, show_rec = TRUE)

percent_probabilities_greater <-
  df3_percent_true$probability > df3_percent_false$probability

test_that(
  "The probability of GRIM inconsistency is always greater
  with `percent = TRUE` than without it", {
    percent_probabilities_greater %>% all() %>% expect_true()
})


df3_true_accord <- df3_percent_true %>%
  dplyr::select(1, 3, 7:11) %>%
  dplyr::mutate(accord = dplyr::if_else(
      consistency,
      any(dplyr::near(
        as.numeric(x), c(
        rec_x_upper_rounded_up, rec_x_upper_rounded_down,
        rec_x_lower_rounded_up, rec_x_lower_rounded_down
      ))),
      FALSE
    ))

accord <- all(df3_true_accord$consistency == df3_true_accord$accord)


test_that(glue::glue(
  "The stated consistency accords with what can be reconstructed \\
  from the numbers presented"
), {
  accord %>% expect_true()
})



df4 <- df1 %>%
  grim_map(items = 2)

df4_cons_true <- df4$consistency[df4$consistency]

test_that("", {
  df4_cons_true %>% expect_length(6)
})


df5 <- df1 %>%
  grim_map(show_rec = TRUE)


test_that("`show_rec` increases the number of columns correctly", {
  df5 %>% ncol() %>% expect_equal(11)
})



df6 <- df1 %>%
  dplyr::rename(Mean = x, Sample_Size = n)

df6_grim <- df6 %>%
  grim_map(x = Mean, n = Sample_Size) %>%
  dplyr::mutate(Mean = NULL, Sample_Size = NULL)


test_that("`x` and `n` make the specified columns take on these roles", {
  df6_grim %>% expect_equal(df1_grim)
})


# `df7` was omitted

test_that("a `probability` column is naturally present", {
  df1_grim %>% colnames() %>% expect_contains("probability")
})



df8 <- tibble::tibble(
  x = df1$x,
  n40 = 40,
  n80 = 80
)

df8_n40_grim_up_or_down       <- grim_map(df8, n = n40, rounding = "up_or_down")
df8_n40_grim_up               <- grim_map(df8, n = n40, rounding = "up")
df8_n40_grim_down             <- grim_map(df8, n = n40, rounding = "down")
df8_n40_grim_even             <- grim_map(df8, n = n40, rounding = "even")
df8_n40_grim_ceiling_or_floor <- grim_map(df8, n = n40, rounding = "ceiling_or_floor")
df8_n40_grim_ceiling          <- grim_map(df8, n = n40, rounding = "ceiling")
df8_n40_grim_floor            <- grim_map(df8, n = n40, rounding = "floor")
df8_n40_grim_trunc            <- grim_map(df8, n = n40, rounding = "trunc")
df8_n40_grim_anti_trunc       <- grim_map(df8, n = n40, rounding = "anti_trunc")

df8_n80_grim_up_or_down       <- grim_map(df8, n = n80, rounding = "up_or_down")
df8_n80_grim_up               <- grim_map(df8, n = n80, rounding = "up")
df8_n80_grim_down             <- grim_map(df8, n = n80, rounding = "down")
df8_n80_grim_even             <- grim_map(df8, n = n80, rounding = "even")
df8_n80_grim_ceiling_or_floor <- grim_map(df8, n = n80, rounding = "ceiling_or_floor")
df8_n80_grim_ceiling          <- grim_map(df8, n = n80, rounding = "ceiling")
df8_n80_grim_floor            <- grim_map(df8, n = n80, rounding = "floor")
df8_n80_grim_trunc            <- grim_map(df8, n = n80, rounding = "trunc")
df8_n80_grim_anti_trunc       <- grim_map(df8, n = n80, rounding = "anti_trunc")


# Function for creating expected logical vectors. Make a list with
# `df8_n40_grim_up_or_down` and all other like it (with `n40`), then run
# `purrr::map(format_consistency_results)` on that list. Copy the resulting
# vectors into the matrix-like scheme below. When finished, do the same with the
# `n80` objects.
format_consistency_results <- function(df) {
  out <- df$consistency %>%
    purrr::map_chr(paste0, ", ") %>%
    stringr::str_flatten() %>%
    stringr::str_remove(", $") %>%
    stringr::str_replace_all("TRUE", "t") %>%
    stringr::str_replace_all("FALSE", "f")

  paste0("c(", out, ")")
}


t <- TRUE
f <- FALSE


df8_n40_grim_up_or_down_exp       <- c(t, f, t, t, t, t, f, t, f, f, t, f)
df8_n40_grim_up_exp               <- c(f, f, t, f, f, t, f, t, f, f, t, f)
df8_n40_grim_down_exp             <- c(t, f, f, t, t, f, f, f, f, f, t, f)
df8_n40_grim_even_exp             <- c(t, f, t, t, t, t, f, t, f, f, t, f)
df8_n40_grim_ceiling_or_floor_exp <- c(t, t, t, t, t, t, t, t, t, t, t, t)
df8_n40_grim_ceiling_exp          <- c(f, f, t, f, f, t, t, t, f, f, t, f)
df8_n40_grim_floor_exp            <- c(t, t, f, t, t, f, f, f, t, t, t, t)
df8_n40_grim_trunc_exp            <- c(t, t, f, t, t, f, f, f, t, t, t, t)
df8_n40_grim_anti_trunc_exp       <- c(f, f, t, f, f, t, t, t, f, f, t, f)


test_that("rounding specifications lead to the expected consistency
          results in the corner case of n = 40", {
  df8_n40_grim_up_or_down       $consistency %>% expect_equal(df8_n40_grim_up_or_down_exp       )
  df8_n40_grim_up               $consistency %>% expect_equal(df8_n40_grim_up_exp               )
  df8_n40_grim_down             $consistency %>% expect_equal(df8_n40_grim_down_exp             )
  df8_n40_grim_even             $consistency %>% expect_equal(df8_n40_grim_even_exp             )
  df8_n40_grim_ceiling_or_floor $consistency %>% expect_equal(df8_n40_grim_ceiling_or_floor_exp )
  df8_n40_grim_ceiling          $consistency %>% expect_equal(df8_n40_grim_ceiling_exp          )
  df8_n40_grim_floor            $consistency %>% expect_equal(df8_n40_grim_floor_exp            )
  df8_n40_grim_trunc            $consistency %>% expect_equal(df8_n40_grim_trunc_exp            )
  df8_n40_grim_anti_trunc       $consistency %>% expect_equal(df8_n40_grim_anti_trunc_exp       )
})


df8_n80_grim_up_or_down_exp       <- c(t, t, t, t, t, t, t, t, t, t, t, t)
df8_n80_grim_up_exp               <- c(f, t, t, f, f, t, t, t, t, t, t, t)
df8_n80_grim_down_exp             <- c(t, t, f, t, t, f, t, f, t, t, t, t)
df8_n80_grim_even_exp             <- c(t, t, t, t, t, t, t, t, t, t, t, t)
df8_n80_grim_ceiling_or_floor_exp <- c(t, t, t, t, t, t, t, t, t, t, t, t)
df8_n80_grim_ceiling_exp          <- c(t, t, t, t, t, t, t, t, t, t, t, t)
df8_n80_grim_floor_exp            <- c(t, t, t, t, t, t, t, t, t, t, t, t)
df8_n80_grim_trunc_exp            <- c(t, t, t, t, t, t, t, t, t, t, t, t)
df8_n80_grim_anti_trunc_exp       <- c(t, t, t, t, t, t, t, t, t, t, t, t)


test_that("rounding specifications lead to the expected consistency
          results in the corner case of n = 80", {
  df8_n80_grim_up_or_down       $consistency %>% expect_equal(df8_n80_grim_up_or_down_exp       )
  df8_n80_grim_up               $consistency %>% expect_equal(df8_n80_grim_up_exp               )
  df8_n80_grim_down             $consistency %>% expect_equal(df8_n80_grim_down_exp             )
  df8_n80_grim_even             $consistency %>% expect_equal(df8_n80_grim_even_exp             )
  df8_n80_grim_ceiling_or_floor $consistency %>% expect_equal(df8_n80_grim_ceiling_or_floor_exp )
  df8_n80_grim_ceiling          $consistency %>% expect_equal(df8_n80_grim_ceiling_exp          )
  df8_n80_grim_floor            $consistency %>% expect_equal(df8_n80_grim_floor_exp            )
  df8_n80_grim_trunc            $consistency %>% expect_equal(df8_n80_grim_trunc_exp            )
  df8_n80_grim_anti_trunc       $consistency %>% expect_equal(df8_n80_grim_anti_trunc_exp       )
})



df9_up_1 <- grim_map(df1, rounding = "up_from", threshold = 1)
df9_up_9 <- grim_map(df1, rounding = "up_from", threshold = 9)

df9_up_1_exp <- c(t, f, f, f, f, t, f, f, f, f, t, f)
df9_up_9_exp <- c(f, f, f, f, t, f, f, t, t, f, t, f)

test_that("the minimum of `threshold` yields expected results", {
  df9_up_1$consistency %>% expect_equal(df9_up_1_exp)
  df9_up_9$consistency %>% expect_equal(df9_up_9_exp)
})


df9_down_1 <- grim_map(df1, rounding = "down_from", threshold = 1)
df9_down_9 <- grim_map(df1, rounding = "down_from", threshold = 9)

df9_down_1_exp <- c(f, f, f, f, t, f, f, t, t, f, t, f)
df9_down_9_exp <- c(t, f, f, f, f, t, f, f, f, f, t, f)

test_that("the maximum of `threshold` yields expected results", {
  df9_down_1$consistency %>% expect_equal(df9_down_1_exp)
  df9_down_9$consistency %>% expect_equal(df9_down_9_exp)
})




# Errors ------------------------------------------------------------------

df10 <- df1 %>%
  dplyr::mutate(items = 2)

df11 <- df1 %>%
  dplyr::rename(Snout = x)

df11_exp <- grim_map(df1)

df12 <- df1 %>%
  dplyr::rename(Sample_Size = n)

df12_exp <- grim_map(df1)


test_that("expectations related to various individual
          error messages hold", {
  df1  %>% grim_map(items = 1:3) %>% expect_error()
  df10 %>% grim_map(items = 3) %>% expect_error()
  df11 %>% grim_map(x = Snout) %>% expect_equal(df11_exp)
  df11 %>% grim_map(x = Mouth) %>% expect_error()
  df12 %>% grim_map(n = Sample_Size) %>% expect_equal(df12_exp)
  df12 %>% grim_map(n = Count_Pigs) %>% expect_error()
})


df13 <- df1 %>%
  dplyr::mutate(girth = 30, mirth = 50, birth = 70)

df13_exp <- grim_map(df1)

test_that("`extra = 0` drops all extra columns", {
  df13 %>% grim_map(extra = 0) %>% expect_equal(df13_exp)
})