tests/testthat/test-count-tally.R

In dplyr: A Grammar of Data Manipulation

# count -------------------------------------------------------------------

test_that("count sorts output by keys by default", {
  # Due to usage of `summarise()` internally
  df <- tibble(x = c(2, 1, 1, 2, 1))
  out <- count(df, x)
  expect_equal(out, tibble(x = c(1, 2), n = c(3, 2)))
})

test_that("count can sort output by `n`", {
  df <- tibble(x = c(1, 1, 2, 2, 2))
  out <- count(df, x, sort = TRUE)
  expect_equal(out, tibble(x = c(2, 1), n = c(3, 2)))
})

test_that("count can rename grouping columns", {
  # But should it really allow this?
  df <- tibble(x = c(2, 1, 1, 2, 1))
  out <- count(df, y = x)
  expect_equal(out, tibble(y = c(1, 2), n = c(3, 2)))
})

test_that("informs if n column already present, unless overridden", {
  df1 <- tibble(n = c(1, 1, 2, 2, 2))
  expect_message(out <- count(df1, n), "already present")
  expect_named(out, c("n", "nn"))

  # not a good idea, but supported
  expect_message(out <- count(df1, n, name = "n"), NA)
  expect_named(out, "n")

  expect_message(out <- count(df1, n, name = "nn"), NA)
  expect_named(out, c("n", "nn"))

  df2 <- tibble(n = c(1, 1, 2, 2, 2), nn = 1:5)
  expect_message(out <- count(df2, n), "already present")
  expect_named(out, c("n", "nn"))

  expect_message(out <- count(df2, n, nn), "already present")
  expect_named(out, c("n", "nn", "nnn"))
})

test_that("name must be string", {
  df <- tibble(x = c(1, 2))
  expect_snapshot(error = TRUE, count(df, x, name = 1))
  expect_snapshot(error = TRUE, count(df, x, name = letters))
})

test_that("output includes empty levels with .drop = FALSE", {
  df <- tibble(f = factor("b", levels = c("a", "b", "c")))
  out <- count(df, f, .drop = FALSE)
  expect_equal(out$n, c(0, 1, 0))

  out <- count(group_by(df, f, .drop = FALSE))
  expect_equal(out$n, c(0, 1, 0))
})

test_that("count preserves grouping", {
  df <- tibble(g = c(1, 2, 2, 2))
  exp <- tibble(g = c(1, 2), n = c(1, 3))

  expect_equal(df |> count(g), exp)
  expect_equal(df |> group_by(g) |> count(), exp |> group_by(g))
})

test_that("output preserves class & attributes where possible", {
  df <- data.frame(g = c(1, 2, 2, 2))
  attr(df, "my_attr") <- 1

  out <- df |> count(g)
  expect_s3_class(out, "data.frame", exact = TRUE)
  expect_equal(attr(out, "my_attr"), 1)

  out <- df |> group_by(g) |> count()
  expect_s3_class(out, "grouped_df")
  expect_equal(group_vars(out), "g")
  # summarise() currently drops attributes
  expect_null(attr(out, "my_attr"))
})

test_that("works with dbplyr", {
  skip_if_not_installed("dbplyr")
  skip_if_not_installed("RSQLite")

  db <- dbplyr::memdb_frame(x = c(1, 1, 1, 2, 2))
  df1 <- db |> count(x) |> as_tibble()
  expect_equal(df1, tibble(x = c(1, 2), n = c(3, 2)))

  df2 <- db |> add_count(x) |> as_tibble()
  expect_equal(df2, tibble(x = c(1, 1, 1, 2, 2), n = c(3, 3, 3, 2, 2)))
})

test_that("dbplyr `count()` method has transient internal grouping (#6338, tidyverse/dbplyr#940)", {
  skip_if_not_installed("dbplyr")
  skip_if_not_installed("RSQLite")

  db <- dbplyr::memdb_frame(
    x = c(1, 1, 1, 2, 2),
    y = c("a", "a", "b", "c", "c")
  )

  df <- db |>
    count(x, y) |>
    collect()

  expect <- tibble(
    x = c(1, 1, 2),
    y = c("a", "b", "c"),
    n = c(2L, 1L, 2L)
  )

  expect_false(is_grouped_df(df))
  expect_identical(df, expect)
})

