├── .Rbuildignore ├── .gitignore ├── ADF_bHP_ani.gif ├── BoostedHP.Rproj ├── DESCRIPTION ├── LICENSE ├── NAMESPACE ├── R ├── BoostedHP.R ├── bHP.R ├── methods.R ├── plot.bHP.R ├── print.bHP.R └── summary.bHP.R ├── README.md ├── data ├── IRE.rda └── def_par.RData ├── man ├── BIC.bHP.Rd ├── BoostedHP.Rd ├── IRE.Rd ├── bHP.Rd ├── plot.bHP.Rd ├── predict.bHP.Rd ├── print.bHP.Rd ├── residuals.bHP.Rd └── summary.bHP.Rd ├── vignettes ├── .gitignore ├── bHP_illustration.jpg ├── vignette.Rmd └── vignette.pdf └── work_memo ├── Example.R └── match_arg.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | *.tar.gz 6 | *.zip 7 | *.Rcheck* 8 | inst/doc 9 | *.bib 10 | *.bak 11 | *.sav -------------------------------------------------------------------------------- /ADF_bHP_ani.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/chenyang45/BoostedHP/33650d816eea69271456929d3c1d87e27869aed2/ADF_bHP_ani.gif -------------------------------------------------------------------------------- /BoostedHP.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: Sweave 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 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: bHP 2 | Type: Package 3 | Title: Boosted HP filter 4 | Version: 1.0.0 5 | Authors@R: c( 6 | person("Yang", "Chen", role = c("aut", "cre"), email = "chen_yang@link.cuhk.edu.hk"), 7 | person("Zhentao", "Shi", role = c("aut"), email = "shizhentao@gmail.com" ) ) 8 | Description: R package for the boosted HP filter, in 9 | Peter Phillips and Zhentao Shi (2021): "Boosting: Why You Can Use the HP Filter," *International Economic Review*, 62(2), 521-570 10 | arXiv: 1905.00175, Cowles Foundation Discussion Paper No.2192. 11 | License: MIT 12 | Encoding: UTF-8 13 | LazyData: true 14 | Imports: 15 | expm, 16 | stargazer, 17 | animation, 18 | plotly, 19 | magrittr, 20 | tseries 21 | RoxygenNote: 7.1.1 22 | Suggests: 23 | knitr, 24 | rmarkdown 25 | VignetteBuilder: knitr 26 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Chen Yang 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 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(BIC,bHP) 4 | S3method(plot,bHP) 5 | S3method(predict,bHP) 6 | S3method(print,bHP) 7 | S3method(residuals,bHP) 8 | S3method(summary,bHP) 9 | export(BoostedHP) 10 | -------------------------------------------------------------------------------- /R/BoostedHP.R: -------------------------------------------------------------------------------- 1 | #' Boosting the Hodrick-Prescott Filter 2 | #' 3 | #' All in one function of conducting the boosted HP-filter. 4 | #' 5 | #' @param x is a raw time series to be filtered. 6 | #' @param lambda the turning parameter, default value is 1600, 7 | #' as recommended by Hodrick and Prescott (1997) for quarterly data. 8 | #' @param iter logical, \code{TRUE} (default) to conduct the boosted HP filter. 9 | #' FALSE does not iterated, which is exactly the original HP filter. 10 | #' @param stopping stopping criterion. \code{"BIC"} (default), or \code{"adf"}, or \code{"nonstop"} means keeping 11 | #' iteration until the maximum number of iteration, specified by \code{Max_Iter} is reached. 12 | #' @param sig_p a threshold of the p-value for the ADF test, with default value 0.050. 13 | #' Only effective when \code{stopping = "adf"}. 14 | #' @param Max_Iter maximal number of iterations. The default is 100. 15 | #' 16 | #' @return The function returns a list containing the following items: 17 | #' \item{cycle}{The cyclical component in the final iteration.} 18 | #' \item{trend}{The trend component in the final iteration.} 19 | #' \item{trend_hist}{The estimated trend in each iteration.} 20 | #' \item{iter_num}{The total number of iterations when it stops.} 21 | #' \item{IC_hist}{The path of the BIC up to the final iterations.} 22 | #' \item{adf_p_hist}{The path of the ADF test p-value up to the final iteration.} 23 | 24 | #' @details 25 | #' 26 | #' This is the main function of implementing the boosted HP filter (Phillisp and 27 | #' Shi, 2021). The arguments accommendate the orginal HP filter (\code{iter = 28 | #' FALSE}), the boosted HP filter with the BIC stopping criterion (\code{stopping = 29 | #' "BIC"}), 30 | #' or ADF test stopping criterion 31 | #' (\code{stopping = "adf"}), or keep going until the maximum number of iterations is reached 32 | #' (\code{stopping = "nonstop"}). 33 | #' 34 | #' Either the original HP filter or the bHP filter requires \code{lambda} to 35 | #' control the strength of the weak learner for in-sample fitting. The default 36 | #' is \code{lambda = 1600}, which is recommended by Hodrick and Prescott (1997) 37 | #' for quarterly data. \code{lambda} should be adjusted for different 38 | #' frequencies. For example, \code{lambda = 129600} for monthly data and 39 | #' \code{lambda = 6.25} for annual data. 40 | #' 41 | #' See the vignette with a brief introduction of the idea of bHP. 42 | #' 43 | #' @references 44 | #' 45 | #' Peter Phillips and Zhentao Shi, 2021: "Boosting: Why You Can Use the HP Filter," International Economic Review, 62(2), 521-570 46 | #' 47 | #' 48 | #' @export 49 | #' 50 | #' 51 | #' @examples 52 | #' 53 | #' data(IRE) # load the data 'IRE' 54 | #' lam <- 100 # tuning parameter for the annual data 55 | #' 56 | #' # raw HP filter 57 | #' bx_HP <- BoostedHP(IRE, lambda = lam, iter= FALSE) 58 | #' 59 | #' # by BIC 60 | #' bx_BIC <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "BIC") 61 | #' 62 | #' # by ADF 63 | #' bx_ADF <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "adf") 64 | #' 65 | #' # If stopping = "nonstop", 66 | #' # Iterated HP filter until Max_Iter and keep the path of BIC. 67 | #' 68 | #' bx_nonstop <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "nonstop") 69 | 70 | 71 | BoostedHP <- function(x, lambda = 1600, iter= TRUE, stopping = "BIC", sig_p = 0.050, Max_Iter = 100) { 72 | 73 | if (!is.numeric(x) || anyNA(x) ) { 74 | stop("The raw time series is not numeric or it contains NAs: returning NA") 75 | return(NA_real_) 76 | } 77 | 78 | ## generating trend operator matrix "S" 79 | raw_x <- x # save the raw data before HP 80 | n <- length(x) # data size 81 | 82 | I_n <- diag(n) 83 | D_temp <- rbind(matrix(0, 1, n), diag(1, n - 1, n)) 84 | D_temp <- (I_n - D_temp) %*% (I_n - D_temp) 85 | D <- t( D_temp[3:n, ] ) 86 | 87 | S <- solve( I_n + lambda * D %*% t(D) ) # Equation 4 in PJ 88 | mS = diag(n) - S 89 | 90 | 91 | 92 | ## the simple HP-filter 93 | if(iter==FALSE){ 94 | # message("Original HP filter.") 95 | 96 | # get the trend and cycle 97 | x_f <- S %*% x 98 | x_c <- x - x_f 99 | result <- list(cycle = x_c, trend_hist = x_f, 100 | stopping = "nonstop", trend = x - x_c, raw_data = raw_x) 101 | 102 | } 103 | 104 | #################################################### 105 | 106 | ## the boosted HP filter 107 | if(iter==TRUE) { 108 | 109 | # if (stopping == "adf"){ 110 | # # message("bHP with ADF stopping criterion.") 111 | # } else if ( stopping == "BIC"){ 112 | # # message( "bHP with BIC stopping criterion.") 113 | # # message( "Save the path of BIC till iter+1 times to show the 'turning point' feature of choosen iteration time in BIC history.") 114 | # } else if ( stopping == "nonstop" ) { 115 | # # message( "bHP filter until Max_Iter and keep the path of BIC.") 116 | # } 117 | 118 | ### ADF test as the stopping criterion 119 | if (stopping =="adf") { 120 | 121 | r <- 1 122 | stationary <- FALSE 123 | x_c <- x 124 | 125 | x_f <- matrix(0, n, Max_Iter) 126 | adf_p <- rep(0, Max_Iter) 127 | 128 | while( (r <= Max_Iter) & (stationary == FALSE)){ 129 | 130 | x_c <- ( diag(n) - S ) %*% x_c # update 131 | x_f[, r] <- x - x_c 132 | 133 | adf_p_r <- (tseries::adf.test(x_c, alternative = "stationary"))$p.value 134 | # x_c is the residual after the mean and linear trend being removed by HP filter 135 | # we use the critical value for the ADF distribution with 136 | # the intercept and linear trend specification 137 | 138 | adf_p[r] <- adf_p_r 139 | 140 | if(stopping == "adf") stationary <- (adf_p_r <= sig_p) 141 | 142 | # Truncate the storage matrix and vectors 143 | if(stationary == TRUE){ 144 | R <- r 145 | x_f <- x_f[, 1:R] 146 | adf_p <- adf_p[1:R] 147 | break 148 | } 149 | 150 | r <- r + 1 151 | } # end the while loop 152 | 153 | if( r > Max_Iter ){ 154 | R <- Max_Iter 155 | warning("The number of iterations exceeds Max_Iter. 156 | The residual cycle remains non-stationary.") 157 | } 158 | 159 | result <- list(cycle = x_c, trend_hist = x_f, stopping = stopping, 160 | signif_p = sig_p, adf_p_hist= adf_p, iter_num = R, 161 | trend = x - x_c, raw_data = raw_x) 162 | } else { # either BIC or nonstopping 163 | 164 | # assignment 165 | r <- 0 166 | x_c_r <- x 167 | x_f <- matrix(0, n, Max_Iter) 168 | IC <- rep(0, Max_Iter) 169 | IC_decrease = TRUE 170 | 171 | 172 | I_S_0 = diag(n) - S 173 | c_HP = I_S_0 %*% x 174 | I_S_r = I_S_0 175 | 176 | 177 | while( r < Max_Iter ) { 178 | r <- r + 1 179 | 180 | x_c_r = I_S_r %*% x # this is the cyclical component after m iterations 181 | x_f[, r] = x - x_c_r 182 | B_r <- diag(n) - I_S_r 183 | IC[r] = var (x_c_r ) / var( c_HP ) + log( n )/ (n - sum(diag (S) ) ) * sum( diag( B_r ) ) 184 | 185 | I_S_r = I_S_0 %*% I_S_r # update for the next round 186 | 187 | if ( (r >= 2) & ( stopping == "BIC") ) { 188 | if ( IC[r-1] < IC[r] ) { break } 189 | } 190 | 191 | } # end of the while loop 192 | 193 | # final assignment 194 | R = r - 1; 195 | x_f <- as.matrix(x_f[, 1:R]) 196 | x_c <- x - x_f[,R] 197 | 198 | if(stopping == "BIC"){ 199 | # save the path of BIC till iter+1 times to keep the "turning point" of BIC history. 200 | result <- list(cycle = x_c, trend_hist = x_f, stopping = stopping, 201 | BIC_hist = IC[1:(R+1)], iter_num = R, trend = x- x_c, raw_data = raw_x) 202 | } 203 | 204 | if(stopping == "nonstop"){ 205 | 206 | result <- list(cycle = x_c, trend_hist = x_f, stopping = stopping, 207 | BIC_hist = IC,iter_num = Max_Iter-1, trend = x- x_c, raw_data = raw_x) 208 | } 209 | } 210 | } # end the boosted HP 211 | 212 | attr(result,'class')<-'bHP' # assign the class 213 | return(result) 214 | } 215 | 216 | 217 | -------------------------------------------------------------------------------- /R/bHP.R: -------------------------------------------------------------------------------- 1 | #' bHP: Package for the boosted HP filter 2 | #' 3 | #' The boosted HP filter by Phillips and Shi (2019) 4 | #' 5 | #' \code{BoostedHP} is the main function. It generates a \code{bHP} object which can work with 6 | #' generic methods. 7 | #' 8 | #' @references 9 | #' 10 | #' Peter Phillips and Zhentao Shi, 2021: "Boosting: Why You Can Use the HP Filter," International Economic Review, 62(2), 521-570 11 | #' 12 | #' @docType package 13 | #' @name bHP 14 | NULL 15 | 16 | 17 | 18 | #' Ireland Annual GDP 19 | #' 20 | #' @usage data(IRE) 21 | #' 22 | 23 | #' @format 24 | #' \itemize{ 25 | #' \item\strong{Release:} {Gross Domestic Product} 26 | #' \item\strong{Frequency:} {Annual} 27 | #' \item\strong{Date Range:} {1981--2016} 28 | #' } 29 | #' 30 | #' @section Description: 31 | #' This dataset is described in Section 4.1 of Philips and Shi (2019). 32 | #' Also See Okun, Ball, Leigh, and Loungani (2017). 33 | #' 34 | #' 35 | #' @source OECD Stat \url{https://stats.oecd.org/} 36 | #' 37 | #' @references 38 | #' 39 | #' Peter Phillips and Zhentao Shi, 2021: "Boosting: Why You Can Use the HP Filter," International Economic Review, 62(2), 521-570 40 | #' 41 | #' Ball, Laurence, Daniel Leigh, and Prakash Loungani. 42 | #' "Okun's law: Fit at 50?." 43 | #' Journal of Money, Credit and Banking 49, no. 7 (2017): 1413-1441. 44 | #' 45 | #' 46 | #' @docType data 47 | "IRE" 48 | -------------------------------------------------------------------------------- /R/methods.R: -------------------------------------------------------------------------------- 1 | #' BIC.bHP 2 | #' 3 | #' Extract the path of BIC value of each iterated BIC HP-filter conduction for 4 | #' class \code{bHP}. As \code{nonstop} type of bHP also keeps BIC for each iteration time till 5 | #' the \code{Max_iter}, BIC.bHP method returns BIC value for it as well. 6 | #' 7 | #' @param x an object of class \code{bHP} 8 | #' 9 | #' @return a vector recording BIC after each iteration of bHP. 10 | #' 11 | #' @export 12 | #' 13 | #' @examples 14 | #' lam <- 100 # tuning parameter for the annual data 15 | #' 16 | #' data(IRE) # load the data 'IRE' 17 | #' 18 | #' # by BIC 19 | #' 20 | #' bx_BIC <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "BIC") 21 | #' 22 | #' BIC(bx_BIC) 23 | #' 24 | #' 25 | #' bx_none <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "nonstop") 26 | #' 27 | #' BIC(bx_none) 28 | #' 29 | #' 30 | #' 31 | #' ### If the test type is not "adf", Pvalue.bHP will return error 32 | #' 33 | #' # raw HP filter 34 | #' 35 | #' bx_HP <- BoostedHP(IRE, lambda = lam, iter= FALSE) 36 | #' 37 | #' BIC(bx_HP) 38 | #' 39 | #' # Error in BIC.bHP(bx_HP) : 40 | #' # The stationary test type is none-iter, not BIC or none. 41 | #' 42 | #' 43 | #' # by ADF 44 | #' bx_ADF <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "adf") 45 | #' 46 | #' BIC(bx_ADF) 47 | #' 48 | #' #Error in BIC.bHP(bx_ADF) : 49 | #' #The stationary test type is adf, not BIC or none. 50 | #' 51 | BIC.bHP <- function(x){ 52 | 53 | if(x$stopping == "BIC" | x$stopping == "nonstop"){ 54 | 55 | message("Retrun the BIC path of ", x$stopping, ".") 56 | message("Number of iterations: ",x$iter_num) 57 | message("Keep the path of BIC till iterated ", (x$iter_num+1), " times.") 58 | 59 | return(x$BIC_hist) 60 | } 61 | else { 62 | message("The stopping criterion is not BIC.") 63 | } 64 | } 65 | 66 | ##################################################################### 67 | 68 | #' Predict.bHP 69 | #' 70 | #' Extract the final trend component for class \code{bHP}. 71 | #' 72 | #' @param x an object of class \code{bHP} 73 | #' 74 | #' @return the estimated trend component 75 | #' 76 | #' @export 77 | #' 78 | #' @examples 79 | #' lam <- 100 # tuning parameter for the annual data 80 | #' 81 | #' data(IRE) # load the data 'IRE' 82 | #' 83 | #' # raw HP filter 84 | #' bx_HP <- BoostedHP(IRE, lambda = lam, iter = FALSE) 85 | #' 86 | #' # by ADF 87 | #' bx_ADF <- BoostedHP(IRE, lambda = lam, iter = TRUE, stopping = "adf", sig_p = 0.050) 88 | #' 89 | #' # return the final trend component 90 | #' 91 | #' predict(bx_HP) 92 | #' 93 | #' predict(bx_ADF) 94 | 95 | 96 | predict.bHP <- function(x) { 97 | message("Retrun the trend component of ", x$stopping, " criterion.") 98 | message("Number of iterations: ", length(x$trend_hist[1, ])) 99 | 100 | return(x$trend) 101 | } 102 | 103 | #################################################### 104 | #' Residuals.bHP 105 | #' 106 | #' Extract the final cycle component for class \code{bHP}. 107 | #' 108 | #' @param x an object of class \code{bHP} 109 | #' 110 | #' @return the estimated cycle component 111 | #' 112 | #' @export 113 | #' 114 | #' @examples 115 | #' lam <- 100 # tuning parameter for the annual data 116 | #' 117 | #' data(IRE) # load the data 'IRE' 118 | #' 119 | #' # raw HP filter 120 | #' bx_HP <- BoostedHP(IRE, lambda = lam, iter = FALSE) 121 | #' 122 | #' # by ADF 123 | #' bx_ADF <- BoostedHP(IRE, lambda = lam, iter = TRUE, stopping = "adf", sig_p = 0.050) 124 | #' 125 | #' # return the final trend component 126 | #' 127 | #' residuals(bx_HP) 128 | #' 129 | #' residuals(bx_ADF) 130 | 131 | residuals.bHP <- function(x) { 132 | message("Retrun the trend component of ", x$stopping, " criterion.") 133 | message("Number of iterations: ", length(x$trend_hist[1, ])) 134 | 135 | return(x$cycle) 136 | } 137 | #################################################### 138 | -------------------------------------------------------------------------------- /R/plot.bHP.R: -------------------------------------------------------------------------------- 1 | #' Plot method for class \code{bHP} 2 | #' 3 | #' plot method for a \code{bHP} object 4 | #' 5 | #' @param x an object of class \code{bHP} 6 | #' @param plot_type a character string specifies the style of plot.'static' for 7 | #' static figure, 'JS' for plotly.js, a web-based interactive charting 8 | #' library, 'dynamic' for dynamic figure showing history of iterated process. 9 | #' @param interval_t a positive number to set the time interval of the animation 10 | #' (unit in seconds); default to be 0.3. 11 | #' @param ylab a title for the y axis: see 'title' in package 'graphics'. 12 | #' @param col_raw A specification for the default plotting color of raw data. 13 | #' See section ‘Color Specification’. 14 | #' @param col_trend_h A specification for the default plotting color of trend 15 | #' history. See section ‘Color Specification’. 16 | #' @param col_trend_f A specification for the default plotting color of final 17 | #' trend component. See section ‘Color Specification’. 18 | #' @param col_pvalue_BIC A specification for the default plotting color of 19 | #' p-value of BIC. See section ‘Color Specification’. 20 | #' @param raw_alpha a numeric vector from 0 to 255 modifying color transparency 21 | #' of plotting raw data. The smaller the number, the more transparent. 22 | #' @param trend_h_alpha a numeric vector from 0 to 255 modifying color 23 | #' transparency of plotting trend history. The smaller the number, the more 24 | #' transparent. 25 | #' @param trend_f_alpha a numeric vector from 0 to 255 modifying color 26 | #' transparency of plotting final trend component. The smaller the number, the 27 | #' more transparent. 28 | #' @param pvalue_BIC_alpha a numeric vector from 0 to 255 modifying color 29 | #' transparency of plotting p-value or BIC. The smaller the number, the more 30 | #' transparent. 31 | #' @param legend_location a character string or a pair of numeric vector 32 | #' specifying the location of legend. The choice set of the character sting 33 | #' are: upleft, downleft, upright, downright. 34 | #' @param iteration_location a character string or a pair of numeric vector 35 | #' specifying the location of 'iteration time'. The choice set of the character 36 | #' sting are: upleft, downleft, upright, downright. 37 | #' @param cex_text The magnification to be used for showing 'iteration time' 38 | #' relative to the current setting of cex. 39 | #' @param cex_legend The magnification to be used for legend relative to the 40 | #' current setting of cex. 41 | #' @param main an overall title for the plot: see 'title' in package 'graphics'. 42 | #' 43 | #' @return X-Y Plotting method for class 'bHP' 44 | #' @export 45 | #' 46 | #' @examples 47 | #' 48 | #' lam <- 100 # tuning parameter for the annual data 49 | #' 50 | #' \dontrun{ 51 | #' data(IRE) # load the data 'IRE' 52 | #' 53 | #' # raw HP filter 54 | #' bx_HP <- BoostedHP(IRE, lambda = lam, iter= FALSE) 55 | #' 56 | #' # by BIC 57 | #' bx_BIC <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "BIC") 58 | #' 59 | #' # by ADF 60 | #' bx_ADF <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "adf") 61 | #' 62 | #' # by nonstop test type 63 | #' # Iterated HP filter until Max_Iter and keep the path of BIC. 64 | #' 65 | #' bx_nonstop <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "nonstop") 66 | #' 67 | #' #--------- start to plot the content of bHP ----------------- 68 | #' 69 | #' 70 | #' #--------- for dynamic style (default)-------- 71 | #' plot(bx_ADF) 72 | #' 73 | #' plot(bx_ADF, iteration_location = "upright") # change the location of text 74 | #' 75 | #' plot(bx_ADF, iteration_location = c(30,12)) # assign the location of text by x-y co-ordinates 76 | #' 77 | #' plot(bx_BIC, interval_t = 0.8 ) # change the time interval of animation 78 | #' 79 | #' plot(bx_nonstop, cex_legend = 2, cex_text = 3) # change the magnification of legend and text 80 | #' 81 | #' # change the color 82 | #' plot(bx_ADF,main = "dynamic graph with new color",col_raw = "#685F74", col_trend_h = "#39A1A8", col_trend_f = "#DD4B4F", col_pvalue_BIC = "#E96145") 83 | #' 84 | #' # change the transparency 85 | #' plot(bx_ADF,main = "dynamic graph with new transparency setting",raw_alpha = 200, trend_h_alpha = 55, trend_f_alpha = 250, pvalue_BIC_alpha = 250) 86 | #' 87 | #' # Note: 'nonstop' bHP doesn't have dynamic figure 88 | #' plot(bx_HP) 89 | #' # Error in plot.bHP(bx_HP) : 90 | #' #'nonstop-iter' bHP doesn't have dynamic picture: returning NA 91 | #' 92 | #' #--------- for JS style ---------- 93 | #' 94 | #' plot(bx_ADF,plot_type = "JS") 95 | #' 96 | #' # change the color 97 | #' plot(bx_ADF,plot_type = "JS",main = "Js graph with new color", col_raw = "#685F74", col_trend_f = "#DD4B4F", col_pvalue_BIC = "#39A1A8") 98 | #' 99 | #' plot(bx_BIC,plot_type = "JS") 100 | #' 101 | #' plot(bx_nonstop,plot_type = "JS") 102 | #' 103 | #' plot(bx_HP,plot_type = "JS") 104 | #' 105 | #' #--------- for static style ---------- 106 | #' 107 | #' plot(bx_ADF,plot_type = "static",cex_legend = 0.7, cex_text = 0.8 ) 108 | #' 109 | #' plot(bx_HP,plot_type = "static") 110 | #' 111 | #' plot(bx_BIC,plot_type = "static",cex_legend = 0.7, cex_text = 0.8 ) 112 | #' 113 | #' plot(bx_nonstop,plot_type = "static",cex_legend = 0.8, cex_text = 0.8 ) 114 | #' } 115 | #' 116 | plot.bHP <- 117 | function(x, 118 | plot_type = "dynamic", 119 | interval_t = 0.3, 120 | ylab = "", 121 | col_raw = "#2D5375", 122 | col_trend_h = "#FBB545", 123 | col_trend_f = "red", 124 | col_pvalue_BIC = "red", 125 | # the range of alpha is 0-255 126 | raw_alpha = 255, 127 | trend_h_alpha = 75, 128 | trend_f_alpha = 255, 129 | pvalue_BIC_alpha = 255, 130 | legend_location = "upleft", 131 | iteration_location = "downright", 132 | cex_text = 1.7, 133 | cex_legend = 1.5, 134 | main = paste0("Figure of ", x$stopping, " bHP (", plot_type, ")")) { 135 | message(plot_type, " plot of ", x$stopping, " bHP") 136 | 137 | # load default par, for resetting 138 | data("def_par") 139 | 140 | location <- function(textinplot_location) { 141 | switch( 142 | textinplot_location, 143 | upright = c(xticks[length(xticks) - 2], yticks[length(yticks)]), 144 | downright = c(xticks[length(xticks) - 2], (yticks[1] + yticks[2]) / 145 | 2), 146 | upleft = c((2.5) * (xticks[1] + xticks[2]) / 3, yticks[length(yticks)]), 147 | downleft = c((2.5) * (xticks[1] + xticks[2]) / 3, (yticks[1] + 148 | yticks[2]) / 2) 149 | ) 150 | } 151 | 152 | # POSIXct (date/time) index 153 | 154 | if (plot_type == "static") { 155 | if (x$stopping == "nonstop-iter") { 156 | dev.next() 157 | par(def_par) 158 | #layout(matrix(1), widths = lcm(12), heights = lcm(12)) 159 | par(las = 1) 160 | col_rgb <- as.numeric(col2rgb(col_raw)) 161 | 162 | plot( 163 | x$raw_data, 164 | pch = 16, 165 | col = rgb( 166 | red = col_rgb[1], 167 | green = col_rgb[2], 168 | blue = col_rgb[3], 169 | alpha = raw_alpha, 170 | maxColorValue = 255 171 | ) 172 | , 173 | lwd = 1, 174 | ylab = ylab 175 | ) 176 | 177 | col_rgb <- as.numeric(col2rgb(col_trend_f)) 178 | col <- 179 | rgb( 180 | red = col_rgb[1], 181 | green = col_rgb[2], 182 | blue = col_rgb[3], 183 | alpha = trend_f_alpha, 184 | maxColorValue = 255 185 | ) 186 | lines(x$trend , 187 | type = "l", 188 | col = col, 189 | lwd = 2) 190 | 191 | x_l <- x$raw_data 192 | y_l <- NULL 193 | xy <- xy.coords(x_l, y_l, log = "") 194 | xy$xlab <- NULL 195 | 196 | #xlim_design <- range(xy$x[is.finite(xy$x)]) 197 | #ylim_design <- range(xy$y[is.finite(xy$y)]) 198 | 199 | localAxis <- 200 | function(..., col, bg, pch, cex, lty, lwd) 201 | Axis(...) 202 | xticks <- localAxis(xy$x, side = 1) 203 | yticks <- localAxis(xy$y, side = 2) 204 | # may try col = "gray90" 205 | abline( 206 | NULL, 207 | NULL, 208 | lty = 1, 209 | col = "gray80", 210 | lwd = .08, 211 | h = yticks 212 | ) 213 | abline( 214 | NULL, 215 | NULL, 216 | lty = 1, 217 | col = "gray80", 218 | lwd = .08, 219 | h = NULL, 220 | v = xticks 221 | ) 222 | 223 | # Title 224 | # mtext(main, side=3, line=1, cex=1.3, family="Consolas") 225 | mtext(main, 226 | side = 3, 227 | line = 1, 228 | cex = 1.3) 229 | 230 | 231 | # location of text 232 | 233 | temp <- try(location(iteration_location), silent = T) 234 | if ('try-error' %in% class(temp)) { 235 | locate_text <- as.numeric(iteration_location) 236 | } else{ 237 | locate_text <- as.numeric(location(iteration_location)) 238 | } 239 | 240 | 241 | # location of legend 242 | 243 | temp <- try(location(legend_location), silent = T) 244 | if ('try-error' %in% class(temp)) { 245 | locate_legend <- as.numeric(legend_location) 246 | } else{ 247 | locate_legend <- as.numeric(location(legend_location)) 248 | } 249 | 250 | # Text 251 | text( 252 | x = locate_text[1], 253 | y = locate_text[2], 254 | c("Iterated Only Once"), 255 | cex = cex_text, 256 | col = "black", 257 | font = 2 258 | ) 259 | 260 | # Legend 261 | legend( 262 | x = locate_legend[1], 263 | y = locate_legend[2], 264 | c("Raw Data", "Trend Component"), 265 | col = c(col_raw, col_trend_f), 266 | text.col = c(col_raw, col_trend_f), 267 | lty = c(-1,-1), 268 | pch = c(16, 15), 269 | text.font = 3, 270 | cex = cex_legend, 271 | bg = "white", 272 | bty = "n" 273 | ) 274 | 275 | 276 | } 277 | 278 | if (x$stopping != "nonstop-iter") { 279 | dev.next() 280 | par(def_par) 281 | layout(matrix(c(1, 1, 2, 2), 2, 2, byrow = TRUE), c(6), c(4, 2), TRUE) 282 | par(mar = c(3, 4, 3, 3), las = 1) 283 | 284 | col_rgb <- as.numeric(col2rgb(col_raw)) 285 | 286 | plot( 287 | x$raw_data, 288 | pch = 16, 289 | col = rgb( 290 | red = col_rgb[1], 291 | green = col_rgb[2], 292 | blue = col_rgb[3], 293 | alpha = raw_alpha, 294 | maxColorValue = 255 295 | ) 296 | , 297 | lwd = 1, 298 | ylab = ylab 299 | ) 300 | 301 | for (i in 1:x$iter_num) { 302 | if (i == x$iter_num) { 303 | col_rgb <- as.numeric(col2rgb(col_trend_f)) 304 | col <- 305 | rgb( 306 | red = col_rgb[1], 307 | green = col_rgb[2], 308 | blue = col_rgb[3], 309 | alpha = trend_f_alpha, 310 | maxColorValue = 255 311 | ) 312 | lwd <- 1.6 313 | 314 | } else{ 315 | col_rgb <- as.numeric(col2rgb(col_trend_h)) 316 | col <- 317 | rgb( 318 | red = col_rgb[1], 319 | green = col_rgb[2], 320 | blue = col_rgb[3], 321 | alpha = trend_h_alpha, 322 | maxColorValue = 255 323 | ) 324 | lwd <- 2 325 | } 326 | 327 | lines(x$trend_hist[, i], 328 | type = "l", 329 | col = col, 330 | lwd = lwd) 331 | } 332 | x_l <- x$raw_data 333 | y_l <- NULL 334 | xy <- xy.coords(x_l, y_l, log = "") 335 | xy$xlab <- NULL 336 | 337 | #xlim_design <- range(xy$x[is.finite(xy$x)]) 338 | #ylim_design <- range(xy$y[is.finite(xy$y)]) 339 | 340 | localAxis <- 341 | function(..., col, bg, pch, cex, lty, lwd) 342 | Axis(...) 343 | xticks <- localAxis(xy$x, side = 1) 344 | yticks <- localAxis(xy$y, side = 2) 345 | # may try col = "gray90" 346 | abline( 347 | NULL, 348 | NULL, 349 | lty = 1, 350 | col = "gray80", 351 | lwd = .08, 352 | h = yticks 353 | ) 354 | abline( 355 | NULL, 356 | NULL, 357 | lty = 1, 358 | col = "gray80", 359 | lwd = .08, 360 | h = NULL, 361 | v = xticks 362 | ) 363 | 364 | # Title 365 | # mtext(main, side=3, line=1, cex=1.3, family="Consolas") 366 | mtext(main, 367 | side = 3, 368 | line = 1, 369 | cex = 1.3) 370 | 371 | 372 | # location of text 373 | 374 | temp <- try(location(iteration_location), silent = T) 375 | if ('try-error' %in% class(temp)) { 376 | locate_text <- as.numeric(iteration_location) 377 | } else{ 378 | locate_text <- as.numeric(location(iteration_location)) 379 | } 380 | 381 | 382 | # location of legend 383 | 384 | temp <- try(location(legend_location), silent = T) 385 | if ('try-error' %in% class(temp)) { 386 | locate_legend <- as.numeric(legend_location) 387 | } else{ 388 | locate_legend <- as.numeric(location(legend_location)) 389 | } 390 | 391 | 392 | text( 393 | x = locate_text[1], 394 | y = locate_text[2], 395 | paste0("Iterated Times: ", as.character(c(1:x$iter_num)[i])), 396 | cex = cex_text, 397 | col = "black", 398 | font = 2 399 | ) 400 | 401 | # Legend 402 | legend( 403 | x = locate_legend[1], 404 | y = locate_legend[2], 405 | c("Raw Data", "Trend History", "Final Trend"), 406 | col = c(col_raw, col_trend_h, col_trend_f), 407 | text.col = c(col_raw, col_trend_h, col_trend_f), 408 | lty = c(-1,-1,-1), 409 | pch = c(16, 15, 15), 410 | text.font = 3, 411 | cex = cex_legend, 412 | bg = "white", 413 | bty = "n" 414 | ) 415 | 416 | if (x$stopping == "adf") { 417 | par(mar = c(3, 4, 3, 3), las = 1) 418 | 419 | col_rgb <- as.numeric(col2rgb(col_pvalue_BIC)) 420 | col <- 421 | rgb( 422 | red = col_rgb[1], 423 | green = col_rgb[2], 424 | blue = col_rgb[3], 425 | alpha = pvalue_BIC_alpha, 426 | maxColorValue = 255 427 | ) 428 | 429 | plot( 430 | x$adf_p_hist, 431 | main = c("p-value"), 432 | bty = "l", 433 | ylab = "", 434 | xlim = c(0, x$iter_num + 1), 435 | ylim = c(0, range(x$adf_p_hist)[2]), 436 | col = col, 437 | pch = 19 438 | ) 439 | abline(h = x$signif_p , col = "gray50") 440 | text(0.5, 441 | (x$signif_p + 0.03), 442 | paste0("sig p = ", x$signif_p) , 443 | col = "gray50") 444 | } 445 | 446 | if (x$stopping == "BIC") { 447 | par(mar = c(3, 4, 3, 3), las = 1) 448 | 449 | col_rgb <- as.numeric(col2rgb(col_pvalue_BIC)) 450 | col <- 451 | rgb( 452 | red = col_rgb[1], 453 | green = col_rgb[2], 454 | blue = col_rgb[3], 455 | alpha = pvalue_BIC_alpha, 456 | maxColorValue = 255 457 | ) 458 | 459 | plot( 460 | x$BIC_hist, 461 | main = c("BIC value"), 462 | bty = "l", 463 | ylab = "", 464 | xlim = c(0, x$iter_num + 1), 465 | ylim = range(x$BIC_hist), 466 | col = col, 467 | pch = 19 468 | ) 469 | abline(h = as.numeric(x$BIC_hist[x$iter_num]), col = "gray50") 470 | abline(v = which.min(x$BIC_hist), col = "gray50") 471 | text( 472 | as.numeric(x$iter_num), 473 | as.numeric(x$BIC_hist[x$iter_num] + 0.05), 474 | paste0("min BIC(", x$iter_num, "th)") , 475 | col = "gray50" 476 | ) 477 | } 478 | 479 | if (x$stopping == "nonstop") { 480 | par(mar = c(3, 4, 3, 3), las = 1) 481 | 482 | col_rgb <- as.numeric(col2rgb(col_pvalue_BIC)) 483 | col <- 484 | rgb( 485 | red = col_rgb[1], 486 | green = col_rgb[2], 487 | blue = col_rgb[3], 488 | alpha = pvalue_BIC_alpha, 489 | maxColorValue = 255 490 | ) 491 | 492 | plot( 493 | x$BIC_hist, 494 | main = c("BIC value"), 495 | bty = "l", 496 | ylab = "", 497 | xlim = c(0, x$iter_num + 1), 498 | ylim = c(0, range(x$BIC_hist)[2]), 499 | col = col, 500 | pch = 19 501 | ) 502 | abline(h = min(as.numeric(x$BIC_hist)), col = "gray50") 503 | abline(v = which.min(x$BIC_hist), col = "gray50") 504 | text( 505 | which.min(x$BIC_hist), 506 | as.numeric(min(x$BIC_hist)) - 0.05, 507 | paste0("minimal BIC(", which.min(x$BIC_hist), "th)") , 508 | col = "gray50" 509 | ) 510 | } 511 | 512 | } 513 | 514 | 515 | } 516 | 517 | if (plot_type == "JS") { 518 | data_1 <- 519 | data.frame( 520 | date = 1:length(x$raw_data), 521 | raw_data = x$raw_data, 522 | trend_data = x$trend 523 | ) 524 | require(magrittr) 525 | p1 <- plotly::plot_ly(data_1, x = ~ date, color = I(col_raw)) %>% 526 | plotly::add_lines(y = ~ raw_data, 527 | name = "raw data", 528 | legendgroup = "raw data") %>% 529 | plotly::add_lines( 530 | y = ~ trend_data, 531 | color = I(col_trend_f), 532 | name = "final trend", 533 | legendgroup = "final trend" 534 | ) %>% 535 | plotly::layout( 536 | showlegend = T, 537 | yaxis = list(title = ylab), 538 | title = main 539 | ) 540 | 541 | if (x$stopping == "nonstop-iter") { 542 | return(p1) 543 | 544 | } 545 | 546 | if (x$stopping == "adf") { 547 | data_2 <- 548 | data.frame(iter_time = 1:x$iter_num, 549 | p_value = x$adf_p_hist) 550 | p2 <- 551 | plotly::plot_ly( 552 | data_2, 553 | x = ~ iter_time, 554 | y = ~ p_value, 555 | color = I(col_pvalue_BIC), 556 | name = "p-value", 557 | legendgroup = "p-value" 558 | ) 559 | 560 | return(plotly::subplot( 561 | p1, 562 | p2, 563 | heights = c(0.7, 0.3), 564 | nrows = 2, 565 | margin = 0.05 566 | )) 567 | } 568 | 569 | if (x$stopping == "BIC") { 570 | data_2 <- 571 | data.frame(iter_time = 1:x$iter_num, 572 | BIC = x$BIC_hist[1:x$iter_num]) 573 | 574 | p2 <- 575 | plotly::plot_ly( 576 | data_2, 577 | x = ~ iter_time, 578 | y = ~ BIC, 579 | color = I(col_pvalue_BIC), 580 | name = "BIC", 581 | legendgroup = "BIC" 582 | ) %>% 583 | plotly::layout(showlegend = T, yaxis = list(title = "BIC")) 584 | 585 | return(plotly::subplot( 586 | p1, 587 | p2, 588 | heights = c(0.7, 0.3), 589 | nrows = 2, 590 | margin = 0.05 591 | )) 592 | } 593 | 594 | if (x$stopping == "nonstop") { 595 | data_2 <- 596 | data.frame(iter_time = 1:x$iter_num, 597 | BIC = x$BIC_hist[1:x$iter_num]) 598 | 599 | p2 <- 600 | plotly::plot_ly( 601 | data_2, 602 | x = ~ iter_time, 603 | y = ~ BIC, 604 | color = I(col_pvalue_BIC), 605 | name = "BIC", 606 | legendgroup = "BIC" 607 | ) %>% 608 | plotly::layout(showlegend = T, yaxis = list(title = "BIC")) 609 | 610 | return(plotly::subplot( 611 | p1, 612 | p2, 613 | heights = c(0.7, 0.3), 614 | nrows = 2, 615 | margin = 0.05 616 | )) 617 | } 618 | 619 | } 620 | 621 | if (plot_type == "dynamic") { 622 | if (x$stopping == "nonstop-iter") { 623 | stop("'nonstop-iter' bHP doesn't have dynamic picture: returning NA") 624 | return(NA_real_) 625 | 626 | } 627 | 628 | if (x$stopping != "nonstop-iter") { 629 | cat( 630 | "It may take more seconds if iteration number is large.", 631 | "\n", 632 | "Please be patient!", 633 | "\n" 634 | ) 635 | 636 | 637 | animation::saveGIF({ 638 | for (i in 1:x$iter_num) { 639 | layout( 640 | matrix(c(1, 1, 2, 2), 2, 2, byrow = TRUE), 641 | widths = lcm(5), 642 | heights = lcm(16) 643 | ) 644 | par(mar = c(3, 4, 5, 3), las = 1) 645 | 646 | col_rgb <- as.numeric(col2rgb(col_raw)) 647 | 648 | plot( 649 | x$raw_data, 650 | pch = 16, 651 | col = rgb( 652 | red = col_rgb[1], 653 | green = col_rgb[2], 654 | blue = col_rgb[3], 655 | alpha = raw_alpha, 656 | maxColorValue = 255 657 | ) 658 | , 659 | lwd = 1, 660 | ylab = ylab 661 | ) 662 | 663 | for (j in 1:i) { 664 | if (j == x$iter_num) { 665 | col_rgb <- as.numeric(col2rgb(col_trend_f)) 666 | col <- 667 | rgb( 668 | red = col_rgb[1], 669 | green = col_rgb[2], 670 | blue = col_rgb[3], 671 | alpha = trend_f_alpha, 672 | maxColorValue = 255 673 | ) 674 | lwd <- 1.6 675 | 676 | } else{ 677 | col_rgb <- as.numeric(col2rgb(col_trend_h)) 678 | col <- 679 | rgb( 680 | red = col_rgb[1], 681 | green = col_rgb[2], 682 | blue = col_rgb[3], 683 | alpha = trend_h_alpha, 684 | maxColorValue = 255 685 | ) 686 | lwd <- 2 687 | } 688 | 689 | lines( 690 | x$trend_hist[, j], 691 | type = "l", 692 | col = col, 693 | lwd = lwd 694 | ) 695 | 696 | x_l <- x$raw_data 697 | y_l <- NULL 698 | xy <- xy.coords(x_l, y_l, log = "") 699 | xy$xlab <- NULL 700 | 701 | #xlim_design <- range(xy$x[is.finite(xy$x)]) 702 | 703 | #ylim_design <- range(xy$y[is.finite(xy$y)]) 704 | 705 | localAxis <- 706 | function(..., col, bg, pch, cex, lty, lwd) 707 | Axis(...) 708 | xticks <- localAxis(xy$x, side = 1) 709 | yticks <- localAxis(xy$y, side = 2) 710 | # may try col = "gray90" 711 | abline( 712 | NULL, 713 | NULL, 714 | lty = 1, 715 | col = "gray80", 716 | lwd = .08, 717 | h = yticks 718 | ) 719 | abline( 720 | NULL, 721 | NULL, 722 | lty = 1, 723 | col = "gray80", 724 | lwd = .08, 725 | h = NULL, 726 | v = xticks 727 | ) 728 | 729 | # Title 730 | # mtext(main, side=3, line=1, cex=1.3, family="Consolas") 731 | mtext(main, 732 | side = 3, 733 | line = 1, 734 | cex = 1.3) 735 | 736 | 737 | } 738 | 739 | # location of text 740 | 741 | temp <- try(location(iteration_location), silent = T) 742 | if ('try-error' %in% class(temp)) { 743 | locate_text <- as.numeric(iteration_location) 744 | } else{ 745 | locate_text <- as.numeric(location(iteration_location)) 746 | } 747 | 748 | 749 | 750 | # location of legend 751 | 752 | temp <- try(location(legend_location), silent = T) 753 | if ('try-error' %in% class(temp)) { 754 | locate_legend <- as.numeric(legend_location) 755 | } else{ 756 | locate_legend <- as.numeric(location(legend_location)) 757 | } 758 | 759 | 760 | text( 761 | x = locate_text[1], 762 | y = locate_text[2], 763 | paste0("Iterated Times: ", as.character(c( 764 | 1:x$iter_num 765 | )[i])), 766 | cex = cex_text, 767 | col = "black", 768 | font = 2 769 | ) 770 | 771 | # Legend 772 | legend( 773 | x = locate_legend[1], 774 | y = locate_legend[2], 775 | c("Raw Data", "Trend History", "Final Trend"), 776 | col = c(col_raw, col_trend_h, col_trend_f), 777 | text.col = c(col_raw, col_trend_h, col_trend_f), 778 | lty = c(-1,-1,-1), 779 | pch = c(16, 15, 15), 780 | text.font = 3, 781 | cex = cex_legend, 782 | bg = "white", 783 | bty = "n" 784 | ) 785 | 786 | if (x$stopping == "adf") { 787 | par(mar = c(3, 4, 3, 3), las = 1) 788 | 789 | col_rgb <- as.numeric(col2rgb(col_pvalue_BIC)) 790 | col <- 791 | rgb( 792 | red = col_rgb[1], 793 | green = col_rgb[2], 794 | blue = col_rgb[3], 795 | alpha = pvalue_BIC_alpha, 796 | maxColorValue = 255 797 | ) 798 | 799 | plot( 800 | x$adf_p_hist[1:i], 801 | main = paste0("p-value = ", round(x$adf_p_hist[i], 4)), 802 | bty = "l", 803 | ylab = "", 804 | xlim = c(0, x$iter_num + 1), 805 | ylim = c(0, range(x$adf_p_hist)[2]), 806 | col = col, 807 | pch = 19 808 | ) 809 | abline(h = x$signif_p , col = "gray50") 810 | text(0.5, 811 | (x$signif_p + 0.03), 812 | paste0("sig_p = ", x$signif_p) , 813 | col = "gray50") 814 | } 815 | 816 | if (x$stopping == "BIC") { 817 | par(mar = c(3, 4, 3, 3), las = 1) 818 | 819 | col_rgb <- as.numeric(col2rgb(col_pvalue_BIC)) 820 | col <- 821 | rgb( 822 | red = col_rgb[1], 823 | green = col_rgb[2], 824 | blue = col_rgb[3], 825 | alpha = pvalue_BIC_alpha, 826 | maxColorValue = 255 827 | ) 828 | 829 | plot( 830 | x$BIC_hist[1:i], 831 | main = paste0("BIC value = ", round(x$BIC_hist[i], 4)), 832 | bty = "l", 833 | ylab = "", 834 | xlim = c(0, x$iter_num + 1), 835 | ylim = c(0, range(x$BIC_hist)[2]), 836 | col = col, 837 | pch = 19 838 | ) 839 | abline(h = as.numeric(x$BIC_hist[x$iter_num]), col = "gray50") 840 | text( 841 | as.numeric(x$iter_num), 842 | as.numeric(x$BIC_hist[x$iter_num] - 0.3), 843 | paste0("min BIC(", x$iter_num, "th)") , 844 | col = "gray50" 845 | ) 846 | } 847 | 848 | if (x$stopping == "nonstop") { 849 | par(mar = c(3, 4, 3, 3), las = 1) 850 | 851 | col_rgb <- as.numeric(col2rgb(col_pvalue_BIC)) 852 | col <- 853 | rgb( 854 | red = col_rgb[1], 855 | green = col_rgb[2], 856 | blue = col_rgb[3], 857 | alpha = pvalue_BIC_alpha, 858 | maxColorValue = 255 859 | ) 860 | 861 | plot( 862 | x$BIC_hist[1:i], 863 | main = paste0("BIC value = ", round(x$BIC_hist[i], 4)), 864 | bty = "l", 865 | ylab = "", 866 | xlim = c(0, x$iter_num + 1), 867 | ylim = c(0, range(x$BIC_hist)[2]), 868 | col = col, 869 | pch = 19 870 | ) 871 | abline(h = min(as.numeric(x$BIC_hist)), col = "gray50") 872 | abline(v = which.min(x$BIC_hist), col = "gray50") 873 | text( 874 | which.min(x$BIC_hist), 875 | as.numeric(min(x$BIC_hist)) - 0.3, 876 | paste0("minimal BIC(", which.min(x$BIC_hist), "th)") , 877 | col = "gray50" 878 | ) 879 | } 880 | 881 | } 882 | 883 | }, movie.name = "bHP_ani.gif" , interval = interval_t, nmax = as.numeric(x$iter_num), 884 | ani.width = 800, ani.height = 600) 885 | } 886 | 887 | 888 | } 889 | 890 | } 891 | -------------------------------------------------------------------------------- /R/print.bHP.R: -------------------------------------------------------------------------------- 1 | #'Print method for class 'bHP' 2 | #' 3 | #'table of the bHP, in text (ASCII text output), latex (LaTeX code) or html 4 | #'(HTML/CSS code). 5 | #' 6 | #'@param x an object of class 'bHP' 7 | #'@param type a character string that specifies what style of print. Default 8 | #' choose is "bHP" showing designed table of class 'bHP'; choose "generic 9 | #' default" if you want to show the result of generic function plot. 10 | #'@param trend_hist logical; if TRUE, adding trend component after each 11 | #' HP-filter conduction into the table and call 'select_trend_hist' to choose 12 | #' which iteration; if FALSE, don't add trend component history to the table. 13 | #'@param select_trend_hist a numeric vector choosing which iteration time to 14 | #' show in the trend component history. It is valid only when 'trend_hist' is 15 | #' TRUE. 16 | #'@param Head logical; if TRUE, showing the head of the table; if FALSE and 17 | #' 'Tail' is TRUE, showing the tail of the table; if FALSE and 'Tail' is FALSE, 18 | #' showing the full-length of the table. 19 | #'@param Tail logical; if TRUE, showing the tail of the table; if FALSE and 20 | #' 'Head' is TRUE, showing the head of the table; if FALSE and 'Head' is FALSE, 21 | #' showing the full-length of the table. 22 | #'@param print_type a character vector that specifies what type of output the 23 | #' command should produce. The possible values are "text" (default) for ASCII 24 | #' text output, "latex" for LaTeX code, "html" for HTML/CSS code. 25 | #'@param digit controls the number of significant digits to print when printing 26 | #' numeric values. It is a suggestion only. Valid values are 1...22 with 27 | #' default 8. See the note in 'print.default' about values greater than 15. 28 | #' 29 | #'@return Table showing the content of bHP, "text" (default) for ASCII text 30 | #' output, "latex" for LaTeX code, "html" for HTML/CSS code. 31 | #'@export 32 | #' 33 | #' @examples lam <- 100 # tuning parameter for the annual data 34 | #' 35 | #' data(IRE) # load the data 'IRE' 36 | #' 37 | #' # raw HP filter 38 | #' bx_HP <- BoostedHP(IRE, lambda = lam, iter= FALSE) 39 | #' 40 | #' # by BIC 41 | #' bx_BIC <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "BIC") 42 | #' 43 | #' # by ADF 44 | #' bx_ADF <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "adf") 45 | #' 46 | #' # by nonstop test type 47 | #' # Iterated HP filter until Max_Iter and keep the path of BIC. 48 | #' 49 | #' bx_nonstop <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "nonstop") 50 | #' \dontrun{ 51 | #'#--------- start to print the content of bHP ----------------- 52 | #' print(bx_ADF) 53 | #' 54 | #' print(bx_ADF, Head = F, Tail = T, trend_hist = F) 55 | #' 56 | #' print(bx_ADF, Head = T, Tail = T, trend_hist = F) 57 | #' 58 | #' print(bx_ADF, Head = F, Tail = F, trend_hist = F) 59 | #' 60 | #' print(bx_BIC, Head = F, Tail = F, trend_hist = T, select_trend_hist = 1:bx_BIC$iter_num) 61 | #' 62 | #' print(bx_BIC, Head = F, Tail = F, trend_hist = T, select_trend_hist = c(1,3,5)) 63 | #' 64 | #' # when the trend_hist is FALSE, select_trend_hist is invalid 65 | #' print(bx_BIC, Head = F, Tail = F, trend_hist = F, select_trend_hist = c(1,3,5)) 66 | #' 67 | #' print(bx_BIC, Head = F, Tail = T, trend_hist = F, print_type = "latex") 68 | #' 69 | #' print(bx_BIC, Head = F, Tail = T, trend_hist = F, print_type = "html") 70 | #' 71 | #' # show the generic print function output 72 | #' print(bx_ADF, type = "generic default") 73 | #' } 74 | 75 | print.bHP <- 76 | function(x, 77 | type = "bHP", 78 | trend_hist = TRUE, 79 | select_trend_hist = c(1), 80 | Head = FALSE, 81 | Tail = FALSE, 82 | print_type = "text", 83 | digit = 8) { 84 | options(digits = digit) 85 | 86 | if (type == "generic default") { 87 | message("This is a generic.default method print of 'bHP' class (", 88 | x$stopping, 89 | ").") 90 | print.default(x) 91 | } 92 | 93 | 94 | if (type == "bHP") { 95 | message("This is print method special for 'bHP' class (", 96 | x$stopping, 97 | ").") 98 | 99 | #----------------- manage data frame for "ADF or "BIC" bHP ----------------------- 100 | if (x$stopping == "adf" | x$stopping == "BIC") { 101 | colname <- 102 | c( 103 | "Raw Data", 104 | paste0("Final Trend (", x$iter_num, "th)"), 105 | paste0("Trend (", 1:x$iter_num, "th)") 106 | ) 107 | 108 | if (x$stopping == "adf") { 109 | value_hist <- 110 | c("P-value:", 111 | paste0(round(x$adf_p_hist[x$iter_num], 4), " (", x$iter_num, "th)"), 112 | paste0( 113 | round(x$adf_p_hist, 4), 114 | paste0(" (", 1:x$iter_num, "th)") 115 | )) 116 | } 117 | if (x$stopping == "BIC") { 118 | value_hist <- 119 | c("BIC value:", 120 | paste0(round(x$BIC_hist[x$iter_num], 4), " (", x$iter_num, "th)"), 121 | paste0( 122 | round(x$BIC_hist[1:x$iter_num], 4), 123 | paste0(" (", 1:x$iter_num, "th)") 124 | )) 125 | } 126 | 127 | raw_trend <- cbind.data.frame(x$raw_data, x$trend, x$trend_hist) 128 | data <- rbind(value_hist, raw_trend) 129 | colnames(data) <- colname 130 | 131 | 132 | #--------------------- trend selection ---------------------------------------------------- 133 | 134 | if (trend_hist == TRUE) { 135 | data_trend_select <- 136 | as.matrix(data)[, c(1, 2, select_trend_hist + 2)] %>% as.data.frame() 137 | } 138 | if (trend_hist == FALSE) { 139 | data_trend_select <- as.matrix(data)[, c(1, 2)] %>% as.data.frame() 140 | } 141 | # end trend selection of ADF or BIC 142 | 143 | } 144 | 145 | #----------------- manage data frame for "nonstop-iter" bHP ----------------------- 146 | if (x$stopping == "nonstop-iter") { 147 | colname <- c("Raw Data", "Trend Component") 148 | 149 | # nonstop BIC or P-value (Only Once HP-filter) 150 | value_hist <- c("Type:", "Once HP-filter") 151 | 152 | raw_trend <- cbind.data.frame(x$raw_data, x$trend) 153 | data <- rbind(value_hist, raw_trend) 154 | colnames(data) <- colname 155 | 156 | data_trend_select <- data 157 | 158 | } 159 | 160 | #----------------- manage data frame for "nonstop" bHP ----------------------- 161 | if (x$stopping == "nonstop") { 162 | colname <- 163 | c("Raw Data", 164 | paste0("Final Trend (", dim(x$trend_hist)[2], "th)"), 165 | paste0(1:dim(x$trend_hist)[2], "th Trend")) 166 | 167 | value_hist <- 168 | c("BIC:", 169 | paste0(round(x$BIC_hist[dim(x$trend_hist)[2]], 4), " (", dim(x$trend_hist)[2], "th)"), 170 | paste0(round(x$BIC_hist[1:(dim(x$trend_hist)[2])], 4), paste0(" (", 1:( 171 | dim(x$trend_hist)[2] 172 | ), "th)"))) 173 | 174 | raw_trend <- cbind.data.frame(x$raw_data, x$trend, x$trend_hist) 175 | data <- rbind(value_hist, raw_trend) 176 | colnames(data) <- colname 177 | 178 | #--------------------- trend selection ---------------------------------------------------- 179 | if (trend_hist == TRUE) { 180 | data_trend_select <- 181 | as.matrix(data)[, c(1, 2, select_trend_hist + 2)] %>% as.data.frame() 182 | } 183 | if (trend_hist == FALSE) { 184 | data_trend_select <- as.matrix(data)[, c(1, 2)] %>% as.data.frame() 185 | } 186 | # end trend selection 187 | 188 | 189 | } 190 | 191 | # manage the Time Serise ID 192 | 193 | row.names(data) <- c(" ", 1:length(x$raw_data)) 194 | row.names(data_trend_select) <- c(" ", 1:length(x$raw_data)) 195 | 196 | #---------------------------------------------------------------------------------------- 197 | #--------------------- row selection ---------------------------------------------------- 198 | 199 | if (Head == FALSE & Tail == FALSE) { 200 | row <- 1:(dim(data)[1]) 201 | } 202 | 203 | if (Head == TRUE & Tail == FALSE) { 204 | if (dim(data)[1] > 6) { 205 | row <- 1:6 206 | } else{ 207 | row <- 1:(dim(data)[1]) 208 | } 209 | } 210 | 211 | if (Head == FALSE & Tail == TRUE) { 212 | if (dim(data)[1] > 6) { 213 | row <- c(1, ((dim(data)[1] - 4):dim(data)[1])) 214 | } else{ 215 | row <- 1:(dim(data)[1]) 216 | } 217 | } 218 | 219 | if (Head == TRUE & Tail == TRUE) { 220 | if (dim(data)[1] > 11) { 221 | row <- c(1:6, ((dim(data)[1] - 4):dim(data)[1])) 222 | } else{ 223 | row <- 1:(dim(data)[1]) 224 | } 225 | } 226 | 227 | data_row_trend_select <- data_trend_select[row, ] 228 | 229 | 230 | stargazer::stargazer(data_row_trend_select, 231 | summary = F, 232 | type = print_type) 233 | 234 | View(data) 235 | message("The content of bHP can be viewd via the spreadsheet-style data viewer.") 236 | 237 | } 238 | } 239 | -------------------------------------------------------------------------------- /R/summary.bHP.R: -------------------------------------------------------------------------------- 1 | #' Summary method for class \code{bHP} 2 | #' 3 | #' tables that summarize a \code{bHP} object. 4 | #' 5 | #' @param x an object of class \code{bHP} 6 | #' @param digit controls the number of significant digits to print when printing 7 | #' numeric values. It is a suggestion only. Valid values are 1...22 with 8 | #' default 8. See the note in 'print.default' about values greater than 15. 9 | #' 10 | #' 11 | #' @return summary of raw data, trend component, the number of iterations, p-value, etc. 12 | #' @export 13 | #' 14 | #' @examples lam <- 100 # tuning parameter for the annual data 15 | #' 16 | #' data(IRE) # load the data 'IRE' 17 | #' 18 | #' # raw HP filter 19 | #' bx_HP <- BoostedHP(IRE, lambda = lam, iter= FALSE) 20 | #' 21 | #' # by BIC 22 | #' bx_BIC <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "BIC") 23 | #' 24 | #' # by ADF 25 | #' bx_ADF <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "adf") 26 | #' 27 | #' # by nonstop test type 28 | #' # Iterated HP filter until Max_Iter and keep the path of BIC. 29 | #' 30 | #' bx_nonstop <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "nonstop") 31 | #' 32 | #' #--------- start to summary the content of bHP ----------------- 33 | #' 34 | #' summary(bx_ADF) 35 | #' summary(bx_BIC) 36 | #' summary(bx_nonstop) 37 | #' summary(bx_HP) 38 | #' 39 | 40 | summary.bHP <- function(x, digit = 8){ 41 | 42 | options(digits=digit) 43 | 44 | message("This is a summary table of 'bHP' class (",x$stopping,").") 45 | 46 | cat(" 47 | ============================================================================================================== 48 | ", 49 | paste0("Summary Table of '",x$stopping,"' bHP"), 50 | " 51 | ============================================================================================================== 52 | ", 53 | 54 | "Length of the Data:",length(x$raw_data), 55 | if(length(x$iter_num)>0){paste0("; Iterated Number: ", x$iter_num)}, 56 | if(x$stopping == "nonstop"){paste0("; Iterated Number: ", (length(x$BIC_hist)-1))}, 57 | if(x$stopping == "nonstop-iter"){"; Only Conduct HP-Filter once"}, 58 | "; Stopping Criterion: ", x$stopping,"\n", if(x$stopping == "adf"){paste0("P-value (last iteration): ", 59 | round(x$adf_p_hist[x$iter_num],4))}, if(x$stopping == "BIC"){paste0("BIC value (last iteration): ", 60 | round(x$BIC_hist[x$iter_num],4))},"\n", 61 | "------------------------------------------------------------------------------------------------------------","\n", 62 | "\n", 63 | "Raw Data","\n", 64 | "---------","\n", 65 | #"Min. ", "1st Qu.", "Median", "Mean ", "3rd Qu.", "Max. ", "\n", 66 | summary(matrix(x$raw_data)),"\n", 67 | 68 | 69 | "\n", 70 | "Final Trend Component","\n", 71 | "----------------------","\n", 72 | #"Min. ", "1st Qu.", "Median", "Mean ", "3rd Qu.", "Max. ", "\n", 73 | summary(matrix(x$trend)),"\n", 74 | 75 | 76 | #----------- start with the path of p-value or BIC ----------------- 77 | if(x$stopping == "adf" | x$stopping == "BIC"){"\n"}, 78 | if(x$stopping == "adf" | x$stopping == "BIC"){ 79 | "------------------------------------------------------------------------------------------------------------" 80 | }, 81 | 82 | if(x$stopping == "adf" | x$stopping == "BIC"){"\n"}, 83 | 84 | # the path of ADF 85 | if(x$stopping == "adf"){ 86 | "Path of P-value (head):"}, 87 | if(x$stopping == "adf"){ 88 | head(round(x$adf_p_hist,4))}, 89 | 90 | # the path of BIC 91 | if(x$stopping == "BIC"){ 92 | "Path of BIC (head):"}, 93 | if(x$stopping == "BIC"){ 94 | head(round(x$BIC_hist[1:(x$iter_num)],4))}, 95 | 96 | if(x$stopping == "adf" | x$stopping == "BIC"){"\n"}, 97 | 98 | 99 | # the path of ADF 100 | if(x$stopping == "adf"){ 101 | "Path of P-value (tail):"}, 102 | if(x$stopping == "adf"){ 103 | tail(round(x$adf_p_hist,4))}, 104 | 105 | if(x$stopping == "BIC"){ 106 | "Path of BIC (tail):"}, 107 | if(x$stopping == "BIC"){ 108 | tail(round(x$BIC_hist[1:(x$iter_num)],4))}, 109 | " 110 | ============================================================================================================== 111 | ") 112 | 113 | } 114 | 115 | 116 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Boosted HP Filter 2 | 3 | This repo will not be updated anymore. 4 | 5 | The latest version is maintained at https://github.com/zhentaoshi/bHP_R_pkg. 6 | -------------------------------------------------------------------------------- /data/IRE.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/chenyang45/BoostedHP/33650d816eea69271456929d3c1d87e27869aed2/data/IRE.rda -------------------------------------------------------------------------------- /data/def_par.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/chenyang45/BoostedHP/33650d816eea69271456929d3c1d87e27869aed2/data/def_par.RData -------------------------------------------------------------------------------- /man/BIC.bHP.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/methods.R 3 | \name{BIC.bHP} 4 | \alias{BIC.bHP} 5 | \title{BIC.bHP} 6 | \usage{ 7 | \method{BIC}{bHP}(x) 8 | } 9 | \arguments{ 10 | \item{x}{an object of class \code{bHP}} 11 | } 12 | \value{ 13 | a vector recording BIC after each iteration of bHP. 14 | } 15 | \description{ 16 | Extract the path of BIC value of each iterated BIC HP-filter conduction for 17 | class \code{bHP}. As \code{nonstop} type of bHP also keeps BIC for each iteration time till 18 | the \code{Max_iter}, BIC.bHP method returns BIC value for it as well. 19 | } 20 | \examples{ 21 | lam <- 100 # tuning parameter for the annual data 22 | 23 | data(IRE) # load the data 'IRE' 24 | 25 | # by BIC 26 | 27 | bx_BIC <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "BIC") 28 | 29 | BIC(bx_BIC) 30 | 31 | 32 | bx_none <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "nonstop") 33 | 34 | BIC(bx_none) 35 | 36 | 37 | 38 | ### If the test type is not "adf", Pvalue.bHP will return error 39 | 40 | # raw HP filter 41 | 42 | bx_HP <- BoostedHP(IRE, lambda = lam, iter= FALSE) 43 | 44 | BIC(bx_HP) 45 | 46 | # Error in BIC.bHP(bx_HP) : 47 | # The stationary test type is none-iter, not BIC or none. 48 | 49 | 50 | # by ADF 51 | bx_ADF <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "adf") 52 | 53 | BIC(bx_ADF) 54 | 55 | #Error in BIC.bHP(bx_ADF) : 56 | #The stationary test type is adf, not BIC or none. 57 | 58 | } 59 | -------------------------------------------------------------------------------- /man/BoostedHP.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/BoostedHP.R 3 | \name{BoostedHP} 4 | \alias{BoostedHP} 5 | \title{Boosting the Hodrick-Prescott Filter} 6 | \usage{ 7 | BoostedHP( 8 | x, 9 | lambda = 1600, 10 | iter = TRUE, 11 | stopping = "BIC", 12 | sig_p = 0.05, 13 | Max_Iter = 100 14 | ) 15 | } 16 | \arguments{ 17 | \item{x}{is a raw time series to be filtered.} 18 | 19 | \item{lambda}{the turning parameter, default value is 1600, 20 | as recommended by Hodrick and Prescott (1997) for quarterly data.} 21 | 22 | \item{iter}{logical, \code{TRUE} (default) to conduct the boosted HP filter. 23 | FALSE does not iterated, which is exactly the original HP filter.} 24 | 25 | \item{stopping}{stopping criterion. \code{"BIC"} (default), or \code{"adf"}, or \code{"nonstop"} means keeping 26 | iteration until the maximum number of iteration, specified by \code{Max_Iter} is reached.} 27 | 28 | \item{sig_p}{a threshold of the p-value for the ADF test, with default value 0.050. 29 | Only effective when \code{stopping = "adf"}.} 30 | 31 | \item{Max_Iter}{maximal number of iterations. The default is 100.} 32 | } 33 | \value{ 34 | The function returns a list containing the following items: 35 | \item{cycle}{The cyclical component in the final iteration.} 36 | \item{trend}{The trend component in the final iteration.} 37 | \item{trend_hist}{The estimated trend in each iteration.} 38 | \item{iter_num}{The total number of iterations when it stops.} 39 | \item{IC_hist}{The path of the BIC up to the final iterations.} 40 | \item{adf_p_hist}{The path of the ADF test p-value up to the final iteration.} 41 | } 42 | \description{ 43 | All in one function of conducting the boosted HP-filter. 44 | } 45 | \details{ 46 | This is the main function of implementing the boosted HP filter (Phillisp and 47 | Shi, 2021). The arguments accommendate the orginal HP filter (\code{iter = 48 | FALSE}), the boosted HP filter with the BIC stopping criterion (\code{stopping = 49 | "BIC"}), 50 | or ADF test stopping criterion 51 | (\code{stopping = "adf"}), or keep going until the maximum number of iterations is reached 52 | (\code{stopping = "nonstop"}). 53 | 54 | Either the original HP filter or the bHP filter requires \code{lambda} to 55 | control the strength of the weak learner for in-sample fitting. The default 56 | is \code{lambda = 1600}, which is recommended by Hodrick and Prescott (1997) 57 | for quarterly data. \code{lambda} should be adjusted for different 58 | frequencies. For example, \code{lambda = 129600} for monthly data and 59 | \code{lambda = 6.25} for annual data. 60 | 61 | See the vignette with a brief introduction of the idea of bHP. 62 | } 63 | \examples{ 64 | 65 | data(IRE) # load the data 'IRE' 66 | lam <- 100 # tuning parameter for the annual data 67 | 68 | # raw HP filter 69 | bx_HP <- BoostedHP(IRE, lambda = lam, iter= FALSE) 70 | 71 | # by BIC 72 | bx_BIC <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "BIC") 73 | 74 | # by ADF 75 | bx_ADF <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "adf") 76 | 77 | # If stopping = "nonstop", 78 | # Iterated HP filter until Max_Iter and keep the path of BIC. 79 | 80 | bx_nonstop <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "nonstop") 81 | } 82 | \references{ 83 | Peter Phillips and Zhentao Shi, 2021: "Boosting: Why You Can Use the HP Filter," International Economic Review, 62(2), 521-570 84 | } 85 | -------------------------------------------------------------------------------- /man/IRE.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bHP.R 3 | \docType{data} 4 | \name{IRE} 5 | \alias{IRE} 6 | \title{Ireland Annual GDP} 7 | \format{ 8 | \itemize{ 9 | \item\strong{Release:} {Gross Domestic Product} 10 | \item\strong{Frequency:} {Annual} 11 | \item\strong{Date Range:} {1981--2016} 12 | } 13 | } 14 | \source{ 15 | OECD Stat \url{https://stats.oecd.org/} 16 | } 17 | \usage{ 18 | data(IRE) 19 | } 20 | \description{ 21 | Ireland Annual GDP 22 | } 23 | \section{Description}{ 24 | 25 | This dataset is described in Section 4.1 of Philips and Shi (2019). 26 | Also See Okun, Ball, Leigh, and Loungani (2017). 27 | } 28 | 29 | \references{ 30 | Peter Phillips and Zhentao Shi, 2021: "Boosting: Why You Can Use the HP Filter," International Economic Review, 62(2), 521-570 31 | 32 | Ball, Laurence, Daniel Leigh, and Prakash Loungani. 33 | "Okun's law: Fit at 50?." 34 | Journal of Money, Credit and Banking 49, no. 7 (2017): 1413-1441. 35 | } 36 | \keyword{datasets} 37 | -------------------------------------------------------------------------------- /man/bHP.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bHP.R 3 | \docType{package} 4 | \name{bHP} 5 | \alias{bHP} 6 | \title{bHP: Package for the boosted HP filter} 7 | \description{ 8 | The boosted HP filter by Phillips and Shi (2019) 9 | } 10 | \details{ 11 | \code{BoostedHP} is the main function. It generates a \code{bHP} object which can work with 12 | generic methods. 13 | } 14 | \references{ 15 | Peter Phillips and Zhentao Shi, 2021: "Boosting: Why You Can Use the HP Filter," International Economic Review, 62(2), 521-570 16 | } 17 | -------------------------------------------------------------------------------- /man/plot.bHP.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot.bHP.R 3 | \name{plot.bHP} 4 | \alias{plot.bHP} 5 | \title{Plot method for class \code{bHP}} 6 | \usage{ 7 | \method{plot}{bHP}( 8 | x, 9 | plot_type = "dynamic", 10 | interval_t = 0.3, 11 | ylab = "", 12 | col_raw = "#2D5375", 13 | col_trend_h = "#FBB545", 14 | col_trend_f = "red", 15 | col_pvalue_BIC = "red", 16 | raw_alpha = 255, 17 | trend_h_alpha = 75, 18 | trend_f_alpha = 255, 19 | pvalue_BIC_alpha = 255, 20 | legend_location = "upleft", 21 | iteration_location = "downright", 22 | cex_text = 1.7, 23 | cex_legend = 1.5, 24 | main = paste0("Figure of ", x$stopping, " bHP (", plot_type, ")") 25 | ) 26 | } 27 | \arguments{ 28 | \item{x}{an object of class \code{bHP}} 29 | 30 | \item{plot_type}{a character string specifies the style of plot.'static' for 31 | static figure, 'JS' for plotly.js, a web-based interactive charting 32 | library, 'dynamic' for dynamic figure showing history of iterated process.} 33 | 34 | \item{interval_t}{a positive number to set the time interval of the animation 35 | (unit in seconds); default to be 0.3.} 36 | 37 | \item{ylab}{a title for the y axis: see 'title' in package 'graphics'.} 38 | 39 | \item{col_raw}{A specification for the default plotting color of raw data. 40 | See section ‘Color Specification’.} 41 | 42 | \item{col_trend_h}{A specification for the default plotting color of trend 43 | history. See section ‘Color Specification’.} 44 | 45 | \item{col_trend_f}{A specification for the default plotting color of final 46 | trend component. See section ‘Color Specification’.} 47 | 48 | \item{col_pvalue_BIC}{A specification for the default plotting color of 49 | p-value of BIC. See section ‘Color Specification’.} 50 | 51 | \item{raw_alpha}{a numeric vector from 0 to 255 modifying color transparency 52 | of plotting raw data. The smaller the number, the more transparent.} 53 | 54 | \item{trend_h_alpha}{a numeric vector from 0 to 255 modifying color 55 | transparency of plotting trend history. The smaller the number, the more 56 | transparent.} 57 | 58 | \item{trend_f_alpha}{a numeric vector from 0 to 255 modifying color 59 | transparency of plotting final trend component. The smaller the number, the 60 | more transparent.} 61 | 62 | \item{pvalue_BIC_alpha}{a numeric vector from 0 to 255 modifying color 63 | transparency of plotting p-value or BIC. The smaller the number, the more 64 | transparent.} 65 | 66 | \item{legend_location}{a character string or a pair of numeric vector 67 | specifying the location of legend. The choice set of the character sting 68 | are: upleft, downleft, upright, downright.} 69 | 70 | \item{iteration_location}{a character string or a pair of numeric vector 71 | specifying the location of 'iteration time'. The choice set of the character 72 | sting are: upleft, downleft, upright, downright.} 73 | 74 | \item{cex_text}{The magnification to be used for showing 'iteration time' 75 | relative to the current setting of cex.} 76 | 77 | \item{cex_legend}{The magnification to be used for legend relative to the 78 | current setting of cex.} 79 | 80 | \item{main}{an overall title for the plot: see 'title' in package 'graphics'.} 81 | } 82 | \value{ 83 | X-Y Plotting method for class 'bHP' 84 | } 85 | \description{ 86 | plot method for a \code{bHP} object 87 | } 88 | \examples{ 89 | 90 | lam <- 100 # tuning parameter for the annual data 91 | 92 | \dontrun{ 93 | data(IRE) # load the data 'IRE' 94 | 95 | # raw HP filter 96 | bx_HP <- BoostedHP(IRE, lambda = lam, iter= FALSE) 97 | 98 | # by BIC 99 | bx_BIC <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "BIC") 100 | 101 | # by ADF 102 | bx_ADF <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "adf") 103 | 104 | # by nonstop test type 105 | # Iterated HP filter until Max_Iter and keep the path of BIC. 106 | 107 | bx_nonstop <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "nonstop") 108 | 109 | #--------- start to plot the content of bHP ----------------- 110 | 111 | 112 | #--------- for dynamic style (default)-------- 113 | plot(bx_ADF) 114 | 115 | plot(bx_ADF, iteration_location = "upright") # change the location of text 116 | 117 | plot(bx_ADF, iteration_location = c(30,12)) # assign the location of text by x-y co-ordinates 118 | 119 | plot(bx_BIC, interval_t = 0.8 ) # change the time interval of animation 120 | 121 | plot(bx_nonstop, cex_legend = 2, cex_text = 3) # change the magnification of legend and text 122 | 123 | # change the color 124 | plot(bx_ADF,main = "dynamic graph with new color",col_raw = "#685F74", col_trend_h = "#39A1A8", col_trend_f = "#DD4B4F", col_pvalue_BIC = "#E96145") 125 | 126 | # change the transparency 127 | plot(bx_ADF,main = "dynamic graph with new transparency setting",raw_alpha = 200, trend_h_alpha = 55, trend_f_alpha = 250, pvalue_BIC_alpha = 250) 128 | 129 | # Note: 'nonstop' bHP doesn't have dynamic figure 130 | plot(bx_HP) 131 | # Error in plot.bHP(bx_HP) : 132 | #'nonstop-iter' bHP doesn't have dynamic picture: returning NA 133 | 134 | #--------- for JS style ---------- 135 | 136 | plot(bx_ADF,plot_type = "JS") 137 | 138 | # change the color 139 | plot(bx_ADF,plot_type = "JS",main = "Js graph with new color", col_raw = "#685F74", col_trend_f = "#DD4B4F", col_pvalue_BIC = "#39A1A8") 140 | 141 | plot(bx_BIC,plot_type = "JS") 142 | 143 | plot(bx_nonstop,plot_type = "JS") 144 | 145 | plot(bx_HP,plot_type = "JS") 146 | 147 | #--------- for static style ---------- 148 | 149 | plot(bx_ADF,plot_type = "static",cex_legend = 0.7, cex_text = 0.8 ) 150 | 151 | plot(bx_HP,plot_type = "static") 152 | 153 | plot(bx_BIC,plot_type = "static",cex_legend = 0.7, cex_text = 0.8 ) 154 | 155 | plot(bx_nonstop,plot_type = "static",cex_legend = 0.8, cex_text = 0.8 ) 156 | } 157 | 158 | } 159 | -------------------------------------------------------------------------------- /man/predict.bHP.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/methods.R 3 | \name{predict.bHP} 4 | \alias{predict.bHP} 5 | \title{Predict.bHP} 6 | \usage{ 7 | \method{predict}{bHP}(x) 8 | } 9 | \arguments{ 10 | \item{x}{an object of class \code{bHP}} 11 | } 12 | \value{ 13 | the estimated trend component 14 | } 15 | \description{ 16 | Extract the final trend component for class \code{bHP}. 17 | } 18 | \examples{ 19 | lam <- 100 # tuning parameter for the annual data 20 | 21 | data(IRE) # load the data 'IRE' 22 | 23 | # raw HP filter 24 | bx_HP <- BoostedHP(IRE, lambda = lam, iter = FALSE) 25 | 26 | # by ADF 27 | bx_ADF <- BoostedHP(IRE, lambda = lam, iter = TRUE, stopping = "adf", sig_p = 0.050) 28 | 29 | # return the final trend component 30 | 31 | predict(bx_HP) 32 | 33 | predict(bx_ADF) 34 | } 35 | -------------------------------------------------------------------------------- /man/print.bHP.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print.bHP.R 3 | \name{print.bHP} 4 | \alias{print.bHP} 5 | \title{Print method for class 'bHP'} 6 | \usage{ 7 | \method{print}{bHP}( 8 | x, 9 | type = "bHP", 10 | trend_hist = TRUE, 11 | select_trend_hist = c(1), 12 | Head = FALSE, 13 | Tail = FALSE, 14 | print_type = "text", 15 | digit = 8 16 | ) 17 | } 18 | \arguments{ 19 | \item{x}{an object of class 'bHP'} 20 | 21 | \item{type}{a character string that specifies what style of print. Default 22 | choose is "bHP" showing designed table of class 'bHP'; choose "generic 23 | default" if you want to show the result of generic function plot.} 24 | 25 | \item{trend_hist}{logical; if TRUE, adding trend component after each 26 | HP-filter conduction into the table and call 'select_trend_hist' to choose 27 | which iteration; if FALSE, don't add trend component history to the table.} 28 | 29 | \item{select_trend_hist}{a numeric vector choosing which iteration time to 30 | show in the trend component history. It is valid only when 'trend_hist' is 31 | TRUE.} 32 | 33 | \item{Head}{logical; if TRUE, showing the head of the table; if FALSE and 34 | 'Tail' is TRUE, showing the tail of the table; if FALSE and 'Tail' is FALSE, 35 | showing the full-length of the table.} 36 | 37 | \item{Tail}{logical; if TRUE, showing the tail of the table; if FALSE and 38 | 'Head' is TRUE, showing the head of the table; if FALSE and 'Head' is FALSE, 39 | showing the full-length of the table.} 40 | 41 | \item{print_type}{a character vector that specifies what type of output the 42 | command should produce. The possible values are "text" (default) for ASCII 43 | text output, "latex" for LaTeX code, "html" for HTML/CSS code.} 44 | 45 | \item{digit}{controls the number of significant digits to print when printing 46 | numeric values. It is a suggestion only. Valid values are 1...22 with 47 | default 8. See the note in 'print.default' about values greater than 15.} 48 | } 49 | \value{ 50 | Table showing the content of bHP, "text" (default) for ASCII text 51 | output, "latex" for LaTeX code, "html" for HTML/CSS code. 52 | } 53 | \description{ 54 | table of the bHP, in text (ASCII text output), latex (LaTeX code) or html 55 | (HTML/CSS code). 56 | } 57 | \examples{ 58 | lam <- 100 # tuning parameter for the annual data 59 | 60 | data(IRE) # load the data 'IRE' 61 | 62 | # raw HP filter 63 | bx_HP <- BoostedHP(IRE, lambda = lam, iter= FALSE) 64 | 65 | # by BIC 66 | bx_BIC <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "BIC") 67 | 68 | # by ADF 69 | bx_ADF <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "adf") 70 | 71 | # by nonstop test type 72 | # Iterated HP filter until Max_Iter and keep the path of BIC. 73 | 74 | bx_nonstop <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "nonstop") 75 | \dontrun{ 76 | #--------- start to print the content of bHP ----------------- 77 | print(bx_ADF) 78 | 79 | print(bx_ADF, Head = F, Tail = T, trend_hist = F) 80 | 81 | print(bx_ADF, Head = T, Tail = T, trend_hist = F) 82 | 83 | print(bx_ADF, Head = F, Tail = F, trend_hist = F) 84 | 85 | print(bx_BIC, Head = F, Tail = F, trend_hist = T, select_trend_hist = 1:bx_BIC$iter_num) 86 | 87 | print(bx_BIC, Head = F, Tail = F, trend_hist = T, select_trend_hist = c(1,3,5)) 88 | 89 | # when the trend_hist is FALSE, select_trend_hist is invalid 90 | print(bx_BIC, Head = F, Tail = F, trend_hist = F, select_trend_hist = c(1,3,5)) 91 | 92 | print(bx_BIC, Head = F, Tail = T, trend_hist = F, print_type = "latex") 93 | 94 | print(bx_BIC, Head = F, Tail = T, trend_hist = F, print_type = "html") 95 | 96 | # show the generic print function output 97 | print(bx_ADF, type = "generic default") 98 | } 99 | } 100 | -------------------------------------------------------------------------------- /man/residuals.bHP.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/methods.R 3 | \name{residuals.bHP} 4 | \alias{residuals.bHP} 5 | \title{Residuals.bHP} 6 | \usage{ 7 | \method{residuals}{bHP}(x) 8 | } 9 | \arguments{ 10 | \item{x}{an object of class \code{bHP}} 11 | } 12 | \value{ 13 | the estimated cycle component 14 | } 15 | \description{ 16 | Extract the final cycle component for class \code{bHP}. 17 | } 18 | \examples{ 19 | lam <- 100 # tuning parameter for the annual data 20 | 21 | data(IRE) # load the data 'IRE' 22 | 23 | # raw HP filter 24 | bx_HP <- BoostedHP(IRE, lambda = lam, iter = FALSE) 25 | 26 | # by ADF 27 | bx_ADF <- BoostedHP(IRE, lambda = lam, iter = TRUE, stopping = "adf", sig_p = 0.050) 28 | 29 | # return the final trend component 30 | 31 | residuals(bx_HP) 32 | 33 | residuals(bx_ADF) 34 | } 35 | -------------------------------------------------------------------------------- /man/summary.bHP.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/summary.bHP.R 3 | \name{summary.bHP} 4 | \alias{summary.bHP} 5 | \title{Summary method for class \code{bHP}} 6 | \usage{ 7 | \method{summary}{bHP}(x, digit = 8) 8 | } 9 | \arguments{ 10 | \item{x}{an object of class \code{bHP}} 11 | 12 | \item{digit}{controls the number of significant digits to print when printing 13 | numeric values. It is a suggestion only. Valid values are 1...22 with 14 | default 8. See the note in 'print.default' about values greater than 15.} 15 | } 16 | \value{ 17 | summary of raw data, trend component, the number of iterations, p-value, etc. 18 | } 19 | \description{ 20 | tables that summarize a \code{bHP} object. 21 | } 22 | \examples{ 23 | lam <- 100 # tuning parameter for the annual data 24 | 25 | data(IRE) # load the data 'IRE' 26 | 27 | # raw HP filter 28 | bx_HP <- BoostedHP(IRE, lambda = lam, iter= FALSE) 29 | 30 | # by BIC 31 | bx_BIC <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "BIC") 32 | 33 | # by ADF 34 | bx_ADF <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "adf") 35 | 36 | # by nonstop test type 37 | # Iterated HP filter until Max_Iter and keep the path of BIC. 38 | 39 | bx_nonstop <- BoostedHP(IRE, lambda = lam, iter= TRUE, stopping = "nonstop") 40 | 41 | #--------- start to summary the content of bHP ----------------- 42 | 43 | summary(bx_ADF) 44 | summary(bx_BIC) 45 | summary(bx_nonstop) 46 | summary(bx_HP) 47 | 48 | } 49 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | *.log 4 | *.tex 5 | -------------------------------------------------------------------------------- /vignettes/bHP_illustration.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/chenyang45/BoostedHP/33650d816eea69271456929d3c1d87e27869aed2/vignettes/bHP_illustration.jpg -------------------------------------------------------------------------------- /vignettes/vignette.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Boosted HP Filter" 3 | author: "Yang Chen and Zhentao Shi" 4 | date: \today 5 | output: 6 | rmarkdown::pdf_document: default 7 | '# rmarkdown::html_vignette': default 8 | description: nothing 9 | geometry: margin=1in 10 | bibliography: REFERENCES.bib 11 | biblio-style: apalike 12 | link-citations: yes 13 | fontsize: 12pt 14 | urlcolor: blue 15 | vignette: | 16 | %\VignetteIndexEntry{my-vignette} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} 17 | header-includes: 18 | - \usepackage{graphics} 19 | - \usepackage{pgfplots} 20 | - \usepackage{caption} 21 | - \usepackage{setspace} 22 | - \singlespacing 23 | --- 24 | 25 | ```{r, include = FALSE} 26 | knitr::opts_chunk$set( 27 | collapse = TRUE, 28 | comment = "#>" 29 | ) 30 | ``` 31 | 32 | 33 | \begin{figure}[h] 34 | \centering 35 | \includegraphics[width = 12cm]{bHP_illustration} 36 | \caption*{Illustration of bHP, by Iris Shi} 37 | \end{figure} 38 | 39 | 40 | ```{r setup} 41 | library(bHP) 42 | library(magrittr) 43 | ``` 44 | 45 | ## Introduction 46 | 47 | This vignette introduces the HP filter, the boosted HP filter, and the usage of the R package 48 | `bHP`. 49 | The Hodrick-Prescott filter (HP filter; @hodrick1997postwar) is one of the fundamental statistical 50 | tools in macroeconomic data analysis. 51 | Thanks to its simplicity, it has been widely used in empirical 52 | macroeconomics studies. As an operational algorithm, its pros and cons have been debated over 53 | decades, and academic interest has been renewed in recent years to investigate its properties and extensions. 54 | While @hamilton2017you argues against the usage of the HP filter, @Phillips2019boosting propose a 55 | machine learning enhancement of the original HP filter, called the boosted HP filter (bHP), 56 | and establish consistency when it is applied to a large class of trended time series in macroeconomic 57 | applications. 58 | 59 | 60 | ## HP filter 61 | 62 | Given a time series $(x_{t})_{t=1}^n$ 63 | the HP method decomposes it into 64 | two additive components: a trend component $f_{t}$ 65 | and a cyclical component (residual) $c_{t}$. The trend is estimated as 66 | \[ 67 | (\hat{f}_{t}^\mathrm{HP} ) 68 | =\arg\min_{ (f_{t} )} \left\{ \sum_{t=1}^{n} (x_{t}-f_{t} )^{2} 69 | +\lambda\sum_{t=2}^{n} (\Delta^ 2 f_{t} )^{2} \right\}, 70 | \] 71 | where $\Delta f_{t}=f_{t}-f_{t-1}$, 72 | and $\Delta^2 f_{t}= \Delta f_{t}- \Delta f_{t-1} = f_{t}- 2 f_{t-1} + f_{t-2}$, 73 | and $\lambda\geq 0$ 74 | is a tuning parameter that controls the level of the penalty. 75 | The corresponding cycle is 76 | \[ 77 | (\hat{c}_{t}^\mathrm{HP} )=( x_t-\hat{f}_{t}^\mathrm{HP}). 78 | \] 79 | 80 | The optimization problem admits a closed form solution. 81 | The estimated trend can be written as 82 | \begin{equation*} 83 | \widehat{f}^{\mathrm{HP}}=S x, 84 | \end{equation*} 85 | where $S$ is a deterministic $n\times n$ matrix and $x=(x_1,...,x_n)'$ is the sample data. 86 | The estimated 87 | trend is 88 | \[ 89 | \widehat{c}^{\mathrm{HP}}=\left(I_{n}-S\right)x, 90 | \] 91 | where $I_{n}$ is the $n\times n$ identity matrix. The explicit form of $S$ can be found in @Phillips2019boosting. 92 | 93 | The choice of the tuning parameter is crucial for the behavior of the HP filter. 94 | In practice, @hodrick1997postwar recommend $\lambda=1600$ for quarterly data, and this number and its sampling frequency adjusted version [@ravn2002adjusting] are widely adopted. However, recent research 95 | [@phillips2015business] [@hamilton2017you] find the "gold standard" is too rigid for the length of time series that often used in macroeconomic studies. 96 | 97 | 98 | ## Boosted HP filter 99 | 100 | The intuition of bHP is that, if the cyclical component $\widehat{c}_{t}^{\mathrm{HP}}$ still exhibits trending behavior after HP filtering, we continue to apply the HP filter to 101 | $\widehat{c}^{\mathrm{HP}}$ to remove the leftover trend residual. After a second fitting, the cyclical component can be written as 102 | \[ 103 | \widehat{c}^{\left(2\right)}=\left(I_{n}-S\right)\widehat{c}^{\mathrm{HP}}=\left(I_{n}-S\right)^{2}x, 104 | \] 105 | where the superscript ``$\left(2\right)$'' indicates that the HP 106 | filter is fitted twice. The corresponding trend component becomes 107 | \[ 108 | \widehat{f}^{\left(2\right)}=x-\widehat{c}^{\left(2\right)}=\left(I_{n}-\left(I_{n}-S\right)^{2}\right)x. 109 | \] 110 | If $\widehat{c}^{\left(2\right)}$ continues to exhibit trend behavior, the filtering process may be continued for a third or further time. 111 | After $m$ repeated applications of the filter, the cyclical and trend component are 112 | \begin{eqnarray*} 113 | \widehat{c}^{\left(m\right)} & = & \left(I_{n}-S\right)\widehat{c}^{\left(m-1\right)}=\left(I_{n}-S\right)^{m}x \\ 114 | \widehat{f}^{\left(m\right)} & = & x-\widehat{c}^{\left(m\right)}. 115 | \end{eqnarray*} 116 | 117 | The number of iterations $m$ is an additional tuning parameter in bHP. In practice, it is recommended that we choose $\lambda$ according to the convention, say $\lambda = 1600$ for quarterly data, and then monitor a stopping criterion as the iteration proceeds. @Phillips2019boosting suggest using either the ADF test or the Bayesian Information Criterion (BIC) to terminate the iteration. 118 | 119 | This package `bHP` automates bHP. The main function is `BoostedHP`. 120 | The user chooses the two tuning parameters `lambda` for $\lambda$ and `stopping` for the stopping criterion. In particular, three options are available for `stopping`: 121 | 122 | * `"BIC"` for the BIC stopping criterion 123 | * `"adf"` for the ADF stopping criterion (default $p$-value 5\%) 124 | * `"nonstop"` keeps iteration until it reaches `Max_iter` (default is 100 iterations). 125 | 126 | 127 | The basic usage with the default options is as follows: 128 | ```{r, eval=FALSE} 129 | BoostedHP(x, lambda = 1600, iter= TRUE, stopping = "BIC", Max_Iter = 100) 130 | ``` 131 | The above line produces an object of the `bHP` class. We can extract the trend by `$trend`, the 132 | cycle by `$cycle`. The sequence of trend for each iteration is stored in `$trend_hist`, 133 | and `$iter_num` reports the number of iterations. 134 | The original HP filter can also be implemented by setting `iter = FALSE` along with a `lambda`. 135 | 136 | 137 | ## Examples 138 | 139 | One of the applications in @Phillips2019boosting is concerning the 140 | international comparison of the Okun's law. We use Ireland's annual GDP here for illustration. 141 | 142 | ```{r, message=FALSE} 143 | lam <- 100 # tuning parameter for the annual data 144 | data(IRE) # load the data 'IRE' 145 | 146 | bx_HP <- BoostedHP(IRE, lambda = lam, iter= FALSE)$trend 147 | bx_BIC <- BoostedHP(IRE, lambda = lam, stopping = "BIC")$trend 148 | bx_ADF <- BoostedHP(IRE, lambda = lam, stopping = "adf")$trend 149 | bx_nonstop <- BoostedHP(IRE, lambda = lam, iter= TRUE, 150 | stopping = "nonstop") %>% predict( ) 151 | # use the generic method `predict` is an alternative way to get the trend 152 | 153 | matplot( y = cbind(IRE, bx_HP, bx_BIC, bx_ADF, bx_nonstop), 154 | type = "l", x = 1981:2016, ylab = "data and trends", 155 | xlab = "year", main = "Ireland Annual GDP") 156 | legend("bottomright", legend = c("data","HP", "BIC", "ADF", "nonstop"), 157 | col = 1:5, lty = 1:5) 158 | ``` 159 | The trend and cycle can also be extracted by the generic methods `predict` and `residuals`, respectively. 160 | 161 | 162 | ```{r} 163 | bx <- BoostedHP(IRE, lambda = lam, stopping = "BIC") 164 | IRE_cycle <- residuals(bx) 165 | ``` 166 | 167 | ## Version 168 | 169 | This is our first R package released on `github`, labeled with Version 1.0. 170 | The main function `BoostedHP` and associated methods `predict`, `residuals` and `BIC` are complete and 171 | well documented. 172 | The package also contains experimental generic methods `print`, `plot` and `summary`, 173 | which are still preliminary. 174 | 175 | 176 | ```{r, eval=FALSE, echo=FALSE} 177 | #-------- plot ----------- 178 | 179 | ?plot.bHP 180 | 181 | #--------- start to plot the content of bHP ----------------- 182 | 183 | #--------- for dynamic style (default)-------- 184 | plot(bx_ADF) 185 | 186 | plot(bx_ADF, iteration_location = "upright") # change the location of text 187 | 188 | plot(bx_ADF, iteration_location = c(30,12)) # assign the location of text by x-y co-ordinates 189 | 190 | plot(bx_BIC, interval_t = 0.8 ) # change the time interval of animation 191 | 192 | plot(bx_nonstop, cex_legend = 2, cex_text = 3) # change the magnification of legend and text 193 | 194 | # change the color 195 | plot(bx_ADF,main = "dynamic graph with new color",col_raw = "#685F74", col_trend_h = "#39A1A8", col_trend_f = "#DD4B4F", col_pvalue_BIC = "#E96145") 196 | 197 | plot(bx_ADF,main = "dynamic graph with new trancparency setting",raw_alpha = 200, trend_h_alpha = 55, trend_f_alpha = 250, pvalue_BIC_alpha = 250) 198 | 199 | plot(bx_HP) 200 | # nonstop-iter' bHP doesn't have dynamic picture: returning NA 201 | 202 | #--------- for JS style ---------- 203 | 204 | plot(bx_ADF,plot_type = "JS") 205 | 206 | # change the color 207 | plot(bx_ADF,plot_type = "JS",main = "Js graph with new color", col_raw = "#685F74", col_trend_f = "#DD4B4F", col_pvalue_BIC = "#39A1A8") 208 | 209 | plot(bx_BIC,plot_type = "JS") 210 | 211 | plot(bx_nonstop,plot_type = "JS") 212 | 213 | plot(bx_HP,plot_type = "JS") 214 | 215 | #--------- for static style ---------- 216 | 217 | plot(bx_ADF,plot_type = "static",cex_legend = 0.7, cex_text = 0.8 ) 218 | 219 | plot(bx_HP,plot_type = "static") 220 | 221 | plot(bx_BIC,plot_type = "static",cex_legend = 0.7, cex_text = 0.8 ) 222 | 223 | plot(bx_nonstop,plot_type = "static",cex_legend = 0.8, cex_text = 0.8 ) 224 | 225 | #----------- print ------------------------------- 226 | 227 | ?print.bHP 228 | 229 | #--------- start to print the content of bHP ----------------- 230 | print(bx_ADF) 231 | 232 | print(bx_ADF, Head = F, Tail = T, trend_hist = F) 233 | 234 | print(bx_ADF, Head = T, Tail = T, trend_hist = F) 235 | 236 | print(bx_ADF, Head = F, Tail = F, trend_hist = F) 237 | 238 | print(bx_BIC, Head = F, Tail = F, trend_hist = T, select_trend_hist = 1:bx_BIC$iter_num) 239 | 240 | print(bx_BIC, Head = F, Tail = F, trend_hist = T, select_trend_hist = c(1,3,5)) 241 | 242 | # when the trend_hist is FALSE, select_trend_hist is invalid 243 | print(bx_BIC, Head = F, Tail = F, trend_hist = F, select_trend_hist = c(1,3,5)) 244 | 245 | print(bx_BIC, Head = F, Tail = T, trend_hist = F, print_type = "latex") 246 | 247 | print(bx_BIC, Head = F, Tail = T, trend_hist = F, print_type = "html") 248 | 249 | # show the generic print function output 250 | print(bx_ADF, type = "generic default") 251 | 252 | 253 | 254 | #------------------ summary ----------------- 255 | 256 | ?summary.bHP 257 | 258 | summary(bx_ADF) 259 | summary(bx_BIC) 260 | summary(bx_nonstop) 261 | summary(bx_HP) 262 | 263 | #------------------ predict ----------------- 264 | 265 | ?predict.bHP 266 | 267 | predict(bx_HP) #Iterated number of HP filter: 1 268 | 269 | predict(bx_ADF) #Iterated number of HP filter: 19 270 | 271 | predict(bx_BIC) #Iterated number of HP filter: 5 272 | 273 | predict(bx_nonstop) #Iterated number of HP filter: 99 274 | 275 | 276 | #------------------ residuals ----------------- 277 | 278 | ?residuals.bHP 279 | 280 | residuals(bx_HP) #Iterated number of HP filter: 1 281 | 282 | residuals(bx_ADF) #Iterated number of HP filter: 19 283 | 284 | #------------------ BIC ------------------------- 285 | 286 | ?BIC.bHP 287 | 288 | BIC(bx_BIC) 289 | 290 | #Retrun the value path of BIC. 291 | #Iterated number of HP filter: 5 292 | #Keep the path of BIC till iterated 6 times to show the tuning point. 293 | #[1] 1.586255 1.366335 1.293931 1.264323 1.254397 1.254620 294 | 295 | BIC(bx_nonstop) 296 | 297 | #Retrun the BIC path of nonstop. 298 | #Iterated number of HP filter: 99 299 | #Keep the path of BIC till iterated 100 times to show the tuning point. 300 | #[1] 1.586255 1.366335 1.293931 1.264323 1.254397 1.254620 1.260345 1.269139 1.279670 1.291179 301 | #[11] 1.303223 ... 302 | 303 | 304 | ### If the test type is not "adf", Pvalue.bHP will return error 305 | 306 | # raw HP filter 307 | BIC(bx_HP) 308 | 309 | # Error in BIC.bHP(bx_HP) : 310 | # The stationary test type is nonstop-iter, not BIC or nonstop. 311 | 312 | 313 | # by ADF 314 | BIC(bx_ADF) 315 | 316 | #Error in BIC.bHP(bx_ADF) : 317 | #The stationary test type is adf, not BIC or nonstop. 318 | 319 | ``` 320 | 321 | ## References 322 | 323 | 324 | 325 | -------------------------------------------------------------------------------- /vignettes/vignette.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/chenyang45/BoostedHP/33650d816eea69271456929d3c1d87e27869aed2/vignettes/vignette.pdf -------------------------------------------------------------------------------- /work_memo/Example.R: -------------------------------------------------------------------------------- 1 | #=================================================================================== 2 | #R version 3.5.1 (2018-07-02) -- "Feather Spray" 3 | #Copyright (C) 2018 The R Foundation for Statistical Computing 4 | #Platform: x86_64-w64-mingw32/x64 (64-bit) 5 | #=================================================================================== 6 | # example of package 'BoostedHP' 7 | #=================================================================================== 8 | # Date: 2019-07-23 9 | #=================================================================================== 10 | # By Chen Yang: chen_yang@link.cuhk.edu.hk 11 | #=================================================================================== 12 | 13 | # install package 'BoostedHp' 14 | 15 | devtools::install_github("chenyang45/BoostedHP/BoostedHP") 16 | 17 | # or 18 | 19 | devtools::install_github("chenyang45/BoostedHP/BoostedHP", INSTALL_opts=c("--no-multiarch")) 20 | 21 | library(BoostedHP) 22 | 23 | # conduct the HP-filter and produce object bHP 24 | 25 | ?BoostedHP 26 | 27 | library(tseries) 28 | 29 | lam <- 100 # tuning parameter for the annaul data 30 | 31 | data(IRE) # laod the data 'IRE' 32 | 33 | # raw HP filter 34 | bx_HP <- BoostedHP(IRE, lambda = lam, iter= FALSE) 35 | 36 | # by BIC 37 | bx_BIC <- BoostedHP(IRE, lambda = lam, iter= TRUE, test_type = "BIC") 38 | 39 | # by ADF 40 | bx_ADF <- BoostedHP(IRE, lambda = lam, iter= TRUE, test_type = "adf") 41 | 42 | # by none test type 43 | # Iterated HP filter until Max_Iter and keep the path of BIC. 44 | 45 | bx_none <- BoostedHP(IRE, lambda = lam, iter= TRUE, test_type = "none") 46 | 47 | #-------- plot ----------- 48 | 49 | ?plot.bHP 50 | 51 | #--------- start to plot the content of bHP ----------------- 52 | 53 | #--------- for dynamic style (default)-------- 54 | plot(bx_ADF) 55 | 56 | plot(bx_ADF, iteration_location = "upright") # change the location of text 57 | 58 | plot(bx_ADF, iteration_location = c(30,12)) # assign the location of text by x-y co-ordinates 59 | 60 | plot(bx_BIC, interval_t = 0.8 ) # change the time interval of animation 61 | 62 | plot(bx_none, cex_legend = 2, cex_text = 3) # change the magnification of legend and text 63 | 64 | # change the color 65 | plot(bx_ADF,main = "dynamic graph with new color",col_raw = "#685F74", col_trend_h = "#39A1A8", col_trend_f = "#DD4B4F", col_pvalue_BIC = "#E96145") 66 | 67 | plot(bx_ADF,main = "dynamic graph with new trancparency setting",raw_alpha = 200, trend_h_alpha = 55, trend_f_alpha = 250, pvalue_BIC_alpha = 250) 68 | 69 | plot(bx_HP) 70 | # none-iter' bHP doesn't have dynamic picture: returning NA 71 | 72 | #--------- for JS style ---------- 73 | 74 | plot(bx_ADF,plot_type = "JS") 75 | 76 | # change the color 77 | plot(bx_ADF,plot_type = "JS",main = "Js graph with new color", col_raw = "#685F74", col_trend_f = "#DD4B4F", col_pvalue_BIC = "#39A1A8") 78 | 79 | plot(bx_BIC,plot_type = "JS") 80 | 81 | plot(bx_none,plot_type = "JS") 82 | 83 | plot(bx_HP,plot_type = "JS") 84 | 85 | #--------- for static style ---------- 86 | 87 | plot(bx_ADF,plot_type = "static",cex_legend = 0.7, cex_text = 0.8 ) 88 | 89 | plot(bx_HP,plot_type = "static") 90 | 91 | plot(bx_BIC,plot_type = "static",cex_legend = 0.7, cex_text = 0.8 ) 92 | 93 | plot(bx_none,plot_type = "static",cex_legend = 0.8, cex_text = 0.8 ) 94 | 95 | #----------- print ------------------------------- 96 | 97 | ?print.bHP 98 | 99 | #--------- start to print the content of bHP ----------------- 100 | print(bx_ADF) 101 | 102 | print(bx_ADF, Head = F, Tail = T, trend_hist = F) 103 | 104 | print(bx_ADF, Head = T, Tail = T, trend_hist = F) 105 | 106 | print(bx_ADF, Head = F, Tail = F, trend_hist = F) 107 | 108 | print(bx_BIC, Head = F, Tail = F, trend_hist = T, select_trend_hist = 1:bx_BIC$iter_num) 109 | 110 | print(bx_BIC, Head = F, Tail = F, trend_hist = T, select_trend_hist = c(1,3,5)) 111 | 112 | # when the trend_hist is FALSE, select_trend_hist is invalid 113 | print(bx_BIC, Head = F, Tail = F, trend_hist = F, select_trend_hist = c(1,3,5)) 114 | 115 | print(bx_BIC, Head = F, Tail = T, trend_hist = F, print_type = "latex") 116 | 117 | print(bx_BIC, Head = F, Tail = T, trend_hist = F, print_type = "html") 118 | 119 | # show the generic print function output 120 | print(bx_ADF, type = "generic default") 121 | 122 | 123 | 124 | #------------------ summary ----------------- 125 | 126 | ?summary.bHP 127 | 128 | summary(bx_ADF) 129 | summary(bx_BIC) 130 | summary(bx_none) 131 | summary(bx_HP) 132 | 133 | #------------------ predict ----------------- 134 | 135 | ?predict.bHP 136 | 137 | predict(bx_HP) #Iterated number of HP filter: 1 138 | 139 | predict(bx_ADF) #Iterated number of HP filter: 19 140 | 141 | predict(bx_BIC) #Iterated number of HP filter: 5 142 | 143 | predict(bx_none) #Iterated number of HP filter: 99 144 | 145 | 146 | #------------------ residuals ----------------- 147 | 148 | ?residuals.bHP 149 | 150 | residuals(bx_HP) #Iterated number of HP filter: 1 151 | 152 | residuals(bx_ADF) #Iterated number of HP filter: 19 153 | 154 | #------------------ BIC ------------------------- 155 | 156 | ?BIC.bHP 157 | 158 | BIC(bx_BIC) 159 | 160 | #Retrun the value path of BIC. 161 | #Iterated number of HP filter: 5 162 | #Keep the path of BIC till iterated 6 times to show the tuning point. 163 | #[1] 1.586255 1.366335 1.293931 1.264323 1.254397 1.254620 164 | 165 | BIC(bx_none) 166 | 167 | #Retrun the BIC path of none. 168 | #Iterated number of HP filter: 99 169 | #Keep the path of BIC till iterated 100 times to show the tuning point. 170 | #[1] 1.586255 1.366335 1.293931 1.264323 1.254397 1.254620 1.260345 1.269139 1.279670 1.291179 171 | #[11] 1.303223 ... 172 | 173 | 174 | ### If the test type is not "adf", Pvalue.bHP will return error 175 | 176 | # raw HP filter 177 | BIC(bx_HP) 178 | 179 | # Error in BIC.bHP(bx_HP) : 180 | # The stationary test type is none-iter, not BIC or none. 181 | 182 | 183 | # by ADF 184 | BIC(bx_ADF) 185 | 186 | #Error in BIC.bHP(bx_ADF) : 187 | #The stationary test type is adf, not BIC or none. 188 | 189 | 190 | #--------------- Pvalue --------------------- 191 | 192 | ?Pvalue.bHP 193 | 194 | Pvalue(bx_ADF) 195 | 196 | # Retrun the value path of adf. 197 | # Iterated number of HP filter: 19 198 | # [1] 0.26932206 0.16154351 0.10943027 0.09301570 0.08624282 0.08172733 0.07880462 0.07692725 199 | # [9] 0.07561611 0.07449014 0.07326910 0.07175650 0.06981805 0.06736339 0.06433257 0.06068690 200 | # [17] 0.05640284 0.05146806 0.04785197 201 | 202 | 203 | ### If the test type is not "adf", Pvalue.bHP will return error 204 | 205 | # raw HP filter 206 | 207 | Pvalue(bx_HP) 208 | 209 | # Error in Pvalue.bHP(bx_HP) : 210 | # The stationary test type is none-iter, not ADF. 211 | 212 | # by BIC 213 | 214 | Pvalue(bx_BIC) 215 | 216 | # Error in Pvalue.bHP(bx_BIC) : The stationary test type is BIC, not ADF. 217 | 218 | # by none test type 219 | # Iterated HP filter until Max_Iter and keep the path of BIC. 220 | 221 | Pvalue(bx_none) 222 | 223 | #Error in Pvalue.bHP(bx_none) : The stationary test type is none, not ADF. 224 | 225 | -------------------------------------------------------------------------------- /work_memo/match_arg.R: -------------------------------------------------------------------------------- 1 | library(stats) 2 | ## Extends the example for 'switch' 3 | center <- function(x, type = c("mean", "median", "trimmed")) { 4 | type <- match.arg(type) 5 | switch(type, 6 | mean = mean(x), 7 | median = median(x), 8 | trimmed = mean(x, trim = .1)) 9 | } 10 | x <- rcauchy(10) 11 | center(x, "t") # Works 12 | center(x, "med") # Works 13 | try(center(x, "m")) # Error 14 | stopifnot(identical(center(x), center(x, "mean")), 15 | identical(center(x, NULL), center(x, "mean")) ) 16 | 17 | 18 | 19 | match.arg <- function (arg, choices, several.ok = FALSE) 20 | { 21 | if (missing(choices)) { 22 | formal.args <- formals(sys.function(sysP <- sys.parent())) 23 | choices <- eval(formal.args[[as.character(substitute(arg))]], 24 | envir = sys.frame(sysP)) 25 | } 26 | if (is.null(arg)) 27 | return(choices[1L]) 28 | else if (!is.character(arg)) 29 | stop("'arg' must be NULL or a character vector") 30 | if (!several.ok) { 31 | if (identical(arg, choices)) 32 | return(arg[1L]) 33 | if (length(arg) > 1L) 34 | stop("'arg' must be of length 1") 35 | } 36 | else if (length(arg) == 0L) 37 | stop("'arg' must be of length >= 1") 38 | i <- pmatch(arg, choices, nomatch = 0L, duplicates.ok = TRUE) 39 | if (all(i == 0L)) 40 | stop(gettextf("'arg' should be one of %s", paste(dQuote(choices), 41 | collapse = ", ")), domain = NA) 42 | i <- i[i > 0L] 43 | if (!several.ok && length(i) > 1) 44 | stop("there is more than one match in 'match.arg'") 45 | choices[i] 46 | } 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | ## Allowing more than one match: 59 | match.arg(c("gauss", "rect", "ep"), 60 | c("gaussian", "epanechnikov", "rectangular", "triangular"), 61 | several.ok = TRUE) 62 | 63 | 64 | --------------------------------------------------------------------------------