17 |
18 |
19 | [](https://travis-ci.com/DylanB95/statespacer)
20 | [](https://www.tidyverse.org/lifecycle/#stable)
21 | [](https://CRAN.R-project.org/package=statespacer)
22 |
23 |
24 | ## Overview
25 | statespacer is a package for state space modelling and forecasting in R. It provides functions that make estimating models in State Space form a breeze. This package implements state-of-the-art algorithms developed by various time series practitioners such as J. Durbin and S.J. Koopman. Details about the algorithms can be found in their book, "Time Series Analysis by State Space Methods".
26 |
27 | If you are new to statespacer, check out `vignette("intro", "statespacer")` for a quick start to the statespacer package! Also check out the references for the following functions:
28 |
29 | * `statespacer()` for fitting State Space models.
30 | * `predict.statespacer()` for producing forecasts and out-of-sample simulations using fitted State Space models.
31 | * `SimSmoother()` for drawing random samples of the hidden state of a State Space model conditional on the data.
32 |
33 | ## State Space Components
34 | This package supports numerous state space components:
35 |
36 | * The Local Level
37 | * The Local Level + Slope
38 | * Smoothing Splines
39 | * Trigonometric Seasonality, BSM
40 | * (Business) Cycles
41 | * Explanatory Variables
42 | * Explanatory Variables with time-varying coefficients
43 | * Explanatory Variables in the Local Level
44 | * Explanatory Variables in the Local Level + Slope
45 | * ARIMA
46 | * SARIMA
47 | * Moreover, you can specify a component yourself!
48 |
49 | These components can be used for both univariate, and multivariate models. The components can be combined in order to get more extensive models. Moreover, the user can control the format of the variance - covariance matrices of each of the components. This way, one could specify the components to be deterministic instead of stochastic. In the multivariate case, one could impose rank restrictions on the variance - covariance matrices such that commonalities in the components are estimated, like common levels, common slopes, etc.
50 |
51 | ## Fitting Procedure
52 | The package employs a univariate treatment, and an exact initialisation for diffuse elements, to estimate the state parameters and compute the loglikelihood. Collapsing large observation vectors is supported as well. Moreover, missing observations are readily dealt with by putting the models in State Space form!
53 |
54 | ## Installation
55 |
56 | You can install statespacer from CRAN with:
57 |
58 | ```{r, eval = FALSE}
59 | install.packages("statespacer")
60 | ```
61 |
62 | ### Development version
63 |
64 | To get a bug fix or to use a feature from the development version, you can install the development version of statespacer from GitHub.
65 |
66 | ```{r, eval = FALSE}
67 | # install.packages("devtools")
68 | devtools::install_github("DylanB95/statespacer")
69 | ```
70 |
71 | ## Usage
72 | ```{r, message = FALSE, warning = FALSE}
73 | library(statespacer)
74 |
75 | library(datasets)
76 | y <- matrix(Nile)
77 |
78 | fit <- statespacer(y = y,
79 | local_level_ind = TRUE,
80 | initial = 0.5*log(var(y)))
81 |
82 | plot(1871:1970, fit$function_call$y, type = 'p', ylim = c(500, 1400),
83 | xlab = NA, ylab = NA,
84 | sub = "The smoothed level with 90% confidence intervals,
85 | and the observed data points")
86 | lines(1871:1970, fit$smoothed$level, type = 'l')
87 | lines(1871:1970, fit$smoothed$level + qnorm(0.95) * sqrt(fit$smoothed$V[1,1,]),
88 | type = 'l', col = 'gray'
89 | )
90 | lines(1871:1970, fit$smoothed$level - qnorm(0.95) * sqrt(fit$smoothed$V[1,1,]),
91 | type = 'l', col = 'gray'
92 | )
93 | ```
94 |
95 | ## Getting help
96 |
97 | If you encounter a clear bug, please file an issue with a minimal reproducible example on [GitHub](https://github.com/DylanB95/statespacer/issues).
98 |
99 | ---
100 | Please note that the 'statespacer' project is released with a [Contributor Code of Conduct](CODE_OF_CONDUCT.md). By contributing to this project, you agree to abide by its terms.
101 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | # State Space Modelling in R
5 |
6 |
7 |
8 | [](https://travis-ci.com/DylanB95/statespacer)
10 | [](https://www.tidyverse.org/lifecycle/#stable)
12 | [](https://CRAN.R-project.org/package=statespacer)
14 |
15 |
16 | ## Overview
17 |
18 | statespacer is a package for state space modelling and forecasting in R.
19 | It provides functions that make estimating models in State Space form a
20 | breeze. This package implements state-of-the-art algorithms developed by
21 | various time series practitioners such as J. Durbin and S.J. Koopman.
22 | Details about the algorithms can be found in their book, “Time Series
23 | Analysis by State Space Methods”.
24 |
25 | If you are new to statespacer, check out
26 | `vignette("intro", "statespacer")` for a quick start to the statespacer
27 | package! Also check out the references for the following functions:
28 |
29 | - `statespacer()` for fitting State Space models.
30 | - `predict.statespacer()` for producing forecasts and out-of-sample
31 | simulations using fitted State Space models.
32 | - `SimSmoother()` for drawing random samples of the hidden state of a
33 | State Space model conditional on the data.
34 |
35 | ## State Space Components
36 |
37 | This package supports numerous state space components:
38 |
39 | - The Local Level
40 | - The Local Level + Slope
41 | - Smoothing Splines
42 | - Trigonometric Seasonality, BSM
43 | - (Business) Cycles
44 | - Explanatory Variables
45 | - Explanatory Variables with time-varying coefficients
46 | - Explanatory Variables in the Local Level
47 | - Explanatory Variables in the Local Level + Slope
48 | - ARIMA
49 | - SARIMA
50 | - Moreover, you can specify a component yourself!
51 |
52 | These components can be used for both univariate, and multivariate
53 | models. The components can be combined in order to get more extensive
54 | models. Moreover, the user can control the format of the variance -
55 | covariance matrices of each of the components. This way, one could
56 | specify the components to be deterministic instead of stochastic. In the
57 | multivariate case, one could impose rank restrictions on the variance -
58 | covariance matrices such that commonalities in the components are
59 | estimated, like common levels, common slopes, etc.
60 |
61 | ## Fitting Procedure
62 |
63 | The package employs a univariate treatment, and an exact initialisation
64 | for diffuse elements, to estimate the state parameters and compute the
65 | loglikelihood. Collapsing large observation vectors is supported as
66 | well. Moreover, missing observations are readily dealt with by putting
67 | the models in State Space form!
68 |
69 | ## Installation
70 |
71 | You can install statespacer from CRAN with:
72 |
73 | ``` r
74 | install.packages("statespacer")
75 | ```
76 |
77 | ### Development version
78 |
79 | To get a bug fix or to use a feature from the development version, you
80 | can install the development version of statespacer from GitHub.
81 |
82 | ``` r
83 | # install.packages("devtools")
84 | devtools::install_github("DylanB95/statespacer")
85 | ```
86 |
87 | ## Usage
88 |
89 | ``` r
90 | library(statespacer)
91 |
92 | library(datasets)
93 | y <- matrix(Nile)
94 |
95 | fit <- statespacer(y = y,
96 | local_level_ind = TRUE,
97 | initial = 0.5*log(var(y)))
98 |
99 | plot(1871:1970, fit$function_call$y, type = 'p', ylim = c(500, 1400),
100 | xlab = NA, ylab = NA,
101 | sub = "The smoothed level with 90% confidence intervals,
102 | and the observed data points")
103 | lines(1871:1970, fit$smoothed$level, type = 'l')
104 | lines(1871:1970, fit$smoothed$level + qnorm(0.95) * sqrt(fit$smoothed$V[1,1,]),
105 | type = 'l', col = 'gray'
106 | )
107 | lines(1871:1970, fit$smoothed$level - qnorm(0.95) * sqrt(fit$smoothed$V[1,1,]),
108 | type = 'l', col = 'gray'
109 | )
110 | ```
111 |
112 | 
113 |
114 | ## Getting help
115 |
116 | If you encounter a clear bug, please file an issue with a minimal
117 | reproducible example on
118 | [GitHub](https://github.com/DylanB95/statespacer/issues).
119 |
120 | ------------------------------------------------------------------------
121 |
122 | Please note that the ‘statespacer’ project is released with a
123 | [Contributor Code of Conduct](CODE_OF_CONDUCT.md). By contributing to
124 | this project, you agree to abide by its terms.
125 |
--------------------------------------------------------------------------------
/vignettes/intro.Rmd:
--------------------------------------------------------------------------------
1 | ---
2 | title: "Introduction to statespacer"
3 | description: >
4 | Start here if this is your first time using statespacer. You'll learn how to
5 | use `statespacer()` to fit a simple State Space model, called the Local
6 | Level model, to the Nile dataset.
7 | output: rmarkdown::html_vignette
8 | bibliography: ../inst/REFERENCES.bib
9 | vignette: >
10 | %\VignetteIndexEntry{Introduction to statespacer}
11 | %\VignetteEngine{knitr::rmarkdown}
12 | %\VignetteEncoding{UTF-8}
13 | ---
14 |
15 | ```{r, include = FALSE}
16 | knitr::opts_chunk$set(
17 | collapse = TRUE,
18 | comment = "#>"
19 | )
20 | ```
21 |
22 | This document provides a brief introduction to using the statespacer package. It does so by showcasing the estimation of a Local Level model on the well known Nile data. See `?Nile` for more information about this dataset.
23 |
24 | To start, let's first introduce the Local Level model. Mathematically, this model can be represented as follows:
25 |
26 | $$
27 | \begin{aligned}
28 | y_t ~ &= ~ \mu_t ~ + ~ \varepsilon_t, ~~~~~~ \varepsilon_t ~ \sim ~ N(0, ~ \sigma_\varepsilon^2), \\
29 | \mu_{t+1} ~ &= ~ \mu_t ~ + ~ \eta_t, ~~~~~~ \eta_t ~ \sim ~ N(0, ~ \sigma_\eta^2),
30 | \end{aligned}
31 | $$
32 |
33 | where $y_t$ is the dependent variable at time $t$, $\mu_t$ is the unobserved level at time $t$, and $\varepsilon_t$ and $\eta_t$ are disturbances. This model has two parameters, $\sigma_\varepsilon^2$ and $\sigma_\eta^2$ that will be estimated by maximising the loglikelihood. In addition, the level $\mu_t$ is a state parameter that will be estimated by employing the Kalman Filter. For extensive details about the algorithms employed, see @durbin2012time.
34 |
35 | Estimating this model using the statespacer package is simple. First, we load the data and extract the dependent variable. The dependent variable needs to be specified as a matrix, with each column being one of the dependents. In this case, we just have one column, as the Nile data comprises a univariate series.
36 |
37 | ```{r, setup}
38 | # Load statespacer
39 | library(statespacer)
40 |
41 | # Load the dataset
42 | library(datasets)
43 | y <- matrix(Nile)
44 | ```
45 |
46 | To fit a local level model, we simply call the `statespacer()` function. See `?statespacer` for further details.
47 |
48 | ```{r}
49 | fit <- statespacer(y = y,
50 | local_level_ind = TRUE,
51 | initial = 0.5*log(var(y)),
52 | verbose = TRUE)
53 | ```
54 |
55 | We get a warning message about the number of initial parameters, as we didn't specify enough of them. We needed 2 initial parameters, but specified only 1. This is okay, as the function just replicates the specified parameters the required amount of times. This way, we don't need to worry about how many parameters are needed. We could also specify too many initial parameters, in which case only the first few are used. This is particularly useful when we want random initial parameters. One could just simply specify `initial = rnorm(1000)`, and not have to worry about if enough parameters were supplied.
56 |
57 | Now, let's check the estimated values of $\sigma_\varepsilon^2$ and $\sigma_\eta^2$.
58 |
59 | ```{r}
60 | c(fit$system_matrices$H$H, fit$system_matrices$Q$level)
61 | ```
62 |
63 | Note that we use the notation used in @durbin2012time for the system matrices. $H$ being the system matrix for the variance - covariance matrix of the observation equation, and $Q$ being the system matrix for the variance - covariance matrix of the state equation.
64 |
65 | Checking out the estimated level is easy as well. The filtered level:
66 |
67 | ```{r, fig.height = 4.5, fig.width = 7}
68 | plot(1871:1970, fit$function_call$y, type = 'p', ylim = c(500, 1400),
69 | xlab = NA, ylab = NA,
70 | sub = "The filtered level with 90% confidence intervals,
71 | and the observed data points"
72 | )
73 | lines(1871:1970, fit$filtered$level, type = 'l')
74 | lines(1871:1970, fit$filtered$level + qnorm(0.95) * sqrt(fit$filtered$P[1,1,]),
75 | type = 'l', col = 'gray'
76 | )
77 | lines(1871:1970, fit$filtered$level - qnorm(0.95) * sqrt(fit$filtered$P[1,1,]),
78 | type = 'l', col = 'gray'
79 | )
80 | ```
81 |
82 | And the smoothed level:
83 |
84 | ```{r, fig.height = 4.5, fig.width = 7}
85 | plot(1871:1970, fit$function_call$y, type = 'p', ylim = c(500, 1400),
86 | xlab = NA, ylab = NA,
87 | sub = "The smoothed level with 90% confidence intervals,
88 | and the observed data points")
89 | lines(1871:1970, fit$smoothed$level, type = 'l')
90 | lines(1871:1970, fit$smoothed$level + qnorm(0.95) * sqrt(fit$smoothed$V[1,1,]),
91 | type = 'l', col = 'gray'
92 | )
93 | lines(1871:1970, fit$smoothed$level - qnorm(0.95) * sqrt(fit$smoothed$V[1,1,]),
94 | type = 'l', col = 'gray'
95 | )
96 | ```
97 |
98 | The object returned by `statespacer()` exhibits many other useful items. For more information about these items, please see `vignette("dictionary", "statespacer")`. For more exhibitions of the statespacer package, please see the other tutorials on `, then ``, etc.) that has more than one element. Defaults to 1 (for ``).
76 | getTopLevel: function($scope) {
77 | for (var i = 1; i <= 6; i++) {
78 | var $headings = this.findOrFilter($scope, 'h' + i);
79 | if ($headings.length > 1) {
80 | return i;
81 | }
82 | }
83 |
84 | return 1;
85 | },
86 |
87 | // returns the elements for the top level, and the next below it
88 | getHeadings: function($scope, topLevel) {
89 | var topSelector = 'h' + topLevel;
90 |
91 | var secondaryLevel = topLevel + 1;
92 | var secondarySelector = 'h' + secondaryLevel;
93 |
94 | return this.findOrFilter($scope, topSelector + ',' + secondarySelector);
95 | },
96 |
97 | getNavLevel: function(el) {
98 | return parseInt(el.tagName.charAt(1), 10);
99 | },
100 |
101 | populateNav: function($topContext, topLevel, $headings) {
102 | var $context = $topContext;
103 | var $prevNav;
104 |
105 | var helpers = this;
106 | $headings.each(function(i, el) {
107 | var $newNav = helpers.generateNavItem(el);
108 | var navLevel = helpers.getNavLevel(el);
109 |
110 | // determine the proper $context
111 | if (navLevel === topLevel) {
112 | // use top level
113 | $context = $topContext;
114 | } else if ($prevNav && $context === $topContext) {
115 | // create a new level of the tree and switch to it
116 | $context = helpers.createChildNavList($prevNav);
117 | } // else use the current $context
118 |
119 | $context.append($newNav);
120 |
121 | $prevNav = $newNav;
122 | });
123 | },
124 |
125 | parseOps: function(arg) {
126 | var opts;
127 | if (arg.jquery) {
128 | opts = {
129 | $nav: arg
130 | };
131 | } else {
132 | opts = arg;
133 | }
134 | opts.$scope = opts.$scope || $(document.body);
135 | return opts;
136 | }
137 | },
138 |
139 | // accepts a jQuery object, or an options object
140 | init: function(opts) {
141 | opts = this.helpers.parseOps(opts);
142 |
143 | // ensure that the data attribute is in place for styling
144 | opts.$nav.attr('data-toggle', 'toc');
145 |
146 | var $topContext = this.helpers.createChildNavList(opts.$nav);
147 | var topLevel = this.helpers.getTopLevel(opts.$scope);
148 | var $headings = this.helpers.getHeadings(opts.$scope, topLevel);
149 | this.helpers.populateNav($topContext, topLevel, $headings);
150 | }
151 | };
152 |
153 | $(function() {
154 | $('nav[data-toggle="toc"]').each(function(i, el) {
155 | var $nav = $(el);
156 | Toc.init($nav);
157 | });
158 | });
159 | })();
160 |
--------------------------------------------------------------------------------
/docs/dev/bootstrap-toc.js:
--------------------------------------------------------------------------------
1 | /*!
2 | * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/)
3 | * Copyright 2015 Aidan Feldman
4 | * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */
5 | (function() {
6 | 'use strict';
7 |
8 | window.Toc = {
9 | helpers: {
10 | // return all matching elements in the set, or their descendants
11 | findOrFilter: function($el, selector) {
12 | // http://danielnouri.org/notes/2011/03/14/a-jquery-find-that-also-finds-the-root-element/
13 | // http://stackoverflow.com/a/12731439/358804
14 | var $descendants = $el.find(selector);
15 | return $el.filter(selector).add($descendants).filter(':not([data-toc-skip])');
16 | },
17 |
18 | generateUniqueIdBase: function(el) {
19 | var text = $(el).text();
20 | var anchor = text.trim().toLowerCase().replace(/[^A-Za-z0-9]+/g, '-');
21 | return anchor || el.tagName.toLowerCase();
22 | },
23 |
24 | generateUniqueId: function(el) {
25 | var anchorBase = this.generateUniqueIdBase(el);
26 | for (var i = 0; ; i++) {
27 | var anchor = anchorBase;
28 | if (i > 0) {
29 | // add suffix
30 | anchor += '-' + i;
31 | }
32 | // check if ID already exists
33 | if (!document.getElementById(anchor)) {
34 | return anchor;
35 | }
36 | }
37 | },
38 |
39 | generateAnchor: function(el) {
40 | if (el.id) {
41 | return el.id;
42 | } else {
43 | var anchor = this.generateUniqueId(el);
44 | el.id = anchor;
45 | return anchor;
46 | }
47 | },
48 |
49 | createNavList: function() {
50 | return $('');
51 | },
52 |
53 | createChildNavList: function($parent) {
54 | var $childList = this.createNavList();
55 | $parent.append($childList);
56 | return $childList;
57 | },
58 |
59 | generateNavEl: function(anchor, text) {
60 | var $a = $('');
61 | $a.attr('href', '#' + anchor);
62 | $a.text(text);
63 | var $li = $('
');
64 | $li.append($a);
65 | return $li;
66 | },
67 |
68 | generateNavItem: function(headingEl) {
69 | var anchor = this.generateAnchor(headingEl);
70 | var $heading = $(headingEl);
71 | var text = $heading.data('toc-text') || $heading.text();
72 | return this.generateNavEl(anchor, text);
73 | },
74 |
75 | // Find the first heading level (``). 76 | getTopLevel: function($scope) { 77 | for (var i = 1; i <= 6; i++) { 78 | var $headings = this.findOrFilter($scope, 'h' + i); 79 | if ($headings.length > 1) { 80 | return i; 81 | } 82 | } 83 | 84 | return 1; 85 | }, 86 | 87 | // returns the elements for the top level, and the next below it 88 | getHeadings: function($scope, topLevel) { 89 | var topSelector = 'h' + topLevel; 90 | 91 | var secondaryLevel = topLevel + 1; 92 | var secondarySelector = 'h' + secondaryLevel; 93 | 94 | return this.findOrFilter($scope, topSelector + ',' + secondarySelector); 95 | }, 96 | 97 | getNavLevel: function(el) { 98 | return parseInt(el.tagName.charAt(1), 10); 99 | }, 100 | 101 | populateNav: function($topContext, topLevel, $headings) { 102 | var $context = $topContext; 103 | var $prevNav; 104 | 105 | var helpers = this; 106 | $headings.each(function(i, el) { 107 | var $newNav = helpers.generateNavItem(el); 108 | var navLevel = helpers.getNavLevel(el); 109 | 110 | // determine the proper $context 111 | if (navLevel === topLevel) { 112 | // use top level 113 | $context = $topContext; 114 | } else if ($prevNav && $context === $topContext) { 115 | // create a new level of the tree and switch to it 116 | $context = helpers.createChildNavList($prevNav); 117 | } // else use the current $context 118 | 119 | $context.append($newNav); 120 | 121 | $prevNav = $newNav; 122 | }); 123 | }, 124 | 125 | parseOps: function(arg) { 126 | var opts; 127 | if (arg.jquery) { 128 | opts = { 129 | $nav: arg 130 | }; 131 | } else { 132 | opts = arg; 133 | } 134 | opts.$scope = opts.$scope || $(document.body); 135 | return opts; 136 | } 137 | }, 138 | 139 | // accepts a jQuery object, or an options object 140 | init: function(opts) { 141 | opts = this.helpers.parseOps(opts); 142 | 143 | // ensure that the data attribute is in place for styling 144 | opts.$nav.attr('data-toggle', 'toc'); 145 | 146 | var $topContext = this.helpers.createChildNavList(opts.$nav); 147 | var topLevel = this.helpers.getTopLevel(opts.$scope); 148 | var $headings = this.helpers.getHeadings(opts.$scope, topLevel); 149 | this.helpers.populateNav($topContext, topLevel, $headings); 150 | } 151 | }; 152 | 153 | $(function() { 154 | $('nav[data-toggle="toc"]').each(function(i, el) { 155 | var $nav = $(el); 156 | Toc.init($nav); 157 | }); 158 | }); 159 | })(); 160 | -------------------------------------------------------------------------------- /docs/dev/bootstrap-toc.js: -------------------------------------------------------------------------------- 1 | /*! 2 | * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/) 3 | * Copyright 2015 Aidan Feldman 4 | * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */ 5 | (function() { 6 | 'use strict'; 7 | 8 | window.Toc = { 9 | helpers: { 10 | // return all matching elements in the set, or their descendants 11 | findOrFilter: function($el, selector) { 12 | // http://danielnouri.org/notes/2011/03/14/a-jquery-find-that-also-finds-the-root-element/ 13 | // http://stackoverflow.com/a/12731439/358804 14 | var $descendants = $el.find(selector); 15 | return $el.filter(selector).add($descendants).filter(':not([data-toc-skip])'); 16 | }, 17 | 18 | generateUniqueIdBase: function(el) { 19 | var text = $(el).text(); 20 | var anchor = text.trim().toLowerCase().replace(/[^A-Za-z0-9]+/g, '-'); 21 | return anchor || el.tagName.toLowerCase(); 22 | }, 23 | 24 | generateUniqueId: function(el) { 25 | var anchorBase = this.generateUniqueIdBase(el); 26 | for (var i = 0; ; i++) { 27 | var anchor = anchorBase; 28 | if (i > 0) { 29 | // add suffix 30 | anchor += '-' + i; 31 | } 32 | // check if ID already exists 33 | if (!document.getElementById(anchor)) { 34 | return anchor; 35 | } 36 | } 37 | }, 38 | 39 | generateAnchor: function(el) { 40 | if (el.id) { 41 | return el.id; 42 | } else { 43 | var anchor = this.generateUniqueId(el); 44 | el.id = anchor; 45 | return anchor; 46 | } 47 | }, 48 | 49 | createNavList: function() { 50 | return $(''); 51 | }, 52 | 53 | createChildNavList: function($parent) { 54 | var $childList = this.createNavList(); 55 | $parent.append($childList); 56 | return $childList; 57 | }, 58 | 59 | generateNavEl: function(anchor, text) { 60 | var $a = $(''); 61 | $a.attr('href', '#' + anchor); 62 | $a.text(text); 63 | var $li = $('
`, then ``, etc.) that has more than one element. Defaults to 1 (for ``).
76 | getTopLevel: function($scope) {
77 | for (var i = 1; i <= 6; i++) {
78 | var $headings = this.findOrFilter($scope, 'h' + i);
79 | if ($headings.length > 1) {
80 | return i;
81 | }
82 | }
83 |
84 | return 1;
85 | },
86 |
87 | // returns the elements for the top level, and the next below it
88 | getHeadings: function($scope, topLevel) {
89 | var topSelector = 'h' + topLevel;
90 |
91 | var secondaryLevel = topLevel + 1;
92 | var secondarySelector = 'h' + secondaryLevel;
93 |
94 | return this.findOrFilter($scope, topSelector + ',' + secondarySelector);
95 | },
96 |
97 | getNavLevel: function(el) {
98 | return parseInt(el.tagName.charAt(1), 10);
99 | },
100 |
101 | populateNav: function($topContext, topLevel, $headings) {
102 | var $context = $topContext;
103 | var $prevNav;
104 |
105 | var helpers = this;
106 | $headings.each(function(i, el) {
107 | var $newNav = helpers.generateNavItem(el);
108 | var navLevel = helpers.getNavLevel(el);
109 |
110 | // determine the proper $context
111 | if (navLevel === topLevel) {
112 | // use top level
113 | $context = $topContext;
114 | } else if ($prevNav && $context === $topContext) {
115 | // create a new level of the tree and switch to it
116 | $context = helpers.createChildNavList($prevNav);
117 | } // else use the current $context
118 |
119 | $context.append($newNav);
120 |
121 | $prevNav = $newNav;
122 | });
123 | },
124 |
125 | parseOps: function(arg) {
126 | var opts;
127 | if (arg.jquery) {
128 | opts = {
129 | $nav: arg
130 | };
131 | } else {
132 | opts = arg;
133 | }
134 | opts.$scope = opts.$scope || $(document.body);
135 | return opts;
136 | }
137 | },
138 |
139 | // accepts a jQuery object, or an options object
140 | init: function(opts) {
141 | opts = this.helpers.parseOps(opts);
142 |
143 | // ensure that the data attribute is in place for styling
144 | opts.$nav.attr('data-toggle', 'toc');
145 |
146 | var $topContext = this.helpers.createChildNavList(opts.$nav);
147 | var topLevel = this.helpers.getTopLevel(opts.$scope);
148 | var $headings = this.helpers.getHeadings(opts.$scope, topLevel);
149 | this.helpers.populateNav($topContext, topLevel, $headings);
150 | }
151 | };
152 |
153 | $(function() {
154 | $('nav[data-toggle="toc"]').each(function(i, el) {
155 | var $nav = $(el);
156 | Toc.init($nav);
157 | });
158 | });
159 | })();
160 |
--------------------------------------------------------------------------------
/vignettes/boxjenkins.Rmd:
--------------------------------------------------------------------------------
1 | ---
2 | title: "Fitting ARIMA models with statespacer"
3 | description: >
4 | A lot of time series practitiones resort to the well-known Box-Jenkins
5 | methods, such as ARIMA and SARIMA, when modelling time series. Those methods
6 | are easily incorporated into the State Space framework. This provides to be
7 | beneficial, as missing observations are easily dealt with in the State Space
8 | framework. Moreover, no observations need to be discarded due to the
9 | differencing and introduced lagged variables. The loglikelihood is calculated in an
10 | exact manner! In this document, we'll show you how to estimate ARIMA and
11 | SARIMA models using statespacer.
12 | output: rmarkdown::html_vignette
13 | bibliography: ../inst/REFERENCES.bib
14 | vignette: >
15 | %\VignetteIndexEntry{Fitting ARIMA models with statespacer}
16 | %\VignetteEngine{knitr::rmarkdown}
17 | %\VignetteEncoding{UTF-8}
18 | ---
19 |
20 | ```{r, include = FALSE}
21 | knitr::opts_chunk$set(
22 | collapse = TRUE,
23 | comment = "#>"
24 | )
25 | ```
26 |
27 | A lot of time series practitioners resort to the well-known Box-Jenkins methods, such as ARIMA and SARIMA, when modelling time series. Those methods are easily incorporated into the State Space framework. This provides to be beneficial, as missing observations are easily dealt with in the State Space framework. Moreover, no observations need to be discarded due to the differencing and introduced lagged variables. The loglikelihood is calculated in an exact manner! In this document, we show you how to estimate ARIMA and SARIMA models using statespacer. We reproduce some estimation results as in @box2015time.
28 |
29 | ## ARIMA modelling of the yearly sunspot data
30 | To showcase the estimation of ARIMA models, we make use of the `sunspot.year` data, which contains yearly numbers of sunspots from 1700 to 1988. See `?sunspot.year` for details. We only use the data from 1770 to 1869, to stay in line with @box2015time. We estimate an $\text{ARIMA}(3, ~ 0, ~ 0)$ with deterministic level (or constant if you prefer) as follows:
31 |
32 | ```{r, setup}
33 | # Load statespacer
34 | library(statespacer)
35 |
36 | # Load the dataset
37 | library(datasets)
38 | Data <- matrix(window(sunspot.year, start = 1770, end = 1869))
39 |
40 | # Estimate the ARIMA model
41 | fit <- statespacer(y = Data,
42 | H_format = matrix(0),
43 | local_level_ind = TRUE,
44 | arima_list = list(c(3, 0, 0)),
45 | format_level = matrix(0),
46 | initial = c(0.5*log(var(Data)), 0, 0, 0),
47 | verbose = TRUE,
48 | standard_errors = TRUE)
49 | ```
50 |
51 | Note that we eliminate the observation error by setting its variance to 0, although it's perfectly fine to include observation errors along with ARIMA models, as long as you watch out for identification issues of course. For details about specifying proper initial values, please see `vignette("dictionary", "statespacer")`.
52 |
53 | We obtain the following estimates:
54 |
55 | ```{r}
56 | # Coefficients of the ARMA component
57 | arma_coeff <- rbind(
58 | fit$system_matrices$AR$ARIMA1,
59 | fit$standard_errors$AR$ARIMA1
60 | )
61 | arma_coeff <- cbind(
62 | arma_coeff,
63 | c(fit$smoothed$level[1],
64 | sqrt(fit$system_matrices$Z_padded$level %*%
65 | fit$smoothed$V[,,1] %*%
66 | t(fit$system_matrices$Z_padded$level))
67 | )
68 | )
69 | rownames(arma_coeff) <- c("coefficient", "std_error")
70 | colnames(arma_coeff) <- c("ar1", "ar2", "ar3", "intercept")
71 | arma_coeff
72 |
73 | goodness_fit <- rbind(
74 | fit$system_matrices$Q$ARIMA1,
75 | fit$diagnostics$loglik,
76 | fit$diagnostics$AIC
77 | )
78 | rownames(goodness_fit) <- c("Variance", "Loglikelihood", "AIC")
79 | goodness_fit
80 | ```
81 |
82 | We see that the results are fairly similar to the results as obtained by @box2015time. Differences may occur due to the different estimation procedures. We don't have to eliminate observations, so we use the full information available at hand, in contrast to traditional estimation procedures. Note that not much has to be done to estimate VARIMA models. In fact, you only need to specify a dependent variable `y` that has more than one column! It's also straightforward to add explanatory variables, by making use of the `addvar_list` option, see `vignette("seatbelt", "statespacer")` for an example of adding explanatory variables.
83 |
84 | ## SARIMA modelling of the airline data
85 | To showcase the estimation of SARIMA models, we make use of the classic `AirPassengers` data, which contains monthly totals of international airline passengers from 1949 to 1960. See `?AirPassengers` for details. We estimate a $\text{SARIMA}(0, ~ 1, ~ 1)_{1} ~ \times ~ (0, ~ 1, ~ 1)_{12}$. Note that in the multivariate case, there is a subtle difference between $\text{SARIMA}(0, ~ 1, ~ 1)_{1} ~ \times ~ (0, ~ 1, ~ 1)_{12}$ and $\text{SARIMA}(0, ~ 1, ~ 1)_{12} ~ \times ~ (0, ~ 1, ~ 1)_{1}$ as matrix multiplication is not commutative.
86 |
87 | We proceed as follows:
88 | ```{r, warning = FALSE}
89 | # Load the dataset
90 | Data <- matrix(log(AirPassengers))
91 |
92 | # The SARIMA specification, must be a list containing lists!
93 | sarima_list <- list(list(s = c(12, 1), ar = c(0, 0), i = c(1, 1), ma = c(1, 1)))
94 |
95 | # Fit the SARIMA model
96 | fit <- statespacer(y = Data,
97 | H_format = matrix(0),
98 | sarima_list = sarima_list,
99 | initial = c(0.5*log(var(diff(Data))), 0, 0),
100 | verbose = TRUE)
101 | ```
102 |
103 | We obtain the following estimates:
104 |
105 | ```{r}
106 | # Coefficients of the ARMA component
107 | arma_coeff <- rbind(
108 | c(fit$system_matrices$SMA$SARIMA1$S1, fit$system_matrices$SMA$SARIMA1$S12),
109 | c(fit$standard_errors$SMA$SARIMA1$S1, fit$standard_errors$SMA$SARIMA1$S12)
110 | )
111 |
112 | rownames(arma_coeff) <- c("coefficient", "std_error")
113 | colnames(arma_coeff) <- c("ma1 s = 1", "ma1 s = 12")
114 | arma_coeff
115 |
116 | goodness_fit <- rbind(
117 | fit$system_matrices$Q$SARIMA1,
118 | fit$diagnostics$loglik,
119 | fit$diagnostics$AIC
120 | )
121 | rownames(goodness_fit) <- c("Variance", "Loglikelihood", "AIC")
122 | goodness_fit
123 | ```
124 |
125 | As you can see, fitting the Box-Jenkins models with statespacer is quite easy!
126 |
127 | ## References
128 |
--------------------------------------------------------------------------------
/src/LogLikC.cpp:
--------------------------------------------------------------------------------
1 | #include
2 | // [[Rcpp::depends(RcppArmadillo)]
3 |
4 | //' Employ the Kalman Filter to calculate the loglikelihood
5 | //'
6 | //' @param y Matrix of observations.
7 | //' @param y_isna Matrix indicating which observations are missing.
8 | //' @param a Initial values of the state vector.
9 | //' @param P_inf Diffuse part of the variance - covariance matrix of the
10 | //' state vector.
11 | //' @param P_star Stationary part of the variance - covariance matrix of the
12 | //' state vector.
13 | //' @param Z Z system matrix of the State Space model.
14 | //' @param T T system matrix of the State Space model.
15 | //' @param R R system matrix of the State Space model.
16 | //' @param Q Q system matrix of the State Space model.
17 | //'
18 | //' @noRd
19 | // [[Rcpp::export]]
20 | double LogLikC(const Rcpp::NumericMatrix& y,
21 | const Rcpp::LogicalMatrix& y_isna,
22 | arma::colvec a,
23 | arma::mat P_inf,
24 | arma::mat P_star,
25 | const arma::cube& Z,
26 | const arma::cube& T,
27 | const arma::cube& R,
28 | const arma::cube& Q) {
29 |
30 | // Number of observations, dependent variables, and state parameters
31 | int N = y.nrow(), p = y.ncol(), m = a.n_rows;
32 |
33 | // Keep track of the limits of the indices
34 | int N_min1 = N - 1, p_min1 = p - 1;
35 |
36 | // Check which system matrices are time-varying
37 | bool Z_tv = Z.n_slices > 1, T_tv = T.n_slices > 1,
38 | R_tv = R.n_slices > 1, Q_tv = Q.n_slices > 1;
39 |
40 | // Initial system matrices
41 | arma::mat Z_mat = Z.slice(0), T_mat = T.slice(0),
42 | R_mat = R.slice(0), Q_mat = Q.slice(0);
43 | arma::rowvec Z_row = Z_mat.row(0);
44 |
45 | // Indicator for whether the first row should be assigned
46 | bool row_assign = Z_tv || p > 1;
47 |
48 | // Check if P_inf is already 0
49 | bool initialisation = !arma::all(arma::vectorise(arma::abs(P_inf)) < 1e-7);
50 |
51 | // Initialise number of non-initialisation steps
52 | // and number of occurrences that F = 0
53 | int non_init = 0, F_eq0 = 0;
54 |
55 | // Initialise loglikelihood
56 | double loglik = 0;
57 |
58 | // Initialise objects used in computations
59 | arma::colvec M_inf(m), M_star(m), K_0(m), K_1(m);
60 | arma::mat L_0(m, m), L_1(m, m);
61 | double F_inf, F_star, F_1, F_2, v;
62 | double constant = -log(2 * M_PI) / 2;
63 |
64 | // Iterators
65 | int i, j;
66 |
67 | // Loop over time points
68 | for (i = 0; i < N; i++) {
69 |
70 | // Get system matrices of current time point
71 | if (Z_tv && i > 0) {
72 | Z_mat = Z.slice(i);
73 | }
74 | if (T_tv && i > 0) {
75 | T_mat = T.slice(i);
76 | }
77 | if (R_tv && i > 0) {
78 | R_mat = R.slice(i);
79 | }
80 | if (Q_tv && i > 0) {
81 | Q_mat = Q.slice(i);
82 | }
83 |
84 | // Loop over dependent variables
85 | for (j = 0; j < p; j++) {
86 |
87 | // Check for missing value
88 | if (y_isna(i, j)) {
89 | continue;
90 | }
91 |
92 | // Retrieve row of Z
93 | if (j > 0 || (i > 0 && row_assign)) {
94 | Z_row = Z_mat.row(j);
95 | }
96 |
97 | // Exact Kalman filter in initialisation steps
98 | if (initialisation) {
99 |
100 | // PZ' as in Kalman formulae
101 | M_inf = P_inf * Z_row.t();
102 | M_star = P_star * Z_row.t();
103 |
104 | // Variance matrix of the current residual/fitted value
105 | F_inf = arma::as_scalar(Z_row * M_inf);
106 | F_star = arma::as_scalar(Z_row * M_star);
107 |
108 | // Check if F_inf is nearly 0
109 | if (F_inf < 1e-7) {
110 |
111 | // Check if F_star is nearly 0
112 | if (F_star < 1e-7) {
113 | continue;
114 | } else {
115 |
116 | // Inverse of Fmat
117 | F_1 = 1 / F_star;
118 |
119 | // Current residual
120 | v = y(i, j) - arma::as_scalar(Z_row * a);
121 |
122 | // Auxiliary matrices
123 | K_0 = M_star * F_1;
124 | L_0 = arma::mat(m, m, arma::fill::eye) - K_0 * Z_row;
125 |
126 | // Estimated state vector and corresponding variance - covariance
127 | // matrix for the next step
128 | a = a + K_0 * v;
129 | P_star = P_star * L_0.t();
130 | loglik += constant - (log(F_star) + pow(v, 2.0) * F_1) / 2;
131 | continue;
132 | }
133 | } else {
134 |
135 | // Inverse of Fmat
136 | F_1 = 1 / F_inf;
137 | F_2 = -pow(F_1, 2.0) * F_star;
138 |
139 | // Current residual
140 | v = y(i, j) - arma::as_scalar(Z_row * a);
141 |
142 | // Auxiliary matrices
143 | K_0 = M_inf * F_1;
144 | L_0 = arma::mat(m, m, arma::fill::eye) - K_0 * Z_row;
145 | K_1 = M_star * F_1 + M_inf * F_2;
146 | L_1 = -K_1 * Z_row;
147 |
148 | // Estimated state vector and corresponding variance - covariance
149 | // matrix for the next step
150 | a = a + K_0 * v;
151 | P_star = P_inf * L_1.t() + P_star * L_0.t();
152 | P_inf = P_inf * L_0.t();
153 | loglik += constant - log(F_inf) / 2;
154 | }
155 |
156 | // Check if P_inf converged to 0
157 | if (j < p_min1) {
158 | initialisation = !arma::all(arma::vectorise(arma::abs(P_inf)) < 1e-7);
159 | }
160 |
161 | } else {
162 |
163 | // Increment non_init
164 | non_init++;
165 |
166 | // PZ' as in Kalman formulae
167 | M_star = P_star * Z_row.t();
168 |
169 | // Variance matrix of the current residual/fitted value
170 | F_star = arma::as_scalar(Z_row * M_star);
171 |
172 | // Check if F_star is nearly 0
173 | if (F_star < 1e-7) {
174 |
175 | // Increment number of times F = 0
176 | F_eq0++;
177 |
178 | } else {
179 |
180 | // Inverse of Fmat
181 | F_1 = 1 / F_star;
182 |
183 | // Current residual
184 | v = y(i, j) - arma::as_scalar(Z_row * a);
185 |
186 | // Auxiliary matrices
187 | K_0 = M_star * F_1;
188 | L_0 = arma::mat(m, m, arma::fill::eye) - K_0 * Z_row;
189 |
190 | // Estimated state vector and corresponding variance - covariance
191 | // matrix for the next step
192 | a = a + K_0 * v;
193 | P_star = P_star * L_0.t();
194 | loglik += constant - (log(F_star) + pow(v, 2.0) * F_1) / 2;
195 | }
196 | }
197 | }
198 |
199 | // Perform computations for the next time point
200 | if (i < N_min1) {
201 | a = T_mat * a;
202 | P_star = T_mat * P_star * T_mat.t() + R_mat * Q_mat * R_mat.t();
203 | if (initialisation) {
204 | P_inf = T_mat * P_inf * T_mat.t();
205 | initialisation = !arma::all(arma::vectorise(arma::abs(P_inf)) < 1e-7);
206 | }
207 | }
208 | }
209 |
210 | // Return NA if F equals 0 during all of the non-initialisation steps
211 | if (non_init == F_eq0) {
212 | return NA_REAL;
213 | }
214 | return loglik / N;
215 | }
216 |
--------------------------------------------------------------------------------
/R/Cholesky.R:
--------------------------------------------------------------------------------
1 | #' Construct a Valid Variance - Covariance Matrix
2 | #'
3 | #' Constructs a valid variance - covariance matrix by using the Cholesky LDL
4 | #' decomposition.
5 | #'
6 | #' @param param Vector containing the parameters used to construct the
7 | #' variance - covariance matrix.
8 | #' @param format Matrix representing the format for the Loading matrix L
9 | #' and Diagonal matrix D. The lower triangular part of the format is used
10 | #' as the format for the Loading matrix L. The diagonal of the format is
11 | #' used as the format for the Diagonal matrix D. Must be a matrix.
12 | #' @param decompositions Boolean indicating whether the loading and diagonal
13 | #' matrix of the Cholesky decomposition, and the correlation matrix and
14 | #' standard deviations should be returned.
15 | #'
16 | #' @details
17 | #' `format` is used to specify which elements of the loading and diagonal
18 | #' matrix should be non-zero. The elements of `param` are then distributed
19 | #' along the non-zero elements of the loading and diagonal matrix.
20 | #' The parameters for the diagonal matrix are transformed using `exp(2 * x)`.
21 | #'
22 | #' @return
23 | #' A valid variance - covariance matrix.
24 | #' If `decompositions = TRUE` then it returns a list containing:
25 | #' * `cov_mat`: The variance - covariance matrix.
26 | #' * `loading_matrix`: The loading matrix of the Cholesky decomposition.
27 | #' * `diagonal_matrix`: The diagonal matrix of the Cholesky decomposition.
28 | #' * `correlation_matrix`: Matrix containing the correlations.
29 | #' * `stdev_matrix`: Matrix containing the standard deviations on the diagonal.
30 | #'
31 | #' @author Dylan Beijers, \email{dylanbeijers@@gmail.com}
32 | #'
33 | #' @examples
34 | #' format <- diag(1, 2, 2)
35 | #' format[2, 1] <- 1
36 | #' Cholesky(param = c(2, 4, 1), format = format, decompositions = TRUE)
37 | #' @export
38 | Cholesky <- function(param = NULL, format = NULL, decompositions = TRUE) {
39 |
40 | # Check if at least one of param and format is specified
41 | if (is.null(param) && is.null(format)) {
42 | stop(
43 | paste(
44 | "Both `param` and `format` were not specified.",
45 | "Must specify at least one of them."
46 | ),
47 | call. = FALSE
48 | )
49 | }
50 |
51 | # Number of parameters that are specified
52 | param <- param[!is.na(param)]
53 | n_par <- length(param)
54 |
55 | # If no format is specified
56 | if (is.null(format)) {
57 |
58 | # Calculate the dimension using the number of parameters that are specified
59 | dimension <- (-1 + sqrt(1 + 8 * n_par)) / 2
60 |
61 | # if calculated dimension is not an integer, return an error message
62 | if ((dimension %% 1) != 0) {
63 | stop(
64 | paste(
65 | "Number of parameters supplied result in non-integer dimensions",
66 | "of the variance - covariance matrix,",
67 | "specify a correct number of parameters.",
68 | "Hint: The dimension is calculated as (-1 + sqrt(1 + 8 * n_par))/2."
69 | ),
70 | call. = FALSE
71 | )
72 | }
73 |
74 | # LDL Cholesky algorithm for covariance matrix
75 | # L matrix: Putting ones on the diagonal
76 | # and the parameters on the lower triangle of the matrix
77 | # D matrix: Diagonal matrix containing the magnitudes
78 | chol_L <- diag(1, dimension, dimension)
79 | chol_L[lower.tri(chol_L)] <- param[(dimension + 1):n_par]
80 | chol_D <- exp(2 * param[1:dimension])
81 | if (any(chol_D <= 1e-7)) {
82 | return(NA)
83 | }
84 | chol_D <- diag(chol_D, dimension, dimension)
85 |
86 | # If format is specified
87 | } else {
88 |
89 | # Dimension of format
90 | format_dim <- dim(format)
91 |
92 | # Number of columns must not exceed the number of rows
93 | if (format_dim[[1]] < format_dim[[2]]) {
94 | stop(
95 | paste(
96 | "Number of columns of `format` must be less than",
97 | "or equal to the number of rows."
98 | ),
99 | call. = FALSE
100 | )
101 | }
102 |
103 | # Only the lower triangle (including diagonal) of the format is needed,
104 | # because the LDL decomposition uses a lower triangular Loading matrix
105 | format[upper.tri(format)] <- 0
106 |
107 | # Non zero elements of the format
108 | format_n0 <- format != 0
109 |
110 | # Non zero elements of the lower triangular part of the format
111 | format_n0_lt <- format_n0 & lower.tri(format)
112 |
113 | # Non zero elements of the diagonal of the format
114 | format_n0_diag <- diag(format_n0)
115 |
116 | # Number of parameters required for the matrix (lower + diagonal)
117 | lower <- sum(format_n0_lt)
118 | diagonal <- sum(format_n0_diag)
119 |
120 | # Check if magnitudes that are set to 0, have non-zero coefficients
121 | # specified in the loading matrix L
122 | if (diagonal < sum(colSums(format_n0) != 0)) {
123 | stop(
124 | paste(
125 | "The specified format is not valid.",
126 | "Columns of which the diagonal element is zero,",
127 | "should be set to zero."
128 | ),
129 | call. = FALSE
130 | )
131 | }
132 |
133 | # If format is a matrix of zeroes, return the format itself
134 | if (diagonal == 0) {
135 | return(format)
136 | }
137 |
138 | # Check if more parameters are specified than needed
139 | if ((lower + diagonal) < n_par) {
140 | stop("Too many parameters supplied.", call. = FALSE)
141 | }
142 |
143 | # Check if not enough parameters are specified
144 | if ((lower + diagonal) > n_par) {
145 | stop("Not enough parameters supplied.", call. = FALSE)
146 | }
147 |
148 | # Initialising L matrix with specified dimensions
149 | chol_L <- diag(1, format_dim[[1]], format_dim[[2]])
150 |
151 | # Putting the parameters into the right places according to format
152 | if (lower > 0) {
153 | chol_L[format_n0_lt] <- param[(diagonal + 1):(diagonal + lower)]
154 | }
155 |
156 | # Constructing D matrix
157 | param_diag <- rep(0, format_dim[[2]])
158 | param_diag_non0 <- exp(2 * param[1:diagonal])
159 | if (any(param_diag_non0 <= 1e-7)) {
160 | return(NA)
161 | }
162 | param_diag[format_n0_diag] <- param_diag_non0
163 | chol_D <- diag(param_diag, format_dim[[2]], format_dim[[2]])
164 | }
165 |
166 | # LDL Cholesky algorithm, resulting in a valid Variance - Covariance matrix
167 | cov_mat <- tcrossprod(chol_L %*% chol_D, chol_L)
168 |
169 | # Returning the result
170 | if (decompositions) {
171 |
172 | # Diagonal matrix containing the standard deviations
173 | stdev_matrix <- diag(sqrt(diag(cov_mat)), dim(cov_mat)[[1]], dim(cov_mat)[[2]])
174 |
175 | # Inverse of stdev_matrix
176 | stdev_inv <- stdev_matrix
177 | diag(stdev_inv)[diag(stdev_inv) > 0] <-
178 | 1 / diag(stdev_inv)[diag(stdev_inv) > 0]
179 |
180 | # Correlation matrix
181 | correlation_matrix <- stdev_inv %*% cov_mat %*% stdev_inv
182 |
183 | result <- list(
184 | cov_mat = cov_mat,
185 | loading_matrix = chol_L,
186 | diagonal_matrix = chol_D,
187 | correlation_matrix = correlation_matrix,
188 | stdev_matrix = stdev_matrix
189 | )
190 | return(result)
191 | } else {
192 | return(cov_mat)
193 | }
194 | }
195 |
--------------------------------------------------------------------------------
/R/AnsleyKohn.R:
--------------------------------------------------------------------------------
1 | #' Transform arbitrary matrices into partial autocorrelation matrices
2 | #'
3 | #' Creates valid partial autocorrelation matrices.
4 | #'
5 | #' @param A An array of arbitrary square matrices in the multivariate case,
6 | #' or a vector of arbitrary numbers in the univariate case.
7 | #'
8 | #' @return An array of partial autocorrelation matrices in the multivariate
9 | #' case, or a vector of partial autocorrelations in the univariate case.
10 | #'
11 | #' @noRd
12 | PACMat <- function(A) {
13 |
14 | # If univariate, computations are less expensive
15 | if (is.vector(A)) {
16 | return(A / sqrt(1 + A^2))
17 | }
18 |
19 | # Multivariate, for a single partial autocorrelation matrix
20 | if (is.matrix(A)) {
21 | return(crossprod(solve(chol(diag(dim(A)[[1]]) + tcrossprod(A))), A))
22 | }
23 |
24 | # Multivariate, for multiple partial autocorrelation matrices
25 | return(array(apply(A, 3, PACMat), dim = dim(A)))
26 | }
27 |
28 | #' Transform partial autocorrelation matrices into coefficient matrices
29 | #'
30 | #' Creates coefficient matrices for which the characteristic polynomial
31 | #' corresponds to a stationary process. Note, this function covers a
32 | #' subset of the space of coefficient matrices that correspond to a
33 | #' stationary process.
34 | #'
35 | #' @param P An array of partial autocorrelation matrices in the multivariate
36 | #' case, or a vector of partial autocorrelations in the univariate case.
37 | #'
38 | #' @return
39 | #' Multivariate case:
40 | #' A list containing:
41 | #' An array of coefficient matrices.
42 | #' Variance - covariance matrix of the noise, in order to transform
43 | #' coefficients further.
44 | #' Univariate case:
45 | #' A vector of coefficients.
46 | #'
47 | #' @noRd
48 | TransformPAC <- function(P) {
49 |
50 | # Initialise
51 | coeff_new <- P
52 |
53 | # If univariate, computations are less expensive
54 | if (is.vector(P)) {
55 | if (length(P) > 1) {
56 | for (i in 1:(length(P) - 1)) {
57 | coeff_old <- coeff_new
58 | for (j in 1:i) {
59 | coeff_new[[j]] <- coeff_old[[j]] -
60 | coeff_new[[i + 1]] * coeff_old[[i - j + 1]]
61 | }
62 | }
63 | }
64 | return(coeff_new)
65 | }
66 |
67 | # Multivariate
68 | # Initialise with i = 0
69 | sigma_new <- diag(dim(P)[[1]]) - tcrossprod(coeff_new[, , 1])
70 |
71 | if (dim(P)[[3]] > 1) {
72 |
73 | # i = 0
74 | coeff_star_new <- P
75 | coeff_star_new[, , 1] <- t(P[, , 1])
76 | sigma_star_new <- diag(dim(P)[[1]]) - tcrossprod(coeff_star_new[, , 1])
77 | L <- t(chol(sigma_new))
78 | L_star <- t(chol(sigma_star_new))
79 |
80 | for (i in 1:(dim(P)[[3]] - 1)) {
81 |
82 | # Storing former values
83 | coeff_old <- coeff_new
84 | coeff_star_old <- coeff_star_new
85 | sigma_old <- sigma_new
86 | sigma_star_old <- sigma_star_new
87 |
88 | # Calculating new values
89 | coeff_new[, , i + 1] <- L %*% P[, , i + 1] %*% solve(L_star)
90 | sigma_new <- sigma_old - tcrossprod(
91 | coeff_new[, , i + 1] %*% sigma_star_old,
92 | coeff_new[, , i + 1]
93 | )
94 | if (i < (dim(P)[[3]] - 1)) {
95 | coeff_star_new[, , i + 1] <- tcrossprod(L_star, P[, , i + 1]) %*%
96 | solve(L)
97 | sigma_star_new <- sigma_star_old - tcrossprod(
98 | coeff_star_new[, , i + 1] %*% sigma_old,
99 | coeff_star_new[, , i + 1]
100 | )
101 | L_star <- t(chol(sigma_star_new))
102 | L <- t(chol(sigma_new))
103 | }
104 | for (j in 1:i) {
105 | coeff_new[, , j] <- coeff_old[, , j] -
106 | coeff_new[, , i + 1] %*% coeff_star_old[, , i - j + 1]
107 | if (i < (dim(P)[[3]] - 1)) {
108 | coeff_star_new[, , j] <- coeff_star_old[, , j] -
109 | coeff_star_new[, , i + 1] %*% coeff_old[, , i - j + 1]
110 | }
111 | }
112 | }
113 | }
114 | return(list(coeff = coeff_new, variance = sigma_new))
115 | }
116 |
117 | #' Transform arbitrary matrices into ARMA coefficient matrices
118 | #'
119 | #' Creates coefficient matrices for which the characteristic polynomial
120 | #' corresponds to a stationary process.
121 | #' See \insertCite{ansley1986note;textual}{statespacer} for details about
122 | #' the transformation used.
123 | #'
124 | #' @param A An array of arbitrary square matrices in the multivariate case,
125 | #' or a vector of arbitrary numbers in the univariate case.
126 | #' @param variance A variance - covariance matrix.
127 | #' Note: `variance` not needed for the univariate case!
128 | #' @param ar The order of the AR part.
129 | #' @param ma The order of the MA part.
130 | #'
131 | #' @return
132 | #' If multivariate, a list containing:
133 | #' * An array of coefficient matrices for the AR part.
134 | #' * An array of coefficient matrices for the MA part.
135 | #'
136 | #' If univariate, a list containing:
137 | #' * A vector of coefficients for the AR part.
138 | #' * A vector of coefficients for the MA part.
139 | #'
140 | #' @author Dylan Beijers, \email{dylanbeijers@@gmail.com}
141 | #'
142 | #' @references
143 | #' \insertRef{ansley1986note}{statespacer}
144 | #'
145 | #' @examples
146 | #' CoeffARMA(A = stats::rnorm(2), ar = 1, ma = 1)
147 | #' @export
148 | CoeffARMA <- function(A, variance = NULL, ar = 1, ma = 0) {
149 |
150 | # Check for erroneous input
151 | if (ar < 0) {
152 | stop("The order of the autoregressive part must be >= 0.", call. = FALSE)
153 | }
154 | if (ma < 0) {
155 | stop("The order of the moving average part must be >= 0.", call. = FALSE)
156 | }
157 | if (ar + ma == 0) {
158 | stop(
159 | "At least one of the orders of the AR and MA parts must be positive.",
160 | call. = FALSE
161 | )
162 | }
163 |
164 | # Initialise list to return
165 | result <- list()
166 |
167 | # Check if array contains square matrices
168 | if (is.array(A)) {
169 | if (dim(A)[1] != dim(A)[[2]]) {
170 | stop("Matrices in `A` must be square matrices.", call. = FALSE)
171 | }
172 | }
173 |
174 | # Obtain partial autocorrelation matrices
175 | P <- PACMat(A)
176 |
177 | # If univariate, coefficients are readily returned by TransformPAC
178 | if (is.vector(P)) {
179 | if (ar > 0) {
180 | P_ar <- P[1:ar]
181 | result$ar <- TransformPAC(P_ar)
182 | }
183 | if (ma > 0) {
184 | P_ma <- P[(ar + 1):(ar + ma)]
185 | result$ma <- -TransformPAC(P_ma) # Note the minus sign
186 | }
187 | return(result)
188 | }
189 |
190 | # Cholesky decomposition of variance - covariance matrix
191 | L <- t(chol(variance))
192 | L_inv <- solve(L)
193 |
194 | # Obtain coefficient matrices for AR part
195 | if (ar > 0) {
196 | P_ar <- P[, , 1:ar, drop = FALSE]
197 | ar_part <- TransformPAC(P_ar)
198 | L_ar <- t(chol(ar_part$variance))
199 | L_ar_inv <- solve(L_ar)
200 | result$ar <- array(
201 | apply(
202 | ar_part$coeff, 3,
203 | function(x) L %*% L_ar_inv %*% x %*% L_ar %*% L_inv
204 | ),
205 | dim = dim(ar_part$coeff)
206 | )
207 | }
208 |
209 | # Obtain coefficient matrices for MA part
210 | if (ma > 0) {
211 | P_ma <- P[, , (ar + 1):(ar + ma), drop = FALSE]
212 | ma_part <- TransformPAC(P_ma)
213 | L_ma <- t(chol(ma_part$variance))
214 | L_ma_inv <- solve(L_ma)
215 | result$ma <- -array( # Note the minus sign
216 | apply(
217 | ma_part$coeff, 3,
218 | function(x) L %*% L_ma_inv %*% x %*% L_ma %*% L_inv
219 | ),
220 | dim = dim(ma_part$coeff)
221 | )
222 | }
223 | return(result)
224 | }
225 |
--------------------------------------------------------------------------------
/src/RcppExports.cpp:
--------------------------------------------------------------------------------
1 | // Generated by using Rcpp::compileAttributes() -> do not edit by hand
2 | // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
3 |
4 | #include
5 | #include
6 |
7 | using namespace Rcpp;
8 |
9 | #ifdef RCPP_USE_GLOBAL_ROSTREAM
10 | Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get();
11 | Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get();
12 | #endif
13 |
14 | // ExtractComponentC
15 | arma::cube ExtractComponentC(const arma::cube& a, const arma::cube& Z);
16 | RcppExport SEXP _statespacer_ExtractComponentC(SEXP aSEXP, SEXP ZSEXP) {
17 | BEGIN_RCPP
18 | Rcpp::RObject rcpp_result_gen;
19 | Rcpp::RNGScope rcpp_rngScope_gen;
20 | Rcpp::traits::input_parameter< const arma::cube& >::type a(aSEXP);
21 | Rcpp::traits::input_parameter< const arma::cube& >::type Z(ZSEXP);
22 | rcpp_result_gen = Rcpp::wrap(ExtractComponentC(a, Z));
23 | return rcpp_result_gen;
24 | END_RCPP
25 | }
26 | // FastSmootherC
27 | Rcpp::List FastSmootherC(const arma::cube& y, const arma::colvec& a, const arma::mat& P_inf, const arma::mat& P_star, const arma::cube& Z, const arma::cube& T, const arma::cube& R, const arma::cube& Q, const int& initialisation_steps, const bool& transposed_state);
28 | RcppExport SEXP _statespacer_FastSmootherC(SEXP ySEXP, SEXP aSEXP, SEXP P_infSEXP, SEXP P_starSEXP, SEXP ZSEXP, SEXP TSEXP, SEXP RSEXP, SEXP QSEXP, SEXP initialisation_stepsSEXP, SEXP transposed_stateSEXP) {
29 | BEGIN_RCPP
30 | Rcpp::RObject rcpp_result_gen;
31 | Rcpp::RNGScope rcpp_rngScope_gen;
32 | Rcpp::traits::input_parameter< const arma::cube& >::type y(ySEXP);
33 | Rcpp::traits::input_parameter< const arma::colvec& >::type a(aSEXP);
34 | Rcpp::traits::input_parameter< const arma::mat& >::type P_inf(P_infSEXP);
35 | Rcpp::traits::input_parameter< const arma::mat& >::type P_star(P_starSEXP);
36 | Rcpp::traits::input_parameter< const arma::cube& >::type Z(ZSEXP);
37 | Rcpp::traits::input_parameter< const arma::cube& >::type T(TSEXP);
38 | Rcpp::traits::input_parameter< const arma::cube& >::type R(RSEXP);
39 | Rcpp::traits::input_parameter< const arma::cube& >::type Q(QSEXP);
40 | Rcpp::traits::input_parameter< const int& >::type initialisation_steps(initialisation_stepsSEXP);
41 | Rcpp::traits::input_parameter< const bool& >::type transposed_state(transposed_stateSEXP);
42 | rcpp_result_gen = Rcpp::wrap(FastSmootherC(y, a, P_inf, P_star, Z, T, R, Q, initialisation_steps, transposed_state));
43 | return rcpp_result_gen;
44 | END_RCPP
45 | }
46 | // KalmanC
47 | Rcpp::List KalmanC(const arma::mat& y, const Rcpp::LogicalMatrix& y_isna, const arma::colvec& a, const arma::mat& P_inf, const arma::mat& P_star, const arma::cube& Z, const arma::cube& T, const arma::cube& R, const arma::cube& Q, const bool& diagnostics);
48 | RcppExport SEXP _statespacer_KalmanC(SEXP ySEXP, SEXP y_isnaSEXP, SEXP aSEXP, SEXP P_infSEXP, SEXP P_starSEXP, SEXP ZSEXP, SEXP TSEXP, SEXP RSEXP, SEXP QSEXP, SEXP diagnosticsSEXP) {
49 | BEGIN_RCPP
50 | Rcpp::RObject rcpp_result_gen;
51 | Rcpp::RNGScope rcpp_rngScope_gen;
52 | Rcpp::traits::input_parameter< const arma::mat& >::type y(ySEXP);
53 | Rcpp::traits::input_parameter< const Rcpp::LogicalMatrix& >::type y_isna(y_isnaSEXP);
54 | Rcpp::traits::input_parameter< const arma::colvec& >::type a(aSEXP);
55 | Rcpp::traits::input_parameter< const arma::mat& >::type P_inf(P_infSEXP);
56 | Rcpp::traits::input_parameter< const arma::mat& >::type P_star(P_starSEXP);
57 | Rcpp::traits::input_parameter< const arma::cube& >::type Z(ZSEXP);
58 | Rcpp::traits::input_parameter< const arma::cube& >::type T(TSEXP);
59 | Rcpp::traits::input_parameter< const arma::cube& >::type R(RSEXP);
60 | Rcpp::traits::input_parameter< const arma::cube& >::type Q(QSEXP);
61 | Rcpp::traits::input_parameter< const bool& >::type diagnostics(diagnosticsSEXP);
62 | rcpp_result_gen = Rcpp::wrap(KalmanC(y, y_isna, a, P_inf, P_star, Z, T, R, Q, diagnostics));
63 | return rcpp_result_gen;
64 | END_RCPP
65 | }
66 | // LogLikC
67 | double LogLikC(const Rcpp::NumericMatrix& y, const Rcpp::LogicalMatrix& y_isna, arma::colvec a, arma::mat P_inf, arma::mat P_star, const arma::cube& Z, const arma::cube& T, const arma::cube& R, const arma::cube& Q);
68 | RcppExport SEXP _statespacer_LogLikC(SEXP ySEXP, SEXP y_isnaSEXP, SEXP aSEXP, SEXP P_infSEXP, SEXP P_starSEXP, SEXP ZSEXP, SEXP TSEXP, SEXP RSEXP, SEXP QSEXP) {
69 | BEGIN_RCPP
70 | Rcpp::RObject rcpp_result_gen;
71 | Rcpp::RNGScope rcpp_rngScope_gen;
72 | Rcpp::traits::input_parameter< const Rcpp::NumericMatrix& >::type y(ySEXP);
73 | Rcpp::traits::input_parameter< const Rcpp::LogicalMatrix& >::type y_isna(y_isnaSEXP);
74 | Rcpp::traits::input_parameter< arma::colvec >::type a(aSEXP);
75 | Rcpp::traits::input_parameter< arma::mat >::type P_inf(P_infSEXP);
76 | Rcpp::traits::input_parameter< arma::mat >::type P_star(P_starSEXP);
77 | Rcpp::traits::input_parameter< const arma::cube& >::type Z(ZSEXP);
78 | Rcpp::traits::input_parameter< const arma::cube& >::type T(TSEXP);
79 | Rcpp::traits::input_parameter< const arma::cube& >::type R(RSEXP);
80 | Rcpp::traits::input_parameter< const arma::cube& >::type Q(QSEXP);
81 | rcpp_result_gen = Rcpp::wrap(LogLikC(y, y_isna, a, P_inf, P_star, Z, T, R, Q));
82 | return rcpp_result_gen;
83 | END_RCPP
84 | }
85 | // SimulateC
86 | Rcpp::List SimulateC(const int& nsim, const int& repeat_Q, const int& N, const arma::colvec& a, const arma::cube& Z, const arma::cube& T, const arma::cube& R, const arma::cube& Q, const arma::mat& P_star, const bool& draw_initial, const bool& eta_only, const bool& transposed_state);
87 | RcppExport SEXP _statespacer_SimulateC(SEXP nsimSEXP, SEXP repeat_QSEXP, SEXP NSEXP, SEXP aSEXP, SEXP ZSEXP, SEXP TSEXP, SEXP RSEXP, SEXP QSEXP, SEXP P_starSEXP, SEXP draw_initialSEXP, SEXP eta_onlySEXP, SEXP transposed_stateSEXP) {
88 | BEGIN_RCPP
89 | Rcpp::RObject rcpp_result_gen;
90 | Rcpp::RNGScope rcpp_rngScope_gen;
91 | Rcpp::traits::input_parameter< const int& >::type nsim(nsimSEXP);
92 | Rcpp::traits::input_parameter< const int& >::type repeat_Q(repeat_QSEXP);
93 | Rcpp::traits::input_parameter< const int& >::type N(NSEXP);
94 | Rcpp::traits::input_parameter< const arma::colvec& >::type a(aSEXP);
95 | Rcpp::traits::input_parameter< const arma::cube& >::type Z(ZSEXP);
96 | Rcpp::traits::input_parameter< const arma::cube& >::type T(TSEXP);
97 | Rcpp::traits::input_parameter< const arma::cube& >::type R(RSEXP);
98 | Rcpp::traits::input_parameter< const arma::cube& >::type Q(QSEXP);
99 | Rcpp::traits::input_parameter< const arma::mat& >::type P_star(P_starSEXP);
100 | Rcpp::traits::input_parameter< const bool& >::type draw_initial(draw_initialSEXP);
101 | Rcpp::traits::input_parameter< const bool& >::type eta_only(eta_onlySEXP);
102 | Rcpp::traits::input_parameter< const bool& >::type transposed_state(transposed_stateSEXP);
103 | rcpp_result_gen = Rcpp::wrap(SimulateC(nsim, repeat_Q, N, a, Z, T, R, Q, P_star, draw_initial, eta_only, transposed_state));
104 | return rcpp_result_gen;
105 | END_RCPP
106 | }
107 |
108 | static const R_CallMethodDef CallEntries[] = {
109 | {"_statespacer_ExtractComponentC", (DL_FUNC) &_statespacer_ExtractComponentC, 2},
110 | {"_statespacer_FastSmootherC", (DL_FUNC) &_statespacer_FastSmootherC, 10},
111 | {"_statespacer_KalmanC", (DL_FUNC) &_statespacer_KalmanC, 10},
112 | {"_statespacer_LogLikC", (DL_FUNC) &_statespacer_LogLikC, 9},
113 | {"_statespacer_SimulateC", (DL_FUNC) &_statespacer_SimulateC, 12},
114 | {NULL, NULL, 0}
115 | };
116 |
117 | RcppExport void R_init_statespacer(DllInfo *dll) {
118 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
119 | R_useDynamicSymbols(dll, FALSE);
120 | }
121 |
--------------------------------------------------------------------------------
/docs/LICENSE-text.html:
--------------------------------------------------------------------------------
1 |
2 | License • statespacer
6 |
7 |
8 |
9 |
67 |
68 |
69 |
70 |
71 |
72 |
73 | License
74 |
75 |
76 | YEAR: 2020
77 | COPYRIGHT HOLDER: Dylan Beijers
78 |
79 |
80 |
81 |
82 |
85 |
86 |
87 |
88 |
89 |
90 |
99 |
100 |
101 |
116 |
117 |
--------------------------------------------------------------------------------
`).
76 | getTopLevel: function($scope) {
77 | for (var i = 1; i <= 6; i++) {
78 | var $headings = this.findOrFilter($scope, 'h' + i);
79 | if ($headings.length > 1) {
80 | return i;
81 | }
82 | }
83 |
84 | return 1;
85 | },
86 |
87 | // returns the elements for the top level, and the next below it
88 | getHeadings: function($scope, topLevel) {
89 | var topSelector = 'h' + topLevel;
90 |
91 | var secondaryLevel = topLevel + 1;
92 | var secondarySelector = 'h' + secondaryLevel;
93 |
94 | return this.findOrFilter($scope, topSelector + ',' + secondarySelector);
95 | },
96 |
97 | getNavLevel: function(el) {
98 | return parseInt(el.tagName.charAt(1), 10);
99 | },
100 |
101 | populateNav: function($topContext, topLevel, $headings) {
102 | var $context = $topContext;
103 | var $prevNav;
104 |
105 | var helpers = this;
106 | $headings.each(function(i, el) {
107 | var $newNav = helpers.generateNavItem(el);
108 | var navLevel = helpers.getNavLevel(el);
109 |
110 | // determine the proper $context
111 | if (navLevel === topLevel) {
112 | // use top level
113 | $context = $topContext;
114 | } else if ($prevNav && $context === $topContext) {
115 | // create a new level of the tree and switch to it
116 | $context = helpers.createChildNavList($prevNav);
117 | } // else use the current $context
118 |
119 | $context.append($newNav);
120 |
121 | $prevNav = $newNav;
122 | });
123 | },
124 |
125 | parseOps: function(arg) {
126 | var opts;
127 | if (arg.jquery) {
128 | opts = {
129 | $nav: arg
130 | };
131 | } else {
132 | opts = arg;
133 | }
134 | opts.$scope = opts.$scope || $(document.body);
135 | return opts;
136 | }
137 | },
138 |
139 | // accepts a jQuery object, or an options object
140 | init: function(opts) {
141 | opts = this.helpers.parseOps(opts);
142 |
143 | // ensure that the data attribute is in place for styling
144 | opts.$nav.attr('data-toggle', 'toc');
145 |
146 | var $topContext = this.helpers.createChildNavList(opts.$nav);
147 | var topLevel = this.helpers.getTopLevel(opts.$scope);
148 | var $headings = this.helpers.getHeadings(opts.$scope, topLevel);
149 | this.helpers.populateNav($topContext, topLevel, $headings);
150 | }
151 | };
152 |
153 | $(function() {
154 | $('nav[data-toggle="toc"]').each(function(i, el) {
155 | var $nav = $(el);
156 | Toc.init($nav);
157 | });
158 | });
159 | })();
160 |
--------------------------------------------------------------------------------
/vignettes/boxjenkins.Rmd:
--------------------------------------------------------------------------------
1 | ---
2 | title: "Fitting ARIMA models with statespacer"
3 | description: >
4 | A lot of time series practitiones resort to the well-known Box-Jenkins
5 | methods, such as ARIMA and SARIMA, when modelling time series. Those methods
6 | are easily incorporated into the State Space framework. This provides to be
7 | beneficial, as missing observations are easily dealt with in the State Space
8 | framework. Moreover, no observations need to be discarded due to the
9 | differencing and introduced lagged variables. The loglikelihood is calculated in an
10 | exact manner! In this document, we'll show you how to estimate ARIMA and
11 | SARIMA models using statespacer.
12 | output: rmarkdown::html_vignette
13 | bibliography: ../inst/REFERENCES.bib
14 | vignette: >
15 | %\VignetteIndexEntry{Fitting ARIMA models with statespacer}
16 | %\VignetteEngine{knitr::rmarkdown}
17 | %\VignetteEncoding{UTF-8}
18 | ---
19 |
20 | ```{r, include = FALSE}
21 | knitr::opts_chunk$set(
22 | collapse = TRUE,
23 | comment = "#>"
24 | )
25 | ```
26 |
27 | A lot of time series practitioners resort to the well-known Box-Jenkins methods, such as ARIMA and SARIMA, when modelling time series. Those methods are easily incorporated into the State Space framework. This provides to be beneficial, as missing observations are easily dealt with in the State Space framework. Moreover, no observations need to be discarded due to the differencing and introduced lagged variables. The loglikelihood is calculated in an exact manner! In this document, we show you how to estimate ARIMA and SARIMA models using statespacer. We reproduce some estimation results as in @box2015time.
28 |
29 | ## ARIMA modelling of the yearly sunspot data
30 | To showcase the estimation of ARIMA models, we make use of the `sunspot.year` data, which contains yearly numbers of sunspots from 1700 to 1988. See `?sunspot.year` for details. We only use the data from 1770 to 1869, to stay in line with @box2015time. We estimate an $\text{ARIMA}(3, ~ 0, ~ 0)$ with deterministic level (or constant if you prefer) as follows:
31 |
32 | ```{r, setup}
33 | # Load statespacer
34 | library(statespacer)
35 |
36 | # Load the dataset
37 | library(datasets)
38 | Data <- matrix(window(sunspot.year, start = 1770, end = 1869))
39 |
40 | # Estimate the ARIMA model
41 | fit <- statespacer(y = Data,
42 | H_format = matrix(0),
43 | local_level_ind = TRUE,
44 | arima_list = list(c(3, 0, 0)),
45 | format_level = matrix(0),
46 | initial = c(0.5*log(var(Data)), 0, 0, 0),
47 | verbose = TRUE,
48 | standard_errors = TRUE)
49 | ```
50 |
51 | Note that we eliminate the observation error by setting its variance to 0, although it's perfectly fine to include observation errors along with ARIMA models, as long as you watch out for identification issues of course. For details about specifying proper initial values, please see `vignette("dictionary", "statespacer")`.
52 |
53 | We obtain the following estimates:
54 |
55 | ```{r}
56 | # Coefficients of the ARMA component
57 | arma_coeff <- rbind(
58 | fit$system_matrices$AR$ARIMA1,
59 | fit$standard_errors$AR$ARIMA1
60 | )
61 | arma_coeff <- cbind(
62 | arma_coeff,
63 | c(fit$smoothed$level[1],
64 | sqrt(fit$system_matrices$Z_padded$level %*%
65 | fit$smoothed$V[,,1] %*%
66 | t(fit$system_matrices$Z_padded$level))
67 | )
68 | )
69 | rownames(arma_coeff) <- c("coefficient", "std_error")
70 | colnames(arma_coeff) <- c("ar1", "ar2", "ar3", "intercept")
71 | arma_coeff
72 |
73 | goodness_fit <- rbind(
74 | fit$system_matrices$Q$ARIMA1,
75 | fit$diagnostics$loglik,
76 | fit$diagnostics$AIC
77 | )
78 | rownames(goodness_fit) <- c("Variance", "Loglikelihood", "AIC")
79 | goodness_fit
80 | ```
81 |
82 | We see that the results are fairly similar to the results as obtained by @box2015time. Differences may occur due to the different estimation procedures. We don't have to eliminate observations, so we use the full information available at hand, in contrast to traditional estimation procedures. Note that not much has to be done to estimate VARIMA models. In fact, you only need to specify a dependent variable `y` that has more than one column! It's also straightforward to add explanatory variables, by making use of the `addvar_list` option, see `vignette("seatbelt", "statespacer")` for an example of adding explanatory variables.
83 |
84 | ## SARIMA modelling of the airline data
85 | To showcase the estimation of SARIMA models, we make use of the classic `AirPassengers` data, which contains monthly totals of international airline passengers from 1949 to 1960. See `?AirPassengers` for details. We estimate a $\text{SARIMA}(0, ~ 1, ~ 1)_{1} ~ \times ~ (0, ~ 1, ~ 1)_{12}$. Note that in the multivariate case, there is a subtle difference between $\text{SARIMA}(0, ~ 1, ~ 1)_{1} ~ \times ~ (0, ~ 1, ~ 1)_{12}$ and $\text{SARIMA}(0, ~ 1, ~ 1)_{12} ~ \times ~ (0, ~ 1, ~ 1)_{1}$ as matrix multiplication is not commutative.
86 |
87 | We proceed as follows:
88 | ```{r, warning = FALSE}
89 | # Load the dataset
90 | Data <- matrix(log(AirPassengers))
91 |
92 | # The SARIMA specification, must be a list containing lists!
93 | sarima_list <- list(list(s = c(12, 1), ar = c(0, 0), i = c(1, 1), ma = c(1, 1)))
94 |
95 | # Fit the SARIMA model
96 | fit <- statespacer(y = Data,
97 | H_format = matrix(0),
98 | sarima_list = sarima_list,
99 | initial = c(0.5*log(var(diff(Data))), 0, 0),
100 | verbose = TRUE)
101 | ```
102 |
103 | We obtain the following estimates:
104 |
105 | ```{r}
106 | # Coefficients of the ARMA component
107 | arma_coeff <- rbind(
108 | c(fit$system_matrices$SMA$SARIMA1$S1, fit$system_matrices$SMA$SARIMA1$S12),
109 | c(fit$standard_errors$SMA$SARIMA1$S1, fit$standard_errors$SMA$SARIMA1$S12)
110 | )
111 |
112 | rownames(arma_coeff) <- c("coefficient", "std_error")
113 | colnames(arma_coeff) <- c("ma1 s = 1", "ma1 s = 12")
114 | arma_coeff
115 |
116 | goodness_fit <- rbind(
117 | fit$system_matrices$Q$SARIMA1,
118 | fit$diagnostics$loglik,
119 | fit$diagnostics$AIC
120 | )
121 | rownames(goodness_fit) <- c("Variance", "Loglikelihood", "AIC")
122 | goodness_fit
123 | ```
124 |
125 | As you can see, fitting the Box-Jenkins models with statespacer is quite easy!
126 |
127 | ## References
128 |
--------------------------------------------------------------------------------
/src/LogLikC.cpp:
--------------------------------------------------------------------------------
1 | #include
2 | // [[Rcpp::depends(RcppArmadillo)]
3 |
4 | //' Employ the Kalman Filter to calculate the loglikelihood
5 | //'
6 | //' @param y Matrix of observations.
7 | //' @param y_isna Matrix indicating which observations are missing.
8 | //' @param a Initial values of the state vector.
9 | //' @param P_inf Diffuse part of the variance - covariance matrix of the
10 | //' state vector.
11 | //' @param P_star Stationary part of the variance - covariance matrix of the
12 | //' state vector.
13 | //' @param Z Z system matrix of the State Space model.
14 | //' @param T T system matrix of the State Space model.
15 | //' @param R R system matrix of the State Space model.
16 | //' @param Q Q system matrix of the State Space model.
17 | //'
18 | //' @noRd
19 | // [[Rcpp::export]]
20 | double LogLikC(const Rcpp::NumericMatrix& y,
21 | const Rcpp::LogicalMatrix& y_isna,
22 | arma::colvec a,
23 | arma::mat P_inf,
24 | arma::mat P_star,
25 | const arma::cube& Z,
26 | const arma::cube& T,
27 | const arma::cube& R,
28 | const arma::cube& Q) {
29 |
30 | // Number of observations, dependent variables, and state parameters
31 | int N = y.nrow(), p = y.ncol(), m = a.n_rows;
32 |
33 | // Keep track of the limits of the indices
34 | int N_min1 = N - 1, p_min1 = p - 1;
35 |
36 | // Check which system matrices are time-varying
37 | bool Z_tv = Z.n_slices > 1, T_tv = T.n_slices > 1,
38 | R_tv = R.n_slices > 1, Q_tv = Q.n_slices > 1;
39 |
40 | // Initial system matrices
41 | arma::mat Z_mat = Z.slice(0), T_mat = T.slice(0),
42 | R_mat = R.slice(0), Q_mat = Q.slice(0);
43 | arma::rowvec Z_row = Z_mat.row(0);
44 |
45 | // Indicator for whether the first row should be assigned
46 | bool row_assign = Z_tv || p > 1;
47 |
48 | // Check if P_inf is already 0
49 | bool initialisation = !arma::all(arma::vectorise(arma::abs(P_inf)) < 1e-7);
50 |
51 | // Initialise number of non-initialisation steps
52 | // and number of occurrences that F = 0
53 | int non_init = 0, F_eq0 = 0;
54 |
55 | // Initialise loglikelihood
56 | double loglik = 0;
57 |
58 | // Initialise objects used in computations
59 | arma::colvec M_inf(m), M_star(m), K_0(m), K_1(m);
60 | arma::mat L_0(m, m), L_1(m, m);
61 | double F_inf, F_star, F_1, F_2, v;
62 | double constant = -log(2 * M_PI) / 2;
63 |
64 | // Iterators
65 | int i, j;
66 |
67 | // Loop over time points
68 | for (i = 0; i < N; i++) {
69 |
70 | // Get system matrices of current time point
71 | if (Z_tv && i > 0) {
72 | Z_mat = Z.slice(i);
73 | }
74 | if (T_tv && i > 0) {
75 | T_mat = T.slice(i);
76 | }
77 | if (R_tv && i > 0) {
78 | R_mat = R.slice(i);
79 | }
80 | if (Q_tv && i > 0) {
81 | Q_mat = Q.slice(i);
82 | }
83 |
84 | // Loop over dependent variables
85 | for (j = 0; j < p; j++) {
86 |
87 | // Check for missing value
88 | if (y_isna(i, j)) {
89 | continue;
90 | }
91 |
92 | // Retrieve row of Z
93 | if (j > 0 || (i > 0 && row_assign)) {
94 | Z_row = Z_mat.row(j);
95 | }
96 |
97 | // Exact Kalman filter in initialisation steps
98 | if (initialisation) {
99 |
100 | // PZ' as in Kalman formulae
101 | M_inf = P_inf * Z_row.t();
102 | M_star = P_star * Z_row.t();
103 |
104 | // Variance matrix of the current residual/fitted value
105 | F_inf = arma::as_scalar(Z_row * M_inf);
106 | F_star = arma::as_scalar(Z_row * M_star);
107 |
108 | // Check if F_inf is nearly 0
109 | if (F_inf < 1e-7) {
110 |
111 | // Check if F_star is nearly 0
112 | if (F_star < 1e-7) {
113 | continue;
114 | } else {
115 |
116 | // Inverse of Fmat
117 | F_1 = 1 / F_star;
118 |
119 | // Current residual
120 | v = y(i, j) - arma::as_scalar(Z_row * a);
121 |
122 | // Auxiliary matrices
123 | K_0 = M_star * F_1;
124 | L_0 = arma::mat(m, m, arma::fill::eye) - K_0 * Z_row;
125 |
126 | // Estimated state vector and corresponding variance - covariance
127 | // matrix for the next step
128 | a = a + K_0 * v;
129 | P_star = P_star * L_0.t();
130 | loglik += constant - (log(F_star) + pow(v, 2.0) * F_1) / 2;
131 | continue;
132 | }
133 | } else {
134 |
135 | // Inverse of Fmat
136 | F_1 = 1 / F_inf;
137 | F_2 = -pow(F_1, 2.0) * F_star;
138 |
139 | // Current residual
140 | v = y(i, j) - arma::as_scalar(Z_row * a);
141 |
142 | // Auxiliary matrices
143 | K_0 = M_inf * F_1;
144 | L_0 = arma::mat(m, m, arma::fill::eye) - K_0 * Z_row;
145 | K_1 = M_star * F_1 + M_inf * F_2;
146 | L_1 = -K_1 * Z_row;
147 |
148 | // Estimated state vector and corresponding variance - covariance
149 | // matrix for the next step
150 | a = a + K_0 * v;
151 | P_star = P_inf * L_1.t() + P_star * L_0.t();
152 | P_inf = P_inf * L_0.t();
153 | loglik += constant - log(F_inf) / 2;
154 | }
155 |
156 | // Check if P_inf converged to 0
157 | if (j < p_min1) {
158 | initialisation = !arma::all(arma::vectorise(arma::abs(P_inf)) < 1e-7);
159 | }
160 |
161 | } else {
162 |
163 | // Increment non_init
164 | non_init++;
165 |
166 | // PZ' as in Kalman formulae
167 | M_star = P_star * Z_row.t();
168 |
169 | // Variance matrix of the current residual/fitted value
170 | F_star = arma::as_scalar(Z_row * M_star);
171 |
172 | // Check if F_star is nearly 0
173 | if (F_star < 1e-7) {
174 |
175 | // Increment number of times F = 0
176 | F_eq0++;
177 |
178 | } else {
179 |
180 | // Inverse of Fmat
181 | F_1 = 1 / F_star;
182 |
183 | // Current residual
184 | v = y(i, j) - arma::as_scalar(Z_row * a);
185 |
186 | // Auxiliary matrices
187 | K_0 = M_star * F_1;
188 | L_0 = arma::mat(m, m, arma::fill::eye) - K_0 * Z_row;
189 |
190 | // Estimated state vector and corresponding variance - covariance
191 | // matrix for the next step
192 | a = a + K_0 * v;
193 | P_star = P_star * L_0.t();
194 | loglik += constant - (log(F_star) + pow(v, 2.0) * F_1) / 2;
195 | }
196 | }
197 | }
198 |
199 | // Perform computations for the next time point
200 | if (i < N_min1) {
201 | a = T_mat * a;
202 | P_star = T_mat * P_star * T_mat.t() + R_mat * Q_mat * R_mat.t();
203 | if (initialisation) {
204 | P_inf = T_mat * P_inf * T_mat.t();
205 | initialisation = !arma::all(arma::vectorise(arma::abs(P_inf)) < 1e-7);
206 | }
207 | }
208 | }
209 |
210 | // Return NA if F equals 0 during all of the non-initialisation steps
211 | if (non_init == F_eq0) {
212 | return NA_REAL;
213 | }
214 | return loglik / N;
215 | }
216 |
--------------------------------------------------------------------------------
/R/Cholesky.R:
--------------------------------------------------------------------------------
1 | #' Construct a Valid Variance - Covariance Matrix
2 | #'
3 | #' Constructs a valid variance - covariance matrix by using the Cholesky LDL
4 | #' decomposition.
5 | #'
6 | #' @param param Vector containing the parameters used to construct the
7 | #' variance - covariance matrix.
8 | #' @param format Matrix representing the format for the Loading matrix L
9 | #' and Diagonal matrix D. The lower triangular part of the format is used
10 | #' as the format for the Loading matrix L. The diagonal of the format is
11 | #' used as the format for the Diagonal matrix D. Must be a matrix.
12 | #' @param decompositions Boolean indicating whether the loading and diagonal
13 | #' matrix of the Cholesky decomposition, and the correlation matrix and
14 | #' standard deviations should be returned.
15 | #'
16 | #' @details
17 | #' `format` is used to specify which elements of the loading and diagonal
18 | #' matrix should be non-zero. The elements of `param` are then distributed
19 | #' along the non-zero elements of the loading and diagonal matrix.
20 | #' The parameters for the diagonal matrix are transformed using `exp(2 * x)`.
21 | #'
22 | #' @return
23 | #' A valid variance - covariance matrix.
24 | #' If `decompositions = TRUE` then it returns a list containing:
25 | #' * `cov_mat`: The variance - covariance matrix.
26 | #' * `loading_matrix`: The loading matrix of the Cholesky decomposition.
27 | #' * `diagonal_matrix`: The diagonal matrix of the Cholesky decomposition.
28 | #' * `correlation_matrix`: Matrix containing the correlations.
29 | #' * `stdev_matrix`: Matrix containing the standard deviations on the diagonal.
30 | #'
31 | #' @author Dylan Beijers, \email{dylanbeijers@@gmail.com}
32 | #'
33 | #' @examples
34 | #' format <- diag(1, 2, 2)
35 | #' format[2, 1] <- 1
36 | #' Cholesky(param = c(2, 4, 1), format = format, decompositions = TRUE)
37 | #' @export
38 | Cholesky <- function(param = NULL, format = NULL, decompositions = TRUE) {
39 |
40 | # Check if at least one of param and format is specified
41 | if (is.null(param) && is.null(format)) {
42 | stop(
43 | paste(
44 | "Both `param` and `format` were not specified.",
45 | "Must specify at least one of them."
46 | ),
47 | call. = FALSE
48 | )
49 | }
50 |
51 | # Number of parameters that are specified
52 | param <- param[!is.na(param)]
53 | n_par <- length(param)
54 |
55 | # If no format is specified
56 | if (is.null(format)) {
57 |
58 | # Calculate the dimension using the number of parameters that are specified
59 | dimension <- (-1 + sqrt(1 + 8 * n_par)) / 2
60 |
61 | # if calculated dimension is not an integer, return an error message
62 | if ((dimension %% 1) != 0) {
63 | stop(
64 | paste(
65 | "Number of parameters supplied result in non-integer dimensions",
66 | "of the variance - covariance matrix,",
67 | "specify a correct number of parameters.",
68 | "Hint: The dimension is calculated as (-1 + sqrt(1 + 8 * n_par))/2."
69 | ),
70 | call. = FALSE
71 | )
72 | }
73 |
74 | # LDL Cholesky algorithm for covariance matrix
75 | # L matrix: Putting ones on the diagonal
76 | # and the parameters on the lower triangle of the matrix
77 | # D matrix: Diagonal matrix containing the magnitudes
78 | chol_L <- diag(1, dimension, dimension)
79 | chol_L[lower.tri(chol_L)] <- param[(dimension + 1):n_par]
80 | chol_D <- exp(2 * param[1:dimension])
81 | if (any(chol_D <= 1e-7)) {
82 | return(NA)
83 | }
84 | chol_D <- diag(chol_D, dimension, dimension)
85 |
86 | # If format is specified
87 | } else {
88 |
89 | # Dimension of format
90 | format_dim <- dim(format)
91 |
92 | # Number of columns must not exceed the number of rows
93 | if (format_dim[[1]] < format_dim[[2]]) {
94 | stop(
95 | paste(
96 | "Number of columns of `format` must be less than",
97 | "or equal to the number of rows."
98 | ),
99 | call. = FALSE
100 | )
101 | }
102 |
103 | # Only the lower triangle (including diagonal) of the format is needed,
104 | # because the LDL decomposition uses a lower triangular Loading matrix
105 | format[upper.tri(format)] <- 0
106 |
107 | # Non zero elements of the format
108 | format_n0 <- format != 0
109 |
110 | # Non zero elements of the lower triangular part of the format
111 | format_n0_lt <- format_n0 & lower.tri(format)
112 |
113 | # Non zero elements of the diagonal of the format
114 | format_n0_diag <- diag(format_n0)
115 |
116 | # Number of parameters required for the matrix (lower + diagonal)
117 | lower <- sum(format_n0_lt)
118 | diagonal <- sum(format_n0_diag)
119 |
120 | # Check if magnitudes that are set to 0, have non-zero coefficients
121 | # specified in the loading matrix L
122 | if (diagonal < sum(colSums(format_n0) != 0)) {
123 | stop(
124 | paste(
125 | "The specified format is not valid.",
126 | "Columns of which the diagonal element is zero,",
127 | "should be set to zero."
128 | ),
129 | call. = FALSE
130 | )
131 | }
132 |
133 | # If format is a matrix of zeroes, return the format itself
134 | if (diagonal == 0) {
135 | return(format)
136 | }
137 |
138 | # Check if more parameters are specified than needed
139 | if ((lower + diagonal) < n_par) {
140 | stop("Too many parameters supplied.", call. = FALSE)
141 | }
142 |
143 | # Check if not enough parameters are specified
144 | if ((lower + diagonal) > n_par) {
145 | stop("Not enough parameters supplied.", call. = FALSE)
146 | }
147 |
148 | # Initialising L matrix with specified dimensions
149 | chol_L <- diag(1, format_dim[[1]], format_dim[[2]])
150 |
151 | # Putting the parameters into the right places according to format
152 | if (lower > 0) {
153 | chol_L[format_n0_lt] <- param[(diagonal + 1):(diagonal + lower)]
154 | }
155 |
156 | # Constructing D matrix
157 | param_diag <- rep(0, format_dim[[2]])
158 | param_diag_non0 <- exp(2 * param[1:diagonal])
159 | if (any(param_diag_non0 <= 1e-7)) {
160 | return(NA)
161 | }
162 | param_diag[format_n0_diag] <- param_diag_non0
163 | chol_D <- diag(param_diag, format_dim[[2]], format_dim[[2]])
164 | }
165 |
166 | # LDL Cholesky algorithm, resulting in a valid Variance - Covariance matrix
167 | cov_mat <- tcrossprod(chol_L %*% chol_D, chol_L)
168 |
169 | # Returning the result
170 | if (decompositions) {
171 |
172 | # Diagonal matrix containing the standard deviations
173 | stdev_matrix <- diag(sqrt(diag(cov_mat)), dim(cov_mat)[[1]], dim(cov_mat)[[2]])
174 |
175 | # Inverse of stdev_matrix
176 | stdev_inv <- stdev_matrix
177 | diag(stdev_inv)[diag(stdev_inv) > 0] <-
178 | 1 / diag(stdev_inv)[diag(stdev_inv) > 0]
179 |
180 | # Correlation matrix
181 | correlation_matrix <- stdev_inv %*% cov_mat %*% stdev_inv
182 |
183 | result <- list(
184 | cov_mat = cov_mat,
185 | loading_matrix = chol_L,
186 | diagonal_matrix = chol_D,
187 | correlation_matrix = correlation_matrix,
188 | stdev_matrix = stdev_matrix
189 | )
190 | return(result)
191 | } else {
192 | return(cov_mat)
193 | }
194 | }
195 |
--------------------------------------------------------------------------------
/R/AnsleyKohn.R:
--------------------------------------------------------------------------------
1 | #' Transform arbitrary matrices into partial autocorrelation matrices
2 | #'
3 | #' Creates valid partial autocorrelation matrices.
4 | #'
5 | #' @param A An array of arbitrary square matrices in the multivariate case,
6 | #' or a vector of arbitrary numbers in the univariate case.
7 | #'
8 | #' @return An array of partial autocorrelation matrices in the multivariate
9 | #' case, or a vector of partial autocorrelations in the univariate case.
10 | #'
11 | #' @noRd
12 | PACMat <- function(A) {
13 |
14 | # If univariate, computations are less expensive
15 | if (is.vector(A)) {
16 | return(A / sqrt(1 + A^2))
17 | }
18 |
19 | # Multivariate, for a single partial autocorrelation matrix
20 | if (is.matrix(A)) {
21 | return(crossprod(solve(chol(diag(dim(A)[[1]]) + tcrossprod(A))), A))
22 | }
23 |
24 | # Multivariate, for multiple partial autocorrelation matrices
25 | return(array(apply(A, 3, PACMat), dim = dim(A)))
26 | }
27 |
28 | #' Transform partial autocorrelation matrices into coefficient matrices
29 | #'
30 | #' Creates coefficient matrices for which the characteristic polynomial
31 | #' corresponds to a stationary process. Note, this function covers a
32 | #' subset of the space of coefficient matrices that correspond to a
33 | #' stationary process.
34 | #'
35 | #' @param P An array of partial autocorrelation matrices in the multivariate
36 | #' case, or a vector of partial autocorrelations in the univariate case.
37 | #'
38 | #' @return
39 | #' Multivariate case:
40 | #' A list containing:
41 | #' An array of coefficient matrices.
42 | #' Variance - covariance matrix of the noise, in order to transform
43 | #' coefficients further.
44 | #' Univariate case:
45 | #' A vector of coefficients.
46 | #'
47 | #' @noRd
48 | TransformPAC <- function(P) {
49 |
50 | # Initialise
51 | coeff_new <- P
52 |
53 | # If univariate, computations are less expensive
54 | if (is.vector(P)) {
55 | if (length(P) > 1) {
56 | for (i in 1:(length(P) - 1)) {
57 | coeff_old <- coeff_new
58 | for (j in 1:i) {
59 | coeff_new[[j]] <- coeff_old[[j]] -
60 | coeff_new[[i + 1]] * coeff_old[[i - j + 1]]
61 | }
62 | }
63 | }
64 | return(coeff_new)
65 | }
66 |
67 | # Multivariate
68 | # Initialise with i = 0
69 | sigma_new <- diag(dim(P)[[1]]) - tcrossprod(coeff_new[, , 1])
70 |
71 | if (dim(P)[[3]] > 1) {
72 |
73 | # i = 0
74 | coeff_star_new <- P
75 | coeff_star_new[, , 1] <- t(P[, , 1])
76 | sigma_star_new <- diag(dim(P)[[1]]) - tcrossprod(coeff_star_new[, , 1])
77 | L <- t(chol(sigma_new))
78 | L_star <- t(chol(sigma_star_new))
79 |
80 | for (i in 1:(dim(P)[[3]] - 1)) {
81 |
82 | # Storing former values
83 | coeff_old <- coeff_new
84 | coeff_star_old <- coeff_star_new
85 | sigma_old <- sigma_new
86 | sigma_star_old <- sigma_star_new
87 |
88 | # Calculating new values
89 | coeff_new[, , i + 1] <- L %*% P[, , i + 1] %*% solve(L_star)
90 | sigma_new <- sigma_old - tcrossprod(
91 | coeff_new[, , i + 1] %*% sigma_star_old,
92 | coeff_new[, , i + 1]
93 | )
94 | if (i < (dim(P)[[3]] - 1)) {
95 | coeff_star_new[, , i + 1] <- tcrossprod(L_star, P[, , i + 1]) %*%
96 | solve(L)
97 | sigma_star_new <- sigma_star_old - tcrossprod(
98 | coeff_star_new[, , i + 1] %*% sigma_old,
99 | coeff_star_new[, , i + 1]
100 | )
101 | L_star <- t(chol(sigma_star_new))
102 | L <- t(chol(sigma_new))
103 | }
104 | for (j in 1:i) {
105 | coeff_new[, , j] <- coeff_old[, , j] -
106 | coeff_new[, , i + 1] %*% coeff_star_old[, , i - j + 1]
107 | if (i < (dim(P)[[3]] - 1)) {
108 | coeff_star_new[, , j] <- coeff_star_old[, , j] -
109 | coeff_star_new[, , i + 1] %*% coeff_old[, , i - j + 1]
110 | }
111 | }
112 | }
113 | }
114 | return(list(coeff = coeff_new, variance = sigma_new))
115 | }
116 |
117 | #' Transform arbitrary matrices into ARMA coefficient matrices
118 | #'
119 | #' Creates coefficient matrices for which the characteristic polynomial
120 | #' corresponds to a stationary process.
121 | #' See \insertCite{ansley1986note;textual}{statespacer} for details about
122 | #' the transformation used.
123 | #'
124 | #' @param A An array of arbitrary square matrices in the multivariate case,
125 | #' or a vector of arbitrary numbers in the univariate case.
126 | #' @param variance A variance - covariance matrix.
127 | #' Note: `variance` not needed for the univariate case!
128 | #' @param ar The order of the AR part.
129 | #' @param ma The order of the MA part.
130 | #'
131 | #' @return
132 | #' If multivariate, a list containing:
133 | #' * An array of coefficient matrices for the AR part.
134 | #' * An array of coefficient matrices for the MA part.
135 | #'
136 | #' If univariate, a list containing:
137 | #' * A vector of coefficients for the AR part.
138 | #' * A vector of coefficients for the MA part.
139 | #'
140 | #' @author Dylan Beijers, \email{dylanbeijers@@gmail.com}
141 | #'
142 | #' @references
143 | #' \insertRef{ansley1986note}{statespacer}
144 | #'
145 | #' @examples
146 | #' CoeffARMA(A = stats::rnorm(2), ar = 1, ma = 1)
147 | #' @export
148 | CoeffARMA <- function(A, variance = NULL, ar = 1, ma = 0) {
149 |
150 | # Check for erroneous input
151 | if (ar < 0) {
152 | stop("The order of the autoregressive part must be >= 0.", call. = FALSE)
153 | }
154 | if (ma < 0) {
155 | stop("The order of the moving average part must be >= 0.", call. = FALSE)
156 | }
157 | if (ar + ma == 0) {
158 | stop(
159 | "At least one of the orders of the AR and MA parts must be positive.",
160 | call. = FALSE
161 | )
162 | }
163 |
164 | # Initialise list to return
165 | result <- list()
166 |
167 | # Check if array contains square matrices
168 | if (is.array(A)) {
169 | if (dim(A)[1] != dim(A)[[2]]) {
170 | stop("Matrices in `A` must be square matrices.", call. = FALSE)
171 | }
172 | }
173 |
174 | # Obtain partial autocorrelation matrices
175 | P <- PACMat(A)
176 |
177 | # If univariate, coefficients are readily returned by TransformPAC
178 | if (is.vector(P)) {
179 | if (ar > 0) {
180 | P_ar <- P[1:ar]
181 | result$ar <- TransformPAC(P_ar)
182 | }
183 | if (ma > 0) {
184 | P_ma <- P[(ar + 1):(ar + ma)]
185 | result$ma <- -TransformPAC(P_ma) # Note the minus sign
186 | }
187 | return(result)
188 | }
189 |
190 | # Cholesky decomposition of variance - covariance matrix
191 | L <- t(chol(variance))
192 | L_inv <- solve(L)
193 |
194 | # Obtain coefficient matrices for AR part
195 | if (ar > 0) {
196 | P_ar <- P[, , 1:ar, drop = FALSE]
197 | ar_part <- TransformPAC(P_ar)
198 | L_ar <- t(chol(ar_part$variance))
199 | L_ar_inv <- solve(L_ar)
200 | result$ar <- array(
201 | apply(
202 | ar_part$coeff, 3,
203 | function(x) L %*% L_ar_inv %*% x %*% L_ar %*% L_inv
204 | ),
205 | dim = dim(ar_part$coeff)
206 | )
207 | }
208 |
209 | # Obtain coefficient matrices for MA part
210 | if (ma > 0) {
211 | P_ma <- P[, , (ar + 1):(ar + ma), drop = FALSE]
212 | ma_part <- TransformPAC(P_ma)
213 | L_ma <- t(chol(ma_part$variance))
214 | L_ma_inv <- solve(L_ma)
215 | result$ma <- -array( # Note the minus sign
216 | apply(
217 | ma_part$coeff, 3,
218 | function(x) L %*% L_ma_inv %*% x %*% L_ma %*% L_inv
219 | ),
220 | dim = dim(ma_part$coeff)
221 | )
222 | }
223 | return(result)
224 | }
225 |
--------------------------------------------------------------------------------
/src/RcppExports.cpp:
--------------------------------------------------------------------------------
1 | // Generated by using Rcpp::compileAttributes() -> do not edit by hand
2 | // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
3 |
4 | #include
5 | #include
6 |
7 | using namespace Rcpp;
8 |
9 | #ifdef RCPP_USE_GLOBAL_ROSTREAM
10 | Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get();
11 | Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get();
12 | #endif
13 |
14 | // ExtractComponentC
15 | arma::cube ExtractComponentC(const arma::cube& a, const arma::cube& Z);
16 | RcppExport SEXP _statespacer_ExtractComponentC(SEXP aSEXP, SEXP ZSEXP) {
17 | BEGIN_RCPP
18 | Rcpp::RObject rcpp_result_gen;
19 | Rcpp::RNGScope rcpp_rngScope_gen;
20 | Rcpp::traits::input_parameter< const arma::cube& >::type a(aSEXP);
21 | Rcpp::traits::input_parameter< const arma::cube& >::type Z(ZSEXP);
22 | rcpp_result_gen = Rcpp::wrap(ExtractComponentC(a, Z));
23 | return rcpp_result_gen;
24 | END_RCPP
25 | }
26 | // FastSmootherC
27 | Rcpp::List FastSmootherC(const arma::cube& y, const arma::colvec& a, const arma::mat& P_inf, const arma::mat& P_star, const arma::cube& Z, const arma::cube& T, const arma::cube& R, const arma::cube& Q, const int& initialisation_steps, const bool& transposed_state);
28 | RcppExport SEXP _statespacer_FastSmootherC(SEXP ySEXP, SEXP aSEXP, SEXP P_infSEXP, SEXP P_starSEXP, SEXP ZSEXP, SEXP TSEXP, SEXP RSEXP, SEXP QSEXP, SEXP initialisation_stepsSEXP, SEXP transposed_stateSEXP) {
29 | BEGIN_RCPP
30 | Rcpp::RObject rcpp_result_gen;
31 | Rcpp::RNGScope rcpp_rngScope_gen;
32 | Rcpp::traits::input_parameter< const arma::cube& >::type y(ySEXP);
33 | Rcpp::traits::input_parameter< const arma::colvec& >::type a(aSEXP);
34 | Rcpp::traits::input_parameter< const arma::mat& >::type P_inf(P_infSEXP);
35 | Rcpp::traits::input_parameter< const arma::mat& >::type P_star(P_starSEXP);
36 | Rcpp::traits::input_parameter< const arma::cube& >::type Z(ZSEXP);
37 | Rcpp::traits::input_parameter< const arma::cube& >::type T(TSEXP);
38 | Rcpp::traits::input_parameter< const arma::cube& >::type R(RSEXP);
39 | Rcpp::traits::input_parameter< const arma::cube& >::type Q(QSEXP);
40 | Rcpp::traits::input_parameter< const int& >::type initialisation_steps(initialisation_stepsSEXP);
41 | Rcpp::traits::input_parameter< const bool& >::type transposed_state(transposed_stateSEXP);
42 | rcpp_result_gen = Rcpp::wrap(FastSmootherC(y, a, P_inf, P_star, Z, T, R, Q, initialisation_steps, transposed_state));
43 | return rcpp_result_gen;
44 | END_RCPP
45 | }
46 | // KalmanC
47 | Rcpp::List KalmanC(const arma::mat& y, const Rcpp::LogicalMatrix& y_isna, const arma::colvec& a, const arma::mat& P_inf, const arma::mat& P_star, const arma::cube& Z, const arma::cube& T, const arma::cube& R, const arma::cube& Q, const bool& diagnostics);
48 | RcppExport SEXP _statespacer_KalmanC(SEXP ySEXP, SEXP y_isnaSEXP, SEXP aSEXP, SEXP P_infSEXP, SEXP P_starSEXP, SEXP ZSEXP, SEXP TSEXP, SEXP RSEXP, SEXP QSEXP, SEXP diagnosticsSEXP) {
49 | BEGIN_RCPP
50 | Rcpp::RObject rcpp_result_gen;
51 | Rcpp::RNGScope rcpp_rngScope_gen;
52 | Rcpp::traits::input_parameter< const arma::mat& >::type y(ySEXP);
53 | Rcpp::traits::input_parameter< const Rcpp::LogicalMatrix& >::type y_isna(y_isnaSEXP);
54 | Rcpp::traits::input_parameter< const arma::colvec& >::type a(aSEXP);
55 | Rcpp::traits::input_parameter< const arma::mat& >::type P_inf(P_infSEXP);
56 | Rcpp::traits::input_parameter< const arma::mat& >::type P_star(P_starSEXP);
57 | Rcpp::traits::input_parameter< const arma::cube& >::type Z(ZSEXP);
58 | Rcpp::traits::input_parameter< const arma::cube& >::type T(TSEXP);
59 | Rcpp::traits::input_parameter< const arma::cube& >::type R(RSEXP);
60 | Rcpp::traits::input_parameter< const arma::cube& >::type Q(QSEXP);
61 | Rcpp::traits::input_parameter< const bool& >::type diagnostics(diagnosticsSEXP);
62 | rcpp_result_gen = Rcpp::wrap(KalmanC(y, y_isna, a, P_inf, P_star, Z, T, R, Q, diagnostics));
63 | return rcpp_result_gen;
64 | END_RCPP
65 | }
66 | // LogLikC
67 | double LogLikC(const Rcpp::NumericMatrix& y, const Rcpp::LogicalMatrix& y_isna, arma::colvec a, arma::mat P_inf, arma::mat P_star, const arma::cube& Z, const arma::cube& T, const arma::cube& R, const arma::cube& Q);
68 | RcppExport SEXP _statespacer_LogLikC(SEXP ySEXP, SEXP y_isnaSEXP, SEXP aSEXP, SEXP P_infSEXP, SEXP P_starSEXP, SEXP ZSEXP, SEXP TSEXP, SEXP RSEXP, SEXP QSEXP) {
69 | BEGIN_RCPP
70 | Rcpp::RObject rcpp_result_gen;
71 | Rcpp::RNGScope rcpp_rngScope_gen;
72 | Rcpp::traits::input_parameter< const Rcpp::NumericMatrix& >::type y(ySEXP);
73 | Rcpp::traits::input_parameter< const Rcpp::LogicalMatrix& >::type y_isna(y_isnaSEXP);
74 | Rcpp::traits::input_parameter< arma::colvec >::type a(aSEXP);
75 | Rcpp::traits::input_parameter< arma::mat >::type P_inf(P_infSEXP);
76 | Rcpp::traits::input_parameter< arma::mat >::type P_star(P_starSEXP);
77 | Rcpp::traits::input_parameter< const arma::cube& >::type Z(ZSEXP);
78 | Rcpp::traits::input_parameter< const arma::cube& >::type T(TSEXP);
79 | Rcpp::traits::input_parameter< const arma::cube& >::type R(RSEXP);
80 | Rcpp::traits::input_parameter< const arma::cube& >::type Q(QSEXP);
81 | rcpp_result_gen = Rcpp::wrap(LogLikC(y, y_isna, a, P_inf, P_star, Z, T, R, Q));
82 | return rcpp_result_gen;
83 | END_RCPP
84 | }
85 | // SimulateC
86 | Rcpp::List SimulateC(const int& nsim, const int& repeat_Q, const int& N, const arma::colvec& a, const arma::cube& Z, const arma::cube& T, const arma::cube& R, const arma::cube& Q, const arma::mat& P_star, const bool& draw_initial, const bool& eta_only, const bool& transposed_state);
87 | RcppExport SEXP _statespacer_SimulateC(SEXP nsimSEXP, SEXP repeat_QSEXP, SEXP NSEXP, SEXP aSEXP, SEXP ZSEXP, SEXP TSEXP, SEXP RSEXP, SEXP QSEXP, SEXP P_starSEXP, SEXP draw_initialSEXP, SEXP eta_onlySEXP, SEXP transposed_stateSEXP) {
88 | BEGIN_RCPP
89 | Rcpp::RObject rcpp_result_gen;
90 | Rcpp::RNGScope rcpp_rngScope_gen;
91 | Rcpp::traits::input_parameter< const int& >::type nsim(nsimSEXP);
92 | Rcpp::traits::input_parameter< const int& >::type repeat_Q(repeat_QSEXP);
93 | Rcpp::traits::input_parameter< const int& >::type N(NSEXP);
94 | Rcpp::traits::input_parameter< const arma::colvec& >::type a(aSEXP);
95 | Rcpp::traits::input_parameter< const arma::cube& >::type Z(ZSEXP);
96 | Rcpp::traits::input_parameter< const arma::cube& >::type T(TSEXP);
97 | Rcpp::traits::input_parameter< const arma::cube& >::type R(RSEXP);
98 | Rcpp::traits::input_parameter< const arma::cube& >::type Q(QSEXP);
99 | Rcpp::traits::input_parameter< const arma::mat& >::type P_star(P_starSEXP);
100 | Rcpp::traits::input_parameter< const bool& >::type draw_initial(draw_initialSEXP);
101 | Rcpp::traits::input_parameter< const bool& >::type eta_only(eta_onlySEXP);
102 | Rcpp::traits::input_parameter< const bool& >::type transposed_state(transposed_stateSEXP);
103 | rcpp_result_gen = Rcpp::wrap(SimulateC(nsim, repeat_Q, N, a, Z, T, R, Q, P_star, draw_initial, eta_only, transposed_state));
104 | return rcpp_result_gen;
105 | END_RCPP
106 | }
107 |
108 | static const R_CallMethodDef CallEntries[] = {
109 | {"_statespacer_ExtractComponentC", (DL_FUNC) &_statespacer_ExtractComponentC, 2},
110 | {"_statespacer_FastSmootherC", (DL_FUNC) &_statespacer_FastSmootherC, 10},
111 | {"_statespacer_KalmanC", (DL_FUNC) &_statespacer_KalmanC, 10},
112 | {"_statespacer_LogLikC", (DL_FUNC) &_statespacer_LogLikC, 9},
113 | {"_statespacer_SimulateC", (DL_FUNC) &_statespacer_SimulateC, 12},
114 | {NULL, NULL, 0}
115 | };
116 |
117 | RcppExport void R_init_statespacer(DllInfo *dll) {
118 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
119 | R_useDynamicSymbols(dll, FALSE);
120 | }
121 |
--------------------------------------------------------------------------------
/docs/LICENSE-text.html:
--------------------------------------------------------------------------------
1 |
2 | License • statespacer
6 |
7 |
8 |
9 |
67 |
68 |
69 |
70 |
71 |
72 |
73 | License
74 |
75 |
76 | YEAR: 2020
77 | COPYRIGHT HOLDER: Dylan Beijers
78 |
79 |
80 |
81 |
82 |
85 |
86 |
87 |
88 |
89 |
90 |
99 |
100 |
101 |
116 |
117 |
--------------------------------------------------------------------------------
9 |
67 |
68 |
69 |
70 |
99 |
100 |
101 |
116 |
117 |
--------------------------------------------------------------------------------
71 |
87 |
88 |
89 |
90 |
72 |
81 |
82 |
85 |
86 |
73 |
75 |
76 | License
74 |YEAR: 2020 77 | COPYRIGHT HOLDER: Dylan Beijers 78 |79 | 80 |