diff --git a/.Rbuildignore b/.Rbuildignore index dd885b7..55b2e91 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -3,7 +3,8 @@ ^_pkgdown\.yml$ ^.*\.Rproj$ ^\.Rproj\.user$ -^README\.Rmd$ +^.lintr$ +^README.Rmd$ ^README-.*\.png$ .travis.yml ^pkgdown$ @@ -14,3 +15,5 @@ TODO.R workspace workspace.xml R/test_X11.R +^\.github$ +^LICENSE$ diff --git a/.github/.gitignore b/.github/.gitignore new file mode 100644 index 0000000..2d19fc7 --- /dev/null +++ b/.github/.gitignore @@ -0,0 +1 @@ +*.html diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml new file mode 100644 index 0000000..e0b443a --- /dev/null +++ b/.github/workflows/R-CMD-check.yaml @@ -0,0 +1,68 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, develop] + pull_request: + branches: [main, develop] + +name: R-CMD-check + +jobs: + R-CMD-check: + runs-on: ${{ matrix.config.os }} + + name: ${{ matrix.config.os }} (${{ matrix.config.r }}) + + strategy: + fail-fast: false + matrix: + config: + - {os: macos-latest, r: 'release'} + - {os: windows-latest, r: 'release'} + - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} + - {os: ubuntu-latest, r: 'release'} + - {os: ubuntu-latest, r: 'oldrel-1'} + + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + R_KEEP_PKG_SOURCE: yes + + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: actions/setup-java@v4 + with: + distribution: 'zulu' # See 'Supported distributions' for available options + java-version: '17' + + - uses: r-lib/actions/setup-r@v2 + with: + r-version: ${{ matrix.config.r }} + http-user-agent: ${{ matrix.config.http-user-agent }} + use-public-rspm: true + + - name: Set up for RProtoBuf on Windows + if: runner.os == 'Windows' + run: choco install protoc + + - name: Set up for RProtoBuf on macos + if: runner.os == 'macOS' + run: brew install protobuf + + - name: Set up for RProtoBuf on ubuntu + if: runner.os == 'Linux' + run: sudo apt-get update -y && sudo apt-get install protobuf-compiler libprotobuf-dev libprotoc-dev + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::rcmdcheck + needs: check + + - uses: r-lib/actions/check-r-package@v2 + with: + upload-snapshots: true + build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' + error-on: '"error"' diff --git a/.github/workflows/check-changelog.yml b/.github/workflows/check-changelog.yml new file mode 100644 index 0000000..e0c5bb1 --- /dev/null +++ b/.github/workflows/check-changelog.yml @@ -0,0 +1,17 @@ +name: Check changelog + +on: [ push, pull_request ] + +jobs: + check-changelog-job: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + with: + submodules: true + fetch-depth: 0 + + - uses: jbangdev/jbang-action@v0.115.0 + with: + script: com.github.nbbrd.heylogs:heylogs-cli:0.7.2:bin + scriptargs: "check NEWS.md" diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml new file mode 100644 index 0000000..b74596b --- /dev/null +++ b/.github/workflows/lint.yaml @@ -0,0 +1,42 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, develop] + pull_request: + branches: [main, develop] + +name: lint + +jobs: + lint: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: actions/setup-java@v4 + with: + distribution: 'zulu' # See 'Supported distributions' for available options + java-version: '17' + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - name: Set up for RProtoBuf + run: sudo apt-get update -y && sudo apt-get install protobuf-compiler libprotobuf-dev libprotoc-dev + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::lintr, local::. + needs: lint + + - name: Lint + run: lintr::lint_package() + shell: Rscript {0} + env: + LINTR_ERROR_ON_LINT: true diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml new file mode 100644 index 0000000..498c6b2 --- /dev/null +++ b/.github/workflows/pkgdown.yaml @@ -0,0 +1,56 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master, develop] + pull_request: + branches: [main, master, develop] + release: + types: [published] + workflow_dispatch: + +name: pkgdown + +jobs: + pkgdown: + runs-on: ubuntu-latest + # Only restrict concurrency for non-PR jobs + concurrency: + group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + permissions: + contents: write + steps: + - uses: actions/checkout@v4 + + - uses: actions/setup-java@v4 + with: + distribution: 'zulu' # See 'Supported distributions' for available options + java-version: '17' + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - name: Set up for RProtoBuf + run: sudo apt-get update -y && sudo apt-get install protobuf-compiler libprotobuf-dev libprotoc-dev + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::pkgdown, local::. + needs: website + + - name: Build site + run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) + shell: Rscript {0} + + - name: Deploy to GitHub pages 🚀 + if: github.event_name != 'pull_request' + uses: JamesIves/github-pages-deploy-action@v4.5.0 + with: + clean: false + branch: gh-pages + folder: docs diff --git a/.github/workflows/pr-commands.yaml b/.github/workflows/pr-commands.yaml new file mode 100644 index 0000000..f3e77c6 --- /dev/null +++ b/.github/workflows/pr-commands.yaml @@ -0,0 +1,139 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + issue_comment: + types: [created] + +name: Commands + +jobs: + document: + if: ${{ github.event.issue.pull_request && (github.event.comment.author_association == 'MEMBER' || github.event.comment.author_association == 'OWNER') && startsWith(github.event.comment.body, '/document') }} + name: document + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/pr-fetch@v2 + with: + repo-token: ${{ secrets.GITHUB_TOKEN }} + + - uses: actions/setup-java@v4 + with: + distribution: 'zulu' # See 'Supported distributions' for available options + java-version: '17' + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - name: Set up for RProtoBuf + run: sudo apt-get update -y && sudo apt-get install protobuf-compiler libprotobuf-dev libprotoc-dev + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::roxygen2 + needs: pr-document + + - name: Document + run: roxygen2::roxygenise() + shell: Rscript {0} + + - name: Config git + run: | + git config --local user.name "$GITHUB_ACTOR" + git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" + + # Check if there are any changes + - name: Check for changes + id: check-changes + run: | + if git diff --quiet -- NAMESPACE man/; then + echo "has-changed=false" >> "$GITHUB_OUTPUT" + else + echo "has-changed=true" >> "$GITHUB_OUTPUT" + fi + + - name: Commit the changes + if: ${{ steps.check-changes.outputs.has-changed == 'true' }} + run: | + git add man/\* NAMESPACE + git commit -m '[GHA] Document package' + + # Commit changes or a placeholder commit if no changes + - name: Commit no changes + if: ${{ steps.check-changes.outputs.has-changed == 'false' }} + run: | + git commit --allow-empty -m '[GHA] Package already documented' + + - uses: r-lib/actions/pr-push@v2 + with: + repo-token: ${{ secrets.GITHUB_TOKEN }} + + style: + if: ${{ github.event.issue.pull_request && (github.event.comment.author_association == 'MEMBER' || github.event.comment.author_association == 'OWNER') && startsWith(github.event.comment.body, '/style') }} + name: style + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/pr-fetch@v2 + with: + repo-token: ${{ secrets.GITHUB_TOKEN }} + + - uses: actions/setup-java@v4 + with: + distribution: 'zulu' # See 'Supported distributions' for available options + java-version: '17' + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - name: Set up for RProtoBuf + run: sudo apt-get update -y && sudo apt-get install protobuf-compiler libprotobuf-dev libprotoc-dev + + - name: Install dependencies + run: install.packages("styler") + shell: Rscript {0} + + - name: Style + run: styler::style_pkg(transformers = styler::tidyverse_style(indent_by = 4)) + shell: Rscript {0} + + - name: Config git + run: | + git config --local user.name "$GITHUB_ACTOR" + git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" + + # Check if there are any changes + - name: Check for changes + id: check-changes + run: | + if git diff --quiet -- '*.R'; then + echo "has-changed=false" >> "$GITHUB_OUTPUT" + else + echo "has-changed=true" >> "$GITHUB_OUTPUT" + fi + + - name: Commit the changes + if: ${{ steps.check-changes.outputs.has-changed == 'true' }} + run: | + git add \*.R + git commit -m '[GHA] Style package' + + # Commit changes or a placeholder commit if no changes + - name: Commit no changes + if: ${{ steps.check-changes.outputs.has-changed == 'false' }} + run: | + git commit --allow-empty -m '[GHA] Package already styled' + + - uses: r-lib/actions/pr-push@v2 + with: + repo-token: ${{ secrets.GITHUB_TOKEN }} diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml new file mode 100644 index 0000000..7d814af --- /dev/null +++ b/.github/workflows/test-coverage.yaml @@ -0,0 +1,60 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, develop] + pull_request: + branches: [main, develop] + +name: test-coverage + +jobs: + test-coverage: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: actions/setup-java@v4 + with: + distribution: 'zulu' # See 'Supported distributions' for available options + java-version: '17' + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - name: Set up for RProtoBuf + run: sudo apt-get update -y && sudo apt-get install protobuf-compiler libprotobuf-dev libprotoc-dev + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::covr + needs: coverage + + - name: Test coverage + run: | + covr::codecov( + quiet = FALSE, + clean = FALSE, + install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") + ) + shell: Rscript {0} + + - name: Show testthat output + if: always() + run: | + ## -------------------------------------------------------------------- + find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true + shell: bash + + - name: Upload test results + if: failure() + uses: actions/upload-artifact@v4 + with: + name: coverage-test-failures + path: ${{ runner.temp }}/package diff --git a/.gitignore b/.gitignore index e5b959a..ee10e6d 100644 --- a/.gitignore +++ b/.gitignore @@ -6,3 +6,4 @@ workspace workspace.xml inst/doc +docs diff --git a/.lintr b/.lintr new file mode 100644 index 0000000..3aa9513 --- /dev/null +++ b/.lintr @@ -0,0 +1,26 @@ +linters: linters_with_defaults( + indentation_linter = NULL, + trailing_blank_lines_linter = NULL, + trailing_whitespace_linter = NULL, + assignment_linter = NULL, + whitespace_linter = NULL, + brace_linter = NULL, + infix_spaces_linter = NULL, + paren_body_linter = NULL, + indentation_linter = NULL, + function_left_parentheses_linter = NULL, + spaces_left_parentheses_linter = NULL, + commas_linter = NULL, + quotes_linter = NULL, + spaces_inside_linter = NULL, + vector_logic_linter = NULL, + seq_linter = NULL, + object_length_linter = NULL, + semicolon_linter = NULL, + cyclocomp_linter = NULL, + object_usage_linter = NULL, + object_name_linter = NULL, + line_length_linter = NULL, + commented_code_linter = NULL + ) +encoding: "UTF-8" diff --git a/DESCRIPTION b/DESCRIPTION index 9f53876..6588889 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: rjd3filters Type: Package Title: Trend-Cycle Extraction with Linear Filters -Version: 2.0.0 +Version: 2.1.0 Authors@R: c( person("Jean", "Palate", role = c("aut", "cre"), email = "jean.palate@nbb.be"), @@ -27,17 +27,17 @@ Imports: MASS, graphics, stats, - rjd3toolkit (>= 3.2.1) + rjd3toolkit (>= 3.2.2) Remotes: github::rjdemetra/rjd3toolkit SystemRequirements: Java (>= 17) License: EUPL LazyData: TRUE -URL: https://github.com/rjdemetra/rjd3filters +URL: https://github.com/rjdemetra/rjd3filters, https://rjdemetra.github.io/rjd3filters/ Suggests: knitr, rmarkdown VignetteBuilder: knitr -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 Roxygen: list(markdown = TRUE) Encoding: UTF-8 diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..20fc266 --- /dev/null +++ b/LICENSE @@ -0,0 +1,185 @@ +EUROPEAN UNION PUBLIC LICENCE v. 1.2 + +EUPL © the European Union 2007, 2016 + +This European Union Public Licence (the ‘EUPL’) applies to the Work (as defined below) which is provided under the terms of this Licence. Any use of the Work, other than as authorised under this Licence is prohibited (to the extent such use is covered by a right of the copyright holder of the Work). + +The Work is provided under the terms of this Licence when the Licensor (as defined below) has placed the following notice immediately following the copyright notice for the Work: + +Licensed under the EUPL + +or has expressed by any other means his willingness to license under the EUPL. + + +1. Definitions + +In this Licence, the following terms have the following meaning: + +— ‘The Licence’: this Licence. + +— ‘The Original Work’: the work or software distributed or communicated by the Licensor under this Licence, available as Source Code and also as Executable Code as the case may be. + +— ‘Derivative Works’: the works or software that could be created by the Licensee, based upon the Original Work or modifications thereof. This Licence does not define the extent of modification or dependence on the Original Work required in order to classify a work as a Derivative Work; this extent is determined by copyright law applicable in the country mentioned in Article 15. + +— ‘The Work’: the Original Work or its Derivative Works. + +— ‘The Source Code’: the human-readable form of the Work which is the most convenient for people to study and modify. + +— ‘The Executable Code’: any code which has generally been compiled and which is meant to be interpreted by a computer as a program. + +— ‘The Licensor’: the natural or legal person that distributes or communicates the Work under the Licence. + +— ‘Contributor(s)’: any natural or legal person who modifies the Work under the Licence, or otherwise contributes to the creation of a Derivative Work. + +— ‘The Licensee’ or ‘You’: any natural or legal person who makes any usage of the Work under the terms of the Licence. + +— ‘Distribution’ or ‘Communication’: any act of selling, giving, lending, renting, distributing, communicating, transmitting, or otherwise making available, online or offline, copies of the Work or providing access to its essential functionalities at the disposal of any other natural or legal person. + + +2. Scope of the rights granted by the Licence + +The Licensor hereby grants You a worldwide, royalty-free, non-exclusive, sublicensable licence to do the following, for the duration of copyright vested in the Original Work: + +— use the Work in any circumstance and for all usage, + +— reproduce the Work, + +— modify the Work, and make Derivative Works based upon the Work, + +— communicate to the public, including the right to make available or display the Work or copies thereof to the public and perform publicly, as the case may be, the Work, + +— distribute the Work or copies thereof, + +— lend and rent the Work or copies thereof, + +— sublicense rights in the Work or copies thereof. + +Those rights can be exercised on any media, supports and formats, whether now known or later invented, as far as the applicable law permits so. + +In the countries where moral rights apply, the Licensor waives his right to exercise his moral right to the extent allowed by law in order to make effective the licence of the economic rights here above listed. + +The Licensor grants to the Licensee royalty-free, non-exclusive usage rights to any patents held by the Licensor, to the extent necessary to make use of the rights granted on the Work under this Licence. + + +3. Communication of the Source Code + +The Licensor may provide the Work either in its Source Code form, or as Executable Code. If the Work is provided as Executable Code, the Licensor provides in addition a machine-readable copy of the Source Code of the Work along with each copy of the Work that the Licensor distributes or indicates, in a notice following the copyright notice attached to the Work, a repository where the Source Code is easily and freely accessible for as long as the Licensor continues to distribute or communicate the Work. + + +4. Limitations on copyright + +Nothing in this Licence is intended to deprive the Licensee of the benefits from any exception or limitation to the exclusive rights of the rights owners in the Work, of the exhaustion of those rights or of other applicable limitations thereto. + + +5. Obligations of the Licensee + +The grant of the rights mentioned above is subject to some restrictions and obligations imposed on the Licensee. Those obligations are the following: + + Attribution right: The Licensee shall keep intact all copyright, patent or trademarks notices and all notices that refer to the Licence and to the disclaimer of warranties. The Licensee must include a copy of such notices and a copy of the Licence with every copy of the Work he/she distributes or communicates. The Licensee must cause any Derivative Work to carry prominent notices stating that the Work has been modified and the date of modification. + Copyleft clause: If the Licensee distributes or communicates copies of the Original Works or Derivative Works, this Distribution or Communication will be done under the terms of this Licence or of a later version of this Licence unless the Original Work is expressly distributed only under this version of the Licence — for example by communicating ‘EUPL v. 1.2 only’. The Licensee (becoming Licensor) cannot offer or impose any additional terms or conditions on the Work or Derivative Work that alter or restrict the terms of the Licence. + Compatibility clause: If the Licensee Distributes or Communicates Derivative Works or copies thereof based upon both the Work and another work licensed under a Compatible Licence, this Distribution or Communication can be done under the terms of this Compatible Licence. For the sake of this clause, ‘Compatible Licence’ refers to the licences listed in the appendix attached to this Licence. Should the Licensee's obligations under the Compatible Licence conflict with his/her obligations under this Licence, the obligations of the Compatible Licence shall prevail. + Provision of Source Code: When distributing or communicating copies of the Work, the Licensee will provide a machine-readable copy of the Source Code or indicate a repository where this Source will be easily and freely available for as long as the Licensee continues to distribute or communicate the Work. + Legal Protection: This Licence does not grant permission to use the trade names, trademarks, service marks, or names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the copyright notice. + + +6. Chain of Authorship + +The original Licensor warrants that the copyright in the Original Work granted hereunder is owned by him/her or licensed to him/her and that he/she has the power and authority to grant the Licence. + +Each Contributor warrants that the copyright in the modifications he/she brings to the Work are owned by him/her or licensed to him/her and that he/she has the power and authority to grant the Licence. + +Each time You accept the Licence, the original Licensor and subsequent Contributors grant You a licence to their contributions to the Work, under the terms of this Licence. + + +7. Disclaimer of Warranty + +The Work is a work in progress, which is continuously improved by numerous Contributors. It is not a finished work and may therefore contain defects or ‘bugs’ inherent to this type of development. + +For the above reason, the Work is provided under the Licence on an ‘as is’ basis and without warranties of any kind concerning the Work, including without limitation merchantability, fitness for a particular purpose, absence of defects or errors, accuracy, non-infringement of intellectual property rights other than copyright as stated in Article 6 of this Licence. + +This disclaimer of warranty is an essential part of the Licence and a condition for the grant of any rights to the Work. + + +8. Disclaimer of Liability + +Except in the cases of wilful misconduct or damages directly caused to natural persons, the Licensor will in no event be liable for any direct or indirect, material or moral, damages of any kind, arising out of the Licence or of the use of the Work, including without limitation, damages for loss of goodwill, work stoppage, computer failure or malfunction, loss of data or any commercial damage, even if the Licensor has been advised of the possibility of such damage. However, the Licensor will be liable under statutory product liability laws as far such laws apply to the Work. + + +9. Additional agreements + +While distributing the Work, You may choose to conclude an additional agreement, defining obligations or services consistent with this Licence. However, if accepting obligations, You may act only on your own behalf and on your sole responsibility, not on behalf of the original Licensor or any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against such Contributor by the fact You have accepted any warranty or additional liability. + + +10. Acceptance of the Licence + +The provisions of this Licence can be accepted by clicking on an icon ‘I agree’ placed under the bottom of a window displaying the text of this Licence or by affirming consent in any other similar way, in accordance with the rules of applicable law. Clicking on that icon indicates your clear and irrevocable acceptance of this Licence and all of its terms and conditions. + +Similarly, you irrevocably accept this Licence and all of its terms and conditions by exercising any rights granted to You by Article 2 of this Licence, such as the use of the Work, the creation by You of a Derivative Work or the Distribution or Communication by You of the Work or copies thereof. + + +11. Information to the public + +In case of any Distribution or Communication of the Work by means of electronic communication by You (for example, by offering to download the Work from a remote location) the distribution channel or media (for example, a website) must at least provide to the public the information requested by the applicable law regarding the Licensor, the Licence and the way it may be accessible, concluded, stored and reproduced by the Licensee. + + +12. Termination of the Licence + +The Licence and the rights granted hereunder will terminate automatically upon any breach by the Licensee of the terms of the Licence. + +Such a termination will not terminate the licences of any person who has received the Work from the Licensee under the Licence, provided such persons remain in full compliance with the Licence. + + +13. Miscellaneous + +Without prejudice of Article 9 above, the Licence represents the complete agreement between the Parties as to the Work. + +If any provision of the Licence is invalid or unenforceable under applicable law, this will not affect the validity or enforceability of the Licence as a whole. Such provision will be construed or reformed so as necessary to make it valid and enforceable. + +The European Commission may publish other linguistic versions or new versions of this Licence or updated versions of the Appendix, so far this is required and reasonable, without reducing the scope of the rights granted by the Licence. New versions of the Licence will be published with a unique version number. + +All linguistic versions of this Licence, approved by the European Commission, have identical value. Parties can take advantage of the linguistic version of their choice. + + +14. Jurisdiction + +Without prejudice to specific agreement between parties, + +— any litigation resulting from the interpretation of this License, arising between the European Union institutions, bodies, offices or agencies, as a Licensor, and any Licensee, will be subject to the jurisdiction of the Court of Justice of the European Union, as laid down in article 272 of the Treaty on the Functioning of the European Union, + +— any litigation arising between other parties and resulting from the interpretation of this License, will be subject to the exclusive jurisdiction of the competent court where the Licensor resides or conducts its primary business. + + +15. Applicable Law + +Without prejudice to specific agreement between parties, + +— this Licence shall be governed by the law of the European Union Member State where the Licensor has his seat, resides or has his registered office, + +— this licence shall be governed by Belgian law if the Licensor has no seat, residence or registered office inside a European Union Member State. +Appendix + +‘Compatible Licences’ according to Article 5 EUPL are: + +— GNU General Public License (GPL) v. 2, v. 3 + +— GNU Affero General Public License (AGPL) v. 3 + +— Open Software License (OSL) v. 2.1, v. 3.0 + +— Eclipse Public License (EPL) v. 1.0 + +— CeCILL v. 2.0, v. 2.1 + +— Mozilla Public Licence (MPL) v. 2 + +— GNU Lesser General Public Licence (LGPL) v. 2.1, v. 3 + +— Creative Commons Attribution-ShareAlike v. 3.0 Unported (CC BY-SA 3.0) for works other than software + +— European Union Public Licence (EUPL) v. 1.1, v. 1.2 + +— QuĂ©bec Free and Open-Source Licence — Reciprocity (LiLiQ-R) or Strong Reciprocity (LiLiQ-R+) + +The European Commission may update this Appendix to later versions of the above licences without producing a new version of the EUPL, as long as they provide the rights granted in Article 2 of this Licence and protect the covered Source Code from exclusive appropriation. + +All other changes or additions to this Appendix require the production of a new EUPL version. diff --git a/NAMESPACE b/NAMESPACE index 54055a5..41b479b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,6 +9,9 @@ S3method(filter,matrix) S3method(finite_filters,list) S3method(finite_filters,matrix) S3method(finite_filters,moving_average) +S3method(fst,default) +S3method(fst,finite_filters) +S3method(fst,moving_average) S3method(get_moving_average,Arima) S3method(get_moving_average,JD3_REGARIMA_OUTPUT) S3method(get_moving_average,JD3_REGARIMA_RSLTS) @@ -20,6 +23,8 @@ S3method(get_properties_function,moving_average) S3method(implicit_forecast,default) S3method(implicit_forecast,matrix) S3method(length,moving_average) +S3method(mse,default) +S3method(mse,finite_filters) S3method(plot_coef,default) S3method(plot_coef,finite_filters) S3method(plot_coef,moving_average) diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 0000000..e14ad43 --- /dev/null +++ b/NEWS.md @@ -0,0 +1,28 @@ +# Changelog + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/), and this project adheres +to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). + +## [Unreleased] + + +## [2.0.0] - 2023-12-12 + +### Changed + +* Merge pull request #12 from rjdemetra/develop +* Merge pull request #11 from rjdemetra/main + + +## [1.0.0] - 2023-07-06 + +### Added + +* New Jars + + +[Unreleased]: https://github.com/rjdemetra/rjd3filters/compare/v2.0.0...HEAD +[2.0.0]: https://github.com/rjdemetra/rjd3filters/releases/tag/v1.0.0...v2.0.0 +[1.0.0]: https://github.com/rjdemetra/rjd3filters/releases/tag/v1.0.0 diff --git a/R/1_moving_average.R b/R/1_moving_average.R index 5306b05..c95f360 100644 --- a/R/1_moving_average.R +++ b/R/1_moving_average.R @@ -18,12 +18,25 @@ NULL #' Manipulation of moving averages #' -#' @param x vector of coefficients +#' @param x vector of coefficients. #' @param lags integer indicating the number of lags of the moving average. #' @param trailing_zero,leading_zero boolean indicating wheter to remove leading/trailing zero and NA. #' @param s seasonal period for the \code{to_seasonal()} function. #' @param object `moving_average` object. #' +#' @details +#' A moving average is defined by a set of coefficient \eqn{\boldsymbol \theta=(\theta_{-p},\dots,\theta_{f})'} +#' such all time series \eqn{X_t} are transformed as: +#' \deqn{ +#' M_{\boldsymbol\theta}(X_t)=\sum_{k=-p}^{+f}\theta_kX_{t+k}=\left(\sum_{k=-p}^{+f}\theta_kB^{-k}\right)X_{t} +#' } +#' The integer \eqn{p} is defined by the parameter \code{lags}. +#' +#' The function `to_seasonal()` transforms the moving average \eqn{\boldsymbol \theta} to: +#' \deqn{ +#' M_{\boldsymbol\theta'}(X_t)=\sum_{k=-p}^{+f}\theta_kX_{t+ks}=\left(\sum_{k=-p}^{+f}\theta_kB^{-ks}\right)X_{t} +#' } +#' #' @examples #' y <- retailsa$AllOtherGenMerchandiseStores #' e1 <- moving_average(rep(1,12), lags = -6) @@ -68,7 +81,7 @@ moving_average <- function(x, lags = -length(x), trailing_zero = FALSE, leading_ lags <- lags - (length(new_x) - length(x)) x <- new_x } - upper_bound = lags + length(x) -1 + upper_bound <- lags + length(x) -1 # remove 1 if it is >= 0 (central term) # upper_bound = upper_bound - (upper_bound >= 0) @@ -86,7 +99,7 @@ moving_average <- function(x, lags = -length(x), trailing_zero = FALSE, leading_ } .ma2jd <- function(x){ lags <- lower_bound(x) - coefs = as.numeric(coef(x)) + coefs <- as.numeric(coef(x)) if (length(x) == 1){ coefs <- .jarray(coefs) } @@ -103,7 +116,7 @@ is.moving_average <- function(x){ #' @importFrom stats coef coefficients #' @export coef.moving_average <- function(object, ...){ - coefs = object@coefficients + coefs <- object@coefficients return(coefs) } #' @rdname moving_average @@ -209,9 +222,9 @@ setReplaceMethod("[", #' @export cbind.moving_average <- function(...){ all_mm <- list(...) - new_lb = min(sapply(all_mm, lower_bound)) - new_ub = max(sapply(all_mm, upper_bound)) - nb_uterms = max(sapply(all_mm, function(x) lower_bound(x) + length(x))) + new_lb <- min(sapply(all_mm, lower_bound)) + new_ub <- max(sapply(all_mm, upper_bound)) + nb_uterms <- max(sapply(all_mm, function(x) lower_bound(x) + length(x))) new_mm <- lapply(all_mm, function(x){ c(rep(0, abs(new_lb - lower_bound(x))), coef(x), diff --git a/R/2_finite_filters.R b/R/2_finite_filters.R index dd1d699..bbed105 100644 --- a/R/2_finite_filters.R +++ b/R/2_finite_filters.R @@ -35,16 +35,16 @@ finite_filters.moving_average <- function(sfilter, first_to_last = FALSE){ if (is.null(lfilters) & !is.null(rfilters)) { if (first_to_last) { - rfilters = rev(rfilters) + rfilters <- rev(rfilters) } - lfilters = rev(lapply(rfilters, rev.moving_average)) + lfilters <- rev(lapply(rfilters, rev.moving_average)) } else if (!is.null(lfilters) & is.null(rfilters)) { if (!first_to_last) { - lfilters = rev(lfilters) + lfilters <- rev(lfilters) } - rfilters = rev(lapply(lfilters, rev.moving_average)) + rfilters <- rev(lapply(lfilters, rev.moving_average)) } else if (is.null(lfilters) & is.null(rfilters)) { - rfilters = lfilters = list() + rfilters <- lfilters <- list() } res <- new("finite_filters", @@ -83,16 +83,34 @@ finite_filters.matrix <- function(sfilter, #' @export -.jd2r_finitefilters <- function(jf, first_to_last = TRUE){ +.jd2r_finitefilters <- function(jf, first_to_last){ jf<-.jcast(jf, "jdplus.toolkit.base.core.math.linearfilters/IFiltering") if (! is.jnull(jf)) { jsfilter <- .jcall(jf, "Ljdplus/toolkit/base/core/math/linearfilters/IFiniteFilter;", "centralFilter") jrfilter <- .jcall(jf, "[Ljdplus/toolkit/base/core/math/linearfilters/IFiniteFilter;", "rightEndPointsFilters") jlfilter <- .jcall(jf, "[Ljdplus/toolkit/base/core/math/linearfilters/IFiniteFilter;", "leftEndPointsFilters") - sfilter = .jd2ma(jsfilter) - rfilters = lapply(jrfilter, .jd2ma) - lfilters = rev(lapply(jlfilter, .jd2ma)) + sfilter <- .jd2ma(jsfilter) + rfilters <- lapply(jrfilter, .jd2ma) + lfilters <- rev(lapply(jlfilter, .jd2ma)) + + if (missing(first_to_last)) { + if (all(diff(sapply(lfilters, length)) <= 0)) { + lfilters <- rev(lfilters) + rfilters <- rev(rfilters) + } + } else { + if(first_to_last) { + lfilters <- rev(lfilters) + rfilters <- rev(rfilters) + } + } + + finite_filters(sfilter = sfilter, + rfilters = rfilters, + lfilters = lfilters) + } else { + NULL } # if (.jinstanceof(jf, "jdplus/x12plus/base/core/X11SeasonalFiltersFactory$AnyFilter")) { # jsfilter <- .jcall(jf, "Ljdplus/toolkit/base/core/math/linearfilters/SymmetricFilter;", "symmetricFilter") @@ -123,9 +141,6 @@ finite_filters.matrix <- function(sfilter, # lfilters <- NULL # } - finite_filters(sfilter = sfilter, - rfilters = rfilters, - lfilters = lfilters) } #' @rdname filters_operations #' @export @@ -164,7 +179,7 @@ setMethod("*", all_f <- t(do.call(cbind,c(new_e1, new_e2))) mat_e1 <- all_f[seq_along(new_e1),] mat_e2 <- all_f[-seq_along(new_e1),] - new_mat = (mat_e1[, seq_along(new_e2)] %*% mat_e2)[seq_len(1 + length(e2@lfilters) + length(e2@rfilters)),] + new_mat <- (mat_e1[, seq_along(new_e2)] %*% mat_e2)[seq_len(1 + length(e2@lfilters) + length(e2@rfilters)),] max_lags <- min(sapply(new_e1, lower_bound), sapply(new_e2, lower_bound)) @@ -228,9 +243,9 @@ setMethod("+", signature(e1 = "finite_filters", e2 = "moving_average"), function(e1, e2) { - e1@sfilter = e1@sfilter + e2 - e1@lfilters = lapply(e1@lfilters, `+`, e2) - e1@rfilters = lapply(e1@rfilters, `+`, e2) + e1@sfilter <- e1@sfilter + e2 + e1@lfilters <- lapply(e1@lfilters, `+`, e2) + e1@rfilters <- lapply(e1@rfilters, `+`, e2) e1 }) #' @rdname filters_operations @@ -250,9 +265,9 @@ setMethod("-", signature(e1 = "finite_filters", e2 = "missing"), function(e1, e2) { - e1@sfilter = - e1@sfilter - e1@lfilters = lapply(e1@lfilters, `-`) - e1@rfilters = lapply(e1@rfilters, `-`) + e1@sfilter <- - e1@sfilter + e1@lfilters <- lapply(e1@lfilters, `-`) + e1@rfilters <- lapply(e1@rfilters, `-`) e1 }) #' @rdname filters_operations @@ -261,9 +276,9 @@ setMethod("-", signature(e1 = "finite_filters", e2 = "moving_average"), function(e1, e2) { - e1@sfilter = e1@sfilter - e2 - e1@lfilters = lapply(e1@lfilters, `-`, e2) - e1@rfilters = lapply(e1@rfilters, `-`, e2) + e1@sfilter <- e1@sfilter - e2 + e1@lfilters <- lapply(e1@lfilters, `-`, e2) + e1@rfilters <- lapply(e1@rfilters, `-`, e2) e1 }) #' @rdname filters_operations @@ -297,9 +312,9 @@ setMethod("/", signature(e1 = "finite_filters", e2 = "numeric"), function(e1, e2) { - e1@sfilter = e1@sfilter / e2 - e1@lfilters = lapply(e1@lfilters, `/`, e2) - e1@rfilters = lapply(e1@rfilters, `/`, e2) + e1@sfilter <- e1@sfilter / e2 + e1@lfilters <- lapply(e1@lfilters, `/`, e2) + e1@rfilters <- lapply(e1@rfilters, `/`, e2) e1 }) #' @method as.matrix finite_filters @@ -457,13 +472,13 @@ setMethod("[", }) #' @export to_seasonal.finite_filters <- function(x, s){ - x@sfilter = to_seasonal(x@sfilter, s) - x@rfilters = unlist(lapply(x@rfilters, function(x){ - new_mm = to_seasonal(x, s) + x@sfilter <- to_seasonal(x@sfilter, s) + x@rfilters <- unlist(lapply(x@rfilters, function(x){ + new_mm <- to_seasonal(x, s) rep(list(new_mm), s) })) - x@lfilters = unlist(lapply(x@lfilters, function(x){ - new_mm = to_seasonal(x, s) + x@lfilters <- unlist(lapply(x@lfilters, function(x){ + new_mm <- to_seasonal(x, s) rep(list(new_mm), s) })) x diff --git a/R/RKHS.R b/R/RKHS.R index bc1ab48..f7910b0 100644 --- a/R/RKHS.R +++ b/R/RKHS.R @@ -29,11 +29,21 @@ rkhs_filter <- function(horizon = 6, degree = 2, optimal.minBandwidth = horizon, optimal.maxBandwidth = 3*horizon, bandwidth = horizon + 1){ - kernel = match.arg(kernel) - asymmetricCriterion = match.arg(asymmetricCriterion) - density = match.arg(density) - jrkhs_filter = + kernel <- match.arg(tolower(kernel)[1], + choices = c("biweight", "henderson", "epanechnikov", "triangular", "uniform", + "triweight")) + + asymmetricCriterion <- switch(tolower(asymmetricCriterion[1]), + timeliness = "Timeliness", + frequencyresponse = "FrequencyResponse", + accuracy = "Accuracy", + smoothness = "Smoothness", + undefined = "Undefined") + + density <- match.arg(density) + + jrkhs_filter <- .jcall("jdplus/filters/base/r/RKHSFilters", "Ljdplus/toolkit/base/core/math/linearfilters/ISymmetricFiltering;", "filters", @@ -73,10 +83,18 @@ rkhs_optimization_fun <- function(horizon = 6, leads = 0, degree = 2, asymmetricCriterion = c("Timeliness", "FrequencyResponse", "Accuracy", "Smoothness"), density = c("uniform", "rw"), passband = 2*pi/12){ - kernel = match.arg(kernel) - asymmetricCriterion = match.arg(asymmetricCriterion) - density = match.arg(density) - optimalFunCriteria = J("jdplus/filters/base/r/RKHSFilters")$optimalCriteria( + + kernel <- match.arg(tolower(kernel)[1], + choices = c("biweight", "henderson", "epanechnikov", "triangular", "uniform", + "triweight")) + asymmetricCriterion <- switch(tolower(asymmetricCriterion[1]), + timeliness = "Timeliness", + frequencyresponse = "FrequencyResponse", + accuracy = "Accuracy", + smoothness = "Smoothness", + undefined = "Undefined") + density <- match.arg(density) + optimalFunCriteria <- J("jdplus/filters/base/r/RKHSFilters")$optimalCriteria( as.integer(horizon), as.integer(leads), as.integer(degree), kernel, asymmetricCriterion, density=="rw", passband )$applyAsDouble @@ -100,10 +118,18 @@ rkhs_optimal_bw <- function(horizon = 6, degree = 2, passband = 2*pi/12, optimal.minBandwidth = horizon, optimal.maxBandwidth = 3*horizon){ - kernel = match.arg(kernel) - asymmetricCriterion = match.arg(asymmetricCriterion) - density = match.arg(density) - optimalBw= J("jdplus/filters/base/r/RKHSFilters")$optimalBandwidth( + + kernel <- match.arg(tolower(kernel)[1], + choices = c("biweight", "henderson", "epanechnikov", "triangular", "uniform", + "triweight")) + asymmetricCriterion <- switch(tolower(asymmetricCriterion[1]), + timeliness = "Timeliness", + frequencyresponse = "FrequencyResponse", + accuracy = "Accuracy", + smoothness = "Smoothness", + undefined = "Undefined") + density <- match.arg(density) + optimalBw <- J("jdplus/filters/base/r/RKHSFilters")$optimalBandwidth( as.integer(horizon), as.integer(degree), kernel, asymmetricCriterion, density=="rw", passband, optimal.minBandwidth, optimal.maxBandwidth ) @@ -115,8 +141,11 @@ rkhs_optimal_bw <- function(horizon = 6, degree = 2, #' @export rkhs_kernel <- function(kernel = c("Biweight", "Henderson", "Epanechnikov", "Triangular", "Uniform", "Triweight"), degree = 2, horizon = 6){ - kernel = match.arg(kernel) - kernel = switch(tolower(kernel), + + kernel <- match.arg(tolower(kernel)[1], + choices = c("biweight", "henderson", "epanechnikov", "triangular", "uniform", + "triweight")) + kernel <- switch(tolower(kernel), "biweight" = "BiWeight", "triweight" ="TriWeight", "uniform" = "Uniform", @@ -124,7 +153,7 @@ rkhs_kernel <- function(kernel = c("Biweight", "Henderson", "Epanechnikov", "Tri "epanechnikov" = "Epanechnikov", "henderson" = "Henderson" ) - kernel_fun = J("jdplus/filters/base/r/RKHSFilters")$kernel( + kernel_fun <- J("jdplus/filters/base/r/RKHSFilters")$kernel( kernel, as.integer(degree), as.integer(horizon) )$applyAsDouble diff --git a/R/arima2ma.R b/R/arima2ma.R index 775ad1a..01c01bc 100644 --- a/R/arima2ma.R +++ b/R/arima2ma.R @@ -2,7 +2,10 @@ #' #' @param x the object. #' @param ... unused parameters -#' +#' @examples +#' fit <- stats::arima(log10(AirPassengers), c(0, 1, 1), +#' seasonal = list(order = c(0, 1, 1), period = 12)) +#' get_moving_average(fit) #' @export get_moving_average <- function(x, ...) { UseMethod("get_moving_average", x) @@ -64,7 +67,7 @@ get_moving_average.Arima <- function(x, ...){ } #' @export get_moving_average.regarima <- function(x, period = 12, ...){ - specif = x$specification$arima$specification + specif <- x$specification$arima$specification ar <- specif$arima.p ma <- specif$arima.q sar <- specif$arima.bp diff --git a/R/crossvalidation.R b/R/crossvalidation.R index 54ce7a2..4dd83fb 100644 --- a/R/crossvalidation.R +++ b/R/crossvalidation.R @@ -51,7 +51,7 @@ var_estimator <- function(x, coef, ...) { coef0 <- coefficients(coef)["t"] sigma2 <- mean((x - sc)^2, na.rm = TRUE) - sigma2 <- sigma2/(1- 2 * coef0 + sum(coef^2)) + sigma2 <- sigma2/(1- 2 * coef0 + sum(coefficients(coef)^2)) names(sigma2) <- NULL sigma2 } diff --git a/R/dfa.R b/R/dfa.R index a5ac2cd..50b24c6 100644 --- a/R/dfa.R +++ b/R/dfa.R @@ -6,6 +6,15 @@ #' @param accuracy.weight,smoothness.weight,timeliness.weight the weight used for the #' optimisation. The weight associated to the residual is derived so that the sum of #' the four weights are equal to 1. +#' +#' @details +#' Moving average computed by a minimisation of a weighted mean of three criteria under polynomials constraints. +#' The criteria come from the decomposition of the mean squared error between th trend-cycle +#' +#' Let \eqn{\boldsymbol \theta=(\theta_{-p},\dots,\theta_{f})'} be a moving average where +#' \eqn{p} and \eqn{f} are two integers defined by the parameter `lags` and `leads`. +#' The three criteria are: +#' #' @export #' @examples #' dfa_filter(horizon = 6, degree = 0) @@ -17,7 +26,7 @@ dfa_filter <- function(horizon = 6, degree = 0, accuracy.weight = 1/3, smoothness.weight = 1/3, timeliness.weight = 1/3){ - density = match.arg(density) + density <- match.arg(density) if (length(targetfilter) != 2*horizon + 1) stop("The symmetric targetfilter must be of length 2*horizon+1") if (is.moving_average(targetfilter)) { @@ -28,7 +37,7 @@ dfa_filter <- function(horizon = 6, degree = 0, targetfilter <- coef(targetfilter) } } - dfa_filter = J("jdplus/filters/base/r/DFAFilters")$filters( + dfa_filter <- J("jdplus/filters/base/r/DFAFilters")$filters( targetfilter, as.integer(horizon), as.integer(degree), density=="rw", passband, @@ -37,4 +46,3 @@ dfa_filter <- function(horizon = 6, degree = 0, return(.jd2r_finitefilters(dfa_filter)) } # - diff --git a/R/filter.R b/R/filter.R index 1f1048e..a5ae053 100644 --- a/R/filter.R +++ b/R/filter.R @@ -72,18 +72,18 @@ filter_ma <- function(x, coefs){ # if (!is.moving_average(coefs)) { # coefs <- moving_average(coefs, -abs(lags)) # } - lb = lower_bound(coefs) - ub = upper_bound(coefs) + lb <- lower_bound(coefs) + ub <- upper_bound(coefs) if (length(x) <= length(coefs)) return(x * NA) - DataBlock = J("jdplus.toolkit.base.core.data.DataBlock") - jx = DataBlock$of(as.numeric(x)) - out = DataBlock$of(as.numeric(rep(NA, length(x) - length(coefs)+1))) + DataBlock <- J("jdplus.toolkit.base.core.data.DataBlock") + jx <- DataBlock$of(as.numeric(x)) + out <- DataBlock$of(as.numeric(rep(NA, length(x) - length(coefs)+1))) .ma2jd(coefs)$apply(jx, out) - result = out$toArray() + result <- out$toArray() result <- c(rep(NA, abs(min(lb, 0))), result, rep(NA, abs(max(ub, 0)))) @@ -119,7 +119,7 @@ ff_ma <- function(x, coefs, remove_missing = TRUE) { result <- .jcall(result, "[D", "toArray") if (remove_missing){ - result = c(rep(NA, data_clean$leading), result, + result <- c(rep(NA, data_clean$leading), result, rep(NA, data_clean$trailing)) } if(is.ts(x)) diff --git a/R/fst_filters.R b/R/fst_filters.R index 421d958..8322c7e 100644 --- a/R/fst_filters.R +++ b/R/fst_filters.R @@ -8,19 +8,62 @@ #' @param timeliness.weight Weight for the Timeliness criterion (in \eqn{[0, 1[}). \code{sweight+tweight} should be in \eqn{[0,1]}. #' @param timeliness.passband Passband for the timeliness criterion (in radians). The phase effect is computed in \eqn{[0, passband]}. #' @param timeliness.antiphase boolean indicating if the timeliness should be computed analytically (\code{TRUE}) or numerically (\code{FALSE}). +#' @details +#' Moving average computed by a minimisation of a weighted mean of three criteria under polynomials constraints. +#' Let \eqn{\boldsymbol \theta=(\theta_{-p},\dots,\theta_{f})'} be a moving average where +#' \eqn{p} and \eqn{f} are two integers defined by the parameter `lags` and `leads`. +#' The three criteria are: +#' - *Fidelity*, \eqn{F_g}: it's the variance reduction ratio. +#' \deqn{ +#' F_g(\boldsymbol \theta) = \sum_{k=-p}^{+f}\theta_{k}^{2} +#' } +#' +#' - *Smoothness*, \eqn{S_g}: it measures the flexibility of the coefficient curve of a filter and the smoothness of the trend. +#' \deqn{ +#' S_g(\boldsymbol \theta) = \sum_{j}(\nabla^{q}\theta_{j})^{2} +#' } +#' The integer \eqn{q} is defined by parameter `smoothness.degree`. +#' By default, the Henderson criteria is used (`smoothness.degree = 3`). #' -#' @return An object of class \code{"fst_filter"}, which is a list of 5 elements:\itemize{ -#' \item{\code{"internal"}}{Java object used for internal functions} -#' \item{\code{"filters.coef"}}{The coefficients of the selected filter} -#' \item{\code{"filters.gain"}}{The gain function between 0 and pi (601 observations)} -#' \item{\code{"filters.phase"}}{The phase function between 0 and pi (601 observations)} -#' \item{\code{"criteria"}}{The value of the tree criteria} +#' - *Timeliness*, \eqn{T_g} : +#' \deqn{ +#' T_g(\boldsymbol\theta)=\int_{0}^{\omega_{2}}f(\rho_{\boldsymbol\theta}(\omega),\varphi_{\boldsymbol\theta}(\omega))d\omega #' } +#' with \eqn{\rho_{\boldsymbol\theta}} and \eqn{\varphi_{\boldsymbol\theta}} the gain and phase shift functions +#' of \eqn{\boldsymbol \theta}, and \eqn{f} a penalty function defined as \eqn{f\colon(\rho,\varphi)\mapsto\rho^2\sin(\varphi)^2} +#' to have an analytically solvable criterium. +#' \eqn{\omega_{2}} is defined by the parameter `timeliness.passband` and is it +#' by default equal to \eqn{2\pi/12}: for monthly time series, we focus on the timeliness associated to +#' cycles of 12 months or more. +#' +#' The moving average is then computed solving the problem: +#' \deqn{ +#' \begin{cases} +#' \underset{\theta}{\min} & J(\theta)= +#' (1-\beta-\gamma) F_g(\theta)+\beta S_g(\theta)+\gamma T_g(\theta)\\ +#' s.t. & C\theta=a +#' \end{cases} +#' } +#' Where \eqn{C\theta=a} represents linear constraints to have a moving average +#' that preserve polynomials of degree \eqn{q} (`pdegree`): +#' \deqn{ +#' C=\begin{pmatrix} +#' 1 & \cdots&1\\ +#' -h & \cdots&h \\ +#' \vdots & \cdots & \vdots \\ +#' (-h)^d & \cdots&h^d +#' \end{pmatrix},\quad +#' a=\begin{pmatrix} +#' 1 \\0 \\ \vdots\\0 +#' \end{pmatrix} +#' } +#' #' #' @examples #' filter <- fst_filter(lags = 6, leads = 0) #' filter -#' @references Grun-Rehomme, Michel, Fabien Guggemos, and Dominique Ladiray (2018). “Asymmetric Moving Averages Minimizing Phase Shift”. In: Handbook on Seasonal Adjustment. +#' @references Grun-Rehomme, Michel, Fabien Guggemos, and Dominique Ladiray (2018). “Asymmetric Moving Averages Minimizing Phase Shift”. In: Handbook on Seasonal Adjustment, +#' \url{https://ec.europa.eu/eurostat/web/products-manuals-and-guidelines/-/ks-gq-18-001}. #' @export fst_filter<-function(lags = 6, leads = 0, pdegree = 2, smoothness.weight = 1, smoothness.degree = 3, timeliness.weight = 0, @@ -40,25 +83,64 @@ fst_filter<-function(lags = 6, leads = 0, pdegree = 2, #' @param weights either a `"moving_average"` or a numeric vector containing weights. #' @param lags Lags of the moving average (when `weights` is not a `"moving_average"`). #' @param passband Passband threshold for timeliness criterion. +#' @param ... other unused arguments. #' #' @return The values of the 3 criteria, the gain and phase of the associated filter. #' @examples #' filter <- lp_filter(horizon = 6, kernel = "Henderson", endpoints = "LC") #' fst(filter[, "q=0"]) -#' @references Grun-Rehomme, Michel, Fabien Guggemos, and Dominique Ladiray (2018). “Asymmetric Moving Averages Minimizing Phase Shift”. In: Handbook on Seasonal Adjustment. +#' # To compute the statistics on all filters: +#' fst(filter) +#' @references Grun-Rehomme, Michel, Fabien Guggemos, and Dominique Ladiray (2018). “Asymmetric Moving Averages Minimizing Phase Shift”. In: Handbook on Seasonal Adjustment, +#' \url{https://ec.europa.eu/eurostat/web/products-manuals-and-guidelines/-/ks-gq-18-001}. #' #' @export -fst<-function(weights, lags, passband=pi/6){ - if (is.moving_average(weights)) { - lags <- lower_bound(weights) - weights <- coef(weights) - } +#' +fst <- function(weights, lags, passband=pi/6, ...) { + UseMethod("fst", weights) +} +#' @export +fst.default<-function(weights, lags, passband=pi/6, ...){ jobj<-.jcall("jdplus/filters/base/core/AdvancedFiltersToolkit", "Ljdplus/filters/base/core/AdvancedFiltersToolkit$FSTResult;", "fst", weights, as.integer(lags), passband) criteria<-.jcall(jobj, "[D", "getCriterions") names(criteria) <- c("Fidelity", "Smoothness", "Timeliness") return(criteria) } +#' @export +fst.moving_average<-function(weights, lags, passband=pi/6, ...){ + lags <- lower_bound(weights) + weights <- coef(weights) + fst(weights, lags, passband) +} +#' @export +fst.finite_filters<-function(weights, lags, passband=pi/6, + sfilter = TRUE, rfilters = TRUE, lfilters = FALSE, ...){ + if (!any(sfilter, rfilters, lfilters)) + return (NULL) + + sfilter_s <- rfilters_s <- lfilters_s <- + index_s <- index_r <- index_l <- NULL + if (sfilter) { + sfilter_s <- list(weights@sfilter) + index_s <- length(weights@rfilters) + } + if (lfilters && length(weights@lfilters) > 0) { + lfilters_s <- weights@lfilters + index_l <- seq(0, -(length(weights@lfilters) - 1)) + } + if (rfilters && length(weights@rfilters) > 0) { + rfilters_s <- weights@rfilters + index_r <- seq(length(weights@rfilters) - 1, 0) + } + mat <- do.call( + cbind, + lapply(c(lfilters_s, sfilter_s, rfilters_s), + fst, passband = passband) + ) + colnames(mat) <- sprintf("q=%i", c(index_l, index_s, index_r)) + mat +} #' Accuracy/smoothness/timeliness criteria through spectral decomposition #' @@ -67,16 +149,23 @@ fst<-function(weights, lags, passband=pi/6){ #' @param aweights `moving_average` object or weights of the asymmetric filter (from -n to m). #' @param density hypothesis on the spectral density: \code{"uniform"} (= white woise, the default) or \code{"rw"} (= random walk). #' @param passband passband threshold. +#' @param ... other unused arguments. #' #' @return The criteria #' @examples #' filter <- lp_filter(horizon = 6, kernel = "Henderson", endpoints = "LC") -#' sweights <- filter[,"q=6"] -#' aweights <- filter[,"q=0"] -#' mse(sweights, aweights) +#' sweights <- filter[, "q=6"] +#' aweights <- filter[, "q=0"] +#' mse(aweights, sweights) +#' # Or to compute directly the criteria on all asymmetric filters: +#' mse(filter) #' @references Wildi, Marc and McElroy, Tucker (2019). “The trilemma between accuracy, timeliness and smoothness in real-time signal extraction”. In: International Journal of Forecasting 35.3, pp. 1072–1084. #' @export -mse<-function(sweights, aweights, density=c("uniform", "rw"), passband = pi/6){ +mse<-function(aweights, sweights, density=c("uniform", "rw"), passband = pi/6, ...){ + UseMethod("mse", aweights) +} +#' @export +mse.default<-function(aweights, sweights, density=c("uniform", "rw"), passband = pi/6, ...){ if (is.moving_average(aweights)) aweights <- coef(aweights) @@ -92,8 +181,36 @@ mse<-function(sweights, aweights, density=c("uniform", "rw"), passband = pi/6){ n <- (length(sweights)-1)/2 sweights <- sweights[-seq_len(n)] } - spectral = match.arg(density) + spectral <- match.arg(density) rslt<-.jcall("jdplus/filters/base/core/AdvancedFiltersToolkit", "[D", "mseDecomposition", sweights, aweights, spectral, passband) return (c(accuracy=rslt[1], smoothness=rslt[2], timeliness=rslt[3], residual=rslt[4])) } +#' @export +mse.finite_filters<-function(aweights, sweights = aweights@sfilter, density=c("uniform", "rw"), passband = pi/6, + sfilter = TRUE, rfilters = TRUE, lfilters = FALSE, ...){ + if (!any(sfilter, rfilters, lfilters)) + return (NULL) + + sfilter_s <- rfilters_s <- lfilters_s <- + index_s <- index_r <- index_l <- NULL + if (sfilter) { + sfilter_s <- list(aweights@sfilter) + index_s <- length(aweights@rfilters) + } + if (lfilters && length(aweights@lfilters) > 0) { + lfilters_s <- aweights@lfilters + index_l <- seq(0, -(length(aweights@lfilters) - 1)) + } + if (rfilters && length(aweights@rfilters) > 0) { + rfilters_s <- aweights@rfilters + index_r <- seq(length(aweights@rfilters) - 1, 0) + } + mat <- do.call( + cbind, + lapply(c(lfilters_s, sfilter_s, rfilters_s), + mse, sweights = sweights, density = density, passband = passband) + ) + colnames(mat) <- sprintf("q=%i", c(index_l, index_s, index_r)) + mat +} diff --git a/R/get_properties_function.R b/R/get_properties_function.R index 9861f02..0a96de5 100644 --- a/R/get_properties_function.R +++ b/R/get_properties_function.R @@ -1,6 +1,6 @@ -#' Get properties of local polynomials filters +#' Get properties of filters #' -#' @param x a \code{"lp_filter"} object. +#' @param x a \code{"moving_average"} or \code{"finite_filters"} object. #' @param component the component to extract. #' @param ... unused other arguments. #' @@ -49,8 +49,8 @@ get_properties_function.moving_average <- function(x, "Asymmetric Gain", "Asymmetric Phase", "Asymmetric transfer"), ...){ - x = .ma2jd(x) - component = match.arg(component) + x <- .ma2jd(x) + component <- match.arg(component) switch(component, "Symmetric Gain" = { get_gain_function(x) @@ -79,7 +79,7 @@ get_properties_function.finite_filters <- function(x, "Asymmetric Gain", "Asymmetric Phase", "Asymmetric transfer"), ...){ - component = match.arg(component) + component <- match.arg(component) if (length(grep("Symmetric", component, fixed = TRUE)) > 0) { get_properties_function(x@sfilter, component = component) } else { @@ -133,8 +133,8 @@ diagnostic_matrix <- function(x, lags, passband = pi/6, fst(x, lags, passband = passband)) if(!missing(sweights)){ results <- c(results, - mse(sweights, - x, + mse(x, + sweights, passband = passband, ... ) diff --git a/R/implicit_forecast.R b/R/implicit_forecast.R index 0aad48b..0c7a1ce 100644 --- a/R/implicit_forecast.R +++ b/R/implicit_forecast.R @@ -8,7 +8,7 @@ #' the trend when \eqn{q} future values are known (with the convention \eqn{w_{q+1}^q=\ldots=w_h^q=0}). #' Let denote \eqn{y_{-h},\ldots, y_0} the las \eqn{h} available values of the input times series. #' Let also note \eqn{y_{-h},\ldots,y_{0}} the observed series studied and \eqn{y_{1}^*,\dots y_h^*}the implicit forecast induced by \eqn{w^0,\dots w^{h-1}}. -#' This means that e: +#' This means that: #' \deqn{ #' \forall q, \quad \sum_{i=-h}^0 v_iy_i + \sum_{i=1}^h v_iy_i^* #' =\sum_{i=-h}^0 w_i^qy_i + \sum_{i=1}^h w_i^qy_i^* diff --git a/R/kernels.R b/R/kernels.R index c201cdb..2a4e7ce 100644 --- a/R/kernels.R +++ b/R/kernels.R @@ -12,27 +12,31 @@ #' @examples #' get_kernel("Henderson", horizon = 3) get_kernel <- function(kernel = c("Henderson","Uniform", "Triangular", - "Epanechnikov","Parabolic","Biweight", "Triweight","Tricube", + "Epanechnikov","Parabolic","BiWeight", "TriWeight","Tricube", "Trapezoidal", "Gaussian"), horizon, sd_gauss = 0.25){ - kernel = match.arg(kernel) - if(kernel == "Parabolic") - kernel = "Epanechnikov" + + kernel <- match.arg(tolower(kernel)[1], + choices = c("henderson", "uniform", "triangular", "epanechnikov", "parabolic", + "biweight", "triweight", "tricube", "trapezoidal", "gaussian" + )) + if(kernel == "parabolic") + kernel <- "epanechnikov" h <- as.integer(horizon) - if(kernel == "Gaussian"){ + if(kernel == "gaussian"){ jkernel <- .jcall("jdplus/toolkit/base/core/data/analysis/DiscreteKernel", "Ljava/util/function/IntToDoubleFunction;", tolower(kernel), h, sd_gauss) - }else{ + } else{ jkernel <- .jcall("jdplus/toolkit/base/core/data/analysis/DiscreteKernel", "Ljava/util/function/IntToDoubleFunction;", tolower(kernel), h) } - coef = sapply(as.integer(seq.int(from = 0, to = horizon, by = 1)), + coef <- sapply(as.integer(seq.int(from = 0, to = horizon, by = 1)), jkernel$applyAsDouble) - m = horizon + m <- horizon result <- list(coef = coef, m = m) attr(result, "name") <- kernel attr(result, "class") <- "tskernel" diff --git a/R/lp_filters.R b/R/lp_filters.R index 7d59990..8f82eec 100644 --- a/R/lp_filters.R +++ b/R/lp_filters.R @@ -31,13 +31,26 @@ localpolynomials<-function(x, if(2*horizon < degree) stop("You need more observation (2 * horizon + 1) than variables (degree + 1) to estimate the filter.") - d<-2/(sqrt(pi)*ic) - kernel=match.arg(kernel) - endpoints=match.arg(endpoints) + d <- 2 / (sqrt(pi) * ic) + kernel <- match.arg(tolower(kernel), + choices = c("henderson", "uniform", "biweight", "trapezoidal", "triweight", + "tricube", "gaussian", "triangular", "parabolic")) + kernel <- switch (kernel, + henderson = "Henderson", + uniform = "Uniform", + biweight = "Biweight", + trapezoidal = "Trapezoidal", + triweight = "Triweight", + tricube = "Tricube", + gaussian = "Gaussian", + triangular = "Triangular", + parabolic = "Parabolic" + ) + endpoints <- match.arg(endpoints) result <- .jcall("jdplus/filters/base/r/LocalPolynomialFilters", "[D", "filter", as.numeric(x), as.integer(horizon), as.integer(degree), kernel, endpoints, d, tweight, passband) - if(is.ts(x)) + if (is.ts(x)) result <- ts(result,start = start(x), frequency = frequency(x)) result } @@ -74,21 +87,33 @@ lp_filter <- function(horizon = 6, degree = 3, tweight = 0, passband = pi/12){ if(2*horizon < degree) stop("You need more observation (2 * horizon + 1) than variables (degree + 1) to estimate the filter.") - d<-2/(sqrt(pi)*ic) - kernel=match.arg(kernel) - endpoints=match.arg(endpoints) - jprops<-.jcall("jdplus/filters/base/r/LocalPolynomialFilters", - "Ljdplus/toolkit/base/core/math/linearfilters/ISymmetricFiltering;", - "filters", as.integer(horizon), - as.integer(degree), kernel, endpoints, d, - tweight, passband) - return(.jd2r_finitefilters(jprops, first_to_last = FALSE)) + d <- 2 / (sqrt(pi) * ic) + kernel <- match.arg(tolower(kernel), + choices = c("henderson", "uniform", "biweight", "trapezoidal", "triweight", + "tricube", "gaussian", "triangular", "parabolic")) + kernel <- switch (kernel, + henderson = "Henderson", + uniform = "Uniform", + biweight = "Biweight", + trapezoidal = "Trapezoidal", + triweight = "Triweight", + tricube = "Tricube", + gaussian = "Gaussian", + triangular = "Triangular", + parabolic = "Parabolic" + ) + endpoints <- match.arg(endpoints) + jprops <-.jcall("jdplus/filters/base/r/LocalPolynomialFilters", + "Ljdplus/toolkit/base/core/math/linearfilters/ISymmetricFiltering;", + "filters", as.integer(horizon), + as.integer(degree), kernel, endpoints, d, + tweight, passband) + + return(.jd2r_finitefilters(jprops)) } coefficients_names <- function(lb, ub){ x <- sprintf("t%+i", seq(lb,ub)) x <- sub("+0", "", x, fixed = TRUE) x } - - diff --git a/R/plots.R b/R/plots.R index 2f84070..8006605 100644 --- a/R/plots.R +++ b/R/plots.R @@ -87,7 +87,7 @@ plot_gain <- function(x, nxlab = 7, add = FALSE, #' @export plot_gain.moving_average<- function(x, nxlab = 7, add = FALSE, xlim = c(0, pi), ...){ - g = get_properties_function(x, "Symmetric Gain") + g <- get_properties_function(x, "Symmetric Gain") plot(g, type = "l", xaxt = "n", xlab = "", ylab = "gain", add = add, xlim = xlim, ...) @@ -144,7 +144,7 @@ plot_phase <- function(x, nxlab = 7, add = FALSE, #' @export plot_phase.moving_average<- function(x, nxlab = 7, add = FALSE, xlim = c(0, pi), normalized = FALSE, ...){ - p = get_properties_function(x, "Symmetric Phase") + p <- get_properties_function(x, "Symmetric Phase") if (normalized) { p_plot <- function(x) { @@ -292,7 +292,7 @@ remove_bound_NA <- function(x) { # list(data = x, leading = 0, # trailing = 0) } else{ - x = x[- c(remove_i_first, remove_i_last)] + x <- x[- c(remove_i_first, remove_i_last)] } list(data = x, leading = length(remove_i_first), diff --git a/R/print.R b/R/print.R index f101e0a..834b359 100644 --- a/R/print.R +++ b/R/print.R @@ -11,6 +11,6 @@ setMethod(f = "show", setMethod(f = "show", signature = c("finite_filters"), definition = function(object){ - x = as.matrix(object) + x <- as.matrix(object) print(x) }) diff --git a/R/zzz.R b/R/zzz.R index 3e793c4..e074c91 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -5,7 +5,7 @@ NULL .onLoad <- function(libname, pkgname) { - if (! requireNamespace("rjd3toolkit", quietly = T)) stop("Loading rjd3 libraries failed") + if (! requireNamespace("rjd3toolkit", quietly = TRUE)) stop("Loading rjd3 libraries failed") # For debugts_ging: to see if Jars are effectively loaded # options(java.parameters = "-verbose:class") diff --git a/README.Rmd b/README.Rmd index e31102d..e273632 100644 --- a/README.Rmd +++ b/README.Rmd @@ -43,7 +43,6 @@ To get the current development version from GitHub: ```{r, eval = FALSE} # install.packages("remotes") -======= # Install development version from GitHub remotes::install_github("rjdemetra/rjd3toolkit") remotes::install_github("rjdemetra/rjd3filters") @@ -221,3 +220,13 @@ Proietti, Tommaso and Alessandra Luati (Dec. 2008). “Real time estimation in l Wildi, Marc and Tucker McElroy (2019). “The trilemma between accuracy, timeliness and smoothness in real-time signal extraction”. In: *International Journal of Forecasting* 35.3, pp. 1072–1084. URL: [https://EconPapers.repec.org/RePEc:eee:intfor:v:35:y:2019:i:3:p:1072-1084](https://EconPapers.repec.org/RePEc:eee:intfor:v:35:y:2019:i:3:p:1072-1084). + +## Package Maintenance and contributing + +Any contribution is welcome and should be done through pull requests and/or issues. +pull requests should include **updated tests** and **updated documentation**. If functionality is changed, docstrings should be added or updated. + + +## Licensing + +The code of this project is licensed under the [European Union Public Licence (EUPL)](https://joinup.ec.europa.eu/page/eupl-text-11-12). diff --git a/README.md b/README.md index afdf680..4112d99 100644 --- a/README.md +++ b/README.md @@ -37,7 +37,6 @@ To get the current development version from GitHub: ``` r # install.packages("remotes") -======= # Install development version from GitHub remotes::install_github("rjdemetra/rjd3toolkit") remotes::install_github("rjdemetra/rjd3filters") @@ -332,3 +331,15 @@ Wildi, Marc and Tucker McElroy (2019). “The trilemma between accuracy, timeliness and smoothness in real-time signal extraction”. In: *International Journal of Forecasting* 35.3, pp. 1072–1084. URL: [https://EconPapers.repec.org/RePEc:eee:intfor:v:35:y:2019:i:3:p:1072-1084](https://EconPapers.repec.org/RePEc:eee:intfor:v:35:y:2019:i:3:p:1072-1084). + +## Package Maintenance and contributing + +Any contribution is welcome and should be done through pull requests +and/or issues. pull requests should include **updated tests** and +**updated documentation**. If functionality is changed, docstrings +should be added or updated. + +## Licensing + +The code of this project is licensed under the [European Union Public +Licence (EUPL)](https://joinup.ec.europa.eu/page/eupl-text-11-12). diff --git a/_pkgdown.yml b/_pkgdown.yml new file mode 100644 index 0000000..e3f2193 --- /dev/null +++ b/_pkgdown.yml @@ -0,0 +1,39 @@ +url: https://rjdemetra.github.io/rjd3filters/ +template: + bootstrap: 5 + +reference: +- title: Create Specific Moving Averages + contents: + - '`dfa_filter`' + - '`fst_filter`' + - '`localpolynomials`' + - '`lp_filter`' + - '`simple_ma`' + - '`rkhs_filter`' + - '`rkhs_kernel`' + - '`rkhs_optimal_bw`' + - '`rkhs_optimization_fun`' + - '`get_kernel`' +- title: Stastics on Moving Averages and estimates + contents: + - '`cross_validation`' + - '`diagnostic_matrix`' + - '`fst`' + - '`implicit_forecast`' + - '`get_properties_function`' + - '`mse`' + - '`var_estimator`' + +- title: Manipulation of Moving Averages and Finite Filters + contents: + - '`filter`' + - '`filters_operations`' + - '`finite_filters`' + - '`get_moving_average`' + - '`impute_last_obs`' + - '`moving_average`' + - '`plot_filters`' +- title: Data + contents: + - '`retailsa`' \ No newline at end of file diff --git a/inst/java/jdplus-filters-base-api-2.0.0.jar b/inst/java/jdplus-filters-base-api-2.0.0.jar deleted file mode 100644 index 87d0de7..0000000 Binary files a/inst/java/jdplus-filters-base-api-2.0.0.jar and /dev/null differ diff --git a/inst/java/jdplus-filters-base-api-2.1.0.jar b/inst/java/jdplus-filters-base-api-2.1.0.jar new file mode 100644 index 0000000..977f57b Binary files /dev/null and b/inst/java/jdplus-filters-base-api-2.1.0.jar differ diff --git a/inst/java/jdplus-filters-base-core-2.0.0.jar b/inst/java/jdplus-filters-base-core-2.0.0.jar deleted file mode 100644 index 2ff6c7b..0000000 Binary files a/inst/java/jdplus-filters-base-core-2.0.0.jar and /dev/null differ diff --git a/inst/java/jdplus-filters-base-core-2.1.0.jar b/inst/java/jdplus-filters-base-core-2.1.0.jar new file mode 100644 index 0000000..0d738ec Binary files /dev/null and b/inst/java/jdplus-filters-base-core-2.1.0.jar differ diff --git a/inst/java/jdplus-filters-base-r-2.0.0.jar b/inst/java/jdplus-filters-base-r-2.0.0.jar deleted file mode 100644 index 41ec903..0000000 Binary files a/inst/java/jdplus-filters-base-r-2.0.0.jar and /dev/null differ diff --git a/inst/java/jdplus-filters-base-r-2.1.0.jar b/inst/java/jdplus-filters-base-r-2.1.0.jar new file mode 100644 index 0000000..29b37c6 Binary files /dev/null and b/inst/java/jdplus-filters-base-r-2.1.0.jar differ diff --git a/man/dfa_filter.Rd b/man/dfa_filter.Rd index 0a059e8..6f68e82 100644 --- a/man/dfa_filter.Rd +++ b/man/dfa_filter.Rd @@ -33,6 +33,14 @@ the four weights are equal to 1.} \description{ Direct Filter Approach } +\details{ +Moving average computed by a minimisation of a weighted mean of three criteria under polynomials constraints. +The criteria come from the decomposition of the mean squared error between th trend-cycle + +Let \eqn{\boldsymbol \theta=(\theta_{-p},\dots,\theta_{f})'} be a moving average where +\eqn{p} and \eqn{f} are two integers defined by the parameter \code{lags} and \code{leads}. +The three criteria are: +} \examples{ dfa_filter(horizon = 6, degree = 0) dfa_filter(horizon = 6, degree = 2) diff --git a/man/fst.Rd b/man/fst.Rd index a3f53d6..fbae23e 100644 --- a/man/fst.Rd +++ b/man/fst.Rd @@ -4,7 +4,7 @@ \alias{fst} \title{FST criteria} \usage{ -fst(weights, lags, passband = pi/6) +fst(weights, lags, passband = pi/6, ...) } \arguments{ \item{weights}{either a \code{"moving_average"} or a numeric vector containing weights.} @@ -12,6 +12,8 @@ fst(weights, lags, passband = pi/6) \item{lags}{Lags of the moving average (when \code{weights} is not a \code{"moving_average"}).} \item{passband}{Passband threshold for timeliness criterion.} + +\item{...}{other unused arguments.} } \value{ The values of the 3 criteria, the gain and phase of the associated filter. @@ -22,7 +24,10 @@ Compute the Fidelity, Smoothness and Timeliness (FST) criteria \examples{ filter <- lp_filter(horizon = 6, kernel = "Henderson", endpoints = "LC") fst(filter[, "q=0"]) +# To compute the statistics on all filters: +fst(filter) } \references{ -Grun-Rehomme, Michel, Fabien Guggemos, and Dominique Ladiray (2018). “Asymmetric Moving Averages Minimizing Phase Shift”. In: Handbook on Seasonal Adjustment. +Grun-Rehomme, Michel, Fabien Guggemos, and Dominique Ladiray (2018). “Asymmetric Moving Averages Minimizing Phase Shift”. In: Handbook on Seasonal Adjustment, +\url{https://ec.europa.eu/eurostat/web/products-manuals-and-guidelines/-/ks-gq-18-001}. } diff --git a/man/fst_filter.Rd b/man/fst_filter.Rd index d7deab7..25d70f5 100644 --- a/man/fst_filter.Rd +++ b/man/fst_filter.Rd @@ -32,22 +32,64 @@ fst_filter( \item{timeliness.antiphase}{boolean indicating if the timeliness should be computed analytically (\code{TRUE}) or numerically (\code{FALSE}).} } -\value{ -An object of class \code{"fst_filter"}, which is a list of 5 elements:\itemize{ -\item{\code{"internal"}}{Java object used for internal functions} -\item{\code{"filters.coef"}}{The coefficients of the selected filter} -\item{\code{"filters.gain"}}{The gain function between 0 and pi (601 observations)} -\item{\code{"filters.phase"}}{The phase function between 0 and pi (601 observations)} -\item{\code{"criteria"}}{The value of the tree criteria} -} -} \description{ Estimation of a filter using the Fidelity-Smoothness-Timeliness criteria } +\details{ +Moving average computed by a minimisation of a weighted mean of three criteria under polynomials constraints. +Let \eqn{\boldsymbol \theta=(\theta_{-p},\dots,\theta_{f})'} be a moving average where +\eqn{p} and \eqn{f} are two integers defined by the parameter \code{lags} and \code{leads}. +The three criteria are: +\itemize{ +\item \emph{Fidelity}, \eqn{F_g}: it's the variance reduction ratio. +\deqn{ +F_g(\boldsymbol \theta) = \sum_{k=-p}^{+f}\theta_{k}^{2} +} +\item \emph{Smoothness}, \eqn{S_g}: it measures the flexibility of the coefficient curve of a filter and the smoothness of the trend. +\deqn{ +S_g(\boldsymbol \theta) = \sum_{j}(\nabla^{q}\theta_{j})^{2} +} +The integer \eqn{q} is defined by parameter \code{smoothness.degree}. +By default, the Henderson criteria is used (\code{smoothness.degree = 3}). +\item \emph{Timeliness}, \eqn{T_g} : +\deqn{ +T_g(\boldsymbol\theta)=\int_{0}^{\omega_{2}}f(\rho_{\boldsymbol\theta}(\omega),\varphi_{\boldsymbol\theta}(\omega))d\omega +} +with \eqn{\rho_{\boldsymbol\theta}} and \eqn{\varphi_{\boldsymbol\theta}} the gain and phase shift functions +of \eqn{\boldsymbol \theta}, and \eqn{f} a penalty function defined as \eqn{f\colon(\rho,\varphi)\mapsto\rho^2\sin(\varphi)^2} +to have an analytically solvable criterium. +\eqn{\omega_{2}} is defined by the parameter \code{timeliness.passband} and is it +by default equal to \eqn{2\pi/12}: for monthly time series, we focus on the timeliness associated to +cycles of 12 months or more. +} + +The moving average is then computed solving the problem: +\deqn{ +\begin{cases} +\underset{\theta}{\min} & J(\theta)= + (1-\beta-\gamma) F_g(\theta)+\beta S_g(\theta)+\gamma T_g(\theta)\\ +s.t. & C\theta=a +\end{cases} +} +Where \eqn{C\theta=a} represents linear constraints to have a moving average +that preserve polynomials of degree \eqn{q} (\code{pdegree}): +\deqn{ +C=\begin{pmatrix} +1 & \cdots&1\\ +-h & \cdots&h \\ +\vdots & \cdots & \vdots \\ +(-h)^d & \cdots&h^d +\end{pmatrix},\quad +a=\begin{pmatrix} +1 \\0 \\ \vdots\\0 +\end{pmatrix} +} +} \examples{ filter <- fst_filter(lags = 6, leads = 0) filter } \references{ -Grun-Rehomme, Michel, Fabien Guggemos, and Dominique Ladiray (2018). “Asymmetric Moving Averages Minimizing Phase Shift”. In: Handbook on Seasonal Adjustment. +Grun-Rehomme, Michel, Fabien Guggemos, and Dominique Ladiray (2018). “Asymmetric Moving Averages Minimizing Phase Shift”. In: Handbook on Seasonal Adjustment, +\url{https://ec.europa.eu/eurostat/web/products-manuals-and-guidelines/-/ks-gq-18-001}. } diff --git a/man/get_kernel.Rd b/man/get_kernel.Rd index 5abdefb..180f411 100644 --- a/man/get_kernel.Rd +++ b/man/get_kernel.Rd @@ -6,7 +6,7 @@ \usage{ get_kernel( kernel = c("Henderson", "Uniform", "Triangular", "Epanechnikov", "Parabolic", - "Biweight", "Triweight", "Tricube", "Trapezoidal", "Gaussian"), + "BiWeight", "TriWeight", "Tricube", "Trapezoidal", "Gaussian"), horizon, sd_gauss = 0.25 ) diff --git a/man/get_moving_average.Rd b/man/get_moving_average.Rd index c2e90aa..a04cfd0 100644 --- a/man/get_moving_average.Rd +++ b/man/get_moving_average.Rd @@ -14,3 +14,8 @@ get_moving_average(x, ...) \description{ Get Moving Averages from ARIMA model } +\examples{ +fit <- stats::arima(log10(AirPassengers), c(0, 1, 1), +seasonal = list(order = c(0, 1, 1), period = 12)) +get_moving_average(fit) +} diff --git a/man/get_properties_function.Rd b/man/get_properties_function.Rd index 73505bb..21c0df5 100644 --- a/man/get_properties_function.Rd +++ b/man/get_properties_function.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/get_properties_function.R \name{get_properties_function} \alias{get_properties_function} -\title{Get properties of local polynomials filters} +\title{Get properties of filters} \usage{ get_properties_function( x, @@ -12,14 +12,14 @@ get_properties_function( ) } \arguments{ -\item{x}{a \code{"lp_filter"} object.} +\item{x}{a \code{"moving_average"} or \code{"finite_filters"} object.} \item{component}{the component to extract.} \item{...}{unused other arguments.} } \description{ -Get properties of local polynomials filters +Get properties of filters } \examples{ filter <- lp_filter(3, kernel = "Henderson") diff --git a/man/implicit_forecast.Rd b/man/implicit_forecast.Rd index 1863b61..20c4d5b 100644 --- a/man/implicit_forecast.Rd +++ b/man/implicit_forecast.Rd @@ -22,7 +22,7 @@ Let \eqn{h} be the bandwidth of the symmetric filter, the trend when \eqn{q} future values are known (with the convention \eqn{w_{q+1}^q=\ldots=w_h^q=0}). Let denote \eqn{y_{-h},\ldots, y_0} the las \eqn{h} available values of the input times series. Let also note \eqn{y_{-h},\ldots,y_{0}} the observed series studied and \eqn{y_{1}^*,\dots y_h^*}the implicit forecast induced by \eqn{w^0,\dots w^{h-1}}. -This means that e: +This means that: \deqn{ \forall q, \quad \sum_{i=-h}^0 v_iy_i + \sum_{i=1}^h v_iy_i^* =\sum_{i=-h}^0 w_i^qy_i + \sum_{i=1}^h w_i^qy_i^* diff --git a/man/moving_average.Rd b/man/moving_average.Rd index 90d4851..4fa9735 100644 --- a/man/moving_average.Rd +++ b/man/moving_average.Rd @@ -39,7 +39,7 @@ to_seasonal(x, s) \S4method{show}{moving_average}(object) } \arguments{ -\item{x}{vector of coefficients} +\item{x}{vector of coefficients.} \item{lags}{integer indicating the number of lags of the moving average.} @@ -52,6 +52,19 @@ to_seasonal(x, s) \description{ Manipulation of moving averages } +\details{ +A moving average is defined by a set of coefficient \eqn{\boldsymbol \theta=(\theta_{-p},\dots,\theta_{f})'} +such all time series \eqn{X_t} are transformed as: +\deqn{ +M_{\boldsymbol\theta}(X_t)=\sum_{k=-p}^{+f}\theta_kX_{t+k}=\left(\sum_{k=-p}^{+f}\theta_kB^{-k}\right)X_{t} +} +The integer \eqn{p} is defined by the parameter \code{lags}. + +The function \code{to_seasonal()} transforms the moving average \eqn{\boldsymbol \theta} to: +\deqn{ +M_{\boldsymbol\theta'}(X_t)=\sum_{k=-p}^{+f}\theta_kX_{t+ks}=\left(\sum_{k=-p}^{+f}\theta_kB^{-ks}\right)X_{t} +} +} \examples{ y <- retailsa$AllOtherGenMerchandiseStores e1 <- moving_average(rep(1,12), lags = -6) diff --git a/man/mse.Rd b/man/mse.Rd index cd8bbba..d97aaee 100644 --- a/man/mse.Rd +++ b/man/mse.Rd @@ -4,16 +4,18 @@ \alias{mse} \title{Accuracy/smoothness/timeliness criteria through spectral decomposition} \usage{ -mse(sweights, aweights, density = c("uniform", "rw"), passband = pi/6) +mse(aweights, sweights, density = c("uniform", "rw"), passband = pi/6, ...) } \arguments{ -\item{sweights}{\code{moving_average} object or weights of the symmetric filter (from 0 to n or -n to n).} - \item{aweights}{\code{moving_average} object or weights of the asymmetric filter (from -n to m).} +\item{sweights}{\code{moving_average} object or weights of the symmetric filter (from 0 to n or -n to n).} + \item{density}{hypothesis on the spectral density: \code{"uniform"} (= white woise, the default) or \code{"rw"} (= random walk).} \item{passband}{passband threshold.} + +\item{...}{other unused arguments.} } \value{ The criteria @@ -23,9 +25,11 @@ Accuracy/smoothness/timeliness criteria through spectral decomposition } \examples{ filter <- lp_filter(horizon = 6, kernel = "Henderson", endpoints = "LC") -sweights <- filter[,"q=6"] -aweights <- filter[,"q=0"] -mse(sweights, aweights) +sweights <- filter[, "q=6"] +aweights <- filter[, "q=0"] +mse(aweights, sweights) +# Or to compute directly the criteria on all asymmetric filters: +mse(filter) } \references{ Wildi, Marc and McElroy, Tucker (2019). “The trilemma between accuracy, timeliness and smoothness in real-time signal extraction”. In: International Journal of Forecasting 35.3, pp. 1072–1084. diff --git a/rjd3filters.Rproj b/rjd3filters.Rproj index 2356e60..49a8d8d 100644 --- a/rjd3filters.Rproj +++ b/rjd3filters.Rproj @@ -1,12 +1,12 @@ Version: 1.0 -RestoreWorkspace: Default -SaveWorkspace: Default -AlwaysSaveHistory: Default +RestoreWorkspace: No +SaveWorkspace: No +AlwaysSaveHistory: No EnableCodeIndexing: Yes UseSpacesForTab: Yes -NumSpacesForTab: 2 +NumSpacesForTab: 4 Encoding: UTF-8 RnwWeave: knitr @@ -19,5 +19,7 @@ BuildType: Package PackageUseDevtools: Yes PackageInstallArgs: --no-multiarch --with-keep.source PackageBuildBinaryArgs: --no-multiarch -PackageCheckArgs: --as-cran --no-multiarch -PackageRoxygenize: rd,collate,namespace +PackageCheckArgs: --no-multiarch --as-cran +PackageRoxygenize: rd,collate,namespace,vignette + +UseNativePipeOperator: Yes