tests/testthat/test-rank-order.R

In tf: S3 Classes and Methods for Tidy Functional Data

grid <- round(seq(0, 10, length.out = 11), 3)
lin <- -3:3 * tfd(0.1 * grid, grid)
parallel <- -3:3 + tfd(0 * grid, grid)
names(lin) <- names(parallel) <- 1:7

lin_b <- tfb(lin, verbose = FALSE) |> suppressWarnings()
na <- 1 * NA + lin[1]

# ---- rank -------------------------------------------------------------------

test_that("rank.tf works with MHI (default)", {
  # For parallel non-crossing lines, MHI should rank lowest to highest
  r <- rank(parallel)
  expect_equal(r, setNames(1:7, 1:7))
  # Same for linear spread
  r_lin <- rank(lin)
  expect_equal(r_lin, setNames(1:7, 1:7))
})

test_that("rank.tf works with MBD", {
  r <- rank(parallel, depth = "MBD")
  # MBD is symmetric: -3 and 3 have equal depth, -2 and 2 have equal depth, etc.
  # Ranking should be symmetric around the center
  expect_equal(unname(r[1]), unname(r[7])) # most extreme pair
  expect_equal(unname(r[2]), unname(r[6]))
  expect_equal(unname(r[3]), unname(r[5]))
  expect_equal(unname(r[4]), 7) # center has highest depth -> highest rank
})

test_that("rank.tf works with custom depth function", {
  my_depth <- function(x, ...) tf_depth(x, depth = "MHI", ...)
  r_custom <- rank(parallel, depth = my_depth)
  r_mhi <- rank(parallel, depth = "MHI")
  expect_equal(r_custom, r_mhi)
})

test_that("rank.tf handles NAs", {
  x_na <- c(parallel, na)
  r <- rank(x_na, na.last = TRUE)
  expect_equal(unname(r[8]), 8)
  r_na <- rank(x_na, na.last = NA)
  # na.last = NA drops NA entries from rank result
  expect_length(r_na, 7)
})

test_that("rank.tf pads custom depth output for missing values", {
  my_depth <- function(x, ...) tf_depth(x, depth = "MHI", ...)
  x_mid_na <- c(parallel[1:3], na, parallel[4:7])

  r <- rank(x_mid_na, depth = my_depth, na.last = TRUE)

  expect_equal(unname(r[-4]), 1:7)
  expect_equal(unname(r[4]), 8)
})

test_that("rank.tf respects ties.method", {
  # Two identical functions
  x <- c(parallel[4], parallel[4], parallel[1])
  r_avg <- rank(x, ties.method = "average")
  expect_equal(unname(r_avg[1]), unname(r_avg[2]))
  r_min <- rank(x, ties.method = "min")
  expect_equal(unname(r_min[1]), unname(r_min[2]))
})

test_that("rank.tf works on tfb", {
  r <- rank(lin_b)
  expect_equal(unname(r), 1:7)
})

test_that("rank.default still works for numeric", {
  expect_equal(rank(c(3, 1, 2)), c(3, 1, 2))
  expect_error(rank(1:3, foo = 1), "unused")
})

# ---- order (via xtfrm) ------------------------------------------------------

test_that("order works on tf via xtfrm", {
  o <- order(parallel)
  expect_equal(o, 1:7)
  # Reversed:
  o_dec <- order(parallel, decreasing = TRUE)
  expect_equal(o_dec, 7:1)
})

test_that("xtfrm.tf returns MHI values", {
  xt <- xtfrm(parallel)
  expect_type(xt, "double")
  expect_length(xt, 7)
  # For parallel lines, xtfrm should increase
  expect_true(all(diff(xt) > 0))
})

# ---- sort --------------------------------------------------------------------

test_that("sort.tf sorts by MHI", {
  # Scramble then sort
  scrambled <- parallel[c(4, 2, 7, 1, 5, 3, 6)]
  sorted <- sort(scrambled)
  expect_length(sorted, 7)
  # After sorting by MHI, evaluations should be in ascending order
  evals <- tf_evaluations(sorted)
  for (i in seq_along(evals)[-1]) {
    expect_true(all(evals[[i]] >= evals[[i - 1]]))
  }
})

test_that("sort.tf decreasing works", {
  sorted_dec <- sort(parallel, decreasing = TRUE)
  evals <- tf_evaluations(sorted_dec)
  for (i in seq_along(evals)[-1]) {
    expect_true(all(evals[[i]] <= evals[[i - 1]]))
  }
})

test_that("sort.tf works with custom depth", {
  sorted <- sort(parallel, depth = "FM")
  expect_length(sorted, 7)
})

test_that("sort.tf respects na.last", {
  x_na <- c(parallel[2], na, parallel[1])

  sorted_keep <- sort(x_na, na.last = TRUE)
  expect_length(sorted_keep, 3)
  expect_true(is.na(sorted_keep[3]))

  sorted_drop <- sort(x_na, na.last = NA)
  expect_length(sorted_drop, 2)
})

# ---- min/max with depth ------------------------------------------------------

test_that("min/max still work pointwise by default", {
  pw_min <- min(parallel)
  pw_max <- max(parallel)
  expect_s3_class(pw_min, "tf")
  expect_s3_class(pw_max, "tf")
  # Pointwise min of parallel lines should equal the lowest line
  expect_equal(
    tf_evaluations(pw_min)[[1]],
    tf_evaluations(parallel)[[1]],
    ignore_attr = TRUE
  )
  expect_equal(
    tf_evaluations(pw_max)[[1]],
    tf_evaluations(parallel)[[7]],
    ignore_attr = TRUE
  )
})

