EconGroup`EGFiltering

Code by Luci Ellis, based on template by Roman E. Maeder, Programming in Mathmatica, 3rd Edition

This notebook forms the basis of a package for various methods of time series filtering not contained in the standard release of Mathematica.

Reference

Title

EGFiltering

Author

Luci B. Ellis

Summary

This notebook forms the basis of a package for various methods of data filtering not contained in the standard release of Mathematica.

Copyright

© Copyright 1997-9, Luci Ellis

Permission is granted to distribute this file for any purpose except for inclusion in commercial software or program collections. This copyright notice must remain intact.

Notebook Version

2.0

Mathematica Version

3.0

History

Version 1.0  implemented Hodrick-Prescott filter, 15 July 1997.
Version 2.0 implemented Henderson moving average weights, 21 February 1999.

Keywords

data smoothing, filters, Hodrick-Prescott, Henderson moving average weights.

Source

Hodrick, R.J. and E.C. Prescott (1980) “Postwar US Business Cycles: An Empirical Investigation”, Carnegie Mellon University Discussion Paper No. 451.
Australian Bureau of Statistics “A Guide to Smoothing Time Series” Cat. No 1301.0.
Note that there appears to be a typographical error in the printed tables for the 17 term averages (the signs of a couple of the weights are shown as positive when they need to be negative to ensure the weights add to 1).  These have been corrected in this implementation.

Warnings

No global effects or limitations currently known. Please report all bugs to Luci Ellis at elisha@dot.net.au

Limitation

The Henderson moving average procedure is only valid for 5, 7, 9, 13, 15, 17 and 23-term averages.

Discussion

The Hodrick-Prescott filter works by finding the values (Subscript[τ, t]),  t = 1  …𝕋 that minimise:
	ℒ = \(TraditionalForm
      \`∑\+\(t = 1\)\%𝕋\((
              y\_\(t - 1\) - τ\_\(t - 1\))\)\^2 + 
        λ 
          \(∑\+\(t = 1\)\%𝕋\((
                Δτ\_\(t + 1\) - Δτ\_t)
                \)\^2\)\)
The value for λ is typically 1600, but this is not required to be the case.
The first-order conditions for this minimisation problem are linear and have a simple structure, so that the algorithm constructs the first-order conditions directly rather than constructing the loss function and differentiating it with respect to each τ. This reduces the computational time substantially.

Requirements

Statistics`DataSmoothing  required for MovingAverage[] command.

Interface

This part declares the publicly visible functions, options, and values.

Set up the package context, including public imports

BeginPackage["EconGroup`EGFiltering`","Statistics`DataSmoothing`"]

Usage messages for the exported functions and the context itself

EGFiltering::usage = "EGFiltering.m is a package containing various functions for smoothing and filtering data, including Henderson moving averages and the univariate Hodrick-Prescott filter."

HendersonTrendExtraction::usage="HendersonTrendExtraction[data,MAOrder] calculates a long-term trend-cycle component of a time series using applications of a Henderson moving average. You may want to Nest[] this function. Data is assumed monthly unless specified otherwise using the DataFrequency option. The MAOrder must be one of the standard ones -- 5,7,9,13,15,17,23."

HendersonMovingAverage::usage="HendersonMovingAverage[data,Order] calculates a  Henderson moving average. Unlike other moving average procedures, this one does not lose data points, but the endpoints are liable to be revised as new data comes in. Order must be an integer from the list {5,7,9,13,15,17,23}."

HendersonMid::usage="HendersonMid[Order] provides the middle part of the Henderson MA weights. Order must be an integer from the list {5,7,9,13,15,17,23}."

HendersonStart::usage="HendersonStart[Order] provides the beginning part of the Henderson MA weights. Order must be an integer from the list {5,7,9,13,15,17,23}."

HendersonEnd::usage="HendersonEnd[Order] provides the end part of the Henderson MA weights. Order must be an integer from the list {5,7,9,13,15,17,23}."

DataFrequency::usage="DataFrequency is an option to HendersonTrendExtraction that specifies the periodicity of the data.  It can take a positive integer value, or one of Daily, Weekly, Monthly, Quarterly or those words as Strings (in quote marks)."

SeasonalityAveraging::usage="SeasonalityAveraging is an option to HendersonTrendExtraction that specifies the number of years of data to put in the moving average to get rid of seasonal effects."

hendersonweights::usage = "hendersonweights[n] gives the list of weights to be used in the LinearFilter function to perform a n-term Henderson Moving Average. The start and end-point weights are not used."

HPFilter::usage = "HPFilter[data,lambda] performs a Hodrick-Prescott filter on data, with a weight on smoothness of lambda (usually 1600 for quarterly data). Data can be a vector or a matrix; in the latter case, the filter is applied to individual rows in the matrix."

Error messages for the exported objects

HendersonTrendExtraction::badfreq="DataFrequency option must be a positive integer, or one of Daily, Weekly, Monthly or Quarterly."

