x <- c(1L, 2L, 3L)
y <- peptr_ptm(x, "ptm_test")
test_that("new_ptm works", {
expect_equal(vctrs::vec_size(new_ptm()), 0)
expect_s3_class(new_ptm(), c("peptr_ptm", "vctrs_rcrd", "vctrs_vctr"))
expect_equal(vctrs::vec_size(new_ptm(x)), 3)
})
test_that("peptr_ptm works", {
expect_equal(vctrs::vec_size(peptr_ptm()), 0)
expect_equal(class(peptr_ptm()), c("peptr_ptm", "vctrs_rcrd", "vctrs_vctr"))
expect_equal(
class(y),
c("peptr_ptm", "vctrs_rcrd", "vctrs_vctr")
)
expect_equal(
class(peptr_ptm(as.numeric(x))),
c("peptr_ptm", "vctrs_rcrd", "vctrs_vctr")
)
expect_true(peptr_is_ptm(y))
expect_false(peptr_is_ptm(x))
expect_true(is.na(peptr_ptm(NA)))
expect_equal(is.na(peptr_ptm(c(1, 3, NA))), c(FALSE, FALSE, TRUE))
expect_is(as.integer(y), "integer")
expect_is(as.numeric(y), "numeric")
expect_equal(as.integer(y), x)
expect_equal(vctrs::field(y, "position"), x)
expect_equal(peptr_get_ptm_name(y), "ptm_test")
expect_equal(peptr_get_ptm_name(peptr_ptm(x)), NA_character_)
})
# Casting ----
test_that("casting peptr_ptm and peptr_ptm", {
expect_is(vctrs::vec_cast(peptr_ptm(), peptr_ptm()), "peptr_ptm")
})
test_that("casting integer and peptr_ptm", {
expect_is(vctrs::vec_cast(1L, peptr_ptm()), "peptr_ptm")
})
test_that("casting peptr_ptm and integer", {
expect_is(vctrs::vec_cast(peptr_ptm(5L), integer()), "integer")
})
test_that("casting double and peptr_ptm", {
expect_is(vctrs::vec_cast(1.0, peptr_ptm()), "peptr_ptm")
})
test_that("casting peptr_ptm and double", {
expect_is(vctrs::vec_cast(peptr_ptm(5.0), double()), "numeric")
})
test_that("incompatible types do not work", {
expect_error(vctrs::vec_c(y, "hello"))
expect_error(vctrs::vec_c(y, TRUE))
expect_error(vctrs::vec_c(y, factor("hello")))
})
# Print ----
test_that("peptr_ptm prints", {
expect_output(print(y))
expect_output(print(peptr_position(NA)))
expect_equal(vctrs::vec_ptype_abbr(y), "ptm")
expect_equal(vctrs::vec_ptype_full(y), "ptm<ptm_test>")
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.