context("signatures")
skipall <- T
if (requireNamespace("here") & requireNamespace("purrr")) {
skipall <- F
load(here::here("tests/bullet1_only.Rdata"))
suppressWarnings({
testb1 <- b1_l2_x3p %>%
dplyr::select(-sigs) %>%
dplyr::mutate(
sigsNIST = purrr::map2(
.x = ccdata, .y = grooves,
.f = function(x, y) {
cc_get_signature(ccdata = x, grooves = y, span1 = 1000, span2 = 0.03)
}
),
sigsLL = purrr::map2(
.x = ccdata, .y = grooves,
.f = function(x, y) {
cc_get_signature(ccdata = x, grooves = y, span1 = 0.75, span2 = 0.03)
}
),
sigsLS = purrr::map2(
.x = ccdata, .y = grooves,
.f = function(x, y) {
cc_get_signature(ccdata = x, grooves = y, span1 = 0.75, span2 = 0.01)
}
),
sigsSL = purrr::map2(
.x = ccdata, .y = grooves,
.f = function(x, y) {
cc_get_signature(ccdata = x, grooves = y, span1 = 0.25, span2 = 0.03)
}
),
sigsSS = purrr::map2(
.x = ccdata, .y = grooves,
.f = function(x, y) {
cc_get_signature(ccdata = x, grooves = y, span1 = 0.25, span2 = 0.01)
}
)
)
})
}
test_that("signatures works as expected", {
skip_if(skipall)
expect_s3_class(testb1$sigsLL[[1]], "data.frame")
expect_silent(bulletxtrctr:::check_sig(testb1$sigsLL[[1]]))
expect_silent(bulletxtrctr:::check_sig(testb1$sigsNIST[[1]]))
expect_type(testb1$sigsLL[[1]]$x, "double")
expect_type(testb1$sigsLL[[1]]$y, "double")
expect_type(testb1$sigsLL[[1]]$value, "double")
expect_type(testb1$sigsLL[[1]]$raw_sig, "double")
expect_type(testb1$sigsLL[[1]]$se, "double")
expect_type(testb1$sigsLL[[1]]$sig, "double")
expect_length(unique(testb1$sigsLL[[1]]$y), 1)
})
test_that("signatures is numerically correct", {
skip_if(skipall)
expect_equivalent(b1_l2_x3p$sigs, testb1$sigsLL)
expect_error(expect_equivalent(testb1$sigsLL[[1]]$sig, testb1$sigsLS[[1]]$sig))
expect_error(expect_equivalent(testb1$sigsLL[[1]]$sig, testb1$sigsSL[[1]]$sig))
expect_error(expect_equivalent(testb1$sigsLL[[1]]$sig, testb1$sigsSS[[1]]$sig))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.