HendersonTrendExtraction::negord="Order of Henderson moving average must be positive and one of the values 5,7,9,13,15,17,23. Pick 13, it works well."

HendersonTrendExtraction::badord="Order of Henderson moving average must be one of the values 5,7,9,13,15,17,23. The value `1` is not appropriate. Pick 13, it works well."

HendersonTrendExtraction::negord="Order of Henderson moving average must be positive and one of the values 5,7,9,13,15,17,23. Pick 13, it works well."

HendersonMovingAverage::badord="Order of Henderson moving average must be one of the values 5,7,9,13,15,17,23. The value `1` is not appropriate. Pick 13, it works well."

HendersonMovingAverage::badlen="Length of data series must be greater than order of moving average process."

Implementation

This part contains the actual definitions and any auxiliary functions that should not be visible outside.

Begin the private context (implementation part)

Begin["`Private`"]

Read in any hidden imports

Definition of auxiliary functions and local (static) variables

hendersonweights

\(hendersonweights[n_Integer] /; \ \ 
        \((n == 5\  || \ n == 7\  || \ n == 9\  || \ n == 13\  || \ n == 15\ 
             || \ n == 17
 || \ n == 23\ )\)\ \  := HendersonMid[n]\)

\(HendersonMid[5] = 
      \ {\(-0.073\), \ 0.294, \ 0.558, \ 0.294, \ \(-0.073\)}\ ; 

    HendersonMid[7] = 
      \ {\(-0.059\), \ 0.059, \ 0.294, \ 0.412, \ 0.294, \ 0.059, \ 
        \(-0.059\)}\ ; 

    HendersonMid[9] = 
      \ {\(-0.041\), \ \(-0.010\), \ 0.119, \ 0.267, \ 0.33, \ 0.267, \ 
        0.119, \ \(-0.010\), \(-0.041\)}\ ; 

    HendersonMid[13] = 
      
{\(-0.019\), \(-0.028\), 0, 0.066, 0.147, 0.214, 0.24, 0.214, 0.147, 
        0.066, 0, \(-0.028\), \(-0.019\)}\ ; 

    HendersonMid[15] = 
      \ {\ \(-0.014\), \ \(-0.024\), \(-0.014\), 0.024, 0.083, \ 0.146, \ 
        0.194, \ 0.212, 
0.194, \ 0.146, \ 0.083, \ 0.024, \ \(-0.014\), \ 
        \(-0.024\), \(-0.014\)}\ ; 

    HendersonMid[17] = 
      \ {\(-0.009\), \ \(-0.02\), \ \(-0.019\), \ 0.002, \ 0.042, \ 0.092, \ 
        0.141, \ 0.176, \ 0.190, \ 0.176, \ 
\ \ \ \ \ \ 0.141, \ 0.092, \ 
        0.042, \ 0.002, \ \(-0.019\), \ \(-0.02\), \ \(-0.009\)}\ ; 

    HendersonMid[23] = 
      \ {\(-0.004\), \(-0.011\), \(-0.016\), \(-0.015\), \(-0.005\), \ 0.013, 
        \ 0.039, \ 0.068, 
0.097, \ 0.122, \ 0.138, \ 0.148, \ 0.138, \ 
        0.122, \ 0.097, \ 0.068, \ 0.039, \ 0.013, 
\(-0.005\), \ 
        \(-0.015\), \ \(-0.016\), \ \(-0.011\), \ \(-0.004\)}\ ; \)

\(HendersonEnd[5] = {{0, 0, \(-0.073\), 0.403, 0.670}, \ 
        
{0, \(-0.073\), \ 0.294, 0.522, 0.257}, \ 
        
{\(-0.073\), \ 0.294, \ 0.558, \ 0.294, \ \(-0.073\)}\ }\ ; 

    HendersonStart[5] = {{0.670, 0.403, \(-0.073\), 0, 0}, \ 
        
{\ 0.257, 0.522, 0.294, \(-0.073\), 0}, \ 
        
{\(-0.073\), \ 0.294, \ 0.558, \ 0.294, \ \(-0.073\)}\ }\ ; \)

\(HendersonEnd[7] = 
      
{{0, 0, 0, \(-0.034\), 0.116, 0.383, 0.535}, 
        
{0, 0, \(-0.054\), 0.061, 0.294, 0.41, 0.289}, 
        
{0, \(-0.053\), 0.058, 0.287, 0.399, 0.275, 0.034}, \ 
        
{\(-0.059\), \ 0.059, \ 0.294, \ 0.412, \ 0.294, \ 0.059, \ 
          \(-0.059\)}\ }; 

    HendersonStart[7] = {{0.535, 0.383, 0.116, \(-0.034\), 0, 0, 0}, 

        		{0.289, 0.41, 0.294, 0.061, \(-0.054\), 0, 0}, {0.034, \ 0.275, \ 
          0.399, 0.287, 0.058, \(-0.053\), 0}, {\(-0.059\), 0.059, 0.294, 
          0.412, 0.294, 0.059, \(-0.059\)}}; \)

