├── LICENSE ├── .Rbuildignore ├── .gitignore ├── NAMESPACE ├── R ├── round2.R ├── nw.R ├── dif.R ├── arch_test.R ├── cw.R ├── bnd.R ├── cc.R ├── ac.R └── gts_ur.R ├── tsm.Rproj ├── man ├── round2.Rd ├── gts_ur.Rd ├── nw.Rd ├── arch_test.Rd ├── bnd.Rd ├── cw.Rd ├── ac.Rd ├── dif.Rd └── cc.Rd ├── DESCRIPTION ├── README.md ├── README.Rmd └── LICENSE.md /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2025 2 | COPYRIGHT HOLDER: tsm authors 3 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^LICENSE\.md$ 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(ac) 4 | export(arch_test) 5 | export(bnd) 6 | export(cc) 7 | export(cw) 8 | export(dif) 9 | export(gts_ur) 10 | export(nw) 11 | export(round2) 12 | import(dplyr) 13 | import(ggplot2) 14 | import(patchwork) 15 | import(tibble) 16 | importFrom(urca,ur.df) 17 | -------------------------------------------------------------------------------- /R/round2.R: -------------------------------------------------------------------------------- 1 | #' Round numbers following normal convention. 2 | #' 3 | #' @param x A numeric scalar. 4 | #' @param n The order for the rounding. 5 | #' 6 | #' @return The result that would be equivalent to Matlab. 7 | #' @export 8 | #' 9 | #' @examples 10 | #' round2(0.55, 1) 11 | 12 | round2 <- function(x, n) { 13 | # where 0.5 rounds up to 1 and 0.4 to 0 14 | posneg <- sign(x) 15 | z <- abs(x) * 10^n 16 | z <- z + 0.5 17 | z <- trunc(z) 18 | z <- z / 10^n 19 | z * posneg 20 | } 21 | -------------------------------------------------------------------------------- /tsm.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /man/round2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/round2.R 3 | \name{round2} 4 | \alias{round2} 5 | \title{Round numbers following normal convention.} 6 | \usage{ 7 | round2(x, n) 8 | } 9 | \arguments{ 10 | \item{x}{A numeric scalar.} 11 | 12 | \item{n}{The order for the rounding.} 13 | } 14 | \value{ 15 | The result that would be equivalent to Matlab. 16 | } 17 | \description{ 18 | Round numbers following normal convention. 19 | } 20 | \examples{ 21 | round2(0.55, 1) 22 | } 23 | -------------------------------------------------------------------------------- /man/gts_ur.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gts_ur.R 3 | \name{gts_ur} 4 | \alias{gts_ur} 5 | \title{General-to-Specific application of Dickey-Fuller (1981) Test.} 6 | \usage{ 7 | gts_ur(series) 8 | } 9 | \arguments{ 10 | \item{series}{A vector of numeric values.} 11 | } 12 | \value{ 13 | Summary of the results of the various tests. 14 | } 15 | \description{ 16 | General-to-Specific application of Dickey-Fuller (1981) Test. 17 | } 18 | \examples{ 19 | gts_ur(rnorm(100)) 20 | } 21 | -------------------------------------------------------------------------------- /man/nw.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/nw.R 3 | \name{nw} 4 | \alias{nw} 5 | \title{Newey-West HAC covariance estimator.} 6 | \usage{ 7 | nw(y, qn) 8 | } 9 | \arguments{ 10 | \item{y}{A T*k vector of numeric values.} 11 | 12 | \item{qn}{A numeric scalar for the truncation lag.} 13 | } 14 | \value{ 15 | Newey-West HAC covariance estimator (as derived in Hayashi). 16 | } 17 | \description{ 18 | Newey-West HAC covariance estimator. 19 | } 20 | \examples{ 21 | nw(rnorm(100), 1) 22 | } 23 | -------------------------------------------------------------------------------- /man/arch_test.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/arch_test.R 3 | \name{arch_test} 4 | \alias{arch_test} 5 | \title{Perform Lagrange Multiplier Test for ARCH effect of a time series.} 6 | \usage{ 7 | arch_test(data, m = 10) 8 | } 9 | \arguments{ 10 | \item{data}{Time series variable.} 11 | 12 | \item{m}{Selected AR order.} 13 | } 14 | \value{ 15 | ARCH Lagrange Multiplier Statistics. 16 | } 17 | \description{ 18 | Perform Lagrange Multiplier Test for ARCH effect of a time series. 19 | } 20 | \examples{ 21 | arch_test(rnorm(100)) 22 | } 23 | -------------------------------------------------------------------------------- /man/bnd.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bnd.R 3 | \name{bnd} 4 | \alias{bnd} 5 | \title{Beveridge-Nelson decomposition} 6 | \usage{ 7 | bnd(data, nlag = 8) 8 | } 9 | \arguments{ 10 | \item{data}{A vector of first-order integrated numeric values} 11 | 12 | \item{nlag}{A numberic scalar for the lag-order of the autoregressive (cyclical) part} 13 | } 14 | \value{ 15 | Values for the stochastic trend and the stationary cycle 16 | } 17 | \description{ 18 | Beveridge-Nelson decomposition 19 | } 20 | \examples{ 21 | bnd(rnorm(100)) 22 | } 23 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: tsm 2 | Type: Package 3 | Title: Time Series Modelling 4 | Version: 0.0.0.2 5 | Authors@R: 6 | person("Kevin", "Kotzé", , "kevinkotze@gmail.com", role = c("aut", "cre"), 7 | comment = c(ORCID = "0000-0002-7968-266X")) 8 | Maintainer: Kevin Kotze 9 | Description: Routines that accompany a course on Time Series Modelling. 10 | License: MIT + file LICENSE 11 | Encoding: UTF-8 12 | LazyData: true 13 | Roxygen: list(markdown = TRUE) 14 | RoxygenNote: 7.3.2 15 | Imports: 16 | urca, 17 | tibble, 18 | dplyr, 19 | ggplot2, 20 | patchwork 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | ## Time Series Modelling 5 | 6 | *\* 7 | 8 | This R package contains a few routines that accompany a course on Time 9 | Series Modelling. 10 | 11 | ## Installation 12 | 13 | To install the repository the current data from GitHub: 14 | 15 | ``` r 16 | pak::pak("KevinKotze/tsm") 17 | ``` 18 | 19 | ## Disclaimer 20 | 21 | Please note that I’m in no way responsible for the results that may be 22 | produced using these routines, which are mostly wrapper functions. 23 | Researchers are encouraged to make use of other packages. 24 | -------------------------------------------------------------------------------- /R/nw.R: -------------------------------------------------------------------------------- 1 | #' Newey-West HAC covariance estimator. 2 | #' 3 | #' @param y A T*k vector of numeric values. 4 | #' @param qn A numeric scalar for the truncation lag. 5 | #' 6 | #' @return Newey-West HAC covariance estimator (as derived in Hayashi). 7 | #' @export 8 | #' 9 | #' @examples 10 | #' nw(rnorm(100), 1) 11 | 12 | nw <- function(y, qn) { 13 | T <- length(y) 14 | ybar <- rep(1, T) * ((sum(y)) / T) 15 | dy <- y - ybar 16 | G0 <- t(dy) %*% dy / T 17 | 18 | for (j in 1:qn) { 19 | gamma <- t(dy[(j + 1):T]) %*% dy[1:T - j] / (T - 1) 20 | G0 <- G0 + (gamma + t(gamma)) * (1 - abs(j / qn)) 21 | } 22 | 23 | return(as.numeric(G0)) 24 | 25 | } 26 | -------------------------------------------------------------------------------- /man/cw.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cw.R 3 | \name{cw} 4 | \alias{cw} 5 | \title{Clark-West (2007) approximate normality tests for equal predictive accuracy in nested models.} 6 | \usage{ 7 | cw(e.m1, e.m2, yf.m1, yf.m2) 8 | } 9 | \arguments{ 10 | \item{e.m1}{Errors from model 1.} 11 | 12 | \item{e.m2}{Errors from model 2.} 13 | 14 | \item{yf.m1}{Forecasts for model 1.} 15 | 16 | \item{yf.m2}{Forecasts for model 2.} 17 | } 18 | \value{ 19 | Clark-West statistics. 20 | } 21 | \description{ 22 | Clark-West (2007) approximate normality tests for equal predictive accuracy in nested models. 23 | } 24 | \examples{ 25 | cw(rnorm(100), rnorm(100), rnorm(100), rnorm(100)) 26 | } 27 | -------------------------------------------------------------------------------- /man/ac.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ac.R 3 | \name{ac} 4 | \alias{ac} 5 | \title{Autocorrelation and partial autocorrelation function.} 6 | \usage{ 7 | ac(data, max_lag = NULL, main_title = NULL, output = NULL) 8 | } 9 | \arguments{ 10 | \item{data}{A numeric, time series, or xts variable.} 11 | 12 | \item{max_lag}{A number that represents the maximum lag order for the ACF and PACF.} 13 | 14 | \item{main_title}{Optional plot title.} 15 | 16 | \item{output}{Return data or not.} 17 | } 18 | \value{ 19 | The ggplot plots for the respective ACF and PACF functions. 20 | } 21 | \description{ 22 | Autocorrelation and partial autocorrelation function. 23 | } 24 | \examples{ 25 | ac(rnorm(100)) 26 | } 27 | -------------------------------------------------------------------------------- /R/dif.R: -------------------------------------------------------------------------------- 1 | #' Returns lagged and differenced data where input and output are same length. 2 | #' 3 | #' @param x A numeric, time series, or xts variable. 4 | #' @param lag A number that represents the maximum lag order. 5 | #' @param differences Number of times data should be differenced. 6 | #' @param ... Optional input arguments. 7 | #' 8 | #' @return Vector of data that is the sample length as input. 9 | #' @export 10 | #' 11 | #' @examples 12 | #' dif(rnorm(100), 1, 1) 13 | 14 | dif <- function(x, lag = 1, differences = 1, ...) { 15 | 16 | # number of observations 17 | num <- length(x) 18 | 19 | # calculations 20 | tmp0 <- diff(x, lag = lag, differences = differences) 21 | tmp1 <- c(rep(NA, num - length(tmp0)), tmp0) 22 | 23 | return(tmp1) 24 | } 25 | -------------------------------------------------------------------------------- /R/arch_test.R: -------------------------------------------------------------------------------- 1 | #' Perform Lagrange Multiplier Test for ARCH effect of a time series. 2 | #' 3 | #' @param data Time series variable. 4 | #' @param m Selected AR order. 5 | #' @return ARCH Lagrange Multiplier Statistics. 6 | #' @export 7 | #' 8 | #' @examples 9 | #' arch_test(rnorm(100)) 10 | 11 | arch_test <- function(data, m = 10) { 12 | 13 | # demean data and take the square 14 | y <- (data - mean(data))^2 15 | 16 | # set up lags for RHS variable 17 | T <- length(data) 18 | atsq <- y[(m + 1):T] 19 | x <- matrix(0, (T - m), m) 20 | for (i in 1:m) { 21 | x[, i] <- y[(m + 1 - i):(T - i)] 22 | } 23 | 24 | # estimate least squares regression 25 | result <- stats::lm(atsq ~ x) 26 | 27 | # return the result 28 | return(result) 29 | } 30 | 31 | -------------------------------------------------------------------------------- /man/dif.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dif.R 3 | \name{dif} 4 | \alias{dif} 5 | \title{Returns lagged and differenced data where input and output are same length.} 6 | \usage{ 7 | dif(x, lag = 1, differences = 1, ...) 8 | } 9 | \arguments{ 10 | \item{x}{A numeric, time series, or xts variable.} 11 | 12 | \item{lag}{A number that represents the maximum lag order.} 13 | 14 | \item{differences}{Number of times data should be differenced.} 15 | 16 | \item{...}{Optional input arguments.} 17 | } 18 | \value{ 19 | Vector of data that is the sample length as input. 20 | } 21 | \description{ 22 | Returns lagged and differenced data where input and output are same length. 23 | } 24 | \examples{ 25 | dif(rnorm(100), 1, 1) 26 | } 27 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, echo = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>" 11 | ) 12 | ``` 13 | 14 | ## Time Series Modelling 15 | 16 | __ 17 | 18 | This R package contains a few routines that accompany a course on Time Series Modelling. 19 | 20 | ## Installation 21 | 22 | To install the repository the current data from GitHub: 23 | 24 | ```R 25 | pak::pak("KevinKotze/tsm") 26 | ``` 27 | 28 | ## Disclaimer 29 | 30 | Please note that I'm in no way responsible for the results that may be produced using these routines, which are mostly wrapper functions. Researchers are encouraged to make use of other packages. 31 | -------------------------------------------------------------------------------- /man/cc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cc.R 3 | \name{cc} 4 | \alias{cc} 5 | \title{Cross correlation function that considers the relationship between two variables.} 6 | \usage{ 7 | cc(x, y, max_lag = NULL, main_title = NULL, output = NULL) 8 | } 9 | \arguments{ 10 | \item{x}{A numeric, time series, or xts variable.} 11 | 12 | \item{y}{A numeric, time series, or xts variable.} 13 | 14 | \item{max_lag}{A number that represents the maximum lag order for the ACF and PACF.} 15 | 16 | \item{main_title}{Optional plot title.} 17 | 18 | \item{output}{Return data or not.} 19 | } 20 | \value{ 21 | The respective CCF functions. 22 | } 23 | \description{ 24 | Cross correlation function that considers the relationship between two variables. 25 | } 26 | \examples{ 27 | cc(rnorm(100), rnorm(100)) 28 | } 29 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2025 tsm authors 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /R/cw.R: -------------------------------------------------------------------------------- 1 | #' Clark-West (2007) approximate normality tests for equal predictive accuracy in nested models. 2 | #' 3 | #' @param e.m1 Errors from model 1. 4 | #' @param e.m2 Errors from model 2. 5 | #' @param yf.m1 Forecasts for model 1. 6 | #' @param yf.m2 Forecasts for model 2. 7 | #' 8 | #' @return Clark-West statistics. 9 | #' @export 10 | #' 11 | #' @examples 12 | #' cw(rnorm(100), rnorm(100), rnorm(100), rnorm(100)) 13 | 14 | 15 | cw <- function(e.m1, e.m2, yf.m1, yf.m2) { 16 | nw <- function(y, qn) { 17 | # input: y is a T*k vector and qn is the truncation lag 18 | # output: the newey west HAC covariance estimator 19 | # Formulas are from Hayashi 20 | T <- length(y) 21 | ybar <- rep(1, T) * ((sum(y)) / T) 22 | dy <- y - ybar 23 | G0 <- t(dy) %*% dy / T 24 | for (j in 1:qn) { 25 | gamma <- t(dy[(j + 1):T]) %*% dy[1:T - j] / (T - 1) 26 | G0 <- G0 + (gamma + t(gamma)) * (1 - abs(j / qn)) 27 | } 28 | return(as.numeric(G0)) 29 | } 30 | 31 | P <- length(e.m1) 32 | froll.adj <- e.m1^2 - (e.m2^2 - (yf.m1 - yf.m2)^2) 33 | varfroll.adj <- nw(froll.adj, 1) 34 | CW <- sqrt(P) * (mean(froll.adj)) / sqrt(varfroll.adj) 35 | pv <- 1 - stats::pnorm(CW, 0, 1) 36 | results = list(test = 0, pvalue = 0) 37 | results$test <- CW 38 | results$pvalue <- pv 39 | return(results) 40 | } 41 | -------------------------------------------------------------------------------- /R/bnd.R: -------------------------------------------------------------------------------- 1 | #' Beveridge-Nelson decomposition 2 | #' 3 | #' @param data A vector of first-order integrated numeric values 4 | #' @param nlag A numberic scalar for the lag-order of the autoregressive (cyclical) part 5 | #' @return Values for the stochastic trend and the stationary cycle 6 | #' @export 7 | #' 8 | #' @examples 9 | #' bnd(rnorm(100)) 10 | 11 | 12 | bnd <- function(data, nlag = 8) { 13 | y <- matrix(data, ncol = 1) 14 | 15 | yd <- diff(y, lag = 1) 16 | yl <- matrix(rep(0, length(y) * nlag), ncol = nlag) 17 | yl[, 1] <- c(0, yd) 18 | for (i in 2:nlag) { 19 | yl[, i] <- c(0, yl[1:(length(y) - 1), i - 1]) 20 | } 21 | x <- yl[(nlag + 1):(length(y) - 1), 1:nlag] 22 | yy <- matrix(yd[(1 + nlag):length(yd), ], ncol = 1) 23 | 24 | # OLS 25 | beta <- stats::lm(yy ~ x)$coefficients 26 | 27 | # Companion form of matrix 28 | eye <- diag(1, nlag) 29 | coef.tmp <- matrix(beta[2:length(beta)], nrow = 1) 30 | betac.tmp <- rbind(coef.tmp, eye) 31 | betac <- betac.tmp[1:nlag, ] 32 | 33 | c1 <- betac %*% solve(diag(nlag) - betac) 34 | ydd <- c(rep(0, 1 + nlag), yd) - beta[1] 35 | ydd.len <- length(ydd) 36 | 37 | # Construct matrix of historical lags 38 | yD <- matrix(rep(0, nlag * (ydd.len - nlag)), nrow = nlag) 39 | 40 | for (i in 1:nlag) { 41 | yD[i, ] <- matrix(ydd[(1 + i):(ydd.len - (nlag) + i)], nrow = 1) 42 | } 43 | 44 | yD.tmp <- apply(yD, 2, rev) 45 | yD <- yD.tmp[nrow(yD.tmp):1, ] 46 | 47 | # Selection vector 48 | sel <- rep(0, nlag) 49 | sel[1] <- 1 50 | 51 | # Compute trend and cycle 52 | ytr <- y + t(sel %*% c1 %*% yD) 53 | yc <- t(sel %*% c1 %*% yD) 54 | out <- cbind(ytr, yc) 55 | colnames(out) <- c("trend", "cycle") 56 | out <- out 57 | 58 | return(out) 59 | } 60 | -------------------------------------------------------------------------------- /R/cc.R: -------------------------------------------------------------------------------- 1 | #' Cross correlation function that considers the relationship between two variables. 2 | #' 3 | #' @import tibble dplyr ggplot2 patchwork 4 | #' @param x A numeric, time series, or xts variable. 5 | #' @param y A numeric, time series, or xts variable. 6 | #' @param max_lag A number that represents the maximum lag order for the ACF and PACF. 7 | #' @param main_title Optional plot title. 8 | #' @param output Return data or not. 9 | #' 10 | #' @return The respective CCF functions. 11 | #' @export 12 | #' 13 | #' @examples 14 | #' cc(rnorm(100), rnorm(100)) 15 | 16 | cc <- function(x, 17 | y, 18 | max_lag = NULL, 19 | main_title = NULL, 20 | output = NULL) { 21 | # colours 22 | tsm_pal <- list( 23 | default = tribble( 24 | ~ colour, 25 | ~ hex, 26 | 'blue', 27 | '#4682B4', 28 | 'purple', 29 | '#B44683', 30 | 'gold', 31 | '#B4A446', 32 | 'darkblue', 33 | '#31697E', 34 | 'darkpurple', 35 | '#7E315C' 36 | ) |> deframe() 37 | ) 38 | 39 | # global functions or variables 40 | LAG <- integer() 41 | CCF <- numeric() 42 | U <- numeric() 43 | L <- numeric() 44 | 45 | # number of observations 46 | num <- length(x) 47 | 48 | # conditions 49 | if (num > 49 & is.null(max_lag)) 50 | max_lag = ceiling(10 + sqrt(num)) 51 | if (num < 50 & is.null(max_lag)) 52 | max_lag = floor(5 * log10(num)) 53 | if (max_lag > (num - 1)) 54 | stop("Number of lags exceeds number of observations") 55 | 56 | # calculations 57 | tmp <- stats::ccf(x, y, max_lag, plot = FALSE) 58 | 59 | # confidence intervals - Enders 2014 60 | cf <- tibble(LAG = tmp$lag[, 1, 1], CCF = tmp$acf[, 1, 1], ) %>% 61 | filter(LAG >= 0) %>% 62 | mutate(U = 2 * ((num - 0:max_lag)^(-1 / 2)), L = -U) 63 | 64 | # plot 65 | p1 <- cf %>% 66 | ggplot() + 67 | geom_bar(aes(x = LAG, y = CCF), 68 | stat = "identity", 69 | fill = tsm_pal$default[[1]]) + 70 | geom_line( 71 | aes(x = LAG, y = U), 72 | stat = "identity", 73 | colour = tsm_pal$default[[3]], 74 | linetype = "dashed", 75 | linewidth = 1 76 | ) + 77 | geom_line( 78 | aes(x = LAG, y = L), 79 | stat = "identity", 80 | colour = tsm_pal$default[[3]], 81 | linetype = "dashed", 82 | linewidth = 1 83 | ) + 84 | theme_light() + 85 | theme( 86 | axis.title.x = element_blank(), 87 | plot.title = element_text(hjust = 0.5), 88 | axis.ticks.x = element_blank(), 89 | plot.margin = margin(0.6, 0.6, 0.6, 0.6, "cm"), 90 | legend.justification = c(0, 1), 91 | legend.position = 'none', 92 | legend.title = element_blank() 93 | ) + 94 | expand_limits(y = c(-0.91, 0.91)) + 95 | labs(y = "CCF", x = NULL) 96 | 97 | cf_plot <- p1 + 98 | plot_layout(nrow = 1, byrow = FALSE) + 99 | plot_annotation(title = main_title) 100 | 101 | if (is.null(output)) { 102 | return(cf_plot) 103 | } else { 104 | return(list(cf_plot, cf)) 105 | } 106 | 107 | } 108 | -------------------------------------------------------------------------------- /R/ac.R: -------------------------------------------------------------------------------- 1 | #' Autocorrelation and partial autocorrelation function. 2 | #' 3 | #' @import tibble dplyr ggplot2 patchwork 4 | #' @param data A numeric, time series, or xts variable. 5 | #' @param max_lag A number that represents the maximum lag order for the ACF and PACF. 6 | #' @param main_title Optional plot title. 7 | #' @param output Return data or not. 8 | #' 9 | #' @return The ggplot plots for the respective ACF and PACF functions. 10 | #' @export 11 | #' 12 | #' @examples 13 | #' ac(rnorm(100)) 14 | 15 | ac <- function(data, max_lag = NULL, main_title = NULL, output = NULL) { 16 | 17 | # colours 18 | tsm_pal <- list( 19 | default = tribble(~ colour, ~ hex, 20 | 'blue', '#4682B4', 21 | 'purple', '#B44683', 22 | 'gold', '#B4A446', 23 | 'darkblue','#31697E', 24 | 'darkpurple','#7E315C' 25 | ) |> deframe() 26 | ) 27 | 28 | # global functions or variables 29 | LAG <- integer() 30 | ACF <- numeric() 31 | PACF <- numeric() 32 | 33 | # confidence intervals 34 | num <- length(data) 35 | U <- 2 / sqrt(num) 36 | L <- -U 37 | 38 | # conditions 39 | if (num > 49 & is.null(max_lag)) 40 | max_lag = ceiling(10 + sqrt(num)) 41 | if (num < 50 & is.null(max_lag)) 42 | max_lag = floor(5 * log10(num)) 43 | if (max_lag > (num - 1)) 44 | stop("Number of lags exceeds number of observations") 45 | 46 | # calculations 47 | cf <- tibble( 48 | ACF = stats::acf(data, max_lag, plot = FALSE)$acf[-1], 49 | PACF = as.numeric(stats::pacf(data, max_lag, plot = FALSE)$acf), 50 | LAG = 1:max_lag 51 | ) |> 52 | dplyr::select(LAG, ACF, PACF) 53 | 54 | # plot 55 | p1 <- cf |> 56 | ggplot() + 57 | geom_bar(aes(x = LAG, y = ACF), 58 | stat = "identity", 59 | fill = tsm_pal$default[[1]]) + 60 | geom_hline(yintercept = c(U, L), 61 | linetype = "dashed", 62 | color = tsm_pal$default[[3]], 63 | linewidth = 1) + 64 | annotate(geom = "rect", xmin = 0, xmax = max_lag, ymin = L, ymax = U, 65 | fill = tsm_pal$default[[3]], alpha = 0.1) + 66 | theme_light() + 67 | theme( 68 | axis.title.x = element_blank(), 69 | plot.title = element_text(hjust = 0.5), 70 | axis.ticks.x = element_blank(), 71 | plot.margin = margin(0.6, 0.6, 0.6, 0.6, "cm"), 72 | legend.justification = c(0,1), 73 | legend.position = 'none', 74 | legend.title = element_blank() 75 | ) + 76 | expand_limits(y = c(-0.91, 0.91)) + 77 | xlim(c(0, max_lag)) + 78 | labs(y = "ACF", x = NULL) 79 | 80 | 81 | 82 | p2 <- cf |> 83 | ggplot() + 84 | geom_bar(aes(x = LAG, y = PACF), 85 | stat = "identity", 86 | fill = tsm_pal$default[[1]]) + 87 | geom_hline(yintercept = c(U, L), linetype = "dashed", 88 | color = tsm_pal$default[[3]], linewidth = 1) + 89 | annotate(geom = "rect", xmin = 0, xmax = max_lag, ymin = L, ymax = U, 90 | fill = tsm_pal$default[[3]], alpha = 0.1) + 91 | theme_light() + 92 | theme( 93 | axis.title.x = element_blank(), 94 | plot.title = element_text(hjust = 0.5), 95 | axis.ticks.x = element_blank(), 96 | plot.margin = margin(0.6, 0.6, 0.6, 0.6, "cm"), 97 | legend.justification = c(0,1), 98 | legend.position = 'none', 99 | legend.title = element_blank() 100 | ) + 101 | expand_limits(y = c(-0.91, 0.91)) + 102 | xlim(c(0, max_lag)) + 103 | labs(y = "PACF", x = NULL) 104 | 105 | 106 | cf_plot <- p1 + p2 + 107 | plot_layout(nrow = 1, byrow = FALSE) + 108 | plot_annotation(title = main_title) 109 | 110 | if (is.null(output)) { 111 | return(cf_plot) 112 | } else { 113 | return(list(cf_plot, cf)) 114 | } 115 | 116 | } 117 | 118 | -------------------------------------------------------------------------------- /R/gts_ur.R: -------------------------------------------------------------------------------- 1 | #' General-to-Specific application of Dickey-Fuller (1981) Test. 2 | #' 3 | #' @importFrom urca ur.df 4 | #' @param series A vector of numeric values. 5 | #' 6 | #' @return Summary of the results of the various tests. 7 | #' @export 8 | #' 9 | #' @examples 10 | #' gts_ur(rnorm(100)) 11 | 12 | gts_ur<-function(series) 13 | { 14 | ur.trend <- urca::ur.df(series, type='trend', selectlags = c("AIC")) 15 | tstat.trend <- ur.trend@teststat 16 | cv.trend <- ur.trend@cval 17 | res.trend <- cbind(t(round(tstat.trend,2)),cv.trend) 18 | nam.trend <- rownames(res.trend) 19 | nam.trend[agrep("tau", nam.trend)] <- "pi" 20 | nam.trend[grep("phi2", nam.trend)] <- "varphi2" 21 | nam.trend[grep("phi3", nam.trend)] <- "varphi3" 22 | rownames(res.trend) <- nam.trend 23 | 24 | ur.drift <- urca::ur.df(series, type='drift', selectlags = c("AIC")) 25 | tstat.drift <- ur.drift@teststat 26 | cv.drift <- ur.drift@cval 27 | res.drift <- cbind(t(round(tstat.drift,2)),cv.drift) 28 | nam.drift <- rownames(res.drift) 29 | nam.drift[agrep("tau", nam.drift)] <- "pi" 30 | nam.drift[grep("phi1", nam.drift)] <- "varphi1" 31 | rownames(res.drift) <- nam.drift 32 | 33 | ur.none <- urca::ur.df(series, type='none', selectlags = c("AIC")) 34 | tstat.none <- ur.none@teststat 35 | cv.none <- ur.none@cval 36 | res.none <- cbind(t(round(tstat.none,2)),cv.none) 37 | nam.none <- rownames(res.none) 38 | nam.none[agrep("tau", nam.none)] <- "pi" 39 | rownames(res.none) <- nam.none 40 | 41 | # print summary 42 | cat(" ", "\n") 43 | cat("#################", "\n") 44 | cat("## ADF summary ##", "\n") 45 | cat("#################", "\n") 46 | cat(" ", "\n") 47 | 48 | if (res.trend[1,1] <= res.trend[1,3]) { 49 | cat("Able to reject null of unit root at 5% - with constant & trend", "\n") 50 | }else if (res.trend[1,1] > res.trend[1,3] && res.trend[2,1] >= res.trend[2,3]) { 51 | cat("Unable to reject null of unit root at 5% - with constant & trend", "\n") 52 | 53 | }else if (res.drift[1,1] <= res.drift[1,3]) { 54 | cat("Able to reject null of unit root at 5% - with constant", "\n") 55 | }else if (res.drift[1,1] > res.drift[1,3] && res.drift[2,1] >= res.drift[2,3]) { 56 | cat("Unable to reject null of unit root at 5% - with constant", "\n") 57 | 58 | }else if (res.none[1,1] <= res.none[1,3]) { 59 | cat("Able to reject null of unit root at 5% - no deterministic", "\n") 60 | }else {cat("Cannot reject null of unit root at 5% - no deterministic", "\n")} 61 | 62 | # print results 63 | cat(" ", "\n") 64 | cat("## ADF with constrant and time trend ##", "\n") 65 | print(res.trend) 66 | cat(" ", "\n") 67 | if (res.trend[1,1] > res.trend[1,3]) { 68 | cat("Cannot reject null of unit root at 5%", "\n") 69 | }else cat("Able to reject null of unit root at 5%", "\n") 70 | if (res.trend[2,1] < res.trend[2,3]) { 71 | cat("Cannot reject null of no constant and no trend at 5%", "\n") 72 | }else cat("Able to reject null of no constant and no trend at 5%", "\n") 73 | if (res.trend[3,1] < res.trend[3,3]) { 74 | cat("Cannot reject null of no trend at 5%", "\n") 75 | }else cat("Able to reject null of no trend at 5%", "\n") 76 | cat(" ", "\n") 77 | 78 | cat("## ADF with constrant ##", "\n") 79 | print(res.drift) 80 | cat(" ", "\n") 81 | if (res.drift[1,1] > res.drift[1,3]) { 82 | cat("Cannot reject null of unit root at 5%", "\n") 83 | }else cat("Able to reject null of unit root at 5%", "\n") 84 | if (res.drift[2,1] < res.drift[2,3]) { 85 | cat("Cannot reject null of no constant at 5%", "\n") 86 | }else cat("Able to reject null of no constant at 5%", "\n") 87 | cat(" ", "\n") 88 | 89 | cat("## ADF with no deterministic ##", "\n") 90 | print(res.none) 91 | cat(" ", "\n") 92 | if (res.none[1,1] > res.none[1,3]) { 93 | cat("Cannot reject null of unit root at 5%", "\n") 94 | }else cat("Able to reject null of unit root at 5%", "\n") 95 | cat(" ", "\n") 96 | 97 | } 98 | --------------------------------------------------------------------------------