tests/testthat/test-miscellaneous-issues.R

In collapse: Advanced and Fast Data Transformation

context("miscellaneous issues")

if(!is.null(attributes(identical(FALSE, TRUE)))) stop("OECD label issue")

# rm(list = ls())

options(warn = -1)

F <- getNamespace("collapse")$F

if(identical(Sys.getenv("NCRAN"), "TRUE")) {

test_that("Using a factor with unused levels does not pose a problem to flag, fdiff or fgrowth (#25)", {
  wlddev2 <- subset(wlddev, iso3c %in% c("ALB", "AFG", "DZA"))
  wlddev3 <- droplevels(wlddev2)
  expect_identical(L(wlddev3, 1, LIFEEX~iso3c, ~year), L(wlddev3, 1, ~iso3c, ~year, cols="LIFEEX"))
  expect_identical(L(wlddev3, -1:1, LIFEEX~iso3c, ~year), L(wlddev3, -1:1, ~iso3c, ~year, cols="LIFEEX"))
  expect_identical(droplevels(L(wlddev2, 1, ~iso3c, ~year, cols="LIFEEX")), L(wlddev3, 1, ~iso3c, ~year, cols="LIFEEX"))
  expect_identical(droplevels(L(wlddev2, -1:1, ~iso3c, ~year, cols="LIFEEX")), L(wlddev3, -1:1, ~iso3c, ~year, cols="LIFEEX"))
  expect_identical(droplevels(D(wlddev2, 1, 1, ~iso3c, ~year, cols="LIFEEX")), D(wlddev3, 1, 1, ~iso3c, ~year, cols="LIFEEX"))
  expect_identical(droplevels(D(wlddev2, -1:1, 1:2, ~iso3c, ~year, cols="LIFEEX")), D(wlddev3, -1:1, 1:2, ~iso3c, ~year, cols="LIFEEX"))
  expect_identical(droplevels(Dlog(wlddev2, 1, 1, ~iso3c, ~year, cols="LIFEEX")), Dlog(wlddev3, 1, 1, ~iso3c, ~year, cols="LIFEEX"))
  expect_identical(droplevels(Dlog(wlddev2, -1:1, 1:2, ~iso3c, ~year, cols="LIFEEX")), Dlog(wlddev3, -1:1, 1:2, ~iso3c, ~year, cols="LIFEEX"))
  expect_identical(droplevels(D(wlddev2, 1, 1, ~iso3c, ~year, cols="LIFEEX", rho = 0.95)), D(wlddev3, 1, 1, ~iso3c, ~year, cols="LIFEEX", rho = 0.95))
  expect_identical(droplevels(D(wlddev2, -1:1, 1:2, ~iso3c, ~year, cols="LIFEEX", rho = 0.95)), D(wlddev3, -1:1, 1:2, ~iso3c, ~year, cols="LIFEEX", rho = 0.95))
  expect_identical(droplevels(Dlog(wlddev2, 1, 1, ~iso3c, ~year, cols="LIFEEX", rho = 0.95)), Dlog(wlddev3, 1, 1, ~iso3c, ~year, cols="LIFEEX", rho = 0.95))
  expect_identical(droplevels(Dlog(wlddev2, -1:1, 1:2, ~iso3c, ~year, cols="LIFEEX", rho = 0.95)), Dlog(wlddev3, -1:1, 1:2, ~iso3c, ~year, cols="LIFEEX", rho = 0.95))
  expect_identical(droplevels(G(wlddev2, 1, 1, ~iso3c, ~year, cols="LIFEEX")), G(wlddev3, 1, 1, ~iso3c, ~year, cols="LIFEEX"))
  expect_identical(droplevels(G(wlddev2, -1:1, 1:2, ~iso3c, ~year, cols="LIFEEX")), G(wlddev3, -1:1, 1:2, ~iso3c, ~year, cols="LIFEEX"))

  expect_identical(L(wlddev3, 1, LIFEEX~iso3c), L(wlddev3, 1, ~iso3c, cols="LIFEEX"))
  expect_identical(L(wlddev3, -1:1, LIFEEX~iso3c), L(wlddev3, -1:1, ~iso3c, cols="LIFEEX"))
  expect_identical(droplevels(L(wlddev2, 1, ~iso3c, cols="LIFEEX")), L(wlddev3, 1, ~iso3c, cols="LIFEEX"))
  expect_identical(droplevels(L(wlddev2, -1:1, ~iso3c, cols="LIFEEX")), L(wlddev3, -1:1, ~iso3c, cols="LIFEEX"))
  expect_identical(droplevels(D(wlddev2, 1, 1, ~iso3c, cols="LIFEEX")), D(wlddev3, 1, 1, ~iso3c, cols="LIFEEX"))
  expect_identical(droplevels(D(wlddev2, -1:1, 1:2, ~iso3c, cols="LIFEEX")), D(wlddev3, -1:1, 1:2, ~iso3c, cols="LIFEEX"))
  expect_identical(droplevels(Dlog(wlddev2, 1, 1, ~iso3c, cols="LIFEEX")), Dlog(wlddev3, 1, 1, ~iso3c, cols="LIFEEX"))
  expect_identical(droplevels(Dlog(wlddev2, -1:1, 1:2, ~iso3c, cols="LIFEEX")), Dlog(wlddev3, -1:1, 1:2, ~iso3c, cols="LIFEEX"))
  expect_identical(droplevels(D(wlddev2, 1, 1, ~iso3c, cols="LIFEEX", rho = 0.95)), D(wlddev3, 1, 1, ~iso3c, cols="LIFEEX", rho = 0.95))
  expect_identical(droplevels(D(wlddev2, -1:1, 1:2, ~iso3c, cols="LIFEEX", rho = 0.95)), D(wlddev3, -1:1, 1:2, ~iso3c, cols="LIFEEX", rho = 0.95))
  expect_identical(droplevels(Dlog(wlddev2, 1, 1, ~iso3c, cols="LIFEEX", rho = 0.95)), Dlog(wlddev3, 1, 1, ~iso3c, cols="LIFEEX", rho = 0.95))
  expect_identical(droplevels(Dlog(wlddev2, -1:1, 1:2, ~iso3c, cols="LIFEEX", rho = 0.95)), Dlog(wlddev3, -1:1, 1:2, ~iso3c, cols="LIFEEX", rho = 0.95))
  expect_identical(droplevels(G(wlddev2, 1, 1, ~iso3c, cols="LIFEEX")), G(wlddev3, 1, 1, ~iso3c, cols="LIFEEX"))
  expect_identical(droplevels(G(wlddev2, -1:1, 1:2, ~iso3c, cols="LIFEEX")), G(wlddev3, -1:1, 1:2, ~iso3c, cols="LIFEEX"))

})

test_that("Using a factor with unused levels does not pose a problem to statistical functions", {
    wlddev2 <- fsubset(wlddev, iso3c %in% c("ALB", "AFG", "DZA"))
    d <- nv(wlddev2)
    m <- qM(d)
    v <- d$PCGDP
    w <- rep(1, length(v))
    f <- wlddev2$iso3c
    lev <- levels(f)
    fd <- fdroplevels(f)
    levd <- levels(fd)

    # Testing BY:
    expect_equal(attr(BY(d, f, sum), "row.names"), lev)
    expect_equal(dimnames(BY(m, f, sum))[[1L]], lev)
    expect_equal(names(BY(v, f, sum)), lev)

    # Fast Statistical Functions
    for(i in .FAST_STAT_FUN) {
      # print(i)
      FUN <- match.fun(i)
      expect_equal(attr(FUN(d, g = f), "row.names"), lev)
      expect_equal(dimnames(FUN(m, g = f))[[1L]], lev)
      expect_equal(names(FUN(v, g = f)), lev)
      expect_equal(attr(FUN(d, g = fd), "row.names"), levd)
      expect_equal(dimnames(FUN(m, g = fd))[[1L]], levd)
      expect_equal(names(FUN(v, g = fd)), levd)
      if(i != "fnobs") {
        expect_equal(attr(FUN(d, g = f, na.rm = FALSE), "row.names"), lev)
        expect_equal(dimnames(FUN(m, g = f, na.rm = FALSE))[[1L]], lev)
        expect_equal(names(FUN(v, g = f, na.rm = FALSE)), lev)
      }
      if(i %in% c("fsum", "fprod", "fmean", "fmedian", "fnth", "fmode", "fvar", "fsd")) {
        expect_equal(attr(FUN(d, g = f, w = w), "row.names"), lev)
        expect_equal(dimnames(FUN(m, g = f, w = w))[[1L]], lev)
        expect_equal(names(FUN(v, g = f, w = w)), lev)
        expect_equal(attr(FUN(d, g = f, w = w, na.rm = FALSE), "row.names"), lev)
        expect_equal(dimnames(FUN(m, g = f, w = w, na.rm = FALSE))[[1L]], lev)
        expect_equal(names(FUN(v, g = f, w = w, na.rm = FALSE)), lev)
        expect_equal(FUN(d, g = f, w = w), FUN(d, g = f))
        expect_equal(FUN(m, g = f, w = w), FUN(m, g = f))
        expect_equal(FUN(v, g = f, w = w), FUN(v, g = f))
      }
    }

    # Other Statistical Functions
    for(i in setdiff(c(.FAST_FUN, .OPERATOR_FUN), .FAST_STAT_FUN)) {
      # print(i)
      FUN <- match.fun(i)
      if(grepl("hd", i, ignore.case = TRUE)) {
        expect_equal(FUN(d, fl = f), FUN(d, fl = fd))
        expect_equal(FUN(m, fl = f), FUN(m, fl = fd))
        expect_equal(FUN(v, fl = f), FUN(v, fl = fd))
        expect_equal(FUN(d, fl = f, na.rm = FALSE), FUN(d, fl = fd, na.rm = FALSE))
        expect_equal(FUN(m, fl = f, na.rm = FALSE), FUN(m, fl = fd, na.rm = FALSE))
        expect_equal(FUN(v, fl = f, na.rm = FALSE), FUN(v, fl = fd, na.rm = FALSE))
        expect_equal(FUN(d, fl = f, w = w), FUN(d, fl = fd))
        expect_equal(FUN(m, fl = f, w = w), FUN(m, fl = fd))
        expect_equal(FUN(v, fl = f, w = w), FUN(v, fl = fd))
        expect_equal(FUN(d, fl = f, w = w, na.rm = FALSE), FUN(d, fl = fd, na.rm = FALSE))
        expect_equal(FUN(m, fl = f, w = w, na.rm = FALSE), FUN(m, fl = fd, na.rm = FALSE))
        expect_equal(FUN(v, fl = f, w = w, na.rm = FALSE), FUN(v, fl = fd, na.rm = FALSE))
      } else {
        expect_equal(FUN(d, g = f), FUN(d, g = fd))
        expect_equal(FUN(m, g = f), FUN(m, g = fd))
        expect_equal(FUN(v, g = f), FUN(v, g = fd))
        expect_equal(FUN(d, g = f, na.rm = FALSE), FUN(d, g = fd, na.rm = FALSE))
        expect_equal(FUN(m, g = f, na.rm = FALSE), FUN(m, g = fd, na.rm = FALSE))
        expect_equal(FUN(v, g = f, na.rm = FALSE), FUN(v, g = fd, na.rm = FALSE))
        if(i %in% c("fscale", "STD", "fbetween", "B", "fwithin", "W")) {
          expect_equal(FUN(d, g = f, w = w), FUN(d, g = fd))
          expect_equal(FUN(m, g = f, w = w), FUN(m, g = fd))
          expect_equal(FUN(v, g = f, w = w), FUN(v, g = fd))
          expect_equal(FUN(d, g = f, w = w, na.rm = FALSE), FUN(d, g = fd, na.rm = FALSE))
          expect_equal(FUN(m, g = f, w = w, na.rm = FALSE), FUN(m, g = fd, na.rm = FALSE))
          expect_equal(FUN(v, g = f, w = w, na.rm = FALSE), FUN(v, g = fd, na.rm = FALSE))
        }
      }
    }
})

if(requireNamespace("magrittr", quietly = TRUE)) {
library(magrittr)
test_that("Testing grouped_df methods", {
  for(sortg in c(TRUE, FALSE)) {
    for(retgrp in c(TRUE, FALSE)) {
      gdf <- wlddev %>% fsubset(year > 1990, region, income, PCGDP:ODA) %>% fgroup_by(region, income, return.groups = retgrp, sort = sortg)
      gdf[["wgt"]] <- round(abs(10*rnorm(fnrow(gdf))), 1)
      expect_visible(gdf %>% fmean)
      expect_visible(gdf %>% fmean(wgt))
      expect_equal(gdf %>% fmean(wgt) %>% slt(-sum.wgt), gdf %>% fmean(wgt, keep.w = FALSE))
      expect_visible(gdf %>% fmedian)
      expect_visible(gdf %>% fmedian(wgt))
      expect_equal(gdf %>% fmedian(wgt) %>% slt(-sum.wgt), gdf %>% fmedian(wgt, keep.w = FALSE))
      expect_visible(gdf %>% fnth)
      expect_visible(gdf %>% fnth(0.75))
      expect_visible(gdf %>% fnth(0.75, wgt))
      expect_equal(gdf %>% fnth(0.75, wgt) %>% slt(-sum.wgt), gdf %>% fnth(0.75, wgt, keep.w = FALSE))
      expect_visible(gdf %>% fmode)
      expect_visible(gdf %>% fmode(wgt))
      expect_equal(gdf %>% fmode(wgt) %>% slt(-sum.wgt), gdf %>% fmode(wgt, keep.w = FALSE))
      expect_visible(gdf %>% fsum)
      expect_visible(gdf %>% fsum(wgt))
      expect_equal(gdf %>% fsum(wgt) %>% slt(-sum.wgt), gdf %>% fsum(wgt, keep.w = FALSE))
      expect_visible(gdf %>% fprod)
      expect_visible(gdf %>% fprod(wgt))
      expect_equal(gdf %>% fprod(wgt) %>% slt(-prod.wgt), gdf %>% fprod(wgt, keep.w = FALSE))
      expect_visible(gdf %>% fsd)
      expect_visible(gdf %>% fsd(wgt))
      expect_equal(gdf %>% fsd(wgt) %>% slt(-sum.wgt), gdf %>% fsd(wgt, keep.w = FALSE))
      expect_visible(gdf %>% fvar)
      expect_visible(gdf %>% fvar(wgt))
      expect_equal(gdf %>% fvar(wgt) %>% slt(-sum.wgt), gdf %>% fvar(wgt, keep.w = FALSE))
      expect_visible(gdf %>% fmin)
      expect_visible(gdf %>% fmax)
      expect_visible(gdf %>% ffirst)
      expect_visible(gdf %>% flast)
      expect_visible(gdf %>% fnobs)
      expect_visible(gdf %>% fndistinct)
      expect_visible(gdf %>% collapg)
      expect_visible(gdf %>% varying)
      expect_visible(gdf %>% varying(any_group = FALSE))
      expect_visible(gdf %>% fmean(w = wgt)) # good?
      expect_equal(gdf %>% collapg(w = wgt) %>% slt(-wgt), gdf %>% collapg(w = wgt, keep.w = FALSE))
      expect_visible(gdf %>% fscale)
      expect_visible(gdf %>% fscale(wgt))
      expect_equal(gdf %>% fscale(wgt) %>% slt(-wgt), gdf %>% fscale(wgt, keep.w = FALSE))
      expect_visible(gdf %>% STD)
      expect_visible(gdf %>% STD(wgt))
      expect_equal(gdf %>% STD(wgt) %>% slt(-wgt), gdf %>% STD(wgt, keep.w = FALSE))
      expect_equal(gdf %>% fscale, gdf %>% STD(stub = FALSE))
      expect_visible(gdf %>% fbetween)
      expect_visible(gdf %>% fbetween(wgt))
      expect_equal(gdf %>% fbetween(wgt) %>% slt(-wgt), gdf %>% fbetween(wgt, keep.w = FALSE))
      expect_visible(gdf %>% B)
      expect_visible(gdf %>% B(wgt))
      expect_equal(gdf %>% B(wgt) %>% slt(-wgt), gdf %>% B(wgt, keep.w = FALSE))
      expect_equal(gdf %>% fbetween, gdf %>% B(stub = FALSE))
      expect_visible(gdf %>% fwithin)
      expect_visible(gdf %>% fwithin(wgt))
      expect_equal(gdf %>% fwithin(wgt) %>% slt(-wgt), gdf %>% fwithin(wgt, keep.w = FALSE))
      expect_visible(gdf %>% W)
      expect_visible(gdf %>% W(wgt))
      expect_equal(gdf %>% W(wgt) %>% slt(-wgt), gdf %>% W(wgt, keep.w = FALSE))
      expect_equal(gdf %>% fwithin, gdf %>% W(stub = FALSE))
      expect_visible(gdf %>% fcumsum)
      expect_visible(gdf %>% flag)
      expect_visible(gdf %>% L)
      expect_visible(gdf %>% F)
      expect_true(all_obj_equal(gdf %>% flag, gdf %>% L(stubs = FALSE), gdf %>% F(-1, stubs = FALSE)))
      expect_true(all_obj_equal(gdf %>% flag(-3:3), gdf %>% L(-3:3), gdf %>% F(3:-3)))
      expect_visible(gdf %>% fdiff)
      expect_visible(gdf %>% D)
      expect_true(all_obj_equal(gdf %>% fdiff, gdf %>% D(stubs = FALSE)))
      expect_equal(gdf %>% fdiff(-2:2, 1:2), gdf %>% D(-2:2, 1:2))
      expect_visible(gdf %>% fdiff(rho = 0.95))
      expect_visible(gdf %>% fdiff(-2:2, 1:2, rho = 0.95))
      expect_visible(gdf %>% fdiff(log = TRUE))
      expect_visible(gdf %>% fdiff(-2:2, 1:2, log = TRUE))
      expect_visible(gdf %>% fdiff(log = TRUE, rho = 0.95))
      expect_visible(gdf %>% fdiff(-2:2, 1:2, log = TRUE, rho = 0.95))
      expect_visible(gdf %>% fgrowth)
      expect_visible(gdf %>% G)
      expect_true(all_obj_equal(gdf %>% fgrowth, gdf %>% G(stubs = FALSE)))
      expect_equal(gdf %>% fgrowth(-2:2, 1:2), gdf %>% G(-2:2, 1:2))
      expect_visible(gdf %>% fgrowth(scale = 1))
      expect_visible(gdf %>% fgrowth(-2:2, 1:2, scale = 1))
      expect_visible(gdf %>% fgrowth(logdiff = TRUE))
      expect_visible(gdf %>% fgrowth(-2:2, 1:2, logdiff = TRUE))
      expect_visible(gdf %>% fgrowth(logdiff = TRUE, scale = 1))
      expect_visible(gdf %>% fgrowth(-2:2, 1:2, logdiff = TRUE, scale = 1))
      expect_equal(BY(gby(iris,Species), sum), BY(nv(gby(iris,Species)), sum))
    }
  }
})
}

# Also better not run on CRAN...
test_that("0-length vectors give expected output", {
  funs <- .c(fsum, fprod, fmean, fmedian, fmin, fmax, fnth, fcumsum, fbetween, fwithin, fscale)
  for(i in funs) {
    FUN <- match.fun(i)
    if(i %!in% .c(fsum, fmin, fmax, fcumsum, fprod, fmean, fmedian, fnth)) {
      expect_true(all_identical(FUN(numeric(0)), FUN(integer(0)), numeric(0)))
    } else {
      expect_identical(FUN(numeric(0)), numeric(0))
      if(i %in% .c(fmean, fprod, fnth, fmedian)) expect_identical(FUN(integer(0)), NA_real_)
      else expect_identical(FUN(integer(0)), integer(0))
    }
  }
  funs <- .c(fmode, ffirst, flast)
  for(i in funs) {
    FUN <- match.fun(i)
    expect_identical(FUN(numeric(0)), numeric(0))
    expect_identical(FUN(integer(0)), integer(0))
    expect_identical(FUN(character(0)), character(0))
    expect_identical(FUN(logical(0)), logical(0))
    expect_identical(FUN(factor(0)), factor(0))
  }
  funs <- .c(fvar, fsd)
  for(i in funs) {
    FUN <- match.fun(i)
    expect_identical(FUN(numeric(0)), NA_real_)
    expect_identical(FUN(integer(0)), NA_real_)
  }
  funs <- .c(fnobs, fndistinct)
  for(i in funs) {
    FUN <- match.fun(i)
    expect_identical(FUN(numeric(0)), 0L)
    expect_identical(FUN(integer(0)), 0L)
  }
  funs <- .c(flag, fdiff, fgrowth)
  for(i in funs) {
    FUN <- match.fun(i)
    expect_error(FUN(numeric(0)))
    expect_error(FUN(integer(0)))
  }
  funs <- .c(groupid, seqid)
  for(i in funs) {
    FUN <- match.fun(i)
    expect_identical(FUN(numeric(0)), integer(0))
    expect_identical(FUN(integer(0)), integer(0))
  }
  expect_identical(varying(numeric(0)), FALSE)
  expect_identical(TRA(numeric(0), 1), numeric(0))
})

}