\(HendersonEnd[9] = {
        
{0, 0, 0, 0, \(-0.156\), \(-0.034\), 0.185, 0.424, 0.581}\ , 
        
{0, 0, 0, \(-0.049\), \(-0.011\), 0.126, 0.282, 0.354, 0.298}, \ 
        
{0, 0, \(-0.022\), 0, 0.12, 0.259, 0.315, 0.242, 0.086}, \ 
        
{0, \(-0.031\), \(-0.004\), 0.12, 0.263, 0.324, 0.255, 0.102, 
          \(-0.029\)}, \ 
        
{\(-0.041\), \ \(-0.010\), \ 0.119, \ 0.267, \ 0.33, \ 0.267, \ 
          0.119, \ \(-0.010\)\ , \ \(-0.041\)}}; 

    HendersonStart[9] = {

        	{0.581, \ 0.424, \ 0.185, \ \(-0.034\), \ \(-0.156\), \ 0, \ 0, \ 
          0, \ 0}, \ 

        \ \ {0.298, \ 0.354, \ 0.282, \ 0.126, \ \(-0.011\), \ \(-0.049\), \ 
          0, \ 0, \ 0}, \ 

        \ \ {0.086, \ 0.242, \ 0.315, \ 0.259, \ 0.12, \ 0, \ \(-0.022\), \ 
          0, \ 0}, \ 

        \ \ {\(-0.029\), \ 0.102, \ 0.255, \ 0.324, \ 0.263, \ \ 0.12, \ 
          \(-0.004\), \ \(-0.031\), \ 0}, \ 

        \ \ {\(-0.041\), \ \(-0.01\), \ 0.119, \ 0.267, \ 0.33, \ 0.267, \ 
          0.119, \ \(-0.01\), \ \(-0.041\)}}; \)

\(HendersonEnd[13] = {
        
{0, 0, 0, 0, 0, 0, \(-0.092\), \(-0.058\), 0.012, 0.12, 0.244, 
          0.353, 0.421}, 
        
{0, 0, 0, 0, 0, \(-0.043\), \(-0.038\), 0.002, 0.08, 0.174, 0.254, 
          0.292, 0.279}, \ 
        
{0, 0, 0, 0, \(-0.016\), \(-0.025\), 0.003, 0.068, 0.149, 0.216, 
          0.241, 0.216, 0.148}, 
        
{0, 0, 0, \(-0.009\), \(-0.022\), 0.004, 0.066, 0.145, 0.208, 
          0.230, 0.201, 0.131, 0.046}, 
        
{0, 0, \(-0.011\), \(-0.022\), 0.003, 0.067, 0.145, 0.21, 0.235, 
          0.205, 0.136, 0.050, \(-0.018\)}, 
        
{0, \(-0.017\), \(-0.025\), 0.001, 0.066, 0.147, 0.213, 0.238, 
          0.212, 0.144, 0.061, \(-0.006\), \(-0.034\)}, 
        
{\(-0.019\), \(-0.028\), 0, 0.066, 0.147, 0.214, 0.24, 0.214, 
          0.147, 0.066, 0, \(-0.028\), \(-0.019\)}
}; 

    HendersonStart[13]
         = {{0.421, \ 0.353, \ 0.244, \ 0.120, \ \ 0.0120, \ \(-0.058\), \ 
          \(-0.092\), \ 0, \ 0, \ 0, \ 0, \ 0, \ 0}, \ 

        \ \ {0.279, \ 0.292, \ 0.254, \ 0.174, \ 0.08, \ 0.002, \ \ 
          \(-0.038\), \ \(-0.043\), \ 0, \ 0, \ 0, \ 0, \ 0}, \ 

        \ \ {0.148, \ 0.216, \ 0.241, \ 0.216, \ 0.149, \ 0.068, \ 0.003, \ 
          \(-0.025\), \ \(-0.016\), \ \ 0, \ 0, \ 0, \ 0}, \ 

        	{0.046, \ 0.131, \ 0.201, \ 0.230, 0.208, \ 0.145, \ 0.066, \ 
          0.004, \ \(-0.022\), \ \(-0.009\), \ 0, \ 0, \ 0}, \ 

        \ \ {\(-0.0180\), \ 0.05, \ 0.136, \ 0.205, \ 0.235, \ 0.21, \ 0.145, 
          \ 0.067, \ 0.003, \ \(-0.022\), \ \(-0.011\), \ 0, \ 0}, \ 

        \ \ {\(-0.034\), \ \(-0.006\), \ 0.061, \ 0.144, 0.212, \ \ 0.238, \ 
          0.213, \ 0.147, \ 0.066, \ 0.001, \ \ \(-0.025\), \ \(-0.017\), \ 
          0}, \ 
	{\(-0.019\), \ \(-0.028\), \ 0, \ 0.066, \ 0.147, \ 
          0.214, \ 0.240, \ 0.214, \ 0.147, \ 0.066, \ 0, \ \(-0.028\), \ 
          \(-0.019\)}}; \)

