---
title: "Advanced examples"
output: rmarkdown::html_vignette
description: |
  Examples using advanced features of the package.
vignette: >
  %\VignetteIndexEntry{Advanced examples}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---




``` r
set.seed(1)
n <- 300
p_true <- 4
p <- 40
x <- mvtnorm::rmvnorm(n, rep(0, p), diag(p))
theta_0 <- rbind(
  runif(p_true, 1, 4),
  runif(p_true, -5, 5),
  runif(p_true, 1, 4),
  runif(p_true, -3, 3)
)
theta_0 <- cbind(theta_0, matrix(0, ncol = p - p_true, nrow = 4))
y <- c(
  x[1:(n * 0.25), ] %*% theta_0[1, ] + rnorm(n * 0.25),
  x[(n * 0.25 + 1):(n * 0.5), ] %*% theta_0[2, ] + rnorm(n * 0.25),
  x[(n * 0.5 + 1):(n * 0.75), ] %*% theta_0[3, ] + rnorm(n * 0.25),
  x[(n * 0.75 + 1):n, ] %*% theta_0[4, ] + rnorm(n * 0.25)
)
small_lasso <- cbind.data.frame(y, x)
```


``` r
result <- fastcpd.lasso(small_lasso, segment_count = 2, r.progress = FALSE)
summary(result)
#> 
#> Call:
#> fastcpd.lasso(data = small_lasso, segment_count = 2, r.progress = FALSE)
#> 
#> Change points:
#> 73 151 
#> 
#> Cost values:
#> 403.3531 330.8874 1131.242 
#> 
#> Parameters:
#> 40 x 3 sparse Matrix of class "dgCMatrix"
#>       segment 1  segment 2 segment 3
#>  [1,] 0.2725645  3.2847730 0.3945321
#>  [2,] 1.0710180 -1.0318006 0.2333177
#>  [3,] 2.0691658  0.8655912 .        
#>  [4,] 0.2865536 -2.7810274 1.4952166
#>  [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,] .          .         .
```

# Vanilla percentage




``` r
result_vanilla_percentage <- fastcpd.lasso(
  small_lasso, segment_count = 2, vanilla_percentage = 0.5,
  r.progress = FALSE
)
summary(result_vanilla_percentage)
#> 
#> Call:
#> fastcpd.lasso(data = small_lasso, segment_count = 2, vanilla_percentage = 0.5, 
#>     r.progress = FALSE)
#> 
#> Change points:
#> 74 150 
#> 
#> Cost values:
#> 404.3949 296.7204 1162.25 
#> 
#> Parameters:
#> 40 x 3 sparse Matrix of class "dgCMatrix"
#>       segment 1 segment 2 segment 3
#>  [1,] 0.2835972  3.208983 0.4299211
#>  [2,] 1.0913097 -1.306468 0.3019345
#>  [3,] 2.0550480  0.697885 .        
#>  [4,] 0.2928737 -2.771848 1.4996787
#>  [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,] .          .        .
```

# Multiple epochs




``` r
result_multiple_epochs <- fastcpd.lasso(
  small_lasso,
  segment_count = 2,
  multiple_epochs = function(segment_length) {
    if (segment_length < 25) 1 else 0
  },
  r.progress = FALSE
)
summary(result_multiple_epochs)
#> 
#> Call:
#> fastcpd.lasso(data = small_lasso, segment_count = 2, multiple_epochs = function(segment_length) {
#>     if (segment_length < 25) 
#>         1
#>     else 0
#> }, r.progress = FALSE)
#> 
#> Change points:
#> 74 151 227 
#> 
#> Cost values:
#> 404.3949 323.0533 394.7117 245.3975 
#> 
#> Parameters:
#> 40 x 4 sparse Matrix of class "dgCMatrix"
#>       segment 1 segment 2 segment 3 segment 4
#>  [1,] 0.2835972  3.269615 0.9960117 .        
#>  [2,] 1.0913097 -1.089741 1.6936173 .        
#>  [3,] 2.0550480  0.896723 1.5956191 .        
#>  [4,] 0.2928737 -2.769824 2.1702226 0.1701821
#>  [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,] .          .        .         .
```