X <- matrix(rnorm(1000), ncol = 10)
g <- qG(sample.int(10, 100, TRUE))
gf <- as_factor_qG(g)
funs <- grep("hd|log", c(.FAST_FUN, .OPERATOR_FUN), ignore.case = TRUE, invert = TRUE, value = TRUE)

test_that("functions work on plain matrices", {
  F <- getNamespace("collapse")$F
  for(i in funs) {
    expect_visible(match.fun(i)(X))
    expect_visible(match.fun(i)(X, g = g))
    expect_visible(match.fun(i)(X, g = gf))
    expect_visible(match.fun(i)(X, g = g, use.g.names = FALSE))
    expect_visible(match.fun(i)(X, g = gf, use.g.names = FALSE))
  }
})

Xl <- mctl(X)

test_that("functions work on plain lists", {
  F <- getNamespace("collapse")$F
  for(i in funs) {
    expect_visible(match.fun(i)(Xl))
    expect_visible(match.fun(i)(Xl, g = g, by = g))
    expect_visible(match.fun(i)(Xl, g = gf, by = gf))
    expect_visible(match.fun(i)(X, g = g, by = g, use.g.names = FALSE))
    expect_visible(match.fun(i)(X, g = gf, by = gf, use.g.names = FALSE))
  }
})

