Update examples

R/fastcpd_wrappers.R

@@ -27,7 +27,8 @@ NULL
 #' AR(\eqn{p}) models. The function is similar to [fastcpd()] except that
 #' the data is by default a one-column matrix or univariate vector
 #' and thus a formula is not required here.
-#' @example tests/testthat/examples/fastcpd_ar.R
+#' @example tests/testthat/examples/fastcpd_ar_1.R
+#' @example tests/testthat/examples/fastcpd_ar_2.R
 #' @seealso [fastcpd()]
 #'
 #' @md

tests/testthat/examples/fastcpd_ar_2.R

@@ -0,0 +1,13 @@
+set.seed(1)
+n <- 1000
+x <- rep(0, n + 3)
+for (i in 1:600) {
+ x[i + 3] <- 0.6 * x[i + 2] - 0.2 * x[i + 1] + 0.1 * x[i] + rnorm(1, 0, 3)
+}
+for (i in 601:1000) {
+ x[i + 3] <- 0.3 * x[i + 2] + 0.4 * x[i + 1] + 0.2 * x[i] + rnorm(1, 0, 3)
+}
+result <-
+ fastcpd.ar(x[3 + seq_len(n)], 3, beta = "MDL", cost_adjustment = "MDL")
+summary(result)
+plot(result)

tests/testthat/test-examples-fastcpd_ar.R → tests/testthat/test-examples-fastcpd_ar_1.R

@@ -1,8 +1,8 @@
 testthat::test_that(
- "examples/fastcpd_ar.R", {
+ "examples/fastcpd_ar_1.R", {
  testthat::skip_if_not_installed("ggplot2")
 
- source("examples/fastcpd_ar.R")
+ source("examples/fastcpd_ar_1.R")
  testthat::expect_equal(result@cp_set, 614)
  }
 )

tests/testthat/test-examples-fastcpd_ar_2.R

@@ -0,0 +1,11 @@
+testthat::test_that(
+ "examples/fastcpd_ar_2.R", {
+ testthat::skip_if_not_installed("ggplot2")
+
+ source("examples/fastcpd_ar_2.R")
+ testthat::expect_equal(result@cp_set, 614)
+ testthat::expect_lt(
+ abs(median(result@residuals, na.rm = TRUE) + 0.11998684), 1e-8
+ )
+ }
+)

tests/testthat/test-experiments.R

@@ -1,3 +1,53 @@
+testthat::test_that(
+ "1d mean custom", {
+ set.seed(1)
+ result_mean <- fastcpd(
+ formula = ~ . - 1,
+ data = data.frame(x = c(rnorm(100, 0, 10), rnorm(100, 100, 10))),
+ cost = function(data) {
+ n <- nrow(data)
+ demeaned_data <- sweep(data, 2, colMeans(data))
+ n / 2 * (log(100) + log(2 * pi) + norm(demeaned_data, "2")^2 / n / 100)
+ },
+ cp_only = TRUE
+ )
+ testthat::expect_equal(result_mean@cp_set, 100)
+ }
+)
+
+testthat::test_that(
+ "warm start", {
+ set.seed(1)
+ p <- 1
+ x <- matrix(rnorm(300 * p, 0, 1), ncol = p)
+ theta <- rbind(rnorm(p, 0, 1), rnorm(p, 4, 1))
+ y <- c(
+ rbinom(150, 1, 1 / (1 + exp(-x[1:150, ] * theta[1, ]))),
+ rbinom(150, 1, 1 / (1 + exp(-x[151:300, ] * theta[2, ])))
+ )
+ result <- suppressWarnings(
+ fastcpd.binomial(
+ data.frame(y = y, x = x),
+ beta = "BIC",
+ vanilla_percentage = 1,
+ warm_start = TRUE,
+ cost_adjustment = NULL
+ )
+ )
+ testthat::expect_equal(result@cp_set, 134)
+ }
+)
+
+testthat::test_that(
+ "variance estimation", {
+ set.seed(1)
+ testthat::expect_message(
+ try(fastcpd.ar(c(0, 0, 0, 0, 0, 0), 2), silent = TRUE),
+ "Variance estimation failed for block 1."
+ )
+ }
+)
+
 testthat::skip("These tests are intended to be run manually.")
 
 testthat::test_that( # nolint: cyclomatic complexity

tests/testthat/test-vignettes-comparison-pelt.R

@@ -2,6 +2,7 @@
 # do a sanity check on the C++ implementation of `fastcpd`.
 
 testthat::skip_on_cran()
+testthat::skip_if_not_installed("mvtnorm")
 
 # nolint start: script provided as is