tests/testthat/test_helpers.R

library(cvms)
context("helpers")

test_that("Helper count_nulls_in_list() works", {

  # skip_test_if_old_R_version()

  expect_equal(count_nulls_in_list(list(
    "cat" = NULL,
    "dog" = 3,
    "hat" = NULL
  )), 2)
})

test_that("Helper count_convergence_warnings() works", {
  expect_equal(count_convergence_warnings(c("Yes", "No", "No", "Yes", "No")), 3)
  expect_error(
    xpectr::strip_msg(count_convergence_warnings(c(
      "Yes", "No", "No", "Yes", "No", "Lol", "Nay"
    )), lowercase = TRUE),
    xpectr::strip(paste0("must be a subset of ",
                         ifelse(!is_checkmate_v2_1(), " set", ""),
                         " {Yes,No}."), lowercase = TRUE),
    fixed = T
  )
})

test_that("capture_fn()", {
  expect_equal(
    substr(capture_fn(
      function(x,y,z){x+y+z}
    ), 1, 22),
    "function(x,y,z){x+y+z}"
  )
  expect_equal(
    capture_fn(NULL),
    "NULL"
  )
})

test_that("nnet gives same predictions on mac and ubuntu", {
  testthat::skip("mac and ubuntu give different warnings")
  testthat::skip_if_not_installed("nnet")
  # Tested on both platforms on travis as well
  # Local test should run on mac as is

  xpectr::set_test_seed(10)

  dat <- participant.scores %>%
    dplyr::mutate(diagnosis = as.factor(diagnosis))

  # binomial
  predictions <- plyr::llply(1:10, function(s) {
    xpectr::set_test_seed(s)
    co <- testthat::capture_output(nn <- nnet::nnet(as.formula("diagnosis~score"), data = dat, size = 10))
    as.vector(predict(nn, dat))
  }) %>% unlist()

  expect_equal(
    predictions,
    c(
      1, 0.74558685723907, 0.578586438198845, 0.74558685723907, 0.580615724626656,
      0, 0.998890098306022, 0.616111813126343, 0.580615724626656, 0.588197506760497,
      0.578045175602885, 0, 0.74558685723907, 0.577916799755878, 0.57632507163764,
      0.99972789041577, 0.711360791916158, 0.616111813126343, 0.999998329721127,
      0.588197506760497, 0.579973146331912, 0.996241553095139, 0.60058844287862,
      0.578809802264348, 0.595351004005742, 0.577937467580419, 0.000202134102871739,
      0.627360442993519, 0.577900935866149, 0, 1, 0.666721786798279,
      0.611104734221879, 0.666721786798279, 0.611104734221879, 0, 1,
      0.611104734221879, 0.611104734221879, 0.611104734221879, 0.611104734221879,
      0, 0.666721786798279, 0.611104734221879, 0.611031240769425, 1,
      0.611127805162521, 0.611104734221879, 1, 0.611104734221879, 0.611104734221879,
      1, 0.611104734221879, 0.611104734221879, 0.611104734221879, 0.611104734221879,
      1.00856566789005e-05, 0.611104734221879, 0.611104734221879, 0,
      1, 0.764463434592399, 0.494841610269604, 0.764463434592399, 0.566127883565247,
      0.215408049162467, 1, 0.697774137967905, 0.566127883565247, 0.63456700711862,
      0.423544643076406, 0.126224173866663, 0.764463434592399, 0.368429302533936,
      0.268533642407709, 1, 0.754107188656388, 0.697774137967905, 1,
      0.63456700711862, 0.552011666457357, 1, 0.673242845547333, 0.509193734651035,
      0.660588208260785, 0.381962238281882, 0.225403261168915, 0.70962847024623,
      0.355092349714316, 0.108073623307058, 1, 0.724113674351695, 0.58282442741649,
      0.724113674351695, 0.59931877687094, 0.0821341520422677, 1, 0.649126815128951,
      0.59931877687094, 0.619006346983197, 0.563107486791626, 1.18430238270543e-05,
      0.724113674351695, 0.535752571789324, 0.34487721608998, 1, 0.706476255414935,
      0.649126815128951, 1, 0.619006346983197, 0.595937853833416, 1,
      0.635105282576637, 0.586130895190753, 0.629201817300479, 0.544401190406166,
      0.128336806782347, 0.65756914221701, 0.525292292028433, 2.32452222685714e-06,
      1, 0.765230535670973, 0.497113483318073, 0.765230535670973, 0.56818606704355,
      0.216425918368818, 1, 0.698899580616249, 0.56818606704355, 0.636220787357355,
      0.425807268658682, 0.126323836555748, 0.765230535670973, 0.370531320315304,
      0.270022823007995, 1, 0.75474192951717, 0.698899580616249, 1,
      0.636220787357355, 0.554129485298243, 1, 0.674589391993337, 0.511440303014397,
      0.662041083917444, 0.384115902502773, 0.226516089464678, 0.710640452968085,
      0.357135834740305, 0.10798886724238, 1, 0.720586816275157, 0.571629206675288,
      0.720586816275157, 0.589375265699162, 0, 1, 0.654013450672579,
      0.589375265699162, 0.615695751684985, 0.559778791833181, 0, 0.720586816275157,
      0.55323271339913, 0.545136939255642, 1, 0.707788414362377, 0.654013450672579,
      1, 0.615695751684985, 0.585237668902095, 1, 0.63700885566586,
      0.574632808733525, 0.629375017068631, 0.554673474405019, 0, 0.663439563471069,
      0.551905774349665, 0, 0.999980042563833, 0.733408085625146, 0.588094813990417,
      0.733408085625146, 0.588325146972442, 0, 0.999903422499639, 0.596195278327381,
      0.588325146972442, 0.589020320549427, 0.587862502354448, 0, 0.733408085625146,
      0.587645379940411, 0.581568453647645, 0.999939645751583, 0.681164869034425,
      0.596195278327381, 0.999972186404575, 0.589020320549427, 0.588272242526939,
      0.999808841326863, 0.591249554181622, 0.588137890314425, 0.590124953892591,
      0.587702786316262, 0.00168924881202357, 0.601310420216751, 0.587585754601369,
      0, 1, 0.684395501621856, 0.588832333654823, 0.684395501621856,
      0.612521029360702, 0, 1, 0.658247723637025, 0.612521029360702,
      0.635690181201618, 0.564725480535334, 0, 0.684395501621856, 0.545212037997334,
      0.505827784911249, 1, 0.680112159860339, 0.658247723637025, 1,
      0.635690181201618, 0.607821734467531, 1, 0.649303564315729, 0.593606892099468,
      0.644791403066015, 0.550105778650825, 1.95688859353457e-06, 0.662678470095522,
      0.540309586231236, 0, 1, 0.667709024688218, 0.611808833844179,
      0.667709024688218, 0.637639124326372, 0.138765913412546, 1, 0.661667769971892,
      0.637639124326372, 0.652758332078045, 0.567424290186004, 0.00131929497785432,
      0.667709024688218, 0.510079434870597, 0.305603208872524, 1, 0.666945137803983,
      0.661667769971892, 1, 0.652758332078045, 0.633521553424334, 1,
      0.658653072080534, 0.618145332848138, 0.656891089566529, 0.526753468207694,
      0.170227131495712, 0.662954212190577, 0.491611369996798, 0.000133267456484988,
      1, 0.733772582465577, 0.570224300934701, 0.733772582465577, 0.592156545325146,
      0, 1, 0.648505042223343, 0.592156545325146, 0.617688194266119,
      0.551496346461226, 0, 0.733772582465577, 0.538578811374203, 0.517272260831303,
      1, 0.707462050155765, 0.648505042223343, 1, 0.617688194266119,
      0.587496997871983, 0.999997812767346, 0.635195268121854, 0.57434280126587,
      0.629117104586359, 0.541647799775378, 0, 0.656114454122126, 0.535611906621616,
      0
    )
  )

  # gaussian
  predictions <- plyr::llply(1:10, function(s) {
    xpectr::set_test_seed(s)
    nn <- nnet::nnet(as.formula("score~diagnosis"), data = dat, size = 10, linout = TRUE)
    as.vector(predict(nn, dat))
  }) %>% unlist()

  expect_equal(
    predictions,
    c(
      30.6666665924374, 30.6666665924374, 30.6666665924374, 50.9166668310158,
      50.9166668310158, 50.9166668310158, 30.6666665924374, 30.6666665924374,
      30.6666665924374, 50.9166668310158, 50.9166668310158, 50.9166668310158,
      30.6666665924374, 30.6666665924374, 30.6666665924374, 30.6666665924374,
      30.6666665924374, 30.6666665924374, 30.6666665924374, 30.6666665924374,
      30.6666665924374, 30.6666665924374, 30.6666665924374, 30.6666665924374,
      50.9166668310158, 50.9166668310158, 50.9166668310158, 50.9166668310158,
      50.9166668310158, 50.9166668310158, 30.6665784709863, 30.6665784709863,
      30.6665784709863, 50.9166708797146, 50.9166708797146, 50.9166708797146,
      30.6665784709863, 30.6665784709863, 30.6665784709863, 50.9166708797146,
      50.9166708797146, 50.9166708797146, 30.6665784709863, 30.6665784709863,
      30.6665784709863, 30.6665784709863, 30.6665784709863, 30.6665784709863,
      30.6665784709863, 30.6665784709863, 30.6665784709863, 30.6665784709863,
      30.6665784709863, 30.6665784709863, 50.9166708797146, 50.9166708797146,
      50.9166708797146, 50.9166708797146, 50.9166708797146, 50.9166708797146,
      30.6666669812194, 30.6666669812194, 30.6666669812194, 50.9166667804219,
      50.9166667804219, 50.9166667804219, 30.6666669812194, 30.6666669812194,
      30.6666669812194, 50.9166667804219, 50.9166667804219, 50.9166667804219,
      30.6666669812194, 30.6666669812194, 30.6666669812194, 30.6666669812194,
      30.6666669812194, 30.6666669812194, 30.6666669812194, 30.6666669812194,
      30.6666669812194, 30.6666669812194, 30.6666669812194, 30.6666669812194,
      50.9166667804219, 50.9166667804219, 50.9166667804219, 50.9166667804219,
      50.9166667804219, 50.9166667804219, 38.7667925707427, 38.7667925707427,
      38.7667925707427, 38.7667588942958, 38.7667588942958, 38.7667588942958,
      38.7667925707427, 38.7667925707427, 38.7667925707427, 38.7667588942958,
      38.7667588942958, 38.7667588942958, 38.7667925707427, 38.7667925707427,
      38.7667925707427, 38.7667925707427, 38.7667925707427, 38.7667925707427,
      38.7667925707427, 38.7667925707427, 38.7667925707427, 38.7667925707427,
      38.7667925707427, 38.7667925707427, 38.7667588942958, 38.7667588942958,
      38.7667588942958, 38.7667588942958, 38.7667588942958, 38.7667588942958,
      30.6666660461772, 30.6666660461772, 30.6666660461772, 50.9166644466571,
      50.9166644466571, 50.9166644466571, 30.6666660461772, 30.6666660461772,
      30.6666660461772, 50.9166644466571, 50.9166644466571, 50.9166644466571,
      30.6666660461772, 30.6666660461772, 30.6666660461772, 30.6666660461772,
      30.6666660461772, 30.6666660461772, 30.6666660461772, 30.6666660461772,
      30.6666660461772, 30.6666660461772, 30.6666660461772, 30.6666660461772,
      50.9166644466571, 50.9166644466571, 50.9166644466571, 50.9166644466571,
      50.9166644466571, 50.9166644466571, 30.666546478818, 30.666546478818,
      30.666546478818, 50.9166831547643, 50.9166831547643, 50.9166831547643,
      30.666546478818, 30.666546478818, 30.666546478818, 50.9166831547643,
      50.9166831547643, 50.9166831547643, 30.666546478818, 30.666546478818,
      30.666546478818, 30.666546478818, 30.666546478818, 30.666546478818,
      30.666546478818, 30.666546478818, 30.666546478818, 30.666546478818,
      30.666546478818, 30.666546478818, 50.9166831547643, 50.9166831547643,
      50.9166831547643, 50.9166831547643, 50.9166831547643, 50.9166831547643,
      30.6666863919472, 30.6666863919472, 30.6666863919472, 50.9167499804574,
      50.9167499804574, 50.9167499804574, 30.6666863919472, 30.6666863919472,
      30.6666863919472, 50.9167499804574, 50.9167499804574, 50.9167499804574,
      30.6666863919472, 30.6666863919472, 30.6666863919472, 30.6666863919472,
      30.6666863919472, 30.6666863919472, 30.6666863919472, 30.6666863919472,
      30.6666863919472, 30.6666863919472, 30.6666863919472, 30.6666863919472,
      50.9167499804574, 50.9167499804574, 50.9167499804574, 50.9167499804574,
      50.9167499804574, 50.9167499804574, 30.6666666743281, 30.6666666743281,
      30.6666666743281, 50.9166673429457, 50.9166673429457, 50.9166673429457,
      30.6666666743281, 30.6666666743281, 30.6666666743281, 50.9166673429457,
      50.9166673429457, 50.9166673429457, 30.6666666743281, 30.6666666743281,
      30.6666666743281, 30.6666666743281, 30.6666666743281, 30.6666666743281,
      30.6666666743281, 30.6666666743281, 30.6666666743281, 30.6666666743281,
      30.6666666743281, 30.6666666743281, 50.9166673429457, 50.9166673429457,
      50.9166673429457, 50.9166673429457, 50.9166673429457, 50.9166673429457,
      30.6669757332435, 30.6669757332435, 30.6669757332435, 50.9159142236694,
      50.9159142236694, 50.9159142236694, 30.6669757332435, 30.6669757332435,
      30.6669757332435, 50.9159142236694, 50.9159142236694, 50.9159142236694,
      30.6669757332435, 30.6669757332435, 30.6669757332435, 30.6669757332435,
      30.6669757332435, 30.6669757332435, 30.6669757332435, 30.6669757332435,
      30.6669757332435, 30.6669757332435, 30.6669757332435, 30.6669757332435,
      50.9159142236694, 50.9159142236694, 50.9159142236694, 50.9159142236694,
      50.9159142236694, 50.9159142236694, 30.6666580877896, 30.6666580877896,
      30.6666580877896, 50.9166717465376, 50.9166717465376, 50.9166717465376,
      30.6666580877896, 30.6666580877896, 30.6666580877896, 50.9166717465376,
      50.9166717465376, 50.9166717465376, 30.6666580877896, 30.6666580877896,
      30.6666580877896, 30.6666580877896, 30.6666580877896, 30.6666580877896,
      30.6666580877896, 30.6666580877896, 30.6666580877896, 30.6666580877896,
      30.6666580877896, 30.6666580877896, 50.9166717465376, 50.9166717465376,
      50.9166717465376, 50.9166717465376, 50.9166717465376, 50.9166717465376
    )
  )

  # multinom

  dat2 <- dat %>%
    rbind(
      dat %>%
        dplyr::mutate(diagnosis = as.factor(as.numeric(as.character(diagnosis)) + 3))
    )

  predictions <- plyr::llply(1:10, function(s) {
    xpectr::set_test_seed(s)
    nn <- nnet::multinom(as.formula("diagnosis~score"), data = dat2)
    as.vector(predict(nn, dat2))
  }) %>% unlist()

  expect_equal(
    predictions,
    c(
      "1", "1", "4", "1", "4", "0", "1", "1", "4", "1", "3", "0",
      "1", "0", "0", "1", "1", "1", "1", "1", "4", "1", "1", "4", "1",
      "0", "0", "1", "0", "0", "1", "1", "4", "1", "4", "0", "1", "1",
      "4", "1", "3", "0", "1", "0", "0", "1", "1", "1", "1", "1", "4",
      "1", "1", "4", "1", "0", "0", "1", "0", "0", "1", "1", "4", "1",
      "4", "0", "1", "1", "4", "1", "3", "0", "1", "0", "0", "1", "1",
      "1", "1", "1", "4", "1", "1", "4", "1", "0", "0", "1", "0", "0",
      "1", "1", "4", "1", "4", "0", "1", "1", "4", "1", "0", "0", "1",
      "0", "0", "1", "1", "1", "1", "1", "4", "1", "1", "4", "1", "0",
      "0", "1", "0", "0", "1", "1", "4", "1", "4", "0", "1", "1", "4",
      "1", "3", "0", "1", "0", "0", "1", "1", "1", "1", "1", "4", "1",
      "1", "4", "1", "0", "0", "1", "0", "0", "1", "1", "4", "1", "4",
      "0", "1", "1", "4", "1", "0", "0", "1", "0", "0", "1", "1", "1",
      "1", "1", "4", "1", "1", "4", "1", "0", "0", "1", "0", "0", "1",
      "1", "4", "1", "4", "0", "1", "1", "4", "1", "0", "0", "1", "0",
      "0", "1", "1", "1", "1", "1", "4", "1", "1", "4", "1", "0", "0",
      "1", "0", "0", "1", "1", "4", "1", "4", "0", "1", "1", "4", "1",
      "3", "0", "1", "0", "0", "1", "1", "1", "1", "1", "4", "1", "1",
      "4", "1", "0", "0", "1", "0", "0", "1", "1", "4", "1", "4", "0",
      "1", "1", "4", "1", "3", "0", "1", "0", "0", "1", "1", "1", "1",
      "1", "4", "1", "1", "4", "1", "0", "0", "1", "0", "0", "1", "1",
      "4", "1", "4", "0", "1", "1", "4", "1", "0", "0", "1", "0", "0",
      "1", "1", "1", "1", "1", "4", "1", "1", "4", "1", "0", "0", "1",
      "0", "0", "1", "1", "4", "1", "4", "0", "1", "1", "4", "1", "0",
      "0", "1", "0", "0", "1", "1", "1", "1", "1", "4", "1", "1", "4",
      "1", "0", "0", "1", "0", "0", "1", "1", "4", "1", "4", "0", "1",
      "1", "4", "1", "0", "0", "1", "0", "0", "1", "1", "1", "1", "1",
      "4", "1", "1", "4", "1", "0", "0", "1", "0", "0", "1", "1", "4",
      "1", "4", "0", "1", "1", "4", "1", "0", "0", "1", "0", "0", "1",
      "1", "1", "1", "1", "4", "1", "1", "4", "1", "0", "0", "1", "0",
      "0", "1", "1", "4", "1", "4", "0", "1", "1", "4", "1", "3", "0",
      "1", "0", "0", "1", "1", "1", "1", "1", "4", "1", "1", "4", "1",
      "0", "0", "1", "0", "0", "1", "1", "4", "1", "4", "0", "1", "1",
      "4", "1", "3", "0", "1", "0", "0", "1", "1", "1", "1", "1", "4",
      "1", "1", "4", "1", "0", "0", "1", "0", "0", "1", "1", "4", "1",
      "4", "0", "1", "1", "4", "1", "3", "0", "1", "0", "0", "1", "1",
      "1", "1", "1", "4", "1", "1", "4", "1", "0", "0", "1", "0", "0",
      "1", "1", "4", "1", "4", "0", "1", "1", "4", "1", "3", "0", "1",
      "0", "0", "1", "1", "1", "1", "1", "4", "1", "1", "4", "1", "0",
      "0", "1", "0", "0", "1", "1", "4", "1", "4", "0", "1", "1", "4",
      "1", "3", "0", "1", "0", "0", "1", "1", "1", "1", "1", "4", "1",
      "1", "4", "1", "0", "0", "1", "0", "0", "1", "1", "4", "1", "4",
      "0", "1", "1", "4", "1", "0", "0", "1", "0", "0", "1", "1", "1",
      "1", "1", "4", "1", "1", "4", "1", "0", "0", "1", "0", "0", "1",
      "1", "4", "1", "4", "0", "1", "1", "4", "1", "3", "0", "1", "0",
      "0", "1", "1", "1", "1", "1", "4", "1", "1", "4", "1", "0", "0",
      "1", "0", "0"
    )
  )
})

