set.seed(11331) x <- suppressMessages({ tf_rgp(5, arg = 301L) |> tf_smooth() |> tfd(evaluator = tf_approx_fill_extend) |> setNames(letters[1:5]) }) l <- list( x_sp = tf_sparsify(x, dropout = 0.1), x_ir = tf_sparsify(x, dropout = 0.1) |> tf_jiggle(amount = 0.05), b = tfb(x, k = 45, verbose = FALSE), b2 = tfb(x, k = 15, bs = "tp", sp = 0.1, verbose = FALSE), bu = tfb(x, k = 15, penalized = FALSE, verbose = FALSE), bg = tfb(x, k = 5, global = TRUE, verbose = FALSE), fpc = tfb_fpc(x, pve = 1), fpc_low = tfb_fpc(x, pve = 0.95) ) for (i in seq_along(l)) { test_that("tf_rebase.tfd preserves args & evals and transfers attributes", { x_rebase <- tf_rebase(x, l[[i]], verbose = FALSE) expect_equal( x_rebase |> tf_evaluations(), l[[i]] |> tf_evaluations(), tolerance = 0.01 ) expect_equal( x_rebase |> tf_arg(), l[[i]] |> tf_arg() ) expect_named(x_rebase, names(x)) skip_on_cran() # to avoid non-reproducible BS-error on Fedora 36 - MKL expect_true( compare_tf_attribs(x_rebase, l[[i]], check_attrib = FALSE) |> all() ) }) } #------------------------------------------------------------------------------- set.seed(1133111) x <- tf_rgp(5, arg = 301L) |> tf_smooth() |> tfd(evaluator = tf_approx_fill_extend) |> suppressMessages() names(x) <- letters[1:5] b <- tfb(x, k = 45, verbose = FALSE) l <- list( x = x, x_sp = tf_sparsify(x, dropout = 0.1), x_ir = tf_sparsify(x, dropout = 0.1) |> tf_jiggle(amount = 0.2), b2 = tfb(x, k = 15, bs = "tp", sp = 0.1, verbose = FALSE), bu = tfb(x, k = 15, penalized = FALSE, verbose = FALSE), bg = tfb(x, k = 5, global = TRUE, verbose = FALSE), fpc = tfb_fpc(x, pve = 1), fpc_low = tfb_fpc(x, pve = 0.95) ) for (i in seq_along(l)) { test_that( paste0( "tf_rebase.tfb_spline preserves args & evals and transfers attributes for l[", i, "]" ), { x_rebase <- tf_rebase(b, l[[i]], verbose = FALSE) expect_equal( x_rebase |> tf_evaluations(), l[[i]] |> tf_evaluations(), tolerance = 0.01 ) expect_equal( x_rebase |> tf_arg(), l[[i]] |> tf_arg() ) expect_named(x_rebase, names(x)) skip_on_cran() # to avoid non-reproducible BS-error on Fedora 36 - MKL expect_true( compare_tf_attribs(x_rebase, l[[i]], check_attrib = FALSE) |> all() ) } ) } #------------------------------------------------------------------------------- set.seed(1133111) x <- suppressMessages({ tf_rgp(5, arg = 301L) |> tf_smooth() |> tfd(evaluator = tf_approx_fill_extend) |> setNames(letters[1:5]) }) fpc <- tfb_fpc(x, pve = 1) l <- list( x = x, x_sp = tf_sparsify(x, dropout = 0.1), x_ir = tf_sparsify(x, dropout = 0.1) |> tf_jiggle(amount = 0.2), b = tfb(x, k = 45, verbose = FALSE), b2 = tfb(x, k = 15, bs = "tp", sp = 0.1, verbose = FALSE), bu = tfb(x, k = 15, penalized = FALSE, verbose = FALSE), bg = tfb(x, k = 5, global = TRUE, verbose = FALSE), fpc_low = tfb_fpc(x, pve = 0.95) ) for (i in seq_along(l)) { test_that("tf_rebase.tfb_fpc preserves args & evals and transfers attributes", { x_rebase <- tf_rebase(fpc, l[[i]], verbose = FALSE) expect_equal( x_rebase |> tf_evaluations(), l[[i]] |> tf_evaluations(), tolerance = 0.01 ) expect_equal( x_rebase |> tf_arg(), l[[i]] |> tf_arg() ) expect_named(x_rebase, names(x)) skip_on_cran() # to avoid non-reproducible BS-error on Fedora 36 - MKL expect_true( compare_tf_attribs(x_rebase, l[[i]], check_attrib = FALSE) |> all() ) }) }