context("Test data.table_misc.R functions from mdmisc package")
library(testthat)
library(mdmisc)
library(data.table)
test_that('sample_rows is working and expected', {
# set.seed(2016)
size <- 20
dt <- data.table(
id = 1:size, A = sample(letters[1:3], size, replace = TRUE),
B = sample(c('Y','N'), size, replace = TRUE),
C = sample(1:100, size, replace = TRUE) + sample(30:70, size, replace = TRUE))
### Parameters checks
# sample_rows(dt, vol = 1000)
expect_error(sample_rows(dt, pct = 50), regexp = 'Please specify pct as a fraction')
expect_error(sample_rows(dt, vol = 1000, pct = 0.1), regexp = 'Please specify either pct or vol.')
expect_error(sample_rows(dt), regexp = 'Please specify either pct or vol.')
### Volumes (should NOT fail even without seeds)
# set.seed(2016)
dt_sampled <- sample_rows(dt, 0.5, grouping = 'A')
expect_equal(dt[, round(table(A)/2)], dt_sampled[, table(A)])
# set.seed(2016)
dt_sampled <- sample_rows(dt, 0.5, grouping = 'A', sort = TRUE)
expect_equal(dt[, round(table(A)/2)], dt_sampled[, table(A)])
expect_equal(dt_sampled[, A], sort(dt_sampled[, A]))
# set.seed(2016)
dt_sampled <- sample_rows(dt, 0.5, grouping = c('A','B'), sort = TRUE)
expect_true(all(between(dt[, round(table(A, B)/2)] - dt_sampled[, table(A, B)], -1, 1)))
})
test_that('leave_cols is working and expected', {
require(data.table)
dt <- data.table(a = 1:3, b = 1:3, g = 1:3)
expect_equal(leave_cols(dt, c('a', 'b')), dt[, .(a, b)])
expect_equal(leave_cols(dt, c('a')), dt[, .(a)])
})
test_that("reorder_vec is working as expected", {
df <- data.frame(a = 1:3, b = 1:3, g = 1:3)
expect_equal(reorder_vec(c("a", "b", "g"), "g first"), c("g", "a", "b"))
expect_equal(reorder_vec(names(df), "g first; a last"), c("g", "b", "a"))
})
test_that("reorder_columns is working as expected", {
require(data.table)
dt <- data.table::data.table(a = 1:3, b = 1:3, g = 1:3)
expect_equal(reorder_columns(dt, "g first"), dt[, .(g, a, b)])
expect_equal(reorder_columns(dt, "g first; a last"), dt[, .(g, b, a)])
})
test_that("count_NAs is working as expected", {
dt <- data.table::data.table(a = rnorm(n=1000, mean=20, sd=5),
b = rnorm(n=1000, mean=20, sd=5),
c = rnorm(n=1000, mean=20, sd=5))
dt[sample.int(nrow(dt), round(nrow(dt) * 0.15)), a := NA_real_]
expected_1 <- data.table::data.table(Variable = c("a", "b", "c"),
Count = c(150, 0, 0))
expected_2 <- data.table::data.table(Variable = c("a", "b", "c"),
Count = c(150, 0, 0),
Prop = c(15, 0, 0))
expected_3 <- data.frame(Count = 150, row.names = "Variable")
expected_4 <- data.frame(Count = 150, Prop = 15, row.names = "Variable")
expected_5 <- data.table::data.table(Variable = "a", Count = 150)
expected_6 <- data.table::data.table(Variable = "a", Count = 150, Prop = 15)
expect_equal(count_NAs(dt, print = FALSE), expected_1)
expect_equal(count_NAs(dt, prop = TRUE, print = FALSE), expected_2)
expect_equal(count_NAs(dt[, a], print = FALSE), expected_3)
expect_equal(count_NAs(dt[, a], prop = TRUE, print = FALSE), expected_4)
expect_equal(count_NAs(dt[, .(a)], print = FALSE), expected_5)
expect_equal(count_NAs(dt[, .(a)], prop = TRUE, print = FALSE), expected_6)
})
test_that("table_data_table is working as expected", {
require(data.table)
set.seed(2016)
dt <- data.table(A = sample(LETTERS[1:10], 200, replace = TRUE),
B = sample(LETTERS[1:10], 200, replace = TRUE))
expected_A <- data.table(
A = c("B", "D", "G", "A", "F", "C", "I", "E", "H", "J"),
N = c(26L, 25L, 24L, 23L, 20L, 19L, 18L, 17L, 15L, 13L),
PCT = c(13, 12.5, 12, 11.5, 10, 9.5, 9, 8.5, 7.5, 6.5))
expected_B <- data.table(
B = c("G", "I", "H", "F", "B", "A", "J", "E", "C", "D"),
N = c(28L, 22L, 21L, 21L, 21L, 20L, 19L, 19L, 17L, 12L),
PCT = c(14, 11, 10.5, 10.5, 10.5, 10, 9.5, 9.5, 8.5, 6))
expected_AB <- data.table(
A = c("B", "B", "G", "C", "H", "D", "D", "G",
"D", "G", "D", "F", "A", "F", "E", "I", "A", "C", "F", "A", "F",
"E", "B", "E", "J", "I", "B", "I", "A", "I", "D", "C", "H", "B",
"G", "A", "I", "D", "I", "G", "A", "C", "H", "B", "F", "E", "J",
"D", "B", "E", "G", "H", "G", "J", "A", "E", "B", "F", "A", "J",
"E", "I", "C", "J", "J", "G", "C", "C", "C", "A", "J", "G", "C",
"D", "H", "F", "A", "I", "H", "G", "D", "B", "F", "H", "C", "J"
),
B = c("G", "H", "B", "G", "E", "I", "C", "F", "J", "G", "B",
"H", "A", "G", "B", "G", "G", "J", "I", "F", "C", "C", "A", "I",
"F", "F", "J", "E", "E", "H", "A", "I", "I", "F", "J", "I", "I",
"F", "J", "A", "H", "F", "A", "E", "A", "D", "G", "E", "D", "A",
"H", "F", "C", "E", "B", "J", "B", "D", "D", "B", "H", "A", "C",
"D", "J", "E", "H", "B", "E", "C", "C", "D", "A", "G", "H", "B",
"J", "C", "B", "I", "H", "C", "J", "D", "D", "I"),
N = c(6L, 5L, 5L, 5L, 5L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L),
PCT = c(3, 2.5, 2.5, 2.5, 2.5, 2, 2, 2,
2, 2, 2, 2, 2, 2, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5,
1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5,
0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5,
0.5))
expect_equal(table_data_table(dt, "A"), expected_A)
expect_equal(table_data_table(dt, "B"), expected_B)
expect_equal(table_data_table(dt, c("A", "B")), expected_AB)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.