\(HendersonEnd[15] = {
        
{0, 0, 0, 0, 0, 0, 0, \(-0.079\), \(-0.057\), \(-0.014\), 0.057, 
          0.149, 0.244, 0.325, 0.375}\ , 
        
{0, 0, 0, 0, 0, 0, \(-0.04\), \(-0.039\), \(-0.016\), 0.034, 0.105, 
          0.18, 0.24, 0.27, 0.265}, 
        
{0, 0, 0, 0, 0, \(-0.016\), \(-0.025\), \(-0.013\), 0.027, 0.088, 
          0.152, 0.202, 0.221, 0.205, 0.159}, 
        
{0, 0, 0, 0, \(-0.005\), \(-0.018\), \(-0.01\), 0.026, 0.083, 
          0.143, 0.189, 0.205, 0.185, 0.135, 0.069}, 
        
{0, 0, 0, \(-0.005\), \(-0.018\), \(-0.01\), 0.026, 0.082, 0.143, 
          0.188, 0.203, 0.183, 0.133, 0.067, 0.006}, \ 
        
{0, 0, \(-0.008\), \(-0.02\), \(-0.011\), 0.025, 0.083, 0.144, 
          0.191, 0.207, 0.188, 0.139, 0.074, 0.014, \(-0.026\)}, \ 
        
{0, \(-0.012\), \(-0.023\), \(-0.013\), 0.025, 0.083, 0.146, 0.193, 
          0.210, 0.192, 0.144, 0.080, 0.021, \(-0.017\), \(-0.028\)}, \ 
        
{\ \(-0.014\), \ \(-0.024\), \(-0.014\), 0.024, 0.083, \ 0.146, \ 
          0.194, \ 0.212, \ 0.194, \ 0.146, 0.083, \ 0.024, \ \(-0.014\), \ 
          \(-0.024\), \(-0.014\)}\ }; 

    HendersonStart[15] = {

        		{0.375, \ 0.325, \ 0.244, \ 0.149, \ 0.0570, \ \(-0.014\), \ 
          \(-0.057\), \ \(-0.079\), \ 0, \ 0, \ 0, \ 0, \ 0, \ 0, \ 0}, \ 
        
{0.265, \ 0.27, \ 0.240, \ 0.180, \ 0.105, \ 0.034, \ \(-0.016\), 
          \ \ \(-0.039\), \ \(-0.04\), \ 0, \ 0, \ 0, \ 0, \ 0, \ 0}, \ 
        
{0.159, \ 0.205, \ 0.221, \ 0.202, \ 0.152, \ \ 0.088, \ 0.027, \ 
          \(-0.013\), \ \(-0.025\), \ \(-0.016\), \ 0, \ 0, \ 0, \ 0, \ 0}, \ 
        
{0.069, \ 0.135, \ 0.185, \ 0.205, \ 0.189, \ 0.143, \ 0.083, \ \ 
          0.026, \ \(-0.01\), \ \(-0.018\), \ \(-0.005\), \ 0, \ 0, \ 0, \ 
          0}, \ 
{0.006, \ 0.067, \ 0.133, \ 0.183, \ 0.203, \ 0.188, \ 
          0.143, \ 0.082, \ 0.026, \ \(-0.01\), \ \(-0.018\), \ \(-0.005\), \ 
          0, \ 0, \ 0}, \ 
        
{\(-0.026\), \ 0.014, \ 0.074, \ 0.139, \ 0.188, \ 0.207, \ 0.191, 
          \ 
\ \ \ 0.144, \ 0.083, \ 0.025, \ \(-0.011\), \ \(-0.02\), \ 
          \(-0.008\), \ 0, \ 0}, \ 
        
{\(-0.028\), \ \(-0.017\), \ 0.021, \ 0.08, \ 0.144, \ 0.192, \ 
          0.21, \ 0.193, \ 0.146, \ 0.083, \ 0.025, \ \(-0.013\), \ 
          \(-0.023\), \ \(-0.012\), \ 0}, \ 
        
{\(-0.014\), \ \(-0.024\), \ \(-0.014\), \ \ 0.024, \ 0.083, \ 
          0.146, \ 0.194, \ 0.212, \ \ 0.194, \ 0.146, \ 0.083, \ 0.024, \ 
          \(-0.014\), \ \ \(-0.024\), \ \(-0.014\)}}; \)

