tests/testthat/test-tidy_quantiles.R

In fastplyr: Fast Alternatives to 'tidyverse' Functions

dplyr_quantiles <- function(data, vars, probs = seq(0, 1, 0.25), .by = NULL){
  dplyr::reframe(
    data,
    .quantile = cheapr::factor_(paste0("p", round(probs * 100, 10)), order = FALSE),
    across(all_of(vars), function(x) unname(quantile(x, na.rm = TRUE, probs = probs)))
  , .by = {{ .by }})
}

test_that("Edge cases", {

  quantile_factor <- cheapr::factor_(c("p0", "p25", "p50", "p75", "p100"), order = FALSE)

  expect_identical(
   tidy_quantiles(iris, Sepal.Length, probs = numeric(), pivot = "long"),
   cheapr::new_df(.quantile = factor(),
                  Sepal.Length = numeric())
  )

  expect_identical(
    tidy_quantiles(iris, Sepal.Length, probs = numeric(), pivot = "wide"),
    cheapr::new_df()
  )

  expect_identical(
    tidy_quantiles(f_slice(iris, 0), Sepal.Length, pivot = "long"),
    cheapr::new_df(
      .quantile = quantile_factor[0],
      Sepal.Length = numeric()
    )
  )

  expect_identical(
    tidy_quantiles(f_slice(iris, 0), Sepal.Length, pivot = "wide"),
    cheapr::new_df(
      p0 = numeric(),
      p25 = numeric(),
      p50 = numeric(),
      p75 = numeric(),
      p100 = numeric()
    )
  )

  expect_identical(
    tidy_quantiles(iris, pivot = "long"),
    cheapr::new_df(.quantile = quantile_factor)
  )

  expect_identical(
    tidy_quantiles(iris, pivot = "wide"),
    cheapr::new_df(
      p0 = numeric(),
      p25 = numeric(),
      p50 = numeric(),
      p75 = numeric(),
      p100 = numeric()
    )
  )

  expect_identical(
    tidy_quantiles(iris, pivot = "wide", .by = Species),
    cheapr::new_df(
      Species = iris$Species[0],
      p0 = numeric(),
      p25 = numeric(),
      p50 = numeric(),
      p75 = numeric(),
      p100 = numeric()
    )
  )

  expect_identical(
    tidy_quantiles(iris, pivot = "long", .by = Species),
    cheapr::new_df(
      Species = rep(unique(iris$Species), each = 5),
      .quantile = rep(quantile_factor, 3)
    )
  )

  expect_identical(
    tidy_quantiles(f_slice(iris, 0), Sepal.Length, pivot = "long", .by = Species),
    cheapr::new_df(
      Species = iris$Species[0],
      .quantile = quantile_factor[0],
      Sepal.Length = numeric()
    )
  )

  expect_identical(
    tidy_quantiles(f_slice(iris, 0), Sepal.Length, pivot = "wide", .by = Species),
    cheapr::new_df(
      Species = iris$Species[0],
      p0 = numeric(),
      p25 = numeric(),
      p50 = numeric(),
      p75 = numeric(),
      p100 = numeric()
    )
  )

  expect_identical(
    tidy_quantiles(f_slice(iris, 0), Sepal.Length, Sepal.Width, pivot = "wide", .by = Species),
    structure(
      list(Species = structure(integer(0), levels = c("setosa",
                                                      "versicolor", "virginica"),
                               class = "factor"), Sepal.Length_p0 = numeric(0),
           Sepal.Length_p25 = numeric(0), Sepal.Length_p50 = numeric(0),
           Sepal.Length_p75 = numeric(0), Sepal.Length_p100 = numeric(0),
           Sepal.Width_p0 = numeric(0), Sepal.Width_p25 = numeric(0),
           Sepal.Width_p50 = numeric(0), Sepal.Width_p75 = numeric(0),
           Sepal.Width_p100 = numeric(0)),
      class = "data.frame", row.names = integer(0)
    )
  )

  expect_identical(
    tidy_quantiles(f_slice(iris, 0), Sepal.Length, Sepal.Width,
                   pivot = "wide"),
    structure(
      list(Sepal.Length_p0 = numeric(0), Sepal.Length_p25 = numeric(0),
           Sepal.Length_p50 = numeric(0), Sepal.Length_p75 = numeric(0),
           Sepal.Length_p100 = numeric(0), Sepal.Width_p0 = numeric(0),
           Sepal.Width_p25 = numeric(0), Sepal.Width_p50 = numeric(0),
           Sepal.Width_p75 = numeric(0), Sepal.Width_p100 = numeric(0)),
      class = "data.frame", row.names = integer(0)
    )
  )

  # Unsorted, duplicate and integer probs

  expect_identical(
    tidy_quantiles(iris, Sepal.Length, probs = c(0L, 1L, 0L)),
    cheapr::new_df(
      .quantile = factor(c("p0", "p100", "p0")),
      Sepal.Length = c(
        min(iris$Sepal.Length), max(iris$Sepal.Length), min(iris$Sepal.Length)
      )
    )
  )

  expect_equal(
    tidy_quantiles(iris, Sepal.Length, probs = c(0, 0.5, 0, 0.25, 0.5)),
    dplyr_quantiles(iris, "Sepal.Length", probs = c(0, 0.5, 0, 0.25, 0.5))
  )

  expect_equal(
    tidy_quantiles(iris, Sepal.Length, probs = c(0, 0.5, 0, 0.25, 0.5),
                   .by = Species, .order = FALSE),
    dplyr_quantiles(iris, "Sepal.Length", probs = c(0, 0.5, 0, 0.25, 0.5),
                    .by = Species)
  )

})

