tests/testthat/zzz-test-step-vpd-tent-template-functions.R

In tdarec: A 'recipes' Extension for Persistent Homology and Its Vectorizations

# ------------------------------------------------------------------------------
# Generated by 'pre-generate/generate-steps.R': do not edit by hand.
# ------------------------------------------------------------------------------

dist_train <- data.frame(
  dist = I(list(eurodist))
)
dist_test <- data.frame(
  dist = I(list(UScitiesD))
)
dist_rec <- recipe(~ ., data = dist_train) |> 
  step_phom_point_cloud(everything(), keep_original_cols = FALSE)
scale_seq <- seq(0, 5000, 100)

test_that("`step_vpd_tent_template_functions()` agrees with raw function", {
  
  pl_rec <- dist_rec |> 
    step_vpd_tent_template_functions(
      everything(),
      hom_degree = 0,
      keep_original_cols = FALSE
    )
  
  pl_prep <- prep(pl_rec, training = dist_train)
  
  pl_pred <- bake(pl_prep, new_data = dist_test) |> 
    unlist() |> unname()
  
  pl_exp <- dist_test$dist[[1L]] |> 
    ripserr::vietoris_rips() |> as.matrix() |> 
    TDAvec::computeTemplateFunction(
      homDim = 0
    ) |> 
    as.vector()
  
  expect_equal(pl_pred, pl_exp)
})

test_that("`tunable()` returns standard names", {
  
  pl_rec <- dist_rec |> 
    step_vpd_tent_template_functions(everything(), keep_original_cols = FALSE)
  tun <- tunable(pl_rec$steps[[2]])
  
  expect_equal(
    names(tun),
    c("name", "call_info", "source", "component", "component_id")
  )
  expect_equal(
    tun$name,
    c("hom_degree", "tent_size", "num_bins", "tent_shift")
  )
  expect_equal(unique(tun$source), "recipe")
  expect_true(is.list(tun$call_info))
})