HendersonEnd[17] = 
   {{0, 0, 0, 0, 0, 0, 0, 0, -0.081, -0.062, -0.032, 0.018, 0.087, 0.166, 0.244, 0.309, 0.351}, 
    {0, 0, 0, 0, 0, 0, 0, -0.042, -0.04, -0.026, 0.007, 0.059, 0.121, 0.182, 0.23, 0.255, 0.254}, 
    {0, 0, 0, 0, 0, 0, -0.017, -0.025, -0.02, 0.004, 0.047, 
     0.101, 0.152, 0.191, 0.206, 0.197, 0.164}, 
    {0, 0, 0, 0, 0, -0.005, -0.016, -0.015, 0.005, 0.043, 0.092, 0.14, 0.174, 0.186, 
     0.172, 0.136, 0.086}, 
    {0, 0, 0, 0, -0.001, -0.013, -0.014, 0.005, 0.043, 
     0.091, 0.138, 0.171, 0.181, 0.167, 0.129, 0.078, 0.026}, 
    {0, 0, 0, -0.003, -0.015, -0.015, 0.005, 0.043, 
     0.091, 0.138, 0.172, 0.183, 0.169, 0.132, 0.081, 0.029, -0.012}, 
    {0, 0, -0.006, -0.017, -0.016, 0.004, 0.043, 0.092, 0.14, 0.174, 0.186, 
     0.173, 0.137, 0.087, 0.036, -0.005, -0.027}, 
    {0, -0.009, -0.019, -0.018, 0.003, 0.042, 0.092, 0.141, 0.176, 
     0.188, 0.175, 0.14, 0.091, 0.04, 0.001, -0.021, -0.023}, 
    {-0.009, -0.02, -0.019, 0.002, 0.042, 0.092, 0.141, 0.176, 0.190, 0.176, 
      0.141, 0.092, 0.042, 0.002, -0.019, -0.02, -0.009}}; 
HendersonStart[17] = 
   {{0.351, 0.309, 0.244, 0.166, 0.087, 0.018, -0.032, -0.062, -0.081, 0, 0, 0, 0, 0, 0, 0, 0}, 
    {0.254, 0.255, 0.23, 0.182, 0.121, 0.059, 0.007, -0.026, -0.04, -0.042, 0, 0, 0, 0, 0, 0, 0},
    {0.164, 0.197, 0.206, 0.191, 0.152, 0.101, 0.047, 0.004, -0.02, -0.025,
      -0.017, 0, 0, 0, 0, 0, 0}, 
    {0.086, 0.136, 0.172, 0.186, 0.174, 0.14, 0.092, 0.043, 0.005, 
       -0.015, -0.016, -0.005, 0, 0, 0, 0, 0}, 
    {0.026, 0.078, 0.129, 0.167, 0.181, 0.171, 0.138, 0.091, 
     0.043, 0.005, -0.014, -0.013, -0.001, 0, 0, 0, 0}, 
    {-0.012, 0.029, 0.081, 0.132, 0.169, 0.183, 0.172, 0.138, 0.091, 0.043, 
     0.005, -0.015, -0.015, -0.003, 0, 0, 0}, 
    {-0.027, -0.005, 0.036, 0.087, 0.137, 0.173, 0.186, 0.174, 0.14, 
     0.092, 0.043, 0.004, -0.016, -0.017, -0.006, 0, 0}, 
    {-0.023, -0.021, 0.001, 0.04,0.091, 0.14, 0.175, 0.188, 
     0.176, 0.141, 0.092, 0.042, 0.003, -0.018, -0.019, -0.009, 0}, 
    {-0.009, -0.02, -0.019, 0.002, 0.042, 0.092, 0.141, 0.176, 0.190, 0.176, 
      0.141, 0.092, 0.042, 0.002, -0.019, -0.02, -0.009}};

