tests/testthat/test_PipeOpFPCA.R

In mlr3fda: Extending 'mlr3' to Functional Data Analysis

test_that("PipeOpFPCA - basic properties", {
  pop = po("fda.fpca")
  expect_pipeop(pop)
  expect_identical(pop$id, "fda.fpca")
})

test_that("PipeOpPCA works", {
  skip_if_not_installed("withr")
  withr::local_seed(1234L)
  # single col works
  dt = data.table(
    id = c("Ann", "Ann", "Ann", "Bob", "Bob", "Bob"),
    arg = rep(1:3, 2L),
    value = 1:6
  )
  f = tf::tfd(dt, id = "id", arg = "arg", value = "value")
  y = c(1, 2)
  dt = data.table(f = f, y = y)
  task = as_task_regr(dt, target = "y")

  pop = po("fda.fpca")
  task_fpc = pop$train(list(task))[[1L]]
  expect_task(task_fpc)
  new_data = task_fpc$data()
  expect_identical(dim(new_data), c(2L, 2L))
  expect_named(new_data, c("y", "f_pc_1"))
  expect_numeric(new_data$f_pc_1, len = 2)
  expect_identical(new_data, pop$predict(list(task))[[1L]]$data())

  # n_components works
  dt = data.table(y = rnorm(15L), f = tf::tf_rgp(15L))
  task = as_task_regr(dt, target = "y")
  pop = po("fda.fpca", n_components = 2L)
  new_data = pop$train(list(task))[[1L]]$data()
  expect_identical(dim(new_data), c(15L, 3L))
  expect_named(new_data, c("y", "f_pc_1", "f_pc_2"))

  # multiple cols work
  dt = data.table(
    id = rep(1:10, each = 3L),
    arg = rep(1:3, 10L),
    value = 1:10 + rnorm(1L)
  )
  f = tf::tfd(dt, id = "id", arg = "arg", value = "value")
  dt = data.table(y = rnorm(10L), f = f, g = f, h = f)
  task = as_task_regr(dt, target = "y")
  pop = po("fda.fpca")
  task_fpc = pop$train(list(task))[[1L]]
  new_data = task_fpc$data()
  expect_task(task_fpc)
  expect_identical(dim(new_data), c(10L, 10L))
  nms = c(
    "y", "f_pc_1", "f_pc_2", "f_pc_3",
    "g_pc_1", "g_pc_2", "g_pc_3",
    "h_pc_1", "h_pc_2", "h_pc_3"
  )
  expect_named(new_data, nms)
  expect_identical(new_data, pop$predict(list(task))[[1L]]$data())

  # n_components works
  pop = po("fda.fpca", n_components = 2L)
  new_data = pop$train(list(task))[[1L]]$data()
  expect_identical(dim(new_data), c(10L, 7L))
  nms = c(
    "y", "f_pc_1", "f_pc_2",
    "g_pc_1", "g_pc_2",
    "h_pc_1", "h_pc_2"
  )
  expect_named(new_data, nms)

  # affect_columns works
  pop = po("fda.fpca", affect_columns = selector_name("f"))
  task_fpc = pop$train(list(task))[[1L]]
  expect_set_equal(task_fpc$feature_names, c("f_pc_1", "f_pc_2", "f_pc_3", "g", "h"))

  # does not touch irreg
  dt = data.table(
    id = c("Ann", "Ann", "Ann", "Bob", "Bob"),
    arg = c(1L, 7L, 2L, 3L, 5L),
    value = 1:5
  )
  f = tf::tfd(dt, id = "id", arg = "arg", value = "value")
  y = 1:2
  dt = data.table(f = f, y = y)
  task = as_task_regr(dt, target = "y")
  task_fpca = pop$train(list(task))[[1L]]
  expect_set_equal(task$feature_names, task_fpca$feature_names)
})