test_that("time series functions work inside lm", {
  expect_equal(unname(coef(lm(mpg ~ L(cyl, 0:2), mtcars))), unname(coef(lm(mpg ~ cyl + L(cyl, 1) + L(cyl, 2), mtcars))))
  expect_equal(unname(coef(lm(mpg ~ F(cyl, 0:2), mtcars))), unname(coef(lm(mpg ~ cyl + F(cyl, 1) + F(cyl, 2), mtcars))))
  expect_equal(unname(coef(lm(mpg ~ D(cyl, 0:2), mtcars))), unname(coef(lm(mpg ~ cyl + D(cyl, 1) + D(cyl, 2), mtcars))))
  expect_equal(unname(coef(lm(mpg ~ G(cyl, 0:2), mtcars))), unname(coef(lm(mpg ~ cyl + G(cyl, 1) + G(cyl, 2), mtcars))))

  expect_equal(unname(coef(lm(mpg ~ L(L(cyl, 0:2)), mtcars))), unname(coef(lm(mpg ~ L(cyl) + L(cyl, 2) + L(cyl, 3), mtcars))))
  expect_equal(unname(coef(lm(mpg ~ L(F(cyl, 0:2)), mtcars))), unname(coef(lm(mpg ~ L(cyl) + cyl + F(cyl, 1), mtcars))))
  expect_equal(unname(coef(lm(mpg ~ L(D(cyl, 0:2)), mtcars))), unname(coef(lm(mpg ~ L(cyl) + L(D(cyl)) + L(D(cyl, 2)), mtcars))))
  expect_equal(unname(coef(lm(mpg ~ L(G(cyl, 0:2)), mtcars))), unname(coef(lm(mpg ~ L(cyl) + L(G(cyl)) + L(G(cyl, 2)), mtcars))))

})