test_that("can only explicitly chain together multiple tallies", {
  expect_snapshot({
    df <- data.frame(g = c(1, 1, 2, 2), n = 1:4)

    df |> count(g, wt = n)
    df |> count(g, wt = n) |> count(wt = n)
    df |> count(n)
  })
})

test_that("count() owns errors (#6139)", {
  expect_snapshot({
    (expect_error(count(mtcars, new = 1 + "")))
    (expect_error(count(mtcars, wt = 1 + "")))
  })
})

test_that("count() `wt = n()` is deprecated", {
  df <- tibble(a = 1:5)

  expect_snapshot({
    count(df, a, wt = n())
  })
})

# tally -------------------------------------------------------------------

test_that("tally can sort output", {
  gf <- group_by(tibble(x = c(1, 1, 2, 2, 2)), x)
  out <- tally(gf, sort = TRUE)
  expect_equal(out, tibble(x = c(2, 1), n = c(3, 2)))
})

test_that("weighted tally drops NAs (#1145)", {
  df <- tibble(x = c(1, 1, NA))
  expect_equal(tally(df, x)$n, 2)
})

test_that("tally() drops last group (#5199) ", {
  df <- data.frame(x = 1, y = 2, z = 3)

  res <- expect_message(df |> group_by(x, y) |> tally(wt = z), NA)
  expect_equal(group_vars(res), "x")
})

test_that("tally() owns errors (#6139)", {
  expect_snapshot({
    (expect_error(tally(mtcars, wt = 1 + "")))
  })
})

test_that("tally() `wt = n()` is deprecated", {
  df <- tibble(a = 1:5)

  expect_snapshot({
    tally(df, wt = n())
  })
})

# add_count ---------------------------------------------------------------

test_that("add_count preserves grouping", {
  df <- tibble(g = c(1, 2, 2, 2))
  exp <- tibble(g = c(1, 2, 2, 2), n = c(1, 3, 3, 3))

  expect_equal(df |> add_count(g), exp)
  expect_equal(df |> group_by(g) |> add_count(), exp |> group_by(g))
})

test_that("`.drop` is defunct", {
  df <- tibble(f = factor("b", levels = c("a", "b", "c")))

  expect_snapshot(error = TRUE, {
    add_count(df, f, .drop = FALSE)
  })
})

test_that("add_count() `wt = n()` is deprecated", {
  df <- tibble(a = 1:5)

  expect_snapshot({
    add_count(df, a, wt = n())
  })
})

test_that("add_count() owns errors (#6139)", {
  expect_snapshot({
    (expect_error(add_count(mtcars, new = 1 + "")))
    (expect_error(add_count(mtcars, wt = 1 + "")))
  })
})

# add_tally ---------------------------------------------------------------

test_that("can add tallies of a variable", {
  df <- tibble(a = c(2, 1, 1))
  expect_equal(
    df |> group_by(a) |> add_tally(),
    group_by(tibble(a = c(2, 1, 1), n = c(1, 2, 2)), a)
  )
})

test_that("add_tally can be given a weighting variable", {
  df <- data.frame(a = c(1, 1, 2, 2, 2), w = c(1, 1, 2, 3, 4))

  out <- df |> group_by(a) |> add_tally(wt = w)
  expect_equal(out$n, c(2, 2, 9, 9, 9))

  out <- df |> group_by(a) |> add_tally(wt = w + 1)
  expect_equal(out$n, c(4, 4, 12, 12, 12))
})

test_that("can override output column", {
  df <- data.frame(g = c(1, 1, 2, 2, 2), x = c(3, 2, 5, 5, 5))
  expect_named(add_tally(df, name = "xxx"), c("g", "x", "xxx"))
})

test_that("add_tally() owns errors (#6139)", {
  expect_snapshot({
    (expect_error(add_tally(mtcars, wt = 1 + "")))
  })
})

test_that("add_tally() `wt = n()` is deprecated", {
  df <- tibble(a = 1:5)

  expect_snapshot({
    add_tally(df, wt = n())
  })
})