Nothing
test_that("can pivot all cols to wide", {
df <- data.table(label = c("x", "y", "z"), val = 1:3)
pivot_df <- pivot_wider(df, names_from = label, values_from = val)
expect_named(pivot_df, c("x", "y", "z"))
expect_equal(nrow(pivot_df), 1)
expect_false(data.table::haskey(pivot_df))
})
test_that("`names_sort = FALSE` works", {
df <- tidytable(id = 1, names = c("b", "a", "c"), values = c(2, 1, 3))
pivot_df <- pivot_wider(df, names_from = names, values_from = values)
expect_named(pivot_df, c("id", "b", "a", "c"))
expect_equal(unlist(pivot_df, use.names = FALSE), c(1, 2, 1, 3))
})
test_that("non-pivoted cols are preserved", {
df <- data.table(a = 1, label = c("x", "y"), val = 1:2)
pivot_df <- pivot_wider(df, names_from = label, values_from = val)
expect_named(pivot_df, c("a", "x", "y"))
expect_equal(nrow(pivot_df), 1)
})
test_that("implicit missings turn into explicit missings", {
df <- data.table(a = 1:2, label = c("x", "y"), val = 1:2)
pivot_df <- pivot_wider(df, names_from = label, values_from = val)
expect_equal(pivot_df$a, c(1, 2))
expect_equal(pivot_df$x, c(1, NA))
expect_equal(pivot_df$y, c(NA, 2))
})
test_that("can override default keys", {
df <- data.table(row = 1:3,
name = c("Sam", "Sam", "Bob"),
var = c("age", "height", "age"),
value = c(10, 1.5, 20))
pv <- pivot_wider(df, id_cols = name, names_from = var, values_from = value)
expect_equal(nrow(pv), 2)
})
test_that("works with dates", {
df <- tidytable(employee = c("Bob", "Cindy", "Murph"),
employee_id = 1:3,
start_date = as.Date(paste0("2020-01-0", c(3, 1, 2))))
res <- pivot_wider(df, c(employee, start_date), employee_id)
expect_named(res, c("Bob_2020-01-03", "Cindy_2020-01-01", "Murph_2020-01-02"))
})
# multiple values ----------------------------------------------------------
test_that("can pivot from multiple measure cols", {
df <- data.table(row = 1, var = c("x", "y"), a = 1:2, b = 3:4)
pv <- pivot_wider(df, names_from = var, values_from = c(a, b))
expect_named(pv, c("row", "a_x", "a_y", "b_x", "b_y"))
expect_equal(pv$a_x, 1)
expect_equal(pv$b_y, 4)
})
test_that("can pivot from multiple measure cols using all keys", {
df <- data.table(var = c("x", "y"), a = 1:2, b = 3:4)
pv <- pivot_wider(df, names_from = var, values_from = c(a, b))
expect_named(pv, c("a_x", "a_y", "b_x", "b_y"))
expect_equal(pv$a_x, 1)
expect_equal(pv$b_y, 4)
})
# select helpers ----------------------------------------------------------
test_that("can pivot from multiple measure cols using helpers", {
df <- data.table(row = 1, var = c("x", "y"), a = 1:2, b = 3:4)
pv <- pivot_wider(
df,
names_from = var,
values_from = c(starts_with("a"), ends_with("b"))
)
expect_named(pv, c("row", "a_x", "a_y", "b_x", "b_y"))
expect_equal(pv$a_x, 1)
expect_equal(pv$b_y, 4)
})
# names args ----------------------------------------------------------
test_that("can add a prefix", {
df <- data.table(label = c("x", "y", "z"), val = 1:3)
pivot_df <- pivot_wider(
df, names_from = label, values_from = val, names_prefix = "test_"
)
expect_named(pivot_df, c("test_x", "test_y", "test_z"))
expect_equal(nrow(pivot_df), 1)
})
test_that("can add a prefix - multiple names_from", {
df <- data.table(label1 = c("x", "y", "z"), label2 = c("x", "y", "z"), val = 1:3)
pivot_df <- pivot_wider(
df, names_from = c(label1, label2),
values_from = val,
names_prefix = "test_"
)
expect_named(pivot_df, c("test_x_x", "test_y_y", "test_z_z"))
expect_equal(nrow(pivot_df), 1)
})
test_that("can use names_glue", {
df <- data.table(label = c("x", "y", "z"), val = 1:3)
pivot_df <- pivot_wider(
df, names_from = label, values_from = val, names_glue = "test_{label}"
)
expect_named(pivot_df, c("test_x", "test_y", "test_z"))
expect_equal(nrow(pivot_df), 1)
})
test_that("can use names_glue - multiple names_from", {
df <- data.table(label1 = c("x", "y", "z"), label2 = c("x", "y", "z"), val = 1:3)
pivot_df <- pivot_wider(
df, names_from = c(label1, label2), values_from = val,
names_glue = "test_{label1}_{label2}"
)
expect_named(pivot_df, c("test_x_x", "test_y_y", "test_z_z"))
expect_equal(nrow(pivot_df), 1)
})
test_that("names_glue works with .value", {
df <- data.table(
x = c("X", "Y"),
y = 1:2,
a = 1:2,
b = 1:2
)
out <- pivot_wider(df, names_from = x:y, values_from = a:b, names_glue = "{x}{y}_{.value}")
expect_named(out, c("X1_a", "Y2_a", "X1_b", "Y2_b"))
})
test_that("can sort names", {
df <- data.table(label = c("z", "y", "x"), val = 1:3)
pivot_df <- pivot_wider(
df, names_from = label, values_from = val,
names_glue = "test_{label}", names_sort = TRUE
)
expect_named(pivot_df, c("test_x", "test_y", "test_z"))
expect_equal(nrow(pivot_df), 1)
})
# using values_fn ----------------------------------------------------------
df <- data.table(a = c(1, 1, 2), stuff = c("x", "x", "x"), val = c(1, 10, 100))
test_that("works with is.numeric helper", {
df <- data.table(a = c(1, 1, 2), stuff = c("x", "x", "x"), val = c(1, 10, 100))
pivot_df <- pivot_wider(df, names_from = stuff, values_from = val, values_fn = sum)
expect_equal(pivot_df$a, c(1, 2))
expect_equal(pivot_df$x, c(11, 100))
})
test_that("can pivot all cols to wide with quosure function", {
df <- data.table(label = c("x", "y", "z"), val = 1:3)
pivot_wider_fn <- function(.df, names, values) {
pivot_wider(df, names_from = {{ names }}, values_from = {{ values }})
}
pivot_df <- pivot_wider_fn(df, names = label, values = val)
expect_named(pivot_df, c("x", "y", "z"))
expect_equal(nrow(pivot_df), 1)
})
test_that("can fill in missing cells", {
df <- data.table(g = c(1, 2), var = c("x", "y"), val = c(1, 2))
widen <- function(...) {
df %>% pivot_wider(names_from = var, values_from = val, ...)
}
expect_equal(widen()$x, c(1, NA))
expect_equal(widen(values_fill = 0)$x, c(1, 0))
expect_equal(widen(values_fill = list(val = 0))$x, c(1, 0))
})
test_that("values_fill only affects missing cells", {
df <- tidytable(g = c(1, 2), names = c("x", "y"), value = c(1, NA))
out <- pivot_wider(df, names_from = names, values_from = value, values_fill = 0)
expect_equal(out$y, c(0, NA))
})
test_that("can pivot data frames with spaced names, #569", {
df <- tidytable("a a" = 1,
"names" = c("a", "b"),
"vals" = 1:2)
out <- pivot_wider(df, names_from = names, values_from = vals)
expect_named(out, c("a a", "a", "b"))
})
# names_glue column order ----------------------------------------------------------
test_that("correctly labels columns when `names_glue` is used, #579", {
# length(values_from) == 1
df1 <- tidytable(
lettr = c("b", "a", "c"),
v1 = c("b", "a", "c")
)
result1 <- pivot_wider(
df1,
names_from = lettr,
values_from = v1,
names_glue = "{.value}_{lettr}"
)
expect_named(result1, c("v1_b", "v1_a", "v1_c"))
expect_equal(unname(unlist(result1)), c("b", "a", "c"))
# length(values_from) > 1
df2 <- tidytable(
lettr = c("b", "a", "c"),
v1 = c("b", "a", "c"),
v2 = c("b", "a", "c")
)
result2 <- pivot_wider(
df2,
names_from = lettr,
values_from = c(v1, v2),
names_glue = "{.value}_{lettr}"
)
expect_named(result2, c("v1_b", "v1_a", "v1_c", "v2_b", "v2_a", "v2_c"))
expect_equal(unname(unlist(result2)), c("b", "a", "c", "b", "a", "c"))
})
# unused -------------------------------------------------------------------
test_that("only uses used columns when `unused_fn = NULL`, #698", {
df <- data.frame(
a = LETTERS[1:2],
b = LETTERS[3:4],
val = 1:2
)
res <- df %>%
pivot_wider(
id_cols = character(0),
names_from = a,
values_from = val
)
expect_named(res, c("A", "B"))
expect_equal(res$A, 1)
expect_equal(res$B, 2)
})
test_that("`unused_fn` can summarize unused columns (#990)", {
df <- tidytable(
id = c(1, 1, 2, 2),
unused1 = c(1, 2, 4, 3),
unused2 = c(1, 2, 4, 3),
name = c("a", "b", "a", "b"),
value = c(1, 2, 3, 4)
)
# # By name
# res <- pivot_wider(df, id_cols = id, unused_fn = list(unused1 = max))
# expect_named(res, c("id", "a", "b", "unused1"))
# expect_identical(res$unused1, c(2, 4))
# Globally
res <- pivot_wider(df, id_cols = id, unused_fn = list)
expect_named(res, c("id", "a", "b", "unused1", "unused2"))
expect_identical(res$unused1, list(c(1, 2), c(4, 3)))
expect_identical(res$unused2, list(c(1, 2), c(4, 3)))
# https://stackoverflow.com/a/73554147
df <- data.frame(A = c(1, 1, 1, 2 , 2, 2),
B = c(3, 3, 3, 6, 6, 6),
C = c(2, 3, 9, 12, 2, 6),
D = c("a1", "a2", "a3", "a1", "a2", "a3"))
res <- df %>%
pivot_wider(id_cols = A, names_from = D, values_from = C, unused_fn = mean)
expect_named(res, c("A", "a1", "a2", "a3", "B"))
expect_equal(res$B, c(3, 6))
# Works with anonymous functions
res <- df %>%
pivot_wider(id_cols = A, names_from = D, values_from = C, unused_fn = ~ mean(.x))
expect_named(res, c("A", "a1", "a2", "a3", "B"))
expect_equal(res$B, c(3, 6))
})
test_that("`unused_fn` works with anonymous functions", {
df <- tidytable(
id = c(1, 1, 2, 2),
unused = c(1, NA, 4, 3),
name = c("a", "b", "a", "b"),
value = c(1, 2, 3, 4)
)
res <- pivot_wider(df, id_cols = id, unused_fn = ~ mean(.x, na.rm = TRUE))
expect_identical(res$unused, c(1, 3.5))
})
# test_that("`unused_fn` must result in single summary values", {
# df <- tidytable(
# id = c(1, 1, 2, 2),
# unused = c(1, 2, 4, 3),
# name = c("a", "b", "a", "b"),
# value = c(1, 2, 3, 4)
# )
#
# expect_snapshot(
# (expect_error(pivot_wider(df, id_cols = id, unused_fn = identity)))
# )
# })
# test_that("`unused_fn` works with expanded key from `id_expand`", {
# df <- tidytable(
# id = factor(c(1, 1, 2, 2), levels = 1:3),
# unused = c(1, 2, 4, 3),
# name = c("a", "b", "a", "b"),
# value = c(1, 2, 3, 4)
# )
#
# res <- pivot_wider(df, id_cols = id, id_expand = TRUE, unused_fn = max)
# expect_identical(res$id, factor(1:3))
# expect_identical(res$unused, c(2, 4, NA))
#
# res <- pivot_wider(df, id_cols = id, id_expand = TRUE, unused_fn = ~ sum(is.na(.x)))
# expect_identical(res$unused, c(0L, 0L, 1L))
# })
# test_that("can't fill implicit missings in unused column with `values_fill`", {
# # (in theory this would need `unused_fill`, but it would only be used when
# # `id_expand = TRUE`, which doesn't feel that useful)
#
# df <- tidytable(
# id = factor(c(1, 1, 2, 2), levels = 1:3),
# unused = c(1, 2, 4, 3),
# name = c("a", "b", "a", "b"),
# value = c(1, 2, 3, 4)
# )
#
# res <- pivot_wider(
# data = df,
# id_cols = id,
# id_expand = TRUE,
# unused_fn = list,
# values_fill = 0
# )
#
# expect_identical(res$a, c(1, 3, 0))
# expect_identical(res$b, c(2, 4, 0))
# expect_identical(res$unused, list(c(1, 2), c(4, 3), NA_real_))
#
# res <- pivot_wider(
# data = df,
# id_cols = id,
# id_expand = TRUE,
# unused_fn = list,
# values_fill = list(unused = 0)
# )
#
# expect_identical(res$unused, list(c(1, 2), c(4, 3), NA_real_))
# })
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.