My goal is to (1) prove the hypothesis of seasonality in this inflation time-series and (2) remove the seasonality via the X-13-ARIMA-SEATS procedure.
My questions are (1) how does one prove such hypothesis and (2) how does one know if the procedure has worked.
The code:
if (!require("tis")) {install.packages("tis"); library('tis')} # Load time series library if (!require("seasonal")) {install.packages("seasonal"); library('seasonal')} inflation.start <- c(1960,1) inflation.end <- c(2018,1) inflation.raw <- "rawData/germany_inflation.csv" inflation.table <- read.table(inflation.raw, skip = 1, header = F, sep = ',', stringsAsFactors = F) inflation.ger <- ts(inflation.table[,2], start = inflation.start, frequency = 4) ts.plot(inflation.ger) # plot acf(inflation.ger) # auto-correlation inflation.seasadj <- final(seas(as.ts(naWindow(inflation.ger),freq=4))) # seasonal adjustment inflation.seasadj.ger <- ts(inflation.seasadj, start = inflation.start, frequency = 4)
The data:
dput(inflation.ger) structure(c(2.22222222222224, 1.244019138756, 0.75973409306742, 1.80608365019013, 1.98487712665404, 2.64650283553874, 2.73327049952876, 3.36134453781511, 3.15106580166824, 2.39410681399631, 2.47706422018348, 3.25203252032522, 2.87511230907457, 2.42805755395685, 3.31244404655327, 2.27471566054242, 2.09606986899562, 2.72168568920105, 2.2530329289428, 2.05303678357573, 3.07955517536358, 3.84615384615386, 3.98305084745763, 4.10729253981556, 4.06639004149377, 3.04526748971191, 2.93398533007336, 2.49597423510466, 1.8341307814992, 1.75718849840257, 1.10847189231985, 1.49253731343286, 1.25293657008615, 1.33437990580847, 1.80109631949884, 1.62538699690402, 2.01082753286931, 2.09140201394268, 1.92307692307691, 2.89413556740292, 3.33586050037907, 3.5660091047041, 4.00000000000001, 4.44115470022204, 5.06236243580337, 5.78754578754579, 5.66037735849054, 5.31537916371368, 4.88826815642457, 5.47091412742381, 6.25000000000001, 6.46029609690444, 7.39014647137152, 6.9599474720946, 7.30446024563674, 7.45891276864728, 7.06757594544325, 6.99815837937383, 6.44578313253009, 5.88235294117648, 6.25361899247252, 6.08146873207113, 5.43293718166383, 5.22222222222223, 4.30517711171662, 3.78583017847487, 3.70370370370372, 3.80147835269271, 3.81400208986417, 3.85617509119333, 3.46790890269152, 3.00101729399797, 2.86864620030195, 2.50878073256398, 2.50125062531265, 2.91358024691356, 3.27788649706457, 4.650024473813, 5.31966813079548, 5.51823416506719, 5.92136428233066, 5.19176800748362, 5.14365152919371, 5.72987721691677, 5.81395348837209, 6.66963094708762, 7.13970912296167, 5.89247311827958, 5.36770921386304, 5.08545227177989, 4.648292883587, 4.06173842404549, 3.28920978740473, 3.13367711225704, 2.71226415094341, 2.84933645589384, 2.83495145631071, 1.88461538461538, 2.06659012629162, 2.31499051233397, 2.30362537764349, 2.076255190638, 1.57480314960629, 0.741839762611279, 0, -0.332840236686399, -0.922849760059066, -0.515463917525782, 0.0369139904023732, 0.519480519480511, 0.968703427719836, 0.962250185048109, 1.14391143911439, 1.29198966408267, 1.69741697416972, 2.4193548387097, 2.88215979569498, 2.80612244897959, 3.01161103047896, 2.72011453113812, 2.3049645390071, 2.72952853598016, 3.02923564635434, 2.84251480582282, 3.29915972330998, 4.51351791825871, 5.50437317784258, 5.9108527131783, 6.09404990403073, 4.95750708215298, 3.33642261353105, 4.66605672461115, 4.38715513342377, 4.5434098065677, 4.30493273542601, 2.97202797202796, 2.77296360485268, 2.58175559380379, 2.45055889939811, 2.07979626485568, 1.7284991568297, 1.5520134228188, 1.46873688627781, 1.45530145530146, 1.45047658516367, 1.36307311028499, 1.53019023986766, 1.76229508196721, 1.55228758169937, 2.32273838630808, 2.11812627291242, 1.24848973016513, 1.36765888978277, 0.597371565113501, 0.438771439968094, 0.198886237072386, 0.515873015873038, 0.673000791765629, 0.953137410643369, 1.54823342596267, 1.10540860639556, 1.37632717263074, 1.73092053501181, 1.72009382329947, 2.53807106598985, 2.01706749418153, 1.6627996906419, 1.99846272098384, 1.29474485910129, 1.21673003802282, 1.17915557246102, 1.13036925395631, 0.789473684210527, 1.05184072126221, 1.16541353383457, 0.968703427719814, 1.86497575531517, 1.82156133828996, 2.0066889632107, 1.62361623616237, 1.24496521420726, 1.64293537787514, 1.67577413479055, 1.70660856935367, 1.84448462929475, 1.4727011494253, 1.28986026513793, 1.7850767583006, 2.05965909090908, 2.26548672566371, 3.0774672798019, 2.94633461943178, 2.88796102992346, 3.08065074420214, 1.61290322580647, 0.81771720613288, 0.270544470747383, -0.235057085292139, 0.405268490374862, 0.811084825954715, 1.11298482293424, 1.11073712554695, 1.37907837201482, 1.87730472678512, 2.00133422281521, 2.19707057256989, 2.22295952222959, 2.13886146758801, 1.86396337475473, 2.01954397394136, 2.01233365790325, 1.54639175257732, 1.50882825040129, 1.62835249042147, 1.33630289532296, 1.20558375634519, 1.07526881720429, 0.848256361922726, 0.50235478806906, 0.0313479623824208, 0.469336670838559, 0.124610591900319, 0.312402374258052, 0.250705108116592, 0.0934288383680993, 0.466708151835709, 1.12114606041732, 1.87558612066271, 1.68014934660859, 1.73428305977082, 1.66307360640589, 1.50352868978214), .Tsp = c(1960, 2017.75, 4), class = "ts")
Best Answer
Use the spectrum.test
function in the ts.extend
package
A reasonable first step here would be to fit a linear regression model using time (numeric) and quarter (categorical) as explanatory variables. You can then use an ANOVA to determine whether there is evidence of the quarter affecting the inflation rate. You can also plot the residuals to see what is left-over once you remove the trend and any quarter-seasonality.
#Set up data n <- length(inflation.ger) TIME <- 1:n QTR <- rep(c('Qtr1', 'Qtr2', 'Qtr3', 'Qtr4'), times = n/4) DATA <- data.frame(Inflation = c(inflation.ger), Time = TIME, Quarter = QTR) #Fit regression model MODEL <- lm(Inflation ~ Time + factor(Quarter), data = DATA) RESID <- MODEL$residuals #Plot residuals plot(RESID, ylim = c(-5,5), type = 'l', xlab = 'Time', ylab = 'Inflation Residual') #Examine ANOVA anova(MODEL) Analysis of Variance Table Response: Inflation Df Sum Sq Mean Sq F value Pr(>F) Time 1 170.13 170.134 67.5025 1.601e-14 *** factor(Quarter) 3 0.03 0.011 0.0042 0.9996 Residuals 227 572.13 2.520 --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
From the ANOVA we see that there is no evidence of an effect for the quarter variable (i.e., no evidence of an annual seasonal effect). However, the residuals in the plot show some clear "waves" that are indicative of seasonality. To test formally for seasonality in the residuals we can plot the intensity in the Fourier domain and perform a permutation-spectrum test (O'Neill 2021, O'Neill 2021). From the output below you can see that there is strong evidence for the presence of one or more signals ($p=4 times 10^{-6}$).
#Conduct permutation-spectrum test TEST <- ts.extend::spectrum.test(RESID) plot(TEST) TEST Permutation-Spectrum Test data: real time-series vector RESID with 232 values maximum scaled intensity = 4.6728, p-value = 4e-06 alternative hypothesis: distribution of time-series vector is not exchangeable (at least one periodic signal is present)