├── .github ├── .gitignore └── workflows │ └── R-CMD-check.yaml ├── vignettes └── .gitignore ├── data ├── ag_data.RData ├── monetary_var_data.RData └── interest_rules_var_data.RData ├── tests ├── testthat.R └── testthat │ ├── testthat-problems.rds │ ├── test-diagnost_ols.R │ ├── test-hp_filter.R │ ├── test-plot_lin.R │ ├── test-newey_west.R │ ├── test-plot_nl.R │ └── test-get_var_lagcrit.R ├── man ├── figures │ ├── lpirfs_logo.png │ ├── README-unnamed-chunk-7-1.png │ ├── README-unnamed-chunk-7-2.png │ ├── README-unnamed-chunk-8-1.png │ ├── README-unnamed-chunk-15-1.png │ ├── README-unnamed-chunk-16-1.png │ ├── README-unnamed-chunk-18-1.png │ ├── README-unnamed-chunk-18-2.png │ ├── README-unnamed-chunk-19-1.png │ └── README-unnamed-chunk-20-1.png ├── lpirfs_obj-methods-base.Rd ├── summary.lpirfs_lin_obj.Rd ├── summary.lpirfs_nl_obj.Rd ├── summary.lpirfs_nl_iv_obj.Rd ├── summary.lpirfs_lin_iv_obj.Rd ├── summary.lpirfs_nl_panel_obj.Rd ├── summary.lpirfs_lin_panel_obj.Rd ├── get_robust_cov_panel.Rd ├── plot.lpirfs_lin_obj.Rd ├── plot.lpirfs_nl_obj.Rd ├── create_lags.Rd ├── get_resids_ols.Rd ├── plot.lpirfs_lin_iv_obj.Rd ├── plot.lpirfs_nl_iv_obj.Rd ├── plot.lpirfs_nl_panel_obj.Rd ├── plot.lpirfs_lin_panel_obj.Rd ├── create_lin_data.Rd ├── plot_lin.Rd ├── create_panel_data.Rd ├── plot_nl.Rd ├── create_nl_data.Rd ├── lpirfs-package.Rd ├── get_robust_vcxt_panel.Rd ├── get_mat_chol.Rd ├── get_std_err_tsls.Rd ├── get_std_err.Rd ├── get_vals_lagcrit.Rd ├── var_one.Rd ├── newey_west.Rd ├── newey_west_pw.Rd ├── interest_rules_var_data.Rd ├── get_var_lagcrit.Rd ├── monetary_var_data.Rd ├── get_vals_switching.Rd ├── newey_west_tsls.Rd ├── ols_diagnost.Rd ├── ag_data.Rd ├── hp_filter.Rd ├── lp_lin.Rd ├── lp_lin_iv.Rd └── lp_nl_iv.Rd ├── CRAN-SUBMISSION ├── docs └── pics_docs │ ├── unnamed-chunk-10-1.png │ ├── unnamed-chunk-11-1.png │ ├── unnamed-chunk-12-1.png │ ├── unnamed-chunk-13-1.png │ ├── unnamed-chunk-13-2.png │ ├── unnamed-chunk-14-1.png │ ├── unnamed-chunk-15-1.png │ ├── unnamed-chunk-15-2.png │ ├── unnamed-chunk-16-1.png │ ├── unnamed-chunk-16-2.png │ ├── unnamed-chunk-17-1.png │ ├── unnamed-chunk-17-2.png │ ├── unnamed-chunk-18-1.png │ ├── unnamed-chunk-18-2.png │ ├── unnamed-chunk-19-1.png │ ├── unnamed-chunk-19-2.png │ ├── unnamed-chunk-20-1.png │ ├── unnamed-chunk-21-1.png │ ├── unnamed-chunk-27-1.png │ ├── unnamed-chunk-28-1.png │ ├── unnamed-chunk-29-1.png │ ├── unnamed-chunk-30-1.png │ ├── unnamed-chunk-31-1.png │ ├── unnamed-chunk-32-1.png │ ├── unnamed-chunk-33-1.png │ ├── unnamed-chunk-33-2.png │ ├── unnamed-chunk-34-1.png │ ├── unnamed-chunk-35-1.png │ ├── unnamed-chunk-36-1.png │ ├── unnamed-chunk-37-1.png │ ├── unnamed-chunk-38-1.png │ ├── unnamed-chunk-39-1.png │ ├── unnamed-chunk-40-1.png │ ├── unnamed-chunk-40-2.png │ ├── unnamed-chunk-40-3.png │ ├── unnamed-chunk-5-1.png │ ├── unnamed-chunk-5-2.png │ ├── unnamed-chunk-6-1.png │ ├── unnamed-chunk-6-2.png │ ├── unnamed-chunk-7-1.png │ ├── unnamed-chunk-7-2.png │ └── unnamed-chunk-8-1.png ├── .gitignore ├── CRAN-RELEASE ├── src ├── Makevars ├── Makevars.win ├── var_one.cpp ├── get_vals_lagcrit.cpp ├── newey_west_pw.cpp ├── newey_west.cpp ├── hp_filter.cpp ├── newey_west_tsls.cpp ├── ols_diagnost.cpp ├── hp_fast.cpp └── RcppExports.cpp ├── .Rbuildignore ├── .travis.yml ├── cran-comments.md ├── R ├── zzz.R ├── package.R ├── get_resids_ols.R ├── get_robust_vcxt_panel.R ├── create_lags.R ├── get_robust_cov_panel.R ├── get_std_err_tsls.R ├── get_std_err.R ├── get_mat_chol.R ├── data-documentation.R ├── get_var_lagcrit.R ├── plot_lin.R ├── get_vals_switching.R ├── create_lin_data.R ├── plot_nl.R ├── lpirfs_obj-methods-base.R ├── RcppExports.R └── create_nl_data.R ├── inst └── CITATION ├── lpirfs.Rproj ├── NAMESPACE ├── DESCRIPTION ├── README.md ├── README.Rmd └── NEWS.md /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /data/ag_data.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/data/ag_data.RData -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(lpirfs) 3 | 4 | test_check("lpirfs") 5 | -------------------------------------------------------------------------------- /data/monetary_var_data.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/data/monetary_var_data.RData -------------------------------------------------------------------------------- /man/figures/lpirfs_logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/man/figures/lpirfs_logo.png -------------------------------------------------------------------------------- /CRAN-SUBMISSION: -------------------------------------------------------------------------------- 1 | Version: 0.2.5 2 | Date: 2025-10-01 12:29:29 UTC 3 | SHA: 6a2d6b30200da0c223fecb443b942c977c530759 4 | -------------------------------------------------------------------------------- /data/interest_rules_var_data.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/data/interest_rules_var_data.RData -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-10-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-10-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-11-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-11-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-12-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-12-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-13-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-13-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-13-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-13-2.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-14-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-14-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-15-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-15-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-15-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-15-2.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-16-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-16-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-16-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-16-2.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-17-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-17-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-17-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-17-2.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-18-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-18-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-18-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-18-2.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-19-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-19-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-19-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-19-2.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-20-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-20-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-21-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-21-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-27-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-27-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-28-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-28-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-29-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-29-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-30-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-30-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-31-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-31-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-32-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-32-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-33-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-33-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-33-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-33-2.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-34-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-34-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-35-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-35-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-36-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-36-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-37-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-37-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-38-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-38-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-39-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-39-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-40-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-40-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-40-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-40-2.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-40-3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-40-3.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-5-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-5-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-5-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-5-2.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-6-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-6-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-6-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-6-2.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-7-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-7-1.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-7-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-7-2.png -------------------------------------------------------------------------------- /docs/pics_docs/unnamed-chunk-8-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/docs/pics_docs/unnamed-chunk-8-1.png -------------------------------------------------------------------------------- /tests/testthat/testthat-problems.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/tests/testthat/testthat-problems.rds -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-7-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/man/figures/README-unnamed-chunk-7-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-7-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/man/figures/README-unnamed-chunk-7-2.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-8-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/man/figures/README-unnamed-chunk-8-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-15-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/man/figures/README-unnamed-chunk-15-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-16-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/man/figures/README-unnamed-chunk-16-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-18-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/man/figures/README-unnamed-chunk-18-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-18-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/man/figures/README-unnamed-chunk-18-2.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-19-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/man/figures/README-unnamed-chunk-19-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-20-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaemmerP/lpirfs/HEAD/man/figures/README-unnamed-chunk-20-1.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | inst/doc 2 | .Rproj.user 3 | .Rhistory 4 | .RData 5 | .Ruserdata 6 | .httr-oauth 7 | .cran-comments.md 8 | *.o 9 | *.so 10 | -------------------------------------------------------------------------------- /CRAN-RELEASE: -------------------------------------------------------------------------------- 1 | This package was submitted to CRAN on 2021-03-23. 2 | Once it is accepted, delete this file and tag the release (commit fdb4e80). 3 | -------------------------------------------------------------------------------- /src/Makevars: -------------------------------------------------------------------------------- 1 | PKG_CPPFLAGS = -I../inst/include/ 2 | #CXX_STD = CXX11 3 | PKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) 4 | PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) 5 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^CRAN-RELEASE$ 2 | ^.*\.Rproj$ 3 | ^\.Rproj\.user$ 4 | ^\.httr-oauth$ 5 | ^README\.Rmd$ 6 | ^README-.*\.png$ 7 | ^docs 8 | ^\.travis\.yml$ 9 | ^cran-comments.md 10 | ^CRAN-SUBMISSION$ 11 | ^\.github$ 12 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # R for travis: see documentation at https://docs.travis-ci.com/user/languages/r 2 | 3 | language: r 4 | r: 5 | - oldrel 6 | - release 7 | - devel 8 | 9 | r_packages: 10 | - covr 11 | 12 | after_success: 13 | - Rscript -e 'library(covr); codecov()' 14 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | # Submission notes 2 | 3 | ## Purpose 4 | 5 | * Fixed bug [#50](https://github.com/AdaemmerP/lpirfs/issues/50) for computing the 6 | confidence intervals with 2SLS in `lp_lin_iv()`. 7 | 8 | ## Test environments 9 | * Running under Ubuntu 22.04.2 LTS 10 | 11 | 12 | 13 | 14 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | .onLoad <- function(libname, pkgname){ 2 | 3 | utils::globalVariables(c(".", "trend", "s", "x", "low", "up", "endog_data", 4 | "x_lin", "d", "y_lin", "cross_id", "date_id", ":=", 5 | "specs", "irf_lin_mean", "irf_lin_low", "irf_lin_up")) 6 | 7 | } 8 | -------------------------------------------------------------------------------- /man/lpirfs_obj-methods-base.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lpirfs_obj-methods-base.R 3 | \name{lpirfs_obj-methods-base} 4 | \alias{lpirfs_obj-methods-base} 5 | \title{Base methods for lpirfs_obj objects} 6 | \description{ 7 | Base methods for lpirfs_obj objects 8 | } 9 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | bibentry(bibtype = "article", 2 | title = "lpirfs: An R Package to Estimate Impulse Response Functions by Local Projections", 3 | author = c(person("Philipp", "Adämmer")), 4 | journal = "The R Journal", 5 | year = "2019", 6 | volume = "11", 7 | number = "2", 8 | pages = "421--438", 9 | doi = "10.32614/RJ-2019-052", 10 | header = "To cite lpirfs in publications use:" 11 | ) 12 | -------------------------------------------------------------------------------- /man/summary.lpirfs_lin_obj.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lpirfs_obj-methods-base.R 3 | \name{summary.lpirfs_lin_obj} 4 | \alias{summary.lpirfs_lin_obj} 5 | \title{Summary for linear lpirfs object} 6 | \usage{ 7 | \method{summary}{lpirfs_lin_obj}(object, ...) 8 | } 9 | \arguments{ 10 | \item{object}{An object of type 'lpirfs_lin_obj'} 11 | 12 | \item{...}{Additional arguments to be consistent with S3 print() function} 13 | } 14 | \description{ 15 | Summary for linear lpirfs object 16 | } 17 | -------------------------------------------------------------------------------- /man/summary.lpirfs_nl_obj.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lpirfs_obj-methods-base.R 3 | \name{summary.lpirfs_nl_obj} 4 | \alias{summary.lpirfs_nl_obj} 5 | \title{Summary for nonlinear lpirfs object} 6 | \usage{ 7 | \method{summary}{lpirfs_nl_obj}(object, ...) 8 | } 9 | \arguments{ 10 | \item{object}{An object of type 'lpirfs_nl_obj'} 11 | 12 | \item{...}{Additional arguments to be consistent with S3 print() function} 13 | } 14 | \description{ 15 | Summary for nonlinear lpirfs object 16 | } 17 | -------------------------------------------------------------------------------- /man/summary.lpirfs_nl_iv_obj.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lpirfs_obj-methods-base.R 3 | \name{summary.lpirfs_nl_iv_obj} 4 | \alias{summary.lpirfs_nl_iv_obj} 5 | \title{Summary for nonlinear lpirfs object} 6 | \usage{ 7 | \method{summary}{lpirfs_nl_iv_obj}(object, ...) 8 | } 9 | \arguments{ 10 | \item{object}{An object of type 'lpirfs_nl_iv_obj'} 11 | 12 | \item{...}{Additional arguments to be consistent with S3 print() function} 13 | } 14 | \description{ 15 | Summary for nonlinear lpirfs object 16 | } 17 | -------------------------------------------------------------------------------- /man/summary.lpirfs_lin_iv_obj.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lpirfs_obj-methods-base.R 3 | \name{summary.lpirfs_lin_iv_obj} 4 | \alias{summary.lpirfs_lin_iv_obj} 5 | \title{Summary for nonlinear lpirfs object} 6 | \usage{ 7 | \method{summary}{lpirfs_lin_iv_obj}(object, ...) 8 | } 9 | \arguments{ 10 | \item{object}{An object of type 'lpirfs_lin_iv_obj'} 11 | 12 | \item{...}{Additional arguments to be consistent with S3 print() function} 13 | } 14 | \description{ 15 | Summary for nonlinear lpirfs object 16 | } 17 | -------------------------------------------------------------------------------- /man/summary.lpirfs_nl_panel_obj.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lpirfs_obj-methods-base.R 3 | \name{summary.lpirfs_nl_panel_obj} 4 | \alias{summary.lpirfs_nl_panel_obj} 5 | \title{Summary for nonlinear lpirfs object} 6 | \usage{ 7 | \method{summary}{lpirfs_nl_panel_obj}(object, ...) 8 | } 9 | \arguments{ 10 | \item{object}{An object of type 'lpirfs_lin_panel_obj'} 11 | 12 | \item{...}{Additional arguments to be consistent with S3 print() function} 13 | } 14 | \description{ 15 | Summary for nonlinear lpirfs object 16 | } 17 | -------------------------------------------------------------------------------- /man/summary.lpirfs_lin_panel_obj.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lpirfs_obj-methods-base.R 3 | \name{summary.lpirfs_lin_panel_obj} 4 | \alias{summary.lpirfs_lin_panel_obj} 5 | \title{Summary for nonlinear lpirfs object} 6 | \usage{ 7 | \method{summary}{lpirfs_lin_panel_obj}(object, ...) 8 | } 9 | \arguments{ 10 | \item{object}{An object of type 'lpirfs_lin_panel_obj'} 11 | 12 | \item{...}{Additional arguments to be consistent with S3 print() function} 13 | } 14 | \description{ 15 | Summary for nonlinear lpirfs object 16 | } 17 | -------------------------------------------------------------------------------- /lpirfs.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | ProjectId: b6a76b2d-ad36-49dc-805a-11d755a8bbab 3 | 4 | RestoreWorkspace: Default 5 | SaveWorkspace: Default 6 | AlwaysSaveHistory: Default 7 | 8 | EnableCodeIndexing: Yes 9 | UseSpacesForTab: Yes 10 | NumSpacesForTab: 2 11 | Encoding: UTF-8 12 | 13 | RnwWeave: knitr 14 | LaTeX: pdfLaTeX 15 | 16 | AutoAppendNewline: Yes 17 | StripTrailingWhitespace: Yes 18 | 19 | BuildType: Package 20 | PackageUseDevtools: Yes 21 | PackageInstallArgs: --no-multiarch --with-keep.source 22 | PackageCheckArgs: --as-cran 23 | PackageRoxygenize: rd,collate,namespace 24 | -------------------------------------------------------------------------------- /R/package.R: -------------------------------------------------------------------------------- 1 | #' Local Projection Impulse Response Functions 2 | #' 3 | #' lpirfs provides functions to estimate and plot linear as well as nonlinear impulse 4 | #' responses based on local projections by Jordà (2005) . 5 | #' The methods and the package are explained in detail in Adämmer (2019) . 6 | #' Please cite the paper when using the package. 7 | #' 8 | #' @author Philipp Adämmer 9 | #' @importFrom Rcpp evalCpp 10 | #' @useDynLib lpirfs, .registration = TRUE 11 | #' @exportPattern "^[[:alpha:]]+" 12 | #' @name lpirfs-package 13 | "_PACKAGE" 14 | -------------------------------------------------------------------------------- /man/get_robust_cov_panel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_robust_cov_panel.R 3 | \name{get_robust_cov_panel} 4 | \alias{get_robust_cov_panel} 5 | \title{Function to get robust covariance matrix for panel data} 6 | \usage{ 7 | get_robust_cov_panel(panel_results, specs) 8 | } 9 | \arguments{ 10 | \item{panel_results}{Plm object from estimation} 11 | 12 | \item{specs}{List with specifications} 13 | } 14 | \value{ 15 | Object with robust covariance matrix 16 | } 17 | \description{ 18 | Function to get robust covariance matrix for panel data 19 | } 20 | -------------------------------------------------------------------------------- /man/plot.lpirfs_lin_obj.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lpirfs_obj-methods-base.R 3 | \name{plot.lpirfs_lin_obj} 4 | \alias{plot.lpirfs_lin_obj} 5 | \title{Base print() function to plot all impulse responses from linear lpirfs object} 6 | \usage{ 7 | \method{plot}{lpirfs_lin_obj}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{An object of type 'lpirfs_lin_obj} 11 | 12 | \item{...}{Additional arguments to be consistent with S3 print() function} 13 | } 14 | \description{ 15 | Base print() function to plot all impulse responses from linear lpirfs object 16 | } 17 | -------------------------------------------------------------------------------- /man/plot.lpirfs_nl_obj.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lpirfs_obj-methods-base.R 3 | \name{plot.lpirfs_nl_obj} 4 | \alias{plot.lpirfs_nl_obj} 5 | \title{Base print() function to plot all impulse responses from nonlinear lpirfs object} 6 | \usage{ 7 | \method{plot}{lpirfs_nl_obj}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{An object of type 'lpirfs_nl_obj'} 11 | 12 | \item{...}{Additional arguments to be consistent with S3 print() function} 13 | } 14 | \description{ 15 | Base print() function to plot all impulse responses from nonlinear lpirfs object 16 | } 17 | -------------------------------------------------------------------------------- /man/create_lags.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/create_lags.R 3 | \name{create_lags} 4 | \alias{create_lags} 5 | \title{Compute a data frame with lagged exogenous variables} 6 | \usage{ 7 | create_lags(data, lags) 8 | } 9 | \arguments{ 10 | \item{data}{A \link{data.frame}().} 11 | 12 | \item{lags}{Integer for the number of lags.} 13 | } 14 | \value{ 15 | Returns a \link{data.frame} with lagged values. 16 | } 17 | \description{ 18 | Create a \link{data.frame}() with lagged exogenous variables. 19 | } 20 | \author{ 21 | Philipp Adämmer 22 | } 23 | \keyword{internal} 24 | -------------------------------------------------------------------------------- /man/get_resids_ols.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_resids_ols.R 3 | \name{get_resids_ols} 4 | \alias{get_resids_ols} 5 | \title{Compute residuals from OLS model} 6 | \usage{ 7 | get_resids_ols(y_data, x_data) 8 | } 9 | \arguments{ 10 | \item{y_data}{A vector for the left hand variable.} 11 | 12 | \item{x_data}{A matrix with right hand variables.} 13 | } 14 | \value{ 15 | A numeric vector with residuals from OLS regression. 16 | } 17 | \description{ 18 | Estimate residuals from OLS model. 19 | } 20 | \author{ 21 | Philipp Adämmer 22 | } 23 | \keyword{internal} 24 | -------------------------------------------------------------------------------- /man/plot.lpirfs_lin_iv_obj.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lpirfs_obj-methods-base.R 3 | \name{plot.lpirfs_lin_iv_obj} 4 | \alias{plot.lpirfs_lin_iv_obj} 5 | \title{Base print() function to plot all impulse responses from linear lpirfs object} 6 | \usage{ 7 | \method{plot}{lpirfs_lin_iv_obj}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{An object of type 'lpirfs_lin_obj} 11 | 12 | \item{...}{Additional arguments to be consistent with S3 print() function} 13 | } 14 | \description{ 15 | Base print() function to plot all impulse responses from linear lpirfs object 16 | } 17 | -------------------------------------------------------------------------------- /man/plot.lpirfs_nl_iv_obj.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lpirfs_obj-methods-base.R 3 | \name{plot.lpirfs_nl_iv_obj} 4 | \alias{plot.lpirfs_nl_iv_obj} 5 | \title{Base print() function to plot all impulse responses from linear lpirfs object} 6 | \usage{ 7 | \method{plot}{lpirfs_nl_iv_obj}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{An object of type 'lpirfs_nl_iv_obj'} 11 | 12 | \item{...}{Additional arguments to be consistent with S3 print() function} 13 | } 14 | \description{ 15 | Base print() function to plot all impulse responses from linear lpirfs object 16 | } 17 | -------------------------------------------------------------------------------- /man/plot.lpirfs_nl_panel_obj.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lpirfs_obj-methods-base.R 3 | \name{plot.lpirfs_nl_panel_obj} 4 | \alias{plot.lpirfs_nl_panel_obj} 5 | \title{Base print() function to plot all impulse responses from linear lpirfs object} 6 | \usage{ 7 | \method{plot}{lpirfs_nl_panel_obj}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{An object of type 'lpirfs_lin_panel_obj'} 11 | 12 | \item{...}{Additional arguments to be consistent with S3 print() function} 13 | } 14 | \description{ 15 | Base print() function to plot all impulse responses from linear lpirfs object 16 | } 17 | -------------------------------------------------------------------------------- /man/plot.lpirfs_lin_panel_obj.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lpirfs_obj-methods-base.R 3 | \name{plot.lpirfs_lin_panel_obj} 4 | \alias{plot.lpirfs_lin_panel_obj} 5 | \title{Base print() function to plot all impulse responses from linear lpirfs object} 6 | \usage{ 7 | \method{plot}{lpirfs_lin_panel_obj}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{An object of type 'lpirfs_lin_panel_obj'} 11 | 12 | \item{...}{Additional arguments to be consistent with S3 print() function} 13 | } 14 | \description{ 15 | Base print() function to plot all impulse responses from linear lpirfs object 16 | } 17 | -------------------------------------------------------------------------------- /man/create_lin_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/create_lin_data.R 3 | \name{create_lin_data} 4 | \alias{create_lin_data} 5 | \title{Compute data for linear model} 6 | \usage{ 7 | create_lin_data(specs, endog_data) 8 | } 9 | \arguments{ 10 | \item{specs}{A \link{list}(). Inputs are created in \link{lp_lin_iv}.} 11 | 12 | \item{endog_data}{A \link{data.frame} with dependent variables.} 13 | } 14 | \value{ 15 | List with filled matrices of lagged left (y_lin) and right hand side (x_lin) variables. 16 | } 17 | \description{ 18 | Function to create data for linear model. 19 | } 20 | \author{ 21 | Philipp Adämmer 22 | } 23 | \keyword{internal} 24 | -------------------------------------------------------------------------------- /src/Makevars.win: -------------------------------------------------------------------------------- 1 | 2 | ## With R 3.1.0 or later, you can uncomment the following line to tell R to 3 | ## enable compilation with C++11 (where available) 4 | ## 5 | ## Also, OpenMP support in Armadillo prefers C++11 support. However, for wider 6 | ## availability of the package we do not yet enforce this here. It is however 7 | ## recommended for client packages to set it. 8 | ## 9 | ## And with R 3.4.0, and RcppArmadillo 0.7.960.*, we turn C++11 on as OpenMP 10 | ## support within Armadillo prefers / requires it 11 | PKG_CPPFLAGS = -I../inst/include/ 12 | #CXX_STD = CXX11 13 | PKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) 14 | PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) 15 | -------------------------------------------------------------------------------- /man/plot_lin.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_lin.R 3 | \name{plot_lin} 4 | \alias{plot_lin} 5 | \title{Compute and display plots of linear impulse responses} 6 | \usage{ 7 | plot_lin(results_lin) 8 | } 9 | \arguments{ 10 | \item{results_lin}{A \link{list} created with \link{lp_lin}() or \link{lp_lin_iv}().} 11 | } 12 | \value{ 13 | A list with (gg-)plots for linear impulse responses. 14 | } 15 | \description{ 16 | Compute and display linear impulse responses, estimated with \link{lp_lin}() and \link{lp_lin_iv}(). 17 | } 18 | \examples{ 19 | \donttest{ 20 | 21 | # See examples for lp_lin() and lp_lin_iv(). 22 | } 23 | } 24 | \author{ 25 | Philipp Adämmer 26 | } 27 | -------------------------------------------------------------------------------- /man/create_panel_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/create_panel_data.R 3 | \name{create_panel_data} 4 | \alias{create_panel_data} 5 | \title{Prepare data sets for linear and nonlinear panel model} 6 | \usage{ 7 | create_panel_data(specs, data_set) 8 | } 9 | \arguments{ 10 | \item{specs}{A list with specifications created in \link{lp_lin_panel} or \link{lp_nl_panel}.} 11 | 12 | \item{data_set}{A data.frame consisting of a panel data set.} 13 | } 14 | \value{ 15 | A list with prepared endogenous and exogenous data as well as the updated list \emph{specs}. 16 | } 17 | \description{ 18 | Function to create panel data for linear and nonlinear model. 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /man/plot_nl.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_nl.R 3 | \name{plot_nl} 4 | \alias{plot_nl} 5 | \title{Compute and display plots of nonlinear impulse responses} 6 | \usage{ 7 | plot_nl(results_nl) 8 | } 9 | \arguments{ 10 | \item{results_nl}{A \link{list} created with \link{lp_nl}() or \link{lp_nl_iv}().} 11 | } 12 | \value{ 13 | A list with (gg-)plots for nonlinear impulse responses. 14 | } 15 | \description{ 16 | Compute and display (nonlinear) impulse responses, estimated with \link{lp_nl}() and \link{lp_nl_iv}(). 17 | } 18 | \examples{ 19 | \donttest{ 20 | # Load package 21 | 22 | # See examples for lp_nl() and lp_nl_iv(). 23 | 24 | } 25 | } 26 | \author{ 27 | Philipp Adämmer 28 | } 29 | -------------------------------------------------------------------------------- /man/create_nl_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/create_nl_data.R 3 | \name{create_nl_data} 4 | \alias{create_nl_data} 5 | \title{Compute data for nonlinear model with instrument variable approach} 6 | \usage{ 7 | create_nl_data(specs, endog_data) 8 | } 9 | \arguments{ 10 | \item{specs}{A \link{list}(). Inputs are created in \link{lp_nl_iv}.} 11 | 12 | \item{endog_data}{A \link{data.frame} with dependent variables.} 13 | } 14 | \value{ 15 | List with filled matrices of lagged left (y_nl) and right hand side (x_nl) variables. 16 | } 17 | \description{ 18 | Function to create data for nonlinear model with instrument variable approach. 19 | } 20 | \author{ 21 | Philipp Adämmer 22 | } 23 | \keyword{internal} 24 | -------------------------------------------------------------------------------- /man/lpirfs-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/package.R 3 | \docType{package} 4 | \name{lpirfs-package} 5 | \alias{lpirfs} 6 | \alias{lpirfs-package} 7 | \title{Local Projection Impulse Response Functions} 8 | \description{ 9 | lpirfs provides functions to estimate and plot linear as well as nonlinear impulse 10 | responses based on local projections by Jordà (2005) . 11 | The methods and the package are explained in detail in Adämmer (2019) . 12 | Please cite the paper when using the package. 13 | } 14 | \seealso{ 15 | Useful links: 16 | \itemize{ 17 | \item Report bugs at \url{https://github.com/adaemmerp/lpirfs/issues} 18 | } 19 | 20 | } 21 | \author{ 22 | Philipp Adämmer 23 | } 24 | -------------------------------------------------------------------------------- /man/get_robust_vcxt_panel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_robust_vcxt_panel.R 3 | \name{get_robust_vcxt_panel} 4 | \alias{get_robust_vcxt_panel} 5 | \title{Create and returns a function to estimate hc and clustered standard errors for panel data.} 6 | \usage{ 7 | get_robust_vcxt_panel(func_name) 8 | } 9 | \arguments{ 10 | \item{func_name}{A character.} 11 | } 12 | \value{ 13 | A function. 14 | } 15 | \description{ 16 | Create and returns a function to estimate hc and clustered standard errors for panel data. 17 | } 18 | \references{ 19 | Croissant, Y., Millo, G. (2017). "Robust Standard Error Estimators for Panel Models: A Unifying Approach." \emph{Journal of Statistical Software}, 27(2), 1-43. 20 | \doi{10.18637/jss.v082.i03}. 21 | } 22 | \keyword{internal} 23 | -------------------------------------------------------------------------------- /R/get_resids_ols.R: -------------------------------------------------------------------------------- 1 | #' @name get_resids_ols 2 | #' @title Compute residuals from OLS model 3 | #' @description Estimate residuals from OLS model. 4 | #' @param y_data A vector for the left hand variable. 5 | #' @param x_data A matrix with right hand variables. 6 | #' @return A numeric vector with residuals from OLS regression. 7 | #' @keywords internal 8 | #' @author Philipp Adämmer 9 | 10 | get_resids_ols <- function(y_data, x_data){ 11 | 12 | # Build matrices 13 | yy <- as.matrix(y_data) 14 | xx <- as.matrix(x_data) 15 | xx <- cbind(rep(1,nrow(xx)), xx) # Add vector of ones for constant 16 | 17 | # Regression parameters 18 | beta <- (solve(crossprod(xx))%*%t(xx))%*%yy 19 | 20 | # Residuals 21 | resids <- yy - xx%*%beta 22 | 23 | return(resids) 24 | 25 | } 26 | 27 | -------------------------------------------------------------------------------- /man/get_mat_chol.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_mat_chol.R 3 | \name{get_mat_chol} 4 | \alias{get_mat_chol} 5 | \title{Compute structural shock matrix via Cholesky decomposition} 6 | \usage{ 7 | get_mat_chol(y_lin, x_lin, endog_data, specs) 8 | } 9 | \arguments{ 10 | \item{y_lin}{A matrix with all endogenous variables.} 11 | 12 | \item{x_lin}{A matrix with lagged endogenous variables.} 13 | 14 | \item{endog_data}{A \link{data.frame} with all endogenous variables.} 15 | 16 | \item{specs}{A list with specifications from \link{lp_lin} or \link{lp_nl}.} 17 | } 18 | \value{ 19 | Shock matrix (d) 20 | } 21 | \description{ 22 | Compute structural shock matrix via Cholesky decomposition with input variables 23 | created in \link{lp_lin} or \link{lp_nl}. 24 | } 25 | \author{ 26 | Philipp Adämmer 27 | } 28 | \keyword{internal} 29 | -------------------------------------------------------------------------------- /man/get_std_err_tsls.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_std_err_tsls.R 3 | \name{get_std_err_tsls} 4 | \alias{get_std_err_tsls} 5 | \title{Compute standard errors for 2SLS} 6 | \usage{ 7 | get_std_err_tsls(yy, xx, lag_nw, k, zz, specs) 8 | } 9 | \arguments{ 10 | \item{yy}{A matrix with all endogenous variables.} 11 | 12 | \item{xx}{A matrix with lagged endogenous variables.} 13 | 14 | \item{lag_nw}{Integer. Number of lags for Newey and West} 15 | 16 | \item{k}{Integer. Value of column to choose from} 17 | 18 | \item{specs}{A list with specifications from \link{lp_lin} or \link{lp_nl}.} 19 | } 20 | \value{ 21 | List. First element contains the estimated standard errors, the second element contains the OLS point estimates. 22 | } 23 | \description{ 24 | Compute 2SLS standard errors.#' 25 | } 26 | \author{ 27 | Philipp Adämmer 28 | } 29 | \keyword{internal} 30 | -------------------------------------------------------------------------------- /man/get_std_err.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_std_err.R 3 | \name{get_std_err} 4 | \alias{get_std_err} 5 | \title{Compute standard errors by standard OLS or Newey and West} 6 | \usage{ 7 | get_std_err(yy, xx, lag_nw, k, specs) 8 | } 9 | \arguments{ 10 | \item{yy}{A matrix with all endogenous variables.} 11 | 12 | \item{xx}{A matrix with lagged endogenous variables.} 13 | 14 | \item{lag_nw}{Integer. Number of lags for Newey and West} 15 | 16 | \item{k}{Integer. Value of column to choose from} 17 | 18 | \item{specs}{A list with specifications from \link{lp_lin} or \link{lp_nl}.} 19 | } 20 | \value{ 21 | List. First element contains the estimated standard errors, the second element contains the OLS point estimates. 22 | } 23 | \description{ 24 | Compute standard errors by standard OLS or Newey and West (1987). 25 | } 26 | \author{ 27 | Philipp Adämmer 28 | } 29 | \keyword{internal} 30 | -------------------------------------------------------------------------------- /tests/testthat/test-diagnost_ols.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | test_that("Test whether diagnostic function returns same values as base function", { 4 | 5 | xx <- matrix(rnorm(500), nrow = 100, 5) 6 | yy <- matrix(rnorm(100)) 7 | 8 | # Get diagnostocs for summary() 9 | get_diagnost <- lpirfs::ols_diagnost(yy, xx) 10 | R_sqrd_lpirfs <- get_diagnost[[3]] 11 | R_sqrd_adj_lpirfs <- get_diagnost[[4]] 12 | F_stat_lpirfs <- get_diagnost[[5]] 13 | p_value_F_lpirfs <- stats::pf(F_stat_lpirfs, get_diagnost[[6]], get_diagnost[[7]], lower.tail = F) 14 | 15 | lm_modeĺ <- lm(yy ~ xx) 16 | summary_lm <- summary(lm_modeĺ) 17 | summary_lm$fstatistic 18 | 19 | testthat::expect_equal(R_sqrd_lpirfs, summary_lm$r.squared) 20 | testthat::expect_equal(R_sqrd_adj_lpirfs, summary_lm$adj.r.squared) 21 | testthat::expect_equal(F_stat_lpirfs, summary_lm$fstatistic[1], ignore_attr = T) 22 | 23 | 24 | }) 25 | -------------------------------------------------------------------------------- /man/get_vals_lagcrit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RcppExports.R 3 | \name{get_vals_lagcrit} 4 | \alias{get_vals_lagcrit} 5 | \title{Compute values for lag length criteria} 6 | \usage{ 7 | get_vals_lagcrit(y, x, lag_crit, h, k, max_lags, n_obs) 8 | } 9 | \arguments{ 10 | \item{y}{List with left (endogenous) variables.} 11 | 12 | \item{x}{List with right (exogenous) variables.} 13 | 14 | \item{lag_crit}{Integer: 'AICc'= 1, 'AIC' = 2, 'BIC' = 3.} 15 | 16 | \item{h}{Integer.} 17 | 18 | \item{k}{Integer.} 19 | 20 | \item{max_lags}{Integer.} 21 | } 22 | \description{ 23 | Compute values for 'AICc', 'AIC', or 'BIC'. 24 | 25 | Schwarz, Gideon E. (1978). "Estimating the dimension of a model", \emph{Annals of Statistics}, 6 (2): 461–464. 26 | } 27 | \references{ 28 | Akaike, H. (1974). "A new look at the statistical model identification", \emph{IEEE Transactions on Automatic Control}, 19 (6): 716–723. 29 | } 30 | \keyword{internal} 31 | -------------------------------------------------------------------------------- /R/get_robust_vcxt_panel.R: -------------------------------------------------------------------------------- 1 | #' @name get_robust_vcxt_panel 2 | #' @title Create and returns a function to estimate hc and clustered standard errors for panel data. 3 | #' @param func_name A character. 4 | #' 5 | #' @return A function. 6 | #' @export 7 | #' @keywords internal 8 | #' @references 9 | #' 10 | #' Croissant, Y., Millo, G. (2017). "Robust Standard Error Estimators for Panel Models: A Unifying Approach." \emph{Journal of Statistical Software}, 27(2), 1-43. 11 | #' \doi{10.18637/jss.v082.i03}. 12 | #' 13 | get_robust_vcxt_panel <- function(func_name){ 14 | 15 | Vw <- function(x) vcovHC(x, method = "white1") 16 | Vcx <- function(x) vcovHC(x, cluster = "group", method = "arellano") 17 | Vct <- function(x) vcovHC(x, cluster = "time", method = "arellano") 18 | Vcxt <- function(x) Vcx(x) + Vct(x) - Vw(x) 19 | 20 | return(get(func_name)) 21 | 22 | } 23 | 24 | 25 | 26 | 27 | -------------------------------------------------------------------------------- /R/create_lags.R: -------------------------------------------------------------------------------- 1 | #' @name create_lags 2 | #' @title Compute a data frame with lagged exogenous variables 3 | #' @description Create a \link{data.frame}() with lagged exogenous variables. 4 | #' @param data A \link{data.frame}(). 5 | #' @param lags Integer for the number of lags. 6 | #' @return Returns a \link{data.frame} with lagged values. 7 | #' @import dplyr 8 | #' @keywords internal 9 | #' @author Philipp Adämmer 10 | 11 | create_lags <- function(data, lags){ 12 | 13 | # Loop to construct lagged data 14 | for (i in 1:lags){ 15 | 16 | lags_column <- data %>% 17 | dplyr::mutate_all(list(~dplyr::lag(., i))) %>% 18 | dplyr::rename_all(list(~paste0(.,"_", "lag_", i))) 19 | 20 | if(i == 1){ 21 | 22 | lag_data <- lags_column 23 | 24 | } else { 25 | 26 | lag_data <- cbind(lag_data, lags_column) 27 | } 28 | } 29 | 30 | # Delete NAs 31 | lag_data <- lag_data 32 | 33 | return(lag_data) 34 | } 35 | -------------------------------------------------------------------------------- /man/var_one.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RcppExports.R 3 | \name{var_one} 4 | \alias{var_one} 5 | \title{Compute VAR to prewhite estimating functions for Newey West estimator.} 6 | \usage{ 7 | var_one(VAR_Data) 8 | } 9 | \arguments{ 10 | \item{VAR_Data}{Matrix.} 11 | } 12 | \value{ 13 | A list. The first element contains the slope parameters of the VAR(1), the sedond element contains 14 | the residuals and the third element the inverted slope parameter matrix. 15 | } 16 | \description{ 17 | Compute Newey-West estimator with prewhitened estimation functions. 18 | } 19 | \references{ 20 | Andrews, D.W. and Monahan, J.C. (1992). An improved heteroskedasticity and 21 | autocorrelation consistent covariance matrix estimator. \emph{Econometrica}, pp.953-966. 22 | 23 | Newey, W.K., and West, K.D. (1987). “A Simple, Positive-Definite, Heteroskedasticity and 24 | Autocorrelation Consistent Covariance Matrix.” \emph{Econometrica}, 55, 703–708. 25 | } 26 | \keyword{internal} 27 | -------------------------------------------------------------------------------- /man/newey_west.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RcppExports.R 3 | \name{newey_west} 4 | \alias{newey_west} 5 | \title{Compute OLS parameters and robust standard errors based on Newey-West estimator} 6 | \usage{ 7 | newey_west(y, x, h) 8 | } 9 | \arguments{ 10 | \item{y}{Numeric vector.} 11 | 12 | \item{x}{Numeric matrix.} 13 | 14 | \item{h}{Integer.} 15 | } 16 | \value{ 17 | A list. The first element contains the estimated OLS parameters, the second element 18 | the Newey West covariance matrix, the third element the estimated functions, the fourth element 19 | the unscaled covariance matrix and the last element the meat estimator. 20 | } 21 | \description{ 22 | Compute OLS parameters and robust standard errors based on Newey and West (1987). 23 | The function is based on the Matlab code by James P. LeSage. 24 | } 25 | \references{ 26 | Newey, W.K., and West, K.D. (1987). “A Simple, Positive-Definite, Heteroskedasticity and 27 | Autocorrelation Consistent Covariance Matrix.” \emph{Econometrica}, 55, 703–708. 28 | } 29 | \keyword{internal} 30 | -------------------------------------------------------------------------------- /man/newey_west_pw.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RcppExports.R 3 | \name{newey_west_pw} 4 | \alias{newey_west_pw} 5 | \title{Compute Newey-West estimator with prewhitened estimation functions} 6 | \usage{ 7 | newey_west_pw(hhat_mat, xpxi_mat, D_mat, h) 8 | } 9 | \arguments{ 10 | \item{hhat_mat}{Matrix.} 11 | 12 | \item{xpxi_mat}{Matrix.} 13 | 14 | \item{D_mat}{Matrix.} 15 | 16 | \item{h}{integer.} 17 | } 18 | \value{ 19 | A list. The first element contains the pre-whitened Newey West covariance matrix. 20 | } 21 | \description{ 22 | Compute Newey-West estimator with prewhitened estimation functions. 23 | The function is based on the Matlab code by James P. LeSage. 24 | } 25 | \references{ 26 | Andrews, D.W. and Monahan, J.C. (1992). An improved heteroskedasticity and 27 | autocorrelation consistent covariance matrix estimator. \emph{Econometrica}, pp.953-966. 28 | 29 | Newey, W.K., and West, K.D. (1987). “A Simple, Positive-Definite, Heteroskedasticity and 30 | Autocorrelation Consistent Covariance Matrix.” \emph{Econometrica}, 55, 703–708. 31 | } 32 | \keyword{internal} 33 | -------------------------------------------------------------------------------- /man/interest_rules_var_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data-documentation.R 3 | \docType{data} 4 | \name{interest_rules_var_data} 5 | \alias{interest_rules_var_data} 6 | \title{Data to estimate the effects of interest rate rules for monetary policy} 7 | \format{ 8 | A tibble with 193 quarterly observations (rows) and 3 variables (columns): 9 | \describe{ 10 | \item{GDP_gap}{Percentage difference between real GDP and potential GDP (Congressional Budget Office).} 11 | \item{Infl}{Inflation: Percentage change in the GDP, chain weighted price index at annual rate.} 12 | \item{FF}{Federal funds rate: quarterly average of daily rates.} 13 | } 14 | Sample: 1955:I - 2003:I 15 | } 16 | \source{ 17 | \url{https://www.aeaweb.org/articles?id=10.1257/0002828053828518} 18 | } 19 | \usage{ 20 | interest_rules_var_data 21 | } 22 | \description{ 23 | A tibble, containing data to estimate the effects of interest rate rules for monetary policy. 24 | The data are used by Jordà (2005). 25 | } 26 | \references{ 27 | Jordà, Ò. (2005) "Estimation and Inference of Impulse Responses by Local Projections." 28 | \emph{American Economic Review}, 95 (1): 161-182. 29 | } 30 | \keyword{datasets} 31 | -------------------------------------------------------------------------------- /man/get_var_lagcrit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_var_lagcrit.R 3 | \name{get_var_lagcrit} 4 | \alias{get_var_lagcrit} 5 | \title{Computes AICc, AIC and BIC for VAR} 6 | \usage{ 7 | get_var_lagcrit(endog_data, specs = NULL) 8 | } 9 | \arguments{ 10 | \item{endog_data}{A \link{data.frame} with endogenous variables for the VAR} 11 | 12 | \item{specs}{A \link{list} created in \link{lp_lin}} 13 | } 14 | \value{ 15 | A list with lag length criteria 16 | } 17 | \description{ 18 | Computes AICc, AIC and BIC for VAR models. 19 | } 20 | \references{ 21 | Akaike, H. (1974). "A new look at the statistical model identification", 22 | \emph{IEEE Transactions on Automatic Control}, 19 (6): 716–723. 23 | 24 | Hamilton, J. D. (1994). "Time Series Analysis." 25 | Princeton: Princeton University Press. 26 | 27 | Hurvich, C. M., and Tsai, C.-L. (1989), "Regression and time series model selection in small samples", 28 | \emph{Biometrika}, 76(2): 297–307 29 | 30 | Lütkepohl, H. (2005). "New Introduction to Multiple Time Series Analysis.", 31 | New York: Springer. 32 | 33 | Schwarz, Gideon E. (1978). "Estimating the dimension of a model", 34 | \emph{Annals of Statistics}, 6 (2): 461–464. 35 | } 36 | \keyword{internal} 37 | -------------------------------------------------------------------------------- /tests/testthat/test-hp_filter.R: -------------------------------------------------------------------------------- 1 | 2 | # Load data 3 | data_set_df <- interest_rules_var_data 4 | 5 | # R function from mFilter package 6 | hp_filter_r <- function(x, lambda){ 7 | 8 | x = as.matrix(x) 9 | 10 | n = length(x) 11 | imat = diag(n) 12 | Ln = rbind(matrix(0, 1, n), diag(1, n - 1, n)) 13 | Ln = (imat - Ln) %*% (imat - Ln) 14 | Q = t(Ln[3:n, ]) 15 | SIGMA.R = t(Q) %*% Q 16 | SIGMA.n = diag(n - 2) 17 | g = t(Q) %*% as.matrix(x) 18 | b = solve(SIGMA.n + lambda * SIGMA.R, g) 19 | x.cycle = c(lambda * Q %*% b) 20 | x.trend = x - x.cycle 21 | 22 | 23 | A = lambda * Q %*% solve(SIGMA.n + lambda * SIGMA.R) %*% t(Q) 24 | 25 | ret_results <- list(cycle = x.cycle, trend = x.trend) 26 | return(ret_results) 27 | } 28 | 29 | 30 | test_that("Test whether value hp-function is identical to function from mFilter package", { 31 | 32 | 33 | x <- as.matrix(rnorm(100)) 34 | results_r <- hp_filter_r(x, 1600) 35 | results_c <- hp_filter(x, 1600) 36 | 37 | testthat::expect_equal(as.matrix(results_r$cycle), results_c[[1]], tolerance = .001) 38 | testthat::expect_equal(as.matrix(results_r$trend), results_c[[2]], tolerance = .001) 39 | }) 40 | 41 | 42 | -------------------------------------------------------------------------------- /man/monetary_var_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data-documentation.R 3 | \docType{data} 4 | \name{monetary_var_data} 5 | \alias{monetary_var_data} 6 | \title{Data to estimate a standard monetary VAR} 7 | \format{ 8 | A tibble with 494 monthly observations (rows) and 6 variables (columns): 9 | \describe{ 10 | \item{EM}{Log of non-agricultural payroll employment.} 11 | \item{P}{Log of personal consumption expenditures deflator (1996 = 100).} 12 | \item{POCM}{Annual growth rate of the index of sensitive materials 13 | prices issued by the Conference Board.} 14 | \item{FF}{Federal funds rate.} 15 | \item{NBRX}{Ratio of nonborrowed reserves plus extended credit to total reserves.} 16 | \item{M2}{Annual growth rate of M2 stock.} 17 | 18 | } 19 | Sample: 1960:01 - 2001:02. 20 | } 21 | \source{ 22 | \url{https://www.aeaweb.org/articles?id=10.1257/0002828053828518} 23 | } 24 | \usage{ 25 | monetary_var_data 26 | } 27 | \description{ 28 | A tibble, containing data to estimate a standard monetary VAR. 29 | } 30 | \references{ 31 | Jordà, Ò. (2005) "Estimation and Inference of Impulse Responses by Local Projections." 32 | \emph{American Economic Review}, 95 (1): 161-182. 33 | } 34 | \keyword{datasets} 35 | -------------------------------------------------------------------------------- /man/get_vals_switching.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_vals_switching.R 3 | \name{get_vals_switching} 4 | \alias{get_vals_switching} 5 | \title{Compute values of transition function to separate regimes} 6 | \usage{ 7 | get_vals_switching(data_set, specs) 8 | } 9 | \arguments{ 10 | \item{data_set}{A numeric vector or a panel data set, depending on the model to estimate.} 11 | 12 | \item{specs}{A \link{list} with inputs as in \link{lp_nl}().} 13 | } 14 | \value{ 15 | \item{fz}{A numeric vector with values from the smooth transition function \eqn{F(z_{t-1})}.} 16 | } 17 | \description{ 18 | Computes transition values by using a smooth transition function as 19 | used in Auerbach and Gorodnichenko (2012). The time series used in the transition function 20 | can be detrended via the Hodrick-Prescott filter (see Auerbach and Gorodnichenko, 2013). 21 | } 22 | \references{ 23 | Auerbach, A. J., and Gorodnichenko Y. (2012). "Measuring the Output Responses to Fiscal Policy." 24 | \emph{American Economic Journal: Economic Policy}, 4 (2): 1-27. 25 | 26 | Auerbach, A. J., and Gorodnichenko Y. (2013). "Fiscal Multipliers in Recession and Expansion." 27 | \emph{NBER Working Paper Series}. Nr 17447. 28 | } 29 | \author{ 30 | Philipp Adämmer 31 | } 32 | \keyword{internal} 33 | -------------------------------------------------------------------------------- /man/newey_west_tsls.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RcppExports.R 3 | \name{newey_west_tsls} 4 | \alias{newey_west_tsls} 5 | \title{Compute 2SLS parameters and robust standard errors based on Newey-West} 6 | \usage{ 7 | newey_west_tsls(y, x, z, h) 8 | } 9 | \arguments{ 10 | \item{y}{Numeric vector.} 11 | 12 | \item{x}{Numeric matrix.} 13 | 14 | \item{z}{Numeric matrix.} 15 | 16 | \item{h}{Integer.} 17 | } 18 | \value{ 19 | A list. The first element contains the estimated 2SLS parameters and the second element 20 | the 2SLS-Newey-West covariance matrix of these parameters. The third element contains the estimated functions, the fourth element 21 | the unscaled covariance matrix, the fifth element the meat estimator and the last element the ordinary covariance matrix of the 22 | point estimates. 23 | } 24 | \description{ 25 | Compute 2SLS parameters and robust standard errors based on Newey and West (1987). 26 | Part of the function is based on the Matlab code by James P. LeSage. 27 | } 28 | \references{ 29 | Newey, W.K., and West, K.D. (1987). “A Simple, Positive-Definite, Heteroskedasticity and 30 | Autocorrelation Consistent Covariance Matrix.” \emph{Econometrica}, 55, 703–708. 31 | Wooldridge, J.M. (2002), Econometric Analysis of Cross Section and Panel Data, The MIT Press. 32 | } 33 | \keyword{internal} 34 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ${{ matrix.config.os }} 14 | 15 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 16 | 17 | strategy: 18 | fail-fast: false 19 | matrix: 20 | config: 21 | - {os: macOS-latest, r: 'release'} 22 | - {os: windows-latest, r: 'release'} 23 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 24 | - {os: ubuntu-latest, r: 'release'} 25 | - {os: ubuntu-latest, r: 'oldrel-1'} 26 | 27 | env: 28 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 29 | R_KEEP_PKG_SOURCE: yes 30 | 31 | steps: 32 | - uses: actions/checkout@v2 33 | 34 | - uses: r-lib/actions/setup-pandoc@v1 35 | 36 | - uses: r-lib/actions/setup-r@v1 37 | with: 38 | r-version: ${{ matrix.config.r }} 39 | http-user-agent: ${{ matrix.config.http-user-agent }} 40 | use-public-rspm: true 41 | 42 | - uses: r-lib/actions/setup-r-dependencies@v1 43 | with: 44 | extra-packages: rcmdcheck 45 | 46 | - uses: r-lib/actions/check-r-package@v1 47 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(plot,lpirfs_lin_iv_obj) 4 | S3method(plot,lpirfs_lin_obj) 5 | S3method(plot,lpirfs_lin_panel_obj) 6 | S3method(plot,lpirfs_nl_iv_obj) 7 | S3method(plot,lpirfs_nl_obj) 8 | S3method(plot,lpirfs_nl_panel_obj) 9 | S3method(summary,lpirfs_lin_iv_obj) 10 | S3method(summary,lpirfs_lin_obj) 11 | S3method(summary,lpirfs_lin_panel_obj) 12 | S3method(summary,lpirfs_nl_iv_obj) 13 | S3method(summary,lpirfs_nl_obj) 14 | S3method(summary,lpirfs_nl_panel_obj) 15 | export(get_robust_cov_panel) 16 | export(get_robust_vcxt_panel) 17 | export(lp_lin) 18 | export(lp_lin_iv) 19 | export(lp_lin_panel) 20 | export(lp_nl) 21 | export(lp_nl_iv) 22 | export(lp_nl_panel) 23 | export(plot_lin) 24 | export(plot_nl) 25 | exportPattern("^[[:alpha:]]+") 26 | import(dplyr) 27 | import(foreach) 28 | import(ggplot2) 29 | importFrom(Rcpp,evalCpp) 30 | importFrom(dplyr,arrange) 31 | importFrom(dplyr,filter) 32 | importFrom(dplyr,lag) 33 | importFrom(dplyr,lead) 34 | importFrom(foreach,foreach) 35 | importFrom(ggplot2,ggplotGrob) 36 | importFrom(graphics,plot) 37 | importFrom(gridExtra,marrangeGrob) 38 | importFrom(lmtest,coeftest) 39 | importFrom(plm,plm) 40 | importFrom(plm,vcovBK) 41 | importFrom(plm,vcovDC) 42 | importFrom(plm,vcovG) 43 | importFrom(plm,vcovHC) 44 | importFrom(plm,vcovNW) 45 | importFrom(plm,vcovSCC) 46 | importFrom(sandwich,vcovHC) 47 | importFrom(stats,na.omit) 48 | importFrom(stats,pf) 49 | importFrom(stats,variable.names) 50 | useDynLib(lpirfs, .registration = TRUE) 51 | -------------------------------------------------------------------------------- /man/ols_diagnost.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RcppExports.R 3 | \name{ols_diagnost} 4 | \alias{ols_diagnost} 5 | \title{Compute diagnostics for OLS models} 6 | \usage{ 7 | ols_diagnost(y, x) 8 | } 9 | \arguments{ 10 | \item{y}{Numeric vector.} 11 | 12 | \item{x}{Numeric matrix.} 13 | } 14 | \value{ 15 | A list: 16 | 17 | \item{beta}{Point estimates of OLS regression.} 18 | 19 | \item{beta_cov}{Covariance matrix of point estimates.} 20 | 21 | \item{R^2}{The R^2 statistic from OLS regression. } 22 | 23 | \item{Adj.R^2}{The adjusted R^2 staistic from OLS regression.} 24 | 25 | \item{F-stat}{The computed F-statistic.} 26 | 27 | \item{df1}{First degress of freedom for F-statistic.} 28 | 29 | \item{df2}{Second degrees of freedom for F-staitisc.} 30 | 31 | \item{AIC_c}{The AIC_c criterion by Hurvich and Tsai (1989)} 32 | 33 | \item{AIC}{The AIC criterion by Akaike (1974)} 34 | 35 | \item{BIC}{The BIC criterion by Schwarz and Gideon (1978)} 36 | } 37 | \description{ 38 | Compute OLS diagnostics such as R^2, adjusted R^2, AIC, etc. 39 | } 40 | \references{ 41 | Akaike, H. (1974). "A new look at the statistical model identification", \emph{IEEE Transactions on Automatic Control}, 19 (6): 716–723. 42 | 43 | Hurvich, C. M., and Tsai, C.-L. (1989). "Regression and time series model selection 44 | in small samples", Biometrika, 76(2): 297–307, 45 | 46 | Schwarz, G.(1978). "Estimating the dimension of a model", \emph{Annals of Statistics}, 6 (2): 461–464. 47 | } 48 | \keyword{internal} 49 | -------------------------------------------------------------------------------- /man/ag_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data-documentation.R 3 | \docType{data} 4 | \name{ag_data} 5 | \alias{ag_data} 6 | \title{Data to estimate fiscal multipliers} 7 | \format{ 8 | A tibble with 248 quarterly observations (rows) and 7 variables (columns): 9 | \describe{ 10 | \item{Year}{Year of observation.} 11 | \item{Quarter}{Quarter of observation.} 12 | \item{Gov}{Logs of real government (federal, state, and local) purchases (consumption and investment).} 13 | \item{Tax}{Logs of real government receipts of direct and indirect taxes net of transfers to businesses 14 | and individuals.} 15 | \item{GDP}{Logs of real gross domestic product.} 16 | \item{GDP_MA}{7-quarter moving average growth rate of GDP.} 17 | \item{Gov_shock_mean}{Identified government spending shock. For details see Supplementary Appendix of Ramey and Zubairy (2018).} 18 | } 19 | Sample: 1948:IV - 2008:IV 20 | } 21 | \source{ 22 | \doi{10.1086/696277} 23 | } 24 | \usage{ 25 | ag_data 26 | } 27 | \description{ 28 | A tibble, containing data to estimate fiscal multipliers. 29 | This data was originally used by Auerbach and Gorodnichenko (2012). 30 | Sarah and Zubairy (2018) use this data to re-evaluate their results with local projections. 31 | } 32 | \references{ 33 | Auerbach, A. J., and Gorodnichenko Y. (2012). "Measuring the Output Responses to Fiscal Policy." 34 | \emph{American Economic Journal: Economic Policy}, 4 (2): 1-27. 35 | 36 | Jordà, Ò. (2005) "Estimation and Inference of Impulse Responses by Local Projections." 37 | \emph{American Economic Review}, 95 (1): 161-182. 38 | 39 | Ramey, V.A., Zubairy, S. (2018). "Government Spending Multipliers in Good Times 40 | and in Bad: Evidence from US Historical Data." \emph{Journal of Political Economy}, 41 | 126(2): 850 - 901. 42 | } 43 | \keyword{datasets} 44 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: lpirfs 2 | Type: Package 3 | Title: Local Projections Impulse Response Functions 4 | Version: 0.2.5.9000 5 | Authors@R: c( 6 | person("Philipp", "Adämmer", 7 | email = "philipp.adaemmer@uni-greifswald.de", 8 | role = c("aut", "cre"), 9 | comment = c(ORCID = "0000-0003-3770-0097")), 10 | person("James P.", "LeSage", 11 | email = "jlesage@spatial-econometrics.com", 12 | role = c("ctb")), 13 | person("Mehmet", "Balcilar", 14 | email = "mbalcilar@yahoo.com", 15 | role = c("ctb")), 16 | person("Jon", "Danielsson", 17 | email = "j.danielsson@lse.ac.uk", 18 | role = c("ctb"))) 19 | Maintainer: Philipp Adämmer 20 | BugReports: https://github.com/adaemmerp/lpirfs/issues 21 | Description: Provides functions to estimate and visualize linear as well as nonlinear impulse 22 | responses based on local projections by Jordà (2005) . 23 | The methods and the package are explained in detail in Adämmer (2019) . 24 | License: GPL (>= 2) 25 | Depends: R (>= 3.1.2) 26 | Encoding: UTF-8 27 | LazyData: true 28 | NeedsCompilation: yes 29 | Imports: 30 | doParallel(>= 1.0.15), 31 | dplyr(>= 1.0.0), 32 | foreach(>= 1.5.0), 33 | ggplot2(>= 3.3.0), 34 | gridExtra(>= 2.3), 35 | lmtest(>= 0.9-36), 36 | plm(>= 2.2-3), 37 | sandwich(>= 2.5-1), 38 | Rcpp(>= 1.0.4.6) 39 | RoxygenNote: 7.3.1 40 | LinkingTo: Rcpp, RcppArmadillo, RcppEigen 41 | Suggests: 42 | testthat (>= 3.0.0), 43 | AER(>= 1.2-12), 44 | readxl, 45 | knitr, 46 | ggpubr, 47 | rmarkdown, 48 | zoo, 49 | vars 50 | VignetteBuilder: knitr 51 | Config/testthat/edition: 3 52 | -------------------------------------------------------------------------------- /src/var_one.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | //' @name var_one 4 | //' @title Compute VAR to prewhite estimating functions for Newey West estimator. 5 | //' @description Compute Newey-West estimator with prewhitened estimation functions. 6 | //' @param VAR_Data Matrix. 7 | //' @return A list. The first element contains the slope parameters of the VAR(1), the sedond element contains 8 | //' the residuals and the third element the inverted slope parameter matrix. 9 | //' @keywords internal 10 | //' @references 11 | //' 12 | //' Andrews, D.W. and Monahan, J.C. (1992). An improved heteroskedasticity and 13 | //' autocorrelation consistent covariance matrix estimator. \emph{Econometrica}, pp.953-966. 14 | //' 15 | //' Newey, W.K., and West, K.D. (1987). “A Simple, Positive-Definite, Heteroskedasticity and 16 | //' Autocorrelation Consistent Covariance Matrix.” \emph{Econometrica}, 55, 703–708. 17 | //' 18 | //' 19 | // [[Rcpp::export]] 20 | List var_one(NumericMatrix VAR_Data){ 21 | NumericMatrix V; 22 | arma::mat XY_Data, beta, beta_mat, mat_resids, yy, xx, xpxi, D_diag, D_mat; 23 | int nobs, num_exog; 24 | List ret(4); 25 | 26 | XY_Data = as(VAR_Data); 27 | nobs = XY_Data.n_rows - 1; 28 | num_exog = XY_Data.n_cols; 29 | D_diag = arma::eye(num_exog, num_exog); 30 | 31 | 32 | beta_mat = arma::zeros(num_exog, num_exog); 33 | mat_resids = arma::zeros(nobs, num_exog); 34 | 35 | // Make Matrix with lagged data 36 | xx = XY_Data.rows(0, (nobs - 1)); 37 | 38 | for (int i = 0; i < num_exog; ++i){ 39 | 40 | yy = XY_Data(arma::span(1, (nobs)), arma::span(i, i)); 41 | beta = inv(xx.t()*xx)*xx.t()*yy; 42 | beta_mat.row(i) = beta.t(); 43 | 44 | mat_resids.col(i) = yy - xx*beta; 45 | 46 | } 47 | 48 | D_mat = inv(D_diag - beta_mat); 49 | 50 | ret[0] = wrap(beta_mat); 51 | ret[1] = wrap(mat_resids); 52 | ret[2] = wrap(D_mat); 53 | return (ret); 54 | } 55 | 56 | -------------------------------------------------------------------------------- /man/hp_filter.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RcppExports.R 3 | \name{hp_filter} 4 | \alias{hp_filter} 5 | \title{Decompose a times series via the Hodrick-Prescott filter} 6 | \usage{ 7 | hp_filter(x, lambda) 8 | } 9 | \arguments{ 10 | \item{x}{One column matrix with numeric values.} 11 | 12 | \item{lambda}{Numeric value.} 13 | } 14 | \value{ 15 | A list. The first element contains the cyclical component and the second element the trend component. 16 | } 17 | \description{ 18 | Estimate cyclical and trend component with filter by Hodrick and Prescott (1997). 19 | The function is based on the function \emph{hpfilter} from the archived \emph{mFilter}-package. 20 | } 21 | \examples{ 22 | \donttest{ 23 | library(lpirfs) 24 | 25 | 26 | # Decompose the Federal Funds Rate 27 | data_set <- as.matrix(interest_rules_var_data$FF) 28 | hp_results <- hp_filter(data_set, 1600) 29 | 30 | # Extract results and save as data.frame 31 | hp_cyc <- as.data.frame(hp_results[[1]]) 32 | hp_trend <- as.data.frame(hp_results[[2]]) 33 | 34 | # Make data.frames for plots 35 | cyc_df <- data.frame(yy = hp_cyc$V1, xx = seq(as.Date('1955-01-01'), 36 | as.Date('2003-01-01') , "quarter")) 37 | trend_df <- data.frame(yy = hp_trend$V1, xx = seq(as.Date('1955-01-01'), 38 | as.Date('2003-01-01') , "quarter")) 39 | 40 | # Make plots 41 | library(ggplot2) 42 | 43 | # Plot cyclical part 44 | ggplot(data = cyc_df) + 45 | geom_line(aes(y = yy, x = xx)) 46 | 47 | # Plot trend component 48 | ggplot(trend_df) + 49 | geom_line(aes(y = yy, x = xx)) 50 | 51 | } 52 | } 53 | \references{ 54 | Hodrick, R.J., and Prescott, E. C. (1997). "Postwar U.S. Business Cycles: An Empirical Investigation." 55 | \emph{Journal of Money, Credit and Banking}, 29(1), 1-16. 56 | 57 | Ravn, M.O., Uhlig, H. (2002). "On Adjusting the Hodrick-Prescott Filter for the Frequency of Observations." 58 | \emph{Review of Economics and Statistics}, 84(2), 371-376. 59 | } 60 | \author{ 61 | Philipp Adämmer 62 | } 63 | -------------------------------------------------------------------------------- /R/get_robust_cov_panel.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | #' Function to get robust covariance matrix for panel data 4 | #' @name get_robust_cov_panel 5 | #' @param panel_results Plm object from estimation 6 | #' @param specs List with specifications 7 | #' @importFrom plm vcovBK vcovDC vcovG vcovHC vcovNW vcovSCC 8 | #' @return Object with robust covariance matrix 9 | #' @export 10 | #' 11 | 12 | get_robust_cov_panel <- function(panel_results, specs){ 13 | 14 | if(specs$robust_cov == "vcovBK"){ 15 | 16 | reg_results <- lmtest::coeftest(panel_results, vcov. = plm::vcovBK(panel_results, 17 | type = specs$robust_type, 18 | cluster = specs$robust_cluster)) 19 | 20 | } else if (specs$robust_cov == "vcovDC"){ 21 | 22 | reg_results <- lmtest::coeftest(panel_results, vcov. = plm::vcovDC(panel_results, 23 | type = specs$robust_type)) 24 | 25 | 26 | } else if (specs$robust_cov == "vcovHC"){ 27 | 28 | reg_results <- lmtest::coeftest(panel_results, vcov. = plm::vcovHC(panel_results, 29 | method = specs$robust_method, 30 | type = specs$robust_type, 31 | cluster = specs$robust_cluster)) 32 | 33 | } else if (specs$robust_cov == "vcovNW"){ 34 | 35 | reg_results <- lmtest::coeftest(panel_results, vcov. = plm::vcovNW(panel_results, 36 | type = specs$robust_type, 37 | maxlag = specs$robust_maxlag)) 38 | } else if (specs$robust_cov == "vcovSCC"){ 39 | 40 | reg_results <- lmtest::coeftest(panel_results, vcov. = plm::vcovSCC(panel_results, 41 | type = specs$robust_type, 42 | maxlag = specs$robust_maxlag)) 43 | 44 | } 45 | 46 | return(reg_results) 47 | 48 | } 49 | -------------------------------------------------------------------------------- /tests/testthat/test-plot_lin.R: -------------------------------------------------------------------------------- 1 | 2 | # Load data 3 | endog_data <- interest_rules_var_data 4 | 5 | # Specify inputs 6 | lags_endog_lin <- 4 7 | lags_criterion <- NaN 8 | max_lags <- NaN 9 | trend <- 0L 10 | shock_type <- 1L 11 | confint <- 1.96 12 | hor <- 12L 13 | 14 | 15 | 16 | test_that("Test whether list length is consistent number of endogenous variables 17 | for lin model",{ 18 | 19 | results_lin <- lp_lin(endog_data, 20 | lags_endog_lin = lags_endog_lin, 21 | lags_criterion = lags_criterion, 22 | exog_data = NULL, 23 | lags_exog = NULL, 24 | max_lags = max_lags, 25 | trend = trend, 26 | shock_type = shock_type, 27 | confint = confint, 28 | hor = hor, 29 | num_cores = 1) 30 | 31 | plots_lin <- plot_lin(results_lin) 32 | num_plots <- ncol(endog_data)*ncol(endog_data) 33 | 34 | 35 | expect_equal(length(plots_lin), num_plots) 36 | }) 37 | 38 | 39 | 40 | # Load package data 41 | ag_data <- ag_data 42 | sample_start <- 7 43 | sample_end <- dim(ag_data)[1] 44 | 45 | # Endogenous data 46 | endog_data <- ag_data[sample_start:sample_end,3:5] 47 | 48 | # 'Instrument' variable 49 | instrument <- as.data.frame(ag_data$Gov[sample_start:sample_end]) 50 | 51 | 52 | test_that("Test whether list length is consistent number of endogenous variables 53 | for lin_iv model", { 54 | 55 | results_lin_iv <- lp_lin_iv(endog_data, 56 | shock = instrument, 57 | lags_endog_lin = 4, 58 | exog_data = NULL, 59 | lags_exog = NULL, 60 | contemp_data = NULL, 61 | lags_criterion = NaN, 62 | max_lags = NaN, 63 | trend = 0, 64 | confint = 1.96, 65 | hor = 20, 66 | num_cores = 1) 67 | 68 | plots_lin_iv <- plot_lin(results_lin_iv) 69 | num_plots_iv <- 1*ncol(endog_data) 70 | 71 | expect_equal(length(plots_lin_iv), num_plots_iv) 72 | 73 | }) 74 | 75 | -------------------------------------------------------------------------------- /src/get_vals_lagcrit.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | //' @name get_vals_lagcrit 4 | //' @title Compute values for lag length criteria 5 | //' @description Compute values for 'AICc', 'AIC', or 'BIC'. 6 | //' 7 | //' @param y List with left (endogenous) variables. 8 | //' @param x List with right (exogenous) variables. 9 | //' @param lag_crit Integer: 'AICc'= 1, 'AIC' = 2, 'BIC' = 3. 10 | //' @param h Integer. 11 | //' @param k Integer. 12 | //' @param max_lags Integer. 13 | //' @references 14 | //' 15 | //' Akaike, H. (1974). "A new look at the statistical model identification", \emph{IEEE Transactions on Automatic Control}, 19 (6): 716–723. 16 | 17 | //' Hurvich, C. M., and Tsai, C.-L. (1989). "Regression and time series model selection 18 | //' in small samples", Biometrika, 76(2): 297–307, 19 | //' 20 | //' Schwarz, Gideon E. (1978). "Estimating the dimension of a model", \emph{Annals of Statistics}, 6 (2): 461–464. 21 | //' 22 | //' @keywords internal 23 | // [[Rcpp::export]] 24 | NumericVector get_vals_lagcrit(List y, List x, int lag_crit, int h, int k, int max_lags, 25 | int n_obs){ 26 | 27 | arma::mat xx, xx_one, yy, xpxi, emat, hhat; 28 | arma::vec w1, beta, resids, resids_sq; 29 | int rstart_y, rend_y, rend_x; 30 | double ssr, var_eps, ll, tp, n; 31 | double pi = 3.141593; 32 | NumericVector crit_val(max_lags); 33 | 34 | n = n_obs; 35 | 36 | for (int i = 0; i < max_lags; i++){ 37 | 38 | yy = as(y[i]); 39 | yy = yy.col(k - 1); 40 | rstart_y = h - 1; 41 | rend_y = yy.n_rows - 1; 42 | yy = yy.rows(rstart_y, rend_y); 43 | 44 | 45 | xx = as(x[i]); 46 | xx_one = arma::ones(xx.n_rows, 1); 47 | xx.insert_cols(0, xx_one); 48 | rend_x = rend_y - h + 1; 49 | xx = xx.rows(0, rend_x); 50 | 51 | 52 | tp = xx.n_cols + 1; // Number of parameters to estimate 53 | xpxi = inv(xx.t()*xx); 54 | beta = xpxi*xx.t()*yy; 55 | resids = yy - xx*beta; 56 | resids_sq = resids%resids; 57 | ssr = sum(resids_sq); 58 | var_eps = ssr/n; 59 | 60 | // Estimate log-likelihood 61 | ll = - n/2*log(2*pi) - n/2*log(var_eps) - ssr/(2*var_eps); 62 | 63 | if (lag_crit == 1){ 64 | 65 | crit_val[i] = (-2*ll + 2*tp) + (2*pow(tp,2) + 2*tp)/(n-tp-1); 66 | 67 | } else if(lag_crit == 2) { 68 | 69 | crit_val[i] = -2*ll + 2*tp ; 70 | 71 | } else if(lag_crit == 3){ 72 | 73 | crit_val[i] = -2*ll + log(n)*tp; 74 | } 75 | 76 | } 77 | 78 | return(crit_val); 79 | 80 | } 81 | -------------------------------------------------------------------------------- /src/newey_west_pw.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | //' @name newey_west_pw 4 | //' @title Compute Newey-West estimator with prewhitened estimation functions 5 | //' @description Compute Newey-West estimator with prewhitened estimation functions. 6 | //' The function is based on the Matlab code by James P. LeSage. 7 | //' @param hhat_mat Matrix. 8 | //' @param xpxi_mat Matrix. 9 | //' @param D_mat Matrix. 10 | //' @param h integer. 11 | //' @return A list. The first element contains the pre-whitened Newey West covariance matrix. 12 | //' @keywords internal 13 | //' @references 14 | //' 15 | //' Andrews, D.W. and Monahan, J.C. (1992). An improved heteroskedasticity and 16 | //' autocorrelation consistent covariance matrix estimator. \emph{Econometrica}, pp.953-966. 17 | //' 18 | //' Newey, W.K., and West, K.D. (1987). “A Simple, Positive-Definite, Heteroskedasticity and 19 | //' Autocorrelation Consistent Covariance Matrix.” \emph{Econometrica}, 55, 703–708. 20 | //' 21 | //' 22 | // [[Rcpp::export]] 23 | List newey_west_pw(NumericMatrix hhat_mat, NumericMatrix xpxi_mat, NumericMatrix D_mat, int h){ 24 | 25 | // Define classes 26 | NumericMatrix V; 27 | arma::mat G, M, M1, M2, ga, g1, za, hhat, D, xpxi, utu; 28 | arma::vec w1; 29 | int nrow_hhat, a, nobs, num_exog, nlag; 30 | double w; 31 | List ret(1); 32 | 33 | 34 | hhat = as(hhat_mat); 35 | xpxi = as(xpxi_mat); 36 | D = as(D_mat); 37 | num_exog = hhat.n_cols; 38 | nobs = hhat.n_rows; 39 | hhat = hhat.t(); 40 | 41 | nlag = h; 42 | G = arma::zeros(num_exog, num_exog); 43 | a = 0; 44 | 45 | 46 | // Loop to weight meat matrix 47 | for (int i = 0; i < nlag + 1; ++i){ 48 | 49 | ga = arma::zeros(num_exog, num_exog); 50 | w = 1 - i/double(nlag + 1); 51 | M = hhat; 52 | nrow_hhat = M.n_rows; 53 | M1 = M(arma::span(0, nrow_hhat - 1), arma::span(a, nobs - 1)); 54 | M2 = M(arma::span(0, nrow_hhat - 1), arma::span(0, nobs - 1 - a)); 55 | M2 = M2.t(); 56 | za = M1*M2; 57 | 58 | if (a == 0){ 59 | 60 | ga = ga + za; 61 | 62 | } else { 63 | 64 | ga = ga + za + za.t(); 65 | 66 | } 67 | 68 | G = G + w*ga; 69 | 70 | a = a + 1; 71 | 72 | 73 | } 74 | 75 | 76 | G = D*G*D.t(); 77 | 78 | V = wrap(xpxi*G*xpxi); 79 | 80 | ret[0] = V; 81 | return (ret); 82 | 83 | } 84 | 85 | -------------------------------------------------------------------------------- /R/get_std_err_tsls.R: -------------------------------------------------------------------------------- 1 | #' @name get_std_err_tsls 2 | #' @title Compute standard errors for 2SLS 3 | #' @description Compute 2SLS standard errors.#' 4 | #' @param yy A matrix with all endogenous variables. 5 | #' @param xx A matrix with lagged endogenous variables. 6 | #' @param k Integer. Value of column to choose from 7 | #' @param lag_nw Integer. Number of lags for Newey and West 8 | #' @param specs A list with specifications from \link{lp_lin} or \link{lp_nl}. 9 | #' @return List. First element contains the estimated standard errors, the second element contains the OLS point estimates. 10 | #' @keywords internal 11 | #' @author Philipp Adämmer 12 | 13 | 14 | get_std_err_tsls <- function(yy, xx, lag_nw, k, zz, specs){ 15 | 16 | 17 | if(!is.matrix(yy)){ 18 | yy <- matrix(yy) 19 | } 20 | 21 | # Newey West standard errors 22 | if(isTRUE(specs$use_nw)){ 23 | 24 | # Check whether prewhitening shall be applied 25 | if(isTRUE(specs$nw_prewhite)){ 26 | 27 | # Estimate coefficients 28 | nw_results <- lpirfs::newey_west_tsls(yy[, k], xx, zz, lag_nw) 29 | b <- nw_results[[1]] 30 | 31 | x_u <- nw_results[[3]] 32 | xpxi <- nw_results[[4]] 33 | 34 | resid_pw <- var_one(x_u)[[2]] 35 | D_mat <- var_one(x_u)[[3]] 36 | 37 | cov_nw_pw <- newey_west_pw(resid_pw, xpxi, D_mat, 1)[[1]] 38 | 39 | # Make finite sample adjustment? 40 | if(isTRUE(specs$adjust_se)) cov_nw_pw <- cov_nw_pw*nrow(yy)/(nrow(yy) - ncol(xx) - 1) 41 | 42 | # Get standard errors 43 | std_err <- sqrt(diag(cov_nw_pw))*specs$confint 44 | 45 | 46 | } else { 47 | 48 | # 49 | nw_results <- lpirfs::newey_west_tsls(yy[, k], xx, zz, lag_nw) 50 | b <- nw_results[[1]] 51 | cov_mat <- nw_results[[2]] 52 | 53 | # Make finite sample adjustment 54 | if(isTRUE(specs$adjust_se)) cov_mat <- cov_mat*nrow(yy)/(nrow(yy) - ncol(xx) - 1) 55 | 56 | # Get NW standard errors 57 | std_err <- sqrt(diag(cov_mat))*specs$confint 58 | 59 | 60 | } 61 | 62 | # Normal standard errors 63 | } else { 64 | 65 | ols_output <- lpirfs::newey_west_tsls(yy[, k], xx, zz, lag_nw) 66 | 67 | 68 | # Get parameters and normal standard errors 69 | b <- ols_output[[1]] 70 | beta_cov <- ols_output[[6]] 71 | 72 | 73 | # Finite sample adjustment? 74 | if(isTRUE(specs$adjust_se)) beta_cov <- beta_cov*nrow(yy)/(nrow(yy) - ncol(xx) - 1) 75 | 76 | std_err <- sqrt(diag(beta_cov)) * specs$confint 77 | 78 | } 79 | 80 | return(list(std_err, b)) 81 | 82 | 83 | } 84 | -------------------------------------------------------------------------------- /tests/testthat/test-newey_west.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("Test whether results from newey_west_cpp function coincide 3 | with NeweyWest from sandwich package", { 4 | 5 | # Newey West without prewhitening 6 | x <- matrix(rnorm(500), 100, 5) 7 | y <- matrix(rnorm(100)) 8 | nlag <- round(runif(1, 0, 10)) 9 | 10 | 11 | lm_obj <- lm(y ~ x) 12 | 13 | # Newey West from sandwich 14 | nw_sandwich <- sandwich::NeweyWest(lm_obj, prewhite = F, lag = nlag) 15 | 16 | # Newey West from lpirfs 17 | nw_lpirfs <- newey_west(y, x, nlag)[[2]] 18 | 19 | testthat::expect_equal(nw_sandwich, nw_lpirfs, tolerance=1e-10, ignore_attr = T) 20 | 21 | } ) 22 | 23 | 24 | test_that("Test whether prewhitening results coincide with results from sandwich package", { 25 | 26 | # Newey West without prewhitening 27 | x <- matrix(rnorm(500), 100, 5) 28 | y <- matrix(rnorm(100)) 29 | nlag <- round(runif(1, 0, 10)) 30 | 31 | 32 | lm_obj <- lm(y ~ x) 33 | 34 | # Newey West from sandwich 35 | nw_sandwich <- sandwich::NeweyWest(lm_obj, prewhite = T, lag = nlag) 36 | 37 | # lpirfs pre whitening 38 | nw_results_pre <- newey_west(y, x, nlag) 39 | x_u <- nw_results_pre[[3]] 40 | xpxi <- nw_results_pre[[4]] 41 | 42 | resid_pw <- var_one(x_u)[[2]] 43 | D_mat <- var_one(x_u)[[3]] 44 | 45 | nw_lpirfs <- newey_west_pw(resid_pw, xpxi, D_mat, nlag)[[1]] 46 | 47 | testthat::expect_equal(nw_sandwich, nw_lpirfs, tolerance=1e-10, ignore_attr = T) 48 | 49 | } ) 50 | 51 | 52 | test_that("Test whether Newey-West 2SLS cov coincides with sandwich and AER package", { 53 | 54 | # Set seed for reproducibility 55 | set.seed(123) 56 | 57 | x <- matrix(rnorm(100), 100, 1) 58 | z <- matrix(rnorm(100), 100, 1) 59 | y <- matrix(rnorm(100)) 60 | 61 | # Step 2: 2SLS Estimation using ivreg from AER package 62 | model_ivreg <- AER::ivreg(y ~ x | z) 63 | 64 | # Step 3: Compute Newey-West Standard Errors 65 | vcov_nw_2sls = summary(model_ivreg, vcov = sandwich::NeweyWest(model_ivreg, 66 | lag = 1, 67 | prewhite = FALSE, 68 | adjust = F), 69 | df = Inf, 70 | diagnostics = TRUE)$vcov 71 | testthat::expect_equal(newey_west_tsls(y, x, z, 1)[[2]], unname(vcov_nw_2sls), tolerance=1e-10) 72 | 73 | } ) 74 | 75 | -------------------------------------------------------------------------------- /R/get_std_err.R: -------------------------------------------------------------------------------- 1 | #' @name get_std_err 2 | #' @title Compute standard errors by standard OLS or Newey and West 3 | #' @description Compute standard errors by standard OLS or Newey and West (1987). 4 | #' 5 | #' @param yy A matrix with all endogenous variables. 6 | #' @param xx A matrix with lagged endogenous variables. 7 | #' @param k Integer. Value of column to choose from 8 | #' @param lag_nw Integer. Number of lags for Newey and West 9 | #' @param specs A list with specifications from \link{lp_lin} or \link{lp_nl}. 10 | #' @return List. First element contains the estimated standard errors, the second element contains the OLS point estimates. 11 | #' @keywords internal 12 | #' @author Philipp Adämmer 13 | 14 | 15 | get_std_err <- function(yy, xx, lag_nw, k, specs){ 16 | 17 | 18 | if(!is.matrix(yy)){ 19 | yy <- matrix(yy) 20 | } 21 | 22 | # Newey West standard errors 23 | if(isTRUE(specs$use_nw)){ 24 | 25 | # Check whether prewhitening shall be applied 26 | if(isTRUE(specs$nw_prewhite)){ 27 | 28 | # Estimate coefficients 29 | nw_results <- lpirfs::newey_west(yy[, k], xx, lag_nw) 30 | b <- nw_results[[1]] 31 | 32 | x_u <- nw_results[[3]] 33 | xpxi <- nw_results[[4]] 34 | 35 | resid_pw <- var_one(x_u)[[2]] 36 | D_mat <- var_one(x_u)[[3]] 37 | 38 | cov_nw_pw <- newey_west_pw(resid_pw, xpxi, D_mat, 1)[[1]] 39 | 40 | # Make finite sample adjustment? 41 | if(isTRUE(specs$adjust_se)) cov_nw_pw <- cov_nw_pw*nrow(yy)/(nrow(yy) - ncol(xx) - 1) 42 | 43 | # Get standard errors 44 | std_err <- sqrt(diag(cov_nw_pw))*specs$confint 45 | 46 | 47 | } else { 48 | 49 | # Estimate coefficients 50 | nw_results <- lpirfs::newey_west(yy[, k], xx, lag_nw) 51 | b <- nw_results[[1]] 52 | cov_nw <- nw_results[[2]] 53 | 54 | # Make finite sample adjustment 55 | if(isTRUE(specs$adjust_se)) cov_nw <- cov_nw*nrow(yy)/(nrow(yy) - ncol(xx) - 1) 56 | 57 | # Get NW standard errors 58 | std_err <- sqrt(diag(cov_nw))*specs$confint 59 | 60 | 61 | } 62 | 63 | # Normal standard errors 64 | } else { 65 | 66 | ols_output <- lpirfs::ols_diagnost(yy[, k], xx) 67 | 68 | 69 | # Get parameters and normal standard errors 70 | b <- ols_output[[1]] 71 | beta_cov <- ols_output[[2]] 72 | 73 | 74 | # Finite sample adjustment? 75 | if(isTRUE(specs$adjust_se)) beta_cov <- beta_cov*nrow(yy)/(nrow(yy) - ncol(xx) - 1) 76 | 77 | std_err <- sqrt(diag(beta_cov))*specs$confint 78 | 79 | } 80 | 81 | return(list(std_err, b)) 82 | 83 | 84 | } 85 | -------------------------------------------------------------------------------- /R/get_mat_chol.R: -------------------------------------------------------------------------------- 1 | #' @name get_mat_chol 2 | #' @title Compute structural shock matrix via Cholesky decomposition 3 | #' @description Compute structural shock matrix via Cholesky decomposition with input variables 4 | #' created in \link{lp_lin} or \link{lp_nl}. 5 | #' @param y_lin A matrix with all endogenous variables. 6 | #' @param x_lin A matrix with lagged endogenous variables. 7 | #' @param endog_data A \link{data.frame} with all endogenous variables. 8 | #' @param specs A list with specifications from \link{lp_lin} or \link{lp_nl}. 9 | #' @return Shock matrix (d) 10 | #' @keywords internal 11 | #' @author Philipp Adämmer 12 | 13 | get_mat_chol <- function(y_lin, x_lin, endog_data, specs){ 14 | 15 | # Check whether lag criterion is given 16 | if (is.nan(specs$lags_criterion) == TRUE) { 17 | 18 | # Estimates reduced VAR with pre-defined lag length 19 | y_data <- lapply(seq_len(ncol(y_lin)), function(i) y_lin[,i]) 20 | resids_all <- (lapply(y_data, get_resids_ols, x_lin)) 21 | 22 | ################################################################################ 23 | } else { 24 | ################################################################################ 25 | 26 | # Estimate lag criteria 27 | lag_criterion <- get_var_lagcrit(endog_data, specs = specs) 28 | 29 | if (specs$lags_criterion == 'AICc'){ 30 | 31 | specs$lags_endog_lin <- lag_criterion$order_vals[1] 32 | 33 | 34 | } else if (specs$lags_criterion == 'AIC'){ 35 | 36 | 37 | specs$lags_endog_lin <- lag_criterion$order_vals[2] 38 | 39 | } else { 40 | 41 | specs$lags_endog_lin <- lag_criterion$order_vals[3] } 42 | 43 | 44 | # Build data based on 'optimal lag length 45 | y_data <- as.list(as.data.frame(y_lin[[specs$lags_endog_lin]])) 46 | x_data <- x_lin[[specs$lags_endog_lin]] 47 | 48 | # Estimate OLS model and calculate residuals 49 | resids_all <- lapply(y_data, get_resids_ols, x_data) 50 | 51 | } 52 | 53 | # Make matrix of residuals 54 | resid_all <- matrix(unlist(resids_all), ncol = specs$endog, byrow = F ) 55 | 56 | # Make covariance matrix 57 | cov_var <- stats::cov(resid_all) 58 | 59 | # Cholesky decomposition 60 | A <- t(chol(cov_var)) 61 | D <- diag(sqrt(diag(cov_var))) 62 | 63 | # Shock Matrix 64 | d <- matrix(NaN, specs$endog, specs$endog) 65 | 66 | if (specs$shock_type == 0){ 67 | 68 | for (i in 1:specs$endog){ 69 | 70 | d[, i] <- A[, i]/A[i, i]*D[i, i] 71 | 72 | } 73 | 74 | } else { 75 | 76 | for (i in 1:specs$endog){ 77 | d[, i] <- A[, i]/A[i, i] 78 | 79 | } 80 | } 81 | 82 | # Return shock matrix 83 | return(d) 84 | 85 | } 86 | -------------------------------------------------------------------------------- /src/newey_west.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | //' @name newey_west 4 | //' @title Compute OLS parameters and robust standard errors based on Newey-West estimator 5 | //' @description Compute OLS parameters and robust standard errors based on Newey and West (1987). 6 | //' The function is based on the Matlab code by James P. LeSage. 7 | //' @param y Numeric vector. 8 | //' @param x Numeric matrix. 9 | //' @param h Integer. 10 | //' @return A list. The first element contains the estimated OLS parameters, the second element 11 | //' the Newey West covariance matrix, the third element the estimated functions, the fourth element 12 | //' the unscaled covariance matrix and the last element the meat estimator. 13 | //' @keywords internal 14 | //' @references 15 | //' Newey, W.K., and West, K.D. (1987). “A Simple, Positive-Definite, Heteroskedasticity and 16 | //' Autocorrelation Consistent Covariance Matrix.” \emph{Econometrica}, 55, 703–708. 17 | // [[Rcpp::export]] 18 | List newey_west(NumericVector y, NumericMatrix x, int h){ 19 | NumericMatrix V; 20 | arma::mat G, M, xx, xx_one, yy, M1, M2, ga, g1, za, xpxi, emat, hhat; 21 | arma::vec w1, beta, resids, resids_mean; 22 | int nrow_hhat, a, nobs, num_exog, nlag; 23 | double w; 24 | List ret(5); 25 | 26 | 27 | // OLS 28 | xx = as(x); 29 | xx_one = arma::ones(xx.n_rows, 1); // Insert ones for constant 30 | xx.insert_cols(0, xx_one); 31 | 32 | yy = as(y); 33 | num_exog = xx.n_cols; 34 | nobs = xx.n_rows; 35 | 36 | xpxi = inv(xx.t()*xx); 37 | beta = xpxi*xx.t()*yy; 38 | resids = yy - xx*beta; 39 | 40 | 41 | // Start Newey-West 42 | nlag = h; // The lag increases with the horizons 43 | emat = arma::zeros(nobs, num_exog); 44 | emat.cols(0, num_exog-1).each_col() = resids; 45 | emat = emat.t(); 46 | hhat = emat%xx.t(); 47 | 48 | G = arma::zeros(num_exog, num_exog); 49 | a = 0; 50 | 51 | 52 | for (int i = 0; i < nlag + 1; ++i){ 53 | 54 | ga = arma::zeros(num_exog, num_exog); 55 | w = 1 - i/double(nlag + 1); 56 | M = hhat; 57 | nrow_hhat = M.n_rows; 58 | M1 = M(arma::span(0, nrow_hhat - 1), arma::span(a, nobs - 1)); 59 | M2 = M(arma::span(0, nrow_hhat - 1), arma::span(0, nobs - 1 - a)); 60 | M2 = M2.t(); 61 | za = M1*M2; 62 | 63 | if (a == 0){ 64 | 65 | ga = ga + za; 66 | 67 | } else { 68 | 69 | ga = ga + za + za.t(); 70 | 71 | } 72 | 73 | G = G + w*ga; 74 | 75 | a = a + 1; 76 | 77 | 78 | } 79 | V = wrap(xpxi*G*xpxi); 80 | 81 | ret[0] = beta; 82 | ret[1] = V; 83 | ret[2] = wrap(hhat.t()); 84 | ret[3] = wrap(xpxi); 85 | ret[4] = wrap(G); 86 | return (ret); 87 | 88 | } 89 | -------------------------------------------------------------------------------- /src/hp_filter.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | //' @name hp_filter 4 | //' @title Decompose a times series via the Hodrick-Prescott filter 5 | //' @description Estimate cyclical and trend component with filter by Hodrick and Prescott (1997). 6 | //' The function is based on the function \emph{hpfilter} from the archived \emph{mFilter}-package. 7 | //' @param x One column matrix with numeric values. 8 | //' @param lambda Numeric value. 9 | //' @return A list. The first element contains the cyclical component and the second element the trend component. 10 | //' @examples 11 | //' \donttest{ 12 | //' library(lpirfs) 13 | //' 14 | //' 15 | //'# Decompose the Federal Funds Rate 16 | //' data_set <- as.matrix(interest_rules_var_data$FF) 17 | //' hp_results <- hp_filter(data_set, 1600) 18 | //' 19 | //'# Extract results and save as data.frame 20 | //' hp_cyc <- as.data.frame(hp_results[[1]]) 21 | //' hp_trend <- as.data.frame(hp_results[[2]]) 22 | //' 23 | //'# Make data.frames for plots 24 | //' cyc_df <- data.frame(yy = hp_cyc$V1, xx = seq(as.Date('1955-01-01'), 25 | //' as.Date('2003-01-01') , "quarter")) 26 | //' trend_df <- data.frame(yy = hp_trend$V1, xx = seq(as.Date('1955-01-01'), 27 | //' as.Date('2003-01-01') , "quarter")) 28 | //' 29 | //'# Make plots 30 | //' library(ggplot2) 31 | //' 32 | //'# Plot cyclical part 33 | //' ggplot(data = cyc_df) + 34 | //' geom_line(aes(y = yy, x = xx)) 35 | //' 36 | //'# Plot trend component 37 | //' ggplot(trend_df) + 38 | //' geom_line(aes(y = yy, x = xx)) 39 | //' 40 | //'} 41 | //' @references 42 | //' Hodrick, R.J., and Prescott, E. C. (1997). "Postwar U.S. Business Cycles: An Empirical Investigation." 43 | //' \emph{Journal of Money, Credit and Banking}, 29(1), 1-16. 44 | //' 45 | //' Ravn, M.O., Uhlig, H. (2002). "On Adjusting the Hodrick-Prescott Filter for the Frequency of Observations." 46 | //' \emph{Review of Economics and Statistics}, 84(2), 371-376. 47 | //' @author Philipp Adämmer 48 | // [[Rcpp::export]] 49 | List hp_filter(NumericVector x, double lambda){ 50 | 51 | arma::mat xx, ln, q, sigma_r, g, b_inv, b; 52 | arma::vec x_cycle, x_trend; 53 | int n; 54 | List ret(2); 55 | 56 | xx = as(x); 57 | 58 | n = xx.n_rows; 59 | arma::mat imat(n,n); 60 | imat = imat.eye(); 61 | 62 | arma::mat ln_1(xx.n_rows, 1); 63 | ln_1 = ln_1.fill(0); 64 | ln_1 = ln_1.t(); 65 | 66 | arma::mat ln_2(n-1, n); 67 | ln_2 = ln_2.eye(); 68 | 69 | ln = join_cols(ln_1, ln_2); 70 | ln = (imat - ln)*(imat - ln); 71 | 72 | q = ln.rows(2,n-1); 73 | q = q.t(); 74 | 75 | sigma_r = q.t()*q; 76 | arma::mat sigma_n(n-2, n-2); 77 | sigma_n = sigma_n.eye(); 78 | 79 | g = q.t()*xx; 80 | b_inv = inv(sigma_n + lambda*sigma_r); 81 | b = b_inv*g; 82 | 83 | x_cycle = lambda*q*b; 84 | x_trend = xx - x_cycle; 85 | 86 | 87 | ret[0] = wrap(x_cycle) ; 88 | ret[1] = wrap(x_trend); 89 | return (ret); 90 | } 91 | -------------------------------------------------------------------------------- /tests/testthat/test-plot_nl.R: -------------------------------------------------------------------------------- 1 | 2 | # Endogenous data 3 | endog_data <- interest_rules_var_data 4 | 5 | # Specifications for switching variable 6 | switching <- endog_data$GDP_gap 7 | 8 | 9 | test_that("Test whether list length is consistent number of endogenous variables 10 | for lp_nl model",{ 11 | 12 | 13 | results_nl <- lp_nl(endog_data, 14 | lags_endog_lin = 4L, 15 | lags_endog_nl = 3L, 16 | lags_criterion = NaN, 17 | max_lags = NaN, 18 | trend = 0L, 19 | shock_type = 1L, 20 | confint = 1.96, 21 | hor = 24L, 22 | switching = switching, 23 | use_hp = TRUE, 24 | lambda = 1600, 25 | gamma = 3, 26 | num_cores = 1) 27 | 28 | plots_nl <- plot_nl(results_nl) 29 | num_plots_iv <- ncol(endog_data)*ncol(endog_data)*2 30 | 31 | 32 | expect_equal(length(plots_nl[[1]]) + length(plots_nl[[2]]), num_plots_iv) 33 | 34 | 35 | }) 36 | 37 | 38 | test_that("Test whether list length is consistent number of endogenous variables 39 | for lp_nl_iv model",{ 40 | 41 | # Load and prepare data 42 | ag_data <- ag_data 43 | sample_start <- 7 44 | sample_end <- dim(ag_data)[1] 45 | endog_data <- ag_data[sample_start:sample_end, 3:5] 46 | 47 | 48 | shock <- ag_data[sample_start:sample_end, 7] 49 | 50 | exog_data <- ag_data[sample_start:sample_end, 6] 51 | 52 | switching_variable <- ag_data$GDP_MA[sample_start:sample_end] - 0.8 53 | 54 | 55 | results_nl_iv <- lp_nl_iv(endog_data, 56 | lags_endog_nl = 3, 57 | shock = shock, 58 | exog_data = exog_data, 59 | lags_exog = 4, 60 | contemp_data = NULL, 61 | lags_criterion = NaN, 62 | max_lags = NaN, 63 | trend = 0, 64 | confint = 1.96, 65 | hor = 20, 66 | switching = switching_variable, 67 | use_hp = 0, 68 | lambda = NaN, 69 | gamma = 3, 70 | num_cores = 1) 71 | 72 | plots_nl_iv <- plot_nl(results_nl_iv) 73 | num_plots_iv <- ncol(endog_data)*2 74 | 75 | 76 | expect_equal(length(plots_nl_iv[[1]]) + length(plots_nl_iv[[2]]), num_plots_iv) 77 | 78 | 79 | }) 80 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # lpirfs 5 | 6 | 7 | 8 | [![CRAN 9 | Version](https://www.r-pkg.org/badges/version/lpirfs)](https://CRAN.R-project.org/package=lpirfs) 10 | [![R-CMD-check](https://github.com/AdaemmerP/lpirfs/workflows/R-CMD-check/badge.svg)](https://github.com/AdaemmerP/lpirfs/actions) 11 | [![Total 12 | Downloads](https://cranlogs.r-pkg.org/badges/grand-total/lpirfs?color=orange)](https://CRAN.R-project.org/package=lpirfs) 13 | [![Downloads](https://cranlogs.r-pkg.org/badges/lpirfs)](https://CRAN.R-project.org/package=lpirfs) 14 | [![Coverage 15 | Status](https://codecov.io/gh/adaemmerp/lpirfs/graph/badge.svg)](https://app.codecov.io/github/adaemmerp/lpirfs?branch=master) 16 | 17 | ## About 18 | 19 | An R-package which estimates linear and nonlinear impulse responses with 20 | local projections by [Jordà 21 | (2005)](https://www.aeaweb.org/articles?id=10.1257/0002828053828518).
22 | 23 | ## Citation 24 | 25 | Please cite the paper by [Adämmer 26 | (2019)](https://journal.r-project.org/archive/2019/RJ-2019-052/index.html) 27 | when using the package. 28 | 29 | ## Main features 30 | 31 | - Estimates linear and nonlinear impulse responses with local 32 | projections. 33 | - Estimates linear and nonlinear impulse responses with identified shock 34 | and/or with 2SLS. 35 | - Estimates linear and nonlinear impulse responses with local 36 | projections for panel data. 37 | - Functions to plot linear and nonlinear impulse responses. 38 | - Functions are partly implemented in *Rcpp*/*RcppArmadillo* and partly 39 | written for parallel computation to improve efficiency. 40 | 41 | ## Installation 42 | 43 | You can install the released version of **lpirfs** from 44 | [CRAN](https://CRAN.R-project.org): 45 | 46 | ``` r 47 | install.packages("lpirfs") 48 | ``` 49 | 50 | You can install the development version of **lpirfs** from 51 | [GitHub](https://github.com/): 52 | 53 | ``` r 54 | # install.packages("devtools") 55 | devtools::install_github("https://github.com/AdaemmerP/lpirfs") 56 | ``` 57 | 58 | As lpirfs compiles some C++ source code, you will need to have installed 59 | the appropriate compilers to build the development version. 60 | 61 | ## How to use 62 | 63 | The paper about the package can be found 64 | [here.](https://journal.r-project.org/archive/2019/RJ-2019-052/index.html) 65 | The vignette of the package can be found 66 | [here.](https://cran.r-project.org/package=lpirfs) 67 | 68 | ## Acknowledgements 69 | 70 | I am thankful to Òscar 71 | [Jordà](https://sites.google.com/site/oscarjorda/) for encouraging 72 | comments and helpful suggestions. I am also indebted to Sarah 73 | [Zubairy](https://sites.google.com/site/sarahzubairy/) for providing the 74 | Matlab code before the publication of their 75 | [paper](https://doi.org/10.1086/696277). 76 | 77 | I greatly benefitted from the helpful remarks by Jon 78 | [Danielsson](https://www.systemicrisk.ac.uk/people/jon-danielsson) and 79 | the profound *R*, *Rcpp* and *GitHub* knowledge of Philipp 80 | [Wittenberg](https://github.com/wittenberg) and Detlef (overflow) 81 | [Steuer](https://github.com/dsteuer). Last but not least, I am grateful 82 | to Philipp Dybowski without whom I would have never started this 83 | project. 84 | 85 | All remaining errors are obviously mine. 86 | 87 | ### Author 88 | 89 | Philipp Adämmer 90 | 91 | ### License 92 | 93 | GPL (\>= 2) 94 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | # lpirfs 8 | 9 | 10 | [![CRAN Version](https://www.r-pkg.org/badges/version/lpirfs)](https://CRAN.R-project.org/package=lpirfs) 11 | [![R-CMD-check](https://github.com/AdaemmerP/lpirfs/workflows/R-CMD-check/badge.svg)](https://github.com/AdaemmerP/lpirfs/actions) 12 | [![Total Downloads](https://cranlogs.r-pkg.org/badges/grand-total/lpirfs?color=orange)](https://CRAN.R-project.org/package=lpirfs) 13 | [![Downloads](https://cranlogs.r-pkg.org/badges/lpirfs)](https://CRAN.R-project.org/package=lpirfs) 14 | [![Coverage Status](https://codecov.io/gh/adaemmerp/lpirfs/graph/badge.svg)](https://app.codecov.io/github/adaemmerp/lpirfs?branch=master) 15 | 16 | ```{r setup, include = FALSE} 17 | knitr::opts_chunk$set( 18 | collapse = TRUE, 19 | comment = "#>", 20 | fig.path = "man/figures/README-", 21 | fig.align = "center" 22 | ) 23 | ``` 24 | 25 | 26 | ## About 27 | An R-package which estimates linear and nonlinear impulse responses 28 | with local projections by [Jordà (2005)](https://www.aeaweb.org/articles?id=10.1257/0002828053828518).
29 | 30 | ## Citation 31 | Please cite the paper by [Adämmer (2019)](https://journal.r-project.org/archive/2019/RJ-2019-052/index.html) 32 | when using the package. 33 | 34 | ## Main features 35 | 36 | - Estimates linear and nonlinear impulse responses with local projections. 37 | - Estimates linear and nonlinear impulse responses with identified shock and/or with 2SLS. 38 | - Estimates linear and nonlinear impulse responses with local projections for panel data. 39 | - Functions to plot linear and nonlinear impulse responses. 40 | - Functions are partly implemented in *Rcpp*/*RcppArmadillo* and partly written for parallel computation 41 | to improve efficiency. 42 | 43 | 44 | ## Installation 45 | 46 | You can install the released version of **lpirfs** from [CRAN](https://CRAN.R-project.org): 47 | 48 | ``` r 49 | install.packages("lpirfs") 50 | ``` 51 | 52 | You can install the development version of **lpirfs** from [GitHub](https://github.com/): 53 | 54 | ``` r 55 | # install.packages("devtools") 56 | devtools::install_github("https://github.com/AdaemmerP/lpirfs") 57 | ``` 58 | 59 | As lpirfs compiles some C++ source code, you will need to have installed the appropriate compilers to build the development version. 60 | 61 | ## How to use 62 | The paper about the package can be found [here.](https://journal.r-project.org/archive/2019/RJ-2019-052/index.html) 63 | The vignette of the package can be found [here.](https://cran.r-project.org/package=lpirfs) 64 | 65 | ## Acknowledgements 66 | I am thankful to Òscar [Jordà](https://sites.google.com/site/oscarjorda/) for encouraging comments and helpful suggestions. I am also indebted to Sarah [Zubairy](https://sites.google.com/site/sarahzubairy/) for providing the Matlab code before the publication of their 67 | [paper](https://doi.org/10.1086/696277). 68 | 69 | I greatly benefitted from the helpful remarks by Jon [Danielsson](https://www.systemicrisk.ac.uk/people/jon-danielsson) and the profound *R*, *Rcpp* and *GitHub* knowledge of Philipp [Wittenberg](https://github.com/wittenberg) and Detlef (overflow) [Steuer](https://github.com/dsteuer). 70 | Last but not least, I am grateful to Philipp Dybowski without whom I would have never started this project. 71 | 72 | All remaining errors are obviously mine. 73 | 74 | 75 | ### Author 76 | Philipp Adämmer 77 | 78 | ### License 79 | 80 | GPL (>= 2) 81 | -------------------------------------------------------------------------------- /tests/testthat/test-get_var_lagcrit.R: -------------------------------------------------------------------------------- 1 | 2 | # Adapted VARselect function from 'vars' package 3 | varSELECT <- function (endog_data, lag.max = 2, type = c("const", "trend", "both", 4 | "none"), season = NULL, exogen = NULL){ 5 | 6 | y <- as.matrix(endog_data) 7 | colnames(y) <- make.names(colnames(y)) 8 | K <- ncol(y) 9 | lag.max <- abs(as.integer(lag.max)) 10 | type <- match.arg(type) 11 | lag <- abs(as.integer(lag.max + 1)) 12 | ylagged <- embed(y, lag)[, -c(1:K)] 13 | yendog <- y[-c(1:lag.max), ] 14 | sample <- nrow(ylagged) 15 | 16 | rhs <- switch(type, 17 | const = rep(1, sample), 18 | trend = seq(lag.max + 1, length = sample), 19 | both = cbind(rep(1, sample), 20 | seq(lag.max + 1, length = sample)), 21 | none = NULL) 22 | 23 | 24 | idx <- seq(K, K * lag.max, K) 25 | 26 | if (!is.null(rhs)) { 27 | detint <- ncol(as.matrix(rhs)) 28 | } else { 29 | detint <- 0 30 | } 31 | criteria <- matrix(NA, nrow = 2, ncol = lag.max) 32 | rownames(criteria) <- c("AIC(n)", "SC(n)") 33 | colnames(criteria) <- paste(seq(1:lag.max)) 34 | 35 | for (i in 1:lag.max) { 36 | ys.lagged <- cbind(ylagged[, c(1:idx[i])], rhs) 37 | sampletot <- nrow(y) 38 | 39 | resids <- lm.fit(x = ys.lagged, y = yendog)$residuals 40 | sigma.det <- det(crossprod(resids)/sample) 41 | 42 | criteria[1, i] <- log(sigma.det) + (2/sample) * 43 | (i * K^2 + K * detint) 44 | 45 | criteria[2, i] <- log(sigma.det) + (log(sample)/sample) * 46 | (i * K^2 + K * detint) 47 | 48 | } 49 | 50 | order <- apply(criteria, 1, which.min) 51 | return(list(selection = order, criteria = criteria)) 52 | 53 | } 54 | 55 | # Load (endogenous) data 56 | endog_data <- interest_rules_var_data 57 | 58 | # Get results 59 | resultsVS <- varSELECT(endog_data, lag.max = 24, type= 'const') 60 | resultsVS$selection 61 | 62 | 63 | 64 | test_that("Test whether package function chooses same number of lags as 65 | VARselect function", { 66 | 67 | 68 | # Estimate linear model 69 | results_lin <- lp_lin(endog_data, 70 | lags_endog_lin = NaN, 71 | lags_criterion = 'AIC', 72 | exog_data = NULL, 73 | lags_exog = NULL, 74 | max_lags = 24, 75 | trend = 0L, 76 | shock_type = 1L, 77 | confint = 1.96, 78 | hor = 12, 79 | num_cores = 1) 80 | 81 | 82 | 83 | specs <- results_lin$specs 84 | 85 | # Get values of lag criteria 86 | results_lpirfs <- get_var_lagcrit(endog_data, specs) 87 | 88 | # AIC results from VARselect function 89 | AIC_VS <- resultsVS$selection[1] 90 | names(AIC_VS) <- 'AIC' 91 | 92 | # AIC results from lpirfs 93 | AIC_lpirfs <- results_lpirfs$order_vals[2] 94 | names(AIC_lpirfs) <- 'AIC' 95 | 96 | # AIC results from VARselect function 97 | BIC_VS <- resultsVS$selection[2] 98 | names(BIC_VS) <- 'BIC' 99 | 100 | # AIC results from lpirfs 101 | BIC_lpirfs <- results_lpirfs$order_vals[3] 102 | names(BIC_lpirfs) <- 'BIC' 103 | 104 | expect_equal(AIC_VS, AIC_lpirfs) 105 | expect_equal(BIC_VS, BIC_lpirfs) 106 | 107 | } ) 108 | 109 | 110 | 111 | -------------------------------------------------------------------------------- /R/data-documentation.R: -------------------------------------------------------------------------------- 1 | #' @title Data to estimate fiscal multipliers 2 | #' @description A tibble, containing data to estimate fiscal multipliers. 3 | #' This data was originally used by Auerbach and Gorodnichenko (2012). 4 | #' Sarah and Zubairy (2018) use this data to re-evaluate their results with local projections. 5 | #' 6 | #' @format A tibble with 248 quarterly observations (rows) and 7 variables (columns): 7 | #' \describe{ 8 | #' \item{Year}{Year of observation.} 9 | #' \item{Quarter}{Quarter of observation.} 10 | #' \item{Gov}{Logs of real government (federal, state, and local) purchases (consumption and investment).} 11 | #' \item{Tax}{Logs of real government receipts of direct and indirect taxes net of transfers to businesses 12 | #' and individuals.} 13 | #' \item{GDP}{Logs of real gross domestic product.} 14 | #' \item{GDP_MA}{7-quarter moving average growth rate of GDP.} 15 | #' \item{Gov_shock_mean}{Identified government spending shock. For details see Supplementary Appendix of Ramey and Zubairy (2018).} 16 | #' } 17 | #' Sample: 1948:IV - 2008:IV 18 | #' @references 19 | #' 20 | #' Auerbach, A. J., and Gorodnichenko Y. (2012). "Measuring the Output Responses to Fiscal Policy." 21 | #' \emph{American Economic Journal: Economic Policy}, 4 (2): 1-27. 22 | #' 23 | #' Jordà, Ò. (2005) "Estimation and Inference of Impulse Responses by Local Projections." 24 | #' \emph{American Economic Review}, 95 (1): 161-182. 25 | #' 26 | #' Ramey, V.A., Zubairy, S. (2018). "Government Spending Multipliers in Good Times 27 | #' and in Bad: Evidence from US Historical Data." \emph{Journal of Political Economy}, 28 | #' 126(2): 850 - 901. 29 | #' 30 | #' @source \doi{10.1086/696277} 31 | "ag_data" 32 | 33 | 34 | 35 | #' @title Data to estimate the effects of interest rate rules for monetary policy 36 | #' @description A tibble, containing data to estimate the effects of interest rate rules for monetary policy. 37 | #' The data are used by Jordà (2005). 38 | #' @format A tibble with 193 quarterly observations (rows) and 3 variables (columns): 39 | #' \describe{ 40 | #' \item{GDP_gap}{Percentage difference between real GDP and potential GDP (Congressional Budget Office).} 41 | #' \item{Infl}{Inflation: Percentage change in the GDP, chain weighted price index at annual rate.} 42 | #' \item{FF}{Federal funds rate: quarterly average of daily rates.} 43 | #' } 44 | #' Sample: 1955:I - 2003:I 45 | #' @references 46 | #' 47 | #' Jordà, Ò. (2005) "Estimation and Inference of Impulse Responses by Local Projections." 48 | #' \emph{American Economic Review}, 95 (1): 161-182. 49 | #' 50 | #' @source \url{https://www.aeaweb.org/articles?id=10.1257/0002828053828518} 51 | "interest_rules_var_data" 52 | 53 | 54 | #' @title Data to estimate a standard monetary VAR 55 | #' 56 | #' @description A tibble, containing data to estimate a standard monetary VAR. 57 | #' 58 | #' @format A tibble with 494 monthly observations (rows) and 6 variables (columns): 59 | #' \describe{ 60 | #' \item{EM}{Log of non-agricultural payroll employment.} 61 | #' \item{P}{Log of personal consumption expenditures deflator (1996 = 100).} 62 | #' \item{POCM}{Annual growth rate of the index of sensitive materials 63 | #' prices issued by the Conference Board.} 64 | #' \item{FF}{Federal funds rate.} 65 | #' \item{NBRX}{Ratio of nonborrowed reserves plus extended credit to total reserves.} 66 | #' \item{M2}{Annual growth rate of M2 stock.} 67 | #' 68 | #' } 69 | #' Sample: 1960:01 - 2001:02. 70 | #' 71 | #' @references 72 | #' 73 | #' Jordà, Ò. (2005) "Estimation and Inference of Impulse Responses by Local Projections." 74 | #' \emph{American Economic Review}, 95 (1): 161-182. 75 | #' 76 | #' @source \url{https://www.aeaweb.org/articles?id=10.1257/0002828053828518} 77 | "monetary_var_data" 78 | 79 | 80 | -------------------------------------------------------------------------------- /R/get_var_lagcrit.R: -------------------------------------------------------------------------------- 1 | #'@name get_var_lagcrit 2 | #'@title Computes AICc, AIC and BIC for VAR 3 | #'@description Computes AICc, AIC and BIC for VAR models. 4 | #'@param endog_data A \link{data.frame} with endogenous variables for the VAR 5 | #'@param specs A \link{list} created in \link{lp_lin} 6 | #'@keywords internal 7 | #'@references 8 | #' 9 | #' Akaike, H. (1974). "A new look at the statistical model identification", 10 | #' \emph{IEEE Transactions on Automatic Control}, 19 (6): 716–723. 11 | #' 12 | #' Hamilton, J. D. (1994). "Time Series Analysis." 13 | #' Princeton: Princeton University Press. 14 | #' 15 | #' Hurvich, C. M., and Tsai, C.-L. (1989), "Regression and time series model selection in small samples", 16 | #' \emph{Biometrika}, 76(2): 297–307 17 | #' 18 | #' Lütkepohl, H. (2005). "New Introduction to Multiple Time Series Analysis.", 19 | #' New York: Springer. 20 | #' 21 | #' Schwarz, Gideon E. (1978). "Estimating the dimension of a model", 22 | #' \emph{Annals of Statistics}, 6 (2): 461–464. 23 | #' 24 | #' @return A list with lag length criteria 25 | #' 26 | get_var_lagcrit <- function (endog_data, 27 | specs = NULL){ 28 | # Maximum number of lags 29 | max_lags <- specs$max_lags 30 | 31 | # Number of endogenous variables (i.e. equations) 32 | K <- ncol(endog_data) 33 | 34 | 35 | # Count contemporaneous variables 36 | if(!is.null(specs$exog_data)){ 37 | num_contemp <- ncol(specs$exog) 38 | } else { 39 | num_contemp <- 0 40 | } 41 | 42 | 43 | # Count exogenous variables 44 | if(!is.null(specs$exog_data)){ 45 | num_exog <- ncol(specs$exog) 46 | lags_exog <- specs$lags_exog 47 | } else { 48 | num_exog <- 0 49 | lags_exog <- 0 50 | } 51 | 52 | 53 | # Count constant, trend, trend^2 54 | if(specs$trend == 0){ 55 | K_cte <- 1 56 | } else if(specs$trend == 1){ 57 | K_cte <- 2 58 | } else if(specs$trend == 2){ 59 | K_cte <- 3 60 | } 61 | 62 | # Construct lagged data 63 | y_lin <- specs$y_lin 64 | x_lin <- specs$x_lin 65 | 66 | # Number of observations 67 | n <- nrow(y_lin[[length(y_lin)]]) 68 | 69 | # Prepare matrices to store values 70 | lagcrit_vals <- matrix(NA, nrow = max_lags, ncol = 3) 71 | colnames(lagcrit_vals) <- c("AICc", "AIC", "BIC") 72 | 73 | # Start of observation to guarantee equal sample length 74 | obs_start <- specs$max_lags 75 | 76 | for (ii in 1:max_lags) { 77 | 78 | # Get data 79 | yy <- y_lin[[ii]][obs_start:nrow(y_lin[[ii]]),] 80 | xx <- x_lin[[ii]][obs_start:nrow(x_lin[[ii]]),] 81 | 82 | # Add constant for regression 83 | xx <- cbind(xx, rep(1, nrow(xx))) 84 | 85 | # Estimate model 86 | ols_resids <- stats::lm.fit(x = xx, y = yy)$residuals 87 | sigma_det <- det(crossprod(ols_resids)/n) 88 | 89 | # Lag order 90 | m <- ii 91 | 92 | # Estimate log-liklihood for VAR (See Hamilton, p. 296) 93 | ll <- -(n/2)*log(sigma_det) - (n/2)*log(2*pi)*K - n/2*K 94 | 95 | 96 | # Count number of parameters to estimate 97 | tp <- m*K^2 + # endogenous parameters 98 | num_exog*lags_exog*K + # number of exogenous parameters 99 | num_contemp*K + # number of contemporeaneous parameters 100 | K_cte*K # constant, trend and trend^2 101 | 102 | # Estimate AIC 103 | lagcrit_vals[ii, 2] <- -2*(ll) + 2*tp 104 | 105 | # Estimate AICc 106 | lagcrit_vals[ii, 1] <- lagcrit_vals[ii, 2] + 2*tp*(tp + 1)/(n - tp - 1) 107 | 108 | # Estimate BIC 109 | lagcrit_vals[ii, 3] <- -2*(ll) + log(n)*tp 110 | 111 | # Decrease start observation 112 | obs_start <- obs_start - 1 113 | 114 | } 115 | 116 | order_vals <- apply(lagcrit_vals, 2, which.min) 117 | return(list(lagcrit_vals = lagcrit_vals, order_vals = order_vals)) 118 | 119 | } 120 | 121 | 122 | -------------------------------------------------------------------------------- /src/newey_west_tsls.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | //' @name newey_west_tsls 4 | //' @title Compute 2SLS parameters and robust standard errors based on Newey-West 5 | //' @description Compute 2SLS parameters and robust standard errors based on Newey and West (1987). 6 | //' Part of the function is based on the Matlab code by James P. LeSage. 7 | //' @param y Numeric vector. 8 | //' @param x Numeric matrix. 9 | //' @param z Numeric matrix. 10 | //' @param h Integer. 11 | //' @return A list. The first element contains the estimated 2SLS parameters and the second element 12 | //' the 2SLS-Newey-West covariance matrix of these parameters. The third element contains the estimated functions, the fourth element 13 | //' the unscaled covariance matrix, the fifth element the meat estimator and the last element the ordinary covariance matrix of the 14 | //' point estimates. 15 | //' @keywords internal 16 | //' @references 17 | //' Newey, W.K., and West, K.D. (1987). “A Simple, Positive-Definite, Heteroskedasticity and 18 | //' Autocorrelation Consistent Covariance Matrix.” \emph{Econometrica}, 55, 703–708. 19 | //' Wooldridge, J.M. (2002), Econometric Analysis of Cross Section and Panel Data, The MIT Press. 20 | // [[Rcpp::export]] 21 | List newey_west_tsls(NumericVector y, NumericMatrix x, NumericMatrix z, int h){ 22 | NumericMatrix V; 23 | arma::mat G, M, xx, xx_one, yy, xx_hat, zz, M1, M2, ga, g1, za, xpxi, xpxi_iv, emat, hhat, cov_beta_iv, p_z, x_pz_x; 24 | arma::vec w1, beta_iv, resids, resids_sq_iv; 25 | int nrow_hhat, a, nobs, num_exog, nlag; 26 | double ssr_iv, sigma_hat_iv, w ; 27 | List ret(6); 28 | 29 | 30 | // 2SLS 31 | xx = as(x); 32 | xx_one = arma::ones(xx.n_rows, 1); // Insert ones for constant 33 | xx.insert_cols(0, xx_one); 34 | 35 | yy = as(y); 36 | 37 | zz = as(z); 38 | zz.insert_cols(0, xx_one); 39 | 40 | // Build x_hat matrix with instrument matrix 41 | xx_hat = zz*inv(zz.t()*zz)*zz.t()*xx; 42 | 43 | // Estimate beta_iv 44 | xpxi_iv = inv(xx_hat.t()*xx_hat); 45 | beta_iv = xpxi_iv*xx_hat.t()*yy; 46 | 47 | // Estimate corrected residuals 48 | resids = yy - xx*beta_iv; 49 | 50 | num_exog = xx.n_cols; 51 | nobs = xx.n_rows; 52 | 53 | // Estimate normal cov-matrix of iv_estimators 54 | resids_sq_iv = resids%resids; 55 | ssr_iv = sum(resids_sq_iv); 56 | sigma_hat_iv = ssr_iv/double(nobs - num_exog); 57 | cov_beta_iv = sigma_hat_iv*xpxi_iv; 58 | 59 | // Start Newey-West 60 | p_z = (zz * inv(zz.t() * zz) * zz.t()); 61 | x_pz_x = inv(xx.t()*p_z*xx); 62 | nlag = h; // The lag increases with the horizons 63 | emat = arma::zeros(nobs, num_exog); 64 | emat.cols(0, num_exog-1).each_col() = resids; 65 | emat = emat.t(); 66 | hhat = emat%(xx.t()*p_z); 67 | 68 | G = arma::zeros(num_exog, num_exog); 69 | a = 0; 70 | 71 | 72 | for (int i = 0; i < nlag + 1; ++i){ 73 | 74 | ga = arma::zeros(num_exog, num_exog); 75 | w = 1 - i/double(nlag + 1); 76 | M = hhat; 77 | nrow_hhat = M.n_rows; 78 | M1 = M(arma::span(0, nrow_hhat - 1), arma::span(a, nobs - 1)); 79 | M2 = M(arma::span(0, nrow_hhat - 1), arma::span(0, nobs - 1 - a)); 80 | M2 = M2.t(); 81 | za = M1*M2; 82 | 83 | if (a == 0){ 84 | 85 | ga = ga + za; 86 | 87 | } else { 88 | 89 | ga = ga + za + za.t(); 90 | 91 | } 92 | 93 | G = G + w*ga; 94 | 95 | a = a + 1; 96 | 97 | 98 | } 99 | V = wrap(x_pz_x * G * x_pz_x); 100 | 101 | ret[0] = beta_iv; 102 | ret[1] = V; 103 | ret[2] = wrap(hhat.t()); 104 | ret[3] = wrap(xpxi_iv); 105 | ret[4] = wrap(G); 106 | ret[5] = wrap(cov_beta_iv); 107 | return (ret); 108 | 109 | } 110 | -------------------------------------------------------------------------------- /src/ols_diagnost.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | //' @name ols_diagnost 4 | //' @title Compute diagnostics for OLS models 5 | //' @description Compute OLS diagnostics such as R^2, adjusted R^2, AIC, etc. 6 | //' @param y Numeric vector. 7 | //' @param x Numeric matrix. 8 | //' @return A list: 9 | //' 10 | //'\item{beta}{Point estimates of OLS regression.} 11 | //' 12 | //'\item{beta_cov}{Covariance matrix of point estimates.} 13 | //' 14 | //'\item{R^2}{The R^2 statistic from OLS regression. } 15 | //' 16 | //'\item{Adj.R^2}{The adjusted R^2 staistic from OLS regression.} 17 | //' 18 | //'\item{F-stat}{The computed F-statistic.} 19 | //' 20 | //'\item{df1}{First degress of freedom for F-statistic.} 21 | //' 22 | //'\item{df2}{Second degrees of freedom for F-staitisc.} 23 | //' 24 | //'\item{AIC_c}{The AIC_c criterion by Hurvich and Tsai (1989)} 25 | //' 26 | //'\item{AIC}{The AIC criterion by Akaike (1974)} 27 | //' 28 | //'\item{BIC}{The BIC criterion by Schwarz and Gideon (1978)} 29 | //' 30 | //' @keywords internal 31 | //' @references 32 | //' Akaike, H. (1974). "A new look at the statistical model identification", \emph{IEEE Transactions on Automatic Control}, 19 (6): 716–723. 33 | //' 34 | //' Hurvich, C. M., and Tsai, C.-L. (1989). "Regression and time series model selection 35 | //' in small samples", Biometrika, 76(2): 297–307, 36 | //' 37 | //' Schwarz, G.(1978). "Estimating the dimension of a model", \emph{Annals of Statistics}, 6 (2): 461–464. 38 | // [[Rcpp::export]] 39 | List ols_diagnost(NumericVector y, NumericMatrix x){ 40 | arma::mat xx, xx_one, yy, xpxi, beta_cov; 41 | arma::vec beta, resids, resids_mean, resids_sq, resids_mean_sq; 42 | int num_exog, num_restr, df_1, df_2 ; 43 | double nobs, sigma_hat, y_bar, ssr, ssm, r_sq, r_sq_adj, var_eps, tp, ll, aic_c, aic, bic, f_stat; 44 | double pi = 3.141593; 45 | List ret(10); 46 | 47 | 48 | // X Matrices 49 | xx = as(x); 50 | xx_one = arma::ones(xx.n_rows, 1); // Insert ones for constant 51 | xx.insert_cols(0, xx_one); 52 | 53 | // Y Matrices 54 | yy = as(y); 55 | num_exog = xx.n_cols; 56 | nobs = xx.n_rows; 57 | 58 | // Point estimates of OLS model 59 | xpxi = inv(xx.t()*xx); 60 | beta = xpxi*xx.t()*yy; 61 | 62 | // Squared residuals from observations 63 | resids = yy - xx*beta; 64 | resids_sq = resids%resids; 65 | ssr = sum(resids_sq); 66 | 67 | // Estimate cov-matrix of estimators 68 | sigma_hat = ssr/double(nobs - num_exog); 69 | beta_cov = sigma_hat*xpxi; 70 | 71 | // Squared residuals from mean 72 | y_bar = mean(y); 73 | resids_mean = y - y_bar; 74 | resids_mean_sq = resids_mean%resids_mean; 75 | ssm = sum(resids_mean_sq); 76 | 77 | // R^2 78 | r_sq = 1 - (ssr/ssm); 79 | 80 | // Adjusted R^2 81 | r_sq_adj = 1 - (1 - r_sq)*((nobs - 1)/double(nobs - num_exog)); 82 | 83 | 84 | // Estimate F-statistic 85 | // Number of restrictions 86 | num_restr = num_exog - 1; 87 | 88 | // Estimate F-statistic 89 | f_stat = ((ssm - ssr)/double(num_restr))/(ssr/double(nobs - num_exog)); 90 | 91 | // Get p-value of F statistic 92 | df_1 = num_restr ; 93 | df_2 = (nobs - num_exog) ; 94 | 95 | // Section for information criteria 96 | var_eps = ssr/nobs; 97 | 98 | tp = xx.n_cols + 1; // Number of parameters to estimate. Plus one, 99 | // because of variance 100 | 101 | // Estimate log-likelihood 102 | ll = - nobs/2*log(2*pi) - nobs/2*log(var_eps) - ssr/(2*var_eps); 103 | 104 | 105 | // Estimate information criteria 106 | aic_c = (-2*ll + 2*tp) + (2*pow(tp,2) + 2*tp)/(nobs - tp -1); 107 | 108 | aic = -2*ll + 2*tp ; 109 | 110 | bic = -2*ll + log(nobs)*tp; 111 | 112 | 113 | ret[0] = beta; 114 | ret[1] = beta_cov; 115 | ret[2] = r_sq; 116 | ret[3] = r_sq_adj; 117 | ret[4] = f_stat; 118 | ret[5] = df_1; 119 | ret[6] = df_2; 120 | ret[7] = aic_c; 121 | ret[8] = aic; 122 | ret[9] = bic; 123 | return (ret); 124 | 125 | } 126 | -------------------------------------------------------------------------------- /src/hp_fast.cpp: -------------------------------------------------------------------------------- 1 | // [[Rcpp::depends(RcppEigen)]] 2 | #include 3 | 4 | using namespace Rcpp; 5 | using namespace Eigen; 6 | 7 | //' Fast Hodrick-Prescott Filter 8 | //' 9 | //' Decomposes a time series into trend and cyclical components using 10 | //' the Hodrick-Prescott (HP) filter. This implementation is highly optimized 11 | //' using sparse matrix algebra (via the Eigen library) and a fast Cholesky solver. 12 | //' Was built with the help of Gemini 3. 13 | //' 14 | //' @param y_in A numeric vector containing the time series data to decompose. 15 | //' @param lambda A numeric value determining the smoothness of the trend. 16 | //' Common values are: 17 | //' \itemize{ 18 | //' \item 1600 for quarterly data 19 | //' \item 14400 for monthly data 20 | //' \item 6.25 for annual data 21 | //' } 22 | //' 23 | //' @return A list with two components: 24 | //' \describe{ 25 | //' \item{trend}{A numeric vector containing the estimated trend component.} 26 | //' \item{cycle}{A numeric vector containing the estimated cyclical component (\code{y_in - trend}).} 27 | //' } 28 | //' 29 | //' This function constructs the sparse matrix directly and uses a Simplicial LLT (Cholesky) solver. 30 | //' This reduces the computational complexity from \eqn{O(N^3)} to linear time \eqn{O(N)}. 31 | //' 32 | //' @references 33 | //' Hodrick, R. J., & Prescott, E. C. (1997). Postwar U.S. business cycles: an empirical investigation. 34 | //' \emph{Journal of Money, Credit, and Banking}, 1-16. 35 | //' 36 | //' @examples 37 | //' \dontrun{ 38 | //' # Generate random data 39 | //' set.seed(123) 40 | //' y <- cumsum(rnorm(100)) 41 | //' 42 | //' # Filter with lambda = 1600 43 | //' res <- hp_filter_fast(y, 1600) 44 | //' 45 | //' # Plot 46 | //' plot(y, type = "l", col = "gray", main = "HP Filter") 47 | //' lines(res$trend, col = "red", lwd = 2) 48 | //' } 49 | //' @export 50 | // [[Rcpp::export]] 51 | List hp_filter_fast(NumericVector y_in, double lambda) { 52 | 53 | // Zero-copy map of the input vector 54 | Map y(as >(y_in)); 55 | int n = y.size(); 56 | 57 | // A has exactly 5 diagonals. 58 | // Total non-zeros approx 5*n. Reserve memory 59 | typedef Triplet T; 60 | std::vector tripletList; 61 | tripletList.reserve(5 * n - 6); 62 | 63 | // --- 1. Fill the Diagonals Manually 64 | 65 | // The "Internal" values (bulk of the matrix) 66 | double diag_main = 1.0 + 6.0 * lambda; 67 | double diag_off1 = -4.0 * lambda; 68 | double diag_off2 = 1.0 * lambda; 69 | 70 | // Boundary values 71 | double diag_0 = 1.0 + lambda; 72 | double diag_1 = 1.0 + 5.0 * lambda; 73 | double off1_0 = -2.0 * lambda; 74 | 75 | // A. Main Diagonal (offset 0) 76 | tripletList.push_back(T(0, 0, diag_0)); // First 77 | tripletList.push_back(T(1, 1, diag_1)); // Second 78 | for(int i = 2; i < n - 2; ++i) { 79 | tripletList.push_back(T(i, i, diag_main)); // Middle 80 | } 81 | tripletList.push_back(T(n - 2, n - 2, diag_1)); // Second to last 82 | tripletList.push_back(T(n - 1, n - 1, diag_0)); // Last 83 | 84 | // B. First Off-Diagonal (offset +/- 1) 85 | tripletList.push_back(T(0, 1, off1_0)); // (0,1) 86 | tripletList.push_back(T(1, 0, off1_0)); // (1,0) 87 | 88 | for(int i = 1; i < n - 2; ++i) { 89 | tripletList.push_back(T(i, i + 1, diag_off1)); // Upper band 90 | tripletList.push_back(T(i + 1, i, diag_off1)); // Lower band 91 | } 92 | 93 | tripletList.push_back(T(n - 2, n - 1, off1_0)); // Last upper 94 | tripletList.push_back(T(n - 1, n - 2, off1_0)); // Last lower 95 | 96 | // C. Second Off-Diagonal (offset +/- 2) 97 | for(int i = 0; i < n - 2; ++i) { 98 | tripletList.push_back(T(i, i + 2, diag_off2)); // Upper band 99 | tripletList.push_back(T(i + 2, i, diag_off2)); // Lower band 100 | } 101 | 102 | // --- 2. Construct Matrix --- 103 | SparseMatrix A(n, n); 104 | A.setFromTriplets(tripletList.begin(), tripletList.end()); 105 | 106 | // --- 3. Solve (SimplicialLLT is fast for Symmetric Positive Definite) --- 107 | SimplicialLLT> solver; 108 | solver.compute(A); 109 | 110 | VectorXd trend = solver.solve(y); 111 | VectorXd cycle = y - trend; 112 | 113 | return List::create(_["trend"] = trend, _["cycle"] = cycle); 114 | } -------------------------------------------------------------------------------- /R/plot_lin.R: -------------------------------------------------------------------------------- 1 | #' @name plot_lin 2 | #' @title Compute and display plots of linear impulse responses 3 | #' @description Compute and display linear impulse responses, estimated with \link{lp_lin}() and \link{lp_lin_iv}(). 4 | #' @param results_lin A \link{list} created with \link{lp_lin}() or \link{lp_lin_iv}(). 5 | #' @return A list with (gg-)plots for linear impulse responses. 6 | #' @export 7 | #' @import ggplot2 8 | #' @author Philipp Adämmer 9 | #' @examples 10 | #'\donttest{ 11 | #' 12 | #'# See examples for lp_lin() and lp_lin_iv(). 13 | #' } 14 | plot_lin <- function(results_lin){ 15 | 16 | 17 | irf_lin_mean <- results_lin[[1]] 18 | irf_lin_low <- results_lin[[2]] 19 | irf_lin_up <- results_lin[[3]] 20 | 21 | 22 | specs <- results_lin$specs 23 | 24 | # Plots for lin function 25 | if(specs$model_type == 0){ 26 | 27 | plot_num <- 1 28 | gg_lin <- rep(list(NaN), specs$endog*specs$endog) 29 | 30 | # Loop to fill to create plots 31 | for(rr in 1:(specs$endog)){ 32 | for (ss in 1:(specs$endog)){ 33 | 34 | # Tibbles for linear irfS 35 | tbl_lin_mean <- as.matrix(t(irf_lin_mean[, 1:specs$hor , ss]))[, rr] 36 | tbl_lin_low <- as.matrix(t(irf_lin_low[, 1:specs$hor , ss]))[, rr] 37 | tbl_lin_up <- as.matrix(t(irf_lin_up[, 1:specs$hor , ss]))[, rr] 38 | 39 | tbl_lin <- tibble(x = seq_along(tbl_lin_mean), mean = tbl_lin_mean, 40 | low = tbl_lin_low, up = tbl_lin_up) 41 | 42 | gg_lin[[plot_num]] <- ggplot()+ 43 | geom_line(data = tbl_lin, aes(y = mean, x = x)) + 44 | geom_ribbon(data = tbl_lin, aes(x = x, ymin = low, ymax = up), col = 'grey', 45 | fill = 'grey', alpha = 0.3) + 46 | theme_classic() + 47 | ggtitle(paste(specs$column_names[ss], 'on', specs$column_names[rr], sep=" ")) + 48 | xlab('') + 49 | ylab('') + 50 | theme(title = element_text(size = 6), 51 | plot.title = element_text(hjust = 0.5)) + 52 | scale_y_continuous(expand = c(0, 0)) + 53 | scale_x_continuous(expand = c(0, 0), 54 | breaks = seq(0, specs$hor, 2)) + 55 | geom_hline(yintercept = 0, col = "black", linewidth = 0.25, linetype = "dashed") 56 | 57 | # Add one to count variable 58 | plot_num <- plot_num + 1 59 | 60 | } 61 | } 62 | 63 | } else if(specs$model_type == 1| specs$model_type == 2){ 64 | 65 | gg_lin <- rep(list(NaN), specs$endog) 66 | 67 | # Loop to fill to create plots 68 | for(rr in 1:(specs$endog)){ 69 | 70 | # Tibbles for linear irfS 71 | tbl_lin_mean <- irf_lin_mean[rr, ] 72 | tbl_lin_low <- irf_lin_low[rr, ] 73 | tbl_lin_up <- irf_lin_up[rr, ] 74 | 75 | tbl_lin <- tibble(x = seq_along(tbl_lin_mean), mean = tbl_lin_mean, # 1:(specs$hor) 76 | low = tbl_lin_low, up = tbl_lin_up) 77 | 78 | gg_lin[[rr]] <- ggplot()+ 79 | geom_line(data = tbl_lin, aes(y = mean, x = x)) + 80 | geom_ribbon(data = tbl_lin, aes(x = x, ymin = low, ymax = up), col = 'grey', 81 | fill = 'grey', alpha = 0.3) + 82 | theme_classic() + 83 | ggtitle(paste('Shock', 'on', specs$column_names[rr], sep=" ")) + 84 | xlab('') + 85 | ylab('') + 86 | theme(title = element_text(size = 6), 87 | plot.title = element_text(hjust = 0.5)) + 88 | scale_y_continuous(expand = c(0, 0)) + 89 | scale_x_continuous(expand = c(0, 0), 90 | breaks = seq(0, specs$hor, 2)) + 91 | geom_hline(yintercept = 0, col = "black", linewidth = 0.25, linetype = "dashed") 92 | 93 | 94 | 95 | } 96 | } 97 | 98 | return(gg_lin) 99 | 100 | } 101 | -------------------------------------------------------------------------------- /R/get_vals_switching.R: -------------------------------------------------------------------------------- 1 | #' @name get_vals_switching 2 | #' @title Compute values of transition function to separate regimes 3 | #' @description Computes transition values by using a smooth transition function as 4 | #' used in Auerbach and Gorodnichenko (2012). The time series used in the transition function 5 | #' can be detrended via the Hodrick-Prescott filter (see Auerbach and Gorodnichenko, 2013). 6 | #' @param data_set A numeric vector or a panel data set, depending on the model to estimate. 7 | #' @param specs A \link{list} with inputs as in \link{lp_nl}(). 8 | #' @return \item{fz}{A numeric vector with values from the smooth transition function \eqn{F(z_{t-1})}.} 9 | #' @keywords internal 10 | #' @references 11 | #' Auerbach, A. J., and Gorodnichenko Y. (2012). "Measuring the Output Responses to Fiscal Policy." 12 | #' \emph{American Economic Journal: Economic Policy}, 4 (2): 1-27. 13 | #' 14 | #' Auerbach, A. J., and Gorodnichenko Y. (2013). "Fiscal Multipliers in Recession and Expansion." 15 | #' \emph{NBER Working Paper Series}. Nr 17447. 16 | #' 17 | #' 18 | #' @author Philipp Adämmer 19 | 20 | 21 | 22 | get_vals_switching <- function(data_set, specs){ 23 | 24 | 25 | # Function which creates lags to be consistent with dplyr 26 | lag_function <- function(data, lag_nr){ 27 | 28 | lag_data <- dplyr::lag(data, lag_nr) 29 | 30 | } 31 | 32 | 33 | # Use switching variable for non-panel data 34 | if(specs$model_type == 0 | specs$model_type == 1){ 35 | 36 | # Convert switching data to tibble 37 | data_set <- as.data.frame(data_set) 38 | names(data_set) <- "switch_name" 39 | 40 | # Decide whether to use HP filter. 41 | if(specs$use_hp == TRUE){ 42 | 43 | # Use HP-filter to decompose switching variable. 44 | filter_results <- hp_filter(as.matrix(data_set), specs$lambda) 45 | gamma_fz <- specs$gamma 46 | z_0 <- as.numeric(scale(filter_results[[1]], center = TRUE)) 47 | fz <- exp((-1)*gamma_fz*z_0)/(1 + exp((-1)*gamma_fz*z_0)) 48 | 49 | # Use first lag of value from switching function? 50 | if(isTRUE(specs$lag_switching)){ 51 | 52 | fz <- dplyr::lag(fz, 1) 53 | 54 | } 55 | 56 | 57 | } else { 58 | 59 | fz <- exp((-1)*specs$gamma*data_set$switch_name)/(1 + exp((-1)*specs$gamma*data_set$switch_name)) 60 | 61 | # Use first lag of value from switching function? 62 | if(isTRUE(specs$lag_switching)){ 63 | 64 | 65 | fz <- dplyr::lag(fz, 1) 66 | 67 | 68 | 69 | } 70 | 71 | 72 | } 73 | 74 | ########################### For panel data ##################################### 75 | } else { 76 | ################################################################################ 77 | 78 | # Estimate switching values for panel data 79 | if(specs$model_type == 2){ 80 | 81 | # Decide whether to use HP filter. 82 | if(isTRUE(specs$use_hp)){ 83 | 84 | # Function to use hp_filter in dplyr 85 | use_hp_dplyr <- function(data, lambda){ 86 | 87 | hp_values <- hp_filter(matrix(data), lambda) 88 | return(hp_values[[1]]) 89 | } 90 | 91 | switching_tbl <- data_set %>% 92 | dplyr::select(cross_id, date_id, specs$switching) %>% 93 | dplyr::group_by(cross_id) %>% 94 | dplyr::mutate_at(vars(specs$switching), list(~use_hp_dplyr(., specs$lambda))) %>% 95 | dplyr::rename(switching = specs$switching) %>% 96 | dplyr::ungroup() 97 | 98 | # Plug values from HP-filter into switching function 99 | gamma_fz <- specs$gamma 100 | z_0 <- as.numeric(scale(switching_tbl$switching, center = TRUE)) 101 | fz <- exp((-1)*gamma_fz*z_0)/(1 + exp((-1)*gamma_fz*z_0)) 102 | 103 | # Use first lag of value from switching function? 104 | if(isTRUE(specs$lag_switching)){ 105 | 106 | 107 | fz_df <- tibble(cross_id = data_set$cross_id, date_id = data_set$date_id, 108 | fz = fz) 109 | 110 | fz_df <- fz_df %>% 111 | dplyr::group_by(cross_id) %>% 112 | dplyr::mutate_at(vars(fz), list(~lag_function(., 1))) %>% 113 | dplyr::ungroup() 114 | 115 | fz <- fz_df$fz 116 | 117 | } 118 | 119 | 120 | return(fz) 121 | } else { 122 | 123 | 124 | fz <- exp((-1)*specs$gamma*data_set[specs$switching])/ 125 | (1 + exp((-1)*specs$gamma*data_set[specs$switching])) 126 | 127 | fz <- as.numeric(fz[, 1]) 128 | 129 | # Use first lag of value from switching function? 130 | if(isTRUE(specs$lag_switching)){ 131 | 132 | 133 | fz_df <- tibble(cross_id = data_set$cross_id, date_id = data_set$date_id, 134 | fz = fz) 135 | 136 | fz_df <- fz_df %>% 137 | dplyr::group_by(cross_id) %>% 138 | dplyr::mutate_at(vars(fz), list(~lag_function(., 1))) %>% 139 | dplyr::ungroup() 140 | 141 | fz <- fz_df$fz 142 | 143 | 144 | } 145 | } 146 | } 147 | 148 | 149 | 150 | 151 | } 152 | 153 | 154 | return(fz) 155 | 156 | } 157 | -------------------------------------------------------------------------------- /src/RcppExports.cpp: -------------------------------------------------------------------------------- 1 | // Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | #include 5 | #include 6 | 7 | using namespace Rcpp; 8 | 9 | #ifdef RCPP_USE_GLOBAL_ROSTREAM 10 | Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); 11 | Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); 12 | #endif 13 | 14 | // get_vals_lagcrit 15 | NumericVector get_vals_lagcrit(List y, List x, int lag_crit, int h, int k, int max_lags, int n_obs); 16 | RcppExport SEXP _lpirfs_get_vals_lagcrit(SEXP ySEXP, SEXP xSEXP, SEXP lag_critSEXP, SEXP hSEXP, SEXP kSEXP, SEXP max_lagsSEXP, SEXP n_obsSEXP) { 17 | BEGIN_RCPP 18 | Rcpp::RObject rcpp_result_gen; 19 | Rcpp::RNGScope rcpp_rngScope_gen; 20 | Rcpp::traits::input_parameter< List >::type y(ySEXP); 21 | Rcpp::traits::input_parameter< List >::type x(xSEXP); 22 | Rcpp::traits::input_parameter< int >::type lag_crit(lag_critSEXP); 23 | Rcpp::traits::input_parameter< int >::type h(hSEXP); 24 | Rcpp::traits::input_parameter< int >::type k(kSEXP); 25 | Rcpp::traits::input_parameter< int >::type max_lags(max_lagsSEXP); 26 | Rcpp::traits::input_parameter< int >::type n_obs(n_obsSEXP); 27 | rcpp_result_gen = Rcpp::wrap(get_vals_lagcrit(y, x, lag_crit, h, k, max_lags, n_obs)); 28 | return rcpp_result_gen; 29 | END_RCPP 30 | } 31 | // hp_filter 32 | List hp_filter(NumericVector x, double lambda); 33 | RcppExport SEXP _lpirfs_hp_filter(SEXP xSEXP, SEXP lambdaSEXP) { 34 | BEGIN_RCPP 35 | Rcpp::RObject rcpp_result_gen; 36 | Rcpp::RNGScope rcpp_rngScope_gen; 37 | Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); 38 | Rcpp::traits::input_parameter< double >::type lambda(lambdaSEXP); 39 | rcpp_result_gen = Rcpp::wrap(hp_filter(x, lambda)); 40 | return rcpp_result_gen; 41 | END_RCPP 42 | } 43 | // newey_west 44 | List newey_west(NumericVector y, NumericMatrix x, int h); 45 | RcppExport SEXP _lpirfs_newey_west(SEXP ySEXP, SEXP xSEXP, SEXP hSEXP) { 46 | BEGIN_RCPP 47 | Rcpp::RObject rcpp_result_gen; 48 | Rcpp::RNGScope rcpp_rngScope_gen; 49 | Rcpp::traits::input_parameter< NumericVector >::type y(ySEXP); 50 | Rcpp::traits::input_parameter< NumericMatrix >::type x(xSEXP); 51 | Rcpp::traits::input_parameter< int >::type h(hSEXP); 52 | rcpp_result_gen = Rcpp::wrap(newey_west(y, x, h)); 53 | return rcpp_result_gen; 54 | END_RCPP 55 | } 56 | // newey_west_pw 57 | List newey_west_pw(NumericMatrix hhat_mat, NumericMatrix xpxi_mat, NumericMatrix D_mat, int h); 58 | RcppExport SEXP _lpirfs_newey_west_pw(SEXP hhat_matSEXP, SEXP xpxi_matSEXP, SEXP D_matSEXP, SEXP hSEXP) { 59 | BEGIN_RCPP 60 | Rcpp::RObject rcpp_result_gen; 61 | Rcpp::RNGScope rcpp_rngScope_gen; 62 | Rcpp::traits::input_parameter< NumericMatrix >::type hhat_mat(hhat_matSEXP); 63 | Rcpp::traits::input_parameter< NumericMatrix >::type xpxi_mat(xpxi_matSEXP); 64 | Rcpp::traits::input_parameter< NumericMatrix >::type D_mat(D_matSEXP); 65 | Rcpp::traits::input_parameter< int >::type h(hSEXP); 66 | rcpp_result_gen = Rcpp::wrap(newey_west_pw(hhat_mat, xpxi_mat, D_mat, h)); 67 | return rcpp_result_gen; 68 | END_RCPP 69 | } 70 | // newey_west_tsls 71 | List newey_west_tsls(NumericVector y, NumericMatrix x, NumericMatrix z, int h); 72 | RcppExport SEXP _lpirfs_newey_west_tsls(SEXP ySEXP, SEXP xSEXP, SEXP zSEXP, SEXP hSEXP) { 73 | BEGIN_RCPP 74 | Rcpp::RObject rcpp_result_gen; 75 | Rcpp::RNGScope rcpp_rngScope_gen; 76 | Rcpp::traits::input_parameter< NumericVector >::type y(ySEXP); 77 | Rcpp::traits::input_parameter< NumericMatrix >::type x(xSEXP); 78 | Rcpp::traits::input_parameter< NumericMatrix >::type z(zSEXP); 79 | Rcpp::traits::input_parameter< int >::type h(hSEXP); 80 | rcpp_result_gen = Rcpp::wrap(newey_west_tsls(y, x, z, h)); 81 | return rcpp_result_gen; 82 | END_RCPP 83 | } 84 | // ols_diagnost 85 | List ols_diagnost(NumericVector y, NumericMatrix x); 86 | RcppExport SEXP _lpirfs_ols_diagnost(SEXP ySEXP, SEXP xSEXP) { 87 | BEGIN_RCPP 88 | Rcpp::RObject rcpp_result_gen; 89 | Rcpp::RNGScope rcpp_rngScope_gen; 90 | Rcpp::traits::input_parameter< NumericVector >::type y(ySEXP); 91 | Rcpp::traits::input_parameter< NumericMatrix >::type x(xSEXP); 92 | rcpp_result_gen = Rcpp::wrap(ols_diagnost(y, x)); 93 | return rcpp_result_gen; 94 | END_RCPP 95 | } 96 | // var_one 97 | List var_one(NumericMatrix VAR_Data); 98 | RcppExport SEXP _lpirfs_var_one(SEXP VAR_DataSEXP) { 99 | BEGIN_RCPP 100 | Rcpp::RObject rcpp_result_gen; 101 | Rcpp::RNGScope rcpp_rngScope_gen; 102 | Rcpp::traits::input_parameter< NumericMatrix >::type VAR_Data(VAR_DataSEXP); 103 | rcpp_result_gen = Rcpp::wrap(var_one(VAR_Data)); 104 | return rcpp_result_gen; 105 | END_RCPP 106 | } 107 | 108 | static const R_CallMethodDef CallEntries[] = { 109 | {"_lpirfs_get_vals_lagcrit", (DL_FUNC) &_lpirfs_get_vals_lagcrit, 7}, 110 | {"_lpirfs_hp_filter", (DL_FUNC) &_lpirfs_hp_filter, 2}, 111 | {"_lpirfs_newey_west", (DL_FUNC) &_lpirfs_newey_west, 3}, 112 | {"_lpirfs_newey_west_pw", (DL_FUNC) &_lpirfs_newey_west_pw, 4}, 113 | {"_lpirfs_newey_west_tsls", (DL_FUNC) &_lpirfs_newey_west_tsls, 4}, 114 | {"_lpirfs_ols_diagnost", (DL_FUNC) &_lpirfs_ols_diagnost, 2}, 115 | {"_lpirfs_var_one", (DL_FUNC) &_lpirfs_var_one, 1}, 116 | {NULL, NULL, 0} 117 | }; 118 | 119 | RcppExport void R_init_lpirfs(DllInfo *dll) { 120 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); 121 | R_useDynamicSymbols(dll, FALSE); 122 | } 123 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # lpirfs 0.2.5.9000 2 | * The development version contains a faster implementation of the HP-filter. The function is called 'hp_filter_fast()'. 3 | 4 | # lpirfs 0.2.5 5 | 6 | * Fixed bug [#50](https://github.com/AdaemmerP/lpirfs/issues/50) for computing the 7 | confidence intervals with 2SLS in `lp_lin_iv()`. 8 | 9 | # lpirfs 0.2.4 10 | 11 | * Fixed bug [#48](https://github.com/AdaemmerP/lpirfs/issues/48) for computing the standard errors 12 | for `lp_lin_iv()` when using 2SLS. 13 | * Improved documentation. 14 | 15 | # lpirfs 0.2.3 16 | 17 | * Fixed bug [#27](https://github.com/AdaemmerP/lpirfs/issues/27#issue-1656283271). 18 | * Added additional output for panel functions. Now, the full plm-objects are returned in addition to summary statistics. 19 | * Updated mail address. 20 | 21 | # lpirfs 0.2.2 22 | 23 | * Disabled the possibility *lags_exog* = 0 for functions `lp_lin()`, `lp_nl()`, `lp_lin_iv()` and `lp_nl_iv()`. Solely *contemp_data* should be used for exogenous data with contemporaneous impact. 24 | 25 | * Updated documentation for functions `lp_lin()`, `lp_nl()`, `lp_lin_iv()` and `lp_nl_iv()` regardings *exog_data* and *lags_exog*. 26 | 27 | # lpirfs 0.2.1 28 | 29 | * Added the options *cumul_mult = FALSE/TRUE* for the functions *lp_lin_iv* and *lp_nl_iv*. The default is FALSE. 30 | 31 | * Updated CITATION to use the paper by Adämmer (2019) published in The R Journal. 32 | 33 | * Updated documentation. 34 | 35 | # lpirfs 0.2.0 36 | 37 | * The dependency on the external JST data set has been removed by commenting out the examples for the panel functions. Now, the JST data set has to be downloaded by the user first, before running the examples for the panel functions. 38 | 39 | 40 | # lpirfs 0.1.9 41 | 42 | * Removed a dependency in the vignette so that it can be build again. 43 | 44 | 45 | # lpirfs 0.1.8 46 | 47 | * Fixed tests and deprecated functions to be compatible with new dplyr 1.0.0. 48 | 49 | * Fixed an issue to correctly show summary statistics 50 | 51 | 52 | # lpirfs 0.1.7 53 | 54 | 55 | * Resolved an integer/double issue with an Rcpp function so that the package can also be installed on Oracle Solaris. 56 | 57 | * Added an option to show how many lags were chosen when an information criterion has been used. 58 | 59 | 60 | 61 | # lpirfs 0.1.6 62 | 63 | 64 | * New S3 methods for all main functions to use `summary()` and `plot()` 65 | 66 | * More flexible options for the HAC estimators, such as pre-whitening, sample 67 | size adjustment, etc. 68 | 69 | * New vignette 70 | 71 | * Updated documentation 72 | 73 | 74 | 75 | # lpirfs 0.1.5 76 | 77 | * Fixed a bug for `lp_lin_panel()` and `lp_nl_panel()` regarding the construction of the 78 | endogenous and exogenous variables. 79 | 80 | * Fixed a bug for `lp_nl_panel()` when using the switching variable. 81 | 82 | * Fixed a bug for `lp_lin_panel()` and `lp_nl_panel()` when a pooling model is specified. 83 | 84 | * New checks for `lp_lin_panel()` and `lp_nl_panel()` to see whether shock variable has been dropped during estimation, 85 | potentially because of co-linearity or identification issues. 86 | 87 | * `lp_nl_panel()` now returns the (transformed) switching variable as a tibble along with the original data 88 | for comparabaility. 89 | 90 | * Updated documentation. 91 | 92 | * Updated examples. 93 | 94 | 95 | # lpirfs 0.1.4 96 | 97 | * Added two functions to estimate linear and nonlinear irfs for panel data. 98 | 99 | * Added an option to choose whether to use lagged values of the switching variable in 100 | nonlinear models. 101 | 102 | * Added an option to use a dummy approach for the nonlinear models. 103 | 104 | * Deleted messages about how models are estimated (e.g. with or without exogenous data). 105 | 106 | * Changed input name in `lp_lin_iv()` for consistency: 107 | 108 | function | old input name | new input name 109 | :--------|:------------- |:------------- 110 | `lp_lin_iv()` | `twosls` | `use_twosls` 111 | 112 | 113 | 114 | # lpirfs 0.1.3 115 | 116 | * Included an option to conduct 2SLS with `lp_lin_iv()`. 117 | 118 | * Included an option to set the lag length of the endogenous variables in `lp_lin_iv()` and `lp_nl_iv()` to zero. 119 | 120 | * Deleted the deprecated plot functions `plot_lin_irfs()` and `plot_nl_irfs()`. 121 | 122 | * Improved documentation. 123 | 124 | * Changed input names in `lp_lin_iv()` and `lp_nl_iv()` for consistency: 125 | 126 | function | old input name | new input name 127 | :--------|:------------- |:------------- 128 | `lp_lin_iv()` | `instr` | `shock` 129 | `lp_nl_iv()` | `instr` | `shock` 130 | 131 | 132 | # lpirfs 0.1.2 133 | 134 | * Fixed an error in `lp_nl()` when lags are chosen by a lag length criterion. 135 | Version 0.1.1 chooses lags based on linear instead of 136 | nonlinear data. 137 | 138 | * Removed the dependency on the *vars* package. 139 | 140 | * `lp_lin()` and `lp_nl()` now allow to include exogenous variables and exogenous variables 141 | with contemporaneous impact. 142 | 143 | * `plot_lin_irfs()` and `plot_nl_irfs()` are deprecated and have been 144 | replaced by `plot_lin()` and `plot_nl()`. 145 | 146 | * Two new functions named `lp_lin_iv()` and `lp_nl_iv()` allow to estimate 147 | linear and nonlinear impulse responses with identified shocks (instrument variables). 148 | 149 | * Input names in `lp_lin()` and `lp_nl()` have been changed for consistency: 150 | 151 | function | old input name | new input name 152 | :--------|:------------- |:------------- 153 | `lp_lin()` | `lags_lin` | `lags_endog_lin` 154 | `lp_nl()` | `lags_lin` | `lags_endog_lin` 155 | `lp_nl()` | `lags_nl` | `lags_endog_nl` 156 | `lp_nl()` | `hp_filter` | `use_hp` 157 | 158 | 159 | 160 | # lpirfs 0.1.1 161 | 162 | * The dependency on the *mFilter* package is removed. `hp_filter()` is now written in C++ to improve efficiency. 163 | 164 | * A problem with a C++ function is resolved so that the package can also be installed on Oracle Solaris. 165 | 166 | * Renamed functions: 167 | 168 | original name | new name | 169 | :--------|:------------- 170 | `lm_function` | `get_resids_ols` 171 | `reduced_var` | `get_mat_chol` 172 | `find_lag_c` | `get_vals_lagcrit` 173 | `newey_west_c` | `newey_west` 174 | `switching_series` | `get_vals_switching` 175 | 176 | 177 | # lpirfs 0.1.0 178 | * First CRAN release. 179 | -------------------------------------------------------------------------------- /R/create_lin_data.R: -------------------------------------------------------------------------------- 1 | #' @name create_lin_data 2 | #' @title Compute data for linear model 3 | #' @description Function to create data for linear model. 4 | #' @param specs A \link{list}(). Inputs are created in \link{lp_lin_iv}. 5 | #' @param endog_data A \link{data.frame} with dependent variables. 6 | #' @return List with filled matrices of lagged left (y_lin) and right hand side (x_lin) variables. 7 | #' @import dplyr 8 | #' @keywords internal 9 | #' @author Philipp Adämmer 10 | 11 | 12 | create_lin_data <- function(specs, endog_data){ 13 | 14 | # Check whether lag length is provided or has to be determined 15 | if (is.nan(specs$lags_criterion)) { 16 | 17 | # Data for endogenous variables 18 | y_lin <- endog_data 19 | 20 | # Make exogenous lagged data and check, whether lag length is zero 21 | if(specs$lags_endog_lin == 0){ 22 | 23 | x_lin <- data.frame(x = rep(Inf, nrow(endog_data))) 24 | 25 | } else { 26 | 27 | x_lin <- create_lags(endog_data, specs$lags_endog_lin) 28 | 29 | } 30 | 31 | # Check whether model type is 'iv'. 32 | # 0 = Normal model, 1 = IV model 33 | # Prepare instrument variable and add to exogenous data 34 | if(specs$model_type == 1){ 35 | 36 | shock <- specs$shock 37 | colnames(shock) <- 'shock' 38 | x_lin <- cbind(shock, x_lin) 39 | 40 | } 41 | 42 | # Include no trend, trend or quadratic trend 43 | if (specs$trend == 0){ 44 | 45 | x_lin <- x_lin 46 | 47 | } else if (specs$trend == 1){ 48 | 49 | x_lin <- x_lin %>% 50 | dplyr::mutate(trend = row_number()) 51 | 52 | } else { 53 | 54 | x_lin <- x_lin %>% 55 | dplyr::mutate(trend = row_number()) %>% 56 | dplyr::mutate(sq_trend = trend^2) 57 | } 58 | 59 | 60 | 61 | # Construct (lagged) exogenous data and merge it with lagged endogenous data 62 | if(!(is.null(specs$exog_data))){ 63 | 64 | x_exog <- create_lags(specs$exog_data, specs$lags_exog) %>% 65 | `rownames<-`(NULL) 66 | 67 | x_lin <- cbind(x_lin, x_exog) 68 | 69 | } 70 | 71 | # Add contemporaneous data if supplied 72 | if(!(is.null(specs$contemp_data))){ 73 | 74 | x_contemp <- specs$contemp_data 75 | 76 | x_lin <- cbind(x_lin, x_contemp) 77 | 78 | } 79 | 80 | # Combine endogenous and exogenous data 81 | yx_all <- cbind(y_lin, x_lin) %>% 82 | stats::na.omit() 83 | 84 | yx_all <- yx_all[, !(colSums(yx_all) == Inf)] 85 | 86 | 87 | y_lin <- yx_all[, 1:ncol(endog_data)] %>% 88 | as.matrix() 89 | 90 | x_lin <- yx_all[, (ncol(endog_data) + 1):dim(yx_all)[2]] %>% 91 | as.matrix() 92 | 93 | 94 | 95 | # Check whether z_lin matrix has to be build for 2sls 96 | if(specs$use_twosls == TRUE){ 97 | 98 | # Compare lag length between endog_lin and lags_exog 99 | z_lag <- max(specs$lags_endog_lin, specs$lags_exog) 100 | z_lin <- x_lin[, -1] 101 | z_lin <- cbind(specs$instrum[(z_lag + 1):dim(specs$instrum)[1], ], z_lin) 102 | 103 | # Set instrument variable to NULL if use_twosls = FALSE 104 | } else { 105 | z_lin <- NULL 106 | } 107 | 108 | 109 | ################################################################################ 110 | } else { 111 | ################################################################################ 112 | 113 | # Create list to store lagged data 114 | y_lin_store <- rep(list(NaN), specs$max_lags) 115 | x_lin_store <- rep(list(NaN), specs$max_lags) 116 | z_lin_store <- rep(list(NaN), specs$max_lags) 117 | 118 | y_lin <- endog_data 119 | 120 | 121 | 122 | # Make lag data based on max lag lengths 123 | for(i in 1:specs$max_lags){ 124 | 125 | x_lin <- (create_lags(endog_data, i)) 126 | 127 | 128 | if(specs$model_type == 1){ 129 | # Prepare instrument variable 130 | shock <- specs$shock 131 | # Add instrument to 'exogenous' data 132 | x_lin <- cbind(shock, x_lin) 133 | } 134 | 135 | # Include no trend, trend or quadratic trend 136 | if (specs$trend == 0){ 137 | 138 | x_lin <- x_lin 139 | 140 | } else if (specs$trend == 1){ 141 | 142 | x_lin <- x_lin %>% 143 | dplyr::mutate(trend = row_number()) 144 | 145 | } else { 146 | 147 | x_lin <- x_lin %>% 148 | dplyr::mutate(trend = row_number()) %>% 149 | dplyr::mutate(sq_trend = trend^2) 150 | } 151 | 152 | 153 | # Add exogenous data and merge with endogenous data 154 | if(!(is.null(specs$exog_data))){ 155 | 156 | x_exog <- create_lags(specs$exog_data, specs$lags_exog) %>% 157 | `rownames<-`(NULL) 158 | 159 | x_lin <- cbind(x_lin, x_exog) 160 | 161 | } 162 | 163 | # Add contemporaneous data if supplied 164 | if(!(is.null(specs$contemp_data))){ 165 | 166 | x_contemp <- specs$contemp_data 167 | x_lin <- cbind(x_lin, x_contemp) 168 | 169 | } 170 | 171 | 172 | 173 | # Merge all and extract exogenous and endogenous data 174 | yx_all <- cbind(y_lin, x_lin) %>% 175 | stats::na.omit() 176 | 177 | y_lin_store[[i]] <- yx_all[, 1:ncol(endog_data)] %>% 178 | as.matrix() 179 | 180 | x_lin_store[[i]] <- yx_all[, (ncol(endog_data) + 1):dim(yx_all)[2]] %>% 181 | as.matrix() 182 | 183 | # Check whether z_lin matrix has to be build for 2sls 184 | if(specs$use_twosls == TRUE){ 185 | 186 | # Compare lag length between endog_lin and lags_exog 187 | z_lag <- max(i, specs$lags_exog) 188 | z_lin <- x_lin_store[[i]][, -1] 189 | z_lin <- cbind(specs$instrum[(z_lag + 1):dim(specs$instrum)[1], ], z_lin) 190 | z_lin_store[[i]] <- z_lin 191 | 192 | } else {} 193 | 194 | 195 | 196 | } 197 | 198 | # Save values te return in list 199 | y_lin <- y_lin_store 200 | x_lin <- x_lin_store 201 | 202 | # Set instrument variable to NULL if use_twosls = FALSE 203 | if(specs$use_twosls == FALSE){ 204 | 205 | z_lin <- NULL 206 | 207 | } else { 208 | 209 | z_lin <- z_lin_store 210 | 211 | } 212 | 213 | } 214 | 215 | # Return list with exogenous, endogenous data, and iv data 216 | return(list(y_lin, x_lin, z_lin)) 217 | 218 | } 219 | -------------------------------------------------------------------------------- /R/plot_nl.R: -------------------------------------------------------------------------------- 1 | #' @name plot_nl 2 | #' @title Compute and display plots of nonlinear impulse responses 3 | #' @description Compute and display (nonlinear) impulse responses, estimated with \link{lp_nl}() and \link{lp_nl_iv}(). 4 | #' @param results_nl A \link{list} created with \link{lp_nl}() or \link{lp_nl_iv}(). 5 | #' @return A list with (gg-)plots for nonlinear impulse responses. 6 | #' @export 7 | #' @import ggplot2 8 | #' @author Philipp Adämmer 9 | #' @examples 10 | #'\donttest{ 11 | #'# Load package 12 | #' 13 | #' # See examples for lp_nl() and lp_nl_iv(). 14 | #' 15 | #' } 16 | plot_nl <- function(results_nl){ 17 | 18 | col_regime_1 <- "#21618C" 19 | col_regime_2 <- "#D68910" 20 | 21 | specs <- results_nl$specs 22 | 23 | if(specs$model_type == 0){ 24 | 25 | irf_s1_mean <- results_nl[[1]] 26 | irf_s1_low <- results_nl[[2]] 27 | irf_s1_up <- results_nl[[3]] 28 | 29 | irf_s2_mean <- results_nl[[4]] 30 | irf_s2_low <- results_nl[[5]] 31 | irf_s2_up <- results_nl[[6]] 32 | 33 | gg_s1 <- rep(list(NaN), specs$endog*specs$endog) 34 | gg_s2 <- rep(list(NaN), specs$endog*specs$endog) 35 | plot_num <- 1 36 | 37 | 38 | 39 | for(rr in 1:(specs$endog)){ 40 | for (ss in 1:(specs$endog)){ 41 | 42 | # Tibbles for expansion irfs 43 | tbl_s1_mean <- as.matrix(t(irf_s1_mean[, 1:specs$hor , ss]))[, rr] 44 | tbl_s1_low <- as.matrix(t(irf_s1_low[, 1:specs$hor , ss]))[, rr] 45 | tbl_s1_up <- as.matrix(t(irf_s1_up[, 1:specs$hor , ss]))[, rr] 46 | 47 | tbl_s1 <- data.frame(x = 1:specs$hor, mean = tbl_s1_mean, 48 | low = tbl_s1_low, up = tbl_s1_up) 49 | 50 | # Tibbles for recessions irfs 51 | tbl_s1_mean <- as.matrix(t(irf_s2_mean[, 1:specs$hor , ss]))[, rr] 52 | tbl_s2_low <- as.matrix(t(irf_s2_low[, 1:specs$hor , ss]))[, rr] 53 | tbl_s2_up <- as.matrix(t(irf_s2_up[, 1:specs$hor , ss]))[, rr] 54 | 55 | tbl_s2 <- data.frame(x = 1:specs$hor, mean = tbl_s1_mean, 56 | low = tbl_s2_low, up = tbl_s2_up) 57 | 58 | 59 | gg_s1[[plot_num]] <- ggplot() + 60 | geom_line(data = tbl_s1, aes(y = mean, x = x), col = col_regime_1) + 61 | geom_ribbon(data = tbl_s1, aes(x = x, ymin = low, ymax = up), col = 'grey', 62 | fill = 'grey', alpha = 0.3) + 63 | theme_classic() + 64 | ggtitle(paste(specs$column_names[ss], 'on', specs$column_names[rr], sep=" ")) + 65 | xlab('') + 66 | ylab('') + 67 | theme(title = element_text(size = 6), 68 | plot.title = element_text(hjust = 0.5)) + 69 | scale_y_continuous(expand = c(0, 0)) + 70 | scale_x_continuous(expand = c(0, 0), 71 | breaks = seq(0, specs$hor, 2)) + 72 | geom_hline(yintercept = 0, col = "black", linewidth = 0.25, linetype = "dashed") 73 | 74 | 75 | gg_s2[[plot_num]] <- ggplot() + 76 | geom_line(data = tbl_s2, aes(y = mean, x = x) , col = col_regime_2) + 77 | geom_ribbon(data = tbl_s2, aes(x = x, ymin = low, ymax = up), col = 'grey', 78 | fill = 'grey', alpha = 0.3) + 79 | theme_classic() + 80 | ggtitle(paste(specs$column_names[ss], 'on', specs$column_names[rr], sep=" ")) + 81 | xlab('') + 82 | ylab('') + 83 | theme(title = element_text(size = 6), 84 | plot.title = element_text(hjust = 0.5)) + 85 | scale_y_continuous(expand = c(0, 0)) + 86 | scale_x_continuous(expand = c(0, 0), 87 | breaks = seq(0, specs$hor, 2)) + 88 | geom_hline(yintercept = 0, col = "black", linewidth = 0.25, linetype = "dashed") 89 | 90 | plot_num <- plot_num + 1 91 | 92 | 93 | } 94 | 95 | } 96 | } else if(specs$model_type == 1| specs$model_type == 2){ 97 | 98 | 99 | 100 | gg_s1 <- rep(list(NaN), specs$endog) 101 | gg_s2 <- rep(list(NaN), specs$endog) 102 | plot_num <- 1 103 | 104 | for(rr in 1:(specs$endog)){ 105 | 106 | # Tibbles for expansion irfs 107 | tbl_s1_mean <- results_nl$irf_s1_mean[rr, ] 108 | tbl_s1_low <- results_nl$irf_s1_low[rr, ] 109 | tbl_s1_up <- results_nl$irf_s1_up[rr, ] 110 | 111 | tbl_s1 <- data.frame(x = 1:specs$hor, mean = tbl_s1_mean, 112 | low = tbl_s1_low, up = tbl_s1_up) 113 | 114 | # Tibbles for recessions irfs 115 | tbl_s2_mean <- results_nl$irf_s2_mean[rr, ] 116 | tbl_s2_low <- results_nl$irf_s2_low[rr, ] 117 | tbl_s2_up <- results_nl$irf_s2_up[rr, ] 118 | 119 | tbl_s2 <- data.frame(x = 1:specs$hor, mean = tbl_s2_mean, 120 | low = tbl_s2_low, up = tbl_s2_up) 121 | 122 | 123 | gg_s1[[rr]] <- ggplot() + 124 | geom_line(data = tbl_s1, aes(y = mean, x = x), col = col_regime_1) + 125 | geom_ribbon(data = tbl_s1, aes(x = x, ymin = low, ymax = up), col = 'grey', 126 | fill = 'grey', alpha = 0.3) + 127 | theme_classic() + 128 | ggtitle(paste('Shock', 'on', specs$column_names[rr], sep=" ")) + 129 | xlab('') + 130 | ylab('') + 131 | theme(title = element_text(size = 6), 132 | plot.title = element_text(hjust = 0.5)) + 133 | scale_y_continuous(expand = c(0, 0)) + 134 | scale_x_continuous(expand = c(0, 0), 135 | breaks = seq(0, specs$hor, 2)) + 136 | geom_hline(yintercept = 0, col = "black", linewidth = 0.25, linetype = "dashed") 137 | 138 | 139 | gg_s2[[rr]] <- ggplot() + 140 | geom_line(data = tbl_s2, aes(y = mean, x = x) , col = col_regime_2) + 141 | geom_ribbon(data = tbl_s2, aes(x = x, ymin = low, ymax = up), col = 'grey', 142 | fill = 'grey', alpha = 0.3) + 143 | theme_classic() + 144 | ggtitle(paste('Shock', 'on', specs$column_names[rr], sep=" ")) + 145 | xlab('') + 146 | ylab('') + 147 | theme(title = element_text(size = 6), 148 | plot.title = element_text(hjust = 0.5)) + 149 | scale_y_continuous(expand = c(0, 0)) + 150 | scale_x_continuous(expand = c(0, 0), 151 | breaks = seq(0, specs$hor, 2)) + 152 | geom_hline(yintercept = 0, col = "black", linewidth = 0.25, linetype = "dashed") 153 | 154 | 155 | } 156 | 157 | 158 | 159 | 160 | 161 | 162 | 163 | 164 | 165 | } 166 | 167 | list (gg_s1 = gg_s1, gg_s2 = gg_s2) 168 | 169 | } 170 | -------------------------------------------------------------------------------- /man/lp_lin.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lp_lin.R 3 | \name{lp_lin} 4 | \alias{lp_lin} 5 | \title{Compute linear impulse responses} 6 | \usage{ 7 | lp_lin( 8 | endog_data, 9 | lags_endog_lin = NULL, 10 | lags_criterion = NaN, 11 | max_lags = NaN, 12 | trend = NULL, 13 | shock_type = NULL, 14 | confint = NULL, 15 | use_nw = TRUE, 16 | nw_lag = NULL, 17 | nw_prewhite = FALSE, 18 | adjust_se = FALSE, 19 | hor = NULL, 20 | exog_data = NULL, 21 | lags_exog = NULL, 22 | contemp_data = NULL, 23 | num_cores = 1 24 | ) 25 | } 26 | \arguments{ 27 | \item{endog_data}{A \link{data.frame}, containing the endogenous variables for the VAR. The Cholesky decomposition is based on the 28 | column order.} 29 | 30 | \item{lags_endog_lin}{NaN or integer. NaN if lag length criterion is used. Integer for number of lags for \emph{endog_data}.} 31 | 32 | \item{lags_criterion}{NaN or character. NaN (default) means that the number of lags 33 | has to be given at \emph{lags_endog_lin}. The character specifies the lag length criterion ('AICc', 'AIC' or 'BIC').} 34 | 35 | \item{max_lags}{NaN or integer. Maximum number of lags if \emph{lags_criterion} is given. NaN (default) otherwise.} 36 | 37 | \item{trend}{Integer. No trend = 0 , include trend = 1, include trend and quadratic trend = 2.} 38 | 39 | \item{shock_type}{Integer. Standard deviation shock = 0, unit shock = 1.} 40 | 41 | \item{confint}{Double. Width of confidence bands. 68\% = 1; 90\% = 1.65; 95\% = 1.96.} 42 | 43 | \item{use_nw}{Boolean. Use Newey-West (1987) standard errors for impulse responses? TRUE (default) or FALSE.} 44 | 45 | \item{nw_lag}{Integer. Specifies the maximum lag with positive weight for the Newey-West estimator. If set to NULL (default), the lag increases with 46 | with the number of horizon.} 47 | 48 | \item{nw_prewhite}{Boolean. Should the estimators be pre-whitened? TRUE or FALSE (default).} 49 | 50 | \item{adjust_se}{Boolen. Should a finite sample adjsutment be made to the covariance matrix estimators? TRUE or FALSE (default).} 51 | 52 | \item{hor}{Integer. Number of horizons for impulse responses.} 53 | 54 | \item{exog_data}{A \link{data.frame}, containing exogenous variables for the VAR. The row length has to be the same as \emph{endog_data}. 55 | Lag lengths for exogenous variables have to be given and will not be determined via a lag length criterion.} 56 | 57 | \item{lags_exog}{NULL or Integer. Integer for the number of lags for the exogenous data. The value cannot be 0. If you want to 58 | to include exogenous data with contemporaneous impact use \emph{contemp_data}.} 59 | 60 | \item{contemp_data}{A \link{data.frame}, containing exogenous data with contemporaneous impact. This data will not be lagged. 61 | The row length has to be the same as \emph{endog_data}.} 62 | 63 | \item{num_cores}{NULL or Integer. The number of cores to use for the estimation. If NULL, the function will 64 | use the maximum number of cores minus one.} 65 | } 66 | \value{ 67 | A list containing: 68 | 69 | 70 | \item{irf_lin_mean}{A three 3D \link{array}, containing all impulse responses for all endogenous variables. 71 | The last dimension denotes the shock variable. The row in each matrix 72 | gives the responses of the \emph{ith} variable, ordered as in endog_data. The columns denote the horizons. 73 | For example, if \emph{results_lin} contains the list with results, results_lin$irf_lin_mean[, , 1] returns a KXH matrix, 74 | where K is the number of variables and H the number of horizons. '1' is the shock variable, corresponding to the 75 | first variable in \emph{endog_data}.} 76 | 77 | \item{irf_lin_low}{A three 3D \link{array} containing all lower confidence bands of the responses, 78 | based on robust standard errors by Newey and West (1987). Properties are equal to irf_lin_mean.} 79 | 80 | \item{irf_lin_up}{A three 3D \link{array} containing all upper confidence bands of the responses, 81 | based on robust standard errors by Newey and West (1987). Properties are equal to \emph{irf_lin_mean}.} 82 | 83 | \item{diagnostic_list}{A list OLS diagnostics. To see everything you can simply use summary() or results$diagnostic_list. The first entry 84 | the shock variable. The rows of each shown matrix then denotes the endogenous variable that reacts to the shock.} 85 | 86 | \item{specs}{A list with properties of \emph{endog_data} for the plot function. It also contains 87 | lagged data (y_lin and x_lin) used for the irf estimations, and the selected lag lengths when an information criterion has been used.} 88 | } 89 | \description{ 90 | Compute linear impulse responses with local projections by Jordà (2005). 91 | } 92 | \examples{ 93 | \donttest{ 94 | ## Example without exogenous variables 95 | 96 | # Load package 97 | library(lpirfs) 98 | 99 | # Load (endogenous) data 100 | endog_data <- interest_rules_var_data 101 | 102 | # Estimate linear model 103 | results_lin <- lp_lin(endog_data, 104 | lags_endog_lin = 4, 105 | trend = 0, 106 | shock_type = 1, 107 | confint = 1.96, 108 | hor = 12) 109 | 110 | # Show all impule responses 111 | # Compare with Figure 5 in Jordà (2005) 112 | plot(results_lin) 113 | 114 | # Make individual plots 115 | linear_plots <- plot_lin(results_lin) 116 | 117 | # Show single plots 118 | # * The first element of 'linear_plots' shows the response of the first 119 | # variable (GDP_gap) to a shock in the first variable (GDP_gap). 120 | # * The second element of 'linear_plots' shows the response of the first 121 | # variable (GDP_gap) to a shock in the second variable (inflation). 122 | # * ... 123 | 124 | linear_plots[[1]] 125 | linear_plots[[2]] 126 | 127 | 128 | # Show diagnostics. The first element correponds to the first shock variable. 129 | summary(results_lin) 130 | 131 | 132 | ## Example with exogenous variables ## 133 | 134 | # Load (endogenous) data 135 | endog_data <- interest_rules_var_data 136 | 137 | # Create exogenous data and data with contemporaneous impact (for illustration purposes only) 138 | exog_data <- endog_data$GDP_gap*endog_data$Infl*endog_data$FF + rnorm(dim(endog_data)[1]) 139 | contemp_data <- endog_data$GDP_gap*endog_data$Infl*endog_data$FF + rnorm(dim(endog_data)[1]) 140 | 141 | # Exogenous data has to be a data.frame 142 | exog_data <- data.frame(xx = exog_data ) 143 | contemp_data <- data.frame(cc = contemp_data) 144 | 145 | # Estimate linear model 146 | results_lin <- lp_lin(endog_data, 147 | lags_endog_lin = 4, 148 | trend = 0, 149 | shock_type = 1, 150 | confint = 1.96, 151 | hor = 12, 152 | exog_data = exog_data, 153 | lags_exog = 4, 154 | contemp_data = contemp_data) 155 | 156 | # Show all impulse responses 157 | plot(results_lin) 158 | 159 | # Show diagnostics. The first element correponds to the first shock variable. 160 | summary(results_lin) 161 | 162 | } 163 | } 164 | \references{ 165 | Akaike, H. (1974). "A new look at the statistical model identification", \emph{IEEE Transactions on Automatic Control}, 19 (6): 716–723. 166 | 167 | Hurvich, C. M., and Tsai, C.-L. (1989), "Regression and time series model selection in small samples", 168 | \emph{Biometrika}, 76(2): 297–307 169 | 170 | Jordà, Ò. (2005). "Estimation and Inference of Impulse Responses by Local Projections." 171 | \emph{American Economic Review}, 95 (1): 161-182. 172 | 173 | Newey, W.K., and West, K.D. (1987). “A Simple, Positive-Definite, Heteroskedasticity and 174 | Autocorrelation Consistent Covariance Matrix.” \emph{Econometrica}, 55: 703–708. 175 | 176 | Schwarz, Gideon E. (1978). "Estimating the dimension of a model", \emph{Annals of Statistics}, 6 (2): 461–464. 177 | } 178 | \seealso{ 179 | \url{https://adaemmerp.github.io/lpirfs/README_docs.html} 180 | } 181 | \author{ 182 | Philipp Adämmer 183 | } 184 | -------------------------------------------------------------------------------- /R/lpirfs_obj-methods-base.R: -------------------------------------------------------------------------------- 1 | #' Base methods for lpirfs_obj objects 2 | #' @name lpirfs_obj-methods-base 3 | 4 | NULL 5 | 6 | ######################### lpirfs_lin_obj ############################################# 7 | 8 | #' @name plot.lpirfs_lin_obj 9 | #' @title Base print() function to plot all impulse responses from linear lpirfs object 10 | #' @export 11 | #' @param x An object of type 'lpirfs_lin_obj 12 | #' @param ... Additional arguments to be consistent with S3 print() function 13 | #' @importFrom gridExtra marrangeGrob 14 | #' @importFrom ggplot2 ggplotGrob 15 | #' @method plot lpirfs_lin_obj 16 | 17 | plot.lpirfs_lin_obj <- function(x, ...){ 18 | 19 | # Extract number for column names 20 | nr_cols <- x$specs$endog 21 | 22 | lin_plots <- plot_lin(x) 23 | 24 | # Save plots based on states 25 | lin_plots_all <- sapply(lin_plots, ggplotGrob) 26 | 27 | # Show all plots 28 | gridExtra::marrangeGrob(lin_plots_all, nrow = nr_cols, ncol = nr_cols, top = NULL) 29 | 30 | 31 | } 32 | 33 | #' @name summary.lpirfs_lin_obj 34 | #' @title Summary for linear lpirfs object 35 | #' @export 36 | #' @param object An object of type 'lpirfs_lin_obj' 37 | #' @param ... Additional arguments to be consistent with S3 print() function 38 | #' @method summary lpirfs_lin_obj 39 | summary.lpirfs_lin_obj <- function(object, ...){ 40 | 41 | object[[4]] 42 | 43 | } 44 | 45 | 46 | ######################### lpirfs_nl_obj ############################################# 47 | 48 | 49 | #' @name plot.lpirfs_nl_obj 50 | #' @title Base print() function to plot all impulse responses from nonlinear lpirfs object 51 | #' @export 52 | #' @param x An object of type 'lpirfs_nl_obj' 53 | #' @param ... Additional arguments to be consistent with S3 print() function 54 | #' @importFrom gridExtra marrangeGrob 55 | #' @importFrom ggplot2 ggplotGrob 56 | #' @method plot lpirfs_nl_obj 57 | 58 | plot.lpirfs_nl_obj <- function(x, ...){ 59 | 60 | 61 | # Make and save all plots 62 | nl_plots <- plot_nl(x) 63 | 64 | # Number of columns 65 | nr_cols <- x$specs$endog 66 | 67 | # Save plots based on states 68 | s1_plots <- sapply(nl_plots$gg_s1, ggplotGrob) 69 | s2_plots <- sapply(nl_plots$gg_s2, ggplotGrob) 70 | 71 | # Show all plots 72 | result_1 <- marrangeGrob(s1_plots, nrow = nr_cols, ncol = nr_cols, top = NULL) 73 | result_2 <- marrangeGrob(s2_plots, nrow = nr_cols, ncol = nr_cols, top = NULL) 74 | 75 | list(result_1, result_2) 76 | 77 | 78 | } 79 | 80 | #' @name summary.lpirfs_nl_obj 81 | #' @title Summary for nonlinear lpirfs object 82 | #' @export 83 | #' @param object An object of type 'lpirfs_nl_obj' 84 | #' @param ... Additional arguments to be consistent with S3 print() function 85 | #' @method summary lpirfs_nl_obj 86 | summary.lpirfs_nl_obj <- function(object, ...){ 87 | 88 | object[[9]] 89 | 90 | 91 | } 92 | 93 | 94 | ######################### lpirfs_lin_iv_obj ############################################ 95 | 96 | #' @name plot.lpirfs_lin_iv_obj 97 | #' @title Base print() function to plot all impulse responses from linear lpirfs object 98 | #' @export 99 | #' @param x An object of type 'lpirfs_lin_obj 100 | #' @param ... Additional arguments to be consistent with S3 print() function 101 | #' @importFrom gridExtra marrangeGrob 102 | #' @importFrom ggplot2 ggplotGrob 103 | #' @method plot lpirfs_lin_iv_obj 104 | 105 | plot.lpirfs_lin_iv_obj <- function(x, ...){ 106 | 107 | # Extract number for column names 108 | nr_cols <- x$specs$endog 109 | 110 | lin_plots <- plot_lin(x) 111 | 112 | # Save plots based on states 113 | lin_plots_all <- sapply(lin_plots, ggplotGrob) 114 | 115 | # Show all plots 116 | gridExtra::marrangeGrob(lin_plots_all, nrow = nr_cols, ncol = 1, top = NULL) 117 | 118 | 119 | } 120 | 121 | 122 | #' @name summary.lpirfs_lin_iv_obj 123 | #' @title Summary for nonlinear lpirfs object 124 | #' @export 125 | #' @param object An object of type 'lpirfs_lin_iv_obj' 126 | #' @param ... Additional arguments to be consistent with S3 print() function 127 | #' @method summary lpirfs_lin_iv_obj 128 | summary.lpirfs_lin_iv_obj <- function(object, ...){ 129 | 130 | object[[4]] 131 | 132 | 133 | } 134 | 135 | 136 | ######################### lpirfs_nl_iv_obj ############################################ 137 | 138 | 139 | #' @name plot.lpirfs_nl_iv_obj 140 | #' @title Base print() function to plot all impulse responses from linear lpirfs object 141 | #' @export 142 | #' @param x An object of type 'lpirfs_nl_iv_obj' 143 | #' @param ... Additional arguments to be consistent with S3 print() function 144 | #' @importFrom gridExtra marrangeGrob 145 | #' @importFrom ggplot2 ggplotGrob 146 | #' @method plot lpirfs_nl_iv_obj 147 | 148 | plot.lpirfs_nl_iv_obj <- function(x, ...){ 149 | 150 | # Make and save all plots 151 | nl_plots <- plot_nl(x) 152 | 153 | # Number of columns 154 | nr_cols <- x$specs$endog 155 | 156 | # Save plots based on states 157 | s1_plots <- sapply(nl_plots$gg_s1, ggplotGrob) 158 | s2_plots <- sapply(nl_plots$gg_s2, ggplotGrob) 159 | 160 | # Show all plots 161 | result_1 <- marrangeGrob(s1_plots, nrow = nr_cols, ncol = 1, top = NULL) 162 | result_2 <- marrangeGrob(s2_plots, nrow = nr_cols, ncol = 1, top = NULL) 163 | 164 | list(result_1, result_2) 165 | 166 | 167 | 168 | } 169 | 170 | 171 | 172 | #' @name summary.lpirfs_nl_iv_obj 173 | #' @title Summary for nonlinear lpirfs object 174 | #' @export 175 | #' @param object An object of type 'lpirfs_nl_iv_obj' 176 | #' @param ... Additional arguments to be consistent with S3 print() function 177 | #' @method summary lpirfs_nl_iv_obj 178 | summary.lpirfs_nl_iv_obj <- function(object, ...){ 179 | 180 | object[[7]] 181 | 182 | 183 | } 184 | 185 | 186 | 187 | ######################### lpirfs_lin_panel_obj ############################################ 188 | 189 | 190 | 191 | #' @name plot.lpirfs_lin_panel_obj 192 | #' @title Base print() function to plot all impulse responses from linear lpirfs object 193 | #' @export 194 | #' @param x An object of type 'lpirfs_lin_panel_obj' 195 | #' @param ... Additional arguments to be consistent with S3 print() function 196 | #' @importFrom gridExtra marrangeGrob 197 | #' @importFrom ggplot2 ggplotGrob 198 | #' @importFrom graphics plot 199 | #' @method plot lpirfs_lin_panel_obj 200 | 201 | plot.lpirfs_lin_panel_obj <- function(x, ...){ 202 | 203 | # Extract number for column names 204 | nr_cols <- x$specs$endog 205 | 206 | plot_lin_panel <- plot_lin(x) 207 | 208 | plot(plot_lin_panel[[1]]) 209 | 210 | 211 | } 212 | 213 | 214 | #' @name summary.lpirfs_lin_panel_obj 215 | #' @title Summary for nonlinear lpirfs object 216 | #' @export 217 | #' @param object An object of type 'lpirfs_lin_panel_obj' 218 | #' @param ... Additional arguments to be consistent with S3 print() function 219 | #' @method summary lpirfs_lin_panel_obj 220 | summary.lpirfs_lin_panel_obj <- function(object, ...){ 221 | 222 | object[[7]] 223 | 224 | 225 | } 226 | 227 | 228 | 229 | ######################### lpirfs_nl_panel_obj ############################################ 230 | 231 | 232 | 233 | #' @name plot.lpirfs_nl_panel_obj 234 | #' @title Base print() function to plot all impulse responses from linear lpirfs object 235 | #' @export 236 | #' @param x An object of type 'lpirfs_lin_panel_obj' 237 | #' @param ... Additional arguments to be consistent with S3 print() function 238 | #' @importFrom gridExtra marrangeGrob 239 | #' @importFrom ggplot2 ggplotGrob 240 | #' @method plot lpirfs_nl_panel_obj 241 | 242 | plot.lpirfs_nl_panel_obj <- function(x, ...){ 243 | 244 | # Extract number for column names 245 | nr_cols <- x$specs$endog 246 | 247 | plot_nl_panel <- plot_nl(x) 248 | 249 | 250 | combine_plots <- list(plot_nl_panel$gg_s1[[1]], plot_nl_panel$gg_s2[[1]]) 251 | marrangeGrob(combine_plots, nrow = 1, ncol = 2, top = NULL) 252 | 253 | 254 | 255 | } 256 | 257 | 258 | #' @name summary.lpirfs_nl_panel_obj 259 | #' @title Summary for nonlinear lpirfs object 260 | #' @export 261 | #' @param object An object of type 'lpirfs_lin_panel_obj' 262 | #' @param ... Additional arguments to be consistent with S3 print() function 263 | #' @method summary lpirfs_nl_panel_obj 264 | summary.lpirfs_nl_panel_obj <- function(object, ...){ 265 | 266 | object[[7]] 267 | 268 | 269 | } 270 | 271 | 272 | 273 | 274 | -------------------------------------------------------------------------------- /R/RcppExports.R: -------------------------------------------------------------------------------- 1 | # Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | #' @name get_vals_lagcrit 5 | #' @title Compute values for lag length criteria 6 | #' @description Compute values for 'AICc', 'AIC', or 'BIC'. 7 | #' 8 | #' @param y List with left (endogenous) variables. 9 | #' @param x List with right (exogenous) variables. 10 | #' @param lag_crit Integer: 'AICc'= 1, 'AIC' = 2, 'BIC' = 3. 11 | #' @param h Integer. 12 | #' @param k Integer. 13 | #' @param max_lags Integer. 14 | #' @references 15 | #' 16 | #' Akaike, H. (1974). "A new look at the statistical model identification", \emph{IEEE Transactions on Automatic Control}, 19 (6): 716–723. 17 | NULL 18 | 19 | #' Hurvich, C. M., and Tsai, C.-L. (1989). "Regression and time series model selection 20 | #' in small samples", Biometrika, 76(2): 297–307, 21 | #' 22 | #' Schwarz, Gideon E. (1978). "Estimating the dimension of a model", \emph{Annals of Statistics}, 6 (2): 461–464. 23 | #' 24 | #' @keywords internal 25 | get_vals_lagcrit <- function(y, x, lag_crit, h, k, max_lags, n_obs) { 26 | .Call(`_lpirfs_get_vals_lagcrit`, y, x, lag_crit, h, k, max_lags, n_obs) 27 | } 28 | 29 | #' @name hp_filter 30 | #' @title Decompose a times series via the Hodrick-Prescott filter 31 | #' @description Estimate cyclical and trend component with filter by Hodrick and Prescott (1997). 32 | #' The function is based on the function \emph{hpfilter} from the archived \emph{mFilter}-package. 33 | #' @param x One column matrix with numeric values. 34 | #' @param lambda Numeric value. 35 | #' @return A list. The first element contains the cyclical component and the second element the trend component. 36 | #' @examples 37 | #' \donttest{ 38 | #' library(lpirfs) 39 | #' 40 | #' 41 | #'# Decompose the Federal Funds Rate 42 | #' data_set <- as.matrix(interest_rules_var_data$FF) 43 | #' hp_results <- hp_filter(data_set, 1600) 44 | #' 45 | #'# Extract results and save as data.frame 46 | #' hp_cyc <- as.data.frame(hp_results[[1]]) 47 | #' hp_trend <- as.data.frame(hp_results[[2]]) 48 | #' 49 | #'# Make data.frames for plots 50 | #' cyc_df <- data.frame(yy = hp_cyc$V1, xx = seq(as.Date('1955-01-01'), 51 | #' as.Date('2003-01-01') , "quarter")) 52 | #' trend_df <- data.frame(yy = hp_trend$V1, xx = seq(as.Date('1955-01-01'), 53 | #' as.Date('2003-01-01') , "quarter")) 54 | #' 55 | #'# Make plots 56 | #' library(ggplot2) 57 | #' 58 | #'# Plot cyclical part 59 | #' ggplot(data = cyc_df) + 60 | #' geom_line(aes(y = yy, x = xx)) 61 | #' 62 | #'# Plot trend component 63 | #' ggplot(trend_df) + 64 | #' geom_line(aes(y = yy, x = xx)) 65 | #' 66 | #'} 67 | #' @references 68 | #' Hodrick, R.J., and Prescott, E. C. (1997). "Postwar U.S. Business Cycles: An Empirical Investigation." 69 | #' \emph{Journal of Money, Credit and Banking}, 29(1), 1-16. 70 | #' 71 | #' Ravn, M.O., Uhlig, H. (2002). "On Adjusting the Hodrick-Prescott Filter for the Frequency of Observations." 72 | #' \emph{Review of Economics and Statistics}, 84(2), 371-376. 73 | #' @author Philipp Adämmer 74 | hp_filter <- function(x, lambda) { 75 | .Call(`_lpirfs_hp_filter`, x, lambda) 76 | } 77 | 78 | #' @name newey_west 79 | #' @title Compute OLS parameters and robust standard errors based on Newey-West estimator 80 | #' @description Compute OLS parameters and robust standard errors based on Newey and West (1987). 81 | #' The function is based on the Matlab code by James P. LeSage. 82 | #' @param y Numeric vector. 83 | #' @param x Numeric matrix. 84 | #' @param h Integer. 85 | #' @return A list. The first element contains the estimated OLS parameters, the second element 86 | #' the Newey West covariance matrix, the third element the estimated functions, the fourth element 87 | #' the unscaled covariance matrix and the last element the meat estimator. 88 | #' @keywords internal 89 | #' @references 90 | #' Newey, W.K., and West, K.D. (1987). “A Simple, Positive-Definite, Heteroskedasticity and 91 | #' Autocorrelation Consistent Covariance Matrix.” \emph{Econometrica}, 55, 703–708. 92 | newey_west <- function(y, x, h) { 93 | .Call(`_lpirfs_newey_west`, y, x, h) 94 | } 95 | 96 | #' @name newey_west_pw 97 | #' @title Compute Newey-West estimator with prewhitened estimation functions 98 | #' @description Compute Newey-West estimator with prewhitened estimation functions. 99 | #' The function is based on the Matlab code by James P. LeSage. 100 | #' @param hhat_mat Matrix. 101 | #' @param xpxi_mat Matrix. 102 | #' @param D_mat Matrix. 103 | #' @param h integer. 104 | #' @return A list. The first element contains the pre-whitened Newey West covariance matrix. 105 | #' @keywords internal 106 | #' @references 107 | #' 108 | #' Andrews, D.W. and Monahan, J.C. (1992). An improved heteroskedasticity and 109 | #' autocorrelation consistent covariance matrix estimator. \emph{Econometrica}, pp.953-966. 110 | #' 111 | #' Newey, W.K., and West, K.D. (1987). “A Simple, Positive-Definite, Heteroskedasticity and 112 | #' Autocorrelation Consistent Covariance Matrix.” \emph{Econometrica}, 55, 703–708. 113 | #' 114 | #' 115 | newey_west_pw <- function(hhat_mat, xpxi_mat, D_mat, h) { 116 | .Call(`_lpirfs_newey_west_pw`, hhat_mat, xpxi_mat, D_mat, h) 117 | } 118 | 119 | #' @name newey_west_tsls 120 | #' @title Compute 2SLS parameters and robust standard errors based on Newey-West 121 | #' @description Compute 2SLS parameters and robust standard errors based on Newey and West (1987). 122 | #' Part of the function is based on the Matlab code by James P. LeSage. 123 | #' @param y Numeric vector. 124 | #' @param x Numeric matrix. 125 | #' @param z Numeric matrix. 126 | #' @param h Integer. 127 | #' @return A list. The first element contains the estimated 2SLS parameters and the second element 128 | #' the 2SLS-Newey-West covariance matrix of these parameters. The third element contains the estimated functions, the fourth element 129 | #' the unscaled covariance matrix, the fifth element the meat estimator and the last element the ordinary covariance matrix of the 130 | #' point estimates. 131 | #' @keywords internal 132 | #' @references 133 | #' Newey, W.K., and West, K.D. (1987). “A Simple, Positive-Definite, Heteroskedasticity and 134 | #' Autocorrelation Consistent Covariance Matrix.” \emph{Econometrica}, 55, 703–708. 135 | #' Wooldridge, J.M. (2002), Econometric Analysis of Cross Section and Panel Data, The MIT Press. 136 | newey_west_tsls <- function(y, x, z, h) { 137 | .Call(`_lpirfs_newey_west_tsls`, y, x, z, h) 138 | } 139 | 140 | #' @name ols_diagnost 141 | #' @title Compute diagnostics for OLS models 142 | #' @description Compute OLS diagnostics such as R^2, adjusted R^2, AIC, etc. 143 | #' @param y Numeric vector. 144 | #' @param x Numeric matrix. 145 | #' @return A list: 146 | #' 147 | #'\item{beta}{Point estimates of OLS regression.} 148 | #' 149 | #'\item{beta_cov}{Covariance matrix of point estimates.} 150 | #' 151 | #'\item{R^2}{The R^2 statistic from OLS regression. } 152 | #' 153 | #'\item{Adj.R^2}{The adjusted R^2 staistic from OLS regression.} 154 | #' 155 | #'\item{F-stat}{The computed F-statistic.} 156 | #' 157 | #'\item{df1}{First degress of freedom for F-statistic.} 158 | #' 159 | #'\item{df2}{Second degrees of freedom for F-staitisc.} 160 | #' 161 | #'\item{AIC_c}{The AIC_c criterion by Hurvich and Tsai (1989)} 162 | #' 163 | #'\item{AIC}{The AIC criterion by Akaike (1974)} 164 | #' 165 | #'\item{BIC}{The BIC criterion by Schwarz and Gideon (1978)} 166 | #' 167 | #' @keywords internal 168 | #' @references 169 | #' Akaike, H. (1974). "A new look at the statistical model identification", \emph{IEEE Transactions on Automatic Control}, 19 (6): 716–723. 170 | #' 171 | #' Hurvich, C. M., and Tsai, C.-L. (1989). "Regression and time series model selection 172 | #' in small samples", Biometrika, 76(2): 297–307, 173 | #' 174 | #' Schwarz, G.(1978). "Estimating the dimension of a model", \emph{Annals of Statistics}, 6 (2): 461–464. 175 | ols_diagnost <- function(y, x) { 176 | .Call(`_lpirfs_ols_diagnost`, y, x) 177 | } 178 | 179 | #' @name var_one 180 | #' @title Compute VAR to prewhite estimating functions for Newey West estimator. 181 | #' @description Compute Newey-West estimator with prewhitened estimation functions. 182 | #' @param VAR_Data Matrix. 183 | #' @return A list. The first element contains the slope parameters of the VAR(1), the sedond element contains 184 | #' the residuals and the third element the inverted slope parameter matrix. 185 | #' @keywords internal 186 | #' @references 187 | #' 188 | #' Andrews, D.W. and Monahan, J.C. (1992). An improved heteroskedasticity and 189 | #' autocorrelation consistent covariance matrix estimator. \emph{Econometrica}, pp.953-966. 190 | #' 191 | #' Newey, W.K., and West, K.D. (1987). “A Simple, Positive-Definite, Heteroskedasticity and 192 | #' Autocorrelation Consistent Covariance Matrix.” \emph{Econometrica}, 55, 703–708. 193 | #' 194 | #' 195 | var_one <- function(VAR_Data) { 196 | .Call(`_lpirfs_var_one`, VAR_Data) 197 | } 198 | 199 | -------------------------------------------------------------------------------- /R/create_nl_data.R: -------------------------------------------------------------------------------- 1 | #' @name create_nl_data 2 | #' @title Compute data for nonlinear model with instrument variable approach 3 | #' @description Function to create data for nonlinear model with instrument variable approach. 4 | #' @param specs A \link{list}(). Inputs are created in \link{lp_nl_iv}. 5 | #' @param endog_data A \link{data.frame} with dependent variables. 6 | #' @return List with filled matrices of lagged left (y_nl) and right hand side (x_nl) variables. 7 | #' @import dplyr 8 | #' @keywords internal 9 | #' @author Philipp Adämmer 10 | 11 | 12 | create_nl_data <- function(specs, endog_data){ 13 | 14 | # Check whether lag lengths have to be determined 15 | if (is.nan(specs$lags_criterion)) { 16 | 17 | # Get transition probabilities by logistic function? 18 | if(isTRUE(specs$use_logistic)){ 19 | 20 | fz <- get_vals_switching(specs$switching, specs) 21 | 22 | } else { 23 | 24 | fz <- specs$switching 25 | 26 | # Use first lag of value from switching function? 27 | if(isTRUE(specs$lag_switching)){ 28 | 29 | fz <- dplyr::lag(fz, 1) 30 | 31 | 32 | } 33 | 34 | } 35 | 36 | # Select data for endogenous variables 37 | y_nl <- endog_data 38 | 39 | # Make exogenous lagged data 40 | if(specs$lags_endog_nl == 0){ 41 | x_nl <- data.frame(x = rep(Inf, nrow(endog_data))) 42 | } else { 43 | x_nl <- create_lags(endog_data, specs$lags_endog_nl) 44 | } 45 | 46 | # Save names of exogenous variables 47 | linear_names <- names(x_nl) 48 | 49 | # Create tibbles with exogenous regime data and combine them to one data set 50 | x_nl_s1 <- x_nl %>% 51 | dplyr::mutate_all(list(s1 = ~.*(1 - fz))) %>% 52 | dplyr::select(-one_of(linear_names)) 53 | 54 | x_nl_s2 <- x_nl %>% 55 | dplyr::mutate_all(list(s2 = ~.*fz)) %>% 56 | dplyr::select(-one_of(linear_names)) 57 | 58 | x_nl <- cbind(x_nl_s1, x_nl_s2) 59 | 60 | 61 | # Check whether model type is 'iv'. 62 | # 0 = Normal model, 1 = IV type model 63 | # Prepare identified shock variable and add to exogenous data 64 | if(specs$model_type == 1){ 65 | # Prepare shock variable 66 | shock <- specs$shock 67 | colnames(shock) <- 'shock' 68 | shock_name <- colnames(shock) 69 | 70 | # Make states of shock 71 | 72 | shock_s1 <- shock %>% 73 | dplyr::mutate_all(list(shock_s1 = ~.*(1 - fz))) %>% 74 | dplyr::select(-one_of(shock_name)) 75 | 76 | shock_s2 <- shock %>% 77 | dplyr::mutate_all(list(shock_s2 = ~.*fz)) %>% 78 | dplyr::select(-one_of(shock_name)) 79 | 80 | # Add shock variable 81 | x_nl <- cbind(shock_s1, shock_s2, x_nl) 82 | } 83 | 84 | # Include no trend, trend or quadratic trend 85 | if(specs$trend == 0){ 86 | 87 | # Only constant 88 | x_nl <- x_nl 89 | 90 | } else if (specs$trend == 1){ 91 | 92 | # Constant and trend 93 | x_nl <- x_nl %>% 94 | dplyr::mutate(trend = row_number()) 95 | 96 | } else { 97 | 98 | x_nl <- x_nl %>% 99 | dplyr::mutate(trend = row_number()) %>% 100 | dplyr::mutate(sq_trend = trend^2) 101 | } 102 | 103 | # Construct (lagged) exogenous data and merge it with lagged endogenous data 104 | if(!(is.null(specs$exog_data))){ 105 | 106 | # Create lagged exogenous data and merge with endogenous data 107 | x_exog <- create_lags(specs$exog_data, specs$lags_exog) %>% 108 | `rownames<-`(NULL) 109 | 110 | 111 | x_nl <- cbind(x_nl, x_exog) 112 | 113 | } 114 | 115 | # Add contemporaneous data if supplied 116 | if(!(is.null(specs$contemp_data))){ 117 | 118 | x_nl <- cbind(x_nl , specs$contemp_data) 119 | 120 | } 121 | 122 | 123 | # Combine endogenous and exogenous data 124 | yx_all <- cbind(y_nl, fz, x_nl) %>% 125 | stats::na.omit() 126 | 127 | yx_all <- yx_all[, !(colSums(yx_all) == Inf)] 128 | 129 | y_nl <- yx_all[, 1:ncol(endog_data)] %>% 130 | as.matrix() 131 | 132 | fz <- yx_all[, (1 + ncol(endog_data))] 133 | 134 | x_nl <- yx_all[, (2 + ncol(endog_data)): dim(yx_all)[2]] %>% 135 | as.matrix() 136 | 137 | 138 | 139 | ################################################################################ 140 | } else { 141 | ################################################################################ 142 | 143 | # Create list to store matrices 144 | y_nl_store <- rep(list(NaN), specs$max_lags) 145 | x_nl_store <- rep(list(NaN), specs$max_lags) 146 | fz_store <- rep(list(NaN), specs$max_lags) 147 | 148 | # Prepare data outside of loop 149 | 150 | # Create list with endogenous variables 151 | y_nl <- endog_data 152 | 153 | # Get transition probabilities by logistic function? 154 | if(isTRUE(specs$use_logistic)){ 155 | 156 | fz <- get_vals_switching(specs$switching, specs) 157 | 158 | } else { 159 | 160 | fz <- specs$switching 161 | } 162 | 163 | # Use first lag of value from switching function? 164 | if(isTRUE(specs$lag_switching)){ 165 | 166 | fz <- dplyr::lag(fz, 1) 167 | 168 | } 169 | 170 | 171 | # Prepare instrument variable 172 | # Check whether model type is 'iv'. 173 | # 0 = Normal model, 1 = IV model 174 | # Prepare instrument variable and add to exogenous data 175 | if(specs$model_type == 1){ 176 | shock <- specs$shock 177 | colnames(shock) <- 'shock' 178 | shock_name <- colnames(shock) 179 | } 180 | 181 | 182 | for(ii in 1:specs$max_lags){ 183 | 184 | # Create lagged variables 185 | x_nl_temp <- create_lags(endog_data, ii) 186 | 187 | linear_names <- names(x_nl_temp) 188 | 189 | x_nl_s1 <- x_nl_temp %>% 190 | dplyr::mutate_all(list(s1 = ~.*(1 - fz))) %>% 191 | dplyr::select(-one_of(linear_names)) 192 | 193 | x_nl_s2 <- x_nl_temp %>% 194 | dplyr::mutate_all(list(s2 = ~.*fz)) %>% 195 | dplyr::select(-one_of(linear_names)) 196 | 197 | x_nl <- cbind(x_nl_s1, x_nl_s2) 198 | 199 | 200 | # Prepare states of instrument 201 | if(specs$model_type == 1){ 202 | shock_s1 <- shock %>% 203 | dplyr::mutate_all(list(shock_s1 = ~.*(1 - fz))) %>% 204 | dplyr::select(-one_of(shock_name)) 205 | 206 | shock_s2 <- shock %>% 207 | dplyr::mutate_all(list(shock_s2 = ~.*fz)) %>% 208 | dplyr::select(-one_of(shock_name)) 209 | 210 | # Add state instruments 211 | x_nl <- cbind(shock_s1, shock_s2, x_nl) 212 | } 213 | 214 | # Add trend if set 215 | if(specs$trend == 0){ 216 | 217 | x_nl <- x_nl 218 | 219 | 220 | } else if (specs$trend == 1){ 221 | 222 | x_nl <- x_nl %>% 223 | dplyr::mutate(trend = row_number()) 224 | 225 | 226 | } else { 227 | 228 | x_nl <- x_nl %>% 229 | dplyr::mutate(trend = row_number()) %>% 230 | dplyr::mutate(sq_trend = trend^2) 231 | } 232 | 233 | 234 | # Construct (lagged) exogenous data and merge it with lagged endogenous data 235 | if(!(is.null(specs$exog_data))){ 236 | 237 | x_exog <- create_lags(specs$exog_data, specs$lags_exog) %>% 238 | `rownames<-`(NULL) 239 | x_nl <- cbind(x_nl, x_exog) 240 | 241 | } 242 | 243 | # Add contemporaneous data if set 244 | if(!(is.null(specs$contemp_data))){ 245 | 246 | x_nl <- cbind(x_nl , specs$contemp_data) 247 | 248 | } 249 | 250 | # Merge endogenous and exogenous data 251 | yx_all <- cbind(y_nl, fz, x_nl) %>% 252 | stats::na.omit() 253 | 254 | y_nl_store[[ii]] <- yx_all[, 1:ncol(endog_data)] %>% 255 | as.matrix() 256 | 257 | fz_store[[ii]] <- yx_all[, (1 + ncol(endog_data))] 258 | 259 | x_nl_store[[ii]] <- yx_all[, (2 + ncol(endog_data)): dim(yx_all)[2]] %>% 260 | as.matrix() 261 | 262 | 263 | 264 | 265 | } 266 | # Save values te return in list 267 | y_nl <- y_nl_store 268 | x_nl <- x_nl_store 269 | fz <- fz_store 270 | } 271 | 272 | return(list(y_nl = y_nl, x_nl = x_nl, fz = fz)) 273 | } 274 | -------------------------------------------------------------------------------- /man/lp_lin_iv.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lp_lin_iv.R 3 | \name{lp_lin_iv} 4 | \alias{lp_lin_iv} 5 | \title{Compute linear impulse responses with identified shock and/or with 2SLS} 6 | \usage{ 7 | lp_lin_iv( 8 | endog_data, 9 | shock = NULL, 10 | cumul_mult = FALSE, 11 | instr = NULL, 12 | use_twosls = FALSE, 13 | instrum = NULL, 14 | lags_endog_lin = NULL, 15 | exog_data = NULL, 16 | lags_exog = NULL, 17 | contemp_data = NULL, 18 | lags_criterion = NaN, 19 | max_lags = NaN, 20 | trend = NULL, 21 | confint = NULL, 22 | use_nw = TRUE, 23 | nw_lag = NULL, 24 | nw_prewhite = FALSE, 25 | adjust_se = FALSE, 26 | hor = NULL, 27 | num_cores = 1 28 | ) 29 | } 30 | \arguments{ 31 | \item{endog_data}{A \link{data.frame}, containing the values of the dependent variable(s).} 32 | 33 | \item{shock}{A one column \link{data.frame}, including the variable to shock with. The row length has to be the same as \emph{endog_data}. 34 | When \emph{use_twosls = TRUE}, this variable will be approximated/regressed on the instrument variable(s) given in \emph{instrum}.} 35 | 36 | \item{cumul_mult}{Boolean. Estimate cumulative multipliers? TRUE or FALSE (default). If TRUE, cumulative responses 37 | are estimated via: \deqn{y_{(t+h)} - y_{(t-1)},} where h = 0,..., H-1. 38 | This option is only available for \emph{lags_criterion = NaN}.} 39 | 40 | \item{instr}{Deprecated input name. Use \emph{shock} instead. See \emph{shock} for details.} 41 | 42 | \item{use_twosls}{Boolean. Use two stage least squares? TRUE or FALSE (default).} 43 | 44 | \item{instrum}{A \link{data.frame}, containing the instrument(s) to use for 2SLS. This instrument will be used for the 45 | variable in \emph{shock}.} 46 | 47 | \item{lags_endog_lin}{NaN or integer. NaN if lags are chosen by a lag length criterion. Integer for number of lags for \emph{endog_data}.} 48 | 49 | \item{exog_data}{A \link{data.frame}, containing exogenous variables. The row length has to be the same as \emph{endog_data}. 50 | Lag lengths for exogenous variables have to be given and will not be determined via a lag length criterion.} 51 | 52 | \item{lags_exog}{NULL or Integer. Integer for the number of lags for the exogenous data. The value cannot be 0. If you want to 53 | to include exogenous data with contemporaneous impact use `contemp_data`.} 54 | 55 | \item{contemp_data}{A \link{data.frame}, containing exogenous data with contemporaneous impact. 56 | The row length has to be the same as \emph{endog_data}.} 57 | 58 | \item{lags_criterion}{NaN or character. NaN means that the number of lags 59 | will be given at \emph{lags_endog_lin}. Possible lag length criteria are 'AICc', 'AIC' or 'BIC'. 60 | Note that when \emph{use_twosls = TRUE}, the lag lengths are chosen based on normal OLS regressions, without using the instruments.} 61 | 62 | \item{max_lags}{NaN or integer. Maximum number of lags if \emph{lags_criterion} is a character denoting the lag length criterion. NaN otherwise.} 63 | 64 | \item{trend}{Integer. No trend = 0 , include trend = 1, include trend and quadratic trend = 2.} 65 | 66 | \item{confint}{Double. Width of confidence bands. 68\% = 1; 90\% = 1.65; 95\% = 1.96.} 67 | 68 | \item{use_nw}{Boolean. Use Newey-West (1987) standard errors for impulse responses? TRUE (default) or FALSE.} 69 | 70 | \item{nw_lag}{Integer. Specifies the maximum lag with positive weight for the Newey-West estimator. If set to NULL (default), the lag increases with 71 | with the number of horizon.} 72 | 73 | \item{nw_prewhite}{Boolean. Should the estimators be pre-whitened? TRUE of FALSE (default).} 74 | 75 | \item{adjust_se}{Boolen. Should a finite sample adjsutment be made to the covariance matrix estimators? TRUE or FALSE (default).} 76 | 77 | \item{hor}{Integer. Number of horizons for impulse responses.} 78 | 79 | \item{num_cores}{NULL or Integer. The number of cores to use for the estimation. If NULL, the function will 80 | use the maximum number of cores minus one.} 81 | } 82 | \value{ 83 | A list containing: 84 | 85 | 86 | 87 | \item{irf_lin_mean}{A \link{matrix}, containing the impulse responses. 88 | The row in each matrix denotes the response of the \emph{ith} 89 | variable to the shock. The columns are the horizons.} 90 | 91 | \item{irf_lin_low}{A \link{matrix}, containing all lower confidence bands of 92 | the impulse responses, based on robust standard errors by Newey and West (1987). 93 | Properties are equal to \emph{irf_lin_mean}.} 94 | 95 | \item{irf_lin_up}{A \link{matrix}, containing all upper confidence bands of 96 | the impulse responses, based on robust standard errors by Newey and West (1987). 97 | Properties are equal to \emph{irf_lin_mean}.} 98 | 99 | \item{specs}{A list with properties of \emph{endog_data} for the plot function. It also contains 100 | lagged data (y_lin and x_lin) used for the estimations of the impulse responses, and the selected lag lengths when an information criterion has been used.} 101 | } 102 | \description{ 103 | Compute linear impulse responses with identified shock and/or with 2SLS. 104 | } 105 | \examples{ 106 | \donttest{ 107 | 108 | # This example replicates a result from the Supplementary Appendix 109 | # by Ramey and Zubairy (2018) (RZ-18) 110 | 111 | # Load data 112 | ag_data <- ag_data 113 | sample_start <- 7 114 | sample_end <- dim(ag_data)[1] 115 | 116 | # Endogenous data 117 | endog_data <- ag_data[sample_start:sample_end,3:5] 118 | 119 | # Variable to shock with. Here government spending due to 120 | # Blanchard and Perotti (2002) framework 121 | shock <- ag_data[sample_start:sample_end, 3] 122 | 123 | # Estimate linear model 124 | results_lin_iv <- lp_lin_iv(endog_data, 125 | lags_endog_lin = 4, 126 | shock = shock, 127 | trend = 0, 128 | confint = 1.96, 129 | hor = 20) 130 | 131 | # Show all impulse responses 132 | plot(results_lin_iv) 133 | 134 | # Make and save plots 135 | iv_lin_plots <- plot_lin(results_lin_iv) 136 | 137 | # * The first element of 'iv_lin_plots' shows the response of the first 138 | # variable (Gov) to the shock (Gov). 139 | # * The second element of 'iv_lin_plots' shows the response of the second 140 | # variable (Tax) to the shock (Gov). 141 | # * ... 142 | 143 | # This plot replicates the left plot in the mid-panel of Figure 12 in the 144 | # Supplementary Appendix by RZ-18. 145 | iv_lin_plots[[1]] 146 | 147 | 148 | # Show diagnostics. The first element shows the reaction of the first given endogenous variable. 149 | summary(results_lin_iv) 150 | 151 | 152 | ## Add lags of the identified shock ## 153 | 154 | # Endogenous data but now exclude government spending 155 | endog_data <- ag_data[sample_start:sample_end, 4:5] 156 | 157 | # Variable to shock with (government spending) 158 | shock <- ag_data[sample_start:sample_end, 3] 159 | 160 | # Add the shock variable to exogenous data 161 | exog_data <- shock 162 | 163 | # Estimate linear model with lagged shock variable 164 | results_lin_iv <- lp_lin_iv(endog_data, 165 | lags_endog_lin = 4, 166 | shock = shock, 167 | exog_data = exog_data, 168 | lags_exog = 2, 169 | trend = 0, 170 | confint = 1.96, 171 | hor = 20) 172 | 173 | 174 | # Show all responses 175 | plot(results_lin_iv) 176 | 177 | # Show diagnostics. The first element shows the reaction of the first endogenous variable. 178 | summary(results_lin_iv) 179 | 180 | 181 | ############################################################################## 182 | ##### Use 2SLS ######### 183 | ############################################################################## 184 | 185 | # Set seed 186 | set.seed(007) 187 | 188 | # Load data 189 | ag_data <- ag_data 190 | sample_start <- 7 191 | sample_end <- dim(ag_data)[1] 192 | 193 | # Endogenous data 194 | endog_data <- ag_data[sample_start:sample_end,3:5] 195 | 196 | # Variable to shock with (government spending) 197 | shock <- ag_data[sample_start:sample_end, 3] 198 | 199 | # Generate instrument variable that is correlated with government spending 200 | instrum <- as.data.frame(0.9*shock$Gov + rnorm(length(shock$Gov), 0, 0.02) ) 201 | 202 | # Estimate linear model via 2SLS 203 | results_lin_iv <- lp_lin_iv(endog_data, 204 | lags_endog_lin = 4, 205 | shock = shock, 206 | instrum = instrum, 207 | use_twosls = TRUE, 208 | trend = 0, 209 | confint = 1.96, 210 | hor = 20) 211 | 212 | # Show all responses 213 | plot(results_lin_iv) 214 | 215 | } 216 | 217 | 218 | } 219 | \references{ 220 | Akaike, H. (1974). "A new look at the statistical model identification", \emph{IEEE Transactions on Automatic Control}, 19 (6): 716–723. 221 | 222 | Auerbach, A. J., and Gorodnichenko, Y. (2012). "Measuring the Output Responses to Fiscal Policy." 223 | \emph{American Economic Journal: Economic Policy}, 4 (2): 1-27. 224 | 225 | Blanchard, O., and Perotti, R. (2002). “An Empirical Characterization of the 226 | Dynamic Effects of Changes in Government Spending and Taxes on Output.” \emph{Quarterly 227 | Journal of Economics}, 117(4): 1329–1368. 228 | 229 | Hurvich, C. M., and Tsai, C.-L. (1989), "Regression and time series model selection in small samples", 230 | \emph{Biometrika}, 76(2): 297–307 231 | 232 | Jordà, Ò. (2005). "Estimation and Inference of Impulse Responses by Local Projections." 233 | \emph{American Economic Review}, 95 (1): 161-182. 234 | 235 | Jordà, Ò, Schularick, M., Taylor, A.M. (2015), "Betting the house", \emph{Journal of International Economics}, 236 | 96, S2-S18. 237 | 238 | Newey, W.K., and West, K.D. (1987). “A Simple, Positive-Definite, Heteroskedasticity and 239 | Autocorrelation Consistent Covariance Matrix.” \emph{Econometrica}, 55: 703–708. 240 | 241 | Ramey, V.A., and Zubairy, S. (2018). "Government Spending Multipliers in Good Times 242 | and in Bad: Evidence from US Historical Data." \emph{Journal of Political Economy}, 243 | 126(2): 850 - 901. 244 | 245 | Schwarz, Gideon E. (1978). "Estimating the dimension of a model", \emph{Annals of Statistics}, 6 (2): 461–464. 246 | } 247 | \seealso{ 248 | \url{https://adaemmerp.github.io/lpirfs/README_docs.html} 249 | } 250 | \author{ 251 | Philipp Adämmer 252 | } 253 | -------------------------------------------------------------------------------- /man/lp_nl_iv.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lp_nl_iv.R 3 | \name{lp_nl_iv} 4 | \alias{lp_nl_iv} 5 | \title{Compute nonlinear impulse responses with identified shock} 6 | \usage{ 7 | lp_nl_iv( 8 | endog_data, 9 | lags_endog_nl = NULL, 10 | shock = NULL, 11 | cumul_mult = FALSE, 12 | instr = NULL, 13 | exog_data = NULL, 14 | lags_exog = NULL, 15 | contemp_data = NULL, 16 | lags_criterion = NaN, 17 | max_lags = NaN, 18 | trend = NULL, 19 | confint = NULL, 20 | use_nw = TRUE, 21 | nw_lag = NULL, 22 | nw_prewhite = FALSE, 23 | adjust_se = FALSE, 24 | hor = NULL, 25 | switching = NULL, 26 | lag_switching = TRUE, 27 | use_logistic = TRUE, 28 | use_hp = NULL, 29 | lambda = NULL, 30 | gamma = NULL, 31 | num_cores = 1 32 | ) 33 | } 34 | \arguments{ 35 | \item{endog_data}{A \link{data.frame}, containing all endogenous variables for the VAR.} 36 | 37 | \item{lags_endog_nl}{NaN or integer. NaN if lags are chosen by a lag length criterion. Integer for number of lags for \emph{endog_data}.} 38 | 39 | \item{shock}{One column \link{data.frame}, including the instrument to shock with. 40 | The row length has to be the same as \emph{endog_data}.} 41 | 42 | \item{cumul_mult}{Boolean. Estimate cumulative multipliers? TRUE or FALSE (default). If TRUE, cumulative responses 43 | are estimated via: \deqn{y_{(t+h)} - y_{(t-1)},} where h = 0,..., H-1. 44 | This option is only available for \emph{lags_criterion = NaN}.} 45 | 46 | \item{instr}{Deprecated input name. Use \emph{shock} instead. See \emph{shock} for details.} 47 | 48 | \item{exog_data}{A \link{data.frame}, containing exogenous variables. The row length has to be the same as \emph{endog_data}. 49 | Lag lengths for exogenous variables have to be given and will not be determined via a lag length criterion.} 50 | 51 | \item{lags_exog}{NULL or Integer. Integer for the number of lags for the exogenous data. The value cannot be 0. If you want to 52 | to include exogenous data with contemporaneous impact use \emph{contemp_data}.} 53 | 54 | \item{contemp_data}{A \link{data.frame}, containing exogenous data with contemporaneous impact. This data will not be lagged. 55 | The row length has to be the same as \emph{endog_data}.} 56 | 57 | \item{lags_criterion}{NaN or character. NaN means that the number of lags 58 | will be given at \emph{lags_endog_nl}. Possible lag length criteria are 'AICc', 'AIC' or 'BIC'.} 59 | 60 | \item{max_lags}{NaN or integer. Maximum number of lags (if \emph{lags_criterion} = 'AICc', 'AIC', 'BIC'). NaN otherwise.} 61 | 62 | \item{trend}{Integer. Include no trend = 0 , include trend = 1, include trend and quadratic trend = 2.} 63 | 64 | \item{confint}{Double. Width of confidence bands. 68\% = 1; 90\% = 1.65; 95\% = 1.96.} 65 | 66 | \item{use_nw}{Boolean. Use Newey-West (1987) standard errors for impulse responses? TRUE (default) or FALSE.} 67 | 68 | \item{nw_lag}{Integer. Specifies the maximum lag with positive weight for the Newey-West estimator. If set to NULL (default), the lag increases with 69 | with the number of horizon.} 70 | 71 | \item{nw_prewhite}{Boolean. Should the estimators be pre-whitened? TRUE of FALSE (default).} 72 | 73 | \item{adjust_se}{Boolen. Should a finite sample adjsutment be made to the covariance matrix estimators? TRUE or FALSE (default).} 74 | 75 | \item{hor}{Integer. Number of horizons for impulse responses.} 76 | 77 | \item{switching}{Numeric vector. A column vector with the same length as \emph{endog_data}. This series can either 78 | be decomposed via the Hodrick-Prescott filter (see Auerbach and Gorodnichenko, 2013) or 79 | directly plugged into the following smooth transition function: 80 | \deqn{ F_{z_t} = \frac{exp(-\gamma z_t)}{1 + exp(-\gamma z_t)}. } 81 | Warning: \code{F\_{z_t}} will be lagged by one and then multiplied with the data. 82 | If the variable shall not be lagged, the vector has to be given with a lead of one. 83 | The data for the two regimes are: \cr 84 | Regime 1 = (1-\code{F(z\_{t-1}))*y\_{(t-p)}}, \cr 85 | Regime 2 = \code{F(z\_{t-1})*y\_{(t-p)}}.} 86 | 87 | \item{lag_switching}{Boolean. Use the first lag of the values of the transition function? TRUE (default) or FALSE.} 88 | 89 | \item{use_logistic}{Boolean. Use logistic function to separate states? TRUE (default) or FALSE. If FALSE, the values of the switching variable 90 | have to be binary (0/1).} 91 | 92 | \item{use_hp}{Boolean. Use HP-filter? TRUE or FALSE.} 93 | 94 | \item{lambda}{Double. Value of \eqn{\lambda} for the Hodrick-Prescott filter (if use_hp = TRUE).} 95 | 96 | \item{gamma}{Double. Positive number which is used in the transition function.} 97 | 98 | \item{num_cores}{Integer. The number of cores to use for the estimation. If NULL, the function will 99 | use the maximum number of cores minus one.} 100 | } 101 | \value{ 102 | A list containing: 103 | 104 | \item{irf_s1_mean}{A \link{matrix}, containing the impulse responses of the first regime. 105 | The row in each matrix denotes the responses of the \emph{ith} 106 | variable to the shock. The columns are the horizons.} 107 | 108 | \item{irf_s1_low}{A \link{matrix}, containing all lower confidence bands of 109 | the impulse responses, based on robust standard errors by Newey and West (1987). 110 | Properties are equal to \emph{irf_s1_mean}.} 111 | 112 | \item{irf_s1_up}{A \link{matrix}, containing all upper confidence bands of the 113 | impulse responses, based on robust standard errors by Newey and West (1987). 114 | Properties are equal to \emph{irf_s1_mean}.} 115 | 116 | \item{irf_s2_mean}{A \link{matrix}, containing all impulse responses for the second regime. 117 | The row in each matrix denotes the responses of the \emph{ith} variable to the shock. 118 | The columns denote the horizon.} 119 | 120 | \item{irf_s2_low}{A \link{matrix}, containing all lower confidence bands of the responses, 121 | based on robust standard errors by Newey and West (1987). Properties are equal to \emph{irf_s2_mean}.} 122 | 123 | \item{irf_s2_up}{A \link{matrix}, containing all upper confidence bands of the responses, based on 124 | robust standard errors by Newey and West (1987). Properties are equal to \emph{irf_s2_mean}.} 125 | 126 | \item{specs}{A list with properties of \emph{endog_data} for the plot function. It also contains 127 | lagged data (y_nl and x_nl) used for the estimations of the impulse responses, and the selected lag lengths when an information criterion has been used.} 128 | 129 | \item{fz}{A vector, containing the values of the transition function \code{F(z\_{t-1})}.} 130 | } 131 | \description{ 132 | Compute nonlinear impulse responses with local projections and identified shock. 133 | The data can be separated into two states by a smooth transition function as applied in Auerbach and Gorodnichenko (2012), 134 | or by a simple dummy approach. 135 | } 136 | \examples{ 137 | \donttest{ 138 | 139 | # This example replicates results from the Supplementary Appendix 140 | # by Ramey and Zubairy (2018) (RZ-18). 141 | 142 | # Load and prepare data 143 | ag_data <- ag_data 144 | sample_start <- 7 145 | sample_end <- dim(ag_data)[1] 146 | endog_data <- ag_data[sample_start:sample_end, 3:5] 147 | 148 | # The shock is estimated by RZ-18 149 | shock <- ag_data[sample_start:sample_end, 7] 150 | 151 | # Include four lags of the 7-quarter moving average growth rate of GDP 152 | # as exogenous variables (see RZ-18) 153 | exog_data <- ag_data[sample_start:sample_end, 6] 154 | 155 | # Use the 7-quarter moving average growth rate of GDP as switching variable 156 | # and adjust it to have suffiently long recession periods. 157 | switching_variable <- ag_data$GDP_MA[sample_start:sample_end] - 0.8 158 | 159 | # Estimate local projections 160 | results_nl_iv <- lp_nl_iv(endog_data, 161 | lags_endog_nl = 3, 162 | shock = shock, 163 | exog_data = exog_data, 164 | lags_exog = 4, 165 | trend = 0, 166 | confint = 1.96, 167 | hor = 20, 168 | switching = switching_variable, 169 | use_hp = FALSE, 170 | gamma = 3) 171 | 172 | # Show all impulse responses 173 | plot(results_nl_iv) 174 | 175 | # Make and save individual plots 176 | plots_nl_iv <- plot_nl(results_nl_iv) 177 | 178 | # Show single impulse responses 179 | # Compare with red line of left plot (lower panel) in Figure 12 in Supplementary Appendix of RZ-18. 180 | plot(plots_nl_iv$gg_s1[[1]]) 181 | # Compare with blue line of left plot (lower panel) in Figure 12 in Supplementary Appendix of RZ-18. 182 | plot(plots_nl_iv$gg_s2[[1]]) 183 | 184 | # Show diagnostics. The first element shows the reaction of the first endogenous variable. 185 | summary(results_nl_iv) 186 | 187 | } 188 | } 189 | \references{ 190 | Akaike, H. (1974). "A new look at the statistical model identification", \emph{IEEE Transactions on Automatic Control}, 19 (6): 716–723. 191 | 192 | Auerbach, A. J., and Gorodnichenko Y. (2012). "Measuring the Output Responses to Fiscal Policy." 193 | \emph{American Economic Journal: Economic Policy}, 4 (2): 1-27. 194 | 195 | Auerbach, A. J., and Gorodnichenko Y. (2013). "Fiscal Multipliers in Recession and Expansion." 196 | \emph{NBER Working Paper Series}. Nr 17447. 197 | 198 | Blanchard, O., and Perotti, R. (2002). “An Empirical Characterization of the 199 | Dynamic Effects of Changes in Government Spending and Taxes on Output.” \emph{Quarterly 200 | Journal of Economics}, 117(4): 1329–1368. 201 | 202 | Hurvich, C. M., and Tsai, C.-L. (1989), "Regression and time series model selection in small samples", 203 | \emph{Biometrika}, 76(2): 297–307 204 | 205 | Jordà, Ò. (2005) "Estimation and Inference of Impulse Responses by Local Projections." 206 | \emph{American Economic Review}, 95 (1): 161-182. 207 | 208 | Jordà, Ò, Schularick, M., Taylor, A.M. (2015), "Betting the house", \emph{Journal of International Economics}, 209 | 96, S2-S18. 210 | 211 | Newey, W.K., and West, K.D. (1987). “A Simple, Positive-Definite, Heteroskedasticity and 212 | Autocorrelation Consistent Covariance Matrix.” \emph{Econometrica}, 55, 703–708. 213 | 214 | Ramey, V.A., and Zubairy, S. (2018). "Government Spending Multipliers in Good Times 215 | and in Bad: Evidence from US Historical Data." \emph{Journal of Political Economy}, 216 | 126(2): 850 - 901. 217 | 218 | Schwarz, Gideon E. (1978). "Estimating the dimension of a model", \emph{Annals of Statistics}, 6 (2): 461–464. 219 | } 220 | \seealso{ 221 | \url{https://adaemmerp.github.io/lpirfs/README_docs.html} 222 | } 223 | \author{ 224 | Philipp Adämmer 225 | } 226 | --------------------------------------------------------------------------------