skip_if_not_installed("mockery")
test_that("can pin a model", {
b <- board_temp()
v <- vetiver_model(cars_lm, "cars1")
expect_snapshot(v)
vetiver_pin_write(b, v)
expect_equal(
pin_read(b, "cars1"),
list(
model = butcher::butcher(cars_lm),
prototype = vctrs::vec_slice(tibble::as_tibble(mtcars[,2:3]), 0)
)
)
})
test_that("can pin a model with no prototype", {
b <- board_temp()
expect_snapshot_warning(
v <- vetiver_model(cars_lm, "cars_null", save_ptype = FALSE)
)
v <- vetiver_model(cars_lm, "cars_null", save_prototype = FALSE)
vetiver_pin_write(b, v)
expect_equal(
pin_read(b, "cars_null"),
list(
model = butcher::butcher(cars_lm),
prototype = NULL
)
)
})
test_that("can pin a model with custom prototype", {
b <- board_temp()
v <- vetiver_model(cars_lm, "cars_custom", save_prototype = mtcars[3:10, 2:3])
vetiver_pin_write(b, v)
expect_equal(
pin_read(b, "cars_custom"),
list(
model = butcher::butcher(cars_lm),
prototype = mtcars[3:10, 2:3]
)
)
})
test_that("default metadata for model", {
b <- board_temp()
v <- vetiver_model(cars_lm, "cars2")
vetiver_pin_write(b, v)
meta <- pin_meta(b, "cars2")
expect_equal(meta$user, list(required_pkgs = NULL, renv_lock = NULL))
expect_equal(meta$description, "An OLS linear regression model")
})
test_that("user can supply metadata for model", {
b <- board_temp()
v <- vetiver_model(cars_lm, "cars3",
description = "lm model for mtcars",
metadata = list(metrics = 1:10))
vetiver_pin_write(b, v)
meta <- pin_meta(b, "cars3")
expect_equal(meta$user$metrics, 1:10)
expect_equal(meta$description, "lm model for mtcars")
})
test_that("can read a pinned model", {
b <- board_temp()
cars_lm <- lm(mpg ~ cyl + disp, data = mtcars)
v <- vetiver_model(cars_lm, "cars1")
vetiver_pin_write(b, v)
v1 <- vetiver_pin_read(b, "cars1")
meta <- pin_meta(b, "cars1")
expect_equal(v1$model, v$model)
expect_equal(v1$model_name, v$model_name)
expect_equal(v1$board, v$board)
expect_equal(v1$description, v$description)
expect_equal(
v1$metadata,
list(user = v$metadata$user,
version = meta$local$version,
url = meta$local$url,
required_pkgs = v$metadata$required_pkgs)
)
expect_equal(v1$prototype, v$prototype)
expect_equal(v1$versioned, FALSE)
})
test_that("can read an old pinned model with `required_pkgs` in blob", {
b <- board_temp()
pins::pin_write(
board = b,
x = list(
model = v$model,
ptype = v$ptype,
required_pkgs = c("janeaustenr", "beepr")
),
name = "cars-plus-pkgs",
type = "rds",
description = v$description,
metadata = v$metadata$user,
versioned = v$versioned
)
v2 <- vetiver_pin_read(b, "cars-plus-pkgs")
expect_equal(v2$metadata$required_pkgs, c("janeaustenr", "beepr"))
})
test_that("can read a versioned model with metadata", {
b <- board_temp(versioned = TRUE)
cars_lm <- lm(mpg ~ cyl + disp, data = mtcars)
v <- vetiver_model(cars_lm, "cars4",
description = "lm model for mtcars",
metadata = list(metrics = 1:10))
vetiver_pin_write(b, v)
v4 <- vetiver_pin_read(b, "cars4")
meta <- pin_meta(b, "cars4")
expect_equal(v4$model, v$model)
expect_equal(v4$model_name, v$model_name)
expect_equal(v4$board, v$board)
expect_equal(v4$description, v$description)
expect_equal(
v4$metadata,
list(user = v$metadata$user,
version = meta$local$version,
url = meta$local$url,
required_pkgs = v$metadata$required_pkgs)
)
expect_equal(v4$prototype, v$prototype)
expect_equal(v4$versioned, TRUE)
})
test_that("right message for reading with `check_renv`", {
skip_on_cran()
b <- board_temp(versioned = TRUE)
mock_version_name <- mockery::mock(
"20130104T050607Z-xxxxx",
"20130204T050607Z-yyyyy",
"20130304T050607Z-zzzzz",
)
local_mocked_bindings(version_name = mock_version_name, .package = "pins")
v <- vetiver_model(cars_lm, "cars5")
v$metadata$required_pkgs <- "ranger"
vetiver_pin_write(b, v)
expect_snapshot_warning(vetiver_pin_read(b, "cars5", check_renv = TRUE))
vetiver_pin_write(b, v, check_renv = TRUE)
v1 <- vetiver_pin_read(b, "cars5")
expect_silent(v2 <- vetiver_pin_read(b, "cars5", check_renv = TRUE))
expect_equal(v1, v2)
new_lock <- renv$renv_lockfile_init(project = NULL)
pins::pin_write(
board = b,
x = list(
model = v$model,
ptype = v$ptype,
required_pkgs = v$metadata$required_pkgs
),
name = v$model_name,
type = "rds",
description = v$description,
metadata = list_modify(v$metadata$user, renv_lockfile = new_lock),
versioned = v$versioned
)
expect_message(
vetiver_pin_read(b, "cars5", check_renv = TRUE),
regexp = "do not match your model"
)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.