test_that("glmer throws same warnings on mac and ubuntu", {
  testthat::skip("mac and ubuntu give different warnings")
  # Tested on both platforms on travis as well
  # 13 warnings on mac, 16 on ubuntu
  # Local test should run on mac as is

  xpectr::set_test_seed(10)

  dat <- participant.scores %>%
    dplyr::mutate(diagnosis = as.factor(diagnosis))

  formula <- "diagnosis ~ score + age + (1|session) + (1|age)"
  family <- "binomial"
  REML <- FALSE
  control <- lme4::glmerControl(optimizer = "bobyqa")

  warnings_and_messages <- plyr::llply(1:10, function(s) {
    process_ <- testthat::evaluate_promise({
      xpectr::set_test_seed(s)
      lme4::glmer(
        formula = formula, family = family, data = dplyr::sample_frac(dat, 0.95),
        REML = REML, control = control
      )
    })
    list(
      "warnings" = process_$warnings,
      "messages" = process_$messages
    )
  })
  warns <- unlist(warnings_and_messages %c% "warnings")
  mesgs <- unlist(warnings_and_messages %c% "messages")

  # NOTE devtools::test() used '' but console outputted ‘’
  # which is weird.. but now I'm just stripping the punctuations
  # cause it's not a problem here
  expect_equal(
    xpectr::strip(sort(warns), remove_numbers = TRUE),
    xpectr::strip(sort(
      c(
        "extra argument(s) ‘REML’ disregarded", "extra argument(s) ‘REML’ disregarded",
        "extra argument(s) ‘REML’ disregarded", "extra argument(s) ‘REML’ disregarded",
        "extra argument(s) ‘REML’ disregarded", "extra argument(s) ‘REML’ disregarded",
        "extra argument(s) ‘REML’ disregarded", "extra argument(s) ‘REML’ disregarded",
        "extra argument(s) ‘REML’ disregarded", "extra argument(s) ‘REML’ disregarded",
        "Model failed to converge with max|grad| = 0.0161905 (tol = 0.001, component 1)",
        "Model failed to converge with max|grad| = 0.025616 (tol = 0.001, component 1)",
        "Model failed to converge with max|grad| = 0.033809 (tol = 0.001, component 1)"
      )
    ), remove_numbers = TRUE)
  )

  expect_equal(mesgs, character())
})

