├── .Rbuildignore ├── .gitignore ├── DESCRIPTION ├── NAMESPACE ├── R ├── autossa.R ├── cadzow.R ├── capabilities.R ├── chankel.R ├── common.R ├── eossa.R ├── forecast.R ├── gapfill.R ├── hankel.R ├── hbhankel.R ├── hmatr.R ├── igapfill.R ├── init.R.in ├── mhankel.R ├── ossa.R ├── parest.R ├── plot.R ├── plot2.R ├── plotn.R ├── pssa.R ├── ssa.R ├── toeplitz.R ├── wcor.R └── wossa.R ├── cleanup ├── configure ├── configure.ac ├── configure.win ├── data ├── AustralianWine.rda ├── Barbara.rda ├── Mars.rda ├── MotorVehicle.rda └── USUnemployment.rda ├── inst ├── CITATION └── extdata │ ├── 1dssa.testdata.rda │ ├── 2dssa.testdata.rda │ ├── common.test.methods.R │ ├── gentest-1dssa.R │ ├── gentest-2dssa.R │ ├── gentest-mssa.R │ ├── gentest-pssa.R │ ├── gentest-toeplitz.R │ ├── gentest-wcor.2d.ssa.R │ ├── mssa.batching.R │ ├── mssa.testdata.rda │ ├── pssa.testdata.rda │ ├── toeplitz.testdata.rda │ └── wcor.2dssa.testdata.rda ├── man ├── AustralianWine.Rd ├── Barbara.rd ├── Mars.Rd ├── MotorVehicle.Rd ├── Rssa-package.Rd ├── USUnemployment.Rd ├── autossa.Rd ├── bforecast.Rd ├── cadzow.Rd ├── calcv.Rd ├── cleanup.Rd ├── clone.Rd ├── clplot.Rd ├── clusterify.Rd ├── decompose.Rd ├── eossa.Rd ├── forecast.Rd ├── fossa.Rd ├── frobenius.cor.Rd ├── gapfill.Rd ├── grouping.auto.Rd ├── hankel.Rd ├── hbhankel.Rd ├── hmatr.Rd ├── igapfill.Rd ├── iossa.Rd ├── iossa.result.Rd ├── lrr.Rd ├── owcor.Rd ├── parest.Rd ├── plot.Rd ├── plot.reconstruct.Rd ├── precache.Rd ├── reconstruct.Rd ├── residuals.Rd ├── rforecast.Rd ├── ssa-data.Rd ├── ssa-routines.Rd ├── ssa.Rd ├── ssa.capabilities.Rd ├── summarize.gaps.Rd ├── toeplitz.Rd ├── vforecast.Rd ├── wcor.Rd └── wnorm.Rd ├── src ├── Makevars.in ├── Rssa_init.c ├── config.h.in ├── config.h.win ├── extmat.c ├── extmat.h ├── fft_plan.h ├── hankel.c ├── hbhankel.c ├── masks.c ├── masks.h └── toeplitz.c └── tests ├── testthat.R └── testthat ├── test-1dssa.R ├── test-2dssa.R ├── test-cadzow.R ├── test-circular1d.R ├── test-circular2d.R ├── test-forecast.R ├── test-forecast.finite.rank.R ├── test-is.fft.plan.R ├── test-marginalL.R ├── test-mssa-shaped.R ├── test-mssa.R ├── test-ndssa.R ├── test-ossa.R ├── test-parest.R ├── test-pssa.R ├── test-serialize.R ├── test-sh1dssa.R ├── test-sh2dssa.R ├── test-toeplitz.R ├── test-wcor.R └── test-wossa.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ToDo.txt 2 | .gitignore 3 | tests 4 | inst/extdata 5 | inst/tests -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.swp 3 | *.swo 4 | *.dll 5 | *.win 6 | *~ 7 | R/init.R 8 | *.Rcheck 9 | .gitignore 10 | config.status 11 | src/Makevars 12 | src/Rssa.so 13 | src/config.h 14 | src/symbols.rds 15 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: Rssa 2 | Type: Package 3 | Title: A Collection of Methods for Singular Spectrum Analysis 4 | Version: 1.1 5 | Depends: R (>= 3.1), svd (>= 0.4), forecast 6 | Imports: lattice, methods 7 | Suggests: testthat (>= 0.7), RSpectra, PRIMME, irlba 8 | SystemRequirements: fftw (>=3.2) 9 | Author: Anton Korobeynikov, Alex Shlemov, Konstantin Usevich, Nina Golyandina 10 | Maintainer: Anton Korobeynikov 11 | Authors@R: c(person(given = "Anton", 12 | family = "Korobeynikov", 13 | role = c("aut", "cre"), 14 | email = "anton@korobeynikov.info"), 15 | person(given = "Alex", 16 | family = "Shlemov", 17 | role = "aut"), 18 | person(given = "Konstantin", 19 | family = "Usevich", 20 | role = "aut"), 21 | person(given = "Nina", 22 | family = "Golyandina", 23 | role = "aut")) 24 | Description: Methods and tools for Singular Spectrum Analysis including decomposition, 25 | forecasting and gap-filling for univariate and multivariate time series. 26 | General description of the methods with many examples can be found in the book 27 | Golyandina (2018, ). 28 | See 'citation("Rssa")' for details. 29 | License: GPL (>= 2) 30 | URL: https://github.com/asl/rssa 31 | BugReports: https://github.com/asl/rssa/issues 32 | Config/testthat/parallel: true 33 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | useDynLib(Rssa, .registration = TRUE) 2 | 3 | import(lattice) 4 | import(svd) 5 | import(forecast) 6 | 7 | export(clone, 8 | decompose, 9 | reconstruct, 10 | nu, 11 | nv, 12 | nlambda, 13 | nsigma, 14 | nspecial, 15 | contributions, 16 | calc.v, 17 | precache, 18 | cleanup, 19 | ssa, 20 | wcor, 21 | wcor.default, 22 | hmatr, 23 | wnorm, 24 | # Capabilities 25 | ssa.capabilities, 26 | # Hankel matrix' routines 27 | new.hmat, 28 | hmatmul, 29 | hankel, 30 | hcols, 31 | hrows, 32 | is.hmat, 33 | # Hankel-block hankel matrix' routines 34 | new.hbhmat, 35 | hbhmatmul, 36 | hbhcols, 37 | hbhrows, 38 | is.hbhmat, 39 | # Symmetric toeplitz matrix' routines 40 | new.tmat, 41 | tmatmul, 42 | tcols, 43 | trows, 44 | is.tmat, 45 | # Forecast stuff 46 | lrr, 47 | roots, 48 | rforecast, 49 | vforecast, 50 | bforecast, 51 | # Period estimation 52 | parestimate, 53 | # Gap filling and rank estimation 54 | cadzow, 55 | # Non-orthogonal decompositions 56 | iossa, 57 | eossa, 58 | owcor, 59 | fossa, 60 | frobenius.cor, 61 | # Gapfilling 62 | igapfill, 63 | clplot, 64 | gapfill, 65 | summarize.gaps, 66 | # Auto-grouping routines 67 | grouping.auto, 68 | grouping.auto.wcor, 69 | grouping.auto.pgram 70 | ) 71 | 72 | S3method("clone", ssa) 73 | S3method("decompose", "ssa") 74 | S3method("decompose", "toeplitz.ssa") 75 | S3method("decompose", "cssa") 76 | S3method("decompose", "pssa") 77 | S3method("decompose", "ossa") 78 | S3method("reconstruct", ssa) 79 | S3method("residuals", ssa) 80 | S3method("residuals", "ssa.reconstruction") 81 | S3method("calc.v", "ssa") 82 | S3method("calc.v", "cssa") 83 | S3method("$", ssa) 84 | S3method("print", ssa) 85 | S3method("print", ossa) 86 | S3method("summary", ssa) 87 | S3method("summary", ossa) 88 | S3method("plot", ssa) 89 | S3method("plot", "1d.ssa.reconstruction") 90 | S3method("plot", "toeplitz.ssa.reconstruction") 91 | S3method("plot", "2d.ssa.reconstruction") 92 | S3method("plot", "nd.ssa.reconstruction") 93 | S3method("plot", "mssa.reconstruction") 94 | S3method("plot", "cssa.reconstruction") 95 | S3method("plot", "grouping.auto.wcor") 96 | S3method("plot", "grouping.auto.pgram") 97 | S3method("wcor", "default") 98 | S3method("wcor", "ssa") 99 | S3method("wcor", "ossa") 100 | S3method("wnorm", "default") 101 | S3method("wnorm", "complex") 102 | S3method("wnorm", "1d.ssa") 103 | S3method("wnorm", "cssa") 104 | S3method("wnorm", "nd.ssa") 105 | S3method("wnorm", "toeplitz.ssa") 106 | S3method("wnorm", "mssa") 107 | S3method("plot", wcor.matrix) 108 | S3method("lrr", "default") 109 | S3method("lrr", "1d.ssa") 110 | S3method("lrr", "toeplitz.ssa") 111 | S3method("lrr", "mssa") 112 | S3method("lrr", "cssa") 113 | S3method("forecast", "1d.ssa") 114 | S3method("forecast", "toeplitz.ssa") 115 | S3method("predict", "1d.ssa") 116 | S3method("predict", "toeplitz.ssa") 117 | S3method("predict", "mssa") 118 | S3method("rforecast", "1d.ssa") 119 | S3method("rforecast", "toeplitz.ssa") 120 | S3method("rforecast", "mssa") 121 | S3method("rforecast", "cssa") 122 | S3method("rforecast", "pssa.1d.ssa") 123 | S3method("vforecast", "1d.ssa") 124 | S3method("vforecast", "toeplitz.ssa") 125 | S3method("vforecast", "mssa") 126 | S3method("vforecast", "cssa") 127 | S3method("vforecast", "pssa.1d.ssa") 128 | S3method("roots", "lrr") 129 | S3method("plot", "lrr") 130 | S3method("print", "fdimpars.1d") 131 | S3method("plot", "fdimpars.1d") 132 | S3method("print", "fdimpars.nd") 133 | S3method("plot", "fdimpars.nd") 134 | S3method("plot", "hmatr") 135 | S3method("print", "iossa.result") 136 | S3method("print", "ssa.gaps") 137 | S3method("plot", "ssa.gaps") 138 | S3method("summary", "iossa.result") 139 | S3method("bforecast", "1d.ssa") 140 | S3method("bforecast", "toeplitz.ssa") 141 | S3method("parestimate", "1d.ssa") 142 | S3method("parestimate", "nd.ssa") 143 | S3method("parestimate", "toeplitz.ssa") 144 | S3method("parestimate", "mssa") 145 | S3method("parestimate", "cssa") 146 | S3method("cadzow", "ssa") 147 | S3method("nspecial", "ssa") 148 | S3method("nspecial", "pssa") 149 | S3method("gapfill", "1d.ssa") 150 | S3method("gapfill", "cssa") 151 | S3method("gapfill", "toeplitz.ssa") 152 | S3method("gapfill", "mssa") 153 | S3method("igapfill", "ssa") 154 | S3method("igapfill", "1d.ssa") 155 | S3method("igapfill", "nd.ssa") 156 | S3method("igapfill", "mssa") 157 | S3method("summarize.gaps", "1d.ssa") 158 | S3method("summarize.gaps", "cssa") 159 | S3method("summarize.gaps", "toeplitz.ssa") 160 | S3method("fossa", "ssa") 161 | S3method("iossa", "ssa") 162 | S3method("grouping.auto.wcor", "ssa") 163 | S3method("grouping.auto.pgram", "1d.ssa") 164 | S3method("grouping.auto.pgram", "toeplitz.ssa") 165 | S3method("eossa", "ssa") 166 | 167 | ## Default imports 168 | importFrom("grDevices", "colorRampPalette", "grey", "heat.colors") 169 | importFrom("graphics", "image", "matplot", "plot") 170 | importFrom("stats", "approxfun", "as.dist", "as.formula", "cov2cor", 171 | "cutree", "fft", "filter", "frequency", "hclust", "is.ts", 172 | "mad", "median", "mvfft", "poly", "predict", "quantile", 173 | "residuals", "time", "toeplitz", "ts", "ts.union", "tsp<-") 174 | importFrom("utils", "head", "modifyList", "object.size", "getS3method") 175 | importFrom("methods", "new") 176 | -------------------------------------------------------------------------------- /R/cadzow.R: -------------------------------------------------------------------------------- 1 | # R package for Singular Spectrum Analysis 2 | # Copyright (c) 2013 Anton Korobeynikov 3 | # 4 | # This program is free software; you can redistribute it 5 | # and/or modify it under the terms of the GNU General Public 6 | # License as published by the Free Software Foundation; 7 | # either version 2 of the License, or (at your option) 8 | # any later version. 9 | # 10 | # This program is distributed in the hope that it will be 11 | # useful, but WITHOUT ANY WARRANTY; without even the implied 12 | # warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 13 | # PURPOSE. See the GNU General Public License for more details. 14 | # 15 | # You should have received a copy of the GNU General Public 16 | # License along with this program; if not, write to the 17 | # Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 18 | # MA 02139, USA. 19 | 20 | .extend.series <- function(x, alpha) { 21 | if (is.list(x)) lapply(x, sys.function(), alpha = alpha) else alpha * x 22 | } 23 | 24 | .series.dist <- function(F1, F2, norm, mask = TRUE) { 25 | mask <- as.logical(mask) 26 | F1 <- as.vector(unlist(F1))[mask] 27 | F2 <- as.vector(unlist(F2))[mask] 28 | 29 | norm(F1 - F2) 30 | } 31 | 32 | .series.winnerprod <- function(F1, F2, weights = 1) { 33 | mask <- weights > 0 34 | 35 | weights <- weights[mask] 36 | F1 <- as.vector(unlist(F1))[mask] 37 | F2 <- as.vector(unlist(F2))[mask] 38 | 39 | sum(weights * F1 * F2) 40 | } 41 | 42 | .inner.fmt.conversion <- function(x, ...) 43 | UseMethod(".inner.fmt.conversion") 44 | 45 | .inner.fmt.conversion.ssa <- function(x, ...) 46 | identical 47 | 48 | .inner.fmt.conversion.1d.ssa <- .inner.fmt.conversion.toeplitz.ssa <- function(x, ...) 49 | as.numeric 50 | 51 | .inner.fmt.conversion.cssa <- function(x, ...) 52 | as.complex 53 | 54 | .inner.fmt.conversion.2d.ssa <- function(x, ...) 55 | as.matrix 56 | 57 | .inner.fmt.conversion.nd.ssa <- function(x, ...) 58 | as.array 59 | 60 | .inner.fmt.conversion.mssa <- function(x, ...) { 61 | template <- x$F 62 | 63 | # Prevent storing huge ssa-object in closure 64 | x <- NULL 65 | 66 | function(x) .to.series.list(x, template = template) 67 | } 68 | 69 | cadzow.ssa <- function(x, rank, 70 | correct = TRUE, 71 | tol = 1e-6, maxiter = 0, 72 | norm = function(x) max(abs(x)), 73 | trace = FALSE, 74 | ..., cache = TRUE) { 75 | # Get conversion 76 | conversion <- .inner.fmt.conversion(x) 77 | 78 | # Get weights and mask 79 | weights <- .hweights(x) 80 | mask <- weights > 0 81 | 82 | # Obtain the initial reconstruction of rank r 83 | r <- reconstruct(x, groups = list(1:rank), ..., cache = cache) 84 | stopifnot(length(r) == 1) 85 | F <- r[[1]] 86 | 87 | # Do the actual iterations until the convergence (or stoppping due to number 88 | # of iterations) 89 | it <- 0 90 | repeat { 91 | s <- clone(x, copy.cache = FALSE, copy.storage = FALSE) 92 | .set(s, "F", conversion(F)) 93 | r <- reconstruct(s, groups = list(1:rank), ..., cache = FALSE) 94 | stopifnot(length(r) == 1) 95 | rF <- r[[1]] 96 | 97 | it <- it + 1 98 | if ((maxiter > 0 && it >= maxiter) || (sqd <- .series.dist(F, rF, norm, mask)) < tol) 99 | break 100 | if (trace) 101 | cat(sprintf("Iteration: %d, distance: %s\n", it, format(sqd))) 102 | F <- rF 103 | } 104 | 105 | if (correct) { 106 | alpha <- .series.winnerprod(.F(x), F, weights) / .series.winnerprod(F, F, weights) 107 | F <- .extend.series(F, alpha) 108 | } 109 | 110 | F 111 | } 112 | 113 | cadzow <- function(x, ...) 114 | UseMethod("cadzow") 115 | -------------------------------------------------------------------------------- /R/capabilities.R: -------------------------------------------------------------------------------- 1 | # R package for Singular Spectrum Analysis 2 | # Copyright (c) 2015-2016 Anton Korobeynikov 3 | # 4 | # This program is free software; you can redistribute it 5 | # and/or modify it under the terms of the GNU General Public 6 | # License as published by the Free Software Foundation; 7 | # either version 2 of the License, or (at your option) 8 | # any later version. 9 | # 10 | # This program is distributed in the hope that it will be 11 | # useful, but WITHOUT ANY WARRANTY; without even the implied 12 | # warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 13 | # PURPOSE. See the GNU General Public License for more details. 14 | # 15 | # You should have received a copy of the GNU General Public 16 | # License along with this program; if not, write to the 17 | # Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 18 | # MA 02139, USA. 19 | 20 | .capabilities <- list() 21 | 22 | .register.capability <- function(name, fun, 23 | pred = function(...) TRUE, 24 | alias) { 25 | if (missing(alias)) 26 | alias <- fun 27 | .capabilities[[alias]] <<- list(fun = fun, pred = pred, name = name) 28 | } 29 | 30 | capable <- function(x, capname) { 31 | cap.entry <- .capabilities[[capname]] 32 | stopifnot(!is.null(cap.entry)) 33 | any(sapply(class(x), .check.caps, cap = cap.entry, x = x)) 34 | } 35 | 36 | .check.caps <- function(cap, klass, x) 37 | !is.null(getS3method(f = cap$fun, class = klass, optional = TRUE)) && cap$pred(x) 38 | 39 | ssa.capabilities <- function(x) { 40 | res <- list() 41 | for (klass in class(x)) 42 | res[[klass]] <- sapply(.capabilities, .check.caps, klass = klass, x = x) 43 | res <- apply(simplify2array(res), 1, any) 44 | names(res) <- sapply(.capabilities[names(res)], function(x) x$name) 45 | res 46 | } 47 | 48 | .register.capability("Decomposition", "decompose") 49 | .caps.continue <- function(x) { 50 | ## Only nu-trlan SVD method is capable of continuation 51 | identical(x$svd.method, "nutrlan") 52 | } 53 | .register.capability("Continuation of a decomposition", "decompose", .caps.continue, "decompose.continue") 54 | 55 | .register.capability("Reconstruction", "reconstruct") 56 | .register.capability("Plotting", "plot") 57 | 58 | .caps.vforecast <- function(x) { 59 | ## No forecast in shaped and circular case 60 | !is.shaped(x) && !x$circular 61 | } 62 | 63 | .caps.rforecast <- function(x) { 64 | ## No forecast in shaped case 65 | !is.shaped(x) || x$circular 66 | } 67 | .register.capability("Recurrent forecast", "rforecast", .caps.rforecast) 68 | .register.capability("Vector forecast", "vforecast", .caps.vforecast) 69 | 70 | .caps.gapfill <- function(x) { 71 | ## Gapfilling should always start from shaped object 72 | is.shaped(x) 73 | } 74 | .register.capability("Gapfilling via forecast", "gapfill", .caps.gapfill) 75 | .register.capability("Iterative gapfilling", "igapfill", .caps.gapfill) 76 | 77 | .register.capability("Cadzow iterations", "cadzow") 78 | .register.capability("W-correlations", "wnorm") 79 | 80 | .caps.lrr <- function(x) { 81 | ## We don't support LRR in shaped case 82 | !is.shaped(x) || x$circular 83 | } 84 | .register.capability("LRR", "lrr", .caps.lrr) 85 | 86 | .caps.iossa <- function(x) { 87 | ## No complex case 88 | !inherits(x, "cssa") 89 | } 90 | .register.capability("Iterative O-SSA nested decomposition", "iossa", .caps.iossa) 91 | .register.capability("Filter-adjusted O-SSA nested decomposition", "fossa") 92 | 93 | .register.capability("Automatic grouping via w-correlations", "grouping.auto.wcor") 94 | 95 | .caps.autossa <- function(x) { 96 | ## No periodogram in shaped case 97 | !is.shaped(x) 98 | } 99 | .register.capability("Automatic grouping via periodogram", "grouping.auto.pgram", .caps.autossa) 100 | 101 | -------------------------------------------------------------------------------- /R/eossa.R: -------------------------------------------------------------------------------- 1 | # R package for Singular Spectrum Analysis 2 | # Copyright (c) 2017-2018 Alex Shlemov 3 | # 4 | # This program is free software; you can redistribute it 5 | # and/or modify it under the terms of the GNU General Public 6 | # License as published by the Free Software Foundation; 7 | # either version 2 of the License, or (at your option) 8 | # any later version. 9 | # 10 | # This program is distributed in the hope that it will be 11 | # useful, but WITHOUT ANY WARRANTY; without even the implied 12 | # warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 13 | # PURPOSE. See the GNU General Public License for more details. 14 | # 15 | # You should have received a copy of the GNU General Public 16 | # License along with this program; if not, write to the 17 | # Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 18 | # MA 02139, USA. 19 | 20 | # Routines for ESPRIT-based Oblique SSA 21 | 22 | 23 | # TODO use QR instead of SVD and make basis real before clustering and joining 24 | .clust.basis <- function(U, roots, k = 2, h = NULL, order = FALSE) { 25 | # Reorder roots by their freqs 26 | ord <- order(abs(Arg(roots))) 27 | roots <- roots[ord] 28 | U <- U[, ord, drop = FALSE] 29 | 30 | stopifnot(length(k) == 1) 31 | 32 | # Check for argument k, k <= the number of roots with nonegative imagine part 33 | maxk <- sum(Im(roots) >= -.Machine$double.eps) # Maybe just Im >= 0? 34 | if (k > maxk) { 35 | stop(sprintf("k exceeds the number of different ESPRIT roots with non-negative imaginary parts (%d%)", maxk)) 36 | } 37 | 38 | d <- stats::dist(cbind(Re(roots), abs(Im(roots))), method = "euclidian") # TODO Use the proper distance from KDU 39 | 40 | hc <- hclust(d, method = "complete") 41 | 42 | idx <- cutree(hc, k = k, h = h) 43 | 44 | groups <- tapply(seq_along(idx), idx, identity) 45 | names(groups) <- paste("F", names(groups), sep = "") 46 | 47 | for (group in groups) { 48 | U[, group] <- svd(cbind(Re(U[, group, drop = FALSE]), 49 | Im(U[, group, drop = FALSE])), 50 | nu = length(group), nv = 0)$u 51 | } 52 | 53 | U <- Re(U) 54 | 55 | if (order) { 56 | U <- U[, unlist(groups), drop = FALSE] 57 | l <- sapply(groups, length) 58 | cl <- cumsum(c(0, l)) 59 | groups <- lapply(seq_along(l), function(i) (cl[i] + 1) : cl[i+1]) 60 | } 61 | 62 | list(basis = U, groups = groups) 63 | } 64 | 65 | eossa <- function(x, ...) 66 | UseMethod("eossa") 67 | 68 | eossa.ssa <- function(x, 69 | nested.groups, k = 2, 70 | subspace = c("column", "row"), 71 | dimensions = NULL, 72 | solve.method = c("ls", "tls"), 73 | beta = 8, 74 | ...) { 75 | if (missing(nested.groups)) 76 | nested.groups <- as.list(1:min(nsigma(x), nu(x))) 77 | 78 | subspace <- match.arg(subspace) 79 | solve.method <- match.arg(solve.method) 80 | 81 | # Continue decomposition, if necessary 82 | .maybe.continue(x, groups = nested.groups, ...) 83 | 84 | idx <- sort(unique(unlist(nested.groups))) 85 | triples <- .get.orth.triples(x, idx, do.orthogonalize = FALSE) 86 | osigma <- triples$sigma; U <- triples$U; V <- triples$V 87 | 88 | if (identical(subspace, "column")) { 89 | vectors <- U 90 | V <- V * rep(osigma, each = nrow(V)) 91 | wmask <- .wmask(x) 92 | } else if (identical(subspace, "row")) { 93 | vectors <- V 94 | U <- U * rep(sqrt(osigma), each = nrow(U)) 95 | wmask <- .fmask(x) 96 | } 97 | sigma <- rep(1, length(idx)) 98 | 99 | if (is.null(dimensions)) { 100 | dimensions <- seq_len(.dim(x)) 101 | } 102 | 103 | d <- dim(wmask) 104 | 105 | if (max(dimensions) > length(d)) { 106 | stop(sprintf("some of input dimension indices exceed the actual number of object dimensions (%d)", 107 | length(d))) 108 | } 109 | 110 | Zs <- lapply(dimensions, 111 | function(ndim) { 112 | .shift.matrix(vectors, 113 | wmask = wmask, 114 | ndim = ndim, 115 | circular = x$circular[ndim], 116 | solve.method = solve.method) 117 | }) 118 | 119 | Z <- .matrix.linear.combination(Zs, beta) 120 | Ze <- eigen(Z, symmetric = FALSE) 121 | 122 | # sm <- 0.5 * (Usm + t(Vsm)) # TODO implement two-sided ESPRIT???? 123 | mb <- .clust.basis(Ze$vectors, Ze$values, k = k) 124 | C <- mb$basis 125 | nested.groups <- mb$groups 126 | 127 | U <- U %*% C 128 | # V <- V %*% solve(t(C)) # TODO Use qr.solve here 129 | V <- t(qr.solve(C, t(V))) 130 | 131 | x <- clone(x, copy.cache = FALSE) # TODO Maybe we should to preserve the relevant part of the cache? 132 | .save.oblique.decomposition(x, sigma, U, V, idx) 133 | 134 | # Return to real group numbers 135 | nested.groups <- lapply(nested.groups, function(group) idx[group]) 136 | 137 | # Grab old iossa.groups.all value 138 | iossa.groups.all <- .get(x, "iossa.groups.all", allow.null = TRUE) 139 | if (is.null(iossa.groups.all)) { 140 | iossa.groups.all <- list() 141 | } 142 | 143 | valid.groups <- as.logical(sapply(iossa.groups.all, 144 | function(group) length(intersect(group, idx)) == 0)) 145 | .set(x, "iossa.groups", nested.groups) 146 | .set(x, "iossa.groups.all", c(nested.groups, iossa.groups.all[valid.groups])) 147 | 148 | # Save nested components 149 | .set(x, "ossa.set", idx) 150 | 151 | if (!is.null(.decomposition(x, "nPR"))) { 152 | if (any(idx <= .decomposition(x, "nPR"))) { 153 | .set.decomposition(x, nPR = 0, nPL = 0) 154 | } else if (any(idx <= sum(unlist(.decomposition(x, c("nPR", "nPL")))))){ 155 | .set.decomposition(x, nPL = 0) 156 | } 157 | } 158 | 159 | if (!inherits(x, "ossa")) { 160 | class(x) <- c("ossa", class(x)) 161 | } 162 | 163 | # Save call info 164 | x$call <- match.call() 165 | 166 | invisible(x) 167 | } 168 | -------------------------------------------------------------------------------- /R/hmatr.R: -------------------------------------------------------------------------------- 1 | # R package for Singular Spectrum Analysis 2 | # Copyright (c) 2012 Anton Korobeynikov 3 | # 4 | # This program is free software; you can redistribute it 5 | # and/or modify it under the terms of the GNU General Public 6 | # License as published by the Free Software Foundation; 7 | # either version 2 of the License, or (at your option) 8 | # any later version. 9 | # 10 | # This program is distributed in the hope that it will be 11 | # useful, but WITHOUT ANY WARRANTY; without even the implied 12 | # warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 13 | # PURPOSE. See the GNU General Public License for more details. 14 | # 15 | # You should have received a copy of the GNU General Public 16 | # License along with this program; if not, write to the 17 | # Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 18 | # MA 02139, USA. 19 | 20 | hmatr <- function(F, ..., 21 | B = N %/% 4, T = N %/% 4, L = B %/% 2, 22 | neig = 10) { 23 | N <- length(F) 24 | 25 | # Pre-calculate embedding vectors and their squared norms 26 | th <- t(hankel(F, L = L)) 27 | cth2 <- c(0, cumsum(rowSums(th^2))) 28 | cth2 <- (cth2[1:(N-T)+(T-L+1)] - cth2[1:(N-T)]) 29 | 30 | hc <- function(idx) { 31 | Fb <- F[idx:(idx+B)] # Form a basis subspace 32 | s <- ssa(Fb, L = L, ..., neig = min(2*neig, 50)) 33 | 34 | # Calculate the distance 35 | U <- s$U[, 1:neig, drop = FALSE] 36 | # FIXME: Can we use FFT stuff here somehow? 37 | cXU2 <- c(0, cumsum(rowSums((th %*% U)^2))) 38 | 39 | 1 - (cXU2[1:(N-T)+(T-L+1)] - cXU2[1:(N-T)]) / cth2 40 | } 41 | 42 | h <- sapply(1:(N-B), hc) 43 | class(h) <- "hmatr" 44 | 45 | invisible(h) 46 | } 47 | 48 | plot.hmatr <- function(x, 49 | col = rev(heat.colors(256)), 50 | main = "Heterogeneity Matrix", 51 | xlab = "", ylab = "", 52 | ...) { 53 | image(1:nrow(x), 1:ncol(x), x, 54 | col = col, xlab = xlab, ylab = ylab, main = main, ...) 55 | } 56 | -------------------------------------------------------------------------------- /R/init.R.in: -------------------------------------------------------------------------------- 1 | .onAttach <- function(libname, pkgname) { 2 | if (!@HAVE_FFTW@) { 3 | packageStartupMessage('\nWARNING: ', pkgname, ' was compiled without FFTW support.') 4 | packageStartupMessage('The speed of the routines will be slower as well.') 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /R/plotn.R: -------------------------------------------------------------------------------- 1 | # R package for Singular Spectrum Analysis 2 | # Copyright (c) 2014 Alex Shlemov 3 | # 4 | # This program is free software; you can redistribute it 5 | # and/or modify it under the terms of the GNU General Public 6 | # License as published by the Free Software Foundation; 7 | # either version 2 of the License, or (at your option) 8 | # any later version. 9 | # 10 | # This program is distributed in the hope that it will be 11 | # useful, but WITHOUT ANY WARRANTY; without even the implied 12 | # warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 13 | # PURPOSE. See the GNU General Public License for more details. 14 | # 15 | # You should have received a copy of the GNU General Public 16 | # License along with this program; if not, write to the 17 | # Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 18 | # MA 02139, USA. 19 | 20 | 21 | .do.slice.array <- function(x, slice) { 22 | dim.names <- names(slice) 23 | if (is.null(dim.names) || any(dim.names == "")) { 24 | stop("All `slice' elements should be named") 25 | # TODO Maybe assign unnamed arguments by order like in function call? 26 | } 27 | 28 | parse.dim.index <- function(name) { 29 | if (grepl("^d?\\d+$", name)) { 30 | dim.index <- as.numeric(sub("d", "", name, fixed = TRUE)) 31 | } else { 32 | dim.index <- switch(name, 33 | x =, i = 1, 34 | y =, j = 2, 35 | z =, k = 3, 36 | t = 4) 37 | if (is.null(dim.index)) { 38 | stop(sprintf("%s is not proper dimension name", name)) 39 | } 40 | } 41 | 42 | dim.index 43 | } 44 | 45 | dim.indices <- sapply(dim.names, parse.dim.index) 46 | 47 | stopifnot(length(unique(dim.indices)) == length(dim.indices)) 48 | 49 | # Coerce argument to array 50 | if (!is.array(x)) x <- as.array(x) 51 | rank <- length(dim(x)) 52 | 53 | stopifnot(max(dim.indices) <= rank) 54 | 55 | args <- as.list(rep(TRUE, rank)) 56 | for (i in seq_along(dim.indices)) { 57 | args[[dim.indices[i]]] <- slice[[i]] 58 | } 59 | 60 | res <- do.call("[", c(list(x, drop = TRUE), args)) 61 | 62 | res 63 | } 64 | 65 | .do.slice.ssa.reconstruction <- function(x, slice) { 66 | for (i in seq_along(x)) { 67 | x[[i]] <- .do.slice.array(x[[i]], slice) 68 | } 69 | 70 | attr(x, "series") <- .do.slice.array(attr(x, "series"), slice) 71 | attr(x, "residuals") <- .do.slice.array(attr(x, "residuals"), slice) 72 | 73 | x 74 | } 75 | 76 | plot.nd.ssa.reconstruction <- function(x, slice, ...) { 77 | x <- .do.slice.ssa.reconstruction(x, slice) 78 | 79 | series <- attr(x, "series") 80 | rank <- length(dim(as.array(series))) 81 | 82 | if (rank == 1) 83 | plot.1d.ssa.reconstruction(x, ...) 84 | else if (rank == 2) 85 | plot.2d.ssa.reconstruction(x, ...) 86 | else 87 | stop("Cannot display array of rank higher than 2. Use `slice' argument") 88 | } 89 | 90 | .plot.ssa.vectors.nd.ssa <- function(x, slice, ..., 91 | what = c("eigen", "factor"), 92 | plot.contrib = FALSE, 93 | idx) { 94 | what <- match.arg(what) 95 | 96 | dots <- list(...) 97 | 98 | if (max(idx) > nsigma(x)) 99 | stop("Too few eigentriples computed for this decomposition") 100 | 101 | N <- x$length 102 | L <- x$window 103 | K <- ifelse(x$circular, N, N - L + 1) 104 | 105 | if (identical(what, "eigen")) { 106 | mask <- x$wmask 107 | dimension <- L 108 | vmatrix <- .U(x)[, idx, drop = FALSE] 109 | } else if (identical(what, "factor")) { 110 | mask <- x$fmask 111 | dimension <- K 112 | vmatrix <- matrix(NA_real_, nrow = .traj.dim(x)[2], ncol = length(idx)) 113 | 114 | vmatrix[, idx <= nv(x)] <- .V(x)[, idx[idx <= nv(x)]] 115 | if (any(idx > nv(x))) { 116 | # Some factor vectors are not available. Calculate them on-fly. 117 | vmatrix[, idx > nv(x)] <- calc.v(x, idx[idx > nv(x)]) 118 | } 119 | } 120 | 121 | if (is.null(mask)) mask <- array(TRUE, dim = dimension) 122 | 123 | # We actually create a reconstruction object with all stuff there.. 124 | res <- lapply(seq_len(ncol(vmatrix)), 125 | function(i) { 126 | vec <- array(NA_real_, dim = dimension) 127 | vec[mask] <- vmatrix[, i] 128 | 129 | vec 130 | }) 131 | 132 | # Make and set fake initial series and residuals 133 | fakeseries <- array(0, dim = dimension) 134 | fakeresiduals <- array(NA_real_, dim = dimension); fakeresiduals[mask] <- 0 135 | attr(res, "series") <- fakeseries 136 | attr(res, "residuals") <- fakeresiduals 137 | 138 | names(res) <- if (!plot.contrib) idx else paste(idx, " (", .contribution(x, idx, ...), "%)", sep = "") 139 | 140 | 141 | # Provide convenient defaults 142 | dots <- .defaults(dots, 143 | xlab = "", 144 | ylab = "", 145 | main = if (identical(what, "eigen")) "Eigenvectors" else "Factor vectors", 146 | as.table = TRUE, 147 | scales = list(draw = FALSE, relation = "free"), 148 | aspect = 1, 149 | plot.type = "l", 150 | symmetric = TRUE, 151 | ref = TRUE) 152 | 153 | do.call(plot.nd.ssa.reconstruction, c(list(res, 154 | slice = slice, 155 | add.original = FALSE, 156 | add.residuals = FALSE, 157 | plot.method = "xyplot"), 158 | dots)) 159 | } 160 | -------------------------------------------------------------------------------- /R/toeplitz.R: -------------------------------------------------------------------------------- 1 | # R package for Singular Spectrum Analysis 2 | # Copyright (c) 2009 Anton Korobeynikov 3 | # 4 | # This program is free software; you can redistribute it 5 | # and/or modify it under the terms of the GNU General Public 6 | # License as published by the Free Software Foundation; 7 | # either version 2 of the License, or (at your option) 8 | # any later version. 9 | # 10 | # This program is distributed in the hope that it will be 11 | # useful, but WITHOUT ANY WARRANTY; without even the implied 12 | # warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 13 | # PURPOSE. See the GNU General Public License for more details. 14 | # 15 | # You should have received a copy of the GNU General Public 16 | # License along with this program; if not, write to the 17 | # Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 18 | # MA 02139, USA. 19 | 20 | # Routines for toeplitz SSA 21 | 22 | Lcor <- function(F, L, circular = FALSE) { 23 | storage.mode(F) <- "double" 24 | storage.mode(L) <- "integer" 25 | storage.mode(circular) <- "logical" 26 | .Call("Lcor_", F, L, circular) 27 | } 28 | 29 | new.tmat <- function(F, L = (N + 1) %/% 2, 30 | circular = FALSE, 31 | fft.plan = NULL) { 32 | N <- length(F) 33 | R <- Lcor(F, L, circular = circular) 34 | 35 | storage.mode(R) <- "double" 36 | 37 | new("extmat", 38 | .Call("initialize_tmat", R, if (is.null(fft.plan)) fft.plan.1d(2*L - 1, L = L) else fft.plan)) 39 | } 40 | 41 | tcols <- function(t) { 42 | ncol(t) 43 | } 44 | 45 | trows <- function(t) { 46 | nrow(t) 47 | } 48 | 49 | is.tmat <- function(t) { 50 | is.extmat(t) && .Call("is_tmat", t@.xData) 51 | } 52 | 53 | tmatmul <- function(tmat, v, transposed = FALSE) { 54 | ematmul(tmat, v, transposed = transposed) 55 | } 56 | 57 | .hankelize.one.toeplitz.ssa <- .hankelize.one.1d.ssa 58 | 59 | .get.or.create.tmat <- function(x) { 60 | .get.or.create(x, "tmat", new.tmat(F = x$F, L = x$window, 61 | circular = x$circular)) 62 | } 63 | 64 | .traj.dim.toeplitz.ssa <- .traj.dim.1d.ssa 65 | 66 | decompose.toeplitz.ssa <- function(x, 67 | neig = NULL, 68 | ..., 69 | force.continue = FALSE) { 70 | ## Check, whether continuation of decomposition is requested 71 | if (!force.continue && nsigma(x) > 0 && 72 | capable(x, "decompose.continue")) 73 | stop(paste0("Continuation of decomposition is not yet implemented for this method: ", x$svd.method)) 74 | 75 | if (is.null(neig)) 76 | neig <- .default.neig(x, ...) 77 | 78 | if (identical(x$svd.method, "svd")) { 79 | S <- svd(toeplitz(Lcor(.F(x), x$window, circular = x$circular)), nu = neig, nv = neig) 80 | U <- S$u 81 | lambda <- NULL 82 | } else if (identical(x$svd.method, "eigen")) { 83 | S <- eigen(toeplitz(Lcor(.F(x), x$window, circular = x$circular)), symmetric = TRUE) 84 | U <- S$vectors 85 | lambda <- NULL 86 | } else if (identical(x$svd.method, "nutrlan")) { 87 | S <- trlan.eigen(.get.or.create.tmat(x), neig = neig, ..., 88 | lambda = .decomposition(x)$lambda, U = .U(x)) 89 | U <- S$u 90 | lambda <- S$d 91 | } else if (identical(x$svd.method, "propack")) { 92 | S <- propack.svd(.get.or.create.tmat(x), neig = neig, ...) 93 | U <- S$u 94 | lambda <- NULL 95 | } else if (identical(x$svd.method, "rspectra")) { 96 | if (!requireNamespace("RSpectra", quietly = TRUE)) 97 | stop("RSpectra package is requireNamespaced for SVD method `rspectra'") 98 | h <- .get.or.create.tmat(x) 99 | A <- function(x, args) ematmul(args, x) 100 | Atrans <- function(x, args) ematmul(args, x, transposed = TRUE) 101 | S <- RSpectra::svds(A, k = neig, Atrans = Atrans, dim = dim(h), args = h, ...) 102 | ## RSpectra sometimes returns unsorted results 103 | idx <- order(S$d, decreasing = TRUE) 104 | U <- S$u[, idx] 105 | lambda <- NULL 106 | } else if (identical(x$svd.method, "primme")) { 107 | if (!requireNamespace("PRIMME", quietly = TRUE)) 108 | stop("PRIMME package is requireNamespaced for SVD method `rspectra'") 109 | h <- .get.or.create.tmat(x) 110 | pA <-function(x, trans) if (identical(trans, "c")) crossprod(h, x) else h %*% x 111 | S <- PRIMME::svds(pA, NSvals = neig, m = nrow(h), n = ncol(h), isreal = TRUE, ...) 112 | U <- S$u 113 | lambda <- NULL 114 | } else if (identical(x$svd.method, "irlba")) { 115 | if (!requireNamespace("irlba", quietly = TRUE)) 116 | stop("irlba package is required for SVD method `irlba'") 117 | h <- .get.or.create.tmat(x) 118 | S <- irlba::irlba(h, nv = neig, ...) 119 | U <- S$u 120 | lambda <- NULL 121 | } else if (identical(x$svd.method, "rsvd")) { 122 | if (!requireNamespace("irlba", quietly = TRUE)) 123 | stop("irlba package is required for SVD method `rsvd'") 124 | h <- .get.or.create.tmat(x) 125 | S <- irlba::svdr(h, k = neig, ...) 126 | U <- S$u 127 | lambda <- NULL 128 | } else 129 | stop("unsupported SVD method") 130 | 131 | Z <- crossprod(.get.or.create.hmat(x), U) 132 | sigma <- apply(Z, 2, function(x) sqrt(sum(x^2))) 133 | V <- sweep(Z, 2, sigma, FUN = "/") 134 | 135 | neig <- min(neig, length(sigma)) 136 | 137 | o <- order(sigma[seq_len(neig)], decreasing = TRUE) 138 | sigma <- sigma[o] 139 | U <- U[, o, drop = FALSE] 140 | V <- V[, o, drop = FALSE] 141 | if (!is.null(lambda)) 142 | lambda <- lambda[o] 143 | 144 | .set.decomposition(x, 145 | sigma = sigma, U = U, V = V, lambda = lambda, 146 | kind = "toeplitz.decomposition") 147 | 148 | x 149 | } 150 | 151 | .rowspan.toeplitz.ssa <- function(x, idx) { 152 | qr.Q(qr(.V(x)[, idx, drop = FALSE])) 153 | } 154 | 155 | .init.fragment.toeplitz.ssa <- function(this) 156 | expression({ 157 | eval(.init.fragment.1d.ssa(this)) 158 | ## Disallow shaped 159 | if (!all(wmask) || !all(fmask)) 160 | stop("gaps are not allowed in Toeplitz SSA") 161 | }) 162 | -------------------------------------------------------------------------------- /cleanup: -------------------------------------------------------------------------------- 1 | rm -f R/init.R 2 | rm -f src/config.h 3 | rm -f src/Makevars 4 | -------------------------------------------------------------------------------- /configure.ac: -------------------------------------------------------------------------------- 1 | AC_INIT([Rssa],[1.0.4]) 2 | 3 | dnl Select an optional include path, from a configure option 4 | dnl or from an environment variable. 5 | AC_ARG_WITH([fftw-include], 6 | AS_HELP_STRING([--with-fftw-include=INCLUDE_PATH],[the location of FFTWv3 header files]), 7 | [fftw_include_path=$withval]) 8 | 9 | RSSA_CPPFLAGS="-I." 10 | if test [ -n "$fftw_include_path" ] ; then 11 | RSSA_CPPFLAGS="-I. -I${fftw_include_path}" 12 | else 13 | if test [ -n "${FFTW_INCLUDE}" ] ; then 14 | RSSA_CPPFLAGS="-I. -I${FFTW_INCLUDE}" 15 | fi 16 | fi 17 | 18 | dnl Ditto for a library path 19 | AC_ARG_WITH([fftw-lib], 20 | AS_HELP_STRING([--with-fftw-lib=LIB_PATH],[the location of FFTWv3 libraries]), 21 | [fftw_lib_path=$withval]) 22 | 23 | if test [ -n "$fftw_lib_path" ] ; then 24 | LIBS="-L$fftw_lib_path ${LIBS}" 25 | else 26 | if test [ -n "${FFTW_LIBS}" ] ; then 27 | LIBS="-L${FFTW_LIBS} ${LIBS}" 28 | fi 29 | fi 30 | 31 | dnl Now find the compiler and compiler flags to use 32 | : ${R_HOME=`R RHOME`} 33 | if test -z "${R_HOME}"; then 34 | echo "could not determine R_HOME" 35 | exit 1 36 | fi 37 | CC=`"${R_HOME}/bin/R" CMD config CC` 38 | CFLAGS=`"${R_HOME}/bin/R" CMD config CFLAGS` 39 | CPPFLAGS=`"${R_HOME}/bin/R" CMD config CPPFLAGS` 40 | LDFLAGS=`"${R_HOME}/bin/R" CMD config LDFLAGS` 41 | 42 | dnl Setup the compilers 43 | AC_PROG_CC 44 | AC_PROG_CPP 45 | 46 | CPPFLAGS="${CPPFLAGS} ${RSSA_CPPFLAGS}" 47 | 48 | dnl Check the headers can be found 49 | AC_CHECK_HEADERS(fftw3.h, 50 | AC_SUBST(HAVE_FFTW, 1), 51 | AC_SUBST(HAVE_FFTW, 0)) 52 | 53 | AC_CHECK_LIB(fftw3, fftw_execute) 54 | 55 | dnl Substitute RSSA_CPPFLAGS and LIBS 56 | AC_SUBST(RSSA_CPPFLAGS) 57 | AC_SUBST(LIBS) 58 | 59 | dnl Do substitution in src/Makevars.in, src/config.h and R/init.R 60 | AC_CONFIG_HEADERS([src/config.h]) 61 | AC_CONFIG_FILES([src/Makevars R/init.R]) 62 | AC_OUTPUT 63 | -------------------------------------------------------------------------------- /configure.win: -------------------------------------------------------------------------------- 1 | cp -r src/config.h.win src/config.h 2 | sed -e "s#@RSSA_CPPFLAGS@##g" -e "s#@LIBS@#-lfftw3#g" src/Makevars.in > src/Makevars.win 3 | sed -e "s#@HAVE_FFTW@#1#g" R/init.R.in > R/init.R -------------------------------------------------------------------------------- /data/AustralianWine.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/asl/rssa/bab3ba18ba8dce3ec3c4cb2fa324b17930f50e99/data/AustralianWine.rda -------------------------------------------------------------------------------- /data/Barbara.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/asl/rssa/bab3ba18ba8dce3ec3c4cb2fa324b17930f50e99/data/Barbara.rda -------------------------------------------------------------------------------- /data/Mars.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/asl/rssa/bab3ba18ba8dce3ec3c4cb2fa324b17930f50e99/data/Mars.rda -------------------------------------------------------------------------------- /data/MotorVehicle.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/asl/rssa/bab3ba18ba8dce3ec3c4cb2fa324b17930f50e99/data/MotorVehicle.rda -------------------------------------------------------------------------------- /data/USUnemployment.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/asl/rssa/bab3ba18ba8dce3ec3c4cb2fa324b17930f50e99/data/USUnemployment.rda -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite the 'Rssa' package in publications use:") 2 | 3 | year <- sub(".*(2[[:digit:]]{3})-.*", "\\1", meta$Date) 4 | vers <- paste("R package version", meta$Version) 5 | 6 | bibentry(bibtype = "Book", 7 | title = "Singular spectrum analysis with {R}", 8 | author = c(person(given = "Nina", 9 | family = "Golyandina"), 10 | person(given = "Anton", 11 | family = "Korobeynikov"), 12 | person(given = "Anatoly", 13 | family = "Zhigljavsky")), 14 | year = "2018", 15 | publisher = "Springer-Verlag Berlin Heidelberg", 16 | series = "Use R!", 17 | textVersion = 18 | paste("Nina Golyandina, Anton Korobeynikov, Anatoly Zhigljavsky (2018).", 19 | "Singular spectrum analysis with R. Series Use R!", 20 | "Springer-Verlag Berlin Heidelberg") 21 | ) 22 | 23 | bibentry(bibtype = "Article", 24 | title = "Computation- and space-efficient implementation of SSA", 25 | author = as.person("Anton Korobeynikov"), 26 | journal = "Statistics and Its Interface", 27 | volume = 3, 28 | number = 3, 29 | year = "2010", 30 | pages = "357--368", 31 | note = vers, 32 | 33 | textVersion = 34 | paste("Anton Korobeynikov (2010)", 35 | "Computation- and space-efficient implementation of SSA.", 36 | "Statistics and Its Interface, Vol. 3, No. 3, 257-368") 37 | ) 38 | 39 | bibentry(bibtype = "Article", 40 | title = "Basic Singular Spectrum Analysis and Forecasting with R", 41 | author = c(as.person("Nina Golyandina"), as.person("Anton Korobeynikov")), 42 | journal = "Computational Statistics and Data Analysis", 43 | volume = 71, 44 | year = "2014", 45 | pages = "934--954", 46 | note = vers, 47 | 48 | textVersion = 49 | paste("Nina Golyandina and Anton Korobeynikov (2014)", 50 | "Basic Singular Spectrum Analysis and Forecasting with R.", 51 | "Computational Statistics and Data Analysis, Vol. 71, 934-954") 52 | ) 53 | 54 | bibentry(bibtype = "Article", 55 | title = "Multivariate and 2D Extensions of Singular Spectrum Analysis with the {Rssa} Package", 56 | author = c(person(given = "Nina", 57 | family = "Golyandina"), 58 | person(given = "Anton", 59 | family = "Korobeynikov"), 60 | person(given = "Alex", 61 | family = "Shlemov"), 62 | person(given = "Konstantin", 63 | family = "Usevich")), 64 | journal = "Journal of Statistical Software", 65 | year = "2015", 66 | volume = "67", 67 | number = "2", 68 | pages = "1--78", 69 | doi = "10.18637/jss.v067.i02", 70 | 71 | textVersion = 72 | paste("Nina Golyandina, Anton Korobeynikov, Alex Shlemov, Konstantin Usevich (2015).", 73 | "Multivariate and 2D Extensions of Singular Spectrum Analysis with the Rssa Package.", 74 | "Journal of Statistical Software, 67(2), 1-78.", 75 | "doi:10.18637/jss.v067.i02.") 76 | ) 77 | -------------------------------------------------------------------------------- /inst/extdata/1dssa.testdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/asl/rssa/bab3ba18ba8dce3ec3c4cb2fa324b17930f50e99/inst/extdata/1dssa.testdata.rda -------------------------------------------------------------------------------- /inst/extdata/2dssa.testdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/asl/rssa/bab3ba18ba8dce3ec3c4cb2fa324b17930f50e99/inst/extdata/2dssa.testdata.rda -------------------------------------------------------------------------------- /inst/extdata/gentest-1dssa.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Rssa) 3 | source(system.file("extdata", "common.test.methods.R", package = "Rssa")) 4 | 5 | all.svd <- c("svd", "eigen", "propack", "nutrlan", "rspectra") 6 | svd.wo.nutrlan <- c("svd", "eigen", "propack") 7 | 8 | co2.td <- make.test.data(series = co2, 9 | Ls = c(17, 234, 235, 300, 400), 10 | Ls.forecast = c(17, 100, 222, 234), 11 | groups = as.list(1:10), 12 | groups.forecast = list(1, 1:2, 3:5, 1:5, c(1, 3, 6, 10), 1:10), 13 | len = 100, 14 | kind = "1d-ssa", 15 | svd.method = "e", 16 | svd.methods = list(svd.wo.nutrlan, all.svd, all.svd, all.svd, all.svd), 17 | svd.methods.forecast = list(svd.wo.nutrlan, all.svd, all.svd, all.svd), 18 | tolerance = 2e-7, 19 | neig = 20) 20 | test.test.data(test.data = co2.td) 21 | 22 | 23 | finite.rank.r5ex1 <- function(N) { 24 | tt <- 1:N 25 | cos(2*pi*(1:N) / 7) + sin(2*pi*(1:N) / 17) * exp(tt / N * 1.5) + exp(-tt / N * 1.2) 26 | } 27 | 28 | fr50 <- finite.rank.r5ex1(50) 29 | fr1k <- finite.rank.r5ex1(1000) 30 | fr50k <- finite.rank.r5ex1(50000) 31 | 32 | fr50.td <- make.test.data(series = fr50, 33 | Ls = c(17, 25, 40), 34 | Ls.forecast = c(17, 24, 25), 35 | groups = as.list(1:5), 36 | groups.forecast = list(1, 1:2, 3:5, 1:5, 5), 37 | len = 100, 38 | kind = "1d-ssa", 39 | svd.method = "e", 40 | svd.methods = list(svd.wo.nutrlan, svd.wo.nutrlan, svd.wo.nutrlan), 41 | svd.methods.forecast = list(svd.wo.nutrlan, svd.wo.nutrlan, svd.wo.nutrlan), 42 | neig = 5) 43 | test.test.data(test.data = fr50.td) 44 | 45 | fr1k.td <- make.test.data(series = fr1k, 46 | Ls = c(17, 493, 499, 500, 670), 47 | Ls.forecast = c(17, 493, 499, 500), 48 | groups = as.list(1:5), 49 | groups.forecast = list(1, 1:2, 3:5, 1:5, 5), 50 | len = 100, 51 | kind = "1d-ssa", 52 | svd.method = "e", 53 | svd.methods = list(svd.wo.nutrlan, all.svd, all.svd, all.svd, all.svd), 54 | svd.methods.forecast = list(svd.wo.nutrlan, all.svd, all.svd, all.svd), 55 | neig = 5) 56 | test.test.data(test.data = fr1k.td) 57 | 58 | #fr50k.td <- make.test.data(series = fr50k, 59 | # Ls = c(17, 493, 23800, 25000, 40000), 60 | # Ls.forecast = c(17, 493, 23000, 23800, 25000), 61 | # groups = as.list(1:5), 62 | # groups.forecast = list(1, 1:2, 3:5, 1:5, 5), 63 | # len = 100, 64 | # kind = "1d-ssa", 65 | # svd.method = "p", 66 | # neig = 5, 67 | # tolerance = 1e-6, 68 | # svd.methods = c("p", "n")) 69 | #test.test.data(test.data = fr50k.td) 70 | 71 | set.seed(1) 72 | fr50.nz.td <- make.test.data(series = fr50 + rnorm(fr50), 73 | name = "fr50.nz", 74 | Ls = c(17, 25, 40), 75 | Ls.forecast = c(17, 24, 25), 76 | groups = as.list(1:10), 77 | groups.forecast = list(1, 1:2, 3:5, 1:5, c(1, 3, 6, 10), 1:10), 78 | len = 100, 79 | kind = "1d-ssa", 80 | svd.method = "e", 81 | svd.methods = list(svd.wo.nutrlan, svd.wo.nutrlan, svd.wo.nutrlan), 82 | svd.methods.forecast = list(svd.wo.nutrlan, svd.wo.nutrlan, svd.wo.nutrlan), 83 | neig = 15) 84 | test.test.data(test.data = fr50.nz.td) 85 | 86 | set.seed(1) 87 | fr1k.nz.td <- make.test.data(series = fr1k + rnorm(fr1k), 88 | name = "fr1k.nz", 89 | Ls = c(17, 493, 499, 500, 670), 90 | Ls.forecast = c(17, 493, 499, 500), 91 | groups = as.list(1:10), 92 | groups.forecast = list(1, 1:2, 3:5, 1:5, c(1, 3, 6, 10), 1:10), 93 | len = 100, 94 | kind = "1d-ssa", 95 | svd.method = "e", 96 | svd.methods = list(svd.wo.nutrlan, all.svd, all.svd, all.svd, all.svd), 97 | svd.methods.forecast = list(svd.wo.nutrlan, all.svd, all.svd, all.svd), 98 | neig = 15) 99 | test.test.data(test.data = fr1k.nz.td) 100 | 101 | #set.seed(1) 102 | #fr50k.nz.td <- make.test.data(series = fr50k + rnorm(fr50k), 103 | # name = "fr50k.nz", 104 | # Ls = c(17, 493, 23800, 25000, 40000), 105 | # Ls.forecast = c(17, 493, 23000, 23800, 25000), 106 | # groups = as.list(1:10), 107 | # groups.forecast = list(1, 1:2, 3:5, 1:5, c(1, 3, 6, 10), 1:10), 108 | # len = 100, 109 | # kind = "1d-ssa", 110 | # svd.method = "p", 111 | # neig = 15, 112 | # tolerance = 1e-6, 113 | # svd.methods = c("p", "n")) 114 | #test.test.data(test.data = fr50k.nz.td) 115 | 116 | #save(co2.td, fr50.td, fr1k.td, fr50k.td, fr50.nz.td, fr1k.nz.td, fr50k.nz.td, 117 | save(co2.td, fr50.td, fr1k.td, fr50.nz.td, fr1k.nz.td, 118 | # file = system.file("extdata", "1dssa.testdata.rda", package = "Rssa"), 119 | file = "1dssa.testdata.rda", 120 | compress = "xz", compression_level = 9) 121 | -------------------------------------------------------------------------------- /inst/extdata/gentest-2dssa.R: -------------------------------------------------------------------------------- 1 | library(testthat); 2 | library(Rssa); 3 | source(system.file("extdata", "common.test.methods.R", package = "Rssa")); 4 | 5 | N <- c(110, 117); 6 | L <- c(55, 53); 7 | groups <- as.list(1:10); 8 | 9 | set.seed(1); 10 | field <- matrix(rnorm(prod(N)), N[1], N[2]); 11 | 12 | ss <- ssa(field, kind = "2d-ssa", L = L, neig = 20); 13 | expected.reconstruction <- reconstruct(ss, groups = groups); 14 | 15 | save(L, groups, field, expected.reconstruction, 16 | file = system.file("extdata", "2dssa.testdata.rda", package = "Rssa"), 17 | compress = "xz", compression_level = 9); 18 | -------------------------------------------------------------------------------- /inst/extdata/gentest-mssa.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Rssa) 3 | 4 | data(AustralianWine) 5 | 6 | 7 | params <- list(same.length.mx = list(ssa.data = AustralianWine[1:176, c("Total", "Drywhite", "Fortified")], 8 | L = 84, 9 | len = 60), 10 | diff.lengths.mx = list(ssa.data = AustralianWine[, c("Total", "Drywhite", "Fortified")], 11 | L = 84, 12 | len = 60), 13 | same.length.list = list(ssa.data = list(AustralianWine[1:176, "Total"], 14 | AustralianWine[1:176, "Drywhite"], 15 | AustralianWine[1:176, "Fortified"]), 16 | L = 84, 17 | len = 60), 18 | diff.lengths.list = list(ssa.data = list(AustralianWine[1:176, "Total"], 19 | AustralianWine[1:187, "Drywhite"], 20 | AustralianWine[1:184, "Fortified"]), 21 | L = 84, 22 | len = 60), 23 | diff.lengths.list.NA = list(ssa.data = list(c(rep(NA, 1002), AustralianWine[21:176, "Total"]), 24 | c(AustralianWine[1:187, "Drywhite"], rep(NA, 101)), 25 | c(rep(NA, 503), as.vector(AustralianWine[1:184, "Fortified"]), rep(NA, 511))), 26 | L = 84, 27 | len = 60), 28 | dataframe = list(ssa.data = as.data.frame(AustralianWine[, c("Total", "Drywhite", "Fortified")]), 29 | L = 84, 30 | len = 60)) 31 | 32 | testcases <- lapply(params, function(param) { 33 | ssa.data <- param$ssa.data; L <- param$L; len <- param$len 34 | s <- ssa(ssa.data, L = L, kind = "mssa", neig = 15) 35 | rec <- reconstruct(s, 36 | groups = list(Trend = c(1, 6), 37 | Seasonality = c(2:5, 7:12))) 38 | 39 | vrfore <- vforecast(s, 40 | groups = list(1, 1:12), 41 | direction = "row", 42 | len = len, only.new = FALSE) 43 | 44 | vcfore <- vforecast(s, 45 | groups = list(1, 1:12), 46 | direction = "column", 47 | len = len, only.new = FALSE) 48 | 49 | rrofore <- rforecast(s, 50 | groups = list(1, 1:12), 51 | direction = "row", 52 | base = "original", 53 | len = len, only.new = FALSE) 54 | 55 | rrrfore <- rforecast(s, 56 | groups = list(1, 1:12), 57 | direction = "row", 58 | base = "reconstructed", 59 | len = len, only.new = FALSE) 60 | 61 | rcofore <- rforecast(s, 62 | groups = list(1, 1:12), 63 | direction = "column", 64 | base = "original", 65 | len = len, only.new = FALSE) 66 | 67 | rcrfore <- rforecast(s, 68 | groups = list(1, 1:12), 69 | direction = "column", 70 | base = "reconstructed", 71 | len = len, only.new = FALSE) 72 | 73 | list(L = L, len = len, 74 | ssa.data = ssa.data, 75 | rec = rec, 76 | vrfore = vrfore, rrofore = rrofore, rrrfore = rrrfore, 77 | vcfore = vcfore, rcofore = rcofore, rcrfore = rcrfore) 78 | }) 79 | 80 | save(testcases, 81 | # file = system.file("extdata", "mssa.testdata.rda", package = "Rssa"), 82 | file = "mssa.testdata.rda", 83 | compress = "xz", compression_level = 9) 84 | -------------------------------------------------------------------------------- /inst/extdata/gentest-pssa.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Rssa) 3 | source(system.file("extdata", "common.test.methods.R", package = "Rssa")) 4 | 5 | all.svd <- c("svd", "eigen", "propack", "nutrlan", "rspectra") 6 | svd.wo.nutrlan <- c("svd", "eigen", "propack") 7 | 8 | co2.td <- make.test.data(series = co2, 9 | Ls = c(17, 234, 235, 300, 400), 10 | Ls.forecast = c(17, 100, 222, 234), 11 | groups = as.list(1:10), 12 | groups.forecast = list(1, 1:2, 3:5, 1:5, c(1, 3, 6, 10), 1:10), 13 | len = 100, 14 | kind = "1d-ssa", 15 | svd.method = "eigen", 16 | svd.methods = list(svd.wo.nutrlan, all.svd, all.svd, all.svd, all.svd), 17 | svd.methods.forecast = list(svd.wo.nutrlan, all.svd, all.svd, all.svd), 18 | tolerance = 2e-7, 19 | column.projector = "centering", 20 | row.projector = "centering", 21 | neig = 20) 22 | test.test.data(test.data = co2.td) 23 | 24 | 25 | finite.rank.r5ex1 <- function(N) { 26 | tt <- 1:N 27 | tt + sin(2*pi*(1:N) / 17) * exp(tt / N * 1.5) + exp(-tt / N * 1.2) 28 | } 29 | 30 | fr50 <- finite.rank.r5ex1(50) 31 | fr1k <- finite.rank.r5ex1(1000) 32 | fr50k <- finite.rank.r5ex1(50000) 33 | 34 | fr50.td <- make.test.data(series = fr50, 35 | Ls = c(17, 25, 40), 36 | Ls.forecast = c(17, 24, 25), 37 | groups = as.list(1:5), 38 | groups.forecast = list(1, 1:2, 3:5, 1:5, 5), 39 | len = 100, 40 | kind = "1d-ssa", 41 | svd.method = "e", 42 | svd.methods = list(svd.wo.nutrlan, svd.wo.nutrlan, svd.wo.nutrlan), 43 | svd.methods.forecast = list(svd.wo.nutrlan, svd.wo.nutrlan, svd.wo.nutrlan), 44 | tolerance = 1e-6, 45 | column.projector = "centering", 46 | row.projector = "centering", 47 | neig = 5) 48 | test.test.data(test.data = fr50.td) 49 | 50 | fr1k.td <- make.test.data(series = fr1k, 51 | Ls = c(170, 493, 499, 500, 670), 52 | Ls.forecast = c(170, 493, 499, 500), 53 | groups = as.list(1:5), 54 | groups.forecast = list(1, 1:2, 3:5, 1:5, 5), 55 | len = 100, 56 | kind = "1d-ssa", 57 | svd.method = "e", 58 | svd.methods = list(svd.wo.nutrlan, all.svd, all.svd, all.svd, all.svd), 59 | svd.methods.forecast = list(svd.wo.nutrlan, all.svd, all.svd, all.svd), 60 | tolerance = 1e-5, 61 | column.projector = "centering", 62 | row.projector = "centering", 63 | neig = 5) 64 | test.test.data(test.data = fr1k.td) 65 | 66 | set.seed(1) 67 | fr50.nz.td <- make.test.data(series = fr50 + rnorm(fr50), 68 | name = "fr50.nz", 69 | Ls = c(17, 25, 40), 70 | Ls.forecast = c(17, 24, 25), 71 | groups = as.list(1:10), 72 | groups.forecast = list(1, 1:2, 3:5, 1:5, c(1, 3, 6, 10), 1:10), 73 | len = 100, 74 | kind = "1d-ssa", 75 | svd.method = "e", 76 | svd.methods = list(svd.wo.nutrlan, svd.wo.nutrlan, svd.wo.nutrlan), 77 | svd.methods.forecast = list(svd.wo.nutrlan, svd.wo.nutrlan, svd.wo.nutrlan), 78 | column.projector = "centering", 79 | row.projector = "centering", 80 | neig = 15) 81 | test.test.data(test.data = fr50.nz.td) 82 | 83 | set.seed(1) 84 | fr1k.nz.td <- make.test.data(series = fr1k + rnorm(fr1k), 85 | name = "fr1k.nz", 86 | Ls = c(17, 493, 499, 500, 670), 87 | Ls.forecast = c(17, 493, 499, 500), 88 | groups = as.list(1:10), 89 | groups.forecast = list(1, 1:2, 3:5, 1:5, c(1, 3, 6, 10), 1:10), 90 | len = 100, 91 | kind = "1d-ssa", 92 | svd.method = "e", 93 | svd.methods = list(svd.wo.nutrlan, all.svd, all.svd, all.svd, all.svd), 94 | svd.methods.forecast = list(svd.wo.nutrlan, all.svd, all.svd, all.svd), 95 | tolerance = 1e-6, 96 | column.projector = "centering", 97 | row.projector = "centering", 98 | neig = 15) 99 | test.test.data(test.data = fr1k.nz.td) 100 | 101 | save(co2.td, fr50.td, fr1k.td, fr50.nz.td, fr1k.nz.td, 102 | # file = system.file("extdata", "pssa.testdata.rda", package = "Rssa"), 103 | file = "pssa.testdata.rda", 104 | compress = "xz", compression_level = 9) 105 | -------------------------------------------------------------------------------- /inst/extdata/gentest-toeplitz.R: -------------------------------------------------------------------------------- 1 | library(testthat); 2 | library(Rssa); 3 | source(system.file("extdata", "common.test.methods.R", package = "Rssa")); 4 | 5 | all.svd <- c("svd", "eigen", "propack", "nutrlan", "rspectra") 6 | svd.wo.nutrlan <- c("svd", "eigen", "propack") 7 | 8 | co2.td <- make.test.data(series = co2, 9 | Ls = c(17, 234, 235, 300), 10 | Ls.forecast = c(17, 100, 222, 234), 11 | groups = as.list(1:5), 12 | groups.forecast = list(1, 1:2, 3:5, 1:5), 13 | len = 100, 14 | kind = "toeplitz-ssa", 15 | svd.method = "e", 16 | svd.methods = list(svd.wo.nutrlan, all.svd, all.svd, all.svd, all.svd), 17 | svd.methods.forecast = list(svd.wo.nutrlan, all.svd, all.svd, all.svd), 18 | tolerance = 1e-5, 19 | neig = 10); 20 | test.test.data(test.data = co2.td); 21 | 22 | finite.rank.r5ex1 <- function(N) { 23 | tt <- 1:N; 24 | cos(2*pi*(1:N) / 7) + sin(2*pi*(1:N) / 17) * exp(tt / N * 1.5) + exp(-tt / N * 1.2); 25 | } 26 | 27 | fr50 <- finite.rank.r5ex1(50); 28 | fr1k <- finite.rank.r5ex1(1000); 29 | fr50k <- finite.rank.r5ex1(50000); 30 | 31 | fr50.td <- make.test.data(series = fr50, 32 | Ls = c(17, 25, 40), 33 | Ls.forecast = c(17, 24, 25), 34 | groups = as.list(1:5), 35 | groups.forecast = list(1, 1:2, 3:5, 1:5, 5), 36 | len = 100, 37 | kind = "toeplitz-ssa", 38 | svd.method = "e", 39 | svd.methods = list(svd.wo.nutrlan, svd.wo.nutrlan, svd.wo.nutrlan), 40 | svd.methods.forecast = list(svd.wo.nutrlan, svd.wo.nutrlan, svd.wo.nutrlan), 41 | neig = 5); 42 | test.test.data(test.data = fr50.td); 43 | 44 | fr1k.td <- make.test.data(series = fr1k, 45 | Ls = c(17, 493, 499, 500, 670), 46 | Ls.forecast = c(17, 493, 499, 500), 47 | groups = as.list(1:5), 48 | groups.forecast = list(1, 1:2, 3:5, 1:5, 5), 49 | len = 100, 50 | kind = "toeplitz-ssa", 51 | svd.method = "e", 52 | svd.methods = list(svd.wo.nutrlan, all.svd, all.svd, all.svd, all.svd), 53 | svd.methods.forecast = list(svd.wo.nutrlan, all.svd, all.svd, all.svd), 54 | neig = 5); 55 | test.test.data(test.data = fr1k.td); 56 | 57 | #fr50k.td <- make.test.data(series = fr50k, 58 | # Ls = c(17, 493, 23800, 25000, 40000), 59 | # Ls.forecast = c(17, 493, 23000, 23800, 25000), 60 | # groups = as.list(1:5), 61 | # groups.forecast = list(1, 1:2, 3:5, 1:5, 5), 62 | # len = 100, 63 | # kind = "toeplitz-ssa", 64 | # svd.method = "p", 65 | # neig = 5, 66 | # tolerance = 1e-6, 67 | # svd.methods = c("p", "n")); 68 | #test.test.data(test.data = fr50k.td); 69 | 70 | set.seed(1); 71 | fr50.nz.td <- make.test.data(series = fr50 + rnorm(fr50), 72 | name = "fr50.nz", 73 | Ls = c(17, 25, 40), 74 | Ls.forecast = c(17, 24, 25), 75 | groups = as.list(1:10), 76 | groups.forecast = list(1, 1:2, 3:5, 1:5, c(1, 3, 6, 10), 1:10), 77 | len = 100, 78 | kind = "toeplitz-ssa", 79 | svd.method = "e", 80 | svd.methods = list(svd.wo.nutrlan, svd.wo.nutrlan, svd.wo.nutrlan), 81 | svd.methods.forecast = list(svd.wo.nutrlan, svd.wo.nutrlan, svd.wo.nutrlan), 82 | neig = 15); 83 | test.test.data(test.data = fr50.nz.td); 84 | 85 | set.seed(1); 86 | fr1k.nz.td <- make.test.data(series = fr1k + rnorm(fr1k), 87 | name = "fr1k.nz", 88 | Ls = c(17, 493, 499, 500, 670), 89 | Ls.forecast = c(17, 493, 499, 500), 90 | groups = as.list(1:10), 91 | groups.forecast = list(1, 1:2, 3:5, 1:5, c(1, 3, 6, 10), 1:10), 92 | len = 100, 93 | kind = "toeplitz-ssa", 94 | svd.method = "e", 95 | svd.methods = list(svd.wo.nutrlan, all.svd, all.svd, all.svd, all.svd), 96 | svd.methods.forecast = list(svd.wo.nutrlan, all.svd, all.svd, all.svd), 97 | tolerance = 1e-5, 98 | neig = 15); 99 | test.test.data(test.data = fr1k.nz.td); 100 | 101 | #set.seed(1); 102 | #fr50k.nz.td <- make.test.data(series = fr50k + rnorm(fr50k), 103 | # name = "fr50k.nz", 104 | # Ls = c(17, 493, 23800, 25000, 40000), 105 | # Ls.forecast = c(17, 493, 23000, 23800, 25000), 106 | # groups = as.list(1:10), 107 | # groups.forecast = list(1, 1:2, 3:5, 1:5, c(1, 3, 6, 10), 1:10), 108 | # len = 100, 109 | # kind = "toeplitz-ssa", 110 | # svd.method = "p", 111 | # neig = 15, 112 | # tolerance = 1e-6, 113 | # svd.methods = c("p", "n")); 114 | #test.test.data(test.data = fr50k.nz.td); 115 | 116 | #save(co2.td, fr50.td, fr1k.td, fr50k.td, fr50.nz.td, fr1k.nz.td, fr50k.nz.td, 117 | save(co2.td, fr50.td, fr1k.td, fr50.nz.td, fr1k.nz.td, 118 | # file = system.file("extdata", "toeplitz.testdata.rda", package = "Rssa"), 119 | file = "toeplitz.testdata.rda", 120 | compress = "xz", compression_level = 9); 121 | -------------------------------------------------------------------------------- /inst/extdata/gentest-wcor.2d.ssa.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Rssa) 3 | source(system.file("extdata", "common.test.methods.R", package = "Rssa")) 4 | 5 | 6 | set.seed(1) 7 | mx <- outer(1:50, 1:50, 8 | function(i, j) sin(2*pi * i/17) * cos(2*pi * j/7) + exp(i/25 - j/20)) + 9 | rnorm(50^2, sd = 0.1) 10 | # Decompose 'mx' with default parameters 11 | s <- ssa(mx, kind = "2d-ssa", svd.method = "nutrlan") 12 | w <- wcor(s, groups = 1:12) 13 | 14 | save(w, 15 | file = system.file("extdata", "wcor.2dssa.testdata.rda", package = "Rssa"), 16 | compress = "xz", compression_level = 9); 17 | -------------------------------------------------------------------------------- /inst/extdata/mssa.testdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/asl/rssa/bab3ba18ba8dce3ec3c4cb2fa324b17930f50e99/inst/extdata/mssa.testdata.rda -------------------------------------------------------------------------------- /inst/extdata/pssa.testdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/asl/rssa/bab3ba18ba8dce3ec3c4cb2fa324b17930f50e99/inst/extdata/pssa.testdata.rda -------------------------------------------------------------------------------- /inst/extdata/toeplitz.testdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/asl/rssa/bab3ba18ba8dce3ec3c4cb2fa324b17930f50e99/inst/extdata/toeplitz.testdata.rda -------------------------------------------------------------------------------- /inst/extdata/wcor.2dssa.testdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/asl/rssa/bab3ba18ba8dce3ec3c4cb2fa324b17930f50e99/inst/extdata/wcor.2dssa.testdata.rda -------------------------------------------------------------------------------- /man/AustralianWine.Rd: -------------------------------------------------------------------------------- 1 | \name{AustralianWine} 2 | \alias{AustralianWine} 3 | \docType{data} 4 | \title{Australian Wine Sales} 5 | \description{ 6 | Monthly Australian wine sales in thousands of litres from Jan 1980 till Jul 1995. 7 | By wine makers in bottles of less than or equal to 1 litre. 8 | } 9 | \usage{data(AustralianWine)} 10 | \format{A multivariate time series with 187 observations on 7 11 | variables. The object is of class 'mts'.} 12 | \source{ 13 | Hyndman, R.J. Time Series Data Library, http://data.is/TSDLdemo. 14 | } 15 | \keyword{datasets} 16 | -------------------------------------------------------------------------------- /man/Barbara.rd: -------------------------------------------------------------------------------- 1 | \name{Barbara} 2 | \alias{Barbara} 3 | \docType{data} 4 | 5 | \title{Classical `Barbara' image (color, wide)} 6 | 7 | \description{ 8 | Classical `Barbara' image (wide version). 9 | 720 x 576 x 3 (color, RGB model), from 0 to 255. 10 | } 11 | \usage{data(Barbara)} 12 | 13 | \format{An integer array of dimension 3.} 14 | 15 | \source{ 16 | \url{http://www.hlevkin.com/hlevkin/06testimages.htm} 17 | } 18 | 19 | \keyword{datasets} 20 | -------------------------------------------------------------------------------- /man/Mars.Rd: -------------------------------------------------------------------------------- 1 | \name{Mars} 2 | \alias{Mars} 3 | \docType{data} 4 | 5 | \title{Webcam image of Mars} 6 | 7 | \description{ 8 | Image of Mars obtained by a webcam. 9 | 258 x 275, grayscale, from 0 to 255. 10 | } 11 | \usage{data(Mars)} 12 | \format{A double matrix with integer values.} 13 | 14 | \source{ 15 | Thierry, P. Tutorial for IRIS 5.59 (an astronomical images processing software), 16 | \url{http://www.astrosurf.com/buil/iris/tutorial8/doc23_us.htm}. 17 | Last updated: 20.12.2005 18 | } 19 | \keyword{datasets} 20 | -------------------------------------------------------------------------------- /man/MotorVehicle.Rd: -------------------------------------------------------------------------------- 1 | \name{MotorVehicle} 2 | \alias{MotorVehicle} 3 | \docType{data} 4 | \title{Total U.S. Domestic and Foreign Car Sales} 5 | \description{ 6 | Monthly series containing total domestic and foreign car sales in the 7 | USA in thousands, from 1967 till 2010. 8 | } 9 | \usage{data(MotorVehicle)} 10 | \format{A time series of length 541.} 11 | \source{ 12 | U.S. Bureau of Economic Analysis. Table 7.2.5S. Auto and Truck Unit Sales Production Inventories 13 | Expenditures and {P}rice, 2010. 14 | } 15 | \keyword{datasets} 16 | -------------------------------------------------------------------------------- /man/Rssa-package.Rd: -------------------------------------------------------------------------------- 1 | \name{Rssa-package} 2 | \alias{Rssa-package} 3 | \alias{Rssa} 4 | \docType{package} 5 | \title{A collection of methods for singular spectrum analysis} 6 | \description{ 7 | Singular Spectrum Analysis (SSA, in short) is a modern non-parametric 8 | method for the analysis of time series and digital images. This 9 | package provides a set of fast and reliable implementations of various 10 | routines to perform decomposition, reconstruction and forecasting. 11 | A comprehensive description of the methods and functions from Rssa 12 | can be found in Golyandina et al (2018). The companion web-site is 13 | https://ssa-with-r-book.github.io/. 14 | } 15 | 16 | \details{ 17 | Typically the use of the package starts with the \emph{decomposition} 18 | of the time series using \code{\link{ssa}}. After this a suitable 19 | \emph{grouping} of the elementary time series is required. This can be 20 | done heuristically, for example, via looking at the plots of the 21 | decomposition (\code{\link[Rssa:plot.ssa]{plot}}). Alternatively, one 22 | can examine the so-called w-correlation matrix 23 | (\code{\link{wcor}}). Automatic grouping can be performed by means of 24 | \code{\link{grouping.auto}}. 25 | In addition, Oblique SSA 26 | methods can be used to improve the series separability 27 | (\code{\link[Rssa:iossa]{iossa}}, \code{\link[Rssa:fossa]{fossa}}). 28 | 29 | Next step includes the \emph{reconstruction} of 30 | the time-series using the selected grouping 31 | (\code{\link[Rssa:reconstruct.ssa]{reconstruct}}). One ends with 32 | frequency estimation (\code{\link[Rssa:parestimate]{parestimate}}), 33 | series forecasting (\code{\link[Rssa:forecast.ssa]{forecast}}, 34 | \code{\link[Rssa:rforecast.ssa]{rforecast}}, 35 | \code{\link[Rssa:vforecast.ssa]{vforecast}}) 36 | and (if any) gap filling (\code{\link[Rssa:gapfill]{gapfill}}, 37 | \code{\link[Rssa:igapfill]{igapfill}}). 38 | } 39 | 40 | \references{ 41 | Golyandina N., Korobeynikov A., Zhigljavsky A. (2018): 42 | \emph{Singular Spectrum Analysis with R.} Use R!. 43 | Springer, Berlin, Heidelberg. 44 | 45 | Golyandina, N., Nekrutkin, V. and Zhigljavsky, A. (2001): 46 | \emph{Analysis of Time Series Structure: SSA and related techniques.} 47 | Chapman and Hall/CRC. ISBN 1584881941f 48 | 49 | Golyandina, N. and Stepanov, D. (2005): \emph{SSA-based approaches to 50 | analysis and forecast of multidimensional time series}. In 51 | Proceedings of the 5th St.Petersburg Workshop on Simulation, June 52 | 26-July 2, 2005, St. Petersburg State University, St. Petersburg, 53 | 293--298. \url{https://www.gistatgroup.com/gus/mssa2.pdf} 54 | 55 | Golyandina, N. and Usevich, K. (2009): \emph{2D-extensions of singular 56 | spectrum analysis: algorithm and elements of theory.} In Matrix 57 | Methods: Theory, Algorithms, Applications. World Scientific 58 | Publishing, 450-474. 59 | 60 | Korobeynikov, A. (2010): \emph{Computation- and space-efficient 61 | implementation of SSA.} Statistics and Its Interface, Vol. 3, No. 3, 62 | Pp. 257-268 63 | 64 | Golyandina, N., Korobeynikov, A. (2012, 2014): \emph{Basic Singular Spectrum 65 | Analysis and Forecasting with R.} Computational Statistics and Data 66 | Analysis, Vol. 71, Pp. 934-954. \url{https://arxiv.org/abs/1206.6910} 67 | 68 | Golyandina, N., Zhigljavsky, A. (2013): \emph{Singular Spectrum 69 | Analysis for time series}. Springer Briefs in Statistics. Springer. 70 | 71 | Shlemov, A. and Golyandina, N. (2014): \emph{Shaped extensions of singular 72 | spectrum analysis}. 21st International Symposium on Mathematical 73 | Theory of Networks and Systems, July 7-11, 2014. Groningen, 74 | The Netherlands. p.1813-1820. \url{https://arxiv.org/abs/1507.05286} 75 | 76 | Golyandina, N., Korobeynikov, A., Shlemov, A. and Usevich, K. (2015): 77 | \emph{Multivariate and 2D Extensions of Singular Spectrum Analysis 78 | with the Rssa Package}. Journal of Statistical Software, Vol. 67, Issue 2. 79 | \doi{10.18637/jss.v067.i02} 80 | } 81 | \keyword{package} 82 | \seealso{ 83 | \code{\link[Rssa:ssa-input]{ssa-input}}, 84 | \code{\link{ssa}}, \code{\link[Rssa:decompose.ssa]{decompose}}, 85 | \code{\link[Rssa:reconstruct.ssa]{reconstruct}}, 86 | \code{\link{wcor}}, \code{\link[Rssa:plot.ssa]{plot}}, 87 | \code{\link[Rssa:parestimate]{parestimate}}, 88 | \code{\link[Rssa:rforecast.ssa]{rforecast}}, 89 | \code{\link[Rssa:vforecast.ssa]{vforecast}}, 90 | \code{\link[Rssa:forecast.ssa]{forecast}}, 91 | \code{\link[Rssa:iossa]{iossa}}, 92 | \code{\link[Rssa:fossa]{fossa}} 93 | } 94 | \examples{ 95 | s <- ssa(co2) # Perform the decomposition using the default window length 96 | summary(s) # Show various information about the decomposition 97 | plot(s) # Show the plot of the eigenvalues 98 | r <- reconstruct(s, groups = list(Trend = c(1, 4), 99 | Seasonality = c(2:3, 5:6))) # Reconstruct into 2 series 100 | plot(r, add.original = TRUE) # Plot the reconstruction 101 | 102 | # Simultaneous trend extraction using MSSA 103 | \donttest{ 104 | s <- ssa(EuStockMarkets, kind = "mssa") 105 | r <- reconstruct(s, groups = list(Trend = c(1,2))) 106 | plot(r, plot.method = "xyplot", add.residuals = FALSE, 107 | superpose = TRUE, auto.key = list(columns = 2)) 108 | # Trend forecast 109 | f <- rforecast(s, groups = list(Trend = c(1, 2)), 110 | len = 50, only.new = FALSE) 111 | library(lattice) 112 | xyplot(ts.union(Original = EuStockMarkets, "Recurrent Forecast" = f), 113 | superpose = TRUE, auto.key = list(columns = 2)) 114 | } 115 | } 116 | -------------------------------------------------------------------------------- /man/USUnemployment.Rd: -------------------------------------------------------------------------------- 1 | \name{USUnemployment} 2 | \alias{USUnemployment} 3 | \docType{data} 4 | \title{U.S. unemployment figures} 5 | \description{ 6 | Monthly U.S. male (16-19 years and from 20 years) and female (16-19 years and from 20 years) 7 | unemployment figures in thousands from 1948 till 1981. 8 | } 9 | \usage{data(USUnemployment)} 10 | \format{A multivariate time series with 408 observations on 4 11 | variables. The object is of class 'mts'.} 12 | \source{ 13 | Andrews D. F. and Herzberg H. M. (1985): 14 | \emph{Data: A Collection of Problems from Many Fields for the Student and Research Worker}, 15 | Springer Series in Statistics. 16 | } 17 | \keyword{datasets} 18 | 19 | -------------------------------------------------------------------------------- /man/autossa.Rd: -------------------------------------------------------------------------------- 1 | \name{grouping.auto.pgram} 2 | \alias{grouping.auto.pgram} 3 | \alias{grouping.auto.pgram.ssa} 4 | \alias{grouping.auto.pgram.toeplitz.ssa} 5 | \alias{grouping.auto.pgram.1d.ssa} 6 | \alias{plot.grouping.auto.pgram} 7 | 8 | \title{ 9 | Group elementary series using periodogram 10 | } 11 | 12 | \description{ 13 | Group elementary components automatically using their frequency contributions 14 | } 15 | 16 | \usage{ 17 | \method{grouping.auto.pgram}{1d.ssa}(x, groups, 18 | base = c("series", "eigen", "factor"), 19 | freq.bins = 2, 20 | threshold = 0, 21 | method = c("constant", "linear"), 22 | \dots, 23 | drop = TRUE) 24 | \method{plot}{grouping.auto.pgram}(x, superpose, order, ...) 25 | } 26 | 27 | \arguments{ 28 | \item{x}{SSA object} 29 | \item{groups}{indices of elementary components for grouping} 30 | \item{base}{input for periodogram: elementary reconstructed series, eigenvectors or factor vectors} 31 | \item{freq.bins}{single integer number > 1 (the number of intervals), 32 | vector of frequency breaks (of length >=2) or list of frequency ranges. 33 | For each range, if only one element provided it will 34 | be used as the upper bound and the lower bound will be zero} 35 | \item{threshold}{contribution threshold. If zero then dependent grouping approach will be used} 36 | \item{method}{method of periodogram interpolation} 37 | \item{superpose}{logical, whether to plot contributions for all intervals on one panel} 38 | \item{order}{logical, whether to reorder components by contribution} 39 | \item{\dots}{additional arguments passed to \code{\link{reconstruct}} and 40 | \code{\link[lattice:xyplot]{xyplot}} routines} 41 | \item{drop}{logical, whether to exclude empty groups from resulted list} 42 | } 43 | 44 | \value{ 45 | object of class 'grouping.auto.pgram' (list of groups with some additional info) for grouping method; 46 | 'trellis' object for plot method. 47 | } 48 | 49 | \details{ 50 | Elementary components are grouped using their frequency contribution (periodogram). 51 | Optionally (see argument 'base') periodogram of eigen or factor vectors may be used. 52 | 53 | For each elementary component and for each frequency interval 54 | (which are specified by 'freq.bins' argument) 55 | relative (from 0 till 1) contribution 56 | is computed using one of two methods: 57 | 'constant' (periodogram is considered as a sequence of separate bars) 58 | or 'linear' (periodogram is linearly interpolated). 59 | 60 | Two approaches of grouping is implemented: 61 | \describe{ 62 | \item{'independent' or 'threshold'}{Each group includes components 63 | with frequency contribution in correspondent interval is greater than specified threshold; 64 | resulted groups can intersect. 65 | If 'threshold' is a vector, correspondent value of threshold will be using 66 | for each interval. See Algorithm 2.16 in Golyandina et al (2018).} 67 | \item{'dependent' or 'splitting'}{Elementary components are separated to disjoint subsets; 68 | for each component interval with the highest contribution is selected. 69 | See Algorithm 2.17 in Golyandina et al (2018)} 70 | } 71 | 72 | If 'freq.bins' is named, result groups will take the same names. 73 | 74 | If drop = 'TRUE' (by default), empty groups will be excluded from result. 75 | 76 | See Section 2.7 in Golyandina et al (2018) and the paper Alexandrov, Golyandina (2005) for the details of the algorithm. 77 | } 78 | 79 | \references{ 80 | Golyandina N., Korobeynikov A., Zhigljavsky A. (2018): 81 | \emph{Singular Spectrum Analysis with R.} Use R!. 82 | Springer, Berlin, Heidelberg. 83 | 84 | Alexandrov, Th., Golyandina, N. (2005): 85 | \emph{Automatic extraction and forecast of time series cyclic components 86 | within the framework of SSA.} 87 | In Proceedings of the 5th St.Petersburg Workshop on Simulation, 88 | June 26 -- July 2, 2005, St.Petersburg State University, St.Petersburg, Pp. 45--50 89 | \url{https://www.gistatgroup.com/gus/autossa2.pdf} 90 | } 91 | 92 | \seealso{ 93 | \code{\link{Rssa}} for an overview of the package, as well as, 94 | \code{\link[Rssa:reconstruct]{reconstruct}}, 95 | \code{\link[Rssa:rforecast]{rforecast}}, 96 | \code{\link[Rssa:vforecast]{vforecast}}, 97 | \code{\link[Rssa:parestimate]{parestimate}} 98 | } 99 | 100 | \examples{ 101 | ss <- ssa(co2) 102 | plot(ss, type = "vectors", idx = 1:12) 103 | plot(ss, type = "vectors", vectors = "factor", idx = 1:12) 104 | plot(ss, type = "series", groups = 1:12) 105 | 106 | g1 <- grouping.auto(ss, base = "series", freq.bins = list(0.005), threshold = 0.95) 107 | g2 <- grouping.auto(ss, base = "eigen", freq.bins = 2, threshold = 0) 108 | g3 <- grouping.auto(ss, base = "factor", freq.bins = list(c(0.1), c(0.1, 0.2)), 109 | threshold = 0, method = "linear") 110 | g4 <- grouping.auto(ss, freq.bins = c(0.1, 0.2), threshold = 0) 111 | 112 | g <- grouping.auto(ss, freq.bins = 8, threshold = 0) 113 | plot(reconstruct(ss, groups = g)) 114 | plot(g) 115 | 116 | g <- grouping.auto(ss, freq.bins = list(0.1, 0.2, 0.3, 0.4, 0.5), threshold = 0.95) 117 | plot(reconstruct(ss, groups = g)) 118 | plot(g) 119 | } 120 | -------------------------------------------------------------------------------- /man/bforecast.Rd: -------------------------------------------------------------------------------- 1 | \name{bforecast} 2 | \alias{bforecast} 3 | \alias{bforecast.default} 4 | \alias{bforecast.ssa} 5 | \alias{bforecast.1d.ssa} 6 | \alias{bforecast.toeplitz.ssa} 7 | \title{Perform bootstrap SSA forecasting of the series} 8 | 9 | \description{ 10 | Perform bootstrap SSA forecasting of the one-dimensional series. 11 | } 12 | 13 | \usage{ 14 | \method{bforecast}{1d.ssa}(x, groups, len = 1, R = 100, level = 0.95, 15 | type = c("recurrent", "vector"), 16 | interval = c("confidence", "prediction"), 17 | only.new = TRUE, 18 | only.intervals = FALSE, \dots, 19 | drop = TRUE, drop.attributes = FALSE, cache = TRUE) 20 | \method{bforecast}{toeplitz.ssa}(x, groups, len = 1, R = 100, level = 0.95, 21 | type = c("recurrent", "vector"), 22 | interval = c("confidence", "prediction"), 23 | only.new = TRUE, 24 | only.intervals = FALSE, \dots, 25 | drop = TRUE, drop.attributes = FALSE, cache = TRUE) 26 | } 27 | 28 | \arguments{ 29 | \item{x}{SSA object holding the decomposition} 30 | \item{groups}{list, the grouping of eigentriples to be used in the forecast} 31 | \item{len}{the desired length of the forecasted series} 32 | \item{R}{number of bootstrap replications} 33 | \item{level}{vector of confidence levels for bounds} 34 | \item{type}{the type of forecast method to be used during 35 | bootstrapping} 36 | \item{interval}{type of interval calculation} 37 | \item{only.new}{logical, if 'FALSE' then confidence bounds for the 38 | signal as well as prediction are reported} 39 | \item{only.intervals}{logical, if 'TRUE' then bootstrap method is used 40 | for confidence bounds only, otherwise --- mean bootstrap forecast is 41 | returned as well} 42 | \item{\dots}{additional arguments passed to forecasting routines} 43 | \item{drop}{logical, if 'TRUE' then the result is coerced to series 44 | itself, when possible (length of 'groups' is one)} 45 | \item{drop.attributes}{logical, if 'TRUE' then the attributes of the input series 46 | are not copied to the reconstructed ones} 47 | \item{cache}{logical, if 'TRUE' then intermediate results will be 48 | cached in the SSA object} 49 | } 50 | 51 | \details{ 52 | The routine uses the reconstruction residuals in order to calculate 53 | their empirical distribution (the residuals are assumed to be 54 | stationary). Empirical distribution of the residuals is used to 55 | perform bootstrap series simulation. Such bootsrapped series are then 56 | extended via selected forecast method. Finally, the distribution of 57 | forecasted values is used to calculate bootstrap estimate of series 58 | forecast and confidence bounds. 59 | 60 | See Section 3.2.1.5 from Golyandina et al (2018) for details. 61 | } 62 | 63 | \value{ 64 | List of matricies. Each matrix has 1 + 2*length(level) columns and 65 | 'len' rows. First column contains the forecasted values, remaining 66 | columns --- low and upper bootstrap confidence bounds for average 67 | forecasted values. 68 | 69 | The matrix itself, if length of groups is one and 'drop = TRUE'. 70 | } 71 | 72 | \references{ 73 | Golyandina N., Korobeynikov A., Zhigljavsky A. (2018): 74 | \emph{Singular Spectrum Analysis with R.} Use R!. 75 | Springer, Berlin, Heidelberg. 76 | } 77 | 78 | \seealso{ 79 | \code{\link{Rssa}} for an overview of the package, as well as, 80 | \code{\link[Rssa:rforecast]{rforecast}}, 81 | \code{\link[Rssa:vforecast]{vforecast}}, 82 | \code{\link[Rssa:forecast]{forecast}}. 83 | } 84 | 85 | \examples{ 86 | # Decompose 'co2' series with default parameters 87 | s <- ssa(co2) 88 | # Produce 24 forecasted values and confidence bounds of the series using 89 | # the first 3 eigentriples as a base space for the forecast. 90 | \donttest{ 91 | f <- bforecast(s, groups = list(1:3), len = 24, R = 50) 92 | matplot(f, col = c("black", "red", "red"), type='l')} 93 | } 94 | -------------------------------------------------------------------------------- /man/cadzow.Rd: -------------------------------------------------------------------------------- 1 | \name{cadzow} 2 | \alias{cadzow} 3 | \alias{cadzow.ssa} 4 | 5 | \title{ 6 | Cadzow Iterations 7 | } 8 | \description{ 9 | Perform the finite rank approximation of the series via Cadzow iterations 10 | } 11 | 12 | \usage{ 13 | \method{cadzow}{ssa}(x, rank, correct = TRUE, tol = 1e-6, maxiter = 0, 14 | norm = function(x) max(abs(x)), 15 | trace = FALSE, \dots, cache = TRUE) 16 | } 17 | 18 | \arguments{ 19 | \item{x}{input SSA object} 20 | \item{rank}{desired rank of approximation} 21 | \item{correct}{logical, if 'TRUE' then additional correction as in 22 | Gillard et al (2013) is performed} 23 | \item{tol}{tolerance value used for convergence criteria} 24 | \item{maxiter}{number of iterations to perform, if zero then 25 | iterations are performed until the convergence} 26 | \item{norm}{distance function used for covergence criterion} 27 | \item{trace}{logical, indicates whether the convergence process should be traced} 28 | \item{\dots}{further arguments passed to \code{reconstruct}} 29 | \item{cache}{logical, if 'TRUE' then intermediate results will be 30 | cached in the SSA object.} 31 | } 32 | 33 | \details{ 34 | Cadzow iterations aim to solve the problem of the approximation of the 35 | input series by a series of finite rank. The idea of the algorithm is 36 | quite simple: alternating projections of the trajectory matrix to 37 | Hankel and low-rank matrices are performed which hopefully converge to 38 | a Hankel low-rank matrix. See Algorithm 3.10 in Golyandina et al (2018). 39 | 40 | Note that the results of one Cadzow iteration with no correction 41 | coincides with the result of reconstruction by the leading \code{rank} 42 | components. 43 | 44 | Unfortunately, being simple, the method often yields the solution which is 45 | far away from the optimum. 46 | } 47 | 48 | \references{ 49 | Golyandina N., Korobeynikov A., Zhigljavsky A. (2018): 50 | \emph{Singular Spectrum Analysis with R.} Use R!. 51 | Springer, Berlin, Heidelberg. 52 | 53 | Cadzow J. A. (1988) Signal enhancement a composite property mapping algorithm, 54 | IEEE Transactions on Acoustics, Speech, and Signal Processing, 36, 55 | 49-62. 56 | 57 | Gillard, J. and Zhigljavsky, A. (2013) Stochastic optimization 58 | algorithms for Hankel structured low-rank approximation. Unpublished 59 | Manuscript. Cardiff School of Mathematics. Cardiff. 60 | } 61 | 62 | \seealso{ 63 | \code{\link{Rssa}} for an overview of the package, as well as, 64 | \code{\link[Rssa:reconstruct]{reconstruct}} 65 | } 66 | 67 | \examples{ 68 | # Decompose co2 series with default parameters 69 | s <- ssa(co2) 70 | # Now make rank 3 approximation using the Cadzow iterations 71 | F <- cadzow(s, rank = 3, tol = 1e-10) 72 | library(lattice) 73 | xyplot(cbind(Original = co2, Cadzow = F), superpose = TRUE) 74 | # All but the first 3 eigenvalues are close to 0 75 | plot(ssa(F)) 76 | 77 | # Compare with SSA reconstruction 78 | F <- cadzow(s, rank = 3, maxiter = 1, correct = FALSE) 79 | Fr <- reconstruct(s, groups = list(1:3))$F1 80 | print(max(abs(F - Fr))) 81 | 82 | # Cadzow with and without weights 83 | set.seed(3) 84 | N <- 60 85 | L <- 30 86 | K <- N - L + 1 87 | alpha <- 0.1 88 | 89 | sigma <- 0.1 90 | signal <- cos(2*pi * seq_len(N) / 10) 91 | x <- signal + rnorm(N, sd = sigma) 92 | 93 | weights <- rep(alpha, K) 94 | weights[seq(1, K, L)] <- 1 95 | salpha <- ssa(x, L = L, 96 | column.oblique = "identity", 97 | row.oblique = weights) 98 | calpha <- cadzow(salpha, rank = 2) 99 | 100 | cz <- cadzow(ssa(x, L = L), rank = 2) 101 | 102 | print(mean((cz - signal)^2)) 103 | print(mean((calpha - signal)^2)) 104 | } 105 | -------------------------------------------------------------------------------- /man/calcv.Rd: -------------------------------------------------------------------------------- 1 | \name{calc.v} 2 | \alias{calc.v} 3 | \alias{calc.v.ssa} 4 | \alias{calc.v.cssa} 5 | 6 | \title{Calculate Factor Vector(s)} 7 | 8 | \description{ 9 | Generic function for the factor vector calculation given the SSA 10 | decomposition. 11 | } 12 | 13 | \usage{ 14 | \method{calc.v}{ssa}(x, idx, \dots) 15 | \method{calc.v}{cssa}(x, idx, \dots) 16 | } 17 | 18 | \arguments{ 19 | \item{x}{SSA object holding the decomposition.} 20 | \item{idx}{indices of the factor vectors to compute.} 21 | \item{\dots}{additional arguments to 'calc.v'.} 22 | } 23 | 24 | \details{ 25 | Factor vector is a column of the factor matrix V, which is calculated 26 | as follows: 27 | \deqn{% 28 | V = \Sigma^{-1} X^{T} U, 29 | }{% 30 | V = \Sigma^(-1) X^T U, 31 | } 32 | where X is a Hankel trajectory matrix, U is the matrix of eigenvectors 33 | and Sigma is a matrix of singular values. 34 | } 35 | 36 | \value{ 37 | A numeric vector of suitable length (usually depends on SSA method 38 | and window length). 39 | } 40 | 41 | \seealso{ 42 | \code{\link{Rssa}} for an overview of the package, as well as, 43 | \code{\link[Rssa:ssa-object]{ssa-object}}, 44 | \code{\link[Rssa:ssa]{ssa}}, 45 | \code{\link[Rssa:decompose.ssa]{decompose}}, 46 | } 47 | 48 | \examples{ 49 | # Decompose 'co2' series with default parameters 50 | s <- ssa(co2) 51 | # Calculate the 5th factor vector 52 | v <- calc.v(s, 5) 53 | } 54 | 55 | \keyword{algebra} 56 | 57 | -------------------------------------------------------------------------------- /man/cleanup.Rd: -------------------------------------------------------------------------------- 1 | \name{cleanup} 2 | \alias{cleanup} 3 | \alias{cleanup.ssa} 4 | 5 | \title{ 6 | Cleanup of all cached data from SSA objects 7 | } 8 | \description{ 9 | Function to copy SSA objects 10 | } 11 | 12 | \usage{ 13 | cleanup(x) 14 | } 15 | 16 | \arguments{ 17 | \item{x}{object to be cleaned} 18 | } 19 | 20 | \details{ 21 | For the sake of memory efficiency SSA objects hold references to the 22 | data, not the data itself. That is why they can hold huge amount of 23 | data and passing them by value is still cheap. 24 | 25 | Also, SSA routines tend to save some intermediate information which 26 | can be used later inside SSA object. This includes (but not limited 27 | to) elementary series, etc. 28 | 29 | \code{cleanup} call deletes all pre-cached stuff freeing memory necessary 30 | for calculations. 31 | } 32 | -------------------------------------------------------------------------------- /man/clone.Rd: -------------------------------------------------------------------------------- 1 | \name{clone} 2 | \alias{clone} 3 | \alias{clone.ssa} 4 | 5 | \title{ 6 | Cloning of SSA objects 7 | } 8 | \description{ 9 | Function to copy SSA objects 10 | } 11 | 12 | \usage{ 13 | \method{clone}{ssa}(x, copy.storage = TRUE, copy.cache = TRUE, \dots) 14 | } 15 | 16 | \arguments{ 17 | \item{x}{object to be cloned} 18 | \item{copy.storage}{enable/disable copying of the internal storage} 19 | \item{copy.cache}{enable/disable copying of the set of pre-cached 20 | elementary series} 21 | \item{\dots}{additional arguments to \code{clone}} 22 | } 23 | \details{ 24 | For the sake of memory efficiency SSA objects hold references to the 25 | data, not the data itself. That is why they can hold huge amount of 26 | data and passing them by value is still cheap. 27 | 28 | However, this means that one cannot safely copy the object using 29 | normal assignment operator, since freeing of references in one object 30 | would yield stale references in another. The \code{clone} method provides 31 | safe `deep copy' of SSA objects. 32 | } 33 | 34 | \examples{ 35 | # Decompose 'co2' series with default parameters 36 | s <- ssa(co2); 37 | # Perform 'normal copy' of SSA object 38 | s1 <- s; 39 | # Perform 'deep copy' of SSA object 40 | s2 <- clone(s); 41 | # Add some data to 's' 42 | reconstruct(s); 43 | # Now 's1' also contains this data, but 's2' - not 44 | summary(s1); 45 | summary(s2); 46 | } 47 | -------------------------------------------------------------------------------- /man/clplot.Rd: -------------------------------------------------------------------------------- 1 | \name{clplot} 2 | \alias{clplot} 3 | 4 | \title{ 5 | Ratio of complete lag vectors in dependence on window length 6 | } 7 | 8 | \description{ 9 | Function to plot the dependence of ratios of complete lagged vectors on window lengths. 10 | } 11 | 12 | \usage{ 13 | clplot(x, \dots) 14 | } 15 | 16 | \arguments{ 17 | \item{x}{input series} 18 | \item{\dots}{further arguments passed to plotting functions} 19 | } 20 | 21 | \details{ 22 | The function plots the dependence of ratios of complete lagged vectors on window lengths. 23 | This information can be used for the choice of window length, since only complete lagged vectors 24 | are used for construction of the SVD expansion in SSA. See page 89 (Chapter 2) in Golyandina et al (2018). 25 | } 26 | 27 | \references{ 28 | Golyandina N., Korobeynikov A., Zhigljavsky A. (2018): 29 | \emph{Singular Spectrum Analysis with R.} Use R!. 30 | Springer, Berlin, Heidelberg. 31 | } 32 | 33 | \seealso{ 34 | \code{\link{Rssa}} for an overview of the package, as well as, 35 | \code{\link[Rssa:igapfill]{igapfill}}, 36 | \code{\link[Rssa:gapfill]{gapfill}} 37 | \code{\link[Rssa:summarize.gaps]{summarize.gaps}}, 38 | } 39 | -------------------------------------------------------------------------------- /man/clusterify.Rd: -------------------------------------------------------------------------------- 1 | \name{grouping.auto.wcor} 2 | \alias{grouping.auto.wcor} 3 | \alias{grouping.auto.wcor.ssa} 4 | \title{Group Elementary Series Using W-correlation Matrix} 5 | 6 | \description{Group elemenatry series automatically via 7 | the hierarchical clustering with w-correlation matrix as a proximity 8 | matrix} 9 | 10 | \usage{ 11 | \method{grouping.auto.wcor}{ssa}(x, groups, nclust = length(groups) / 2, \dots) 12 | } 13 | 14 | \arguments{ 15 | \item{x}{SSA object} 16 | \item{groups}{list of numeric vectors, indices of elementary components 17 | used for reconstruction} 18 | \item{nclust}{integer, desired number of output series} 19 | \item{\dots}{further arguments passed to \code{hclust}} 20 | } 21 | 22 | \value{ 23 | List of integer vectors holding the indices of the elementary components 24 | forming each grouped objects 25 | } 26 | 27 | \details{ 28 | Standard \code{hclust} routine is used to perform the grouping 29 | of the elementary components. See Algorithm 2.15 in Golyandina et al (2018) for details. 30 | } 31 | 32 | \references{ 33 | Golyandina N., Korobeynikov A., Zhigljavsky A. (2018): 34 | \emph{Singular Spectrum Analysis with R.} Use R!. 35 | Springer, Berlin, Heidelberg. 36 | } 37 | 38 | \seealso{ 39 | \code{\link{hclust}}, \code{\link{wcor}} 40 | } 41 | 42 | \examples{ 43 | # Decompose 'co2' series with default parameters 44 | s <- ssa(co2) 45 | # Form 3 series from the initial 6 ones: 46 | lst <- grouping.auto(s, grouping.method = "wcor", 47 | groups = 1:6, nclust=3) 48 | # Automatic grouping: 49 | print(lst) 50 | plot(lst) 51 | # Check separability 52 | w <- wcor(s, groups = lst) 53 | plot(w) 54 | } 55 | 56 | -------------------------------------------------------------------------------- /man/decompose.Rd: -------------------------------------------------------------------------------- 1 | \name{decompose} 2 | \alias{decompose} 3 | \alias{decompose.default} 4 | \alias{decompose.ssa} 5 | \alias{decompose.cssa} 6 | \alias{decompose.toeplitz.ssa} 7 | \title{Perform SSA Decomposition} 8 | 9 | \description{ 10 | Performs the SSA decomposition. 11 | } 12 | 13 | \usage{ 14 | \method{decompose}{ssa}(x, neig = NULL, \dots, force.continue = FALSE) 15 | \method{decompose}{toeplitz.ssa}(x, neig = NULL, \dots, force.continue = FALSE) 16 | \method{decompose}{cssa}(x, neig = NULL, \dots, force.continue = FALSE) 17 | } 18 | 19 | \arguments{ 20 | \item{x}{SSA object holding the decomposition.} 21 | \item{neig}{number of desired eigentriples or 'NULL' for default value (minimum from 50 and trajectory space dimension).} 22 | \item{\dots}{additional arguments passed to SVD routines.} 23 | \item{force.continue}{logical, if TRUE then continuation of the decomposition is explicitly requested} 24 | } 25 | 26 | \details{ 27 | This is the main function which does the decomposition of the SSA 28 | trajectory matrix. Depending on the SVD method selected in the 29 | \code{\link{ssa}} different SVD implementations are called. This 30 | might be the ordinary full SVD routines or fast methods which exploit 31 | the Hankel / Toeplitz / Hankel with Hankel blocks matrix structure and 32 | allow the calculation of first few eigentriples. 33 | 34 | Some SVD methods support continuation of the decomposition: if the 35 | 'ssa' object already holds some decomposition and more eigentriples 36 | are requested, then the decomposition continues using the current 37 | values as a starting point reducing the computation time dramatically. 38 | } 39 | 40 | \note{ 41 | Usually there is no need to call this function directly. Call to 42 | \code{\link{ssa}} does the decomposition in the end. Other functions 43 | do the decomposition when necessary. 44 | } 45 | 46 | \value{ 47 | The SSA object. 48 | } 49 | 50 | \seealso{ 51 | \code{\link{Rssa}} for an overview of the package, as well as, 52 | \code{\link[svd:svd]{svd}}, \code{\link[Rssa:ssa]{ssa}}. 53 | } 54 | 55 | \examples{ 56 | # Decompose 'co2' series with default parameters and decomposition turned off. 57 | s <- ssa(co2, force.decompose = FALSE, svd.method = "nutrlan") 58 | # Perform the decomposition 59 | decompose(s, neig = 50) 60 | # Continue the decomposition 61 | decompose(s, neig = 100) 62 | } 63 | -------------------------------------------------------------------------------- /man/eossa.Rd: -------------------------------------------------------------------------------- 1 | \name{eossa} 2 | \alias{eossa} 3 | \alias{eossa.ssa} 4 | \title{ESPRIT-based O-SSA nested decomposition} 5 | 6 | \description{ 7 | Perform ESPRIT-based O-SSA (EOSSA) algorithm. 8 | } 9 | 10 | \usage{ 11 | \method{eossa}{ssa}(x, nested.groups, k = 2, 12 | subspace = c("column", "row"), 13 | dimensions = NULL, 14 | solve.method = c("ls", "tls"), 15 | beta = 8, 16 | \dots) 17 | } 18 | 19 | \arguments{ 20 | \item{x}{SSA object holding SSA decomposition} 21 | \item{nested.groups}{list or named list of numbers of eigentriples 22 | from full decomposition, describes elementary components for EOSSA nested redecomposition} 23 | \item{k}{the number of components in desired resultant decomposition} 24 | \item{subspace}{which subspace will be used for oblique matrix construction} 25 | \item{dimensions}{a vector of dimension indices to construct shift matrices along. 'NULL' means all dimensions} 26 | \item{solve.method}{approximate matrix equation solving method, 'ls' for least-squares, 'tls' for total-least-squares.} 27 | \item{beta}{In multidimensional (nD) case, coefficient(s) in convex linear combination of 28 | shifted matrices. The length of \code{beta} should be \code{ndim - 1}, 29 | where \code{ndim} is the number of independent dimensions. 30 | If only one value is passed, it is expanded to a geometric progression.} 31 | \item{\dots}{additional arguments passed to \code{\link{decompose}} 32 | routines} 33 | } 34 | 35 | \value{ 36 | Object of `ossa' class. 37 | } 38 | 39 | \details{ 40 | EOSSA is an experimental signal separation method working in Nested Oblique SSA setting. 41 | As opposed to \code{\link[Rssa:iossa]{iossa}}, 42 | this method does not require initial approximate decomposition. 43 | Moreover, it can be used for initial decomposition construction for IOSSA. 44 | 45 | EOSSA is motivated by parametric model of finite-dimensional signal, 46 | however it does not exploit this model directly and does not estimate the parameters. 47 | Therefore, it works for wider class of time series. 48 | According to the experiments, it works for series that could be locally 49 | approximated by a series of finite dimension, but at this moment there is no any theoretical results for this. 50 | 51 | EOSSA constructs shift matrix estimation by the same way is in ESPRIT 52 | (see \code{\link[Rssa:parestimate]{parestimate}}) method and 53 | uses its eigenspace to build separating scalar products 54 | (see \code{\link[Rssa:iossa]{iossa}} for more information about Oblique SSA decompositions). 55 | Consequently, the method ideally separates signals of finite dimension with absence of noise. 56 | With presence of noise it provides approximate results due to continuity. 57 | The method performs eigenvectors clustering inside (for now \code{\link[stats:hclust]{hclust}} is used), 58 | the number of components (argument \code{k}) should be passed. 59 | } 60 | 61 | \references{ 62 | Shlemov A. (2017): \emph{The method of signal separation using the eigenspaces of the shift matrices (in Russian)}, 63 | In Proceedings of the SPISOK-2017 conference, April 26--28, Saint Petersburg, Russia. 64 | } 65 | 66 | \seealso{ 67 | \code{\link{Rssa}} for an overview of the package, as well as, 68 | \code{\link[Rssa:ssa-object]{ssa-object}}, 69 | \code{\link[Rssa:parestimate]{ESPRIT}}, 70 | \code{\link[Rssa:iossa]{iossa}}, 71 | \code{\link[Rssa:fossa]{fossa}}, 72 | \code{\link[Rssa:owcor]{owcor}}, 73 | \code{\link[Rssa:iossa.result]{iossa.result}}. 74 | } 75 | 76 | \examples{ 77 | # Separability of three finite-dimensional series, EOSSA vs Basic SSA 78 | N <- 150 79 | L <- 70 80 | omega1 <- 0.065 81 | omega2 <- 0.07 82 | omega3 <- 0.02 83 | sigma <- 0.5 84 | 85 | F1.real <- 2*sin(2*pi*omega1*(1:N)) 86 | F2.real <- 4*sin(2*pi*omega2*(1:N)) 87 | F3.real <- sin(2*pi*omega3*(1:N)) 88 | 89 | noise <- rnorm(N, sd = sigma) 90 | F <- F1.real + F2.real + F3.real + noise 91 | 92 | ss <- ssa(F, L) 93 | eoss <- eossa(ss, nested.groups = list(1:2, 3:4, 5:6), k = 3) 94 | 95 | print(eoss) 96 | 97 | plot(ss, type = "series", groups = list(1:2, 3:4, 5:6)) 98 | plot(eoss, type = "series", groups = eoss$iossa.groups) 99 | 100 | plot(reconstruct(ss, 101 | groups = list(1:2, 3:4, 5:6)), 102 | add.residuals = TRUE, plot.method = "xyplot", main = "", 103 | xlab = "") 104 | 105 | plot(reconstruct(eoss, groups = list(1:2, 3:4, 5:6)), 106 | add.residuals = TRUE, plot.method = "xyplot", main = "", 107 | xlab = "") 108 | 109 | plot(reconstruct(ss, 110 | groups = list(Reconstructed = 1:6, F1 = 1:2, F2 = 3:4, F3 = 5:6)), 111 | add.residuals = TRUE, plot.method = "xyplot", main = "", 112 | xlab = "") 113 | 114 | plot(reconstruct(eoss, 115 | groups = list(Reconstructed = 1:6, F1 = 1:2, F2 = 3:4, F3 = 5:6)), 116 | add.residuals = TRUE, plot.method = "xyplot", main = "", 117 | xlab = "") 118 | 119 | rec.ideal <- reconstruct(ss, 120 | groups = list(Signal = 1:6, F1 = 1:2, F2 = 3:4, F3 = 5:6)) 121 | rec.ideal$Signal <- F1.real + F2.real + F3.real 122 | rec.ideal$F1 <- F2.real 123 | rec.ideal$F2 <- F1.real 124 | rec.ideal$F3 <- F3.real 125 | 126 | plot(rec.ideal, 127 | add.residuals = TRUE, plot.method = "xyplot", main = "", 128 | xlab = "") 129 | 130 | # Real-life example (co2), EOSSA vs Basic SSA 131 | sigma <- 0.05 132 | ss <- ssa(co2) 133 | plot(ss, type = "vector") 134 | eoss <- eossa(ss, 1:6, k = 4) 135 | eoss$iossa.groups 136 | 137 | plot(eoss) 138 | rec <- reconstruct(eoss, groups = eoss$iossa.groups) 139 | plot(rec) 140 | 141 | plot(reconstruct(ss, 142 | groups = list(ET1 = 1,ET2 = 2,ET3 = 3,ET4 = 4,ET5 = 5,ET6 = 6)), 143 | add.residuals = TRUE, plot.method = "xyplot", main = "", 144 | xlab = "") 145 | 146 | plot(reconstruct(eoss, 147 | groups = eoss$iossa.groups), 148 | add.residuals = TRUE, plot.method = "xyplot", main = "", 149 | xlab = "") 150 | 151 | # Sine wave with phase shift, EOSSA vs Basic SSA 152 | omega1 <- 0.06 153 | omega2 <- 0.07 154 | sigma <- 0.25 155 | 156 | F1.real <- sin(2*pi*omega1*(1:N)) 157 | F2.real <- sin(2*pi*omega2*(1:N)) 158 | v <- c(F1.real, F2.real) 159 | v <- v + rnorm(v, sd = sigma) 160 | # v <- c(F1.real, F2.real) 161 | 162 | ss <- ssa(v, L = 35) 163 | 164 | eoss <- eossa(ss, 1:4, 2) 165 | ioss <- iossa(ss, list(1:2, 3:4)) 166 | 167 | plot(reconstruct(eoss, groups = eoss$iossa.groups)) 168 | 169 | plot(reconstruct(eoss, 170 | groups = eoss$iossa.groups), plot.method = "xyplot", main = "", 171 | xlab = "") 172 | 173 | plot(reconstruct(ss, groups = list(1:2, 3:4)), 174 | plot.method = "xyplot", 175 | main = "", xlab = "") 176 | plot(reconstruct(ss, groups = list(1,2, 3,4)), 177 | plot.method = "xyplot", 178 | main = "", xlab = "") 179 | } 180 | -------------------------------------------------------------------------------- /man/forecast.Rd: -------------------------------------------------------------------------------- 1 | \name{forecast} 2 | \alias{forecast.ssa} 3 | \alias{forecast.1d.ssa} 4 | \alias{forecast.toeplitz.ssa} 5 | \alias{predict.ssa} 6 | \alias{predict.1d.ssa} 7 | \alias{predict.mssa} 8 | \alias{predict.toeplitz.ssa} 9 | \title{Perform SSA forecasting of series} 10 | 11 | \description{ 12 | All-in-one function to perform SSA forecasting of one-dimensional series. 13 | } 14 | 15 | \usage{ 16 | \method{forecast}{1d.ssa}(object, 17 | groups, h = 1, 18 | method = c("recurrent", "vector"), 19 | interval = c("none", "confidence", "prediction"), 20 | only.intervals = TRUE, 21 | \dots, 22 | drop = TRUE, drop.attributes = FALSE, cache = TRUE) 23 | \method{forecast}{toeplitz.ssa}(object, 24 | groups, h = 1, 25 | method = c("recurrent", "vector"), 26 | interval = c("none", "confidence", "prediction"), 27 | only.intervals = TRUE, 28 | \dots, 29 | drop = TRUE, drop.attributes = FALSE, cache = TRUE) 30 | \method{predict}{1d.ssa}(object, 31 | groups, len = 1, 32 | method = c("recurrent", "vector"), 33 | interval = c("none", "confidence", "prediction"), 34 | only.intervals = TRUE, 35 | \dots, 36 | drop = TRUE, drop.attributes = FALSE, cache = TRUE) 37 | \method{predict}{toeplitz.ssa}(object, 38 | groups, len = 1, 39 | method = c("recurrent", "vector"), 40 | interval = c("none", "confidence", "prediction"), 41 | only.intervals = TRUE, 42 | \dots, 43 | drop = TRUE, drop.attributes = FALSE, cache = TRUE) 44 | \method{predict}{mssa}(object, 45 | groups, len = 1, 46 | method = c("recurrent", "vector"), 47 | direction = c("column", "row"), 48 | \dots, 49 | drop = TRUE, drop.attributes = FALSE, cache = TRUE) 50 | } 51 | 52 | \arguments{ 53 | \item{object}{SSA object holding the decomposition} 54 | \item{groups}{list, the grouping of eigentriples to be used in the forecast} 55 | \item{h,len}{the desired length of the forecasted series} 56 | \item{method}{method of forecasting to be used} 57 | \item{interval}{type of interval calculation} 58 | \item{only.intervals}{logical, if 'TRUE' then bootstrap method is used 59 | for confidence bounds only, otherwise --- mean bootstrap forecast is 60 | returned as well} 61 | \item{direction}{direction of forecast in multichannel SSA case, "column" 62 | stands for so-called L-forecast and "row" stands for K-forecast} 63 | \item{\dots}{further arguments passed for forecast routines 64 | (e.g. \code{level} argument to \code{bforecast})} 65 | \item{drop}{logical, if 'TRUE' then the result is coerced to series 66 | itself, when possible (length of 'groups' is one)} 67 | \item{drop.attributes}{logical, if 'TRUE' then the forecast routines do not try 68 | to infer the time index arguments for the forecasted series.} 69 | \item{cache}{logical, if 'TRUE' then intermediate results will be 70 | cached in the SSA object.} 71 | } 72 | 73 | \details{ 74 | This function is a convenient wrapper over other forecast routines (see 75 | 'See Also') turning their value into object of type 'forecast' which 76 | can be used with the routines from \pkg{forecast} package. 77 | } 78 | 79 | \value{ 80 | object of class 'forecast' for \code{forecast} function call, 81 | predicted series for \code{predict} call. 82 | } 83 | 84 | \seealso{ 85 | \code{\link{Rssa}} for an overview of the package, as well as, 86 | \code{\link[Rssa:rforecast]{rforecast}}, 87 | \code{\link[Rssa:vforecast]{vforecast}}, 88 | \code{\link[Rssa:bforecast]{bforecast}}, 89 | \code{\link[forecast:forecast]{forecast (package)}} 90 | } 91 | 92 | \examples{ 93 | s <- ssa(co2) 94 | # Calculate 24-point forecast using first 6 components as a base 95 | f <- forecast(s, groups = list(1:6), method = "recurrent", bootstrap = TRUE, len = 24, R = 10) 96 | \donttest{ 97 | # Plot the result including the last 24 points of the series 98 | plot(f, include = 24, shadecols = "green", type = "l") 99 | # Use of predict() for prediction 100 | p <- predict(s, groups = list(1:6), method = "recurrent", len = 24) 101 | # Simple plotting 102 | plot(p, ylab = "Forecasteed Values") 103 | } 104 | } 105 | -------------------------------------------------------------------------------- /man/frobenius.cor.Rd: -------------------------------------------------------------------------------- 1 | \name{frobenius.cor} 2 | \alias{frobenius.cor} 3 | 4 | \title{Calculate Frobenius correlations of the component matrices} 5 | 6 | \description{Function calculates Frobenius correlations between grouped matrices 7 | from the SSA matrix decomposition} 8 | 9 | \usage{ 10 | frobenius.cor(x, groups, ...) 11 | } 12 | 13 | \arguments{ 14 | \item{x}{input SSA object, supposed to be of class `ossa'} 15 | \item{groups}{list of numeric vectors, indices of elementary matrix components 16 | in the SSA matrix decomposition} 17 | \item{\dots}{further arguments passed to \code{decompose}} 18 | } 19 | 20 | \details{ 21 | Function computes matrix of Frobenius correlations between grouped matrices from the SSA matrix decomposition. 22 | For group \eqn{\mathcal{I} = \{i_1, \dots, i_s\}}{I = {i_1, \dots, i_s}} the group matrix is defined as 23 | \eqn{\mathbf{X}_\mathcal{I} = \sum_{i \in \mathcal{I}} \sigma_i U_i V_i^\mathrm{T}}{X_i = sum_{i in I} (sigma_i U_i (V_i)^T)}. 24 | 25 | Frobenius correlation of two matrices is defined as follows: 26 | \deqn{% 27 | \mathrm{fcor}(\mathbf{Z}, \mathbf{Y}) = 28 | \frac{\langle \mathbf{Z}, \mathbf{Y} \rangle_\mathrm{F}} 29 | {\|\mathbf{Z}\|_\mathrm{F} \cdot \|\mathbf{Y}\|_\mathrm{F}}. 30 | }{% 31 | fcor (Z, Y) = _F / (||Z||_F ||Y||_F)). 32 | } 33 | 34 | Frobenius correlation is a measure of Frobenius orthogonality of the components. 35 | If grouped matrices are correlated then the w-correlations of the corresponding reconstructed series is not 36 | relevant measure of separability (and one should use \code{\link[Rssa:owcor]{owcor}} instead). 37 | Also, if the elementary matrices \eqn{\mathbf{X}_i = \sigma_i U_i V_i^\mathrm{T}}{X_i = sigma_i U_i (V_i)^T} 38 | of the decomposition are not F-orthogonal, 39 | then \eqn{\sigma_i} do not reflect their true contributions into the matrix decomposition. 40 | 41 | This function normally should be used only for object of class `ossa'. 42 | Otherwise it always returns identical matrix (for disjoint groups). 43 | } 44 | 45 | \value{ 46 | Object of type 'wcor.matrix'. 47 | } 48 | 49 | \seealso{ 50 | \code{\link[Rssa:wcor]{wcor}}, 51 | \code{\link[Rssa:owcor]{owcor}}, 52 | \code{\link[Rssa:iossa]{iossa}}. 53 | } 54 | 55 | \examples{ 56 | # Separation of two mixed sine-waves with equal amplitudes 57 | N <- 150 58 | L <- 70 59 | omega1 <- 1/5 60 | omega2 <- 1/10 61 | 62 | v <- sin(2*pi*omega1 * (1:N)) + sin(2*pi*omega2 * (1:N)) 63 | s <- ssa(v, L) 64 | fs <- fossa(s, nested.groups = 1:4, gamma = 100) 65 | 66 | # Decomposition is F-orthogonal 67 | plot(frobenius.cor(fs, groups = 1:4), main = "F-correlation matrix") 68 | 69 | plot(wcor(s, groups = 1:4)) 70 | plot(wcor(fs, groups = 1:4)) 71 | 72 | 73 | # Separate two non-separable sine series with different amplitudes 74 | \donttest{ 75 | N <- 150 76 | L <- 70 77 | 78 | omega1 <- 0.07 79 | omega2 <- 0.0675 80 | 81 | F <- 2*sin(2*pi*omega1 * (1:N)) + 2*sin(2*pi*omega2 * (1:N)) 82 | s <- ssa(F, L) 83 | ios <- iossa(s, nested.groups = list(1:2, 3:4), 84 | kappa = NULL, maxiter = 1000, tol = 1e-5) 85 | 86 | plot(reconstruct(ios, groups = ios$iossa.groups)) 87 | summary(ios) 88 | 89 | # Decomposition is really oblique 90 | plot(frobenius.cor(ios, groups = 1:4), main = "F-correlation matrix") 91 | 92 | plot(wcor(ios, groups = 1:4)) 93 | plot(owcor(ios, groups = list(1:2, 3:4)), main = "Oblique W-correlation matrix") 94 | } 95 | 96 | 97 | \donttest{ 98 | data(USUnemployment) 99 | unempl.male <- USUnemployment[, "MALE"] 100 | 101 | s <- ssa(unempl.male) 102 | ios <- iossa(s, nested.groups = list(c(1:4, 7:11), c(5:6, 12:13))) 103 | summary(ios) 104 | 105 | # W-cor matrix before IOSSA and w-cor matrix after it 106 | plot(wcor(s, groups = 1:30)) 107 | plot(wcor(ios, groups = 1:30)) 108 | 109 | # Confirmation of the indicated max value in the above warning 110 | plot(frobenius.cor(ios, groups = 1:30), main = "F-correlation matrix") 111 | } 112 | } 113 | 114 | -------------------------------------------------------------------------------- /man/gapfill.Rd: -------------------------------------------------------------------------------- 1 | \name{gapfill} 2 | \alias{gapfill} 3 | \alias{gapfill.1d.ssa} 4 | \alias{gapfill.toeplitz.ssa} 5 | \alias{gapfill.mssa} 6 | \alias{gapfill.cssa} 7 | 8 | \title{Perform SSA gapfilling via forecast} 9 | 10 | \description{ 11 | Perform SSA gapfilling of the series. 12 | } 13 | 14 | \usage{ 15 | \method{gapfill}{1d.ssa}(x, groups, base = c("original", "reconstructed"), 16 | method = c("sequential", "simultaneous"), 17 | alpha = function(len) seq.int(0, 1, length.out = len), \dots, 18 | drop = TRUE, drop.attributes = FALSE, cache = TRUE) 19 | \method{gapfill}{mssa}(x, groups, base = c("original", "reconstructed"), 20 | alpha = function(len) seq.int(0, 1, length.out = len), \dots, 21 | drop = TRUE, drop.attributes = FALSE, cache = TRUE) 22 | \method{gapfill}{cssa}(x, groups, base = c("original", "reconstructed"), 23 | method = c("sequential", "simultaneous"), 24 | alpha = function(len) seq.int(0, 1, length.out = len), \dots, 25 | drop = TRUE, drop.attributes = FALSE, cache = TRUE) 26 | \method{gapfill}{toeplitz.ssa}(x, groups, base = c("original", "reconstructed"), 27 | method = c("sequential", "simultaneous"), 28 | alpha = function(len) seq.int(0, 1, length.out = len), \dots, 29 | drop = TRUE, drop.attributes = FALSE, cache = TRUE) 30 | } 31 | 32 | \arguments{ 33 | \item{x}{Shaped SSA object holding the decomposition} 34 | \item{groups}{list, the grouping of eigentriples to be used in the forecast} 35 | \item{base}{series used as a 'seed' for gapfilling: original or 36 | reconstructed according to the value of \code{groups} argument} 37 | \item{method}{method used for gapfilling, "sequential" means to 38 | filling by a recurrent forecast from complete parts; "simultaneous" 39 | tries to build a projections onto the signal subspace. See 40 | 'References' for more info.} 41 | \item{alpha}{weight used for combining forecasts from left and right 42 | when method = "sequential"; 0.5 means that the forecasts are averaged, 43 | 0 (1) means that only forecast from the left (right correspondingly) 44 | is used, arbitrary function could be specified; by default linear 45 | weights are used.} 46 | \item{\dots}{additional arguments passed to \code{\link{reconstruct}} 47 | routines} 48 | \item{drop}{logical, if 'TRUE' then the result is coerced to series 49 | itself, when possible (length of 'groups' is one)} 50 | \item{drop.attributes}{logical, if 'TRUE' then the attributes of the input series 51 | are not copied to the reconstructed ones.} 52 | \item{cache}{logical, if 'TRUE' then intermediate results will be 53 | cached in the SSA object.} 54 | } 55 | 56 | \details{ 57 | The function fills in the missed entries in the series. Both methods 58 | described in Golyandina and Osipov (2007) are implemented: 59 | \itemize{ 60 | \item method = "sequential" performs forecast from complete chunks 61 | onto incomplete. For internal gaps forecast is performed from both 62 | sides of the gap and average is taken in order to reduce the 63 | forecast error. For gaps in the beginning or end of the series the 64 | method coincides with ordinary recurrent forecast; 65 | \item method = "simultaneous" performs gap filling via projections 66 | onto signal subspace. The method may fail if insufficient complete 67 | observations are provided. 68 | } 69 | Details of the used algorithms see in Golyandina et al (2018), 70 | Algorithms 3.8 and 3.9 respectively. 71 | } 72 | 73 | \value{ 74 | List of objects with gaps filled in. Elements of the list have the 75 | same names as elements of \code{groups}. If group is unnamed, 76 | corresponding component gets name `Fn', where `n' is its index in 77 | \code{groups} list. 78 | 79 | Or, the forecasted object itself, if length of groups is one and 'drop = TRUE'. 80 | } 81 | 82 | \references{ 83 | Golyandina N., Korobeynikov A., Zhigljavsky A. (2018): 84 | \emph{Singular Spectrum Analysis with R.} Use R!. 85 | Springer, Berlin, Heidelberg. 86 | 87 | N. Golyandina, E. Osipov (2007): \emph{The "Caterpillar"-SSA method 88 | for analysis of time series with missing values}. Journal of 89 | Statistical Planning and Inference, Vol. 137, No. 8, Pp 2642--2653 90 | \url{https://www.gistatgroup.com/cat/mvssa1en.pdf} 91 | } 92 | 93 | \seealso{ 94 | \code{\link{Rssa}} for an overview of the package, as well as, 95 | \code{\link[Rssa:rforecast]{rforecast}}, 96 | \code{\link[Rssa:igapfill]{igapfill}}, 97 | \code{\link[Rssa:clplot]{clplot}}, 98 | \code{\link[Rssa:summarize.gaps]{summarize.gaps}}, 99 | } 100 | 101 | \examples{ 102 | # Produce series with gaps 103 | F <- co2; F[100:200] <- NA 104 | # Perform shaped SSA 105 | s <- ssa(F, L = 72) 106 | # Fill in gaps using the trend and 2 periodicty components 107 | g <- gapfill(s, groups = list(1:6)) 108 | # Compare the result 109 | plot(g) 110 | lines(co2, col = "red") 111 | } 112 | -------------------------------------------------------------------------------- /man/grouping.auto.Rd: -------------------------------------------------------------------------------- 1 | \name{grouping.auto} 2 | \alias{grouping.auto} 3 | \title{Group Elementary Series} 4 | 5 | \description{The `grouping.auto' function performs the Grouping Step of 6 | SSA using different approaches.} 7 | 8 | \usage{ 9 | grouping.auto(x, \dots, grouping.method = c("pgram", "wcor")) 10 | } 11 | 12 | \arguments{ 13 | \item{x}{SSA object} 14 | \item{grouping.method}{String specifying the method used to perform 15 | the grouping. Allowed methods are `"pgram"' (the default) and 16 | `"wcor"'} 17 | \item{\dots}{Further arguments to specific methods} 18 | } 19 | 20 | \value{ 21 | List of integer vectors holding the indices of the elementary components 22 | forming each grouped objects. 23 | } 24 | 25 | \details{ 26 | `grouping.auto' is a wrapper function which calls the methods 27 | `grouping.auto.pgram' and `grouping.auto.wcor'. 28 | } 29 | 30 | \seealso{ 31 | \code{\link{grouping.auto.pgram}}, \code{\link{grouping.auto.wcor}} 32 | } 33 | -------------------------------------------------------------------------------- /man/hankel.Rd: -------------------------------------------------------------------------------- 1 | \name{hmat} 2 | \alias{new.hmat} 3 | \alias{is.hmat} 4 | \alias{hcols} 5 | \alias{hrows} 6 | \alias{hankel} 7 | \alias{hmatmul} 8 | 9 | \title{Hankel matrices operations.} 10 | 11 | \description{ 12 | A set of routines to operate on Hankel matrices stored in 13 | compact FFT-based form. 14 | } 15 | 16 | \usage{ 17 | new.hmat(F, L = (N + 1)\%/\%2, circular = FALSE, wmask = NULL, 18 | fmask = NULL, weights = NULL, fft.plan = NULL) 19 | is.hmat(h) 20 | hcols(h) 21 | hrows(h) 22 | hmatmul(hmat, v, transposed = FALSE) 23 | hankel(X, L) 24 | } 25 | 26 | \arguments{ 27 | \item{F}{series to construct the trajectory matrix for.} 28 | \item{fft.plan}{internal hint argument, should be NULL in most cases} 29 | \item{wmask, fmask, weights}{special parameters for shaped SSA case (see \code{\link[Rssa:ssa]{ssa}}). 30 | \code{wmask} and \code{fmask} are logical vectors, window and factor masks respectively. 31 | \code{weights} is integer vector which denotes hankel weights for array elements. If 'NULL', 32 | parameters for simple 1D SSA case are used.} 33 | \item{circular}{logical vector of one element, describes series topology. 34 | 'TRUE' means circularity by time.} 35 | \item{L}{the window length.} 36 | \item{h, hmat}{matrix to operate on.} 37 | \item{transposed}{logical, if 'TRUE' the multiplication is performed 38 | with the transposed matrix.} 39 | \item{v}{vector to multiply with.} 40 | \item{X}{series to construct the trajectory matrix for or matrix for hankelization} 41 | } 42 | 43 | \details{ 44 | Fast Fourier Transform provides a very efficient matrix-vector 45 | multiplication routine for Hankel matrices. See the paper in 46 | 'References' for the details of the algorithm. 47 | } 48 | 49 | \references{ 50 | Korobeynikov, A. (2010) \emph{Computation- and space-efficient implementation of 51 | SSA.} Statistics and Its Interface, Vol. 3, No. 3, Pp. 257-268 52 | } 53 | 54 | \seealso{ 55 | \code{\link{Rssa}} for an overview of the package, as well as, 56 | \code{\link[Rssa:ssa]{ssa}}, 57 | \code{\link[Rssa:decompose.ssa]{decompose}}, 58 | } 59 | 60 | \examples{ 61 | # Construct the Hankel trajectory matrix for 'co2' series 62 | h <- new.hmat(co2, L = 10) 63 | # Print number of columns and rows 64 | print(hrows(h)) 65 | print(hcols(h)) 66 | } 67 | -------------------------------------------------------------------------------- /man/hbhankel.Rd: -------------------------------------------------------------------------------- 1 | \name{hbhmat} 2 | \alias{new.hbhmat} 3 | \alias{is.hbhmat} 4 | \alias{hbhcols} 5 | \alias{hbhrows} 6 | \alias{hbhankel} 7 | \alias{hbhmatmul} 8 | \title{Hankel with Hankel block matrices operations.} 9 | 10 | \description{ 11 | A set of routines to operate on Hankel with Hankel block matrices 12 | stored in compact FFT-based form. 13 | } 14 | 15 | \usage{ 16 | new.hbhmat(F, L = (N + 1) \%/\% 2, 17 | wmask = NULL, fmask = NULL, weights = NULL, 18 | circular = FALSE) 19 | is.hbhmat(h) 20 | hbhcols(h) 21 | hbhrows(h) 22 | hbhmatmul(hmat, v, transposed = FALSE) 23 | } 24 | 25 | \arguments{ 26 | \item{F}{array to construct the trajectory matrix for.} 27 | \item{L}{the window length.} 28 | \item{wmask, fmask, weights}{special parameters for shaped SSA case (see \code{\link[Rssa:ssa]{ssa}}). 29 | \code{wmask} and \code{fmask} are logical matrices, window and factor masks respectively. 30 | \code{weights} is integer matrix which denotes hankel weights for array elements. If 'NULL', 31 | parameters for simple rectangular 2D SSA case are used.} 32 | \item{circular}{logical vector of one or two elements, describes field topology. 33 | 'TRUE' means circularity by a corresponding coordinate. If vector has only one element, 34 | this element will be used twice.} 35 | \item{h, hmat}{matrix to operate on.} 36 | \item{transposed}{logical, if 'TRUE' the multiplication is performed 37 | with the transposed matrix.} 38 | \item{v}{vector to multiply with.} 39 | } 40 | 41 | \details{ 42 | Fast Fourier Transform provides a very efficient matrix-vector 43 | multiplication routine for Hankel with Hankel blocks matrices. See the 44 | paper in 'References' for the details of the algorithm. 45 | } 46 | 47 | \references{ 48 | Korobeynikov, A. (2010) \emph{Computation- and space-efficient implementation of 49 | SSA.} Statistics and Its Interface, Vol. 3, No. 3, Pp. 257-268 50 | } 51 | 52 | \author{Konstantin Usevich} 53 | -------------------------------------------------------------------------------- /man/hmatr.Rd: -------------------------------------------------------------------------------- 1 | \name{hmatr} 2 | \alias{hmatr} 3 | \alias{plot.hmatr} 4 | 5 | \title{Calculate the heterogeneity matrix.} 6 | \description{ 7 | Function calculates the heterogeneity matrix for the one-dimensional series. 8 | } 9 | \usage{hmatr(F, \dots, 10 | B = N \%/\% 4, T = N \%/\% 4, L = B \%/\% 2, 11 | neig = 10) 12 | 13 | \method{plot}{hmatr}(x, 14 | col = rev(heat.colors(256)), 15 | main = "Heterogeneity Matrix", xlab = "", ylab = "", \dots) 16 | } 17 | 18 | \arguments{ 19 | \item{F}{the series to be checked for structural changes} 20 | \item{\dots}{further arguments passed to \code{ssa} routine for 21 | \code{hmatr} call or \code{image} for \code{plot.hmatr} call} 22 | \item{B}{integer, length of base series} 23 | \item{T}{integer, length of tested series} 24 | \item{L}{integer, window length for the decomposition of the base 25 | series} 26 | \item{neig}{integer, number of eigentriples to consider for 27 | calculating projections} 28 | \item{x}{'hmatr' object} 29 | \item{col}{color palette to use} 30 | \item{main}{plot title} 31 | \item{xlab,ylab}{labels for 'x' and 'y' axis} 32 | } 33 | \details{ 34 | The \emph{heterogeneity matrix} (H-matrix) provides a 35 | consistent view on the structural discrepancy between different parts of the 36 | series. Denote by \eqn{F_{i,j}} the subseries of F of the form: \eqn{F_{i,j} = 37 | \left(f_{i},\dots,f_{j}\right)}. Fix two integers \eqn{B > L} and \eqn{T \geq L}. Let 38 | these integers denote the lengths of \emph{base} and \emph{test} subseries, 39 | respectively. Introduce the H-matrix \eqn{G_{B,T}} with the elements \eqn{g_{ij}} as 40 | follows: 41 | \deqn{ 42 | g_{ij} = g(F_{i,i+B}, F_{j,j+T}), 43 | } 44 | for \eqn{i=1,\dots,N-B+1} and \eqn{j=1,\dots,N-T+1}, that is we split the series 45 | F into subseries of lengths B and T and calculate the heterogeneity index 46 | between all possible pairs of the subseries. 47 | 48 | The heterogeneity index \eqn{g(F^{(1)}, F^{(2)})} between the series 49 | \eqn{F^{(1)}} and \eqn{F^{(2)}} can be calculated as follows: let 50 | \eqn{U_{j}^{(1)}}, \eqn{j=1,\dots,L} denote the eigenvectors of the 51 | SVD of the trajectory matrix of the series \eqn{F^{(1)}}. Fix I to be a 52 | subset of \eqn{\left\{1,\dots,L\right\}} and denote \eqn{\mathcal{L}^{(1)} = 53 | \mathrm{span}\,\left(U_{i},\, i \in I\right)}. Denote by 54 | \eqn{X^{(2)}_{1},\dots,X^{(2)}_{K_{2}}} (\eqn{K_{2} = N_{2} - L + 1}) the 55 | L-lagged vectors of the series \eqn{F^{(2)}}. Now define 56 | \deqn{ 57 | g(F^{(1)},F^{(2)}) 58 | = \frac{\sum_{j=1}^{K_{2}}{\mathrm{dist}^{2}\left(X^{(2)}_{j}, 59 | \mathcal{L}^{(1)}\right)}} 60 | {\sum_{j=1}^{K_{2}}{\left\|X^{(2)}_{j}\right\|^{2}}}, } where 61 | \eqn{\mathrm{dist}\,(X,\mathcal{L})} denotes the Euclidean distance between the 62 | vector X and the subspace \eqn{\mathcal{L}}. One can easily see that 63 | \eqn{0 \leq g \leq 1}. 64 | } 65 | 66 | \value{ 67 | object of type 'hmatr' 68 | } 69 | 70 | \references{ 71 | Golyandina, N., Nekrutkin, V. and Zhigljavsky, A. (2001): \emph{Analysis of 72 | Time Series Structure: SSA and related techniques.} Chapman and Hall/CRC. ISBN 1584881941 73 | } 74 | \seealso{ 75 | \code{\link[Rssa:ssa]{ssa}} 76 | } 77 | 78 | \examples{ 79 | # Calculate H-matrix for co2 series 80 | h <- hmatr(co2, L = 24) 81 | # Plot the matrix 82 | plot(h) 83 | } 84 | 85 | -------------------------------------------------------------------------------- /man/igapfill.Rd: -------------------------------------------------------------------------------- 1 | \name{igapfill} 2 | \alias{igapfill} 3 | \alias{igapfill.ssa} 4 | \alias{igapfill.1d.ssa} 5 | \alias{igapfill.cssa} 6 | \alias{igapfill.toeplitz.ssa} 7 | \alias{igapfill.nd.ssa} 8 | \title{Perform SSA gapfilling via iterative reconstruction} 9 | 10 | \description{ 11 | Perform iterative gapfilling of the series. 12 | } 13 | 14 | \usage{ 15 | \method{igapfill}{1d.ssa}(x, groups, fill = NULL, tol = 1e-6, maxiter = 0, 16 | norm = function(x) sqrt(max(x^2)), 17 | base = c("original", "reconstructed"), \dots, trace = FALSE, 18 | drop = TRUE, drop.attributes = FALSE, cache = TRUE) 19 | \method{igapfill}{cssa}(x, groups, fill = NULL, tol = 1e-6, maxiter = 0, 20 | norm = function(x) sqrt(max(x^2)), 21 | base = c("original", "reconstructed"), \dots, trace = FALSE, 22 | drop = TRUE, drop.attributes = FALSE, cache = TRUE) 23 | \method{igapfill}{toeplitz.ssa}(x, groups, fill = NULL, tol = 1e-6, maxiter = 0, 24 | norm = function(x) sqrt(max(x^2)), 25 | base = c("original", "reconstructed"), \dots, trace = FALSE, 26 | drop = TRUE, drop.attributes = FALSE, cache = TRUE) 27 | \method{igapfill}{nd.ssa}(x, groups, fill = NULL, tol = 1e-6, maxiter = 0, 28 | norm = function(x) sqrt(max(x^2)), 29 | base = c("original", "reconstructed"), \dots, trace = FALSE, 30 | drop = TRUE, drop.attributes = FALSE, cache = TRUE) 31 | } 32 | 33 | \arguments{ 34 | \item{x}{Shaped SSA object holding the decomposition} 35 | \item{groups}{list, the grouping of eigentriples to be used in the forecast} 36 | \item{fill}{initial values for missed entries, recycled if necessary; 37 | if missed, then average of the series will be used} 38 | \item{tol}{tolerance for reconstruction iterations} 39 | \item{maxiter}{upper bound for the number of iterations} 40 | \item{norm}{distance function used for covergence criterion} 41 | \item{base}{series used as a 'seed' for gapfilling: original or 42 | reconstructed according to the value of \code{groups} argument} 43 | \item{\dots}{additional arguments passed to \code{\link{reconstruct}} 44 | routines} 45 | \item{trace}{logical, indicates whether the convergence process should be traced} 46 | \item{drop}{logical, if 'TRUE' then the result is coerced to series 47 | itself, when possible (length of 'groups' is one)} 48 | \item{drop.attributes}{logical, if 'TRUE' then the attributes of the input series 49 | are not copied to the reconstructed ones.} 50 | \item{cache}{logical, if 'TRUE' then intermediate results will be 51 | cached in the SSA object.} 52 | } 53 | 54 | \details{ 55 | Iterative gapfilling starts from filling missed entries with initial 56 | values, then the missed values are imputed from the successive 57 | reconstructions. This process continues until convergence up to a 58 | stationary point (e.g. filling / reconstruction does not change missed 59 | values at all). 60 | 61 | Details of the used algorithm see in Golyandina et al (2018), 62 | Algorithms 3.7. 63 | } 64 | 65 | \note{ 66 | The method is very sensitive to the initial value of missed entries 67 | ('fill' argument). If the series are not stationary (e.g. contains 68 | some trend) than the method may be prohibitely slow, or even fail to 69 | converge or produce bogus results. 70 | } 71 | 72 | \value{ 73 | List of objects with gaps filled in. Elements of the list have the 74 | same names as elements of \code{groups}. If group is unnamed, 75 | corresponding component gets name `Fn', where `n' is its index in 76 | \code{groups} list. 77 | 78 | Or, the forecasted object itself, if length of groups is one and 'drop = TRUE'. 79 | } 80 | 81 | \references{ 82 | Golyandina N., Korobeynikov A., Zhigljavsky A. (2018): 83 | \emph{Singular Spectrum Analysis with R.} Use R!. 84 | Springer, Berlin, Heidelberg. 85 | 86 | Kondrashov, D. & Ghil, M. (2006) \emph{Spatio-temporal filling of 87 | missing points in geophysical data sets}. Nonlinear Processes In 88 | Geophysics, Vol. 13(2), pp. 151-159. 89 | } 90 | 91 | \seealso{ 92 | \code{\link{Rssa}} for an overview of the package, as well as, 93 | \code{\link[Rssa:gapfill]{gapfill}}, 94 | \code{\link[Rssa:clplot]{clplot}}, 95 | \code{\link[Rssa:summarize.gaps]{summarize.gaps}}, 96 | } 97 | 98 | \examples{ 99 | # Produce series with gaps 100 | F <- co2; F[100:200] <- NA 101 | # Perform shaped SSA 102 | s <- ssa(F, L = 72) 103 | # Fill in gaps using the trend and 2 periodicty components 104 | # Due to trend, provide a linear filler to speedup the process 105 | fill <- F; fill[100:200] <- F[99] + (1:101)/101*(F[201] - F[99]) 106 | g <- igapfill(s, groups = list(1:6), fill = fill, maxit = 50) 107 | # Compare the result 108 | plot(g) 109 | lines(co2, col = "red") 110 | } 111 | -------------------------------------------------------------------------------- /man/iossa.result.Rd: -------------------------------------------------------------------------------- 1 | \name{iossa.result} 2 | \alias{iossa.result} 3 | \alias{print.iossa.result} 4 | \alias{summary.iossa.result} 5 | \title{Summary of Iterative O-SSA results} 6 | 7 | \description{ 8 | Various routines to print Iterative Oblique SSA results 9 | } 10 | 11 | \usage{ 12 | \method{print}{iossa.result}(x, digits = max(3, getOption("digits") - 3), \dots) 13 | \method{summary}{iossa.result}(object, digits = max(3, getOption("digits") - 3), \dots) 14 | } 15 | 16 | \arguments{ 17 | \item{x, object}{object of class `iossa.result' or `ossa'} 18 | \item{digits}{integer, used for number formatting} 19 | \item{\dots}{further arguments passed to method} 20 | } 21 | 22 | \details{ 23 | An object of class `iossa.result' is a list with the following fields: 24 | \describe{ 25 | \item{converged}{logical, whether algorithm has been converged} 26 | \item{iter}{the number of OSSA iterations} 27 | \item{cond}{numeric vector with two elements, condition numbers of the final column and row inner products} 28 | \item{initial.tau}{numeric vector, proportions of high rank components contribution 29 | for each of initial series 30 | (denotes how well the series is approximated by a series of finite rank)} 31 | \item{tau}{numeric vector, proportions of high rank components contribution for each of final series} 32 | \item{initial.wcor}{W-correlation matrix of the initial nested decomposition} 33 | \item{wcor}{W-correlations matrix of the final nested decomposition} 34 | \item{owcor}{oblique W-correlation matrix (see \code{\link[Rssa:owcor]{owcor}}) 35 | of the final nested decomposition} 36 | \item{initial.rec}{list of initial series (reconstructed initial nested decomposition)} 37 | \item{kappa, maxiter, tol}{Iterative O-SSA procedure parameters} 38 | } 39 | } 40 | 41 | \references{ 42 | Golyandina N. and Shlemov A. (2015): \emph{Variations of Singular Spectrum Analysis 43 | for separability improvement: non-orthogonal decompositions of time series}, 44 | Statistics and Its Interface. Vol.8, No 3, P.277-294. 45 | \url{https://arxiv.org/abs/1308.4022} 46 | } 47 | 48 | \seealso{ 49 | \code{\link{Rssa}} for an overview of the package, as well as, 50 | \code{\link[Rssa:iossa]{iossa}}, 51 | \code{\link[Rssa:owcor]{owcor}}, 52 | \code{\link[Rssa:summary.ssa]{summary.ssa}}. 53 | } 54 | 55 | \examples{ 56 | \donttest{ 57 | # Separate three non-separable sines with different amplitudes 58 | N <- 150 59 | L <- 70 60 | 61 | omega1 <- 0.05 62 | omega2 <- 0.06 63 | omega3 <- 0.07 64 | 65 | F <- 4*sin(2*pi*omega1 * (1:N)) + 2*sin(2*pi*omega2 * (1:N)) + sin(2*pi*omega3 * (1:N)) 66 | s <- ssa(F, L) 67 | ios <- iossa(s, nested.groups = list(1:2, 3:4, 5:6), kappa = NULL, maxiter = 100, tol = 1e-3) 68 | 69 | print(ios) 70 | print(ios$iossa.result) 71 | } 72 | } 73 | -------------------------------------------------------------------------------- /man/lrr.Rd: -------------------------------------------------------------------------------- 1 | \name{lrr} 2 | \alias{lrr} 3 | \alias{lrr.default} 4 | \alias{lrr.ssa} 5 | \alias{lrr.1d.ssa} 6 | \alias{lrr.toeplitz.ssa} 7 | \alias{roots} 8 | \alias{roots.lrr} 9 | \alias{plot.lrr} 10 | 11 | \title{Calculate the min-norm Linear Recurrence Relation} 12 | 13 | \description{ 14 | Calculates the min-norm Linear Recurrence Relation given the one-dimensional 'ssa' object. 15 | } 16 | 17 | \usage{ 18 | \method{lrr}{1d.ssa}(x, groups, reverse = FALSE, \dots, drop = TRUE) 19 | \method{lrr}{toeplitz.ssa}(x, groups, reverse = FALSE, \dots, drop = TRUE) 20 | \method{lrr}{default}(x, eps = sqrt(.Machine$double.eps), 21 | reverse = FALSE, \dots, orthonormalize = TRUE) 22 | \method{roots}{lrr}(x, ..., method = c("companion", "polyroot")) 23 | \method{plot}{lrr}(x, ..., raw = FALSE) 24 | } 25 | 26 | \arguments{ 27 | \item{x}{SSA object holding the decomposition or matrix containing the basis vectors in columns 28 | for \code{lrr} call or 'lrr' object itself for other function calls} 29 | \item{groups}{list, the grouping of eigentriples used to derive the LRR} 30 | \item{reverse}{logical, if 'TRUE', then LRR is assumed to go back} 31 | \item{\dots}{further arguments to be passed to \code{decompose} or 32 | \code{plot} call, if necessary} 33 | \item{drop}{logical, if 'TRUE' then the result is coerced to lrr object 34 | itself, when possible (length of 'groups' is one)} 35 | \item{eps}{Tolerance for verticality checking} 36 | \item{method}{methods used for calculation of the polynomial roots: via eigenvalues 37 | of companion matrix or R's standard \code{polyroot} routine} 38 | \item{raw}{logical, if 'TRUE' then \code{plot} routine will not add any 39 | additional plot components (e.g. unit circle)} 40 | \item{orthonormalize}{logical, if 'FALSE' then the basis is assumed orthonormal. 41 | Otherwise, orthonormalization is performed} 42 | } 43 | 44 | \details{ 45 | Produces the min-norm linear recurrence relation from the series. The default 46 | implementation works as follows. 47 | 48 | Denote by \eqn{U_i} the columns of matrix \eqn{x}. Denote by 49 | \eqn{\tilde{U}_{i}} the same vector \eqn{U_i} but without the 50 | last coordinate. Denote the last coordinate of \eqn{U_i} by 51 | \eqn{\pi_i}. The returned value is 52 | \deqn{ 53 | \mathcal{R} = \frac{1}{1-\nu^2}\sum_{i=1}^{d}{\pi_i \tilde{U}_{i}}, 54 | } 55 | where 56 | \deqn{ 57 | \nu^2 = \pi_1^2 + \dots + \pi_d^2. 58 | } 59 | 60 | For \code{lrr.ssa} case the matrix \eqn{U} used is the matrix of basis 61 | vector corresponding to the selected elementary series. 62 | 63 | For \code{reverse = 'TRUE'} everything is the same, besides the 64 | last coordinate substituted for the first coordinate. 65 | 66 | Details of the used algorithm see in Golyandina et al (2018), 67 | Algorithms 3.1 and 3.2. 68 | } 69 | 70 | \value{ 71 | Named list of object of class 'lrr' for \code{lrr} function call, 72 | where elements have the same names as elements of \code{groups} 73 | (if group is unnamed, corresponding component gets name `Fn', 74 | where `n' is its index in \code{groups} list). 75 | Or the object itself if 'drop = TRUE' and groups has length one. 76 | 77 | Vector with the roots of the of the characteristic 78 | polynomial of the LRR for \code{roots} function call. Roots are 79 | ordered by moduli decreasing. 80 | } 81 | 82 | \references{ 83 | Golyandina N., Korobeynikov A., Zhigljavsky A. (2018): 84 | \emph{Singular Spectrum Analysis with R.} Use R!. 85 | Springer, Berlin, Heidelberg. 86 | } 87 | 88 | \seealso{ 89 | \code{\link{Rssa}} for an overview of the package, as well as, 90 | \code{\link[Rssa:ssa]{ssa}}, 91 | \code{\link[Rssa:parestimate]{parestimate}}, 92 | } 93 | 94 | \examples{ 95 | # Decompose 'co2' series with default parameters 96 | s <- ssa(co2, L = 24) 97 | # Calculate the LRR out of first 3 eigentriples 98 | l <- lrr(s, groups = list(1:3)) 99 | # Calculate the roots of the LRR 100 | r <- roots(l) 101 | # Moduli of the roots 102 | Mod(r) 103 | # Periods of three roots with maximal moduli 104 | 2*pi/Arg(r)[1:3] 105 | # Plot the roots 106 | plot(l) 107 | } 108 | -------------------------------------------------------------------------------- /man/owcor.Rd: -------------------------------------------------------------------------------- 1 | \name{owcor} 2 | \alias{owcor} 3 | \title{Calculate generalized (oblique) W-correlation matrix} 4 | 5 | \description{ 6 | Function calculates oblique W-correlation matrix for the series. 7 | } 8 | 9 | \usage{ 10 | owcor(x, groups, ..., cache = TRUE) 11 | } 12 | 13 | \arguments{ 14 | \item{x}{the input object of `ossa' class} 15 | \item{groups}{list of numeric vectors, indices of elementary components 16 | used for reconstruction. The elementary components must belong to 17 | the current OSSA component set} 18 | \item{\dots}{further arguments passed to \code{reconstruct} routine} 19 | \item{cache}{logical, if 'TRUE' then intermediate results will be 20 | cached in 'ssa' object.} 21 | } 22 | 23 | \value{ 24 | Object of class `wcor.matrix' 25 | } 26 | 27 | \details{ 28 | Matrix of oblique weighted correlations will be computed. 29 | For two series, oblique W-covariation is defined as follows: 30 | \deqn{% 31 | \mathrm{owcov}(F_1, F_2) = 32 | \langle L^\dagger X_1 (R^\dagger)^\mathrm{T}, 33 | L^\dagger X_2 (R^\dagger)^\mathrm{T} \rangle_\mathrm{F}, 34 | }{% 35 | owcov(F_1, F_2) = _F, 36 | } 37 | where 38 | \eqn{X_1, X_2} denotes the trajectory matrices of series \eqn{F_1, F_2} 39 | correspondingly, \eqn{L = [U_{b_1} : ... : U_{b_r}], R = [V_{b_1}: ... V_{b_r}]}, 40 | where \eqn{\\\{b_1, \dots, b_r\\\}}{\{b_1, \dots, \b_r\}} is current OSSA component set 41 | (see description of `ossa.set' field of `ossa' object), 42 | `\eqn{\langle \cdot, \cdot 43 | \rangle_\mathrm{F}}{<., .>_F}' denotes Frobenius matrix inner product 44 | and `\eqn{\dagger}{*}' denotes Moore-Penrose pseudo-inverse matrix. 45 | 46 | And oblique W-correlation is defined the following way: 47 | \deqn{% 48 | \mathrm{owcor}(F_1, F_2) = \frac{\mathrm{owcov}(F_1, F_2)} 49 | {\sqrt{\mathrm{owcov}(F_1, F_1) \cdot \mathrm{owcov(F_2, F_2)}}} 50 | }{% 51 | owcor(F_1, F_2) = owcov(F_1, F_2) / sqrt(owcov(F_1, F_1) owcov(F_2, F_2)) 52 | } 53 | 54 | Oblique W-correlation is an OSSA analogue of W-correlation, that is, a 55 | measure of series separability. If I-OSSA procedure separates series 56 | exactly, their oblique W-correlation will be equal to zero. 57 | } 58 | 59 | \references{ 60 | Golyandina N. and Shlemov A. (2015): \emph{Variations of Singular Spectrum Analysis 61 | for separability improvement: non-orthogonal decompositions of time series}, 62 | Statistics and Its Interface. Vol.8, No 3, P.277-294. 63 | \url{https://arxiv.org/abs/1308.4022} 64 | } 65 | 66 | \seealso{ 67 | \code{\link{Rssa}} for an overview of the package, as well as, 68 | \code{\link[Rssa:wcor]{wcor}}, 69 | \code{\link[Rssa:iossa]{iossa}}, 70 | \code{\link[Rssa:iossa]{fossa}}. 71 | } 72 | 73 | \examples{ 74 | # Separate two non-separable sines 75 | N <- 150 76 | L <- 70 77 | 78 | omega1 <- 0.06 79 | omega2 <- 0.065 80 | 81 | F <- 4*sin(2*pi*omega1 * (1:N)) + sin(2*pi*omega2 * (1:N)) 82 | s <- ssa(F, L) 83 | ios <- iossa(s, nested.groups = list(1:2, 3:4), kappa = NULL, maxIter = 200, tol = 1e-8) 84 | 85 | p.wcor <- plot(wcor(ios, groups = list(1:2, 3:4))) 86 | p.owcor <- plot(owcor(ios, groups = list(1:2, 3:4)), main = "OW-correlation matrix") 87 | print(p.wcor, split = c(1, 1, 2, 1), more = TRUE) 88 | print(p.owcor, split = c(2, 1, 2, 1)) 89 | } 90 | -------------------------------------------------------------------------------- /man/plot.Rd: -------------------------------------------------------------------------------- 1 | \name{plot} 2 | \alias{plot.ssa} 3 | 4 | \title{Plot SSA object} 5 | \description{ 6 | This function plots various sorts of figures related to the SSA method. 7 | } 8 | \usage{ 9 | \method{plot}{ssa}(x, 10 | type = c("values", "vectors", "paired", "series", "wcor"), 11 | \dots, 12 | vectors = c("eigen", "factor"), 13 | plot.contrib = TRUE, 14 | numvalues = nsigma(x), 15 | numvectors = min(nsigma(x), 10), 16 | idx = 1:numvectors, 17 | idy, 18 | groups) 19 | } 20 | 21 | \arguments{ 22 | \item{x}{SSA object holding the decomposition} 23 | \item{type}{Type of the plot (see 'Details' for more information)} 24 | \item{\dots}{Arguments to be passed to methods, such as graphical 25 | parameters} 26 | \item{vectors}{For type = 'vectors', choose the vectors to plot} 27 | \item{plot.contrib}{logical. If 'TRUE' (the default), the contribution 28 | of the component to the total variance is plotted. 29 | For `ossa' class, Frobenius orthogonality checking of elementary matrices is performed. 30 | If not all matrices are orthogonal, corresponding warning is risen} 31 | \item{numvalues}{Number of eigenvalues to plot (for type = 'values')} 32 | \item{numvectors}{Total number of eigenvectors to plot (for type = 'vectors')} 33 | \item{idx}{Indices of eigenvectors to plot (for type = 'vectors')} 34 | \item{idy}{Second set of indices of eigenvectors to plot (for type = 'paired')} 35 | \item{groups}{Grouping used for the decomposition (see \code{\link[Rssa:reconstruct.ssa]{reconstruct}})} 36 | } 37 | 38 | \details{ 39 | This function is the single entry to various plots of SSA objects. Right 40 | now this includes: 41 | \describe{ 42 | \item{values}{plot the graph of the component norms.} 43 | \item{vectors}{plot the eigenvectors.} 44 | \item{paired}{plot the pairs of eigenvectors (useful for the 45 | detection of periodic components).} 46 | \item{series}{plot the reconstructed series.} 47 | \item{wcor}{plot the W-correlation matrix for the reconstructed objects.} 48 | } 49 | 50 | Additional (non-standard) graphical parameters which can be transfered via \dots: 51 | \describe{ 52 | \item{plot.type}{lattice plot type. This argument will be transfered as \code{type} 53 | argument to function \code{panel.xyplot}.} 54 | \item{ref}{logical. Whether to plot zero-level lines in series-plot, eigenvectors-plot and paired-plot. 55 | Zero-level isolines will be plotted for 2d-eigenvectors-plot.} 56 | \item{symmetric}{logical. Whether to use symmetric scales in series-plot, eigenvectors-plot and paired-plot.} 57 | \item{useRaster}{logical. For 2d-eigenvector-plot and wcor-plot, indicating whether raster representations 58 | should be used. 'TRUE' by default.} 59 | \item{col}{color vector for colorscale (for 2d- and wcor-plots), 60 | given by two or more colors, 61 | the first color corresponds to the minimal value, 62 | while the last one corresponds to the maximal value (will be interpolated by \code{colorRamp})} 63 | \item{zlim}{for 2d-plot, range of displayed values} 64 | \item{at}{for 2d-eigenvectors-plot, a numeric vector giving breakpoints along the range of \code{z}, 65 | a list of such vectors 66 | or a character string. 67 | If a list is given, corresponding list element (with recycling) will be used for each 68 | plot panel. 69 | For character strings, values 'free' and 'same' are allowed: 'free' means 70 | special breakpoints' vectors (will be evaluated automatically, see description of \code{cuts} 71 | argument in 'Details') for each component. 'same' means one breakpoints' vector for all 72 | component (will be evaluated automatically too)} 73 | \item{cuts}{for 2d-reconstruction-plot, the number of levels the range of \code{z} would be divided into.} 74 | \item{fill.color}{color or 'NULL'. Defines background color for shaped 2d-eigenvectors plot. If 'NULL', standard white 75 | background will be used.} 76 | } 77 | } 78 | 79 | \seealso{ 80 | \code{\link[Rssa:ssa-object]{ssa-object}}, 81 | \code{\link{ssa}} 82 | \code{\link[Rssa:plot.reconstruction]{plot.reconstruction}}, 83 | } 84 | 85 | \examples{ 86 | \donttest{ 87 | # Decompose 'co2' series with default parameters 88 | s <- ssa(co2) 89 | # Plot the eigenvalues 90 | plot(s, type = "values") 91 | # Plot W-cor matrix for first 10 reconstructed components 92 | plot(s, type = "wcor", groups = 1:10) 93 | # Plot the paired plot for first 6 eigenvectors 94 | plot(s, type = "paired", idx = 1:6) 95 | # Plot eigenvectors for first 6 components 96 | plot(s, type = "vectors", idx = 1:6) 97 | # Plot the first 4 reconstructed components 98 | plot(s, type = "series", groups = list(1:4)) 99 | # Plot the eigenvalues by points only 100 | plot(s, type = "values", plot.type = "p") 101 | 102 | # Artificial image for 2dSSA 103 | mx <- outer(1:50, 1:50, 104 | function(i, j) sin(2*pi * i/17) * cos(2*pi * j/7) + exp(i/25 - j/20)) + 105 | rnorm(50^2, sd = 0.1) 106 | # Decompose 'mx' with default parameters 107 | s <- ssa(mx, kind = "2d-ssa") 108 | # Plot the eigenvalues 109 | plot(s, type = "values") 110 | # Plot eigenvectors for first 6 components 111 | plot(s, type = "vectors", idx = 1:6, 112 | ref = TRUE, at = "same", cuts = 50, 113 | plot.contrib = TRUE, symmetric = TRUE) 114 | # Plot factor vectors for first 6 components 115 | plot(s, type = "vectors", vectors = "factor", idx = 1:6, 116 | ref = TRUE, at = "same", cuts = 50, 117 | plot.contrib = TRUE, symmetric = TRUE) 118 | # Plot wcor for first 12 components 119 | plot(s, type = "wcor", groups = 1:12, grid = c(2, 6)) 120 | 121 | # 3D-SSA example (2D-MSSA) 122 | data(Barbara) 123 | ss <- ssa(Barbara, L = c(50, 50, 1)) 124 | plot(ss, type = "values") 125 | plot(ss, type = "vectors", idx = 1:12, slice = list(k = 1), 126 | cuts = 50, plot.contrib = TRUE) 127 | plot(ss, type = "vectors", idx = 1:12, slice = list(k = 1, i = 1)) 128 | plot(ss, type = "vectors", vectors = "factor", idx = 1:12, slice = list(k = 3), 129 | cuts = 50, plot.contrib = FALSE) 130 | plot(ss, type = "series", groups = 1:12, slice = list(k = 1)) 131 | plot(ss, type = "series", groups = 1:12, slice = list(k = 1, i = 1)) 132 | plot(ss, plot.method = "xyplot", type = "series", groups = 1:12, slice = list(k = 1, i = 1)) 133 | } 134 | } 135 | -------------------------------------------------------------------------------- /man/precache.Rd: -------------------------------------------------------------------------------- 1 | \name{precache} 2 | \alias{precache} 3 | \alias{precache.ssa} 4 | \title{Calculates and caches elementary components inside SSA object} 5 | 6 | \description{ 7 | Calculates all the elementary series and saves inside SSA 8 | object. After this the grouping procedure can be performed much 9 | faster. 10 | } 11 | \usage{ 12 | precache(x, n, \dots) 13 | } 14 | 15 | \arguments{ 16 | \item{x}{SSA object} 17 | \item{n}{integer, number of series to calculate and save} 18 | \item{\dots}{further arguments passed to the reconstruction routines} 19 | } 20 | 21 | \note{ 22 | In most cases it is not necessary to call this routine directly. By 23 | default functions from the package collect all elementary 24 | series they encounter during the calculations. 25 | } 26 | 27 | \seealso{ 28 | \code{\link[Rssa:reconstruct.ssa]{reconstruct}} 29 | } 30 | 31 | \examples{ 32 | # Decompose 'co2' series with default parameters 33 | s <- ssa(co2) 34 | summary(s) 35 | # Precache the stuff 36 | precache(s) 37 | summary(s) 38 | } 39 | -------------------------------------------------------------------------------- /man/reconstruct.Rd: -------------------------------------------------------------------------------- 1 | \name{reconstruct} 2 | \alias{reconstruct} 3 | \alias{reconstruct.ssa} 4 | \title{Perform a series reconstruction} 5 | 6 | \description{ 7 | Reconstruct the data given the SSA decomposition and the desired 8 | grouping of the elementary components. 9 | } 10 | 11 | \usage{ 12 | \method{reconstruct}{ssa}(x, groups, \dots, drop.attributes = FALSE, cache = TRUE) 13 | } 14 | 15 | \arguments{ 16 | \item{x}{SSA object} 17 | \item{groups}{list of numeric vectors, indices of elementary components 18 | used for reconstruction, the entries of the list can be named, see 19 | 'Value' for more information} 20 | \item{\dots}{further arguments passed to routines (e.g. to 21 | \code{decompose} routine if the continuation is desired).} 22 | \item{drop.attributes}{logical, if 'TRUE' then the attributes of the 23 | input objects are not copied to the reconstructed ones.} 24 | \item{cache}{logical, if 'TRUE' then intermediate results will be 25 | cached in the SSA object.} 26 | } 27 | 28 | \details{ 29 | Reconstruction is performed in a common form for different types of input objects. 30 | See Section 1.1.2.6 in Golyandina et al (2018) for the explanation. 31 | Formal algorithms are described in this book in Algorithm 2.2 for 1D-SSA, Algorithm 4.3 for MSSA, 32 | Algorithm 5.2 for 2D-SSA and Algorithm 5.6 for Shaped 2D-SSA. 33 | 34 | Fast implementation of reconstruction with the help of FFT is described in Korobeynikov (2010) 35 | for the 1D case and in Section 6.2 (Rank-one quasi-hankelization) of Golyandina et al (2015) 36 | for the general case. 37 | } 38 | 39 | \value{ 40 | List of reconstructed objects. Elements of the list have the same 41 | names as elements of \code{groups}. If the group is unnamed, then 42 | corresponding component will obtain name `Fn', where `n' is its index 43 | in \code{groups} list. 44 | } 45 | 46 | \note{ 47 | By default (argument \code{drop.attributes}) the routine tries to 48 | preserve all the attributes of the input object. This way, for 49 | example, the reconstruction result of 'ts' object is the 'ts' object 50 | with the same time scale. 51 | } 52 | 53 | \references{ 54 | Golyandina N., Korobeynikov A., Zhigljavsky A. (2018): 55 | \emph{Singular Spectrum Analysis with R.} Use R!. 56 | Springer, Berlin, Heidelberg. 57 | 58 | Korobeynikov, A. (2010): \emph{Computation- and space-efficient 59 | implementation of SSA.} Statistics and Its Interface, Vol. 3, No. 3, 60 | Pp. 257-268 61 | 62 | Golyandina, N., Korobeynikov, A., Shlemov, A. and Usevich, K. (2015): 63 | \emph{Multivariate and 2D Extensions of Singular Spectrum Analysis 64 | with the Rssa Package}. Journal of Statistical Software, Vol. 67, Issue 2. 65 | \doi{10.18637/jss.v067.i02} 66 | } 67 | 68 | \seealso{ 69 | \code{\link{Rssa}} for an overview of the package, as well as, 70 | \code{\link[Rssa:ssa-input]{ssa-input}}, 71 | \code{\link[Rssa:ssa]{ssa}}, 72 | \code{\link[Rssa:plot.reconstruction]{plot.reconstruction}}, 73 | } 74 | 75 | \examples{ 76 | # Decompose 'co2' series with default parameters 77 | s <- ssa(co2) 78 | # Reconstruct the series, grouping elementary series. 79 | r <- reconstruct(s, groups = list(Trend = c(1, 4), Season1 = c(2,3), Season2 = c(5, 6))) 80 | plot(r) 81 | # 'groups' argument might contain duplicate entries as well 82 | r <- reconstruct(s, groups = list(1, 1:4, 1:6)) 83 | plot(r) 84 | 85 | \donttest{ 86 | # Real example: Mars photo 87 | data(Mars) 88 | # Decompose only Mars image (without backgroud) 89 | s <- ssa(Mars, mask = Mars != 0, wmask = circle(50), kind = "2d-ssa") 90 | # Reconstruct and plot trend 91 | plot(reconstruct(s, 1), fill.uncovered = "original") 92 | # Reconstruct and plot texture pattern 93 | plot(reconstruct(s, groups = list(c(13, 14, 17, 18)))) 94 | 95 | # Decompose 'EuStockMarkets' series with default parameters 96 | s <- ssa(EuStockMarkets, kind = "mssa") 97 | r <- reconstruct(s, groups = list(Trend = 1:2)) 98 | # Plot original series, trend and residuals superimposed 99 | plot(r, plot.method = "xyplot", superpose = TRUE, 100 | auto.key = list(columns = 3), 101 | col = c("blue", "green", "red", "violet"), 102 | lty = c(rep(1, 4), rep(2, 4), rep(3, 4))) 103 | } 104 | } 105 | 106 | -------------------------------------------------------------------------------- /man/residuals.Rd: -------------------------------------------------------------------------------- 1 | \name{residuals} 2 | \alias{residuals.ssa} 3 | \alias{residuals.ssa.reconstruction} 4 | \title{Obtain the residuals from SSA reconstruction} 5 | \description{ 6 | Obtain the residuals from SSA reconstruction 7 | } 8 | 9 | \usage{ 10 | \method{residuals}{ssa}(object, groups, \dots, cache = TRUE) 11 | \method{residuals}{ssa.reconstruction}(object, \dots) 12 | } 13 | 14 | \arguments{ 15 | \item{object}{input object} 16 | \item{groups}{list of numeric vectors, indices of elementary components 17 | used for reconstruction, the entries of the list can be named.} 18 | \item{\dots}{further arguments passed to \code{reconstruct} routine} 19 | \item{cache}{logical, if 'TRUE' then intermediate results will be 20 | cached in the SSA object.} 21 | } 22 | 23 | \details{ 24 | This function calculates the residuals either from SSA object 25 | corresponding to reconstruction using \code{groups} arguments, or just 26 | extracts the residuals from reconstruction object. 27 | } 28 | 29 | \value{ 30 | residuals object 31 | } 32 | 33 | \seealso{ 34 | \code{\link{Rssa}} for an overview of the package, as well as, 35 | \code{\link[Rssa:reconstruct]{reconstruct}}. 36 | } 37 | 38 | \examples{ 39 | # Decompose 'co2' series with default parameters 40 | s <- ssa(co2) 41 | # Reconstruct the series, grouping elementary series. 42 | r <- reconstruct(s, groups = list(c(1, 4), c(2,3), c(5, 6))) 43 | print(residuals(r)) 44 | 45 | # If there are several groups, then the residuals are calculated as 46 | # residuals for the model corresponding to the combined model. 47 | r <- reconstruct(s, groups = list(c(6, 7), c(6,7), c(8, 9))) 48 | r1 <- reconstruct(s, groups = list(6:9)) 49 | max(abs(residuals(r) - residuals(r1))) # 0 50 | max(abs(co2 - (r1$F1 + residuals(r1)))) # 0 51 | } 52 | -------------------------------------------------------------------------------- /man/ssa-data.Rd: -------------------------------------------------------------------------------- 1 | \name{ssa-input} 2 | \alias{ssa-input} 3 | \title{Input Data Formats Used by SSA Routines} 4 | 5 | \description{ 6 | The inputs of SSA can be quite different depending on the kind of SSA 7 | used. However, there is a common of all the variants of SSA and all 8 | the routines. The package tries hard to preserve the specifics of 9 | input object as much as possible. This means, that all the attributes, 10 | etc. are copied back to the reconstructed objects. This way, the 11 | result of the SSA decomposition of a 'ts' object is a 'ts' object as 12 | well. 13 | 14 | For forecasting, it is not possible in general to preserve the 15 | attributes of the input objects. However, \code{Rssa} knows about some 16 | common time series classes (e.g. 'ts') and tries to infer the time 17 | scales for forecasted objects as well. 18 | 19 | The input formats are as follows: 20 | \subsection{1d SSA and Toeplitz SSA}{ 21 | Input is assumed to be a simple vector, or vector-like object 22 | (e.g. univariare 'ts' or 'zooreg' object). Everything else is 23 | coerced to vector. 24 | } 25 | 26 | \subsection{2d SSA}{ 27 | Input assumed to be a matrix. If there are any \code{NA}'s then the 28 | shaped variant of 2d SSA will be used. All non-\code{NA} elements 29 | will be used as a mask. 30 | } 31 | 32 | \subsection{nd SSA}{ 33 | Input assumed to be an array of arbitrary dimension. If there are any 34 | \code{NA}'s then the shaped variant will be used. 35 | } 36 | 37 | \subsection{MSSA}{ 38 | While the representation of a one dimensional time series in 39 | R is pretty obvious, there are multiple possible ways of 40 | defining the multivariate time series. Let us outline some common 41 | choices. 42 | 43 | \itemize{ 44 | \item Matrix with separate series in the columns. Optionally, 45 | additional time structure like in 'mts' objects, can be embedded. 46 | 47 | \item Matrix-like (e.g. a 'data.frame') object with series in the 48 | columns. In particular, 'data.frame' would be a result of reading 49 | the series from the file via 'read.table' function. 50 | 51 | \item List of separate time series objects (e.g. a 'list' of 'ts' 52 | or 'zoo' objects). 53 | } 54 | 55 | Also, the time scales of the individual time series can be 56 | normalized via head or tail padding with \code{NA} (for example, as 57 | a result of the \code{ts.union} call), or specified via time series 58 | attributes. Or, everything can be mixed all together. 59 | 60 | The \code{ssa} routine with 'kind = mssa' allows one to provide any 61 | of the outlined multivariate series formats. As usual, all the 62 | attributes, names of the series, NA padding, etc. is carefully 63 | preserved. 64 | 65 | } 66 | 67 | \subsection{CSSA}{ 68 | Complex vectors are assumed at the input. 69 | } 70 | } 71 | 72 | \seealso{ 73 | \code{\link[Rssa:ssa]{ssa}} 74 | } 75 | 76 | \examples{ 77 | s <- ssa(co2) # Perform the decomposition using the default window length 78 | r <- reconstruct(s, groups = list(Trend = c(1, 4), 79 | Seasonality = c(2, 3))) # Reconstruct into 2 series 80 | class(r$Trend) # Result is 'ts' object 81 | 82 | # Simultaneous trend extraction using MSSA 83 | s <- ssa(EuStockMarkets, kind = "mssa") 84 | r <- reconstruct(s, groups = list(Trend = c(1,2))) 85 | class(r$Trend) # Result is 'mts' object 86 | 87 | # Trend forecast 88 | f <- rforecast(s, groups = list(Trend = c(1, 2)), len = 50, only.new = FALSE) 89 | class(f) # For 'ts' objects the time scales are inferred automatically 90 | 91 | # Artificial image for 2dSSA 92 | mx <- outer(1:50, 1:50, 93 | function(i, j) sin(2*pi * i/17) * cos(2*pi * j/7) + exp(i/25 - j/20)) + 94 | rnorm(50^2, sd = 0.1) 95 | # Decompose 'mx' with circular window 96 | s <- ssa(mx, kind = "2d-ssa", wmask = circle(5), neig = 10) 97 | # Reconstruct 98 | r <- reconstruct(s, groups = list(1, 2:5)) 99 | # Plot components, original image and residuals 100 | plot(r) 101 | 102 | # 3D-SSA example (2D-MSSA) 103 | data(Barbara) 104 | \donttest{ 105 | ss <- ssa(Barbara, L = c(50, 50, 1)) 106 | plot(ss) 107 | } 108 | } 109 | -------------------------------------------------------------------------------- /man/ssa.capabilities.Rd: -------------------------------------------------------------------------------- 1 | \name{ssa.capabilities} 2 | \alias{ssa.capabilities} 3 | \title{ 4 | SSA methods and capabilities check 5 | } 6 | \description{ 7 | Not all SSA algorithms and methods could be applied to SSA objects of 8 | any kind (e.g. gapfilling requires shaped SSA object, one cannot 9 | forecast for 3D-SSA and so on). This function allows one to determine 10 | a set of methods allowed to be applied to a particular SSA object 11 | } 12 | \usage{ 13 | ssa.capabilities(x) 14 | } 15 | 16 | \arguments{ 17 | \item{x}{SSA object holding the decomposition} 18 | } 19 | 20 | \value{ 21 | Logical vector, indicating which methods are allowed 22 | } 23 | 24 | \examples{ 25 | # Decompose 'co2' series with default parameters 26 | s <- ssa(co2) 27 | # Since this is 1d SSA object, everything should be supported except 28 | # gapfilling 29 | print(ssa.capabilities(s)) 30 | } 31 | -------------------------------------------------------------------------------- /man/summarize.gaps.Rd: -------------------------------------------------------------------------------- 1 | \name{summarize.gaps} 2 | \alias{summarize.gaps} 3 | \alias{summarize.gaps.ssa} 4 | \alias{summarize.gaps.1d.ssa} 5 | \alias{summarize.gaps.toeplitz.ssa} 6 | \alias{summarize.gaps.cssa} 7 | \alias{summarize.gaps.default} 8 | 9 | \title{Summarize Gaps in a Series} 10 | 11 | \description{Provide a summary about the gaps in a series given desired 12 | window length, namely whether the gap is internal or not, whether it 13 | is sparce or dense, etc.} 14 | 15 | \usage{ 16 | \method{summarize.gaps}{1d.ssa}(x, L = NULL) 17 | \method{summarize.gaps}{toeplitz.ssa}(x, L = NULL) 18 | \method{summarize.gaps}{cssa}(x, L = NULL) 19 | \method{summarize.gaps}{default}(x, L) 20 | } 21 | 22 | \arguments{ 23 | \item{x}{SSA object} 24 | \item{L}{vector of window lengths, if missing or NULL, then all viable 25 | window lengths are considered} 26 | } 27 | 28 | \value{ 29 | Object of type 'ssa.gaps': a list with entries which correspond to 30 | every window length. For each window length, entry is a list of gaps 31 | with their descriptions. 32 | } 33 | 34 | \seealso{ 35 | \code{\link{Rssa}} for an overview of the package, as well as, 36 | \code{\link[Rssa:gapfill]{gapfill}}, 37 | \code{\link[Rssa:igapfill]{igapfill}}, 38 | \code{\link[Rssa:clplot]{clplot}}, 39 | } 40 | 41 | \examples{ 42 | # Produce series with gaps 43 | F <- co2; F[c(12, 100:200, 250)] <- NA 44 | # Summarize the gaps 45 | s <- ssa(F, L = 72) 46 | g <- summarize.gaps(s, L = c(36, 72, 144)) 47 | # Print the results 48 | print(g) 49 | # Plot the proportion of complete lag-vectors 50 | plot(g) 51 | } 52 | 53 | -------------------------------------------------------------------------------- /man/toeplitz.Rd: -------------------------------------------------------------------------------- 1 | \name{tmat} 2 | \alias{new.tmat} 3 | \alias{is.tmat} 4 | \alias{tcols} 5 | \alias{trows} 6 | \alias{tmatmul} 7 | 8 | \title{Toeplitz matrices operations.} 9 | 10 | \description{ 11 | A set of routines to operate on Toeplitz matrices stored in compact 12 | FFT-based form. 13 | } 14 | 15 | \usage{ 16 | new.tmat(F, L = (N + 1) \%/\% 2, circular = FALSE, fft.plan = NULL) 17 | is.tmat(t) 18 | tcols(t) 19 | trows(t) 20 | tmatmul(tmat, v, transposed = FALSE) 21 | } 22 | 23 | \arguments{ 24 | \item{F}{series to construct the Toeplitz version of L x L autocovariance matrix.} 25 | \item{fft.plan}{internal hint argument, should be NULL in most cases} 26 | \item{L}{the window length.} 27 | \item{circular}{logical vector of one element, describes series topology. 28 | 'TRUE' means series circularity} 29 | \item{t, tmat}{matrix to operate on.} 30 | \item{transposed}{logical, if 'TRUE' the multiplication is performed 31 | with the transposed matrix.} 32 | \item{v}{vector to multiply with.} 33 | } 34 | 35 | \details{ 36 | Fast Fourier Transform provides a very efficient matrix-vector 37 | multiplication routine for Toeplitz matrices. See the paper in 38 | 'References' for the details of the algorithm. 39 | } 40 | 41 | \references{ 42 | Korobeynikov, A. (2010) \emph{Computation- and space-efficient implementation of 43 | SSA.} Statistics and Its Interface, Vol. 3, No. 3, Pp. 257-268 44 | } 45 | 46 | \seealso{ 47 | \code{\link{Rssa}} for an overview of the package, as well as, 48 | \code{\link[Rssa:ssa]{ssa}}, 49 | } 50 | 51 | \examples{ 52 | # Construct the Toeplitz version of the autocovariance matrix for 'co2' series 53 | h <- new.tmat(co2, L = 10) 54 | # Print the number of columns and rows 55 | print(trows(h)); print(tcols(h)) 56 | } 57 | -------------------------------------------------------------------------------- /man/vforecast.Rd: -------------------------------------------------------------------------------- 1 | \name{vforecast} 2 | \alias{vforecast} 3 | \alias{vforecast.default} 4 | \alias{vforecast.ssa} 5 | \alias{vforecast.1d.ssa} 6 | \alias{vforecast.toeplitz.ssa} 7 | \alias{vforecast.mssa} 8 | \alias{vforecast.cssa} 9 | \alias{vforecast.pssa.1d.ssa} 10 | \title{Perform vector SSA forecasting of the series} 11 | 12 | \description{ 13 | Perform vector SSA forecasting of the series. 14 | } 15 | 16 | \usage{ 17 | \method{vforecast}{1d.ssa}(x, groups, len = 1, only.new = TRUE, \dots, 18 | drop = TRUE, drop.attributes = FALSE) 19 | \method{vforecast}{toeplitz.ssa}(x, groups, len = 1, only.new = TRUE, \dots, 20 | drop = TRUE, drop.attributes = FALSE) 21 | \method{vforecast}{toeplitz.ssa}(x, groups, len = 1, only.new = TRUE, \dots, 22 | drop = TRUE, drop.attributes = FALSE) 23 | \method{vforecast}{mssa}(x, groups, len = 1, 24 | direction = c("row", "column"), 25 | only.new = TRUE, \dots, 26 | drop = TRUE, drop.attributes = FALSE) 27 | \method{vforecast}{cssa}(x, groups, len = 1, only.new = TRUE, \dots, 28 | drop = TRUE, drop.attributes = FALSE) 29 | \method{vforecast}{pssa.1d.ssa}(x, groups, len = 1, only.new = TRUE, \dots, 30 | drop = TRUE, drop.attributes = FALSE) 31 | } 32 | 33 | \arguments{ 34 | \item{x}{SSA object holding the decomposition} 35 | \item{groups}{list, the grouping of eigentriples to be used in the forecast} 36 | \item{len}{integer, the desired length of the forecasted series} 37 | \item{direction}{direction of forecast in multichannel SSA case, "column" 38 | stands for so-called L-forecast and "row" stands for K-forecast} 39 | \item{only.new}{logical, if 'TRUE' then only forecasted values are returned, 40 | whole series otherwise} 41 | \item{\dots}{additional arguments passed to \code{\link{decompose}} 42 | routines} 43 | \item{drop}{logical, if 'TRUE' then the result is coerced to series 44 | itself, when possible (length of 'groups' is one)} 45 | \item{drop.attributes}{logical, if 'TRUE' then the attributes of the input series 46 | are not copied to the reconstructed ones.} 47 | } 48 | 49 | \details{ 50 | The routines applies the vector SSA forecasting algorithm to 51 | produce the new series which is expected to 'continue' the current 52 | series on the basis of a given decomposition. Vector forecast 53 | differs from recurrent forecast in such a way that it continues the set 54 | of vectors in the subspace spanning the chosen eigenvectors (the same 55 | formula as described in \code{\link{lrr}} is used for constructing of 56 | the last components of the new vectors) and then derives the series out 57 | of this extended set of vectors. 58 | 59 | For multichannel SSA, forecast can be constructed in two versions, 60 | row and column ones; it uses the formulae from Golyandina et al (2015). 61 | 62 | For details of 1D-SSA recurrent forecasting, see Section 3.2.1.3 and 63 | Algorithm 3.6 in Golyandina et al (2018). 64 | For details of MSSA recurrent forecasting, see Section 4.3.1.3 and 65 | Algorithm 4.5 (column forecasting). 66 | } 67 | 68 | \value{ 69 | List of forecasted objects. Elements of the list have the same names 70 | as elements of \code{groups}. If group is unnamed, corresponding 71 | component gets name `Fn', where `n' is its index in \code{groups} 72 | list. 73 | 74 | Or, the forecasted object itself, if length of groups is one and 'drop = TRUE'. 75 | } 76 | 77 | \references{ 78 | Golyandina N., Korobeynikov A., Zhigljavsky A. (2018): 79 | \emph{Singular Spectrum Analysis with R.} Use R!. 80 | Springer, Berlin, Heidelberg. 81 | 82 | Golyandina, N., Nekrutkin, V. and Zhigljavsky, A. (2001): \emph{Analysis of 83 | Time Series Structure: SSA and related techniques.} Chapman and 84 | Hall/CRC. ISBN 1584881941 85 | 86 | Golyandina, N. and Stepanov, D. (2005): \emph{SSA-based approaches to 87 | analysis and forecast of multidimensional time series}. In 88 | Proceedings of the 5th St.Petersburg Workshop on Simulation, June 89 | 26-July 2, 2005, St. Petersburg State University, St. Petersburg, 90 | 293--298. \url{https://www.gistatgroup.com/gus/mssa2.pdf} 91 | 92 | Golyandina, N., Korobeynikov, A., Shlemov, A. and Usevich, K. (2015): 93 | \emph{Multivariate and 2D Extensions of Singular Spectrum Analysis 94 | with the Rssa Package}. Journal of Statistical Software, Vol. 67, Issue 2. 95 | \doi{10.18637/jss.v067.i02} 96 | } 97 | 98 | \seealso{ 99 | \code{\link{Rssa}} for an overview of the package, as well as, 100 | \code{\link[Rssa:rforecast]{rforecast}}, 101 | \code{\link[Rssa:bforecast]{bforecast}}, 102 | \code{\link[Rssa:forecast]{forecast}}. 103 | } 104 | 105 | \examples{ 106 | # Decompose 'co2' series with default parameters 107 | s <- ssa(co2) 108 | # Produce 24 forecasted values of the series using different sets of eigentriples 109 | # as a base space for the forecast. 110 | vfor <- vforecast(s, groups = list(c(1,4), 1:4), len = 24, only.new=FALSE) 111 | matplot(data.frame(c(co2, rep(NA, 24)), vfor), type="l") 112 | 113 | # Forecast `co2' trend by SSA with projections 114 | s <- ssa(co2, column.projector = 2, row.projector = 2) 115 | len <- 100 116 | vfor <- vforecast(s, groups = list(trend = seq_len(nspecial(s))), len = len, only.new = FALSE) 117 | matplot(data.frame(c(co2, rep(NA, len)), vfor), type = "l") 118 | 119 | # Forecast finite rank series with polynomial component by SSA with projections 120 | v <- 5000 * sin(2*pi / 13 * (1:100)) + (1:100)^2 + 10000 121 | s <- ssa(v, row.projector = 2, column.projector = 2) 122 | plot(vforecast(s, groups = list(all = 1:6), len = 100, only.new = FALSE), type = "l") 123 | } 124 | -------------------------------------------------------------------------------- /man/wcor.Rd: -------------------------------------------------------------------------------- 1 | \name{wcor} 2 | \alias{wcor} 3 | \alias{wcor.ssa} 4 | \alias{wcor.ossa} 5 | \alias{wcor.default} 6 | \alias{plot.wcor.matrix} 7 | 8 | \title{Calculate the W-correlation matrix} 9 | \description{ 10 | Function calculates the W-correlation matrix for the series. 11 | } 12 | \usage{ 13 | \method{wcor}{ssa}(x, groups, Fs, \dots, cache = TRUE) 14 | \method{wcor}{ossa}(x, groups, Fs, \dots, cache = TRUE) 15 | \method{wcor}{default}(x, L = (N + 1) \%/\% 2, \dots, weights = NULL) 16 | \method{plot}{wcor.matrix}(x, 17 | grid = c(), 18 | \dots, 19 | col = grey(c(1, 0)), 20 | cuts = 20, 21 | zlim = range(abs(x), 0, 1), 22 | at) 23 | } 24 | 25 | \arguments{ 26 | \item{x}{the input object. This might be ssa object for \emph{ssa} 27 | method, or just a matrix with elementary series in columns for 28 | \emph{default} implementation.} 29 | \item{L}{window length.} 30 | \item{weights}{additional weights} 31 | \item{groups}{list of numeric vectors, indices of elementary components 32 | used for reconstruction.} 33 | \item{Fs}{list of series (e.g. 'ssa.reconstruction' object) for W-cor computation. 34 | If missing, reconstructed series from the input 'ssa' object \code{x} will be used.} 35 | \item{\dots}{further arguments passed to \code{reconstruct} routine 36 | for \code{wcor} or to \code{plot} for \code{plot.wcor.matrix}} 37 | \item{cache}{logical, if 'TRUE' then intermediate results will be 38 | cached in 'ssa' object.} 39 | \item{grid}{numeric vector, indices of matrix blocks (groups) 40 | which will be separated by grid line. 41 | Lines will be drawn on the left of and under noted blocks. 42 | Also this argument can be list of two numeric vectors 43 | with names 'x' and 'y', for control vertical and horizontal 44 | grid lines separately.} 45 | \item{col}{color vector for colorscale, 46 | given by two or more colors, 47 | the first color corresponds to the minimal value, 48 | while the last one corresponds to the maximal value (will be interpolated by \code{colorRamp})} 49 | \item{cuts}{integer, the number of levels the range of W-cor 50 | values will be divided into.} 51 | \item{zlim}{range of displayed W-cor values.} 52 | \item{at}{A numeric vector giving breakpoints along the range of the image. 53 | if missing, will be evaluated automatically (see description of the \code{cuts} argument).} 54 | } 55 | \details{ 56 | W-correlation matrix is a standard way of checking for weak 57 | separability between the elementary components. In particular, the 58 | strongly correlated elementary components should be placed into the 59 | same group. The function calculates such a matrix either directly from 60 | 'ssa' object or from the matrix of elementary series. 61 | 62 | For plotting additional (non-standard) graphical parameters which can be passed via \dots: 63 | \describe{ 64 | \item{useRaster}{logical, indicates whether raster plot should be used. 'FALSE' by default} 65 | } 66 | 67 | For class `ossa', checking of Frobenius orthogonality is performed. 68 | If there are reconstructed matrices, which are not F-orthogonal (it is 69 | a usual case for Oblique SSA), the warning about possible irrelevancy 70 | will be shown, since then weighted correlations do not indicate weak 71 | separability properly. In such a case, the use of 72 | \code{\link[Rssa:owcor]{owcor}} is preferred. 73 | } 74 | 75 | \value{ 76 | Object of type 'wcor.matrix'. 77 | } 78 | 79 | \references{ 80 | Golyandina, N., Nekrutkin, V. and Zhigljavsky, A. (2001): \emph{Analysis of 81 | Time Series Structure: SSA and related techniques.} Chapman and 82 | Hall/CRC. ISBN 1584881941 83 | } 84 | \seealso{ 85 | \code{\link[Rssa:reconstruct.ssa]{reconstruct}} 86 | \code{\link[Rssa:owcor]{owcor.}} 87 | } 88 | 89 | \examples{ 90 | # Decompose co2 series with default parameters 91 | s <- ssa(co2) 92 | # Calculate the w-correlation matrix between first 20 series 93 | # for a guess for grouping 94 | w <- wcor(s, groups = 1:20) 95 | plot(w, grid = c(2,4, 5,7)) 96 | # Calculate the w-correlation matrix for the chosen groups 97 | # to check separability 98 | w <- wcor(s, groups = list(c(1,4), c(2,3), c(5,6))) 99 | 100 | \donttest{ 101 | # Artificial image for 2D SSA 102 | mx <- outer(1:50, 1:50, 103 | function(i, j) sin(2*pi * i/17) * cos(2*pi * j/7) + exp(i/25 - j/20)) + 104 | rnorm(50^2, sd = 0.1) 105 | # Decompose 'mx' with default parameters 106 | s <- ssa(mx, kind = "2d-ssa") 107 | # Plot wcor for first 12 components 108 | plot(wcor(s, groups = 1:12), grid = c(2, 6)) 109 | 110 | # Real example: Mars photo 111 | data(Mars) 112 | # Decompose only Mars image (without backgroud) 113 | s <- ssa(Mars, mask = Mars != 0, wmask = circle(50), kind = "2d-ssa") 114 | # Plot wcor for the first 25 components 115 | plot(wcor(s, groups = 1:25), grid = c(13, 15, 17,19)) 116 | } 117 | } 118 | 119 | -------------------------------------------------------------------------------- /man/wnorm.Rd: -------------------------------------------------------------------------------- 1 | \name{wnorm} 2 | \alias{wnorm} 3 | \alias{wnorm.1d.ssa} 4 | \alias{wnorm.nd.ssa} 5 | \alias{wnorm.toeplitz.ssa} 6 | \alias{wnorm.mssa} 7 | \alias{wnorm.default} 8 | \alias{wnorm.complex} 9 | 10 | \title{Calculate Weighted Norm of series} 11 | \description{ 12 | Function calculates the W-norm for input objects or for objects stored in input ssa obect. 13 | } 14 | \usage{ 15 | \method{wnorm}{1d.ssa}(x, ...) 16 | \method{wnorm}{nd.ssa}(x, ...) 17 | \method{wnorm}{toeplitz.ssa}(x, ...) 18 | \method{wnorm}{mssa}(x, ...) 19 | \method{wnorm}{default}(x, L = (N + 1) \%/\% 2, ...) 20 | \method{wnorm}{complex}(x, L = (N + 1) \%/\% 2, ...) 21 | } 22 | 23 | \arguments{ 24 | \item{x}{the input object. This might be ssa object for \emph{ssa} 25 | method, or just a series.} 26 | \item{L}{window length.} 27 | \item{\dots}{arguments to be passed to methods.} 28 | } 29 | 30 | \details{ 31 | \code{L}-weighted norm of series is Frobenius norm of its 32 | \code{L}-trajectory matrix. So, if \code{x} is vector (series), the 33 | result of \code{wnorm(x, L)} is equal to \code{sqrt(sum(hankel(x, 34 | L)^2)}, but in fact is calculated much more efficiently. For 1d SSA and 35 | Toeplitz SSA \code{wnorm(x)} calculates weighted norm for stored 36 | original input series and stored window length. 37 | 38 | \code{L}-weighted norm of 2d array is Frobenius norm of its \code{L[1] 39 | * L[2]}-trajectory hankel-block-hankel matrix. For 2d SSA this method 40 | calculates weighted norm for stored original input array and stored 41 | 2d-window lengths. 42 | } 43 | 44 | \references{ 45 | Golyandina, N., Nekrutkin, V. and Zhigljavsky, A. (2001): \emph{Analysis of 46 | Time Series Structure: SSA and related techniques.} Chapman and 47 | Hall/CRC. ISBN 1584881941 48 | } 49 | 50 | \seealso{ 51 | \code{\link[Rssa:ssa-input]{ssa-input}}, 52 | \code{\link[Rssa:hankel]{hankel}}, 53 | \code{\link[Rssa:wcor]{wcor}} 54 | } 55 | 56 | \examples{ 57 | wnorm(co2, 20) 58 | # Construct ssa-object for 'co2' with default parameters but don't decompose 59 | ss <- ssa(co2, force.decompose = FALSE) 60 | wnorm(ss) 61 | 62 | # Artificial image for 2D SSA 63 | \donttest{ 64 | mx <- outer(1:50, 1:50, 65 | function(i, j) sin(2*pi * i/17) * cos(2*pi * j/7) + exp(i/25 - j/20)) + 66 | rnorm(50^2, sd = 0.1) 67 | # Construct ssa-object for 'mx' with default parameters but don't decompose 68 | s <- ssa(mx, kind = "2d-ssa", force.decompose = FALSE) 69 | wnorm(s) 70 | } 71 | } 72 | -------------------------------------------------------------------------------- /src/Makevars.in: -------------------------------------------------------------------------------- 1 | PKG_LIBS=$(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) 2 | PKG_CFLAGS=-I. @RSSA_CPPFLAGS@ 3 | PKG_LIBS=@LIBS@ 4 | -------------------------------------------------------------------------------- /src/Rssa_init.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include // for NULL 4 | #include 5 | 6 | #include "extmat.h" 7 | #include "fft_plan.h" 8 | 9 | 10 | /* .Call calls */ 11 | extern SEXP convolveN(SEXP, SEXP, SEXP, SEXP, SEXP); 12 | extern SEXP hankelize_multi_fft(SEXP, SEXP, SEXP); 13 | extern SEXP hankelize_one_fft(SEXP, SEXP, SEXP); 14 | extern SEXP hbhankelize_one_fft(SEXP, SEXP, SEXP); 15 | extern SEXP initialize_fft_plan(SEXP, SEXP, SEXP, SEXP); 16 | extern SEXP initialize_hbhmat(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); 17 | extern SEXP initialize_hmat(SEXP, SEXP, SEXP, SEXP); 18 | extern SEXP initialize_tmat(SEXP, SEXP); 19 | extern SEXP is_extptrnull(SEXP); 20 | extern SEXP is_fft_plan(SEXP); 21 | extern SEXP is_hbhmat(SEXP); 22 | extern SEXP is_hmat(SEXP); 23 | extern SEXP is_tmat(SEXP); 24 | extern SEXP Lcor(SEXP, SEXP, SEXP); 25 | 26 | static const R_CallMethodDef CallEntries[] = { 27 | {"convolveN", (DL_FUNC) &convolveN, 5}, 28 | {"hankelize_multi_fft", (DL_FUNC) &hankelize_multi_fft, 3}, 29 | {"hankelize_one_fft", (DL_FUNC) &hankelize_one_fft, 3}, 30 | {"hbhankelize_one_fft", (DL_FUNC) &hbhankelize_one_fft, 3}, 31 | {"initialize_fft_plan", (DL_FUNC) &initialize_fft_plan, 4}, 32 | {"initialize_hbhmat", (DL_FUNC) &initialize_hbhmat, 6}, 33 | {"initialize_hmat", (DL_FUNC) &initialize_hmat, 4}, 34 | {"initialize_tmat", (DL_FUNC) &initialize_tmat, 2}, 35 | {"is_extptrnull", (DL_FUNC) &is_extptrnull, 1}, 36 | {"is_fft_plan", (DL_FUNC) &is_fft_plan, 1}, 37 | {"is_hbhmat", (DL_FUNC) &is_hbhmat, 1}, 38 | {"is_hmat", (DL_FUNC) &is_hmat, 1}, 39 | {"is_tmat", (DL_FUNC) &is_tmat, 1}, 40 | {"Lcor_", (DL_FUNC) &Lcor, 3}, 41 | {NULL, NULL, 0} 42 | }; 43 | 44 | void R_init_Rssa(DllInfo *dll) 45 | { 46 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); 47 | R_useDynamicSymbols(dll, FALSE); 48 | } 49 | -------------------------------------------------------------------------------- /src/config.h.in: -------------------------------------------------------------------------------- 1 | /* src/config.h.in. Generated from configure.ac by autoheader. */ 2 | 3 | /* Define to 1 if you have the header file. */ 4 | #undef HAVE_FFTW3_H 5 | 6 | /* Define to 1 if you have the header file. */ 7 | #undef HAVE_INTTYPES_H 8 | 9 | /* Define to 1 if you have the `fftw3' library (-lfftw3). */ 10 | #undef HAVE_LIBFFTW3 11 | 12 | /* Define to 1 if you have the header file. */ 13 | #undef HAVE_MEMORY_H 14 | 15 | /* Define to 1 if you have the header file. */ 16 | #undef HAVE_STDINT_H 17 | 18 | /* Define to 1 if you have the header file. */ 19 | #undef HAVE_STDLIB_H 20 | 21 | /* Define to 1 if you have the header file. */ 22 | #undef HAVE_STRINGS_H 23 | 24 | /* Define to 1 if you have the header file. */ 25 | #undef HAVE_STRING_H 26 | 27 | /* Define to 1 if you have the header file. */ 28 | #undef HAVE_SYS_STAT_H 29 | 30 | /* Define to 1 if you have the header file. */ 31 | #undef HAVE_SYS_TYPES_H 32 | 33 | /* Define to 1 if you have the header file. */ 34 | #undef HAVE_UNISTD_H 35 | 36 | /* Define to the address where bug reports for this package should be sent. */ 37 | #undef PACKAGE_BUGREPORT 38 | 39 | /* Define to the full name of this package. */ 40 | #undef PACKAGE_NAME 41 | 42 | /* Define to the full name and version of this package. */ 43 | #undef PACKAGE_STRING 44 | 45 | /* Define to the one symbol short name of this package. */ 46 | #undef PACKAGE_TARNAME 47 | 48 | /* Define to the home page for this package. */ 49 | #undef PACKAGE_URL 50 | 51 | /* Define to the version of this package. */ 52 | #undef PACKAGE_VERSION 53 | 54 | /* Define to 1 if you have the ANSI C header files. */ 55 | #undef STDC_HEADERS 56 | -------------------------------------------------------------------------------- /src/config.h.win: -------------------------------------------------------------------------------- 1 | /* Assume FFTW3 is always available */ 2 | 3 | #define HAVE_FFTW3_H 1 4 | -------------------------------------------------------------------------------- /src/extmat.c: -------------------------------------------------------------------------------- 1 | /* 2 | * R package for Singular Spectrum Analysis 3 | * Copyright (c) 2009-2010 Anton Korobeynikov 4 | * 5 | * This program is free software; you can redistribute it 6 | * and/or modify it under the terms of the GNU General Public 7 | * License as published by the Free Software Foundation; 8 | * either version 2 of the License, or (at your option) 9 | * any later version. 10 | * 11 | * This program is distributed in the hope that it will be 12 | * useful, but WITHOUT ANY WARRANTY; without even the implied 13 | * warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 14 | * PURPOSE. See the GNU General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU General Public 17 | * License along with this program; if not, write to the 18 | * Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 19 | * MA 02139, USA. 20 | */ 21 | 22 | #include 23 | #include 24 | 25 | #include "extmat.h" 26 | 27 | SEXP is_extptrnull(SEXP ptr) { 28 | SEXP ans; 29 | 30 | PROTECT(ans = allocVector(LGLSXP, 1)); 31 | LOGICAL(ans)[0] = (R_ExternalPtrAddr(ptr) == NULL); 32 | UNPROTECT(1); 33 | 34 | return ans; 35 | } 36 | 37 | SEXP is_extmat(SEXP ptr) { 38 | SEXP ans; 39 | ext_matrix *e = NULL; 40 | 41 | PROTECT(ans = allocVector(LGLSXP, 1)); 42 | LOGICAL(ans)[0] = 1; 43 | 44 | /* object is an external pointer */ 45 | if (TYPEOF(ptr) != EXTPTRSXP) 46 | LOGICAL(ans)[0] = 0; 47 | 48 | /* tag should be 'external matrix' */ 49 | if (LOGICAL(ans)[0] && 50 | R_ExternalPtrTag(ptr) != install("external matrix")) 51 | LOGICAL(ans)[0] = 0; 52 | 53 | /* pointer itself should not be null */ 54 | if (LOGICAL(ans)[0]) { 55 | e = R_ExternalPtrAddr(ptr); 56 | if (!e) 57 | LOGICAL(ans)[0] = 0; 58 | } 59 | 60 | /* finally, type should be nonnull */ 61 | if (LOGICAL(ans)[0] && e && e->type == NULL) 62 | LOGICAL(ans)[0] = 0; 63 | 64 | UNPROTECT(1); 65 | 66 | return ans; 67 | } 68 | 69 | SEXP extmat_rows(SEXP ptr) { 70 | SEXP tchk; 71 | SEXP ans = NILSXP; 72 | 73 | /* Perform a type checking */ 74 | PROTECT(tchk = is_extmat(ptr)); 75 | 76 | if (LOGICAL(tchk)[0]) { 77 | ext_matrix *e = R_ExternalPtrAddr(ptr); 78 | 79 | PROTECT(ans = allocVector(INTSXP, 1)); 80 | INTEGER(ans)[0] = e->nrow(e->matrix); 81 | UNPROTECT(1); 82 | } else 83 | error("pointer provided is not an external matrix"); 84 | 85 | UNPROTECT(1); 86 | 87 | return ans; 88 | } 89 | 90 | SEXP extmat_cols(SEXP ptr) { 91 | SEXP tchk; 92 | SEXP ans = NILSXP; 93 | 94 | /* Perform a type checking */ 95 | PROTECT(tchk = is_extmat(ptr)); 96 | 97 | if (LOGICAL(tchk)[0]) { 98 | ext_matrix *e = R_ExternalPtrAddr(ptr); 99 | 100 | PROTECT(ans = allocVector(INTSXP, 1)); 101 | INTEGER(ans)[0] = e->ncol(e->matrix); 102 | UNPROTECT(1); 103 | } else 104 | error("pointer provided is not an external matrix"); 105 | 106 | UNPROTECT(1); 107 | 108 | return ans; 109 | } 110 | -------------------------------------------------------------------------------- /src/extmat.h: -------------------------------------------------------------------------------- 1 | /* 2 | * R package for Singular Spectrum Analysis 3 | * Copyright (c) 2009-2010 Anton Korobeynikov 4 | * 5 | * This program is free software; you can redistribute it 6 | * and/or modify it under the terms of the GNU General Public 7 | * License as published by the Free Software Foundation; 8 | * either version 2 of the License, or (at your option) 9 | * any later version. 10 | * 11 | * This program is distributed in the hope that it will be 12 | * useful, but WITHOUT ANY WARRANTY; without even the implied 13 | * warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 14 | * PURPOSE. See the GNU General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU General Public 17 | * License along with this program; if not, write to the 18 | * Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 19 | * MA 02139, USA. 20 | */ 21 | 22 | #ifndef __EXTMAT_H__ 23 | #define __EXTMAT_H__ 24 | 25 | #include 26 | 27 | /* External matrix structure */ 28 | typedef void (*mulfn) (double* out, const double* v, const void* matrix); 29 | typedef unsigned (*infofn) (const void* matrix); 30 | 31 | typedef struct { 32 | const char* type; 33 | void* matrix; 34 | mulfn mulfn; 35 | mulfn tmulfn; 36 | infofn ncol; 37 | infofn nrow; 38 | } ext_matrix; 39 | 40 | typedef SEXP (*extmat_fn_t)(SEXP); 41 | 42 | SEXP is_extmat(SEXP ptr); 43 | 44 | #endif /* __EXTMAT_H__ */ 45 | -------------------------------------------------------------------------------- /src/fft_plan.h: -------------------------------------------------------------------------------- 1 | /* 2 | * R package for Singular Spectrum Analysis 3 | * Copyright (c) 2009-2010 Anton Korobeynikov 4 | * 5 | * This program is free software; you can redistribute it 6 | * and/or modify it under the terms of the GNU General Public 7 | * License as published by the Free Software Foundation; 8 | * either version 2 of the License, or (at your option) 9 | * any later version. 10 | * 11 | * This program is distributed in the hope that it will be 12 | * useful, but WITHOUT ANY WARRANTY; without even the implied 13 | * warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 14 | * PURPOSE. See the GNU General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU General Public 17 | * License along with this program; if not, write to the 18 | * Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 19 | * MA 02139, USA. 20 | */ 21 | 22 | #include 23 | #include 24 | 25 | #include 26 | 27 | #include "config.h" 28 | #include "masks.h" 29 | #if HAVE_FFTW3_H 30 | #include 31 | #else 32 | #include 33 | #endif 34 | 35 | typedef struct { 36 | #if HAVE_FFTW3_H 37 | fftw_plan r2c_plan; 38 | fftw_plan c2r_plan; 39 | #endif 40 | R_len_t N; 41 | area_indices *col_ind; 42 | area_indices *row_ind; 43 | unsigned *weights; 44 | } fft_plan; 45 | 46 | static inline unsigned valid_plan(const fft_plan *f, R_len_t N) { 47 | return (f->N == N); 48 | } 49 | 50 | -------------------------------------------------------------------------------- /src/masks.c: -------------------------------------------------------------------------------- 1 | /* 2 | * R package for Singular Spectrum Analysis 3 | * Copyright (c) 2009-2010 Anton Korobeynikov 4 | * Copyright (c) 2013 Konstantin Usevich 5 | * Copyright (c) 2014 Alex Shlemov 6 | * 7 | * This program is free software; you can redistribute it 8 | * and/or modify it under the terms of the GNU General Public 9 | * License as published by the Free Software Foundation; 10 | * either version 2 of the License, or (at your option) 11 | * any later version. 12 | * 13 | * This program is distributed in the hope that it will be 14 | * useful, but WITHOUT ANY WARRANTY; without even the implied 15 | * warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 16 | * PURPOSE. See the GNU General Public License for more details. 17 | * 18 | * You should have received a copy of the GNU General Public 19 | * License along with this program; if not, write to the 20 | * Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 21 | * MA 02139, USA. 22 | */ 23 | 24 | #include "masks.h" 25 | 26 | void free_area(area_indices *area) { 27 | if (area == NULL) { 28 | return; 29 | } 30 | R_Free(area->ind); 31 | R_Free(area); 32 | } 33 | 34 | unsigned *alloc_weights(SEXP weights) { 35 | if (weights == R_NilValue) { 36 | error("the weights should be precomputed."); 37 | } 38 | unsigned *wcopy = R_Calloc(length(weights), unsigned); 39 | memcpy(wcopy, INTEGER(weights), sizeof(unsigned) * length(weights)); 40 | return wcopy; 41 | } 42 | -------------------------------------------------------------------------------- /src/masks.h: -------------------------------------------------------------------------------- 1 | /* 2 | * R package for Singular Spectrum Analysis 3 | * Copyright (c) 2009-2010 Anton Korobeynikov 4 | * Copyright (c) 2013 Konstantin Usevich 5 | * Copyright (c) 2014 Alex Shlemov 6 | * 7 | * This program is free software; you can redistribute it 8 | * and/or modify it under the terms of the GNU General Public 9 | * License as published by the Free Software Foundation; 10 | * either version 2 of the License, or (at your option) 11 | * any later version. 12 | * 13 | * This program is distributed in the hope that it will be 14 | * useful, but WITHOUT ANY WARRANTY; without even the implied 15 | * warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 16 | * PURPOSE. See the GNU General Public License for more details. 17 | * 18 | * You should have received a copy of the GNU General Public 19 | * License along with this program; if not, write to the 20 | * Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 21 | * MA 02139, USA. 22 | */ 23 | 24 | #ifndef __MASKS_H__ 25 | #define __MASKS_H__ 26 | 27 | #include 28 | #include 29 | 30 | typedef struct { 31 | R_len_t num; 32 | R_len_t *ind; /* Indices in an N array or an Nx x Ny array */ 33 | } area_indices; 34 | 35 | void free_area(area_indices *area); 36 | unsigned *alloc_weights(SEXP weights); 37 | #endif /* __MASKS_H__ */ 38 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Rssa) 3 | 4 | test_check("Rssa") 5 | -------------------------------------------------------------------------------- /tests/testthat/test-1dssa.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Rssa) 3 | source(system.file("extdata", "common.test.methods.R", package = "Rssa")) 4 | context("1dSSA") 5 | 6 | test_that("1dSSA reconstruct test", { 7 | env <- new.env() 8 | load(system.file("extdata", "1dssa.testdata.rda", package = "Rssa"), envir = env) 9 | #names <- c("co2.td", "fr50.td", "fr1k.td", "fr50k.td", "fr50.nz.td", "fr1k.nz.td", "fr50k.nz.td") 10 | names <- c("co2.td", "fr50.td", "fr1k.td", "fr50.nz.td", "fr1k.nz.td") 11 | for (name in names) { 12 | test.test.data(what = "reconstruct", 13 | test.data = env[[name]]) 14 | } 15 | }) 16 | -------------------------------------------------------------------------------- /tests/testthat/test-2dssa.R: -------------------------------------------------------------------------------- 1 | library(testthat); 2 | library(Rssa); 3 | source(system.file("extdata", "common.test.methods.R", package = "Rssa")); 4 | context("2dSSA"); 5 | 6 | 7 | test_that("simple 2s-ssa test", { 8 | load(system.file("extdata", "2dssa.testdata.rda", package = "Rssa")); 9 | 10 | for (svd.method in c("nutrlan", "propack", "rspectra")) { 11 | ss <- ssa(field, kind = "2d-ssa", L = L, neig = 20, svd.method = svd.method); 12 | cur.rec <- reconstruct(ss, groups = groups); 13 | 14 | expect_equal(cur.rec, expected.reconstruction, 15 | label = sprintf("%s.2d.ssa reconstruction", svd.method)); 16 | } 17 | }); 18 | 19 | test_that("2d SSA works correctly with finite rank fields", { 20 | # Artificial field for 2dSSA 21 | mx <- outer(1:50, 1:50, 22 | function(i, j) sin(2*pi * i/17) * cos(2*pi * j/7) + exp(i/25 - j/20)) 23 | for (svd.method in c("eigen", "svd", "nutrlan", "propack", "rspectra", "primme")) { 24 | # Decompose 25 | s <- ssa(mx, kind = "2d-ssa", neig = 5, svd.method = svd.method) 26 | # Reconstruct 27 | r <- reconstruct(s, groups = list(1:5))$F1 28 | expect_equal(r, mx, label = sprintf("svd.method = %s", svd.method)) 29 | } 30 | }) 31 | -------------------------------------------------------------------------------- /tests/testthat/test-cadzow.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Rssa) 3 | source(system.file("extdata", "common.test.methods.R", package = "Rssa")) 4 | context("Cadzow") 5 | 6 | test_that("Cadzow limit is a series of finite rank", { 7 | s <- ssa(co2) 8 | eps <- sqrt(.Machine$double.eps) 9 | 10 | ranks <- 1:5 11 | for (rank in ranks) { 12 | cz <- cadzow(s, rank = rank) 13 | expect_true(high.rank.rate(cz, rank = rank, ssaobj = s) < eps) 14 | } 15 | }) 16 | 17 | .series.wsqdistance <- function(F1, F2, weights = 1) { 18 | mask <- weights > 0 19 | 20 | weights <- weights[mask] 21 | F1 <- as.vector(unlist(F1))[mask] 22 | F2 <- as.vector(unlist(F2))[mask] 23 | 24 | sum(weights * (F1-F2)^2) 25 | } 26 | 27 | test_that("Cadzow correction really works", { 28 | s <- ssa(co2) 29 | eps <- sqrt(.Machine$double.eps) 30 | delta <- 0.0001 31 | w <- .hweights(s) 32 | 33 | ranks <- 1:5 34 | for (rank in ranks) { 35 | cz <- cadzow(s, rank = rank, correct = TRUE) 36 | expect_true(.series.wsqdistance(cz, .F(s), w) < .series.wsqdistance((1 + delta) * cz, .F(s), w)) 37 | expect_true(.series.wsqdistance(cz, .F(s), w) < .series.wsqdistance((1 - delta) * cz, .F(s), w)) 38 | } 39 | }) 40 | 41 | test_that("Cadzow for Complex SSA", { 42 | set.seed(1) 43 | N <- 100 44 | v <- rnorm(N) + 1i * rnorm(N) 45 | s <- ssa(v, kind = "cssa") 46 | eps <- sqrt(.Machine$double.eps) 47 | 48 | ranks <- 1:5 49 | for (rank in ranks) { 50 | cz <- cadzow(s, rank = rank) 51 | expect_true(high.rank.rate(cz, rank = rank, ssaobj = s) < eps) 52 | } 53 | }) 54 | -------------------------------------------------------------------------------- /tests/testthat/test-circular1d.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Rssa) 3 | 4 | test_that("Circular Toeplitz SSA works correct for sines with finite circular rank", { 5 | N <- 640 6 | ii <- 3 * 2*pi * (1:N) / N 7 | 8 | Ls <- c(3, 10, 17, 50, 371) 9 | 10 | F <- sin(ii) 11 | for (L in Ls) { 12 | for (svd.method in c("eigen", "svd", "nutrlan", "propack", "primme", "rspectra")) { 13 | if (L < 10 && 14 | (svd.method %in% c("nutrlan", "rspectra"))) 15 | svd.method <- "propack" 16 | ss <- ssa(F, L = L, circular = TRUE, kind = "toeplitz-ssa", 17 | svd.method = svd.method, 18 | neig = 3) 19 | 20 | expect_true(sum(ss$sigma[-(1:2)]) < .Machine$double.eps^.25) 21 | expect_equal(reconstruct(ss, groups = list(1:2))$F1, F) 22 | } 23 | } 24 | }) 25 | 26 | test_that("Lcor computation works correctly for circular case", { 27 | Ls <- c(3, 10, 17, 50, 371, 500, 1000) 28 | Ns <- c(1005, 1500, 2000, 5000) 29 | 30 | set.seed(1) 31 | for (N in Ns) { 32 | for (L in Ls) { 33 | F <- rcauchy(N) 34 | C.exact <- convolve(F, F, conj = TRUE)[1:L] / N 35 | C <- Lcor(F, L = L, circular = TRUE) 36 | expect_equal(C, C.exact, 37 | info = sprintf("L = %d, N = %d", L, N)) 38 | } 39 | } 40 | }) 41 | -------------------------------------------------------------------------------- /tests/testthat/test-circular2d.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Rssa) 3 | 4 | context("Circular 2d SSA") 5 | test_that("Circular SSA works correct for sines with finite circular rank", { 6 | N <- 32 7 | M <- 36 8 | ii <- 3 * 2*pi * (1:N) / N 9 | jj <- 4 * 2*pi * (1:M) / M 10 | 11 | mx <- outer(ii, jj, function(i, j) sin(i) + sin(j)) 12 | 13 | ss <- ssa(mx, circular = TRUE, kind = "2d-ssa") 14 | 15 | expect_true(sum(ss$sigma[-(1:4)]) / sum(ss$sigma[1:4]) < .Machine$double.eps^.25) 16 | expect_equal(reconstruct(ss, groups = list(1:4))$F1, mx) 17 | }) 18 | 19 | test_that("Half-circular SSA works correct for sines with finite circular rank", { 20 | N <- 32 21 | M <- 36 22 | ii <- 3 * 2*pi * (1:N) / N 23 | jj <- (1:M) / M 24 | 25 | mx <- outer(ii, jj, function(i, j) sin(i) * exp(j)) 26 | 27 | ss <- ssa(mx, circular = c(TRUE, FALSE), kind = "2d-ssa") 28 | 29 | expect_true(sum(ss$sigma[-(1:2)]) / sum(ss$sigma[1:2]) < .Machine$double.eps^.25) 30 | expect_equal(reconstruct(ss, groups = list(1:2))$F1, mx) 31 | }) 32 | -------------------------------------------------------------------------------- /tests/testthat/test-forecast.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Rssa) 3 | source(system.file("extdata", "common.test.methods.R", package = "Rssa")) 4 | context("SSA forecast") 5 | 6 | test_that("1dSSA forecast test", { 7 | env <- new.env() 8 | load(system.file("extdata", "1dssa.testdata.rda", package = "Rssa"), envir = env) 9 | #names <- c("co2.td", "fr50.td", "fr1k.td", "fr50k.td", "fr50.nz.td", "fr1k.nz.td", "fr50k.nz.td") 10 | names <- c("co2.td", "fr50.td", "fr1k.td", "fr50.nz.td", "fr1k.nz.td") 11 | for (name in names) { 12 | test.test.data(what = c("rforecast", "vforecast"), 13 | test.data = env[[name]]) 14 | } 15 | }) 16 | 17 | test_that("toeplitz SSA forecast test", { 18 | env <- new.env() 19 | load(system.file("extdata", "toeplitz.testdata.rda", package = "Rssa"), envir = env) 20 | #names <- c("co2.td", "fr50.td", "fr1k.td", "fr50k.td", "fr50.nz.td", "fr1k.nz.td", "fr50k.nz.td") 21 | names <- c("co2.td", "fr50.td", "fr1k.td", "fr50.nz.td", "fr1k.nz.td") 22 | for (name in names) { 23 | test.test.data(what = c("rforecast", "vforecast"), 24 | test.data = env[[name]], 25 | tolerance = 1e-4) 26 | } 27 | }) 28 | -------------------------------------------------------------------------------- /tests/testthat/test-forecast.finite.rank.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Rssa) 3 | source(system.file("extdata", "common.test.methods.R", package = "Rssa")) 4 | source(system.file("extdata", "mssa.batching.R", package = "Rssa")) 5 | context("2dSSA") 6 | 7 | test_that("All kinds of 1d-forecasting and reconstruction work correctly for finite rank series", { 8 | set.seed(1) 9 | N <- 71 10 | sigma <- 0 11 | Ls <- c(12, 24, 36, 48, 60) 12 | len <- 400 13 | 14 | examples.all <- list(list(xs = list(cosine(N + len, 30, 12), cosine(N + len, 20, 12, pi / 4)), ssa.dim = 2, mssa.dim = 2, cssa.dim = 2), 15 | list(xs = list(cosine(N + len, 30, 12), cosine(N + len, 30, 12, pi / 2)), ssa.dim = 2, mssa.dim = 2, cssa.dim = 1), 16 | list(xs = list(cosine(N + len, 30, 12), cosine(N + len, 20, 8, pi / 4)), ssa.dim = 2, mssa.dim = 4, cssa.dim = 4)) 17 | 18 | examples.mssa.dlen <- list(list(xs = list(cosine(N + len + 10, 30, 12), cosine(N + len, 20, 12, pi / 4)), mssa.dim = 2), 19 | list(xs = list(cosine(N + len + 10, 30, 12), cosine(N + len, 30, 12, pi / 2)), mssa.dim = 2), 20 | list(xs = list(cosine(N + len + 10, 30, 12), cosine(N + len, 20, 8, pi / 4)), mssa.dim = 4)) 21 | 22 | for (svd.method in c("svd", "eigen", "nutrlan", "propack", "primme")) { 23 | rec.all <- all.MSE(examples.all, 24 | N = 1, 25 | sigma = sigma, 26 | Ls = Ls, 27 | type = "reconstruct", 28 | len = len, 29 | svd.method = svd.method, 30 | eval.sd = FALSE) 31 | 32 | 33 | expect_true(all(abs(unlist(rec.all)) < .Machine$double.eps^.5), 34 | label = sprintf("Reconstruction, series of same length, svd.method = %s", svd.method)) 35 | 36 | fore.all <- all.MSE(examples.all, 37 | N = 1, 38 | sigma = sigma, 39 | Ls = Ls, 40 | type = "forecast", 41 | len = len, 42 | svd.method = svd.method, 43 | eval.sd = FALSE) 44 | 45 | expect_true(all(abs(unlist(fore.all)) < .Machine$double.eps^.5), 46 | label = sprintf("Forecast, series of same length, svd.method = %s", svd.method)) 47 | 48 | expect_true(all(abs(unlist(fore.all)) < .Machine$double.eps^.5), 49 | label = sprintf("MSSA reconstruction, series of different lengths, svd.method = %s", svd.method)) 50 | 51 | 52 | fore.mssa.dlen <- all.MSE(examples.mssa.dlen, 53 | kinds = c("r-mssa-row", "r-mssa-column", "v-mssa-row", "v-mssa-column"), 54 | N = 1, 55 | sigma = sigma, 56 | Ls = Ls, 57 | type = "forecast", 58 | len = len, 59 | svd.method = svd.method, 60 | eval.sd = FALSE) 61 | expect_true(all(abs(unlist(fore.all)) < .Machine$double.eps^.5), 62 | label = sprintf("MSSA forecast, series of different lengths, svd.method = %s", svd.method)) 63 | } 64 | }) 65 | -------------------------------------------------------------------------------- /tests/testthat/test-is.fft.plan.R: -------------------------------------------------------------------------------- 1 | library(testthat); 2 | library(Rssa); 3 | source(system.file("extdata", "common.test.methods.R", package = "Rssa")); 4 | context("is.fft.plan"); 5 | 6 | test_that("is.fft.plan-check works correctly", { 7 | expect_true(is.fft.plan(fft.plan.1d(42, L = 12))); 8 | 9 | expect_false(is.fft.plan(42)); 10 | expect_false(is.fft.plan(new.hmat(1:42))); 11 | 12 | regexp <- "pointer provided is not a fft plan"; 13 | 14 | no.fft.plan <- 1; 15 | expect_error(new.hmat(1:42, L = 10, fft.plan = no.fft.plan), regexp = regexp); 16 | expect_error(.Call("hankelize_one_fft", 1:10, 1:10, fft.plan = no.fft.plan), regexp = regexp); 17 | expect_error(.hankelize.multi(as.matrix(1:10), as.matrix(1:10), fft.plan = no.fft.plan), regexp = regexp); 18 | }); 19 | -------------------------------------------------------------------------------- /tests/testthat/test-marginalL.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Rssa) 3 | source(system.file("extdata", "common.test.methods.R", package = "Rssa")) 4 | context("1dSSA") 5 | 6 | test_that("1dSSA works correctly for marginal L values", { 7 | Ns <- c(15, 150, 200) 8 | 9 | set.seed(1) 10 | for (N in Ns) { 11 | for (L in c(1, N)) { 12 | for (svd.method in c("propack", "eigen", "svd")) { 13 | F <- rcauchy(N) 14 | ss <- ssa(F, L = L, svd.method = svd.method) 15 | 16 | expect_equal(wnorm(ss), sqrt(sum(F^2)), 17 | info = sprintf("L = %d, N = %d, svd.method = %s", L, N, svd.method)) 18 | expect_equal(reconstruct(ss, 1)$F1, F, 19 | info = sprintf("L = %d, N = %d, svd.method = %s", L, N, svd.method)) 20 | } 21 | } 22 | } 23 | }) 24 | 25 | test_that("Toeplitz SSA works correctly for marginal L values", { 26 | Ns <- c(15, 150, 200) 27 | 28 | set.seed(1) 29 | for (N in Ns) { 30 | for (L in 1) { 31 | for (svd.method in c("propack", "eigen", "svd")) { 32 | F <- rcauchy(N) 33 | ss <- ssa(F, kind = "toeplitz-ssa", L = L, svd.method = svd.method) 34 | 35 | expect_equal(wnorm(ss), sqrt(sum(F^2)), 36 | info = sprintf("L = %d, N = %d, svd.method = %s", L, N, svd.method)) 37 | expect_equal(reconstruct(ss, 1)$F1, F, 38 | info = sprintf("L = %d, N = %d, svd.method = %s", L, N, svd.method)) 39 | } 40 | } 41 | } 42 | }) 43 | 44 | test_that("Marginal case for shaped 2dSSA", { 45 | s <- ssa(rbind(rep(1, 20), c(rep(1, 10), rep(NA, 10))), L = c(2, 10), kind = "2d-ssa", neig = 5) 46 | expect_equal(dim(s$fmask), c(1, 11)) 47 | expect_equal(s$sigma[1:5]^2, c(20, 0, 0, 0, 0)) 48 | 49 | 50 | s <- ssa(cbind(rep(1, 20), c(rep(1, 10), rep(NA, 10))), L = c(10, 2), kind = "2d-ssa", neig = 5) 51 | expect_equal(dim(s$fmask), c(11, 1)) 52 | expect_equal(s$sigma[1:5]^2, c(20, 0, 0, 0, 0)) 53 | }) 54 | -------------------------------------------------------------------------------- /tests/testthat/test-mssa-shaped.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Rssa) 3 | context("MSSA") 4 | 5 | new.hmat.striped.old <- function(F, L) { 6 | N <- sapply(F, length); K <- N - L + 1 7 | 8 | h <- lapply(seq_along(N), 9 | function(idx) new.hmat(F[[idx]], L = L)) 10 | b <- c(0, cumsum(K)) 11 | matmul <- function(v) { 12 | res <- numeric(L) 13 | for (idx in seq_along(h)) { 14 | res <- res + hmatmul(h[[idx]], v[(b[idx]+1):b[idx+1]], transposed = FALSE) 15 | } 16 | res 17 | } 18 | tmatmul <- function(v) unlist(lapply(h, hmatmul, v = v, transposed = TRUE)) 19 | 20 | extmat(matmul, tmatmul, nrow = L, ncol = sum(K)) 21 | } 22 | 23 | as.matrix.extmat <- function (x) { 24 | apply(diag(extmat.ncol(x)), 2, ematmul, emat = x) 25 | } 26 | 27 | test_that("new.hmat.striped and new.hmat.striped.old produce equal matrices", { 28 | set.seed(1) 29 | Ns <- list(10, 11, c(113, 113), 100, c(10, 14, 13, 11, 17)) 30 | for (N in Ns) { 31 | Ls <- c(2, 4, 7, 9) 32 | F <- lapply(N, rnorm) 33 | 34 | for (L in Ls) { 35 | new <- .hmat.striped(ssa(F, L = L, kind = "mssa", force.decompose = FALSE)) 36 | old <- new.hmat.striped.old(F, L) 37 | 38 | expect_equal(hbhrows(new), extmat.nrow(old)) 39 | expect_equal(hbhcols(new), extmat.ncol(old)) 40 | 41 | 42 | for (i in 1:42) { 43 | v <- rnorm(hbhcols(new)) 44 | u <- rnorm(hbhrows(new)) 45 | 46 | expect_equal(hbhmatmul(new, v, transposed = FALSE), 47 | ematmul(old, v, transposed = FALSE)) 48 | expect_equal(hbhmatmul(new, u, transposed = TRUE), 49 | ematmul(old, u, transposed = TRUE)) 50 | } 51 | } 52 | } 53 | }) 54 | 55 | test_that("shaped MSSA works correct with gaps", { 56 | v1 <- 1:100 57 | v2 <- 1:200 58 | v1[60:63] <- NA 59 | v2[50:55] <- NA 60 | v1[1:3] <- NA 61 | v2[198:200] <- NA 62 | 63 | v <- list(v1, v2) 64 | r <- 2 65 | 66 | ss <- ssa(v, L = 10, kind = "mssa") 67 | expect_equal(reconstruct(ss, groups = list(1:r))$F1, v) 68 | 69 | w.exp <- structure(c(1, 0.0372400664289056, 0.0372400664289056, 1), 70 | .Dim = c(2L, 2L), 71 | .Dimnames = list(c("F1", "F2"), c("F1", "F2")), 72 | class = "wcor.matrix") 73 | expect_equal(wcor(ss, 1:r), w.exp) 74 | }) 75 | 76 | test_that("shaped MSSA works correct with gaps and uncovered points", { 77 | v1 <- 1:100 78 | v2 <- 1:200 79 | v1[60:63] <- NA 80 | v2[50:55] <- NA 81 | v1[3:5] <- NA 82 | v2[197:199] <- NA 83 | 84 | L <- 10 85 | v <- list(v1, v2) 86 | r <- 2 87 | v.res <- v 88 | v.res[[1]][1:2] <- NA 89 | v.res[[2]][200] <- NA 90 | 91 | ss <- ssa(v, L = L, kind = "mssa") 92 | expect_equal(reconstruct(ss, groups = list(1:r))$F1, v.res) 93 | 94 | w.exp <- structure(c(1, 0.0365310054106304, 0.0365310054106304, 1), 95 | .Dim = c(2L, 2L), 96 | .Dimnames = list(c("F1", "F2"), c("F1", "F2")), 97 | class = "wcor.matrix") 98 | expect_equal(wcor(ss, 1:r), w.exp) 99 | }) 100 | -------------------------------------------------------------------------------- /tests/testthat/test-mssa.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Rssa) 3 | 4 | context("Multichannel SSA AustralianWine multitest") 5 | 6 | load(system.file("extdata", "mssa.testdata.rda", package = "Rssa")) 7 | 8 | for (testcase.name in names(testcases)) {{{ 9 | testcase <- testcases[[testcase.name]] 10 | 11 | ssa.data <- testcase$ssa.data 12 | L <- testcase$L 13 | len <- testcase$len 14 | 15 | test_that(sprintf("Real data MSSA reconstruction test (testcase: %s)", testcase.name), { 16 | for (svd.method in c("svd", "eigen", "nutrlan", "propack", "rspectra")) { 17 | L <- testcase$L 18 | s <- ssa(testcase$ssa.data, L = L, kind = "mssa", 19 | neig = 15, 20 | svd.method = svd.method) 21 | 22 | rec <- reconstruct(s, 23 | groups = list(Trend = c(1, 6), 24 | Seasonality = c(2:5, 7:12))) 25 | expect_equal(rec, testcase$rec, 26 | label = sprintf("%s.mssa reconstruction", svd.method)) 27 | } 28 | }) 29 | 30 | test_that(sprintf("Real data MSSA forecast test (testcase: %s)", testcase.name), { 31 | s <- ssa(ssa.data, L = L, kind = "mssa", 32 | neig = 15, 33 | svd.method = "propack") 34 | vrfore <- vforecast(s, 35 | groups = list(1, 1:12), 36 | direction = "row", 37 | len = len, only.new = FALSE) 38 | expect_equal(vrfore, testcase$vrfore, 39 | label = "mssa row-vector forecast", 40 | tolerance = 1e-6) 41 | 42 | vcfore <- vforecast(s, 43 | groups = list(1, 1:12), 44 | direction = "column", 45 | len = len, only.new = FALSE) 46 | expect_equal(vcfore, testcase$vcfore, 47 | label = "mssa column-vector forecast", 48 | tolerance = 1e-6) 49 | 50 | rrofore <- rforecast(s, 51 | groups = list(1, 1:12), 52 | direction = "row", 53 | base = "original", 54 | len = len, only.new = FALSE) 55 | expect_equal(rrofore, testcase$rrofore, 56 | label = "mssa row-reccurent forecast (base = original)", 57 | tolerance = 1e-6) 58 | 59 | rrrfore <- rforecast(s, 60 | groups = list(1, 1:12), 61 | direction = "row", 62 | base = "reconstructed", 63 | len = len, only.new = FALSE) 64 | expect_equal(rrrfore, testcase$rrrfore, 65 | label = "mssa row-reccurent forecast (base = reconstructed)", 66 | tolerance = 1e-6) 67 | 68 | rcofore <- rforecast(s, 69 | groups = list(1, 1:12), 70 | direction = "column", 71 | base = "original", 72 | len = len, only.new = FALSE) 73 | expect_equal(rcofore, testcase$rcofore, 74 | label = "mssa column-reccurent forecast (base = original)", 75 | tolerance = 1e-6) 76 | 77 | rcrfore <- rforecast(s, 78 | groups = list(1, 1:12), 79 | direction = "column", 80 | base = "reconstructed", 81 | len = len, only.new = FALSE) 82 | expect_equal(rcrfore, testcase$rcrfore, 83 | label = "mssa column-reccurent forecast (base = reconstructed)", 84 | tolerance = 1e-6) 85 | }) 86 | }}} 87 | -------------------------------------------------------------------------------- /tests/testthat/test-ndssa.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Rssa) 3 | context("n-dimensional SSA") 4 | 5 | mouter <- function(xs, FUN) { 6 | grid <- do.call(expand.grid, xs) 7 | args <- as.list(grid) 8 | names(args) <- names(xs) 9 | res <- do.call(FUN, args) 10 | dim(res) <- sapply(xs, length) 11 | 12 | res 13 | } 14 | 15 | 16 | test_that("nd-SSA works for 3d arrays of the finite rank", { 17 | sssin <- function(x, y, z) sin(x + y + z) 18 | r <- 2 19 | 20 | x <- mouter(list(1:10, 1:9, 1:12), sssin) 21 | ss <- ssa(x, kind = "nd-ssa") 22 | 23 | rec <- reconstruct(ss, groups = list(1:r))$F1 24 | 25 | expect_equal(rec, x) 26 | }) 27 | 28 | test_that("nd-SSA works for 4d arrays of the finite rank", { 29 | ssssin <- function(x, y, z, t) sin(x + y + z + t) 30 | r <- 2 31 | 32 | x <- mouter(list(1:10, 1:9, 1:12, 1:5), ssssin) 33 | ss <- ssa(x) 34 | 35 | rec <- reconstruct(ss, groups = list(1:r))$F1 36 | 37 | expect_equal(rec, x) 38 | }) 39 | 40 | test_that("igapfill works exactly for finite-rank 3d arrays", { 41 | sssin <- function(x, y, z) sin(x + y + z) 42 | r <- 2 43 | 44 | original <- mouter(list(1:10, 1:9, 1:12), sssin) 45 | 46 | x <- original 47 | x[1] <- x[10] <- x[70] <- NA 48 | 49 | ss <- ssa(x) 50 | g <- igapfill(ss, groups = list(1:r), tol = 1e-7) 51 | 52 | expect_equal(g, original, tolerance = 1e-5) 53 | }) 54 | 55 | test_that("igapfill works exactly for finite-rank 4d arrays", { 56 | ssssin <- function(x, y, z, t) sin(x + y + z + t) 57 | r <- 2 58 | 59 | original <- mouter(list(1:10, 1:9, 1:12, 1:5), ssssin) 60 | 61 | x <- original 62 | x[1] <- x[10] <- x[70] <- NA 63 | 64 | ss <- ssa(x) 65 | g <- igapfill(ss, groups = list(1:r), tol = 1e-7) 66 | 67 | expect_equal(g, original, tolerance = 1e-5) 68 | }) 69 | -------------------------------------------------------------------------------- /tests/testthat/test-ossa.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Rssa) 3 | context("OSSA") 4 | 5 | test_that("I-OSSA separates 3 sines exactly", { 6 | N <- 150 7 | L <- 70 8 | 9 | omega1 <- 0.05 10 | omega2 <- 0.06 11 | omega3 <- 0.07 12 | 13 | F1.real <- 4*sin(2*pi*omega1*(1:N)) 14 | F2.real <- 2*sin(2*pi*omega2*(1:N)) 15 | F3.real <- sin(2*pi*omega3*(1:N)) 16 | F <- F1.real + F2.real + F3.real 17 | ss <- ssa(F, L) 18 | ioss <- iossa(ss, nested.groups = list(1:2, 3:4, 5:6), maxiter = 200, tol = 1e-8, kappa = NULL, trace = FALSE) 19 | 20 | rec <- reconstruct(ioss, groups = ioss$iossa.groups) 21 | expect_equal(rec$F1, F1.real, tolerance = 1e-6) 22 | expect_equal(rec$F2, F2.real, tolerance = 1e-6) 23 | expect_equal(rec$F3, F3.real, tolerance = 1e-6) 24 | }) 25 | 26 | test_that("I-OSSA and F-OSSA", { 27 | N <- 200 28 | L <- 100 29 | omega1 <- 0.07 30 | omega2 <- 0.06 31 | 32 | F1.real <- 2*sin(2*pi*omega1*(1:N)) 33 | F2.real <- 2*sin(2*pi*omega2*(1:N)) 34 | ss <- ssa(F1.real + F2.real, L, svd.method = "eigen", neig = 28) 35 | fss <- fossa(ss, nested.groups = list(c(1,2), c(3,4)), kappa = Inf, normalize = FALSE) 36 | ioss <- iossa(fss, nested.groups = list(c(1,2), c(3,4)), maxiter = 1000, kappa = 2, tol = 1e-8, trace = FALSE) 37 | 38 | rec <- reconstruct(ioss, groups = ioss$iossa.groups) 39 | expect_equal(rec$F1, F1.real, tolerance = 1e-6) 40 | expect_equal(rec$F2, F2.real, tolerance = 1e-6) 41 | 42 | wc <- owcor(ioss, groups = list(1:2, 3:4)) 43 | expect_equivalent(wc[,], diag(2)) 44 | 45 | expect_true(ioss$iossa.result$conv) 46 | }) 47 | 48 | test_that("FOSSA", { 49 | N <- 150 50 | L <- 70 51 | omega1 <- 1/5 52 | omega2 <- 1/10 53 | 54 | F1.real <- 2*sin(2*pi*omega1*(1:N)) 55 | F2.real <- 2*sin(2*pi*omega2*(1:N)) 56 | v <- F1.real + F2.real 57 | ss <- ssa(v, L, svd.method = "eigen") 58 | fss <- fossa(ss, nested.groups = list(1:2, 3:4), gamma = Inf, normalize = FALSE) 59 | wc <- wcor(fss, groups = list(1:2, 3:4)) 60 | 61 | expect_equivalent(wc[,], diag(2)) 62 | 63 | rec <- reconstruct(fss, groups = list(1:2, 3:4)) 64 | expect_equal(rec$F1, F1.real, tolerance = 1e-6) 65 | expect_equal(rec$F2, F2.real, tolerance = 1e-6) 66 | }) 67 | 68 | test_that ("OSSA + PSSA forecast is correct", { 69 | N <- 100 70 | len <- 20 71 | tt <- seq_len(N + len) 72 | F <- 0.01 * tt^2 + 10 * sin(2*pi * tt / 10) 73 | pss <- ssa(F[seq_len(N)], row.projector = "centering", column.projector = "centering") 74 | ios <- iossa(pss, nested.groups = list(c(1:2), c(3:5)), trace = FALSE) 75 | fos <- fossa(ios, nested.groups = ios$iossa.groups, gamma = 1000) 76 | 77 | rforec.ios <- rforecast(ios, groups = list(1:5), len = len, only.new = FALSE) 78 | vforec.ios <- vforecast(ios, groups = list(1:5), len = len, only.new = FALSE) 79 | expect_equal(rforec.ios, F) 80 | expect_equal(vforec.ios, F) 81 | 82 | rforec.fos <- rforecast(fos, groups = list(1:5), len = len, only.new = FALSE) 83 | vforec.fos <- vforecast(fos, groups = list(1:5), len = len, only.new = FALSE) 84 | expect_equal(rforec.fos, F) 85 | expect_equal(vforec.fos, F) 86 | }) 87 | 88 | test_that("Shaped I-OSSA separates 3 sines exactly", { 89 | N <- 150 90 | L <- 40 91 | 92 | omega1 <- 0.05 93 | omega2 <- 0.06 94 | omega3 <- 0.07 95 | 96 | tt <- 1:N 97 | tt[c(1, L+4, L+5, L+6)] <- NA 98 | 99 | F1.real <- 4*sin(2*pi * omega1 * tt) 100 | F2.real <- 2*sin(2*pi * omega2 * tt) 101 | F3.real <- sin(2*pi * omega3 * tt) 102 | F <- F1.real + F2.real + F3.real 103 | ss <- ssa(F, L) 104 | ioss <- iossa(ss, nested.groups = list(1:2, 3:4, 5:6), maxiter = 1000, tol = 1e-8, kappa = NULL, trace = FALSE) 105 | 106 | rec <- reconstruct(ioss, groups = ioss$iossa.groups) 107 | expect_equal(rec$F1, F1.real, tolerance = 1e-6) 108 | expect_equal(rec$F2, F2.real, tolerance = 1e-6) 109 | expect_equal(rec$F3, F3.real, tolerance = 1e-6) 110 | }) 111 | 112 | test_that("2D I-OSSA separates finite rank fields exactly", { 113 | mx1 <- outer(1:50, 1:50, 114 | function(i, j) exp(i/25 - j/20)) 115 | mx2 <- outer(1:50, 1:50, 116 | function(i, j) sin(2*pi * i/17) * cos(2*pi * j/7)) 117 | 118 | ss <- ssa(mx1 + mx2, kind = "2d-ssa") 119 | ioss <- iossa(ss, nested.groups = list(1, 2:5), maxiter = 1000, tol = 1e-8, kappa = NULL, trace = FALSE) 120 | 121 | rec <- reconstruct(ioss, groups = ioss$iossa.groups) 122 | expect_equal(rec$F1, mx1, tolerance = 1e-6) 123 | expect_equal(rec$F2, mx2, tolerance = 1e-6) 124 | }) 125 | 126 | test_that("Shaped 2D I-OSSA separates finite rank fields exactly", { 127 | mx1 <- outer(1:50, 1:50, 128 | function(i, j) exp(i/25 - j/20)) 129 | mx2 <- outer(1:50, 1:50, 130 | function(i, j) sin(2*pi * i/17) * cos(2*pi * j/7)) 131 | 132 | mask <- matrix(TRUE, 50, 50) 133 | mask[23:25, 23:27] <- FALSE 134 | mask[1:2, 1] <- FALSE 135 | mask[50:49, 1] <- FALSE 136 | mask[1:2, 50] <- FALSE 137 | 138 | mx1[!mask] <- mx2[!mask] <- NA 139 | 140 | ss <- ssa(mx1 + mx2, kind = "2d-ssa", L = c(10, 10)) 141 | ioss <- iossa(ss, nested.groups = list(1, 2:5), maxiter = 1000, tol = 1e-8, kappa = NULL, trace = FALSE) 142 | 143 | rec <- reconstruct(ioss, groups = ioss$iossa.groups) 144 | expect_equal(rec$F1, mx1, tolerance = 1e-6) 145 | expect_equal(rec$F2, mx2, tolerance = 1e-6) 146 | }) 147 | 148 | test_that("MSSA-I-OSSA separates finite rank multivariate time series exactly", { 149 | N1 <- 150 150 | N2 <- 120 151 | L <- 40 152 | 153 | omega1 <- 0.05 154 | omega2 <- 0.06 155 | 156 | tt1 <- 1:N1 157 | tt2 <- 1:N2 158 | F1 <- list(2 * sin(2*pi * omega1 * tt1), cos(2*pi * omega1 * tt2)) 159 | F2 <- list(sin(2*pi * omega2 * tt1), cos(2*pi * omega2 * tt2)) 160 | 161 | F <- list(F1[[1]] + F2[[1]], F1[[2]] + F2[[2]]) 162 | 163 | ss <- ssa(F, kind = "mssa") 164 | ioss <- iossa(ss, nested.groups = list(1:2, 3:4), maxiter = 1000, tol = 1e-8, kappa = NULL, trace = FALSE) 165 | 166 | rec <- reconstruct(ioss, groups = ioss$iossa.groups) 167 | expect_equal(rec$F1, F1, tolerance = 1e-6) 168 | expect_equal(rec$F2, F2, tolerance = 1e-6) 169 | }) 170 | -------------------------------------------------------------------------------- /tests/testthat/test-serialize.R: -------------------------------------------------------------------------------- 1 | library(testthat); 2 | library(Rssa); 3 | source(system.file("extdata", "common.test.methods.R", package = "Rssa")); 4 | context("Serialization"); 5 | 6 | test_that("Serialization works correctly", { 7 | Ls <- c(17, 100, 222, 234); 8 | kinds <- c("1d-ssa", "toeplitz-ssa"); 9 | svd.methods <- c("eigen", "nutrlan", "propack", "svd"); 10 | groups <- list(1, 1:2, 3:5, 1:5); 11 | len <- 100; 12 | neig = 15; 13 | 14 | for (kind in kinds) for (svd.method in svd.methods) { 15 | if (identical(kind, "toeplitz-ssa") && identical(svd.method, "svd")) 16 | next; 17 | 18 | for (L in Ls) { 19 | suppressWarnings(ss <- ssa(co2, L = L, kind = kind, svd.method = svd.method, neig = neig, force.decompose = TRUE)); 20 | 21 | # Serialize ssa-object to raw vector 22 | rw <- serialize(ss, connection = NULL); 23 | 24 | # Unserialize ssa-object 25 | ss.uns <- unserialize(rw); 26 | 27 | expect_equal(ss.uns$U, ss$U); 28 | expect_equal(ss.uns$V, ss$V); 29 | expect_equal(ss.uns$sigma, ss$sigma); 30 | 31 | expect_equal(reconstruct(ss.uns, groups = groups), reconstruct(ss, groups = groups)); 32 | expect_equal(rforecast(ss.uns, groups = groups, len = len, base = "original"), 33 | rforecast(ss, groups = groups, len = len, base = "original")); 34 | 35 | expect_equal(rforecast(ss.uns, groups = groups, len = len, base = "reconstructed"), 36 | rforecast(ss, groups = groups, len = len, base = "reconstructed")); 37 | 38 | expect_equal(vforecast(ss.uns, groups = groups, len = len), 39 | vforecast(ss, groups = groups, len = len)); 40 | } 41 | } 42 | }); 43 | 44 | test_that("Serialization works correctly for 2d SSA", { 45 | N <- c(110, 117); 46 | 47 | set.seed(1); 48 | field <- matrix(rnorm(prod(N)), N[1], N[2]); 49 | 50 | Ls <- list(c(17, 16), c(50, 56)); 51 | svd.methods <- c("nutrlan", "propack"); 52 | groups <- list(1, 1:2, 3:5, 1:5, 1:10); 53 | neig = 15; 54 | 55 | for (svd.method in svd.methods) { 56 | for (L in Ls) { 57 | set.seed(1); 58 | ss <- ssa(field, L = L, kind = "2d-ssa", svd.method = svd.method, neig = neig, force.decompose = TRUE); 59 | 60 | # Serialize ssa-object to raw vector 61 | rw <- serialize(ss, connection = NULL); 62 | 63 | # Unserialize ssa-object 64 | ss.uns <- unserialize(rw); 65 | 66 | expect_equal(ss.uns$U, ss$U); 67 | expect_equal(ss.uns$V, ss$V); 68 | expect_equal(ss.uns$sigma, ss$sigma); 69 | 70 | expect_equal(reconstruct(ss.uns, groups = groups), reconstruct(ss, groups = groups)); 71 | } 72 | } 73 | }); 74 | -------------------------------------------------------------------------------- /tests/testthat/test-sh1dssa.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Rssa) 3 | source(system.file("extdata", "common.test.methods.R", package = "Rssa")) 4 | 5 | context("Shaped 1dSSA") 6 | 7 | test_that("Shaped 1d SSA works correctly", { 8 | set.seed(1) 9 | N <- 200 10 | L <- 40 11 | rank <- 6 12 | F <- rnorm(N) 13 | F[50] <- F[101] <- F[143] <- NA 14 | 15 | wmask0 <- wmask1 <- wmask2 <- rep(TRUE, L) 16 | wmask1[2] <- wmask1[30] <- wmask2[23] <- FALSE 17 | wmasks <- list(wmask0, wmask1, wmask2) 18 | for (wmask in wmasks) { 19 | circulars <- c(FALSE, TRUE) 20 | for (circular in circulars) { 21 | s2 <- ssa(F, L = c(L, 1), wmask = as.matrix(wmask), 22 | kind = "2d-ssa", circular = c(circular, FALSE), neig = rank + 1) 23 | 24 | svd.methods <- c("svd", "nutrlan", "propack", "eigen", "rspectra") 25 | for (svd.method in svd.methods) { 26 | s1 <- ssa(F, L = L, wmask = wmask, 27 | svd.method = svd.method, neig = rank + 1, circular = circular) 28 | 29 | for (r in seq_len(rank)) { 30 | expect_equal(reconstruct(s1, r)$F1, reconstruct(s2, r)$F1, 31 | info = sprintf("component = %d, svd.method = %s", r, svd.method)) 32 | } 33 | } 34 | } 35 | } 36 | }) 37 | -------------------------------------------------------------------------------- /tests/testthat/test-toeplitz.R: -------------------------------------------------------------------------------- 1 | library(testthat); 2 | library(Rssa); 3 | source(system.file("extdata", "common.test.methods.R", package = "Rssa")); 4 | context("Toeplitz SSA"); 5 | 6 | test_that("toeplitz SSA reconstruct test", { 7 | env <- new.env(); 8 | load(system.file("extdata", "toeplitz.testdata.rda", package = "Rssa"), envir = env); 9 | #names <- c("co2.td", "fr50.td", "fr1k.td", "fr50k.td", "fr50.nz.td", "fr1k.nz.td", "fr50k.nz.td"); 10 | names <- c("co2.td", "fr50.td", "fr1k.td", "fr50.nz.td", "fr1k.nz.td"); 11 | for (name in names) { 12 | test.test.data(what = "reconstruct", 13 | test.data = env[[name]]); 14 | } 15 | }); 16 | -------------------------------------------------------------------------------- /tests/testthat/test-wcor.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Rssa) 3 | source(system.file("extdata", "common.test.methods.R", package = "Rssa")) 4 | 5 | context("W-correlations") 6 | 7 | test_that("wcor method returns proper matrix", { 8 | set.seed(1) 9 | N <- 48 10 | L <- 24 11 | v <- rnorm(N) 12 | ss <- ssa(v, L = L, svd.method = "eigen") 13 | w <- wcor(ss) 14 | 15 | expect_true(all(abs(w) <= 1)) 16 | expect_true(all(diag(w) == 1)) 17 | expect_equal(w, t(w)) 18 | }) 19 | 20 | test_that("wcor method returns proper matrix for 2dSSA", { 21 | set.seed(1) 22 | N <- c(48, 49) 23 | L <- c(24, 25) 24 | mx <- matrix(rnorm(prod(N)), N[1], N[2]) 25 | ss <- ssa(mx, L = L, kind = "2d-ssa", svd.method = "propack", neig = 10) 26 | w <- wcor(ss) 27 | 28 | expect_true(all(abs(w) <= 1)) 29 | expect_true(all(diag(w) == 1)) 30 | expect_equal(w, t(w)) 31 | }) 32 | 33 | test_that("wcor method return correct matrix for 2dSSA case", { 34 | env <- new.env() 35 | load(file = system.file("extdata", "wcor.2dssa.testdata.rda", package = "Rssa"), envir = env) 36 | 37 | set.seed(1) 38 | mx <- outer(1:50, 1:50, 39 | function(i, j) sin(2*pi * i/17) * cos(2*pi * j/7) + exp(i/25 - j/20)) + 40 | rnorm(50^2, sd = 0.1) 41 | 42 | for (svd.method in c("nutrlan", "propack", "rspectra")) { 43 | s <- ssa(mx, kind = "2d-ssa", svd.method = svd.method) 44 | w <- wcor(s, groups = 1:12) 45 | 46 | expect_equal(w, env$w, 47 | info = sprintf("wcor.2d.ssa.%s", svd.method)) 48 | } 49 | }) 50 | 51 | test_that("Hankel weights computed correctly for marginal cases", { 52 | expect_equal(.hweights.default(1, 1), 1) 53 | expect_equal(.hweights.default(10, 1), rep(1, 10)) 54 | expect_equal(.hweights.default(10, 10), rep(1, 10)) 55 | }) 56 | 57 | test_that("Hankel weights computed correctly for common case", { 58 | expect_equal(.hweights.default(5, 2), c(1, 2, 2, 2, 1)) 59 | expect_equal(.hweights.default(5, 3), c(1, 2, 3, 2, 1)) 60 | expect_equal(.hweights.default(5, 4), c(1, 2, 2, 2, 1)) 61 | }) 62 | 63 | test_that("`wnorm' works correctly for MSSA", { 64 | Nss <- list(20, 65 | c(17, 17), 66 | 14, 67 | c(14, 32, 36, 36, 31, 37)) 68 | 69 | set.seed(1) 70 | for (Ns in Nss) { 71 | f <- lapply(Ns, rnorm) 72 | 73 | sss <- lapply(f, ssa, kind = "1d-ssa", L = 13, 74 | force.decompose = FALSE) 75 | ss <- ssa(f, kind = "mssa", L = 13, 76 | force.decompose = FALSE) 77 | 78 | w1 <- sum(sapply(sss, wnorm) ^ 2) 79 | w2 <- wnorm(ss) ^ 2 80 | expect_equal(w2, w1, label = sprintf("lengths: %s", 81 | paste0(Ns, collapse = ", "))) 82 | } 83 | }) 84 | -------------------------------------------------------------------------------- /tests/testthat/test-wossa.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Rssa) 3 | source(system.file("extdata", "common.test.methods.R", package = "Rssa")) 4 | context("Weighted Oblique SSA and Cadzow") 5 | 6 | test_that("Weighted Oblique Cadzow limit is a series of finite rank", { 7 | L <- 228 8 | row.oblique <- c(rep(1, 22), rep(0.12, 197), rep(1, 22)) 9 | column.oblique <- rep(1, L) 10 | s <- ssa(co2, L = L, row.oblique = row.oblique, column.oblique = column.oblique) 11 | eps <- sqrt(.Machine$double.eps) 12 | 13 | ranks <- 1:5 14 | for (rank in ranks) { 15 | cz <- cadzow(s, rank = rank) 16 | expect_true(high.rank.rate(cz, rank = rank, ssaobj = s) < eps) 17 | } 18 | }) 19 | 20 | .series.wsqdistance <- function(F1, F2, weights = rep(1, length(F1))) { 21 | mask <- weights > 0 22 | 23 | weights <- weights[mask] 24 | F1 <- as.vector(unlist(F1))[mask] 25 | F2 <- as.vector(unlist(F2))[mask] 26 | 27 | sum(weights * (F1-F2)^2) 28 | } 29 | 30 | test_that("Weighted Oblique Cadzow gives closer answer than Basic Cadzow", { 31 | L <- 228 32 | row.oblique <- c(rep(1, 22), rep(0.12, 197), rep(1, 22)) 33 | column.oblique <- rep(1, L) 34 | s_wo <- ssa(co2, L = L, row.oblique = row.oblique, column.oblique = column.oblique) 35 | 36 | s_b <- ssa(co2, L = L) 37 | 38 | ranks <- 1:5 39 | for (rank in ranks) { 40 | cz_wo <- cadzow(s_wo, rank = rank) 41 | cz_b <- cadzow(s_b, rank = rank) 42 | 43 | expect_true(.series.wsqdistance(cz_wo, .F(s_wo)) <= 44 | .series.wsqdistance(cz_b, .F(s_wo))) 45 | } 46 | }) 47 | --------------------------------------------------------------------------------