test_that("functions using welfords method properly deal with zero weights", {
  for(g in list(NULL, rep(1L, 3))) {
    expect_equal(unattrib(fvar(x = c(2, 1, 0), g = g, w = c(1, 1, 0), na.rm = TRUE)), 0.5)
    expect_equal(unattrib(fvar(x = c(2, 1, 3), g = g, w = c(0, 1, 1), na.rm = FALSE)), 2)
    expect_equal(unattrib(fsd(x = c(2, 1, 0), g = g, w = c(1, 1, 0), na.rm = TRUE)), sqrt(0.5))
    expect_equal(unattrib(fsd(x = c(2, 1, 3), g = g, w = c(0, 1, 1), na.rm = FALSE)), sqrt(2))
    expect_equal(unattrib(fscale(x = c(2, 1, 0), g = g, w = c(1, 1, 0), na.rm = TRUE)), (c(2, 1, 0)-1.5)/sqrt(0.5))
    expect_equal(unattrib(fscale(x = c(2, 1, 3), g = g, w = c(0, 1, 1), na.rm = FALSE)), (c(2, 1, 3)-2)/sqrt(2))
    expect_equal(unattrib(qsu(x = c(2, 1, 0), g = g, w = c(1, 1, 0))), c(2, 1.5, sqrt(0.5), 1, 2))
    expect_equal(unattrib(qsu(x = c(2, 1, 3), g = g, w = c(0, 1, 1))), c(2, 2, sqrt(2), 1, 3))
    expect_equal(unattrib(qsu(x = c(2, 1, 0), g = g, w = c(1, 1, 0), higher = TRUE))[1:5], c(2, 1.5, sqrt(0.5), 1, 2))
    expect_equal(unattrib(qsu(x = c(2, 1, 3), g = g, w = c(0, 1, 1), higher = TRUE))[1:5], c(2, 2, sqrt(2), 1, 3))

  }
})