test_that("one-hot encoding helper works for evaluate purposes", {
  df <- tibble::tibble(
    "Target" = c("D", rep(c("A", "B", "C"), 3)),
    "PredictedClass" = c("A", rep(c("A", "B", "C"), 3))
  )

  df_large <- dplyr::bind_rows(rep(list(df), 100)) %>%
    dplyr::mutate(x = runif(nrow(df) * 100))

  # system.time(one_hot_encode(df_large, "Target", c_levels=c("D","A","C","B","F")))
  oh1 <- one_hot_encode(df, "Target")
  oh2 <- one_hot_encode(df, "Target", c_levels = c("D", "A", "C", "B", "F"))

  expect_equal(
    oh1,
    structure(
      list(
        Target = c(
          "D", "A", "B", "C", "A", "B", "C",
          "A", "B", "C"
        ),
        PredictedClass = c(
          "A", "A", "B", "C", "A", "B",
          "C", "A", "B", "C"
        ),
        A = c(0L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L),
        B = c(0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 0L),
        C = c(0L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 1L),
        D = c(1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L)
      ),
      row.names = c(NA, -10L),
      class = c("tbl_df", "tbl", "data.frame")
    )
  )

  expect_equal(
    oh2,
    structure(
      list(
        Target = c(
          "D", "A", "B", "C", "A", "B", "C",
          "A", "B", "C"
        ),
        PredictedClass = c(
          "A", "A", "B", "C", "A", "B",
          "C", "A", "B", "C"
        ),
        A = c(0L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L),
        B = c(0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 0L),
        C = c(0L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 1L),
        D = c(1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L),
        F = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L)
      ),
      row.names = c(NA, -10L),
      class = c("tbl_df", "tbl", "data.frame")
    )
  )
})

