Skip to content

Commit

Permalink
Remove useless tests
Browse files Browse the repository at this point in the history
  • Loading branch information
@doccstat
doccstat committed Apr 8, 2024
1 parent 7d1f924 commit 5ec8e6b
Showing 1 changed file with 0 additions and 248 deletions.
248 changes: 0 additions & 248 deletions tests/testthat/test-experiments.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -371,28 +371,6 @@ testthat::test_that( # nolint: cyclomatic complexity
}
)

testthat::test_that(
"example linear regression with one-dimensional covariate", {
testthat::skip_if_not_installed("mvtnorm")
set.seed(1)
p <- 1
x <- mvtnorm::rmvnorm(300, rep(0, p), diag(p))
theta_0 <- matrix(c(1, -1, 0.5))
y <- c(
x[1:100, ] * theta_0[1, ] + rnorm(100, 0, 1),
x[101:200, ] * theta_0[2, ] + rnorm(100, 0, 1),
x[201:300, ] * theta_0[3, ] + rnorm(100, 0, 1)
)
result <- fastcpd(
formula = y ~ . - 1,
data = data.frame(y = y, x = x),
family = "lm"
)

testthat::expect_equal(result@cp_set, c(100, 194))
}
)

testthat::test_that(
"example custom logistic regression", {
set.seed(1)
Expand Down Expand Up @@ -501,127 +479,6 @@ testthat::test_that(
}
)

testthat::test_that(
"ARIMA(3, 0, 0)", {
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.arima(
x[3 + seq_len(n)],
c(3, 0, 0),
include.mean = FALSE,
trim = 0,
beta = (3 + 1 + 1) * log(n) / 2 * 5,
cp_only = TRUE
)

testthat::expect_equal(result@cp_set, c(609, 613))
}
)

testthat::test_that(
"ARIMA(3, 0, 0)", {
set.seed(5)
n <- 1500
x <- rep(0, n + 3)
for (i in 1:1000) {
x[i + 3] <- 0.6 * x[i + 2] - 0.2 * x[i + 1] + 0.1 * x[i] + rnorm(1, 0, 5)
}
for (i in 1001:n) {
x[i + 3] <- 0.3 * x[i + 2] + 0.4 * x[i + 1] + 0.2 * x[i] + rnorm(1, 0, 5)
}
result <- fastcpd.arima(
x[3 + seq_len(n)],
c(3, 0, 0),
include.mean = FALSE,
trim = 0,
beta = (3 + 1 + 1) * log(n) / 2 * 5,
cp_only = TRUE
)

testthat::expect_equal(result@cp_set, c(1003, 1007, 1011))
}
)

testthat::test_that(
"ARIMA(2, 0, 0)", {
set.seed(4)
n <- 1000
x <- rep(0, n + 2)
for (i in 1:500) {
x[i + 2] <- - 0.2 * x[i + 1] + 0.5 * x[i] + rnorm(1, 0, 4)
}
for (i in 501:n) {
x[i + 2] <- 0.4 * x[i + 1] - 0.2 * x[i] + rnorm(1, 0, 4)
}
result <- fastcpd.arima(
x[2 + seq_len(n)],
c(2, 0, 0),
include.mean = FALSE,
trim = 0,
beta = (2 + 1 + 1) * log(n) / 2 * 4,
cp_only = TRUE
)

testthat::expect_equal(result@cp_set, c(532, 535))
}
)

testthat::test_that(
"ARIMA(2, 0, 0)", {
set.seed(4)
n <- 1000
x <- rep(0, n + 2)
for (i in 1:500) {
x[i + 2] <- - 0.2 * x[i + 1] + 0.5 * x[i] + rnorm(1, 0, 1)
}
for (i in 501:n) {
x[i + 2] <- 0.4 * x[i + 1] - 0.2 * x[i] + rnorm(1, 0, 1)
}
result <- fastcpd.arima(
x[2 + seq_len(n)],
c(2, 0, 0),
include.mean = FALSE,
trim = 0,
beta = (2 + 1 + 1) * log(n) / 2 * 4,
cp_only = TRUE
)

testthat::expect_equal(result@cp_set, c(532, 535))
}
)

testthat::test_that(
"ARIMA(1, 0, 0)", {
set.seed(4)
n <- 600
x <- rep(0, n + 1)
for (i in 1:300) {
x[i + 1] <- 0.8 * x[i] + rnorm(1, 0, 1)
}
for (i in 301:n) {
x[i + 1] <- 0.1 * x[i] + rnorm(1, 0, 1)
}
result <- fastcpd.arima(
x[1 + seq_len(n)],
c(1, 0, 0),
include.mean = FALSE,
trim = 0,
beta = (1 + 1 + 1) * log(n) / 2 * 3,
cp_only = TRUE
)

testthat::expect_equal(result@cp_set, 301)
}
)


testthat::test_that(
"confidence interval experiment", {
set.seed(1)
Expand Down Expand Up @@ -1113,108 +970,3 @@ testthat::test_that(
)
}
)

testthat::test_that(
"build-in binomial performance on large data set with n = 10^4, p = 20", {
set.seed(1)
n <- 10^4
p <- 20
segment_count <- n / 500
theta_mean <- 5
x <- mvtnorm::rmvnorm(n, mean = rep(0, p), sigma = diag(1, p))
theta <- matrix(NA, segment_count, p)
for (segment_count_index in seq_len(segment_count)) {
theta[segment_count_index, ] <- rnorm(p, theta_mean, 5)
theta_mean <- -theta_mean
}
y <- matrix(NA, n, 1)
for (segment_count_index in seq_len(segment_count)) {
segment_index <- (segment_count_index - 1) * 500 + seq_len(500)
segment_theta <- theta[segment_count_index, ]
y[segment_index] <-
rbinom(500, 1, 1 / (1 + exp(-x[segment_index, ] %*% segment_theta)))
}

warning_messages <- testthat::capture_warnings(
runtime <- system.time(
result <- fastcpd::fastcpd(
formula = y ~ . - 1,
data = data.frame(y = y, x = x),
family = "binomial"
)
)
)

testthat::expect_equal(
warning_messages,
rep("fit_glm: fitted probabilities numerically 0 or 1 occurred", 7)
)

# Discard the runtime value since it is different depending on the machine.
# The run time is less than 10 seconds on a GitHub codespace with 2 cores.
invisible(runtime)
# user system elapsed
# 36.672 14.923 28.899

true_change_points <- 500 * seq_len(segment_count - 1)
testthat::expect_equal(
result@cp_set,
true_change_points +
c(11, -1, 8, 9, 12, 5, 9, -16, 28, 0, 0, 66, 26, 38, 7, 36, 8, 9, -3)
)
}
)

testthat::test_that(
"build-in binomial performance on large data set with n = 3 * 10^4, p = 30", {
set.seed(1)
n <- 3 * 10^4
p <- 30
segment_count <- n / 1000
theta_mean <- 5
x <- mvtnorm::rmvnorm(n, mean = rep(0, p), sigma = diag(1, p))
theta <- matrix(NA, segment_count, p)
for (segment_count_index in seq_len(segment_count)) {
theta[segment_count_index, ] <- rnorm(p, theta_mean, 5)
theta_mean <- -theta_mean
}
y <- matrix(NA, n, 1)
for (segment_count_index in seq_len(segment_count)) {
segment_index <- (segment_count_index - 1) * 1000 + seq_len(1000)
segment_theta <- theta[segment_count_index, ]
y[segment_index] <-
rbinom(1000, 1, 1 / (1 + exp(-x[segment_index, ] %*% segment_theta)))
}

warning_messages <- testthat::capture_warnings(
runtime <- system.time(
result <- fastcpd::fastcpd(
formula = y ~ . - 1,
data = data.frame(y = y, x = x),
family = "binomial"
)
)
)

testthat::expect_equal(
warning_messages,
rep("fit_glm: fitted probabilities numerically 0 or 1 occurred", 8)
)

# Discard the runtime value since it is different depending on the machine.
# The run time is less than 10 seconds on a GitHub codespace with 2 cores.
invisible(runtime)
# user system elapsed
# 683.446 356.068 576.744

true_change_points <- 1000 * seq_len(segment_count - 1)
testthat::expect_equal(
result@cp_set,
na.exclude(true_change_points + c(
21, 50, 3, 91, 12, 27, NA, -317, 36, 168, 19, 79, 43, 97,
0, 18, 5, 9, 63, 16, 26, 95, 4, -4, 24, 30, 57, 19, 19
)),
ignore_attr = TRUE
)
}
)

0 comments on commit 5ec8e6b

Please sign in to comment.