test_that("singleton groups are handled properly by all statistical functions", {
  w <- rep(1, fnrow(wlddev))
  # Ordered
  g <- GRP(seq_row(wlddev), return.groups = FALSE)
  expect_equal(fmode(wlddev, g), wlddev)
  expect_equal(fmode(wlddev, g, w), wlddev)
  expect_equal(ffirst(wlddev, g), wlddev)
  expect_equal(flast(wlddev, g), wlddev)
  expect_equal(dapply(fndistinct(wlddev, g), unattrib), dapply(wlddev, function(x) as.integer(!is.na(x))))
  expect_equal(fmode(wlddev, g, na.rm = FALSE), wlddev)
  expect_equal(fmode(wlddev, g, w, na.rm = FALSE), wlddev)
  expect_equal(ffirst(wlddev, g, na.rm = FALSE), wlddev)
  expect_equal(flast(wlddev, g, na.rm = FALSE), wlddev)
  expect_equal(dapply(fndistinct(wlddev, g, na.rm = FALSE), unattrib), dapply(wlddev, function(x) rep(1L, length(x))))
  for(FUN in list(fmean, fmedian, fnth, fsum, fprod, fmin, fmax, fbetween, fcumsum)) {
    # print(FUN)
    expect_equal(FUN(nv(wlddev), g = g), nv(wlddev))
    expect_equal(FUN(nv(wlddev), g = g, na.rm = FALSE), nv(wlddev))
    expect_equal(FUN(nv(wlddev), g = g, w = w), nv(wlddev))
    expect_equal(FUN(nv(wlddev), g = g, w = w, na.rm = FALSE), nv(wlddev))
  }
  for(FUN in list(fvar, fsd, fscale, flag, fdiff, fgrowth)) {
    expect_true(all(dapply(FUN(nv(wlddev), g = g), allNA)))
    expect_true(all(dapply(FUN(nv(wlddev), g = g, na.rm = FALSE), allNA)))
    expect_true(all(dapply(FUN(nv(wlddev), g = g, w = w, n = -1), allNA)))
    expect_true(all(dapply(FUN(nv(wlddev), g = g, w = w, n = -1, na.rm = FALSE), allNA)))
  }
  # Unordered
  o <- radixorder(rnorm(fnrow(wlddev)))
  g <- GRP(o, return.groups = FALSE)
  wlduo <- setRownames(ss(wlddev, radixorder(o)))
  expect_equal(fmode(wlddev, g), wlduo)
  expect_equal(fmode(wlddev, g, w), wlduo)
  expect_equal(ffirst(wlddev, g), wlduo)
  expect_equal(flast(wlddev, g), wlduo)
  expect_equal(dapply(fndistinct(wlddev, g), unattrib), dapply(wlduo, function(x) as.integer(!is.na(x))))
  expect_equal(fmode(wlddev, g, na.rm = FALSE), wlduo)
  expect_equal(fmode(wlddev, g, w, na.rm = FALSE), wlduo)
  expect_equal(ffirst(wlddev, g, na.rm = FALSE), wlduo)
  expect_equal(flast(wlddev, g, na.rm = FALSE), wlduo)
  expect_equal(dapply(fndistinct(wlddev, g, na.rm = FALSE), unattrib), dapply(wlduo, function(x) rep(1L, length(x))))
  for(FUN in list(fmean, fmedian, fnth, fsum, fprod, fmin, fmax)) {
    # print(FUN)
    expect_equal(FUN(nv(wlddev), g = g), nv(wlduo))
    expect_equal(FUN(nv(wlddev), g = g, na.rm = FALSE), nv(wlduo))
    expect_equal(FUN(nv(wlddev), g = g, w = w), nv(wlduo))
    expect_equal(FUN(nv(wlddev), g = g, w = w, na.rm = FALSE), nv(wlduo))
  }
  for(FUN in list(fbetween, fcumsum)) {
    expect_equal(FUN(nv(wlddev), g), nv(wlddev))
    expect_equal(FUN(nv(wlddev), g, na.rm = FALSE), nv(wlddev))
    expect_equal(FUN(nv(wlddev), g, w), nv(wlddev))
    expect_equal(FUN(nv(wlddev), g, w, na.rm = FALSE), nv(wlddev))
  }
  for(FUN in list(fvar, fsd, fscale, flag, fdiff, fgrowth)) {
    expect_true(all(dapply(FUN(nv(wlddev), g = g), allNA)))
    expect_true(all(dapply(FUN(nv(wlddev), g = g, na.rm = FALSE), allNA)))
    expect_true(all(dapply(FUN(nv(wlddev), g = g, w = w, n = -1), allNA)))
    expect_true(all(dapply(FUN(nv(wlddev), g = g, w = w, n = -1, na.rm = FALSE), allNA)))
  }
})