HendersonEnd[23] = 
   {{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -0.077, -0.064, -0.049, -0.028, 0.002, 
     0.039, 0.084, 0.133, 0.1819999999999999, 0.227, 0.2629999999999999, 
     0.2879999999999999}, 
   {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -0.04599999999999999, 
     -0.041, -0.035, -0.02399999999999999, -0.004, 0.025, 0.06099999999999999, 
     0.101, 0.1409999999999999, 0.1759999999999999, 0.203, 0.2189999999999999, 
     0.224},
   {0, 0, 0, 0, 0, 0, 0, 0, 0, -0.02199999999999999, -0.025, -0.025, 
     -0.019, -0.005, 0.01799999999999999, 0.049, 0.08200000000000001, 0.116, 
     0.1459999999999999, 0.166, 0.177, 0.1759999999999999, 0.166}, 
    {0, 0, 0, 0, 0, 0, 0, 0, -0.008, -0.014, -0.01799999999999999, -0.015, 
     -0.004, 0.015, 0.042, 0.07299999999999999, 0.103, 0.129, 0.1469999999999999, 
     0.154, 0.15, 0.134, 0.112}, {0, 0, 0, 0, 0, 0, 0, -0.001, -0.008, -0.013, 
     -0.01199999999999999, -0.003, 0.015, 0.04009999999999999, 
     0.06809999999999999, 0.0981, 0.1211, 0.1370999999999999, 0.1421, 
     0.1350999999999999, 0.1191, 0.09510000000000001, 0.0661}, 
    {0, 0, 0, 0, 0, 0, 0.003, -0.006, -0.01099999999999999, -0.01099999999999999, 
     -0.002, 0.015, 0.039, 0.067, 0.095, 0.1189999999999999, 0.134, 0.139, 0.131, 
     0.114, 0.08799999999999998, 0.05899999999999999, 0.027}, 
    {0, 0, 0, 0, 0, 0.002, -0.006, -0.01199999999999999, -0.01099999999999999, 
     -0.003, 0.015, 0.039, 0.068, 0.09599999999999999, 0.1179999999999999, 0.134, 
     0.138, 0.132, 0.114, 0.08899999999999998, 0.05899999999999999, 0.027, 0.001}, 
    {0, 0, 0, 0, 0.001, -0.007, -0.013, -0.01099999999999999, -0.003, 0.015, 
     0.039, 0.068, 0.09599999999999999, 0.1199999999999999, 0.135, 0.14, 0.133, 
     0.116, 0.09, 0.06, 0.031, 0.005, -0.015}, 
    {0, 0, 0, -0.002, -0.007, -0.013, -0.013, -0.003, 0.014, 0.039, 0.068, 
     0.09699999999999999, 0.1199999999999999, 0.137, 0.14, 0.136, 
     0.1179999999999999, 0.09399999999999998, 0.064, 0.034, 0.008, -0.01, -0.021}, 
    {0, 0, -0.003, -0.01, -0.015, -0.014, -0.005, 0.014, 0.04, 0.069, 
     0.09699999999999999, 0.1219999999999999, 0.138, 0.1429999999999999, 0.137, 
     0.1199999999999999, 0.095, 0.067, 0.037, 0.01099999999999999, -0.007, 
     -0.017, -0.019}, {0, -0.004, -0.01099999999999999, -0.016, -0.015, -0.005, 
     0.013, 0.039, 0.068, 0.09699999999999999, 0.1219999999999999, 0.138, 
     0.1439999999999999, 0.138, 0.1219999999999999, 0.09699999999999999, 0.068, 
     0.039, 0.013, -0.005, -0.015, -0.016, -0.01099999999999999}, 
    {-0.004, -0.01099999999999999, -0.016, -0.015, -0.005, 0.013, 0.039, 0.068, 
     0.09699999999999999, 0.1219999999999999, 0.138, 0.1479999999999999, 0.138, 
     0.1219999999999999, 0.09699999999999999, 0.068, 0.039, 0.013, -0.005, -0.015, 
     -0.016, -0.01099999999999999, -0.004}}; 
  HendersonStart[23] = 
   {{0.288, 0.263, 0.227, 0.1819999999999999, 0.133, 
     0.084, 0.039, 0.002, -0.028, -0.049, -0.064, -0.077, 0, 0, 0, 0, 0, 0, 0, 0, 
     0, 0, 0}, {0.224, 0.2189999999999999, 0.203, 0.1759999999999999, 
     0.1409999999999999, 0.101, 0.06099999999999999, 0.025, -0.004, 
     -0.02399999999999999, -0.035, -0.041, -0.04599999999999999, 0, 0, 0, 0, 0, 0, 
     0, 0, 0, 0}, {0.166, 0.1759999999999999, 0.177, 0.166, 0.1459999999999999, 
     0.116, 0.08200000000000001, 0.049, 0.01799999999999999, -0.005, -0.019, 
     -0.025, -0.025, -0.02199999999999999, 0, 0, 0, 0, 0, 0, 0, 0, 0}, 
    {0.112, 0.134, 0.15, 0.154, 0.1469999999999999, 0.129, 0.103, 
     0.07299999999999999, 0.042, 0.015, -0.004, -0.015, -0.01799999999999999, 
     -0.014, -0.008, 0, 0, 0, 0, 0, 0, 0, 0}, 
    {0.0661, 0.09510000000000001, 0.1191, 0.1350999999999999, 0.1421, 
     0.1370999999999999, 0.1211, 0.0981, 0.06809999999999999, 0.04009999999999999, 
     0.015, -0.003, -0.01199999999999999, -0.013, -0.008, -0.001, 0, 0, 0, 0, 0, 
     0, 0}, {0.027, 0.05899999999999999, 0.08799999999999998, 0.114, 0.131, 0.139, 
     0.134, 0.1189999999999999, 0.095, 0.067, 0.039, 0.015, -0.002, 
     -0.01099999999999999, -0.01099999999999999, -0.006, 0.003, 0, 0, 0, 0, 0, 0}, 
    {0.001, 0.027, 0.05899999999999999, 0.08899999999999998, 0.114, 0.132, 0.138, 
     0.134, 0.1179999999999999, 0.09599999999999999, 0.068, 0.039, 0.015, -0.003, 
     -0.01099999999999999, -0.01199999999999999, -0.006, 0.002, 0, 0, 0, 0, 0}, 
    {-0.015, 0.005, 0.031, 0.06, 0.09, 0.116, 0.133, 0.14, 0.135, 
     0.1199999999999999, 0.09599999999999999, 0.068, 0.039, 0.015, -0.003, 
     -0.01099999999999999, -0.013, -0.007, 0.001, 0, 0, 0, 0}, 
    {-0.021, -0.01, 0.008, 0.034, 0.064, 0.094, 0.118, 0.136, 0.14, 0.137, 0.12, 0.097, 0.068, 
      0.039, 0.014, -0.003, -0.013, -0.013, -0.007, -0.002, 0, 0, 0}, 
    {-0.019, -0.017, -0.007, 0.011, 0.037, 0.067, 0.095, 0.112, 0.137, 0.143, 0.138, 0.122, 
     0.097, 0.069, 0.04, 0.014, -0.005, -0.014, -0.015, -0.01, -0.003, 0, 0}, 
    {-0.011, -0.016, -0.015, -0.005, 0.013, 0.039, 0.068, 0.097, 0.122, 0.138, 0.144, 
     0.138, 0.122, 0.097, 0.068, 0.039, 0.013, -0.005, -0.015, -0.016, -0.011, -0.004, 0}, 
    {-0.004, -0.011, -0.016, -0.015, -0.005, 0.013, 0.039, 0.068, 0.097, 0.122, 0.138, 0.148, 0.138,
     0.122, 0.097, 0.068, 0.039, 0.013, -0.005, -0.015, -0.016, -0.011, -0.004}};

