test_that("Test 1", { seasonalStructure <- list(segments = list(c(1, 4)), sKnots = list(c(1, 4), 2, 3)) toTest <- as.matrix(seasonalTransformer(nKnots = 3, seasonalStructure = seasonalStructure)) v1 <- c(1, 0, 0, 0, 0, 0) v2 <- c(0, 1, 0, 0, 0, 0) v3 <- c(-1, -1, 0, 0, 0, 0) v4 <- c(0, 0, 1, 0, 0, 0) v5 <- c(0, 0, 0, 1, 0, 0) v6 <- c(0, 0, -1, -1, 0, 0) v7 <- c(0, 0, 0, 0, 1, 0) v8 <- c(0, 0, 0, 0, 0, 1) v9 <- c(0, 0, 0, 0, -1, -1) toCompare <- rbind(v1, v2, v3, v4, v5, v6, v7, v8, v9) expect_false(!identical(dim(toTest), dim(toCompare)) || sum(toTest != toCompare) > 0) seasonalStructure <- list(segments = list(c(1, 6)), sKnots = list(c(1, 6), 2, 3)) toTest <- as.matrix(seasonalTransformer(nKnots = 3, seasonalStructure = seasonalStructure)) v1 <- c(1, 0, 0, 0, 0, 0) v2 <- c(0, 1, 0, 0, 0, 0) v3 <- c(-1, -0.5, 0, 0, 0, 0) v4 <- c(0, 0, 1, 0, 0, 0) v5 <- c(0, 0, 0, 1, 0, 0) v6 <- c(0, 0, -1, -0.5, 0, 0) v7 <- c(0, 0, 0, 0, 1, 0) v8 <- c(0, 0, 0, 0, 0, 1) v9 <- c(0, 0, 0, 0, -1, -0.5) toCompare <- rbind(v1, v2, v3, v4, v5, v6, v7, v8, v9) expect_false(!identical(dim(toTest), dim(toCompare)) || sum(toTest != toCompare) > 0) seasonalStructure <- list(segments = list(c(0, 5)), sKnots = list(3, 4, c(0, 5))) toTest <- as.matrix(seasonalTransformer(nKnots = 3, seasonalStructure = seasonalStructure)) v1 <- c(1, 0, 0, 0, 0, 0) v2 <- c(0, 1, 0, 0, 0, 0) v3 <- c(-1, -0.5, 0, 0, 0, 0) v4 <- c(0, 0, 1, 0, 0, 0) v5 <- c(0, 0, 0, 1, 0, 0) v6 <- c(0, 0, -1, -0.5, 0, 0) v7 <- c(0, 0, 0, 0, 1, 0) v8 <- c(0, 0, 0, 0, 0, 1) v9 <- c(0, 0, 0, 0, -1, -0.5) toCompare <- rbind(v1, v2, v3, v4, v5, v6, v7, v8, v9) expect_false(!identical(dim(toTest), dim(toCompare)) || sum(toTest != toCompare) > 0) seasonalStructure <- list(segments = list(c(0, 5)), sKnots = list(1, 4, c(0, 5))) toTest <- as.matrix(seasonalTransformer(nKnots = 3, seasonalStructure = seasonalStructure)) v1 <- c(1, 0, 0, 0, 0, 0) v2 <- c(0, 1, 0, 0, 0, 0) v3 <- c(-2, -2, 0, 0, 0, 0) v4 <- c(0, 0, 1, 0, 0, 0) v5 <- c(0, 0, 0, 1, 0, 0) v6 <- c(0, 0, -2, -2, 0, 0) v7 <- c(0, 0, 0, 0, 1, 0) v8 <- c(0, 0, 0, 0, 0, 1) v9 <- c(0, 0, 0, 0, -2, -2) toCompare <- rbind(v1, v2, v3, v4, v5, v6, v7, v8, v9) expect_false(!identical(dim(toTest), dim(toCompare)) || sum(toTest != toCompare) > 0) seasonalStructure <- list(segments = list(c(0, 5)), sKnots = list(2, 4, c(0, 5))) toTest <- as.matrix(seasonalTransformer(nKnots = 3, seasonalStructure = seasonalStructure)) v1 <- c(1, 0, 0, 0, 0, 0) v2 <- c(0, 1, 0, 0, 0, 0) v3 <- c(-4 / 3, -1, 0, 0, 0, 0) v4 <- c(0, 0, 1, 0, 0, 0) v5 <- c(0, 0, 0, 1, 0, 0) v6 <- c(0, 0, -4 / 3, -1, 0, 0) v7 <- c(0, 0, 0, 0, 1, 0) v8 <- c(0, 0, 0, 0, 0, 1) v9 <- c(0, 0, 0, 0, -4 / 3, -1) toCompare <- rbind(v1, v2, v3, v4, v5, v6, v7, v8, v9) expect_false(!identical(dim(toTest), dim(toCompare)) || sum(toTest != toCompare) > 0) }) test_that("Test 2", { toTest <- as.matrix(seasonalTransposer(nKnots = 3, nSKnots = 3)) m <- matrix(1:9, 3, 3) v1 <- as.vector(toTest %*% as.vector(m)) v2 <- as.vector(t(m)) expect_false(!identical(length(v1), length(v2)) || sum(v1 != v2) > 0) for (nk in 1:10) { for (nsk in 2:10) { toTest <- as.matrix(seasonalTransposer(nk, nsk)) m <- matrix(1:(nk * nsk), nsk, nk) v1 <- as.vector(toTest %*% as.vector(m)) v2 <- as.vector(t(m)) expect_false(!identical(length(v1), length(v2)) || sum(v1 != v2) > 0) } } }) test_that("Test 3", { times <- c(1, 2, 5, 9, 9.5, 10) data <- rep(1, length(times)) seasons <- rep(0, length(times)) timeKnots <- c(1, 3, 10) seasonalStructure <- list(segments = list(c(0, 1)), sKnots = list(c(0, 1))) predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure) matrixToTest <- as.matrix(seasonalPredictorConstructor(predictor)) vk <- c(1, 3, 10) toTest <- as.vector(matrixToTest %*% vk) expect_true(sum(abs(toTest - times) > 1E-6) == 0) expect_true(length(toTest) == length(times)) # Now let's test with 2 time knots timeKnots <- c(1, 10) seasonalStructure <- list(segments = list(c(0, 1)), sKnots = list(c(0, 1))) predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure) matrixToTest <- as.matrix(seasonalPredictorConstructor(predictor)) vk <- c(1, 10) toTest <- as.vector(matrixToTest %*% vk) expect_true(length(toTest) == length(times)) expect_true(sum(abs(toTest - times) > 1E-6) == 0) # Testing with no time knots (static predictor) times <- c(1, 2, 5, 9, 9.5, 10) data <- times seasons <- NULL timeKnots <- NULL seasonalStructure <- NULL predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure) matrixToTest <- as.matrix(seasonalPredictorConstructor(predictor)) vk <- c(1) toTest <- as.vector(matrixToTest %*% vk) expect_true(length(toTest) == length(times)) expect_true(sum(abs(toTest - times) > 1E-6) == 0) # Testing static predictor times <- c(1, 2, 5, 9, 9.5, 10) data <- times data_ <- data + c(0.1, -0.2, 0.3, 0.1, -0.3, 0) seasons <- NULL timeKnots <- NULL seasonalStructure <- NULL predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure, lambdas = c(0, 0, 0)) str <- STRmodel(data = data_, predictors = list(predictor)) # plot(str) ############################################# timeKnots <- c(1, 5, 9) times <- 1:9 seasons <- c(2, 3, 1, 2, 3, 1, 2, 3, 1) data <- rep(1, length(times)) seasonalStructure <- list(segments = list(c(0, 3)), sKnots = list(1, 2, c(3, 0))) predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure) matrixToTest <- as.matrix(seasonalPredictorConstructor(predictor)) v <- c(-1, 0, -1, 0, -1, 0) toCompare <- c(0, 1, -1, 0, 1, -1, 0, 1, -1) toTest <- matrixToTest %*% v expect_false(!(sum(abs(toTest - toCompare) > 1E-6) == 0 && length(toTest) == length(toCompare))) timeKnots <- c(1, 5, 9) times <- 1:6 seasons <- c(2, 1, 2, 1, 2, 1) data <- rep(1, length(times)) seasonalStructure <- list(segments = list(c(0, 2)), sKnots = list(1, c(2, 0))) predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure) matrixToTest <- as.matrix(seasonalPredictorConstructor(predictor)) v <- c(-1, -1, -1) toCompare <- c(1, -1, 1, -1, 1, -1) toTest <- matrixToTest %*% v expect_false(!(sum(abs(toTest - toCompare) > 1E-6) == 0 && length(toTest) == length(toCompare))) timeKnots <- c(1, 5, 9, 15) seasons <- c(2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1) times <- seq_along(seasons) data <- rep(1, length(times)) seasonalStructure <- list(segments = list(c(0, 5)), sKnots = list(1, 2, 3, 4, c(5, 0))) predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure) matrixToTest <- as.matrix(seasonalPredictorConstructor(predictor)) v <- c(-2, -1, 0, 1, -2, -1, 0, 1, -2, -1, 0, 1, -2, -1, 0, 1) toCompare <- c(-1, 0, 1, 2, -2, -1, 0, 1, 2, -2, -1, 0, 1, 2, -2) toTest <- matrixToTest %*% v expect_false(!(sum(abs(toTest - toCompare) > 1E-6) == 0 && length(toTest) == length(toCompare))) timeKnots <- c(1, 8, 15) seasons <- c(2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1) times <- seq_along(seasons) data <- rep(1, length(times)) seasonalStructure <- list(segments = list(c(0, 5)), sKnots = list(1, 3, 4, c(5, 0))) predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure) matrixToTest <- as.matrix(seasonalPredictorConstructor(predictor)) v <- c(-2, 0, 1, -2, 0, 1, -2, 0, 1) toCompare <- c(-1, 0, 1, 2, -2, -1, 0, 1, 2, -2, -1, 0, 1, 2, -2) toTest <- matrixToTest %*% v expect_false(!(sum(abs(toTest - toCompare) > 1E-6) == 0 && length(toTest) == length(toCompare))) timeKnots <- c(1, 8, 15) seasons <- c(2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1) times <- seq_along(seasons) data <- rep(1, length(times)) seasonalStructure <- list(segments = list(c(0, 5)), sKnots = list(2, 3, 4, c(5, 0))) predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure) matrixToTest <- as.matrix(seasonalPredictorConstructor(predictor)) v <- c(-2, -1, 1, -2, -1, 1, -2, -1, 1) toCompare <- c(-2, -1, 1, 2, 0, -2, -1, 1, 2, 0, -2, -1, 1, 2, 0) toTest <- matrixToTest %*% v expect_false(!(sum(abs(toTest - toCompare) > 1E-6) == 0 && length(toTest) == length(toCompare))) timeKnots <- c(1, 8, 15) seasons <- c(2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1) times <- seq_along(seasons) data <- rep(1, length(times)) seasonalStructure <- list(segments = list(c(0, 5)), sKnots = list(2, 3, 4, c(5, 0))) predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure) matrixToTest <- as.matrix(seasonalPredictorConstructor(predictor)) v <- c(-2, -1, 1, 0, 0, 0, -2, -1, 1) toCompare <- c(-2, -1 * (6 / 7), 1 * (5 / 7), 2 * (4 / 7), 0 * (3 / 7), -2 * (2 / 7), -1 * (1 / 7), 1 * 0, 2 * (1 / 7), 0 * (2 / 7), -2 * (3 / 7), -1 * (4 / 7), 1 * (5 / 7), 2 * (6 / 7), 0) toTest <- matrixToTest %*% v expect_false(!(sum(abs(toTest - toCompare) > 1E-6) == 0 && length(toTest) == length(toCompare))) }) test_that("Test 4", { data <- c(7, 3, 1, 5, 3) timeKnots <- c(1, 2, 3, 5) seasons <- rep(0, length(data)) times <- seq_along(seasons) seasonalStructure <- list(segments = list(c(0, 1)), sKnots = list(c(0, 1))) predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure) matrixToTest <- as.matrix(seasonalPredictorConstructor(predictor)) v <- rep(1, length(timeKnots)) expect_true(all(abs(matrixToTest %*% v - data) < 1E-6)) data <- c(7, 3, 1, 5, 3) timeKnots <- c(1, 4, 5) seasons <- rep(0, length(data)) times <- seq_along(seasons) seasonalStructure <- list(segments = list(c(0, 1)), sKnots = list(c(0, 1))) predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure) matrixToTest <- as.matrix(seasonalPredictorConstructor(predictor)) v <- rep(1, length(timeKnots)) expect_true(all(abs(matrixToTest %*% v - data) < 1E-6)) ############################################# timeKnots <- c(1, 5, 9) times <- 1:9 seasons <- c(2, 3, 1, 2, 3, 1, 2, 3, 1) data <- (1:length(times))^2 - 7 seasonalStructure <- list(segments = list(c(0, 3)), sKnots = list(1, 2, c(3, 0))) predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure) matrixToTest <- as.matrix(seasonalPredictorConstructor(predictor)) v <- c(-1, 0, -1, 0, -1, 0) toCompare <- c(0, 1, -1, 0, 1, -1, 0, 1, -1) * data toTest <- matrixToTest %*% v expect_false(!(sum(abs(toTest - toCompare) > 1E-6) == 0 && length(toTest) == 9)) timeKnots <- c(1, 8, 15) seasons <- c(2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1) times <- seq_along(seasons) data <- (1:length(times))^2 - 7 seasonalStructure <- list(segments = list(c(0, 5)), sKnots = list(2, 3, 4, c(5, 0))) predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure) matrixToTest <- as.matrix(seasonalPredictorConstructor(predictor)) v <- c(-2, -1, 1, 0, 0, 0, -2, -1, 1) toCompare <- c(-2, -1 * (6 / 7), 1 * (5 / 7), 2 * (4 / 7), 0 * (3 / 7), -2 * (2 / 7), -1 * (1 / 7), 1 * 0, 2 * (1 / 7), 0 * (2 / 7), -2 * (3 / 7), -1 * (4 / 7), 1 * (5 / 7), 2 * (6 / 7), 0) * data toTest <- matrixToTest %*% v expect_false(!(sum(abs(toTest - toCompare) > 1E-6) == 0 && length(toTest) == length(toCompare))) }) test_that("Test 5", { n <- 5 v <- 1:n expect_true(all(abs(as.matrix(diff1(n)) %*% v - rep(1, n - 1)) < 1E-6)) n <- 25 v <- 1:n expect_true(all(abs(as.matrix(diff2(n)) %*% v - rep(0, n - 2)) < 1E-6)) }) test_that("Test 6", { knots <- c(1, 3, 5, 7, 9) vd <- as.matrix(vector2Derivatives(knots, weights = rep(1, length(knots) - 2))) expect_true(all(abs(vd %*% knots - rep(0, length(knots) - 2)) < 1E-6)) knots <- c(1, 5, 7, 9) vd <- as.matrix(vector2Derivatives(knots, weights = rep(1, length(knots) - 2))) expect_true(all(abs(vd %*% knots - rep(0, length(knots) - 2)) < 1E-6)) knots <- c(1, 8.9, 9) vd <- as.matrix(vector2Derivatives(knots, weights = rep(1, length(knots) - 2))) expect_true(all(abs(vd %*% knots - rep(0, length(knots) - 2)) < 1E-6)) knots <- c(1, 8.9, 9) vd <- as.matrix(vector2Derivatives(knots, weights = rep(1, length(knots) - 2))) expect_true(all(abs(vd %*% (knots^2) - rep(2, length(knots) - 2)) < 1E-6)) knots <- c(1, 8.9, 9, 12, 14, 15, 16) vd <- as.matrix(vector2Derivatives(knots, weights = rep(1, length(knots) - 2))) expect_true(all(abs(vd %*% (knots^2) - rep(2, length(knots) - 2)) < 1E-6)) knots <- c(1, 8.9, 9, 12, 14, 15, 16) vd <- as.matrix(vector2Derivatives(knots, weights = rep(0.5, length(knots) - 2))) expect_true(all(abs(vd %*% (knots^2) - rep(1, length(knots) - 2)) < 1E-6)) }) test_that("Test 7", { seasonalStructure <- list( segments = list(c(0, 24), c(100, 124), c(212, 224), c(312, 324)), sKnots = list(c(0, 24, 324), 4, 8, c(12, 212), 16, 20, c(100, 124, 224), 104, 108, c(112, 312), 116, 120, 216, 220, 316, 320) ) lrk <- lrKnots(seasonalStructure) lk <- list(c(NA, 20, 320), 0, 4, c(8, NA), 12, 16, c(NA, 120, 220), 100, 104, c(108, NA), 112, 116, 212, 216, 312, 316) rk <- list(c(4, NA, NA), 8, 12, c(16, 216), 20, 24, c(104, NA, NA), 108, 112, c(116, 316), 120, 124, 220, 224, 320, 324) expect_true(length(lrk$lKnots) == length(lk)) expect_true(length(lrk$rKnots) == length(rk)) expect_true(sum(!unlist(lapply(seq_along(lrk$lKnots), function(i) identical(lk[[i]], lrk$lKnots[[i]])))) == 0) expect_true(sum(!unlist(lapply(seq_along(lrk$rKnots), function(i) identical(rk[[i]], lrk$rKnots[[i]])))) == 0) expect_true(knotToIndex(0, seasonalStructure$sKnots) == 1) expect_true(knotToIndex(4, seasonalStructure$sKnots) == 2) expect_true(knotToIndex(8, seasonalStructure$sKnots) == 3) expect_true(knotToIndex(12, seasonalStructure$sKnots) == 4) expect_true(knotToIndex(16, seasonalStructure$sKnots) == 5) expect_true(knotToIndex(20, seasonalStructure$sKnots) == 6) expect_true(knotToIndex(24, seasonalStructure$sKnots) == 1) expect_true(knotToIndex(100, seasonalStructure$sKnots) == 7) expect_true(knotToIndex(104, seasonalStructure$sKnots) == 8) expect_true(knotToIndex(108, seasonalStructure$sKnots) == 9) expect_true(knotToIndex(112, seasonalStructure$sKnots) == 10) expect_true(knotToIndex(116, seasonalStructure$sKnots) == 11) expect_true(knotToIndex(120, seasonalStructure$sKnots) == 12) expect_true(knotToIndex(124, seasonalStructure$sKnots) == 7) expect_true(knotToIndex(212, seasonalStructure$sKnots) == 4) expect_true(knotToIndex(216, seasonalStructure$sKnots) == 13) expect_true(knotToIndex(220, seasonalStructure$sKnots) == 14) expect_true(knotToIndex(224, seasonalStructure$sKnots) == 7) expect_true(knotToIndex(312, seasonalStructure$sKnots) == 10) expect_true(knotToIndex(316, seasonalStructure$sKnots) == 15) expect_true(knotToIndex(320, seasonalStructure$sKnots) == 16) expect_true(knotToIndex(324, seasonalStructure$sKnots) == 1) }) test_that("Test 7", { seasonalStructure <- list( segments = list(c(0, 24), c(100, 124), c(212, 224), c(312, 324)), sKnots = list(c(0, 24, 324), 4, 8, c(12, 212), 16, 20, c(100, 124, 224), 104, 108, c(112, 312), 116, 120, 216, 220, 316, 320) ) tm <- as.matrix(cycle2Derivatives(seasonalStructure)) sKnots <- seasonalStructure$sKnots nSKnots <- length(sKnots) v <- rep(7.7, nSKnots) toTest <- as.vector(tm %*% v) expect_true(all(abs(toTest) < 1E-6)) seasonalStructure <- list( segments = list(c(0, 4), c(10, 14)), sKnots = list(c(0, 4, 10, 14), 1, 2, 3, 11, 12, 13) ) tm <- as.matrix(cycle2Derivatives(seasonalStructure)) sKnots <- seasonalStructure$sKnots nSKnots <- length(sKnots) expect_true(nSKnots == 7) v <- rep(7.7, nSKnots) toTest <- as.vector(tm %*% v) expect_true(all(abs(toTest) < 1E-6)) expect_true(length(toTest) == 10) v <- c(1, 1, 1, 1, 1, 2, 1) tm <- as.matrix(cycle2Derivatives(seasonalStructure, norm = 1)) toTest <- as.vector(tm %*% v) expect_true(all(abs(toTest - c(0, 0, 0, 0, 0, 0, 0, 1, -2, 1)) < 1E-6)) v <- c(1, 1, 1, 1, 1, 2, 1) tm <- as.matrix(cycle2Derivatives(seasonalStructure, norm = 2)) toTest <- as.vector(tm %*% v) expect_true(all(abs(toTest - c(0, 0, 0, 0, 0, 0, 0, 1, -2, 1)) < 1E-6)) v <- c(2, 1, 1, 1, 1, 1, 1) tm <- as.matrix(cycle2Derivatives(seasonalStructure, norm = 1)) toTest <- as.vector(tm %*% v) expect_true(all(abs(toTest - c(-1, -1, -1, -1, 1, 0, 1, 1, 0, 1)) < 1E-6)) v <- c(2, 1, 1, 1, 1, 1, 1) tm <- as.matrix(cycle2Derivatives(seasonalStructure, norm = 2)) toTest <- as.vector(tm %*% v) expect_true(all(abs(toTest - c(-sqrt(2), -sqrt(2), -sqrt(2), -sqrt(2), 1, 0, 1, 1, 0, 1)) < 1E-6)) v <- c(1, 2, 1, 1, 1, 1, 1) tm <- as.matrix(cycle2Derivatives(seasonalStructure, norm = 1)) toTest <- as.vector(tm %*% v) expect_true(all(abs(toTest - c(0.5, 0, 0.5, 0, -2, 1, 0, 0, 0, 0)) < 1E-6)) seasonalStructure <- list( segments = list(c(0, 4)), sKnots = list(1, 2, 3, c(0, 4)) ) c2d <- as.matrix(cycle2Derivatives(seasonalStructure, norm = 2)) v <- c(0, 1, 0, 1) expect_true(all(abs(c2d %*% v - 2 * c(1, -1, 1, -1)) < 1E-6)) }) test_that("Test 8", { timeKnots <- c(1, 6, 11) times <- 1:11 seasons <- c(1, 2, 3, 4, 5, 1, 2, 3, 4, 5) data <- (1:length(times))^2 - 7 seasonalStructure <- list(segments = list(c(0, 5)), sKnots = list(1, 2, 3, 4, c(5, 0))) predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure) matrixToTest <- as.matrix(ssRegulariser(predictor, norm = 1)) # I do not know how to test it... }) test_that("Test 9", { timeKnots <- c(1, 6, 11) times <- 1:11 seasons <- c(1, 2, 3, 4, 5, 1, 2, 3, 4, 5) data <- (1:length(times))^2 - 7 seasonalStructure <- list(segments = list(c(0, 5)), sKnots = list(1, 2, 3, 4, c(5, 0))) predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure) matrixToTest <- as.matrix(ttRegulariser(predictor, norm = 1)) v <- c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) toTest <- as.vector(matrixToTest %*% v) expect_true(all(toTest < 1E-6)) v <- c(1, 1, 1, 1, 2, 2, 2, 2, 1, 1, 1, 1) toTest <- as.vector(matrixToTest %*% v) toCompare <- c(-0.4, -0.4, -0.4, -0.4, 1.6) expect_true(all(toTest - toCompare < 1E-6)) }) test_that("Test 10", { timeKnots <- c(1, 6, 11) times <- 1:11 seasons <- c(1, 2, 3, 4, 5, 1, 2, 3, 4, 5) data <- (1:length(times))^2 - 7 seasonalStructure <- list(segments = list(c(0, 5)), sKnots = list(1, 2, 3, 4, c(5, 0))) predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure) matrixToTest <- as.matrix(stRegulariser(predictor, norm = 1)) v <- c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) toTest <- as.vector(matrixToTest %*% v) toCompare <- rep(0, 10) expect_true(all(toTest - toCompare < 1E-6)) v <- c(1, 1, 1, 1, 2, 2, 2, 2, 1, 1, 1, 1) toTest <- as.vector(matrixToTest %*% v) toCompare <- c(0, 0, 0, -5, 5, 0, 0, 0, 5, -5) expect_true(all(toTest - toCompare < 1E-6)) }) test_that("Test 11", { timeKnots <- c(1, 6, 11) times <- 1:11 seasons <- c(1, 2, 3, 4, 5, 1, 2, 3, 4, 5) data <- (1:length(times))^2 - 7 seasonalStructure <- list(segments = list(c(0, 5)), sKnots = list(1, 2, 3, 4, c(5, 0))) predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure, lambdas = c(1, 2, 3)) matrixToTest <- as.matrix(predictorRegulariser(predictor)) # I do not know how to test it... }) test_that("Test 12", { timeKnots <- c(1, 6, 11) times <- 1:11 seasons <- c(1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1) data <- (1:length(times))^2 - 7 seasonalStructure <- list(segments = list(c(0, 5)), sKnots = list(1, 2, 3, 4, c(5, 0))) predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure, lambdas = c(1, 2, 3)) predictors <- list(predictor, predictor) matrixToTest <- as.matrix(constructorMatrix(predictors)$matrix) seats <- constructorMatrix(predictors)$seats matrixToTest2 <- as.matrix(regulariserMatrix(predictors)$matrix) matrixToTest3 <- as.matrix(designMatrix(predictors)) matrixToTest4 <- designMatrix(predictors) # I do not know how to test it... }) test_that("Test 13", { knots <- c(1, 2, 3, 4) expect_true(all(abs(tWeights(knots, norm = 1) - c(0.5, 1, 1, 0.5)) < 1E-6)) knots <- c(1, 3, 7) expect_true(all(abs(tWeights(knots, norm = 1) - c(1, 3, 2)) < 1E-6)) }) test_that("Test 14", { expect_true(translST(s = 1, t = 1, nSKnots = 3) == 1) expect_true(translST(s = 2, t = 1, nSKnots = 3) == 2) expect_true(translST(s = 3, t = 1, nSKnots = 3) == 3) expect_true(translST(s = 1, t = 2, nSKnots = 3) == 4) }) test_that("Test 15", { seasonalStructure <- list(segments = list(c(0, 4)), sKnots = list(1, 2, 3, c(4, 0))) seasons <- c(2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1) times <- seq_along(seasons) data <- rep(1, length(seasons)) timeKnots <- c(1, 5, 9) predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure, lambdas = c(1, 2, 3)) fullDataVector <- c( 1, -1, 1, -1, 1, -1, 1, -1, 1, -1, 1, -1 ) fullDataMatrix <- matrix(fullDataVector, 4, 3) reducedDataMatrix <- fullDataMatrix[1:3, ] v <- as.vector(reducedDataMatrix) ssr <- as.matrix(ssRegulariser(predictor, norm = 1)) r <- ssr %*% v m <- matrix(r, 4, 3) expect_true(all(m[, 1] == 8 * c(-1, 1, -1, 1))) expect_true(all(m[, 2] == 16 * c(-1, 1, -1, 1))) expect_true(all(m[, 3] == 8 * c(-1, 1, -1, 1))) ttr <- as.matrix(ttRegulariser(predictor, norm = 2)) r <- ttr %*% v expect_true(all(abs(r) < 1E-6)) str <- as.matrix(stRegulariser(predictor, norm = 2)) r <- str %*% v expect_true(all(abs(r) < 1E-6)) ############################################# fullDataVector <- c( 1, -1, 1, -1, 2, -2, 2, -2, 3, -3, 3, -3 ) fullDataMatrix <- matrix(fullDataVector, 4, 3) reducedDataMatrix <- fullDataMatrix[1:3, ] v <- as.vector(reducedDataMatrix) ssr <- as.matrix(ssRegulariser(predictor, norm = 1)) r <- ssr %*% v m <- matrix(r, 4, 3) expect_true(all(m[, 1] == 8 * c(-1, 1, -1, 1))) expect_true(all(m[, 2] == 32 * c(-1, 1, -1, 1))) expect_true(all(m[, 3] == 24 * c(-1, 1, -1, 1))) ttr <- as.matrix(ttRegulariser(predictor, norm = 2)) r <- ttr %*% v expect_true(all(abs(r) < 1E-6)) str <- as.matrix(stRegulariser(predictor, norm = 1)) r <- str %*% v m <- matrix(r, 4, 2) expect_true(all(m[, 1] == 2 * c(-1, 1, -1, 1))) expect_true(all(m[, 2] == 2 * c(-1, 1, -1, 1))) ############################################# fullDataVector <- c( 1, -1, 1, -1, -1, 1, -1, 1, 1, -1, 1, -1 ) fullDataMatrix <- matrix(fullDataVector, 4, 3) reducedDataMatrix <- fullDataMatrix[1:3, ] v <- as.vector(reducedDataMatrix) ssr <- as.matrix(ssRegulariser(predictor, norm = 1)) r <- ssr %*% v m <- matrix(r, 4, 3) expect_true(all(m[, 1] == 8 * c(-1, 1, -1, 1))) expect_true(all(m[, 2] == -16 * c(-1, 1, -1, 1))) expect_true(all(m[, 3] == 8 * c(-1, 1, -1, 1))) ttr <- as.matrix(ttRegulariser(predictor, norm = 1)) r <- ttr %*% v expect_true(all(r == c(1, -1, 1, -1))) str <- as.matrix(stRegulariser(predictor, norm = 1)) r <- str %*% v m <- matrix(r, 4, 2) expect_true(all(m[, 1] == 4 * c(1, -1, 1, -1))) expect_true(all(m[, 2] == -4 * c(1, -1, 1, -1))) }) test_that("Test 18", { seasonalStructure <- list(segments = list(c(0, 4)), sKnots = list(1, 3, c(4, 0))) seasons <- c(2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1) times <- seq_along(seasons) data <- rep(1, length(seasons)) timeKnots <- c(1, 7, 9) predictor <- list(data = data, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure, lambdas = c(5, 0, 2)) fullDataVector <- c( 1, -1, 0, -1, 1, 0, 1, -1, 0 ) fullDataMatrix <- matrix(fullDataVector, 3, 3) reducedDataMatrix <- fullDataMatrix[1:2, ] v <- as.vector(reducedDataMatrix) ssr <- as.matrix(ssRegulariser(predictor, norm = 2)) r <- ssr %*% v m <- matrix(r, 3, 3) dts12 <- (1 / 6 + 1 / 2) * 2 w2s <- 1.5 w1t <- 3 dw12 <- dts12 * sqrt(w2s * w1t) rv <- c(-dw12, dw12, 0) expect_true(all(abs(m[, 1] - rv) < 1E-6)) w2t <- 4 dw22 <- dts12 * sqrt(w2s * w2t) rv <- c(dw22, -dw22, 0) expect_true(all(abs(m[, 2] - rv) < 1E-6)) w3t <- 1 dw32 <- dts12 * sqrt(w2s * w3t) rv <- c(-dw32, dw32, 0) expect_true(all(abs(m[, 3] - rv) < 1E-6)) ttr <- as.matrix(ttRegulariser(predictor, norm = 2)) r <- ttr %*% v d <- 1 / 3 dw <- d * sqrt(4 * 1.5) rv <- c(dw, -dw, 0) expect_true(all(abs(r - rv) < 1E-6)) str <- as.matrix(stRegulariser(predictor, norm = 2)) r <- str %*% v m <- matrix(r, 3, 2) rv1 <- c(2 / sqrt(3), -2 / sqrt(6), -2 / sqrt(6)) expect_true(all(abs(m[, 1] - rv1) < 1E-6)) rv2 <- c(-2, 2 / sqrt(2), 2 / sqrt(2)) expect_true(all(abs(m[, 2] - rv2) < 1E-6)) }) test_that("Test 19", { l <- list(list(data = c(1, 3, 4, 5)), list(data = c(4, 7, 0, 2))) expect_true(all(getLimits(l) == c(0, 7))) }) test_that("Test 20", { n <- 5 trendSeasonalStructure <- list(segments = list(c(0, 1)), sKnots = list(c(1, 0))) trend <- list(data = rep(1, n), times = 1:n, seasons = rep(1, n), timeKnots = 1:n, seasonalStructure = trendSeasonalStructure, lambdas = c(1, 0, 0)) toTest <- as.matrix(ttRegulariser(trend, norm = 2)) v <- 1:n expect_true(all(abs(toTest %*% v) < 1E-6)) }) test_that("Test 21", { for (n in 55:71) { trendSeasonalStructure <- list(segments = list(c(0, 1)), sKnots = list(c(1, 0))) timeKnots1 <- 1:n trend1 <- list(data = rep(1, n), times = 1:n, seasons = rep(1, n), timeKnots = 1:n, seasonalStructure = trendSeasonalStructure, lambdas = c(1, 0, 0)) timeKnots2 <- sort(union(seq(1, n, by = 2), c(1, 2, n, n - 1))) trend2 <- list(data = rep(1, n), times = 1:n, seasons = rep(1, n), timeKnots = timeKnots2, seasonalStructure = trendSeasonalStructure, lambdas = c(1, 0, 0)) times3 <- seq(1, n, by = 3) times4 <- seq(1, n, by = 3) timeKnots3 <- sort(union(setdiff(setdiff(timeKnots1, times3), times4), c(1, 2, n - 1, n))) trend3 <- list(data = rep(1, n), times = 1:n, seasons = rep(1, n), timeKnots = timeKnots3, seasonalStructure = trendSeasonalStructure, lambdas = c(1, 0, 0)) toTest1 <- as.matrix(ttRegulariser(trend1, norm = 1)) toTest2 <- as.matrix(ttRegulariser(trend2, norm = 1)) toTest3 <- as.matrix(ttRegulariser(trend3, norm = 1)) v1 <- ((1:n) / n)^2 v2 <- v1[timeKnots2] v3 <- v1[timeKnots3] expect_true(abs(sum(abs(toTest1 %*% v1)) / sum(abs(toTest2 %*% v2)) - 1) < 1E-5) expect_true(abs(sum(abs(toTest1 %*% v1)) / sum(abs(toTest3 %*% v3)) - 1) < 1E-5) toTest1 <- as.matrix(ttRegulariser(trend1, norm = 2)) toTest2 <- as.matrix(ttRegulariser(trend2, norm = 2)) toTest3 <- as.matrix(ttRegulariser(trend3, norm = 2)) expect_true(abs(sum((toTest1 %*% v1)^2) / sum((toTest2 %*% v2)^2) - 1) < 1E-5) expect_true(abs(sum((toTest1 %*% v1)^2) / sum((toTest3 %*% v3)^2) - 1) < 1E-5) } }) test_that("Test 22", { n <- 101 by <- 0.1 sKnots <- c(as.list(setdiff(seq(0, 1, by = by), c(0, 1))), list(c(1, 0))) seasonalStructure <- list(segments = list(c(0, 1)), sKnots = sKnots) timeKnots1 <- 1:n s1 <- list(data = rep(1, n), times = 1:n, seasons = rep(1, n), timeKnots = 1:n, seasonalStructure = seasonalStructure, lambdas = c(1, 0, 0)) timeKnots2 <- sort(union(seq(1, n, by = 2), c(1, 2, n - 1, n))) s2 <- list(data = rep(1, n), times = 1:n, seasons = rep(1, n), timeKnots = timeKnots2, seasonalStructure = seasonalStructure, lambdas = c(1, 0, 0)) v1 <- ((1:n) / n)^2 vv1 <- as.vector(sapply(v1, FUN = function(x) rep(x, length(sKnots) - 1))) v2 <- v1[timeKnots2] vv2 <- as.vector(sapply(v2, FUN = function(x) rep(x, length(sKnots) - 1))) toTest1 <- as.matrix(ttRegulariser(s1, norm = 2)) toTest2 <- as.matrix(ttRegulariser(s2, norm = 2)) # length(vv1) # dim(toTest1) expect_true(abs(sum((toTest1 %*% vv1)^2) / sum((toTest2 %*% vv2)^2) - 1) < 1E-5) }) test_that("Test 23", { n <- 30 by <- 0.005 by2 <- 0.0025 intKnots <- setdiff(seq(0, 1, by = by), c(0, 1)) intKnots2 <- setdiff(seq(0, 1, by = by2), c(0, 1)) sKnots <- c(as.list(intKnots), list(c(1, 0))) sKnots2 <- c(as.list(intKnots2), list(c(1, 0))) seasonalStructure <- list(segments = list(c(0, 1)), sKnots = sKnots) seasonalStructure2 <- list(segments = list(c(0, 1)), sKnots = sKnots2) timeKnots1 <- 1:n s1 <- list(data = rep(1, n), times = 1:n, seasons = rep(1, n), timeKnots = 1:n, seasonalStructure = seasonalStructure, lambdas = c(1, 0, 0)) timeKnots2 <- sort(union(seq(1, n, by = 2), c(1, 2, n - 1, n))) s2 <- list(data = rep(1, n), times = 1:n, seasons = rep(1, n), timeKnots = timeKnots2, seasonalStructure = seasonalStructure, lambdas = c(1, 0, 0)) s3 <- list(data = rep(1, n), times = 1:n, seasons = rep(1, n), timeKnots = timeKnots2, seasonalStructure = seasonalStructure2, lambdas = c(1, 0, 0)) sinv <- sin(intKnots * 2 * pi) sinv2 <- sin(intKnots2 * 2 * pi) expect_true(sum(sinv) < 1E-6) expect_true(sum(sinv2) < 1E-6) v1 <- ((1:n) / n)^2 vv1 <- as.vector(sapply(v1, FUN = function(x) x * sinv)) v2 <- v1[timeKnots2] vv2 <- as.vector(sapply(v2, FUN = function(x) x * sinv)) vv3 <- as.vector(sapply(v2, FUN = function(x) x * sinv2)) toTest1 <- as.matrix(ttRegulariser(s1, norm = 2)) toTest2 <- as.matrix(ttRegulariser(s2, norm = 2)) toTest3 <- as.matrix(ttRegulariser(s3, norm = 2)) expect_true(abs(sum((toTest1 %*% vv1)^2) / sum((toTest2 %*% vv2)^2) - 1) < 1E-5) expect_true(abs(sum((toTest1 %*% vv1)^2) / sum((toTest3 %*% vv3)^2) - 1) < 1E-5) toTest1 <- as.matrix(ttRegulariser(s1, norm = 1)) toTest2 <- as.matrix(ttRegulariser(s2, norm = 1)) toTest3 <- as.matrix(ttRegulariser(s3, norm = 1)) expect_true(abs(sum(abs(toTest1 %*% vv1)) / sum(abs(toTest2 %*% vv2)) - 1) < 1E-5) expect_true(abs(sum(abs(toTest1 %*% vv1)) / sum(abs(toTest3 %*% vv3)) - 1) < 1E-4) }) test_that("Test 24", { n <- 30 k <- 100 intSet <- 1:(k - 1) intSet2 <- setdiff(intSet, seq(1, k - 1, by = 3)) intKnots <- intSet / k intKnots2 <- intSet2 / k sKnots <- c(as.list(intKnots), list(c(1, 0))) sKnots2 <- c(as.list(intKnots2), list(c(1, 0))) seasonalStructure <- list(segments = list(c(0, 1)), sKnots = sKnots) seasonalStructure2 <- list(segments = list(c(0, 1)), sKnots = sKnots2) timeKnots1 <- 1:n s1 <- list(data = rep(1, n), times = 1:n, seasons = rep(1, n), timeKnots = 1:n, seasonalStructure = seasonalStructure, lambdas = c(1, 0, 0)) timeKnots2 <- sort(union(seq(1, n, by = 2), c(1, 2, n - 1, n))) s2 <- list(data = rep(1, n), times = 1:n, seasons = rep(1, n), timeKnots = timeKnots2, seasonalStructure = seasonalStructure, lambdas = c(1, 0, 0)) s3 <- list(data = rep(1, n), times = 1:n, seasons = rep(1, n), timeKnots = timeKnots2, seasonalStructure = seasonalStructure2, lambdas = c(1, 0, 0)) sinv <- sin(intKnots * 2 * pi) sinv2 <- sin(intKnots2 * 2 * pi) expect_true(sum(sinv) < 1E-6) expect_true(sum(sinv2) < 1E-6) v1 <- ((1:n) / n)^2 vv1 <- as.vector(sapply(v1, FUN = function(x) x * sinv)) v2 <- v1[timeKnots2] vv2 <- as.vector(sapply(v2, FUN = function(x) x * sinv)) vv3 <- as.vector(sapply(v2, FUN = function(x) x * sinv2)) toTest1 <- as.matrix(ttRegulariser(s1, norm = 2)) toTest2 <- as.matrix(ttRegulariser(s2, norm = 2)) toTest3 <- as.matrix(ttRegulariser(s3, norm = 2)) expect_true(abs(sum((toTest1 %*% vv1)^2) / sum((toTest2 %*% vv2)^2) - 1) < 1E-5) expect_true(abs(sum((toTest1 %*% vv1)^2) / sum((toTest3 %*% vv3)^2) - 1) < 1E-4) toTest1 <- as.matrix(ttRegulariser(s1, norm = 1)) toTest2 <- as.matrix(ttRegulariser(s2, norm = 1)) toTest3 <- as.matrix(ttRegulariser(s3, norm = 1)) expect_true(abs(sum(abs(toTest1 %*% vv1)) / sum(abs(toTest2 %*% vv2)) - 1) < 1E-5) expect_true(abs(sum(abs(toTest1 %*% vv1)) / sum(abs(toTest3 %*% vv3)) - 1) < 1E-3) }) test_that("Test 25", { n <- 30 k <- 100 intSet <- 1:(k - 1) intSet2 <- setdiff(intSet, seq(1, k - 1, by = 3)) intKnots <- intSet / k intKnots2 <- intSet2 / k sKnots <- c(as.list(intKnots), list(c(1, 0))) sKnots2 <- c(as.list(intKnots2), list(c(1, 0))) seasonalStructure <- list(segments = list(c(0, 1)), sKnots = sKnots) seasonalStructure2 <- list(segments = list(c(0, 1)), sKnots = sKnots2) timeKnots1 <- 1:n s1 <- list(data = rep(1, n), times = 1:n, seasons = rep(1, n), timeKnots = 1:n, seasonalStructure = seasonalStructure, lambdas = c(1, 0, 0)) timeKnots2 <- sort(union(seq(1, n, by = 2), c(1, 2, n - 1, n))) s2 <- list(data = rep(1, n), times = 1:n, seasons = rep(1, n), timeKnots = timeKnots2, seasonalStructure = seasonalStructure, lambdas = c(1, 0, 0)) s3 <- list(data = rep(1, n), times = 1:n, seasons = rep(1, n), timeKnots = timeKnots2, seasonalStructure = seasonalStructure2, lambdas = c(1, 0, 0)) sinv <- sin(intKnots * 2 * pi) sinv2 <- sin(intKnots2 * 2 * pi) expect_true(sum(sinv) < 1E-6) expect_true(sum(sinv2) < 1E-6) v1 <- ((1:n) / n)^2 vv1 <- as.vector(sapply(v1, FUN = function(x) x * sinv)) v2 <- v1[timeKnots2] vv2 <- as.vector(sapply(v2, FUN = function(x) x * sinv)) vv3 <- as.vector(sapply(v2, FUN = function(x) x * sinv2)) toTest1 <- as.matrix(stRegulariser(s1, norm = 2)) toTest2 <- as.matrix(stRegulariser(s2, norm = 2)) toTest3 <- as.matrix(stRegulariser(s3, norm = 2)) expect_true(abs(sum((toTest1 %*% vv1)^2) / sum((toTest2 %*% vv2)^2) - 1) < 1E-3) expect_true(abs(sum((toTest1 %*% vv1)^2) / sum((toTest3 %*% vv3)^2) - 1) < 5E-2) toTest1 <- as.matrix(stRegulariser(s1, norm = 1)) toTest2 <- as.matrix(stRegulariser(s2, norm = 1)) toTest3 <- as.matrix(stRegulariser(s3, norm = 1)) expect_true(abs(sum(abs(toTest1 %*% vv1)) / sum(abs(toTest2 %*% vv2)) - 1) < 1E-5) expect_true(abs(sum(abs(toTest1 %*% vv1)) / sum(abs(toTest3 %*% vv3)) - 1) < 1E-3) }) test_that("Test 26", { n <- 30 k <- 100 intSet <- 1:(k - 1) intSet2 <- setdiff(intSet, seq(1, k - 1, by = 2)) intKnots <- intSet / k intKnots2 <- intSet2 / k sKnots <- c(as.list(intKnots), list(c(1, 0))) sKnots2 <- c(as.list(intKnots2), list(c(1, 0))) seasonalStructure <- list(segments = list(c(0, 1)), sKnots = sKnots) seasonalStructure2 <- list(segments = list(c(0, 1)), sKnots = sKnots2) timeKnots1 <- 1:n s1 <- list(data = rep(1, n), times = 1:n, seasons = rep(1, n), timeKnots = 1:n, seasonalStructure = seasonalStructure, lambdas = c(1, 0, 0)) timeKnots2 <- sort(union(seq(1, n, by = 2), c(1, 2, n - 1, n))) s2 <- list(data = rep(1, n), times = 1:n, seasons = rep(1, n), timeKnots = timeKnots2, seasonalStructure = seasonalStructure, lambdas = c(1, 0, 0)) s3 <- list(data = rep(1, n), times = 1:n, seasons = rep(1, n), timeKnots = timeKnots2, seasonalStructure = seasonalStructure2, lambdas = c(1, 0, 0)) sinv <- sin(intKnots * 2 * pi) sinv2 <- sin(intKnots2 * 2 * pi) expect_true(sum(sinv) < 1E-6) expect_true(sum(sinv2) < 1E-6) v1 <- ((1:n) / n)^2 vv1 <- as.vector(sapply(v1, FUN = function(x) x * sinv)) v2 <- v1[timeKnots2] vv2 <- as.vector(sapply(v2, FUN = function(x) x * sinv)) vv3 <- as.vector(sapply(v2, FUN = function(x) x * sinv2)) toTest1 <- as.matrix(ssRegulariser(s1, norm = 2)) toTest2 <- as.matrix(ssRegulariser(s2, norm = 2)) toTest3 <- as.matrix(ssRegulariser(s3, norm = 2)) expect_true(abs(sum((toTest1 %*% vv1)^2) / sum((toTest2 %*% vv2)^2) - 1) < 5E-2) expect_true(abs(sum((toTest1 %*% vv1)^2) / sum((toTest3 %*% vv3)^2) - 1) < 5E-2) toTest1 <- as.matrix(ssRegulariser(s1, norm = 1)) toTest2 <- as.matrix(ssRegulariser(s2, norm = 1)) toTest3 <- as.matrix(ssRegulariser(s3, norm = 1)) expect_true(abs(sum(abs(toTest1 %*% vv1)) / sum(abs(toTest2 %*% vv2)) - 1) < 5E-2) expect_true(abs(sum(abs(toTest1 %*% vv1)) / sum(abs(toTest3 %*% vv3)) - 1) < 5E-2) }) test_that("Test 27", { n <- 50 trendSeasonalStructure <- list(segments = list(c(0, 1)), sKnots = list(c(1, 0))) ns <- 5 seasonalStructure <- list(segments = list(c(0, ns)), sKnots = c(as.list(1:(ns - 1)), list(c(ns, 0)))) seasons <- rep(1:ns, n %/% ns + 1)[1:n] trendSeasons <- rep(1, length(seasons)) times <- seq_along(seasons) data <- seasons + times / 4 plot(times, data, type = "l") timeKnots <- times trendData <- rep(1, n) seasonData <- rep(1, n) trend <- list(data = trendData, times = times, seasons = trendSeasons, timeKnots = timeKnots, seasonalStructure = trendSeasonalStructure, lambdas = c(1, 0, 0)) season <- list(data = seasonData, times = times, seasons = seasons, timeKnots = timeKnots, seasonalStructure = seasonalStructure, lambdas = c(10, 0, 0)) predictors <- list(trend, season) str1 <- STRmodel(data, predictors) # plot(str1$output$random$data, type = "l") # plot(str1$output$predictors[[1]]$data, type = "l") # plot(str1$output$predictors[[2]]$data, type = "l") plot(str1) oldData <- data data <- oldData data[c(3, 4, 7, 20, 24, 29, 35, 37, 45)] <- NA plot(times, data, type = "l") str2 <- STRmodel(data, predictors) plot(str2) data <- data + rnorm(length(data), 0, 0.2) plot(times, data, type = "l") str3 <- STRmodel(data, predictors) plot(str3) #str4 <- STRmodel(data, predictors, confidence = 0.95) #plot(str4) })