test_that("unsorted probs", {
  expect_equal(
    iris |>
      tidy_quantiles(Sepal.Length, probs = seq(1, 0, -0.01)),
    iris |>
      dplyr_quantiles("Sepal.Length", probs = seq(1, 0, -0.01))
  )
  expect_equal(
    iris |>
      tidy_quantiles(Sepal.Length, probs = seq(1, 0, -0.01),
                     .by = Species, .order = FALSE),
    iris |>
      dplyr_quantiles("Sepal.Length", probs = seq(1, 0, -0.01),
                     .by = Species)
  )
})

test_that("Standard tests", {
  numeric_vars <- airquality |>
    f_select(-Month) |>
    names()

  expect_equal(
    dplyr_quantiles(airquality, "Ozone"),
    tidy_quantiles(airquality, .cols = "Ozone", pivot = "long")
  )
  expect_equal(
    dplyr_quantiles(airquality, "Ozone") |>
      tidyr::pivot_wider(names_from = ".quantile",
                         values_from = "Ozone"),
    tidy_quantiles(as_tbl(airquality), .cols = "Ozone", pivot = "wide")
  )

  expect_equal(
    dplyr_quantiles(dplyr::group_by(airquality, Month), "Ozone"),
    f_ungroup(tidy_quantiles(f_group_by(airquality, Month), .cols = "Ozone", pivot = "long"))
  )

  expect_equal(
    dplyr_quantiles(dplyr::group_by(airquality, Month), "Ozone") |>
      tidyr::pivot_wider(names_from = ".quantile",
                         values_from = "Ozone"),
    tidy_quantiles(f_group_by(airquality, Month), .cols = "Ozone", pivot = "wide")
  )


  expect_equal(
    dplyr_quantiles(dplyr::group_by(airquality, Month), "Ozone") |>
      dplyr::group_by(Month),
    tidy_quantiles(dplyr::group_by(airquality, Month), .cols = "Ozone", pivot = "long",
                   .drop_groups = FALSE)
  )

  expect_equal(
    dplyr_quantiles(airquality, "Ozone") |>
      tidyr::pivot_wider(names_from = ".quantile",
                         values_from = "Ozone"),
    tidy_quantiles(as_tbl(airquality), .cols = "Ozone", pivot = "wide")
  )

  expect_equal(
    dplyr_quantiles(dplyr::group_by(airquality, Month), numeric_vars),
    tidy_quantiles(as_tbl(airquality), .cols = numeric_vars,
                   .by = Month, pivot = "long")
  )

  expect_equal(
    dplyr_quantiles(dplyr::group_by(airquality, Month), numeric_vars) |>
      tidyr::pivot_wider(names_from = ".quantile",
                         values_from = 3:7),
    tidy_quantiles(as_tbl(airquality), .cols = numeric_vars,
                   .by = Month, pivot = "wide")
  )

  expect_equal(
    dplyr_quantiles(trees, names(trees)),
    tidy_quantiles(trees, .cols = names(trees), pivot = "long")
  )

  expect_equal(
    dplyr_quantiles(trees, names(trees)) |>
      tidyr::pivot_wider(names_from = 1, values_from = -1),
    tidy_quantiles(as_tbl(trees), .cols = names(trees), pivot = "wide")
  )

  expect_equal(
    dplyr_quantiles(as_tbl(EuStockMarkets), colnames(EuStockMarkets),
                    probs = seq(0, 1, 0.01)),
    tidy_quantiles(as_tbl(EuStockMarkets), .cols = colnames(EuStockMarkets),
                   probs = seq(0, 1, 0.01), pivot = "long")
  )
  expect_equal(
    dplyr_quantiles(as_tbl(EuStockMarkets), colnames(EuStockMarkets),
                    probs = seq(0, 1, 0.01)) |>
      tidyr::pivot_wider(names_from = 1, values_from = -1),
    tidy_quantiles(as_tbl(EuStockMarkets), .cols = colnames(EuStockMarkets),
                   probs = seq(0, 1, 0.01), pivot = "wide")
  )

})