/tests/testthat/test-pivot_wider.R

https://github.com/markfairbanks/tidytable · R · 181 lines · 136 code · 40 blank · 5 comment · 0 complexity · 8016da290396585fb36f43a99df498df MD5 · raw file

  1. # tests from tidyr regarding pivot_wider
  2. test_that("can pivot all cols to wide", {
  3. df <- data.table(label = c("x", "y", "z"), val = 1:3)
  4. pivot_df <- pivot_wider.(df, names_from = label, values_from = val)
  5. expect_named(pivot_df, c("x", "y", "z"))
  6. expect_equal(nrow(pivot_df), 1)
  7. })
  8. test_that("non-pivoted cols are preserved", {
  9. df <- data.table(a = 1, label = c("x", "y"), val = 1:2)
  10. pivot_df <- pivot_wider.(df, names_from = label, values_from = val)
  11. expect_named(pivot_df, c("a", "x", "y"))
  12. expect_equal(nrow(pivot_df), 1)
  13. })
  14. test_that("implicit missings turn into explicit missings", {
  15. df <- data.table(a = 1:2, label = c("x", "y"), val = 1:2)
  16. pivot_df <- pivot_wider.(df, names_from = label, values_from = val)
  17. expect_equal(pivot_df$a, c(1, 2))
  18. expect_equal(pivot_df$x, c(1, NA))
  19. expect_equal(pivot_df$y, c(NA, 2))
  20. })
  21. test_that("can override default keys", {
  22. df <- data.table(row = 1:3,
  23. name = c("Sam", "Sam", "Bob"),
  24. var = c("age", "height", "age"),
  25. value = c(10, 1.5, 20))
  26. pv <- pivot_wider.(df, id_cols = name, names_from = var, values_from = value)
  27. expect_equal(nrow(pv), 2)
  28. })
  29. # multiple values ----------------------------------------------------------
  30. test_that("can pivot from multiple measure cols", {
  31. df <- data.table(row = 1, var = c("x", "y"), a = 1:2, b = 3:4)
  32. pv <- pivot_wider.(df, names_from = var, values_from = c(a, b))
  33. expect_named(pv, c("row", "a_x", "a_y", "b_x", "b_y"))
  34. expect_equal(pv$a_x, 1)
  35. expect_equal(pv$b_y, 4)
  36. })
  37. test_that("can pivot from multiple measure cols using all keys", {
  38. df <- data.table(var = c("x", "y"), a = 1:2, b = 3:4)
  39. pv <- pivot_wider.(df, names_from = var, values_from = c(a, b))
  40. expect_named(pv, c("a_x", "a_y", "b_x", "b_y"))
  41. expect_equal(pv$a_x, 1)
  42. expect_equal(pv$b_y, 4)
  43. })
  44. # select helpers ----------------------------------------------------------
  45. test_that("can pivot from multiple measure cols using helpers", {
  46. df <- data.table(row = 1, var = c("x", "y"), a = 1:2, b = 3:4)
  47. pv <- pivot_wider.(
  48. df,
  49. names_from = var,
  50. values_from = c(starts_with("a"), ends_with("b"))
  51. )
  52. expect_named(pv, c("row", "a_x", "a_y", "b_x", "b_y"))
  53. expect_equal(pv$a_x, 1)
  54. expect_equal(pv$b_y, 4)
  55. })
  56. # names args ----------------------------------------------------------
  57. test_that("can add a prefix", {
  58. df <- data.table(label = c("x", "y", "z"), val = 1:3)
  59. pivot_df <- pivot_wider.(
  60. df, names_from = label, values_from = val, names_prefix = "test_"
  61. )
  62. expect_named(pivot_df, c("test_x", "test_y", "test_z"))
  63. expect_equal(nrow(pivot_df), 1)
  64. })
  65. test_that("can add a prefix - multiple names_from", {
  66. df <- data.table(label1 = c("x", "y", "z"), label2 = c("x", "y", "z"), val = 1:3)
  67. pivot_df <- pivot_wider.(
  68. df, names_from = c(label1, label2),
  69. values_from = val,
  70. names_prefix = "test_"
  71. )
  72. expect_named(pivot_df, c("test_x_x", "test_y_y", "test_z_z"))
  73. expect_equal(nrow(pivot_df), 1)
  74. })
  75. test_that("can use names_glue", {
  76. df <- data.table(label = c("x", "y", "z"), val = 1:3)
  77. pivot_df <- pivot_wider.(
  78. df, names_from = label, values_from = val, names_glue = "test_{label}"
  79. )
  80. expect_named(pivot_df, c("test_x", "test_y", "test_z"))
  81. expect_equal(nrow(pivot_df), 1)
  82. })
  83. test_that("can use names_glue - multiple names_from", {
  84. df <- data.table(label1 = c("x", "y", "z"), label2 = c("x", "y", "z"), val = 1:3)
  85. pivot_df <- pivot_wider.(
  86. df, names_from = c(label1, label2), values_from = val,
  87. names_glue = "test_{label1}_{label2}"
  88. )
  89. expect_named(pivot_df, c("test_x_x", "test_y_y", "test_z_z"))
  90. expect_equal(nrow(pivot_df), 1)
  91. })
  92. test_that("names_glue works with .value", {
  93. df <- data.table(
  94. x = c("X", "Y"),
  95. y = 1:2,
  96. a = 1:2,
  97. b = 1:2
  98. )
  99. out <- pivot_wider.(df, names_from = x:y, values_from = a:b, names_glue = "{x}{y}_{.value}")
  100. expect_named(out, c("X1_a", "Y2_a", "X1_b", "Y2_b"))
  101. })
  102. test_that("can sort names", {
  103. df <- data.table(label = c("z", "y", "x"), val = 1:3)
  104. pivot_df <- pivot_wider.(
  105. df, names_from = label, values_from = val,
  106. names_glue = "test_{label}", names_sort = TRUE
  107. )
  108. expect_named(pivot_df, c("test_x", "test_y", "test_z"))
  109. expect_equal(nrow(pivot_df), 1)
  110. })
  111. # using values_fn ----------------------------------------------------------
  112. df <- data.table(a = c(1, 1, 2), stuff = c("x", "x", "x"), val = c(1, 10, 100))
  113. test_that("works with is.numeric helper", {
  114. df <- data.table(a = c(1, 1, 2), stuff = c("x", "x", "x"), val = c(1, 10, 100))
  115. pivot_df <- pivot_wider.(df, names_from = stuff, values_from = val, values_fn = sum)
  116. expect_equal(pivot_df$a, c(1, 2))
  117. expect_equal(pivot_df$x, c(11, 100))
  118. })
  119. test_that("can pivot all cols to wide with quosure function", {
  120. df <- data.table(label = c("x", "y", "z"), val = 1:3)
  121. pivot_wider_fn <- function(.df, names, values) {
  122. pivot_wider.(df, names_from = {{ names }}, values_from = {{ values }})
  123. }
  124. pivot_df <- pivot_wider_fn(df, names = label, values = val)
  125. expect_named(pivot_df, c("x", "y", "z"))
  126. expect_equal(nrow(pivot_df), 1)
  127. })
  128. test_that("can fill in missing cells", {
  129. df <- data.table(g = c(1, 2), var = c("x", "y"), val = c(1, 2))
  130. widen <- function(...) {
  131. df %>% pivot_wider.(names_from = var, values_from = val, ...)
  132. }
  133. expect_equal(widen()$x, c(1, NA))
  134. expect_equal(widen(values_fill = 0)$x, c(1, 0))
  135. expect_equal(widen(values_fill = list(val = 0))$x, c(1, 0))
  136. })
  137. test_that("values_fill only affects missing cells", {
  138. df <- tidytable(g = c(1, 2), names = c("x", "y"), value = c(1, NA))
  139. out <- pivot_wider.(df, names_from = names, values_from = value, values_fill = 0)
  140. expect_equal(out$y, c(0, NA))
  141. })