test_that("non_empty_names()", {

  a <- list(NULL, "a" = 3, f = 8)
  names(a) <- c(NA, "a", NULL)

  # xpectr::gxs_function(non_empty_names,
  #                      args_values = list(
  #                        "x" = list(
  #                          list("a" = 1, "b" = 3, 4, NA),
  #                          list(1,2,3,4),
  #                          a,
  #                          # NA,
  #                          c("a" = 1, 3, "p" = NA),
  #                          list("a" = list("b" = 3))
  #                        )
  #                      ))

  ## Testing 'non_empty_names'                                                ####
  ## Initially generated by xpectr
  # Testing different combinations of argument values

  # Testing non_empty_names(x = list(1, 2, 3, 4))
  # Assigning output
  output_12935 <- non_empty_names(x = list(1, 2, 3, 4))
  # Testing class
  expect_equal(
    class(output_12935),
    "character",
    fixed = TRUE)
  # Testing type
  expect_type(
    output_12935,
    type = "character")
  # Testing values
  expect_equal(
    output_12935,
    character(0),
    fixed = TRUE)
  # Testing names
  expect_equal(
    names(output_12935),
    NULL,
    fixed = TRUE)
  # Testing length
  expect_equal(
    length(output_12935),
    0L)
  # Testing sum of element lengths
  expect_equal(
    sum(xpectr::element_lengths(output_12935)),
    0L)

  # Testing non_empty_names(x = a)
  # Testing class
  expect_equal(
    class(non_empty_names(x = a)),
    "character",
    fixed = TRUE)
  # Testing type
  expect_type(
    non_empty_names(x = a),
    type = "character")
  # Testing values
  expect_equal(
    non_empty_names(x = a),
    "a",
    fixed = TRUE)
  # Testing names
  expect_equal(
    names(non_empty_names(x = a)),
    NULL,
    fixed = TRUE)
  # Testing length
  expect_equal(
    length(non_empty_names(x = a)),
    1L)
  # Testing sum of element lengths
  expect_equal(
    sum(xpectr::element_lengths(non_empty_names(x = a))),
    1L)

  # Testing non_empty_names(x = c(a = 1, 3, p = NA))
  # Assigning output
  output_14590 <- non_empty_names(x = c(a = 1, 3, p = NA))
  # Testing class
  expect_equal(
    class(output_14590),
    "character",
    fixed = TRUE)
  # Testing type
  expect_type(
    output_14590,
    type = "character")
  # Testing values
  expect_equal(
    output_14590,
    c("a", "p"),
    fixed = TRUE)
  # Testing names
  expect_equal(
    names(output_14590),
    NULL,
    fixed = TRUE)
  # Testing length
  expect_equal(
    length(output_14590),
    2L)
  # Testing sum of element lengths
  expect_equal(
    sum(xpectr::element_lengths(output_14590)),
    2L)

  # Testing non_empty_names(x = list(a = list(b = 3)))
  # Assigning output
  output_13323 <- non_empty_names(x = list(a = list(b = 3)))
  # Testing class
  expect_equal(
    class(output_13323),
    "character",
    fixed = TRUE)
  # Testing type
  expect_type(
    output_13323,
    type = "character")
  # Testing values
  expect_equal(
    output_13323,
    "a",
    fixed = TRUE)
  # Testing names
  expect_equal(
    names(output_13323),
    NULL,
    fixed = TRUE)
  # Testing length
  expect_equal(
    length(output_13323),
    1L)
  # Testing sum of element lengths
  expect_equal(
    sum(xpectr::element_lengths(output_13323)),
    1L)

  # Testing non_empty_names(x = list(a = 1, b = 3, 4, NA))
  # Assigning output
  output_16508 <- non_empty_names(x = list(a = 1, b = 3, 4, NA))
  # Testing class
  expect_equal(
    class(output_16508),
    "character",
    fixed = TRUE)
  # Testing type
  expect_type(
    output_16508,
    type = "character")
  # Testing values
  expect_equal(
    output_16508,
    c("a", "b"),
    fixed = TRUE)
  # Testing names
  expect_equal(
    names(output_16508),
    NULL,
    fixed = TRUE)
  # Testing length
  expect_equal(
    length(output_16508),
    2L)
  # Testing sum of element lengths
  expect_equal(
    sum(xpectr::element_lengths(output_16508)),
    2L)

  # Testing non_empty_names(x = NULL)
  # Assigning output
  output_12579 <- non_empty_names(x = NULL)
  # Testing class
  expect_equal(
    class(output_12579),
    "character",
    fixed = TRUE)
  # Testing type
  expect_type(
    output_12579,
    type = "character")
  # Testing values
  expect_equal(
    output_12579,
    character(0),
    fixed = TRUE)
  # Testing names
  expect_equal(
    names(output_12579),
    NULL,
    fixed = TRUE)
  # Testing length
  expect_equal(
    length(output_12579),
    0L)
  # Testing sum of element lengths
  expect_equal(
    sum(xpectr::element_lengths(output_12579)),
    0L)

  ## Finished testing 'non_empty_names'                                       ####

})

