tests/testthat/test-monitor.R

In tidymodels/vetiver: Version, Share, Deploy, and Monitor Models

skip_if_not_installed("modeldata")
skip_if_not_installed("dplyr")
skip_if_not_installed("parsnip")
skip_if_not_installed("slider")
skip_if_not_installed("yardstick")

describe("vetiver_compute_metrics()", {

    data(Chicago, package = "modeldata")
    Chicago <- dplyr::select(Chicago, ridership, date, one_of(stations))
    training_data <- dplyr::filter(Chicago, date < "2009-01-01")
    testing_data <- dplyr::filter(Chicago, date >= "2009-01-01", date < "2011-01-01")
    lm_fit <- parsnip::fit(parsnip::linear_reg(), ridership ~ ., data = training_data)
    lm_aug <- parsnip::augment(lm_fit, new_data = testing_data)

    it("can compute default metrics", {
        res <- vetiver_compute_metrics(
            lm_aug,
            date, "month",
            ridership, .pred
        )
        expect_s3_class(res, "tbl_df")
        expect_equal(unique(res$.metric), c("rmse", "rsq", "mae"))
        expect_equal(ncol(res), 5)
        expect_equal(nrow(res), 72)
    })
    it("can compute custom metrics", {
        res <- vetiver_compute_metrics(
            lm_aug,
            date, "month",
            ridership, .pred,
            metric_set = yardstick::metric_set(yardstick::rmse, yardstick::mape)
        )
        expect_s3_class(res, "tbl_df")
        expect_equal(unique(res$.metric), c("rmse", "mape"))
        expect_equal(ncol(res), 5)
        expect_equal(nrow(res), 48)
    })
    it("can compute rolling metrics", {
        res <- vetiver_compute_metrics(
            lm_aug,
            date, "week",
            ridership, .pred,
            every = 6L
        )
        expect_s3_class(res, "tbl_df")
        expect_equal(unique(res$.metric), c("rmse", "rsq", "mae"))
        expect_equal(ncol(res), 5)
        expect_equal(nrow(res), 54)
    })
})

describe("vetiver_pin_metrics()", {

    skip_if_not_installed("vdiffr")
    data(Chicago, package = "modeldata")
    Chicago <- dplyr::select(Chicago, ridership, date, one_of(stations))
    training_data <- dplyr::filter(Chicago, date < "2009-01-01")
    testing_data <- dplyr::filter(Chicago, date >= "2009-01-01", date < "2011-01-01")
    lm_fit <- parsnip::fit(parsnip::linear_reg(), ridership ~ ., data = training_data)

    df_metrics <-
        parsnip::augment(lm_fit, new_data = testing_data) %>%
        vetiver_compute_metrics(date, "week", ridership, .pred, every = 4L)

    it("fails without existing pin", {
        b <- pins::board_temp()
        expect_snapshot_error(
            vetiver_pin_metrics(b, df_metrics, "metrics1", overwrite = TRUE)
        )
    })
    it("fails with `overwrite = FALSE`", {
        b <- pins::board_temp()
        pins::pin_write(b, df_metrics, "metrics2")
        expect_snapshot_error(
            vetiver_pin_metrics(b, df_metrics, "metrics2")
        )
    })
    it("fails with type = csv", {
        b <- pins::board_temp()
        pins::pin_write(b, df_metrics, "metrics2", type = "csv")
        expect_snapshot_error(
            vetiver_pin_metrics(b, df_metrics, "metrics2")
        )

        pins::pin_write(b, df_metrics, "metrics2", type = "rds")
        expect_snapshot_error(
            vetiver_pin_metrics(b, df_metrics, "metrics2", type = "csv")
        )
    })
    it("can update metrics", {
        b <- pins::board_temp()
        pins::pin_write(b, df_metrics, "metrics3")

        new_metrics <- tibble::tibble(
            .index = as.Date("2011-01-12"),
            n = 30,
            .metric = c("rmse", "rsq", "mae"),
            .estimator = "standard",
            .estimate = c(3.0, 0.7, 2.0)

        )
        res2 <- vetiver_pin_metrics(b, new_metrics, "metrics3", overwrite = TRUE)
        expect_equal(
            pins::pin_read(b, "metrics3"),
            dplyr::arrange(vctrs::vec_rbind(df_metrics, new_metrics), .index)
        )
    })
})


describe("vetiver_plot_metrics()", {

    data(Chicago, package = "modeldata")
    Chicago <- dplyr::select(Chicago, ridership, date, one_of(stations))
    training_data <- dplyr::filter(Chicago, date < "2009-01-01")
    testing_data <- dplyr::filter(Chicago, date >= "2009-01-01", date < "2011-01-01")
    lm_fit <- parsnip::fit(parsnip::linear_reg(), ridership ~ ., data = training_data)

    df_metrics <-
        parsnip::augment(lm_fit, new_data = testing_data) %>%
        vetiver_compute_metrics(date, "week", ridership, .pred, every = 4L)

    it("can plot monitoring metrics", {
        p <- vetiver_plot_metrics(df_metrics)
        expect_s3_class(p, "ggplot")
        vdiffr::expect_doppelganger("default metrics plot", p)
    })

})