# Notes

This document is generated by the following code:

```shell
R -e 'knitr::knit("vignettes/examples-advanced.Rmd.original", output = "vignettes/examples-advanced.Rmd")'
```

# Appendix: all code snippets


``` r
knitr::opts_chunk$set(
  collapse = TRUE, comment = "#>", eval = TRUE, warning = FALSE
)
library(fastcpd)
set.seed(1)
n <- 300
p_true <- 4
p <- 40
x <- mvtnorm::rmvnorm(n, rep(0, p), diag(p))
theta_0 <- rbind(
  runif(p_true, 1, 4),
  runif(p_true, -5, 5),
  runif(p_true, 1, 4),
  runif(p_true, -3, 3)
)
theta_0 <- cbind(theta_0, matrix(0, ncol = p - p_true, nrow = 4))
y <- c(
  x[1:(n * 0.25), ] %*% theta_0[1, ] + rnorm(n * 0.25),
  x[(n * 0.25 + 1):(n * 0.5), ] %*% theta_0[2, ] + rnorm(n * 0.25),
  x[(n * 0.5 + 1):(n * 0.75), ] %*% theta_0[3, ] + rnorm(n * 0.25),
  x[(n * 0.75 + 1):n, ] %*% theta_0[4, ] + rnorm(n * 0.25)
)
small_lasso <- cbind.data.frame(y, x)
result <- fastcpd.lasso(small_lasso, segment_count = 2, r.progress = FALSE)
summary(result)
set.seed(1)
n <- 300
p_true <- 4
p <- 40
x <- mvtnorm::rmvnorm(n, rep(0, p), diag(p))
theta_0 <- rbind(
  runif(p_true, 1, 4),
  runif(p_true, -5, 5),
  runif(p_true, 1, 4),
  runif(p_true, -3, 3)
)
theta_0 <- cbind(theta_0, matrix(0, ncol = p - p_true, nrow = 4))
y <- c(
  x[1:(n * 0.25), ] %*% theta_0[1, ] + rnorm(n * 0.25),
  x[(n * 0.25 + 1):(n * 0.5), ] %*% theta_0[2, ] + rnorm(n * 0.25),
  x[(n * 0.5 + 1):(n * 0.75), ] %*% theta_0[3, ] + rnorm(n * 0.25),
  x[(n * 0.75 + 1):n, ] %*% theta_0[4, ] + rnorm(n * 0.25)
)
small_lasso <- cbind.data.frame(y, x)
result_vanilla_percentage <- fastcpd.lasso(
  small_lasso, segment_count = 2, vanilla_percentage = 0.5,
  r.progress = FALSE
)
summary(result_vanilla_percentage)
set.seed(1)
n <- 300
p_true <- 4
p <- 40
x <- mvtnorm::rmvnorm(n, rep(0, p), diag(p))
theta_0 <- rbind(
  runif(p_true, 1, 4),
  runif(p_true, -5, 5),
  runif(p_true, 1, 4),
  runif(p_true, -3, 3)
)
theta_0 <- cbind(theta_0, matrix(0, ncol = p - p_true, nrow = 4))
y <- c(
  x[1:(n * 0.25), ] %*% theta_0[1, ] + rnorm(n * 0.25),
  x[(n * 0.25 + 1):(n * 0.5), ] %*% theta_0[2, ] + rnorm(n * 0.25),
  x[(n * 0.5 + 1):(n * 0.75), ] %*% theta_0[3, ] + rnorm(n * 0.25),
  x[(n * 0.75 + 1):n, ] %*% theta_0[4, ] + rnorm(n * 0.25)
)
small_lasso <- cbind.data.frame(y, x)
result_multiple_epochs <- fastcpd.lasso(
  small_lasso,
  segment_count = 2,
  multiple_epochs = function(segment_length) {
    if (segment_length < 25) 1 else 0
  },
  r.progress = FALSE
)
summary(result_multiple_epochs)
```
