skip_if_not_installed("clustMixType") skip_if_not_installed("plumber") library(plumber) data(crickets, package = "modeldata") ## this model does not work with tibble input: crickets <- as.data.frame(crickets) set.seed(123) kp_fit <- clustMixType::kproto(crickets, k = 3, verbose = FALSE) v <- vetiver_model(kp_fit, "kproto-example") test_that("can print kproto model", { expect_snapshot(v) }) test_that("can predict kproto model", { ## prediction is broken for single observation predicted_clusters <- predict(v, crickets[5:6,]) expect_equal(predicted_clusters$cluster, c(1, 1)) }) test_that("can pin a kproto model", { b <- pins::board_temp() vetiver_pin_write(b, v) pinned <- pins::pin_read(b, "kproto-example") expect_equal( pinned, list( model = vetiver_prepare_model(kp_fit), prototype = vctrs::vec_ptype(tibble::as_tibble(crickets)) ) ) expect_equal( pin_meta(b, "kproto-example")$user$required_pkgs, "clustMixType" ) }) test_that("default endpoint for kproto", { p <- plumber::pr() %>% vetiver_api(v) p_routes <- p$routes[-1] expect_api_routes(p_routes) }) test_that("default OpenAPI spec", { v$metadata <- list(url = "potatoes") p <- pr() %>% vetiver_api(v) api_spec <- p$getApiSpec() expect_equal(api_spec$info$description, "A k-prototypes clustering model (3 clusters)") post_spec <- api_spec$paths$`/predict`$post expect_equal(names(post_spec), c("summary", "requestBody", "responses")) expect_equal(as.character(post_spec$summary), "Return predictions from model using 3 features") get_spec <- api_spec$paths$`/pin-url`$get expect_equal(as.character(get_spec$summary), "Get URL of pinned vetiver model") }) test_that("create plumber.R for kproto", { skip_on_cran() b <- board_folder(path = tmp_dir) vetiver_pin_write(b, v) tmp <- tempfile() vetiver_write_plumber(b, "kproto-example", file = tmp) expect_snapshot( cat(readr::read_lines(tmp), sep = "\n"), transform = redact_vetiver ) })