Definition of the exported functions

HendersonTrendExtraction[]

Options[HendersonTrendExtraction]={DataFrequency->"Monthly",SeasonalityAveraging-> 3}

HendersonTrendExtraction[y : {__?NumericQ}, 
            order_Integer, opts___Rule]/; 
  \(\((order == 5\  || \ order == 7\  || \ order == 9\  || \ 
                order == 13\  || \ order == 15\  || \ order == 17
 || \ 
                order == 23\ )\)\  && \ Length[y] > \ \((order + 1)\)\) :=
With[{seasave=SeasonalityAveraging  /.  {opts} /. Options[HendersonTrendExtraction], 
	freq=Switch[DataFrequency /. {opts}/.Options[HendersonTrendExtraction], "Monthly", 12, "Quarterly" ,4, "Weekly", 52, "Daily", 365,Monthly, 12, Quarterly ,4, Weekly, 52, Daily, 365, _Integer, Abs[DataFrequency /. {opts}/.Options[HendersonTrendExtraction]], _, 
		Message[HendersonTrendExtraction::badfreq];$Failed]},
(
              HendersonMovingAverage[
                Drop[Drop[y, 
                      Floor[(freq - 1 + (seasave*freq) - 1)/2]], 
                    -Ceiling[(freq - 1 + (seasave*freq) - 1)/2]] 
                   -  MovingAverage[
                    Drop[Drop[y, Floor[(freq - 1)/2]], 
                        -Ceiling[(freq - 1)/2]]  - 
                      MovingAverage[y, freq], seasave * freq],  order])
              ]

HendersonTrendExtraction[y : {__?NumericQ}, order_Integer, 
        opts___Rule] :=Message[HendersonTrendExtraction::badord, order]

HendersonMovingAverage[]

HendersonMovingAverage[y : {__Real}, order_Integer, opts___Rule] /;  
        order ≤ 0  :=  
      Message[HendersonMovingAverage::badord, order]

\(HendersonMovingAverage[data : {__?NumericQ}, \ order_Integer] /; \ 

        \ \ \((order == 5\  || \ order == 7\  || \ order == 9\  || \ 
              order == 13\  || \ order == 15\  || \ order == 17
 || \ 
              order == 23\ )\)\  && \ Length[data] > \ \((order + 1)\)\  := 

      With[{n = Length[data]}, 
\ \ \ \ \ \ \ \ 
        Join[
\((HendersonStart[order].\((Take[data, order])\))\), 

          \ \ \ \ \ \ \ \ 
          LinearFilter[Drop[Rest[data], \(-1\)], \ HendersonMid[order]\ ], 

          \ \ Reverse[HendersonEnd[order].\((Take[data, \(-order\)])\)]]\ ]
        \)

HendersonMovingAverage[data : {__?NumericQ},  order_Integer] /;  
        Length[data] <  (order + 1) := 
      Message[HendersonMovingAverage::badord]

HPFilter[]

\(HPFilter[data_?VectorQ, lambda_Integer] := 
	
      Module[{τ, focs, taulist, simpleanswer}, 
		
        With[{𝕋 = Length[data], λ = N[lambda]}, 
          
			taulist\  = \ 
            Table[τ[t], {t, 1, 𝕋}]; 

          focs = 	Flatten[
              Join[{\(-2.\)\ data[[1]]\ 
                     + 2.\ τ[1] + 2.\ λ\ τ[1] - 
                    4.\ λ\ τ[2] + 2.\ λ\ τ[3], 
                  \(-2.\)\ data[[2]] - 
                    4.\ λ\ τ[1] + 2.\ τ[2] + 
                    10.\ λ\ τ[2] - 8.\ λ\ τ[3] + 
                    2.\ λ\ τ[4]}, 

                Table[	\(-2.\)\ \ 
                      data[[t]] + 
                    2.\ λ\ τ[t - 2] - 
                    8.\ λ\ τ[t - 1] + 2.\ τ[t] + 
                    12.\ λ\ τ[t] - 
                    8.\ λ\ τ[t + 1] + 
                    2.\ λ\ τ[t + 2], {t, 3, 
                    𝕋 - 2}], 

                		{\(-2\)\ 
                      data[[𝕋 - 1
                          ]] + 
                    2.\ λ\ τ[𝕋 - 3] - 
                    8.\ λ\ τ[𝕋 - 2] + 
                    2.\ τ[𝕋 - 1] + 
                    10.\ λ\ τ[𝕋 - 1] - 
                    4.\ λ\ τ[𝕋], 
                  2.\ λ\ τ[𝕋 - 2] - 
                    4.\ λ\ τ[𝕋 - 1] + 
                    2.\ λ\ τ[𝕋]}]]; 

          			focs = Thread[focs == 0]; 
		
          simpleanswer = Solve[focs, taulist]; 
		
          Flatten[Expand[N[taulist /. simpleanswer]]]
					]]\)