test_that("reposition_column()", {

  data <- participant.scores


  ## Testing 'data'                                                         ####
  ## Initially generated by xpectr
  xpectr::set_test_seed(42)
  # Testing class
  expect_equal(
    class(data),
    "data.frame",
    fixed = TRUE)
  # Testing column values
  expect_equal(
    data[["participant"]],
    structure(c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 4L, 4L, 4L, 5L,
      5L, 5L, 6L, 6L, 6L, 7L, 7L, 7L, 8L, 8L, 8L, 9L, 9L, 9L, 10L,
      10L, 10L), .Label = c("1", "2", "3", "4", "5", "6", "7", "8",
      "9", "10"), class = "factor"))
  expect_equal(
    data[["age"]],
    c(20, 20, 20, 23, 23, 23, 27, 27, 27, 21, 21, 21, 32, 32, 32, 31,
      31, 31, 43, 43, 43, 21, 21, 21, 34, 34, 34, 32, 32, 32),
    tolerance = 1e-4)
  expect_equal(
    data[["diagnosis"]],
    c(1, 1, 1, 0, 0, 0, 1, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1,
      1, 1, 1, 0, 0, 0, 0, 0, 0),
    tolerance = 1e-4)
  expect_equal(
    data[["score"]],
    c(10, 24, 45, 24, 40, 67, 15, 30, 40, 35, 50, 78, 24, 54, 62, 14,
      25, 30, 11, 35, 41, 16, 32, 44, 33, 53, 66, 29, 55, 81),
    tolerance = 1e-4)
  expect_equal(
    data[["session"]],
    c(1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3,
      1, 2, 3, 1, 2, 3, 1, 2, 3),
    tolerance = 1e-4)
  # Testing column names
  expect_equal(
    names(data),
    c("participant", "age", "diagnosis", "score", "session"),
    fixed = TRUE)
  # Testing column classes
  expect_equal(
    xpectr::element_classes(data),
    c("factor", "numeric", "numeric", "numeric", "integer"),
    fixed = TRUE)
  # Testing column types
  expect_equal(
    xpectr::element_types(data),
    c("integer", "double", "double", "double", "integer"),
    fixed = TRUE)
  # Testing dimensions
  expect_equal(
    dim(data),
    c(30L, 5L))
  # Testing group keys
  expect_equal(
    colnames(dplyr::group_keys(data)),
    character(0),
    fixed = TRUE)
  ## Finished testing 'data'                                                ####

  data <- reposition_column(data, "age", .before = "session")

  ## Testing 'data'                                                         ####
  ## Initially generated by xpectr
  xpectr::set_test_seed(42)
  # Testing class
  expect_equal(
    class(data),
    "data.frame",
    fixed = TRUE)
  # Testing column values
  expect_equal(
    data[["participant"]],
    structure(c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 4L, 4L, 4L, 5L,
      5L, 5L, 6L, 6L, 6L, 7L, 7L, 7L, 8L, 8L, 8L, 9L, 9L, 9L, 10L,
      10L, 10L), .Label = c("1", "2", "3", "4", "5", "6", "7", "8",
      "9", "10"), class = "factor"))
  expect_equal(
    data[["diagnosis"]],
    c(1, 1, 1, 0, 0, 0, 1, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1,
      1, 1, 1, 0, 0, 0, 0, 0, 0),
    tolerance = 1e-4)
  expect_equal(
    data[["score"]],
    c(10, 24, 45, 24, 40, 67, 15, 30, 40, 35, 50, 78, 24, 54, 62, 14,
      25, 30, 11, 35, 41, 16, 32, 44, 33, 53, 66, 29, 55, 81),
    tolerance = 1e-4)
  expect_equal(
    data[["age"]],
    c(20, 20, 20, 23, 23, 23, 27, 27, 27, 21, 21, 21, 32, 32, 32, 31,
      31, 31, 43, 43, 43, 21, 21, 21, 34, 34, 34, 32, 32, 32),
    tolerance = 1e-4)
  expect_equal(
    data[["session"]],
    c(1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3,
      1, 2, 3, 1, 2, 3, 1, 2, 3),
    tolerance = 1e-4)
  # Testing column names
  expect_equal(
    names(data),
    c("participant", "diagnosis", "score", "age", "session"),
    fixed = TRUE)
  # Testing column classes
  expect_equal(
    xpectr::element_classes(data),
    c("factor", "numeric", "numeric", "numeric", "integer"),
    fixed = TRUE)
  # Testing column types
  expect_equal(
    xpectr::element_types(data),
    c("integer", "double", "double", "double", "integer"),
    fixed = TRUE)
  # Testing dimensions
  expect_equal(
    dim(data),
    c(30L, 5L))
  # Testing group keys
  expect_equal(
    colnames(dplyr::group_keys(data)),
    character(0),
    fixed = TRUE)
  ## Finished testing 'data'                                                ####

  data <- reposition_column(data, "age", .after = "session")


  ## Testing 'data'                                                         ####
  ## Initially generated by xpectr
  xpectr::set_test_seed(42)
  # Testing class
  expect_equal(
    class(data),
    "data.frame",
    fixed = TRUE)
  # Testing column values
  expect_equal(
    data[["participant"]],
    structure(c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 4L, 4L, 4L, 5L,
      5L, 5L, 6L, 6L, 6L, 7L, 7L, 7L, 8L, 8L, 8L, 9L, 9L, 9L, 10L,
      10L, 10L), .Label = c("1", "2", "3", "4", "5", "6", "7", "8",
      "9", "10"), class = "factor"))
  expect_equal(
    data[["diagnosis"]],
    c(1, 1, 1, 0, 0, 0, 1, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1,
      1, 1, 1, 0, 0, 0, 0, 0, 0),
    tolerance = 1e-4)
  expect_equal(
    data[["score"]],
    c(10, 24, 45, 24, 40, 67, 15, 30, 40, 35, 50, 78, 24, 54, 62, 14,
      25, 30, 11, 35, 41, 16, 32, 44, 33, 53, 66, 29, 55, 81),
    tolerance = 1e-4)
  expect_equal(
    data[["session"]],
    c(1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3,
      1, 2, 3, 1, 2, 3, 1, 2, 3),
    tolerance = 1e-4)
  expect_equal(
    data[["age"]],
    c(20, 20, 20, 23, 23, 23, 27, 27, 27, 21, 21, 21, 32, 32, 32, 31,
      31, 31, 43, 43, 43, 21, 21, 21, 34, 34, 34, 32, 32, 32),
    tolerance = 1e-4)
  # Testing column names
  expect_equal(
    names(data),
    c("participant", "diagnosis", "score", "session", "age"),
    fixed = TRUE)
  # Testing column classes
  expect_equal(
    xpectr::element_classes(data),
    c("factor", "numeric", "numeric", "integer", "numeric"),
    fixed = TRUE)
  # Testing column types
  expect_equal(
    xpectr::element_types(data),
    c("integer", "double", "double", "integer", "double"),
    fixed = TRUE)
  # Testing dimensions
  expect_equal(
    dim(data),
    c(30L, 5L))
  # Testing group keys
  expect_equal(
    colnames(dplyr::group_keys(data)),
    character(0),
    fixed = TRUE)
  ## Finished testing 'data'                                                ####


})

Try the cvms package in your browser

Any scripts or data that you put into this service are public.

cvms documentation built on Sept. 11, 2024, 6:22 p.m.