context("rectify")
test_that("rectify() has the right row/col headers", {
x <- data.frame(
row = c(1L, 1L, 2L, 2L),
col = c(1L, 2L, 1L, 2L),
data_type = rep("chr", 4),
chr = c("a", "b", "c", "d"),
stringsAsFactors = FALSE
)
rectify_correct <- tibble::tibble(
`row/col` = 1:2,
`1(A)` = 1:2,
`2(B)` = 1:2,
.name_repair = "minimal"
)
class(rectify_correct) <- c("cell_grid", class(rectify_correct))
expect_equal(rectify(x, values = row), rectify_correct)
rectify_correct <- tibble::tibble(
`row/col` = 1:2,
`1(A)` = 1L,
`2(B)` = 2L,
.name_repair = "minimal"
)
class(rectify_correct) <- c("cell_grid", class(rectify_correct))
expect_equal(rectify(x, values = col), rectify_correct)
})
test_that("rectify() isn't confused by same-named variables in context", {
x <- data.frame(
row = c(1L, 1L, 2L, 2L),
col = c(1L, 2L, 1L, 2L),
data_type = rep("chr", 4),
chr = c("a", "b", "c", "d"),
stringsAsFactors = FALSE
)
data_type <- "Oops!"
rectify_correct <- tibble::tibble(
`row/col` = 1:2,
`1(A)` = c("a", "c"),
`2(B)` = c("b", "d"),
.name_repair = "minimal"
)
class(rectify_correct) <- c("cell_grid", class(rectify_correct))
expect_equal(rectify(x, types = data_type), rectify_correct)
})
test_that("rectify() can use 'row', 'col' and 'data_type' as values", {
x <- data.frame(
row = c(1L, 1L, 2L, 2L),
col = c(1L, 2L, 1L, 2L),
data_type = c("chr", "chr", "int", "int"),
chr = c("a", "b", NA, NA),
int = c(NA, NA, 3L, 4L),
stringsAsFactors = FALSE
)
rectify_correct <- tibble::tibble(
`row/col` = 1:2,
`1(A)` = 1:2,
`2(B)` = 1:2,
.name_repair = "minimal"
)
class(rectify_correct) <- c("cell_grid", class(rectify_correct))
expect_equal(rectify(x, values = row), rectify_correct)
rectify_correct <- tibble::tibble(
`row/col` = 1:2,
`1(A)` = 1L,
`2(B)` = 2L,
.name_repair = "minimal"
)
class(rectify_correct) <- c("cell_grid", class(rectify_correct))
expect_equal(rectify(x, values = col), rectify_correct)
rectify_correct <- tibble::tibble(
`row/col` = 1:2,
`1(A)` = c("chr", "int"),
`2(B)` = c("chr", "int"),
.name_repair = "minimal"
)
class(rectify_correct) <- c("cell_grid", class(rectify_correct))
expect_equal(rectify(x, values = data_type), rectify_correct)
})
test_that("Blank initial rows and columns are handled", {
x <- data.frame(
row = c(2L, 2L, 3L, 3L),
col = c(2L, 3L, 2L, 3L),
data_type = rep("int", 4),
int = c(1L, 2L, 3L, NA),
stringsAsFactors = FALSE
)
rectify_correct <- tibble::tibble(
`row/col` = 2:3,
`2(B)` = c(1L, 3L),
`3(C)` = c(2L, NA_integer_),
.name_repair = "minimal"
)
class(rectify_correct) <- c("cell_grid", class(rectify_correct))
expect_equal(rectify(x), rectify_correct)
})
test_that("rectify() allows formatting formulas", {
x <- data.frame(
row = c(1L, 1L, 2L, 2L),
col = c(1L, 2L, 1L, 2L),
data_type = c("chr", "chr", "int", "int"),
chr = c("a", "b", NA, NA),
int = c(NA, NA, 3L, 4L),
stringsAsFactors = FALSE
)
rectify_correct <- tibble::tibble(
`row/col` = 1:2,
`1(A)` = c("A", "30"),
`2(B)` = c("B", "40"),
.name_repair = "minimal"
)
class(rectify_correct) <- c("cell_grid", class(rectify_correct))
expect_equal(
rectify(x, formatters = list(chr = toupper, int = ~ .x * 10)),
rectify_correct
)
})
test_that("Extraneous columns on the edges are dropped", {
x <- data.frame(
row = c(2L, 2L, 3L, 3L),
col = c(2L, 3L, 2L, 3L),
data_type = rep("int", 4),
int = c(1L, 2L, 3L, NA),
foo = 1:4,
stringsAsFactors = FALSE
)
rectify_correct <- tibble::tibble(
`row/col` = 2:3,
`2(B)` = c(1L, 3L),
`3(C)` = c(2L, NA_integer_),
.name_repair = "minimal"
)
class(rectify_correct) <- c("cell_grid", class(rectify_correct))
expect_equal(rectify(x), rectify_correct)
})
test_that("Blank columns amongst the data are retained", {
x <- data.frame(
row = c(2L, 2L, 4L, 4L),
col = c(2L, 4L, 2L, 4L),
data_type = rep("int", 4),
int = c(1L, 2L, 3L, NA),
stringsAsFactors = FALSE
)
rectify_correct <- tibble::tibble(
`row/col` = 2:4,
`2(B)` = c(1L, NA_integer_, 3L),
`3(C)` = c(NA, NA, NA),
`4(D)` = c(2L, NA_integer_, NA_integer_),
.name_repair = "minimal"
)
class(rectify_correct) <- c("cell_grid", class(rectify_correct))
expect_equal(rectify(x), rectify_correct)
})
test_that("rectify() handles zero-row data frames", {
expect_error(
rectify(dplyr::slice(as_cells(mtcars, col_names = TRUE), 0L)),
NA
)
})
test_that("rectify() stops on non-distinct cells", {
x <- data.frame(
row = c(1L, 1L, 2L, 2L),
col = c(1L, 2L, 1L, 2L),
data_type = rep("chr", 4),
chr = c("a", "b", "c", "d"),
stringsAsFactors = FALSE
)
expect_error(
rectify(dplyr::bind_rows(x, x), values = row),
"Row and column numbers must be distinct.\n Perhaps you meant to use a single sheet.",
fixed = TRUE
)
})
test_that("rectify() works on common data types", {
x <-
tibble::tibble(
lgl = c(TRUE, FALSE),
int = c(1L, 2L),
dbl = c(1, 2),
cpl = c(1i, 2i),
date = c(as.Date("2001-01-01"), as.Date("2001-01-02")),
chr = c("a", "b"),
fct = factor(c("c", "d")),
list = list(1:2, letters[1:2])
)
y <-
as_cells(x) %>%
rectify() %>%
dplyr::select(-1)
expect(all(purrr::map2_lgl(y, x, identical)), "Not all data returned")
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.