set.seed(1)
n <- 1500
p_true <- 6
p <- 50
x <- mvtnorm::rmvnorm(480, rep(0, p), diag(p))
theta_0 <- rbind(
runif(p_true, -5, -2),
runif(p_true, -3, 3),
runif(p_true, 2, 5),
runif(p_true, -5, 5)
)
theta_0 <- cbind(theta_0, matrix(0, ncol = p - p_true, nrow = 4))
y <- c(
x[1:80, ] %*% theta_0[1, ] + rnorm(80, 0, 1),
x[81:200, ] %*% theta_0[2, ] + rnorm(120, 0, 1),
x[201:320, ] %*% theta_0[3, ] + rnorm(120, 0, 1),
x[321:480, ] %*% theta_0[4, ] + rnorm(160, 0, 1)
)
result <- fastcpd(
formula = y ~ . - 1,
data = data.frame(y = y, x = x),
family = "lasso",
r.progress = FALSE
)
summary(result)
#>
#> Call:
#> fastcpd(formula = y ~ . - 1, data = data.frame(y = y, x = x),
#> family = "lasso", r.progress = FALSE)
#>
#> Change points:
#> 79 202 325
#>
#> Cost values:
#> 185.7631 508.1195 337.1486 328.3755
#>
#> Parameters:
#> 50 x 4 sparse Matrix of class "dgCMatrix"
#> segment 1 segment 2 segment 3 segment 4
#> [1,] -1.815974 -1.5964536 3.838563 -2.399833
#> [2,] -1.692328 -1.2734980 3.287314 2.170296
#> [3,] -3.340743 0.8558482 4.075844 2.853726
#> [4,] -4.075669 . 1.788200 -2.534484
#> [5,] -3.972095 . 3.868924 2.308333
#> [6,] -3.203743 -1.6359700 2.388598 3.302757
#> [7,] . . . .
#> [8,] . . . .
#> [9,] . . . .
#> [10,] . . . .
#> [11,] . . . .
#> [12,] . . . .
#> [13,] . . . .
#> [14,] . . . .
#> [15,] . . . .
#> [16,] . . . .
#> [17,] . . . .
#> [18,] . . . .
#> [19,] . . . .
#> [20,] . . . .
#> [21,] . . . .
#> [22,] . . . .
#> [23,] . . . .
#> [24,] . . . .
#> [25,] . . . .
#> [26,] . . . .
#> [27,] . . . .
#> [28,] . . . .
#> [29,] . . . .
#> [30,] . . . .
#> [31,] . . . .
#> [32,] . . . .
#> [33,] . . . .
#> [34,] . . . .
#> [35,] . . . .
#> [36,] . . . .
#> [37,] . . . .
#> [38,] . . . .
#> [39,] . . . .
#> [40,] . . . .
#> [41,] . . . .
#> [42,] . . . .
#> [43,] . . . .
#> [44,] . . . .
#> [45,] . . . .
#> [46,] . . . .
#> [47,] . . . .
#> [48,] . . . .
#> [49,] . . . .
#> [50,] . . . .
Multiple epochs
result_multiple_epochs <- fastcpd(
formula = y ~ . - 1,
data = data.frame(y = y, x = x),
family = "lasso",
k = function(x) if (x < 20) 1 else 0,
r.progress = FALSE
)
summary(result_multiple_epochs)
#>
#> Call:
#> fastcpd(formula = y ~ . - 1, data = data.frame(y = y, x = x),
#> k = function(x) if (x < 20) 1 else 0, family = "lasso", r.progress = FALSE)
#>
#> Change points:
#> 79 200 320
#>
#> Cost values:
#> 3511.248 1248.405 5457.215 5298.905
#>
#> Parameters:
#> 50 x 4 sparse Matrix of class "dgCMatrix"
#> segment 1 segment 2 segment 3 segment 4
#> [1,] . . . .
#> [2,] . . . .
#> [3,] . . . .
#> [4,] . . . .
#> [5,] . . . .
#> [6,] . . . .
#> [7,] . . . .
#> [8,] . . . .
#> [9,] . . . .
#> [10,] . . . .
#> [11,] . . . .
#> [12,] . . . .
#> [13,] . . . .
#> [14,] . . . .
#> [15,] . . . .
#> [16,] . . . .
#> [17,] . . . .
#> [18,] . . . .
#> [19,] . . . .
#> [20,] . . . .
#> [21,] . . . .
#> [22,] . . . .
#> [23,] . . . .
#> [24,] . . . .
#> [25,] . . . .
#> [26,] . . . .
#> [27,] . . . .
#> [28,] . . . .
#> [29,] . . . .
#> [30,] . . . .
#> [31,] . . . .
#> [32,] . . . .
#> [33,] . . . .
#> [34,] . . . .
#> [35,] . . . .
#> [36,] . . . .
#> [37,] . . . .
#> [38,] . . . .
#> [39,] . . . .
#> [40,] . . . .
#> [41,] . . . .
#> [42,] . . . .
#> [43,] . . . .
#> [44,] . . . .
#> [45,] . . . .
#> [46,] . . . .
#> [47,] . . . .
#> [48,] . . . .
#> [49,] . . . .
#> [50,] . . . .
Vanilla percentage
result_vanilla_percentage <- fastcpd(
formula = y ~ . - 1,
data = data.frame(y = y, x = x),
family = "lasso",
vanilla_percentage = 0.2,
r.progress = FALSE
)
summary(result_vanilla_percentage)
#>
#> Call:
#> fastcpd(formula = y ~ . - 1, data = data.frame(y = y, x = x),
#> family = "lasso", vanilla_percentage = 0.2, r.progress = FALSE)
#>
#> Change points:
#> 80 202 325
#>
#> Cost values:
#> 189.9238 501.139 337.1486 328.3755
#>
#> Parameters:
#> 50 x 4 sparse Matrix of class "dgCMatrix"
#> segment 1 segment 2 segment 3 segment 4
#> [1,] -1.841843 -1.6334187 3.838563 -2.399833
#> [2,] -1.692516 -1.2889968 3.287314 2.170296
#> [3,] -3.329914 0.8624382 4.075844 2.853726
#> [4,] -4.058322 . 1.788200 -2.534484
#> [5,] -3.958522 . 3.868924 2.308333
#> [6,] -3.197979 -1.6349725 2.388598 3.302757
#> [7,] . . . .
#> [8,] . . . .
#> [9,] . . . .
#> [10,] . . . .
#> [11,] . . . .
#> [12,] . . . .
#> [13,] . . . .
#> [14,] . . . .
#> [15,] . . . .
#> [16,] . . . .
#> [17,] . . . .
#> [18,] . . . .
#> [19,] . . . .
#> [20,] . . . .
#> [21,] . . . .
#> [22,] . . . .
#> [23,] . . . .
#> [24,] . . . .
#> [25,] . . . .
#> [26,] . . . .
#> [27,] . . . .
#> [28,] . . . .
#> [29,] . . . .
#> [30,] . . . .
#> [31,] . . . .
#> [32,] . . . .
#> [33,] . . . .
#> [34,] . . . .
#> [35,] . . . .
#> [36,] . . . .
#> [37,] . . . .
#> [38,] . . . .
#> [39,] . . . .
#> [40,] . . . .
#> [41,] . . . .
#> [42,] . . . .
#> [43,] . . . .
#> [44,] . . . .
#> [45,] . . . .
#> [46,] . . . .
#> [47,] . . . .
#> [48,] . . . .
#> [49,] . . . .
#> [50,] . . . .
