tests/testthat/test_sample.R

In LudvigOlsen/xpectr: Generates Expectations for 'testthat' Unit Testing

library(xpectr)
context("smpl()")

test_that("smpl() samples correctly", {

  # Vectors
  vec_1 <- c(1,2,3,4,5)
  expect_equal(smpl(vec_1, n = 3),
               c(1, 4, 5))
  expect_equal(smpl(c(1,2,3,4,5), n = 3),
               c(1, 4, 5))
  expect_equal(smpl(c(1,2,3,4,5), n = 3, seed = 3),
               c(1, 2, 4))
  expect_equal(smpl(as.character(vec_1), n = 3),
               c("1", "4", "5"))
  expect_equal(smpl(as.character(vec_1), n = 3, keep_order = FALSE),
               c("5", "4", "1"))

  # lists (are vectors)
  ## Testing 'smpl(list(1,2,4,2,1,4,6,1,3,3), n = 3)'                       ####
  ## Initially generated by xpectr
  # Assigning output
  output_18303 <- smpl(list(1,2,4,2,1,4,6,1,3,3), n = 3)
  # Testing class
  expect_equal(
    class(output_18303),
    "list",
    fixed = TRUE)
  # Testing type
  expect_type(
    output_18303,
    type = "list")
  # Testing values
  expect_equal(
    output_18303,
    list(4, 3, 3))
  # Testing names
  expect_equal(
    names(output_18303),
    NULL,
    fixed = TRUE)
  # Testing length
  expect_equal(
    length(output_18303),
    3L)
  # Testing sum of element lengths
  expect_equal(
    sum(xpectr::element_lengths(output_18303)),
    3L)
  ## Finished testing 'smpl(list(1,2,4,2,1,4,6,1,3,3), n = 3)'              ####

  # Factors
  fac_1 <- factor(c(1,2,1,2,3,1,5,7))
  fac_2 <- factor(as.character(c(1,2,1,2,3,1,5,7)))
  fac_3 <- factor(c("a", "b", "c", "d", "e", "f"))
  expect_equal(smpl(fac_1, n = 3),
               structure(c(2L, 4L, 5L), levels = c("1", "2", "3", "5", "7"), class = "factor"))
  expect_equal(smpl(fac_2, n = 3),
               structure(c(2L, 4L, 5L), levels = c("1", "2", "3", "5", "7"), class = "factor"))
  expect_equal(smpl(fac_2, n = 3, seed = 3),
               structure(c(2L, 1L, 1L), levels = c("1", "2", "3", "5", "7"), class = "factor"))
  expect_equal(smpl(fac_3, n = 3, seed = 7),
               structure(c(1L, 2L, 6L), levels = c("a", "b", "c", "d", "e", "f"), class = "factor"))

  # Data Frames
  set_test_seed(1)
  df_1 <- data.frame("a" = runif(10), "b" = runif(10))
  set_test_seed(1)
  df_2 <- tibble::tibble("a" = runif(10), "b" = runif(10))

  expect_equal(smpl(df_1, n = 3),
               structure(list(a = c(0.572853363351896, 0.62911404389888, 0.0617862704675645
               ), b = c(0.687022846657783, 0.380035179434344, 0.777445221319795)),
               row.names = c(3L, 9L, 10L), class = "data.frame"), tolerance = 1e-7)
  expect_equal(as.data.frame(smpl(df_2, n = 3)),
               structure(list(a = c(0.572853363351896, 0.62911404389888, 0.0617862704675645
               ), b = c(0.687022846657783, 0.380035179434344, 0.777445221319795)),
               row.names = c(NA,-3L), class = "data.frame"), tolerance = 1e-7)
  expect_equal(as.data.frame(smpl(df_2, n = 3, seed = 7)),
               structure(list(a = c(0.2655086631421, 0.908207789994776, 0.0617862704675645
               ), b = c(0.205974574899301, 0.384103718213737, 0.777445221319795
               )), row.names = c(NA,-3L), class = "data.frame"),
               tolerance = 1e-7)

  # Data Frames
  set_test_seed(1)
  dt_1 <- data.table::data.table("a" = runif(10), "b" = runif(10))
  set_test_seed(1)
  dt_2 <- data.table::data.table("a" = runif(10), "b" = runif(10))

  expect_equal(as.data.frame(smpl(dt_1, n = 3)),
               structure(list(a = c(0.572853363351896, 0.62911404389888, 0.0617862704675645
               ), b = c(0.687022846657783, 0.380035179434344, 0.777445221319795)),
               row.names = c(NA,-3L), class = "data.frame"), tolerance = 1e-7)
  expect_equal(as.data.frame(smpl(dt_2, n = 3)),
               structure(list(a = c(0.572853363351896, 0.62911404389888, 0.0617862704675645
               ), b = c(0.687022846657783, 0.380035179434344, 0.777445221319795)),
               row.names = c(NA,-3L), class = "data.frame"), tolerance = 1e-7)
  expect_equal(as.data.frame(smpl(dt_2, n = 3, seed = 7)),
               structure(list(a = c(0.2655086631421, 0.908207789994776, 0.0617862704675645
               ), b = c(0.205974574899301, 0.384103718213737, 0.777445221319795
               )), row.names = c(NA,-3L), class = "data.frame"),
               tolerance = 1e-7)

  smpled_df_2 <- smpl(df_2, n = 3, seed = 7)
  smpled_dt_2 <- smpl(dt_2, n = 3, seed = 7)

  ## Testing 'smpled_df_2'                                                  ####
  ## Initially generated by xpectr
  # Testing class
  expect_equal(
    class(smpled_df_2),
    c("tbl_df", "tbl", "data.frame"),
    fixed = TRUE)
  # Testing column values
  expect_equal(
    smpled_df_2[["a"]],
    c(0.26551, 0.90821, 0.06179),
    tolerance = 1e-4)
  expect_equal(
    smpled_df_2[["b"]],
    c(0.20597, 0.3841, 0.77745),
    tolerance = 1e-4)
  # Testing column names
  expect_equal(
    names(smpled_df_2),
    c("a", "b"),
    fixed = TRUE)
  # Testing column classes
  expect_equal(
    xpectr::element_classes(smpled_df_2),
    c("numeric", "numeric"),
    fixed = TRUE)
  # Testing column types
  expect_equal(
    xpectr::element_types(smpled_df_2),
    c("double", "double"),
    fixed = TRUE)
  # Testing dimensions
  expect_equal(
    dim(smpled_df_2),
    3:2)
  # Testing group keys
  expect_equal(
    colnames(dplyr::group_keys(smpled_df_2)),
    character(0),
    fixed = TRUE)
  ## Finished testing 'smpled_df_2'                                         ####



  ## Testing 'smpled_dt_2'                                                  ####
  ## Initially generated by xpectr
  xpectr::set_test_seed(42)
  # Testing class
  expect_equal(
    class(smpled_dt_2),
    c("data.table", "data.frame"),
    fixed = TRUE)
  # Testing column values
  expect_equal(
    smpled_dt_2[["a"]],
    c(0.26551, 0.90821, 0.06179),
    tolerance = 1e-4)
  expect_equal(
    smpled_dt_2[["b"]],
    c(0.20597, 0.3841, 0.77745),
    tolerance = 1e-4)
  # Testing column names
  expect_equal(
    names(smpled_dt_2),
    c("a", "b"),
    fixed = TRUE)
  # Testing column classes
  expect_equal(
    xpectr::element_classes(smpled_dt_2),
    c("numeric", "numeric"),
    fixed = TRUE)
  # Testing column types
  expect_equal(
    xpectr::element_types(smpled_dt_2),
    c("double", "double"),
    fixed = TRUE)
  # Testing dimensions
  expect_equal(
    dim(smpled_dt_2),
    3:2)
  # Testing group keys
  expect_equal(
    colnames(dplyr::group_keys(smpled_dt_2)),
    character(0),
    fixed = TRUE)
  ## Finished testing 'smpled_dt_2'                                         ####


  # Other types
  ## Testing 'smpl(matrix(1,3,3), n = 3)'                                   ####
  ## Initially generated by xpectr
  # Testing side effects
  expect_error(
    xpectr::strip_msg(smpl(matrix(1,3,3), n = 3)),
    xpectr::strip("Only vectors, factors and data frames are currently supported."),
    fixed = TRUE)
  ## Finished testing 'smpl(matrix(1,3,3), n = 3)'                          ####


})

test_that("smpl() restores random state correctly", {

  # Vectors
  vec_1 <- c(1,2,3,4,5)

  set_test_seed(98)
  current_random_state <- head(.Random.seed, 10)

  expect_equal(smpl(vec_1, 2), c(4, 5))

  exist_random_state <- head(.Random.seed, 10)

  expect_equal(current_random_state, exist_random_state)

})