test_that("min/max with depth select observations", {
  d_min <- min(parallel, depth = "MHI")
  d_max <- max(parallel, depth = "MHI")
  expect_length(d_min, 1)
  expect_length(d_max, 1)
  # MHI min should be the lowest function
  expect_equal(
    tf_evaluations(d_min)[[1]],
    tf_evaluations(parallel)[[1]],
    ignore_attr = TRUE
  )
  # MHI max should be the highest function
  expect_equal(
    tf_evaluations(d_max)[[1]],
    tf_evaluations(parallel)[[7]],
    ignore_attr = TRUE
  )
})

test_that("depth-based min/max handle missing values consistently", {
  x_mid_na <- c(parallel[1:3], na, parallel[4:7])

  expect_true(is.na(min(x_mid_na, depth = "MHI")))
  expect_true(is.na(max(x_mid_na, depth = "MHI")))

  expect_equal(
    tf_evaluations(min(x_mid_na, depth = "MHI", na.rm = TRUE))[[1]],
    tf_evaluations(parallel[1])[[1]],
    ignore_attr = TRUE
  )
  expect_equal(
    tf_evaluations(max(x_mid_na, depth = "MHI", na.rm = TRUE))[[1]],
    tf_evaluations(parallel[7])[[1]],
    ignore_attr = TRUE
  )
})

test_that("min/max with MBD depth", {
  d_min_mbd <- min(parallel, depth = "MBD")
  d_max_mbd <- max(parallel, depth = "MBD")
  # MBD min = most extreme, MBD max = most central
  expect_equal(
    tf_evaluations(d_max_mbd)[[1]],
    tf_evaluations(parallel)[[4]],
    ignore_attr = TRUE
  )
})

test_that("range with depth works", {
  r <- range(parallel, depth = "MHI")
  expect_length(r, 2)
  expect_s3_class(r, "tf")
})

# ---- median with various depths ---------------------------------------------

test_that("median.tf accepts all built-in centrality depths", {
  for (d in c("MBD", "FM", "FSD")) {
    m <- median(parallel, depth = d)
    expect_length(m, 1)
    # For symmetric parallel lines, centrality-based median = center function
    expect_equal(
      tf_evaluations(m)[[1]],
      tf_evaluations(parallel)[[4]],
      ignore_attr = TRUE
    )
  }
})

test_that("median.tf with MHI selects highest-depth (topmost) function", {
  m <- median(parallel, depth = "MHI")
  expect_length(m, 1)
  # MHI is directional: max depth = highest function
  expect_equal(
    tf_evaluations(m)[[1]],
    tf_evaluations(parallel)[[7]],
    ignore_attr = TRUE
  )
})

test_that("median.tf accepts custom depth function", {
  my_depth <- function(x, ...) tf_depth(x, depth = "MBD", ...)
  m <- median(parallel, depth = my_depth)
  expect_length(m, 1)
  expect_equal(
    tf_evaluations(m)[[1]],
    tf_evaluations(parallel)[[4]],
    ignore_attr = TRUE
  )
})

test_that("median.tf pointwise still works", {
  m <- median(parallel, depth = "pointwise")
  expect_s3_class(m, "tf")
})

# ---- fivenum ----------------------------------------------------------------

test_that("fivenum.tf works", {
  fn <- fivenum(parallel)
  expect_length(fn, 5)
  expect_named(fn, c("min", "lower_hinge", "median", "upper_hinge", "max"))
})

test_that("fivenum.tf orders correctly with MHI", {
  fn <- fivenum(parallel)
  evals <- tf_evaluations(fn)
  # min should be lowest, max should be highest
  expect_true(all(evals[["min"]] <= evals[["max"]]))
  expect_true(all(evals[["lower_hinge"]] <= evals[["upper_hinge"]]))
})

test_that("fivenum.tf handles NAs", {
  x_na <- c(parallel, na)
  fn_na <- fivenum(x_na, na.rm = FALSE)
  expect_true(is.na(fn_na))

  fn_rm <- fivenum(x_na, na.rm = TRUE)
  expect_length(fn_rm, 5)
})

test_that("fivenum.tf reuses order statistics for small samples", {
  fn_one <- fivenum(parallel[1])
  expect_length(fn_one, 5)
  expect_named(fn_one, c("min", "lower_hinge", "median", "upper_hinge", "max"))
  expect_true(all(vapply(
    tf_evaluations(fn_one),
    identical,
    logical(1),
    tf_evaluations(parallel[1])[[1]]
  )))

  fn_two <- fivenum(parallel[1:2])
  expect_length(fn_two, 5)
  expect_named(fn_two, c("min", "lower_hinge", "median", "upper_hinge", "max"))
})

test_that("fivenum.default still works for numeric", {
  expect_equal(fivenum(1:5), c(1, 2, 3, 4, 5))
})

# ---- summary with depth arg -------------------------------------------------

test_that("summary.tf accepts depth argument", {
  s_mbd <- summary(parallel)
  s_fm <- summary(parallel, depth = "FM")
  expect_length(s_mbd, 6)
  expect_length(s_fm, 6)
  expect_named(
    s_mbd,
    c("min", "lower_mid", "median", "mean", "upper_mid", "max")
  )
})

test_that("summary.tf handles all-NA input", {
  s_na <- summary(c(na, na))
  expect_length(s_na, 6)
  expect_named(
    s_na,
    c("min", "lower_mid", "median", "mean", "upper_mid", "max")
  )
  expect_true(all(is.na(s_na)))
})

# ---- validate_depth ----------------------------------------------------------

test_that("validate_depth rejects invalid depths", {
  expect_error(rank(parallel, depth = "INVALID"), "depth")
  expect_error(rank(parallel, depth = 42), "depth")
})