\(HPFilter[data_?VectorQ, lambda_Real] := 
	
      Module[{τ, focs, taulist, simpleanswer}, 
		
        With[{𝕋 = Length[data], λ = N[lambda]}, 
          
			taulist\  = \ 
            Table[τ[t], {t, 1, 𝕋}]; 

          focs = 	Flatten[
              Join[{\(-2.\)\ data[[1]]\ 
                     + 2.\ τ[1] + 2.\ λ\ τ[1] - 
                    4.\ λ\ τ[2] + 2.\ λ\ τ[3], 
                  \(-2.\)\ data[[2]] - 
                    4.\ λ\ τ[1] + 2.\ τ[2] + 
                    10.\ λ\ τ[2] - 8.\ λ\ τ[3] + 
                    2.\ λ\ τ[4]}, 

                Table[	\(-2.\)\ \ 
                      data[[t]] + 
                    2.\ λ\ τ[t - 2] - 
                    8.\ λ\ τ[t - 1] + 2.\ τ[t] + 
                    12.\ λ\ τ[t] - 
                    8.\ λ\ τ[t + 1] + 
                    2.\ λ\ τ[t + 2], {t, 3, 
                    𝕋 - 2}], 

                		{\(-2\)\ 
                      data[[𝕋 - 1
                          ]] + 
                    2.\ λ\ τ[𝕋 - 3] - 
                    8.\ λ\ τ[𝕋 - 2] + 
                    2.\ τ[𝕋 - 1] + 
                    10.\ λ\ τ[𝕋 - 1] - 
                    4.\ λ\ τ[𝕋], 
                  2.\ λ\ τ[𝕋 - 2] - 
                    4.\ λ\ τ[𝕋 - 1] + 
                    2.\ λ\ τ[𝕋]}]]; 

          			focs = Thread[focs == 0]; 
		
          simpleanswer = Solve[focs, taulist]; 
		
          Flatten[Expand[N[taulist /. simpleanswer]]]
					]]\)

\(HPFilter[\((data_)\)?MatrixQ, lambda_] := 
	
      \(HPFilter[#, lambda]&\)\ /@\ data\)

\(HPFilter[data_List, lambda_] := 
	
      \(HPFilter[#, lambda]&\)\ /@\ data\)

End the private context

End[ ]

Epilog

This section protects exported symbols and ends the package.

Protect exported symbol

Protect[ HPFilter,hendersonweights,HendersonMovingAverage,HendersonStart,HendersonEnd,HendersonMid ]

End the package context

EndPackage[ ]

Examples, Tests

This loads the package

Needs["EconGroup`EGFiltering`"]

This generates some test AR(1) data

testdata = NestList[0.1  + 0.9 #  + 3  Random[] &, 12., 200];

\(Block[{graph1, graph2}, 
	
        graph1\  = 
          ListPlot[HPFilter[testdata, 1600], PlotJoined -> True, 
            DisplayFunction -> Identity, PlotStyle -> Hue[0.01]]; 

        	graph2\  = \ 
          ListPlot[testdata, DisplayFunction -> Identity, 
            PlotStyle -> GrayLevel[0.6]]; 
	
        Show[graph1, graph2, DisplayFunction -> $DisplayFunction]] // 
      Timing\)

Show[{ListPlot[HendersonTrendExtraction[testdata, 13],PlotJoined -> True,DisplayFunction -> Identity],
		ListPlot[Drop[HendersonMovingAverage[testdata, 13],23],PlotStyle -> Hue[0],PlotJoined -> True,DisplayFunction -> Identity]},DisplayFunction -> $DisplayFunction]//Timing

Show[
        ListPlot[testdata, PlotJoined -> True, 
          DisplayFunction -> Identity], 
        ListPlot[HendersonMovingAverage[testdata, 17], 
          PlotJoined -> True, 
          PlotStyle -> {AbsoluteThickness[3.5], GrayLevel[0.7]}, 
          DisplayFunction -> Identity], 
        DisplayFunction -> $DisplayFunction] // Timing