tests/testthat/test-tidyr.R

In fabian-s/tidyfun: Tools for Tidy Functional Data

data <- refund::DTI[1:5, ]
d1 <- data.frame(data$cca)
d2 <- data.frame(id = data$ID, data$cca)
cca <- tfd(data$cca)

test_that("tf_gather works", {
  expect_s3_class(tf_gather(d1)$cca |> suppressMessages(),
                  "tfd")
  expect_message(tf_gather(d1)$cca,
                 "cca")
  expect_identical(tf_gather(d1)$cca |> suppressMessages(),
                   cca)
  expect_equal(
    tf_gather(d1)$cca |> suppressMessages(),
    tf_gather(data[, 1:8], cca)$cca |> suppressMessages(),
    ignore_attr = TRUE
  )

  expect_identical(tf_gather(d2, -1)$cca |> suppressMessages(),
                   cca)
  expect_identical(tf_gather(d2, -1)$id |> suppressMessages(),
                   d2$id)
  expect_identical(tf_gather(d2, -1, key = "nuhnuh")$nuhnuh |>
                     suppressMessages(),
                   tf_gather(d2, -1)$cca |> suppressMessages())

  expect_identical(tf_gather(d2, -id)$cca |> suppressMessages(),
                   tf_gather(d2, -1)$cca |> suppressMessages())
  expect_identical(tf_gather(d2, starts_with("cca"))$cca |> suppressMessages(),
                   tf_gather(d2, -1)$cca |> suppressMessages())

  expect_identical(
    attr(tf_gather(d1, evaluator = tf_approx_spline)$cca, "evaluator_name") |>
      suppressMessages(),
    "tf_approx_spline"
  )

  expect_named(tf_gather(d1) |> suppressMessages(),
               "cca")
})

test_that("tf_spread works", {
  d <- tibble(g = 1:3, f = tf_rgp(3, 11L))
  expect_equal(
    tf_spread(d, f, sep = NULL)[, -1], as.data.frame(as.matrix(d$f)),
    ignore_attr = TRUE
  )
  expect_identical(tf_spread(d, f), tf_spread(d, -g))
  expect_identical(tf_spread(d, f), tf_spread(d))
  expect_warning(
    tf_spread(d, f, arg = seq(0, 1, length.out = 20), sep = NULL),
    "interpolate = FALSE"
  )
  expect_equal(
    suppressWarnings(
      tf_spread(d, f, arg = seq(0, 1, length.out = 20), sep = NULL)[, -1]
    ),
    suppressWarnings(
      as.data.frame(d$f[, seq(0, 1, length.out = 20), interpolate = FALSE])
    ),
    ignore_attr = TRUE
  )
  d$fb <- tfb(tf_rgp(3, 11L), verbose = FALSE) |> suppressWarnings()
  expect_error(tf_spread(d), "More than one")
  expect_equal(
    tf_spread(d, fb, sep = NULL)[, -(1:2)] |> suppressMessages(),
    as.data.frame(as.matrix(d$fb)),
    ignore_attr = TRUE
  )
  set.seed(1312)
  d$fi <- tf_jiggle(tf_rgp(3, 11L))
  tf_spread(d, fi) |>
    expect_warning("no explicit `arg` for irregular") |>
    suppressWarnings()
  tf_spread(d, fi) |>
    expect_warning("interpolate = FALSE") |>
    suppressWarnings()
  expect_true(suppressWarnings(ncol(tf_spread(d, fi)) == 36))
  expect_equal(
    tf_spread(d, fi,
      arg = seq(0, 1, length.out = 20), sep = NULL, interpolate = TRUE
    )[, -(1:3)],
    as.data.frame(
      as.matrix(d$fi, arg = seq(0, 1, length.out = 20), interpolate = TRUE)
    ),
    ignore_attr = TRUE
  )
})

test_that("tf_nest works", {
  f1 <- tf_rgp(3, 11L)
  f2 <- tf_rgp(3, 11L)
  data <- dplyr::inner_join(tf_unnest(f1), tf_unnest(f2), by = c("id", "arg"))
  expect_equal(tf_nest(data)$value.x, f1, ignore_attr = TRUE)
  expect_equal(tf_nest(data)$value.y, f2, ignore_attr = TRUE)
  expect_named(tf_nest(data, value.x:value.y), names(tf_nest(data)))
  expect_named(tf_nest(data, -(1:2)), names(tf_nest(data)))

  g <- rnorm(3)
  data <- bind_cols(data, g = rep(g, e = tf_count(f1)))
  expect_error(tf_nest(data |> group_by(g)), "grouped_df")
  expect_identical(tf_nest(data, value.x:value.y)$g, g)
  data <- bind_cols(data, f = rep(rnorm(nrow(data))))
  expect_error(tf_nest(data, value.x:value.y), "Can't nest")
})

# weird scoping problem going on -- fixed by assigning
# data to tf_evaluate as evaluated object instead of quoted for now,
# otherwise tfdata is not found inside test environments (related to testthat/#266?)
test_that("tf_unnest works", {
  set.seed(121211)
  f1 <- tf_rgp(3, 11L)
  f2 <- tf_rgp(3, 11L)
  data <- dplyr::inner_join(tf_unnest(f1), tf_unnest(f2), by = c("id", "arg"))
  tfdata <- tf_nest(data)
  expect_identical(NCOL(tf_unnest(tfdata, cols = c(value.x, value.y))), 5L)
  expect_equal(
    as.matrix(tf_unnest(tfdata, cols = c(value.x, value.y))[-c(1, 4)]),
    as.matrix(data[, 2:4]),
    ignore_attr = TRUE
  )
  expect_s3_class(tf_unnest(tfdata, value.x)$value.y, "tfd")
})

# tidyfun#109
test_that("tf_nest / tf_unnest work with numeric id-variables", {
  d <- tf_rgp(10) |> tf_unnest()
  d$id <- as.numeric(d$id) * 10
  nested <- tf_nest(d)
  unnested <- tf_unnest(nested, cols = value)
  expect_equal(d, unnested, ignore_attr = TRUE)
})