test_that("functions work for data frames with zero rows", {
  mtc0 <- qDF(mtcars)[NULL, ]
  expect_equal(mtc0, funique(mtc0))
  expect_equal(mtc0, funique(mtc0, sort = TRUE))
  expect_equal(mtc0, roworderv(mtc0))
  expect_visible(colorder(mtc0, mpg, hp))
  expect_visible(GRP(mtc0))
  expect_visible(fgroup_by(mtc0, cyl, vs, am))
  expect_visible(GRP(mtc0, sort = FALSE))
  expect_visible(fgroup_by(mtc0, cyl, vs, am, sort = FALSE))
  expect_visible(fduplicated(mtc0))
  expect_false(any_duplicated(mtc0))
  expect_visible(fselect(mtc0, hp, carb))
  expect_visible(get_vars(mtc0, 9:8))
})

test_that("issue with integer followed by NA #432", {
    for (f in setdiff(.FAST_STAT_FUN, c("fvar", "fsd", "fnobs", "fndistinct"))) {
      # if(!isTRUE(all.equal(match.fun(f)(c(10L, NA)), 10L))) print(f)
      expect_equal(match.fun(f)(c(10L, NA)), 10L)
      expect_equal(match.fun(f)(c(NA, 10L)), 10L)
      expect_equal(match.fun(f)(c(10, NA)), 10)
      expect_equal(match.fun(f)(c(NA, 10)), 10)
      expect_equal(match.fun(f)(c(10L, NA), g = rep(1L, 2), use.g.names = FALSE), 10L)
      expect_equal(match.fun(f)(c(NA, 10L), g = rep(1L, 2), use.g.names = FALSE), 10L)
      expect_equal(match.fun(f)(c(10, NA), g = rep(1L, 2), use.g.names = FALSE), 10)
      expect_equal(match.fun(f)(c(NA, 10), g = rep(1L, 2), use.g.names = FALSE), 10)
      # na.rm = FALSE
      if(f %!in% c("fmode", "ffirst")) expect_equal(match.fun(f)(c(10L, NA), na.rm = FALSE), NA_integer_)
      if(f != "flast") expect_equal(match.fun(f)(c(NA, 10L), na.rm = FALSE), NA_integer_)
      if(f %!in% c("fmode", "ffirst")) expect_equal(match.fun(f)(c(10, NA), na.rm = FALSE), NA_real_)
      if(f != "flast") expect_equal(match.fun(f)(c(NA, 10), na.rm = FALSE), NA_real_)
      # Some functions are optimized and don't check here
      # expect_equal(match.fun(f)(c(10L, NA), g = rep(1L, 2), na.rm = FALSE, use.g.names = FALSE), NA_integer_)
      # expect_equal(match.fun(f)(c(NA, 10L), g = rep(1L, 2), na.rm = FALSE, use.g.names = FALSE), NA_integer_)
      if(f %!in% c("fmode", "ffirst")) expect_equal(match.fun(f)(c(10, NA), g = rep(1L, 2), na.rm = FALSE, use.g.names = FALSE), NA_real_)
      if(f != "flast") expect_equal(match.fun(f)(c(NA, 10), g = rep(1L, 2), na.rm = FALSE, use.g.names = FALSE), NA_real_)
    }
  if(Sys.getenv("OMP") == "TRUE") {
    for (f in c("fsum", "fmean", "fmode", "fnth", "fmedian")) {
      expect_equal(match.fun(f)(c(10L, rep(NA_integer_, 1e5)), nthreads = 2L), 10L)
      expect_equal(match.fun(f)(c(rep(NA_integer_, 1e5), 10L), nthreads = 2L), 10L)
      expect_equal(match.fun(f)(c(10, rep(NA_real_, 1e5)), nthreads = 2L), 10)
      expect_equal(match.fun(f)(c(rep(NA_real_, 1e5), 10), nthreads = 2L), 10)
      expect_equal(match.fun(f)(c(10L, rep(NA_integer_, 1e5)), g = rep(1L, 1e5+1), nthreads = 2L, use.g.names = FALSE), 10L)
      expect_equal(match.fun(f)(c(rep(NA_integer_, 1e5), 10L), g = rep(1L, 1e5+1), nthreads = 2L, use.g.names = FALSE), 10L)
      expect_equal(match.fun(f)(c(10, rep(NA_real_, 1e5)), g = rep(1L, 1e5+1), nthreads = 2L, use.g.names = FALSE), 10)
      expect_equal(match.fun(f)(c(rep(NA_real_, 1e5), 10), g = rep(1L, 1e5+1), nthreads = 2L, use.g.names = FALSE), 10)
      # na.rm = FALSE
      expect_equal(match.fun(f)(c(10L, rep(NA_integer_, 1e5)), na.rm = FALSE, nthreads = 2L), NA_integer_)
      expect_equal(match.fun(f)(c(rep(NA_integer_, 1e5), 10L), na.rm = FALSE, nthreads = 2L), NA_integer_)
      expect_equal(match.fun(f)(c(10, rep(NA_real_, 1e5)), na.rm = FALSE, nthreads = 2L), NA_real_)
      expect_equal(match.fun(f)(c(rep(NA_real_, 1e5), 10), na.rm = FALSE, nthreads = 2L), NA_real_)
      # Some functions are optimized and don't check here
      # expect_equal(match.fun(f)(c(10L, rep(NA_integer_, 1e5)), g = rep(1L, 1e5+1), na.rm = FALSE, nthreads = 2L, use.g.names = FALSE), NA_integer_)
      # expect_equal(match.fun(f)(c(rep(NA_integer_, 1e5), 10L), g = rep(1L, 1e5+1), na.rm = FALSE, nthreads = 2L, use.g.names = FALSE), NA_integer_)
      expect_equal(match.fun(f)(c(10, rep(NA_real_, 1e5)), g = rep(1L, 1e5+1), na.rm = FALSE, nthreads = 2L, use.g.names = FALSE), NA_real_)
      expect_equal(match.fun(f)(c(rep(NA_real_, 1e5), 10), g = rep(1L, 1e5+1), na.rm = FALSE, nthreads = 2L, use.g.names = FALSE), NA_real_)
    }
  }
})

test_that("fmedian ties handled properly with weights", {
  x <- c(1, 2, 3, 4)
  w <- c(2.5, 2.4, 3.8, 1.1)
  expect_equal(c(fmedian(x, w = w, ties = "mean"), fmedian(x, w = w, ties = "min"), fmedian(x, w = w, ties = "max")),
               c(2.5, 2, 3))
  w <- c(2.5, 2.4, 3.7, 1.2)
  expect_equal(c(fmedian(x, w = w, ties = "mean"), fmedian(x, w = w, ties = "min"), fmedian(x, w = w, ties = "max")),
               c(2.5, 2, 3))
})

options(warn = 1)