├── .Rbuildignore ├── .gitattributes ├── .github ├── .gitignore ├── CONTRIBUTING.md └── workflows │ ├── R-CMD-check.yaml │ ├── pkgdown.yaml │ └── test-coverage.yaml ├── .gitignore ├── .lintr ├── BirdFlowR.Rproj ├── DESCRIPTION ├── Dockerfile ├── LICENSE ├── LICENSE.md ├── NAMESPACE ├── NEWS.md ├── R ├── Routes-internal.R ├── Routes.R ├── add_dynamic_mask.R ├── animate_distr.R ├── animate_flux.R ├── animate_movement_vectors.R ├── animate_routes.R ├── as_BirdFlowIntervals.R ├── as_BirdFlowRoutes.R ├── as_distr.R ├── as_transitions.R ├── bf_msg.R ├── birdflow_options.R ├── build_transitions.R ├── cache_path.R ├── calc_abundance_stats.R ├── calc_distance_weights.R ├── calc_flux.R ├── calc_interval_metrics.R ├── calc_martern_variance.R ├── calc_movement_vectors.R ├── calc_year_offset.R ├── calculate_distance_matrix.R ├── calculate_interval_sampling_strategy.R ├── clean_hdf5_dataframe.R ├── combine_transitions.R ├── compareGeom.R ├── compare_list_item_names.R ├── determine_resolution.R ├── dimensions.R ├── distribution_performance.R ├── dmi_to_i.R ├── ebirdst_compatibility.R ├── evaluate_performance.R ├── expand_distr.R ├── export_birdflow.R ├── export_rasters.R ├── extend_birdflow.R ├── find_dead_ends.R ├── find_threshold.R ├── fix_dead_ends.R ├── flatten_raster.R ├── format_pyear.R ├── get_dates.R ├── get_distr.R ├── get_dynamic_mask.R ├── get_marginal.R ├── get_mask.R ├── get_metadata.R ├── get_naturalearth.R ├── get_timestep_padding.R ├── get_transition.R ├── has.R ├── ignore_unused_imports.R ├── import_birdflow.R ├── import_birdflow_v3.R ├── index_conversions.R ├── interval_log_likelihood.R ├── is_between.R ├── is_location_valid.R ├── load_collection_index.R ├── load_model.R ├── lookup_date.R ├── lookup_species_metadata.R ├── lookup_timestep.R ├── lookup_timestep_sequence.R ├── lookup_transitions.R ├── make_cache_readme.R ├── make_dates.R ├── make_marginal_index.R ├── make_mask.R ├── make_pyear_breaks.R ├── marginal_stats.R ├── n_parameters.R ├── new_birdflow.R ├── pad_timestep.R ├── plot_distr.R ├── plot_flux.R ├── plot_loss.R ├── plot_movement_vectors.R ├── plot_routes.R ├── predict.R ├── preprocess_species.R ├── print.BirdFlowIntervals.R ├── print.R ├── print.Routes.R ├── process_rasters.R ├── proportion_of_year.R ├── range_rescale.R ├── rasterize_distr.R ├── read_geom.R ├── reformat_distr_labels.R ├── reformat_timestep.R ├── route.R ├── route_migration.R ├── sample_distr.R ├── sf_methods.R ├── shorten_distance_matrix.R ├── shrink_birdflow.R ├── skip_if_no_big_models.R ├── snap_to_birdflow.R ├── sparsify.R ├── species_info.R ├── suppress_specific_warnings.R ├── sysdata.rda ├── truncate_birdflow.R ├── ts_info.R ├── validate_BirdFlow.R ├── validate_RouteDataClass.R └── weight_between.R ├── README.Rmd ├── README.md ├── _pkgdown.yml ├── codecov.yml ├── data-raw ├── ebirdst_weeks.R ├── ebirdst_weeks.rds ├── martern_parameters.R └── pnas.2023170118.sd01.csv ├── inst ├── WORDLIST ├── markdown_templates │ ├── collection_index.Rmd │ └── index_example.Rds └── readme_templates │ ├── collection_cache_readme.txt │ └── main_cache_readme.txt ├── man ├── Routes-internal.Rd ├── Routes.Rd ├── add_dynamic_mask.Rd ├── add_stay_id.Rd ├── add_stay_id_with_varied_intervals.Rd ├── animate_distr.Rd ├── animate_flux.Rd ├── animate_movement_vectors.Rd ├── animate_routes.Rd ├── as_BirdFlowIntervals.Rd ├── as_BirdFlowRoutes.Rd ├── as_distr.Rd ├── as_transitions.Rd ├── attribute_validators.Rd ├── bf_msg.Rd ├── bf_suppress_msg.Rd ├── birdflow_options.Rd ├── build_transitions.Rd ├── cache_path.Rd ├── calc_abundance_stats.Rd ├── calc_dist_weights.Rd ├── calc_flux.Rd ├── calc_interval_metrics.Rd ├── calc_movement_vectors.Rd ├── calc_single_interval_metrics.Rd ├── calc_year_offset.Rd ├── calculate_interval_sampling_strategy.Rd ├── combine_transitions.Rd ├── compareGeom-BirdFlow.Rd ├── compare_list_item_names.Rd ├── determine_resolution.Rd ├── dimensions.Rd ├── distribution_performance.Rd ├── dynamic_mask_index_conversions.Rd ├── ebirdst-compatibility.Rd ├── evaluate_performance.Rd ├── expand_distr.Rd ├── export_import_birdflow.Rd ├── export_rasters.Rd ├── extend_birdflow.Rd ├── extend_geom.Rd ├── figures │ ├── BirdFlowR.png │ ├── BirdFlowR_logo.R │ ├── README-examples-1.png │ ├── README-movement_vectors-1.png │ └── logo.png ├── find_threshold.Rd ├── fix_current_dead_ends.Rd ├── fix_dead_ends.Rd ├── flatten_raster.Rd ├── get_dates.Rd ├── get_distr.Rd ├── get_dynamic_mask.Rd ├── get_loss.Rd ├── get_marginal.Rd ├── get_mask.Rd ├── get_metadata.Rd ├── get_naturalearth.Rd ├── get_timestep_padding.Rd ├── get_transition.Rd ├── great_circle_distance_lonlat_input.Rd ├── great_circle_distances.Rd ├── has.Rd ├── import_birdflow_v3.Rd ├── index_conversions.Rd ├── interval_log_likelihood.Rd ├── is_between.Rd ├── is_location_valid.Rd ├── load_collection_index.Rd ├── load_model.Rd ├── lookup_date.Rd ├── lookup_season_timesteps.Rd ├── lookup_species_metadata.Rd ├── lookup_timestep.Rd ├── lookup_timestep_sequence.Rd ├── lookup_transitions.Rd ├── make_cache_readme.Rd ├── make_dates.Rd ├── make_marginal_index.Rd ├── make_mask.Rd ├── make_pyear_breaks.Rd ├── marginal_stats.Rd ├── new_BirdFlow.Rd ├── object_validators.Rd ├── pad_timestep.Rd ├── plot_distr.Rd ├── plot_flux.Rd ├── plot_loss.Rd ├── plot_movement_vectors.Rd ├── plot_routes.Rd ├── predict.BirdFlow.Rd ├── predict_params.Rd ├── preprocess_species.Rd ├── print.BirdFlow.Rd ├── print.BirdFlowIntervals.Rd ├── print.Routes.Rd ├── print_type_breakdown.Rd ├── process_rasters.Rd ├── rasterize.Rd ├── read_geom.Rd ├── reformat_distr_labels.Rd ├── reformat_timestep.Rd ├── reset_index.Rd ├── route.Rd ├── route_migration.Rd ├── sample_distr.Rd ├── shorten_distance_matrix.Rd ├── shrink_birdflow.Rd ├── shrink_geom.Rd ├── snap_to_birdflow.Rd ├── sort_by_id_and_dates.Rd ├── sparsify.Rd ├── species_info.Rd ├── suppress_specific_warnings.Rd ├── target_columns.Rd ├── transition_from_marginal.Rd ├── truncate_birdflow.Rd ├── ts_info.Rd ├── validate_BirdFlow.Rd ├── validate_geom.Rd └── weight_between.Rd ├── tests ├── testthat.R └── testthat │ ├── _snaps │ ├── as_BirdFlowRoutes.md │ ├── birdflow_options.md │ ├── calc_flux.md │ ├── calc_movement_vectors.md │ ├── distribution_performance.md │ ├── evaluate_performance.md │ ├── export_rasters.md │ ├── get_distr.md │ ├── get_naturalearth.md │ ├── get_transition.md │ ├── interval_log_likelihood.md │ ├── is_between.md │ ├── lookup_date.md │ ├── lookup_species_metadata.md │ ├── preprocess_species.md │ ├── rasterize_distr.md │ ├── route.md │ └── sparsify.md │ ├── helper-buffer_extent.R │ ├── helper-change_date_format.R │ ├── helper-fake_routes.R │ ├── helper-get_americas.R │ ├── helper-local_quiet.R │ ├── helper-local_test_dir.R │ ├── helper-make_fake_move_data.R │ ├── helper-skip_if_unsupported_ebirdst_version.R │ ├── helper-skip_if_wrong_ebirdst_for_snapshot.R │ ├── test-Routes-internal.R │ ├── test-add_dynamic_mask.R │ ├── test-animate_distr.R │ ├── test-animate_movement_vectors.R │ ├── test-animate_routes.R │ ├── test-as_BirdFlowIntervals.R │ ├── test-as_BirdFlowRoutes.R │ ├── test-as_distr.R │ ├── test-birdflow_options.R │ ├── test-build_transitions.R │ ├── test-cache_path.R │ ├── test-calc_flux.R │ ├── test-calc_interval_metrics.R │ ├── test-calc_movement_vectors.R │ ├── test-calc_year_offset.R │ ├── test-combine_transitions.R │ ├── test-compareGeom.R │ ├── test-distribution_performance.R │ ├── test-dmi_to_i.R │ ├── test-evaluate_performance.R │ ├── test-export_rasters.R │ ├── test-extend_birdflow.R │ ├── test-find_threshold.R │ ├── test-flatten_raster.R │ ├── test-get_dates.R │ ├── test-get_distr.R │ ├── test-get_marginal.R │ ├── test-get_mask.R │ ├── test-get_metadata.R │ ├── test-get_naturalearth.R │ ├── test-get_timestep_padding.R │ ├── test-get_transition.R │ ├── test-import_birdflow.R │ ├── test-index_conversions.R │ ├── test-interval_log_likelihood.R │ ├── test-is_between.R │ ├── test-is_location_valid.R │ ├── test-load_collection_index.R │ ├── test-load_model.R │ ├── test-lookup_date.R │ ├── test-lookup_species_metadata.R │ ├── test-lookup_timestep.R │ ├── test-lookup_timestep_sequence.R │ ├── test-lookup_transitions.R │ ├── test-marginal_stats.R │ ├── test-n_parameters.R │ ├── test-plot_distr.R │ ├── test-plot_loss.R │ ├── test-plot_movement_vectors.R │ ├── test-plot_routes.R │ ├── test-predict.R │ ├── test-preprocess_species.R │ ├── test-print.R │ ├── test-rasterize_distr.R │ ├── test-route.R │ ├── test-route_migration.R │ ├── test-sample_distr.R │ ├── test-shorten_distance_matrix.R │ ├── test-shrink_birdflow.R │ ├── test-snap_to_birdflow.R │ ├── test-sparsify.R │ ├── test-truncate_birdflow.R │ ├── test-ts_info.R │ ├── test-validate_BirdFlow.R │ ├── test-validate_RouteDataClass.R │ └── test-weight_between.R └── vignettes ├── .gitignore ├── BirdFlowOverview.Rmd ├── BirdFlowR.Rmd ├── Installation.Rmd ├── Polygons.Rmd └── Preprocess.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^BirdFlowR\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^LICENSE\.md$ 4 | ^\.github$ 5 | ^codecov\.yml$ 6 | ^doc$ 7 | ^Meta$ 8 | ^Dockerfile$ 9 | ^_pkgdown\.yml$ 10 | ^docs$ 11 | ^pkgdown$ 12 | ^README\.Rmd$ 13 | ^man/figures/BirdFlowR.png 14 | ^man/figures/BirdFlowR_transparent.png 15 | ^man/figures/BirdFlowR_logo.R 16 | ^\.lintr 17 | ^data-raw$ 18 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # Basic .gitattributes for a R repo. 2 | # From: https://github.com/alexkaratarakis/gitattributes/blob/master/R.gitattributes 3 | # Modified slightly 4 | 5 | # Source files 6 | # ============ 7 | *.Rdata binary 8 | *.RData binary 9 | *.rda binary 10 | *.rdb binary 11 | *.rds binary 12 | *.Rd text 13 | *.Rdx binary 14 | *.Rmd text 15 | *.md text 16 | *.R text 17 | *.Rproj text 18 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/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@v3 33 | 34 | - uses: r-lib/actions/setup-pandoc@v2 35 | 36 | - uses: r-lib/actions/setup-r@v2 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@v2 43 | with: 44 | extra-packages: any::rcmdcheck 45 | needs: check 46 | 47 | - uses: r-lib/actions/check-r-package@v2 48 | with: 49 | upload-snapshots: true 50 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/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 | release: 9 | types: [published] 10 | workflow_dispatch: 11 | 12 | name: pkgdown 13 | 14 | jobs: 15 | pkgdown: 16 | runs-on: ubuntu-latest 17 | # Only restrict concurrency for non-PR jobs 18 | concurrency: 19 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 20 | env: 21 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 22 | steps: 23 | - uses: actions/checkout@v3 24 | 25 | - uses: r-lib/actions/setup-pandoc@v2 26 | 27 | - uses: r-lib/actions/setup-r@v2 28 | with: 29 | use-public-rspm: true 30 | 31 | - uses: r-lib/actions/setup-r-dependencies@v2 32 | with: 33 | extra-packages: any::pkgdown, local::. 34 | needs: website 35 | 36 | - name: Build site 37 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 38 | shell: Rscript {0} 39 | 40 | - name: Deploy to GitHub pages 🚀 41 | if: github.event_name != 'pull_request' 42 | uses: JamesIves/github-pages-deploy-action@v4.4.1 43 | with: 44 | clean: false 45 | branch: gh-pages 46 | folder: docs 47 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/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: test-coverage 10 | 11 | permissions: read-all 12 | 13 | jobs: 14 | test-coverage: 15 | runs-on: ubuntu-latest 16 | env: 17 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 18 | 19 | steps: 20 | - uses: actions/checkout@v4 21 | 22 | - uses: r-lib/actions/setup-r@v2 23 | with: 24 | use-public-rspm: true 25 | 26 | - uses: r-lib/actions/setup-r-dependencies@v2 27 | with: 28 | extra-packages: any::covr, any::xml2 29 | needs: coverage 30 | 31 | - name: Test coverage 32 | run: | 33 | cov <- covr::package_coverage( 34 | quiet = FALSE, 35 | clean = FALSE, 36 | install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") 37 | ) 38 | covr::to_cobertura(cov) 39 | shell: Rscript {0} 40 | 41 | - uses: codecov/codecov-action@v4 42 | with: 43 | fail_ci_if_error: ${{ github.event_name != 'pull_request' && true || false }} 44 | file: ./cobertura.xml 45 | plugin: noop 46 | disable_search: true 47 | token: ${{ secrets.CODECOV_TOKEN }} 48 | 49 | - name: Show testthat output 50 | if: always() 51 | run: | 52 | ## -------------------------------------------------------------------- 53 | find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true 54 | shell: bash 55 | 56 | - name: Upload test results 57 | if: failure() 58 | uses: actions/upload-artifact@v4 59 | with: 60 | name: coverage-test-failures 61 | path: ${{ runner.temp }}/package 62 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | 8 | # User-specific files 9 | .Ruserdata 10 | 11 | # Example code in package build process 12 | *-Ex.R 13 | 14 | # Output files from R CMD build 15 | /*.tar.gz 16 | 17 | # Output files from R CMD check 18 | /*.Rcheck/ 19 | 20 | # RStudio files 21 | .Rproj.user/ 22 | 23 | # produced vignettes 24 | vignettes/*.html 25 | vignettes/*.pdf 26 | 27 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 28 | .httr-oauth 29 | 30 | # knitr and R markdown default cache directories 31 | *_cache/ 32 | /cache/ 33 | 34 | # Temporary files created by R markdown 35 | *.utf8.md 36 | *.knit.md 37 | 38 | # R Environment Variables 39 | .Renviron 40 | .Rproj.user 41 | inst/doc 42 | /doc/ 43 | /Meta/ 44 | docs 45 | 46 | # Annoying Rplot.pdf file that gets created while testing 47 | /tests/testthat/Rplots.pdf 48 | 49 | # Rendered html from rmarkdown template 50 | inst/markdown_templates/collection_index.html 51 | -------------------------------------------------------------------------------- /.lintr: -------------------------------------------------------------------------------- 1 | linters: linters_with_defaults( 2 | cyclocomp_linter = NULL, 3 | indentation_linter = NULL, 4 | return_linter = NULL) 5 | encoding: "UTF-8" 6 | exclusions: list( # dropping rendered version of vignettes, .Rmd still ckecked 7 | "vignettes/BirdFlowR.R", 8 | "vignettes/Preprocess.R", 9 | "vignettes/Installation.R" 10 | ) 11 | -------------------------------------------------------------------------------- /BirdFlowR.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | ProjectId: 56cbdbaa-a452-4934-820a-6459aa572fdb 3 | 4 | RestoreWorkspace: No 5 | SaveWorkspace: No 6 | AlwaysSaveHistory: Default 7 | 8 | EnableCodeIndexing: Yes 9 | UseSpacesForTab: Yes 10 | NumSpacesForTab: 2 11 | Encoding: UTF-8 12 | 13 | RnwWeave: Sweave 14 | LaTeX: pdfLaTeX 15 | 16 | AutoAppendNewline: Yes 17 | StripTrailingWhitespace: Yes 18 | LineEndingConversion: Posix 19 | 20 | BuildType: Package 21 | PackageUseDevtools: Yes 22 | PackageInstallArgs: --no-multiarch --with-keep.source 23 | PackageRoxygenize: rd,collate,namespace,vignette 24 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: BirdFlowR 2 | Title: Predict and Visualize Bird Movement 3 | Version: 0.1.0.9075 4 | Authors@R: 5 | c(person("Ethan", "Plunkett", email = "plunkett@umass.edu", role = c("aut", "cre"), 6 | comment = c(ORCID = "0000-0003-4405-2251")), 7 | person("BirdFlow-Science", role = "cph"), 8 | person("National Science Foundation", role = "fnd")) 9 | Description: BirdFlowR predicts bird movement and distribution from previously fitted models. 10 | License: MIT + file LICENSE 11 | Encoding: UTF-8 12 | Roxygen: list(markdown = TRUE) 13 | RoxygenNote: 7.3.2 14 | Suggests: 15 | BirdFlowModels (>= 0.0.2.9003), 16 | covr, 17 | ebirdst, 18 | knitr, 19 | ragg, 20 | rmarkdown, 21 | SparseArray, 22 | testthat (>= 3.0.0), 23 | withr 24 | Config/testthat/edition: 3 25 | biocViews: 26 | Imports: 27 | gganimate, 28 | digest, 29 | dplyr, 30 | ggplot2, 31 | ggthemes, 32 | gifski, 33 | grDevices, 34 | lubridate, 35 | Matrix (>= 1.5-2), 36 | methods, 37 | progress, 38 | rhdf5, 39 | rlang, 40 | rnaturalearth, 41 | rnaturalearthdata, 42 | scales, 43 | s2, 44 | sf, 45 | stringr, 46 | tidyr, 47 | terra, 48 | units, 49 | utils, 50 | viridisLite 51 | VignetteBuilder: knitr 52 | Remotes: 53 | birdflow-science/BirdFlowModels 54 | URL: https://birdflow-science.github.io/BirdFlowR/, https://github.com/birdflow-science/BirdFlowR 55 | BugReports: https://github.com/birdflow-science/BirdFlowR/issues 56 | Language: en-US 57 | Depends: 58 | R (>= 4.1.0) 59 | LazyData: true 60 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | FROM --platform=linux/amd64 rocker/geospatial:4.3.2 2 | RUN install2.r --error --skipinstalled --ncpus -1 \ 3 | rnaturalearth \ 4 | rnaturalearthdata \ 5 | ebirdst \ 6 | && rm -rf /tmp/downloaded_packages \ 7 | && strip /usr/local/lib/R/site-library/*/libs/*.so \ 8 | && R -q -e 'remotes::install_github("birdflow-science/BirdFlowModels")' \ 9 | && R -q -e 'remotes::install_github("birdflow-science/BirdFlowR", build_vignettes = TRUE, upgrade = "never")' 10 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2022 birdflow-science 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2022 BirdFlowR authors 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /R/animate_flux.R: -------------------------------------------------------------------------------- 1 | #' Animate flux 2 | #' 3 | #' Animate net migration from [calc_flux()]. 4 | #' 5 | #' @inheritParams plot_flux 6 | #' @inheritDotParams plot_flux 7 | #' 8 | #' @return A [`gganim`][gganimate::gganimate-package] object 9 | #' @export 10 | #' @inherit calc_flux examples 11 | #' @seealso [calc_flux()],[plot_flux()] 12 | animate_flux <- function(flux, bf, title = species(bf), ...) { 13 | p <- plot_flux(flux, bf, ...) 14 | 15 | anim <- p + 16 | ggplot2::facet_null() + 17 | gganimate::transition_manual(frames = .data$label) + 18 | ggplot2::labs(title = title, 19 | subtitle = "{current_frame}") 20 | 21 | return(anim) 22 | } 23 | -------------------------------------------------------------------------------- /R/as_transitions.R: -------------------------------------------------------------------------------- 1 | #' Convert a sequence of timesteps into a sequence of transition names 2 | #' 3 | #' @param timesteps A valid sequence of timesteps. See 4 | #' `lookup_timestep_sequence()`. 5 | #' @param bf A BirdFlowR model, used to determine how much padding 6 | #' is needed around the timesteps. 7 | #' @return A directional sequence of transitions that connect `timesteps`. 8 | #' @export 9 | as_transitions <- function(timesteps, bf) { 10 | return(paste0("T_", pad_timestep(timesteps[-length(timesteps)], bf), 11 | "-", 12 | pad_timestep(timesteps[-1], bf))) 13 | } 14 | -------------------------------------------------------------------------------- /R/bf_msg.R: -------------------------------------------------------------------------------- 1 | #' Internal function to send a message from within BirdFlow functions 2 | #' 3 | #' It checks to see if BirdFlowR is in verbose mode 4 | #' (`birdflow_options("verbose"`) and if so pastes it's arguments together 5 | #' and prints the result with `cat()`. 6 | #' In the future it might be updated to use `message()` 7 | #' 8 | #' @param ... Text that will be pasted together to make a message. 9 | #' @param sep (optional) separator between text elements in `...` 10 | #' defaults to no separation. 11 | #' 12 | #' @return Nothing is returned if verbose is TRUE the message is printed. 13 | #' 14 | #' @keywords internal 15 | #' @seealso [birdflow_options()] for changing verbosity. 16 | bf_msg <- function(..., sep = "") { 17 | m <- paste(..., sep = sep) 18 | if (birdflow_options("verbose")) { 19 | cat(m) 20 | } 21 | } 22 | 23 | #' Conditionally suppress messages from expressions in BirdFlowR code 24 | #' 25 | #' This internal functions is used to suppress messages thrown 26 | #' by functions called in BirdFlowR code if `birdflow_options("verbose")` 27 | #' is `FALSE`. 28 | #' 29 | #' @param exp R code that might throw a message (originating outside of 30 | #' \pkg{BirdFlowR}. 31 | #' @keywords internal 32 | #' @seealso [preprocess_species()] uses this when calling \pkg{ebirdst} 33 | #' functions that display messages. 34 | #' When BirdFlowR functions generate messages they should use [bf_msg()] so that 35 | #' `birdflow_options("verbose")` is honored. 36 | #' @examples 37 | #' \dontrun{ 38 | #' # bf_suppress_msg isn't exported so can't be run in examples 39 | #' # in internal code or after devtools::load_all() example will work 40 | #' ob <- birdflow_options("verbose") 41 | #' birdflow_options(verbose = FALSE) 42 | #' bf_suppress_msg( message("hi" )) 43 | #' birdflow_options(verbose = TRUE) 44 | #' bf_suppress_msg( message("hi" )) 45 | #' birdflow_options(ob) 46 | #' } 47 | #' 48 | bf_suppress_msg <- function(exp) { 49 | verbose <- birdflow_options("verbose") 50 | withCallingHandlers( 51 | message = function(m) { 52 | if (!verbose) 53 | tryInvokeRestart("muffleMessage") 54 | }, 55 | exp 56 | ) 57 | } 58 | -------------------------------------------------------------------------------- /R/build_transitions.R: -------------------------------------------------------------------------------- 1 | if (FALSE) { 2 | full_bf <- import_birdflow( 3 | "../Models/Visualization/original/batch1/round1/robgro_2021_80km.hdf5") 4 | sparse_bf <- sparsify(full_bf, "state+conditional", p = .99) 5 | bf <- build_transitions(sparse_bf) 6 | } 7 | 8 | #' Add or drop transition matrices 9 | #' 10 | #' Given a BirdFlow object with marginals and without transitions 11 | #' `build_transitions()` return a BirdFlow object with both marginals 12 | #' and transitions, `drop_tansitions()` will reverse the process. 13 | #' 14 | #' @rdname build_transitions 15 | #' @param x BirdFlow object 16 | #' @param rebuild Set to TRUE to rebuild transitions if they are already 17 | #' present. 18 | #' @return BirdFlow object with transition matrices 19 | #' @export 20 | #' @seealso [has_transitions()] 21 | #' @examples 22 | #' \dontrun{ 23 | #' bf1 <- BirdFlowModels::amewoo 24 | #' bf2 <- build_transitions(bf) 25 | #' bf2 26 | #' 27 | #' bf3 <- drop_transitions(bf2) 28 | #' bf3 29 | #' } 30 | build_transitions <- function(x, rebuild = FALSE) { 31 | if (has_transitions(x) && !rebuild) 32 | stop("x already has transitions.") 33 | if (!has_marginals(x)) 34 | stop("marginals are missing and necessary to build transitions.") 35 | mi <- x$marginals$index 36 | tl <- vector(mode = "list", length = nrow(mi)) 37 | names(tl) <- mi$transition 38 | for (i in seq_len(nrow(mi))) { 39 | tl[[i]] <- get_transition(x, mi$transition[i]) 40 | } 41 | x$transitions <- tl 42 | x$metadata$has_transitions <- TRUE 43 | return(x) 44 | } 45 | 46 | #' @rdname build_transitions 47 | #' @aliases drop_transitions 48 | #' @export 49 | drop_transitions <- function(x) { 50 | if (!has_marginals(x)) 51 | stop("Cannot drop transitions from a BirdFlow object that lacks marginals.") 52 | x$transitions <- NA 53 | x$metadata$has_transitions <- FALSE 54 | return(x) 55 | } 56 | -------------------------------------------------------------------------------- /R/cache_path.R: -------------------------------------------------------------------------------- 1 | #' Internal function to get the local path to the cache for the current 2 | #' model collection. 3 | #' 4 | #' Use [birdflow_options("cache")](birdflow_options()) to get the main cache 5 | #' directory (parent of the collection directory) and 6 | #'[birdflow_options("collection_url")](birdflow_options()) for the current model 7 | #' collection url. 8 | #' @inheritParams load_model 9 | #' @return Path to the local cache for the current collection including a 10 | #' trailing delimiter. 11 | #' @keywords internal 12 | #' 13 | cache_path <- function(collection_url = birdflow_options("collection_url")) { 14 | # Return path to cache directory for the current collection 15 | # url with a trailing delimiter 16 | url <- collection_url |> tolower() 17 | url <- gsub("/*$", "/", url) # enforce trailing slash 18 | cache_dir <- birdflow_options("cache") 19 | subdir <- digest::digest(tolower(url), serialize = FALSE) |> substr(1, 6) 20 | return(file.path(cache_dir, subdir, "")) 21 | } 22 | -------------------------------------------------------------------------------- /R/calc_martern_variance.R: -------------------------------------------------------------------------------- 1 | # Define kernel functions 2 | # Original version used "l" instead of "kl" but that led to a 3 | # warning about partial matching of "l" to "len" when invoked via ... 4 | # in calc_dist_weights(). kl makes it unambiguous. 5 | k_m1 <- function(d, gamma, kl) { 6 | gamma * (1 + sqrt(3) * d / kl) 7 | } 8 | 9 | k_m3 <- function(d, gamma = 40, kl = 40) { 10 | gamma * (1 + sqrt(3) * d / kl) * exp(-sqrt(3) * d / kl) 11 | } 12 | 13 | k_m5 <- function(d, gamma = 40, kl = 40) { 14 | gamma * (1 + sqrt(5) * d / kl + 5 * d^2 / (3 * kl^2)) * 15 | exp(-sqrt(5) * d / kl) 16 | } 17 | 18 | k_sq <- function(d, gamma, kl) { 19 | gamma * exp(-0.5 * (d / kl)^2) 20 | } 21 | 22 | # Note the argument k is a kernel function to use, presumably one of the above. 23 | # ... is used to flexibly pass additional parameters (gamma and l through to k) 24 | calc_martern_variance <- function(t, len, k, ...) { 25 | variance <- k(0, ...) - 26 | (k(t, ...)^2 + k(len - t, ...)^2 - 2 * 27 | k(t, ...) * k(len - t, ...) * k(len, ...) / k(0, ...)) / 28 | (k(0, ...) * (1 - k(len, ...)^2 / k(0, ...)^2)) 29 | return(pmax(variance, 0)) 30 | } 31 | -------------------------------------------------------------------------------- /R/calc_year_offset.R: -------------------------------------------------------------------------------- 1 | #' Calculate year offset from a sequence of timesteps 2 | #' 3 | #' This internal function assigns a year offset for each 4 | #' observation based on whether the sequence has passed over a presumed year 5 | #' boundary and started over. The sequence always starts with 0. 6 | #' Forward sequences increment with each new year, while backwards sequences 7 | #' decrements (0, -1, etc.). Elsewhere there are limitations on `route()` that 8 | #' prevent routes longer than 1 full year (back to start), but this function 9 | #' does not have that limit. 10 | #' 11 | #' It is used by `route()` to convert from circular to linear time by 12 | #' making dates monotonic. 13 | #' 14 | #' @param x a sequence of integers representing timesteps. 15 | #' 16 | #' @return sequence of year offsets these will be 0 or 1 for forward sequences 17 | #' and 0 or -1 for backwards. 18 | #' @keywords internal 19 | calc_year_offset <- function(x) { 20 | if (length(x) == 1) # special case 21 | return(1) 22 | 23 | # Determine direction 24 | direction <- NULL 25 | diff <- x[2] - x[1] 26 | if (diff == 1) 27 | direction <- "forward" 28 | if (diff == -1) 29 | direction <- "backward" 30 | if (diff > 1) # diff is large positive if backwards across year boundary 31 | direction <- "backward" 32 | if (diff < -1) 33 | direction <- "forward" # eg -51 at year boundary 34 | if (is.null(direction)) 35 | stop("Direction couldn't be resolved from sequence") 36 | 37 | # Logic is different for backwards so instead of handling both cases 38 | # I'm flipping backwards sequences before and after the calculations 39 | if (direction == "backward") { 40 | x <- base::rev(x) 41 | } 42 | 43 | calculate_year_offset <- function(timesteps) { 44 | c(0, cumsum(timesteps[-1] < timesteps[-length(timesteps)])) 45 | } 46 | 47 | year_offset <- calculate_year_offset(x) 48 | 49 | if (direction == "backward") { 50 | year_offset <- rev(year_offset) 51 | year_offset <- year_offset - max(year_offset) 52 | } 53 | 54 | return(year_offset) 55 | } 56 | -------------------------------------------------------------------------------- /R/clean_hdf5_dataframe.R: -------------------------------------------------------------------------------- 1 | 2 | # This strips weird extra within column attributes from dataframes returned 3 | # by h5read 4 | # It's used by import_birdflow_v3. 5 | clean_hdf5_dataframe <- function(df) { 6 | if (!inherits(df, "data.frame")) 7 | return(df) 8 | 9 | for (i in seq_len(ncol(df))) 10 | df[[i]] <- as.vector(df[[i]]) 11 | return(df) 12 | } 13 | -------------------------------------------------------------------------------- /R/combine_transitions.R: -------------------------------------------------------------------------------- 1 | #' Function to combine a sequence of transition matrices into one 2 | #' 3 | #' @param bf A BirdFlow object 4 | #' @inheritDotParams lookup_transitions -x 5 | #' 6 | #' @return This returns the transition probabilities associated with a 7 | #' sequence of timesteps. It will have a column for every unmasked cell 8 | #' at the starting timestep and a row for every unmasked cell in the 9 | #' last timestep, with cell values being the probably of transitioning from 10 | #' that row to that column between the start and end of the time sequence 11 | #' described by `...` 12 | #' 13 | #' @export 14 | combine_transitions <- function(bf, ...) { 15 | # Lookup transition names 16 | transitions <- lookup_transitions(x = bf, ...) 17 | 18 | # Multiply all the transitions together 19 | for (i in seq_along(transitions)) { 20 | # Origin timestep get transtion 21 | if (i == 1) { 22 | trans <- get_transition(bf, transitions[i]) 23 | next 24 | } 25 | # All other timesteps get transition and multiple with prior 26 | a <- get_transition(bf, transitions[i]) 27 | trans <- a %*% trans 28 | } 29 | return(trans) 30 | } 31 | -------------------------------------------------------------------------------- /R/compareGeom.R: -------------------------------------------------------------------------------- 1 | # This implements compareGeom methods where one or both of the first 2 | # two arguments is a BirdFlow obect, possible with the other argument 3 | # being a SpatRaster. They are all implemented by converting the 4 | # BirdFlow objects to SpatRasters and then calling terra::compareGeom 5 | # this is inefficient as it's reformatting the data in the BirdFlow 6 | # rather than using it as is, but it easy and clean and fast enough. 7 | 8 | # setOldClass("BirdFlow") allows S4 dispatch on S3 BirdFlow objects. 9 | methods::setOldClass("BirdFlow") 10 | 11 | #' @aliases compareGeom-BirdFlow compareGeom,BirdFlow,BirdFlow-method 12 | #' @name compareGeom 13 | #' @title BirdFlow compareGeom methods 14 | #' 15 | #' @description 16 | #' These are methods for [terra::compareGeom()] that work when one or both 17 | #' of arguments are BirdFlow objects. 18 | #' 19 | #' @param x A BirdFlow or SpatRaster object 20 | #' @param y A BirdFlow or SpatRaster object 21 | #' @inheritDotParams terra::compareGeom 22 | #' @importMethodsFrom terra compareGeom 23 | #' @export 24 | #' @rdname compareGeom-BirdFlow 25 | setMethod("compareGeom", signature(x = "BirdFlow", y = "BirdFlow"), 26 | function(x, y, ...) { 27 | x <- rast(x) 28 | y <- rast(y) 29 | return(terra::compareGeom(x, y, ...)) 30 | } 31 | ) 32 | 33 | 34 | #' @rdname compareGeom-BirdFlow 35 | #' @export 36 | setMethod("compareGeom", signature(x = "SpatRaster", y = "BirdFlow"), 37 | function(x, y, ...) { 38 | y <- rast(y) 39 | return(terra::compareGeom(x, y, ...)) 40 | } 41 | ) 42 | 43 | #' @rdname compareGeom-BirdFlow 44 | #' @export 45 | setMethod("compareGeom", signature(x = "BirdFlow", y = "SpatRaster"), 46 | function(x, y, ...) { 47 | x <- rast(x) 48 | return(terra::compareGeom(x, y, ...)) 49 | } 50 | ) 51 | -------------------------------------------------------------------------------- /R/compare_list_item_names.R: -------------------------------------------------------------------------------- 1 | 2 | #' compare names of two nested lists 3 | #' 4 | #' Look for difference in the list item names at any nested level. 5 | #' Used internally to verify BirdFlow object structure 6 | #' 7 | #' @param x list 8 | #' @param y reference list 9 | #' @param map used during recursion to tracking where in x differences are found 10 | #' @param differences used during recursion to collecting differences 11 | #' 12 | #' @return data frame with where and difference columns will have 0 rows if no 13 | #' differences found. 14 | #' @keywords internal 15 | compare_list_item_names <- function(x, y, map = "x", differences) { 16 | if (missing(differences)) 17 | differences <- data.frame(where = character(0), difference = character(0)) 18 | if (!is.list(x) && !is.list(y)) 19 | return(differences) 20 | if (sum(is.list(x), is.list(y)) == 1) { # only one is a list 21 | if (is.list(x)) 22 | return(rbind(differences, 23 | data.frame(where = map, 24 | differences = "should not be a list"))) 25 | if (is.list(y)) 26 | return(rbind(differences, 27 | data.frame(where = map, 28 | differences = "should be a list"))) 29 | } 30 | if (!setequal(names(x), names(y))) { 31 | lost <- setdiff(names(x), names(y)) 32 | gained <- setdiff(names(y), names(x)) 33 | if (length(lost) != 0) 34 | differences <- rbind( 35 | differences, 36 | data.frame(where = map, 37 | differences = paste0("extra:", lost))) 38 | 39 | if (length(gained) != 0) 40 | differences <- rbind( 41 | differences, 42 | data.frame(where = map, 43 | differences = paste0("missing:", gained))) 44 | return(differences) 45 | } 46 | 47 | if (!all(names(x) == names(y))) 48 | return(rbind(differences, 49 | data.frame(where = map, differences = "Wrong order"))) 50 | 51 | for (n in names(x)) { 52 | differences <- compare_list_item_names(x[[n]], 53 | y[[n]], 54 | map = paste0(map, "$", n), 55 | differences = differences) 56 | } 57 | return(differences) 58 | 59 | } # end compare list item names 60 | -------------------------------------------------------------------------------- /R/find_threshold.R: -------------------------------------------------------------------------------- 1 | #' function to determine the threshold in values that preserves a given 2 | #' proportion of the value. 3 | #' 4 | #' @param x A vector of values 5 | #' @param p A proportion of x that we wish retain 6 | #' @param method Either `"weight"` to retain a proportion of the total weight 7 | #' or `"values"` to retain a proportion of non-zero values. 8 | #' @return A threshold in values of x such that dropping everything smaller than 9 | #' the threshold retains at least proportion `p` of the total weight or 10 | #' number of values in `x` 11 | #' @keywords internal 12 | find_threshold <- function(x, p, method = "weight") { 13 | 14 | stopifnot(is.numeric(p), 15 | length(p) == 1, 16 | !is.na(p), 17 | p >= 0, 18 | p <= 1) 19 | 20 | x <- sort(x[!is.na(x) & !x == 0], decreasing = TRUE) 21 | if (method == "weight") { 22 | target <- sum(x) * p 23 | cs <- cumsum(x) 24 | i <- which(cs >= target)[1] 25 | return(x[i]) 26 | } 27 | 28 | if (method == "values") { 29 | i <- ceiling(length(x) * p) 30 | return(x[i]) 31 | } 32 | 33 | stop('method should be either "weight" or "values"') 34 | 35 | } 36 | -------------------------------------------------------------------------------- /R/format_pyear.R: -------------------------------------------------------------------------------- 1 | # Function to create legend labels with month and day 2 | # from proportion of year (PY) or half proportion of year (HPY) 3 | # Used by plot_routes() 4 | # PY maps 1 year to 0 to 1 5 | # HPY maps two years to 0 to 1 6 | # In either case this will return formatted labels indicating the 7 | # Month and Day associated with the input values. 8 | format_pyear <- function(x, hpy = TRUE) { 9 | 10 | if (hpy) { # convert hpy to py if necessary 11 | x <- (x * 2) %% 1 # double and take remainder 12 | } 13 | 14 | year <- 2023 # arbitrary but shouldn't be a leap year 15 | dates <- lubridate::as_date(rep("2000-01-01", length(x))) 16 | lubridate::year(dates) <- year 17 | lubridate::yday(dates) <- round((x * 366) + 0.5) 18 | # using ebirdst convention of 366 19 | # + 0.5 because of 0 vs 1 indexing in posix vs lubridate::yday 20 | paste(lubridate::month(dates, label = TRUE, abbr = FALSE), 21 | lubridate::day(dates)) 22 | } 23 | -------------------------------------------------------------------------------- /R/get_dynamic_mask.R: -------------------------------------------------------------------------------- 1 | #' Get the dynamic mask from a BirdFlow object 2 | #' 3 | #' If a BirdFlow object has a dynamic mask it controls which subset of the 4 | #' active cells in the model are active for a given timestep. This is derived 5 | #' from eBird Status and Trends (S&T) distributions; cells that are zero in the 6 | #' S&T data for each timestep are excluded from the model for that timestep, 7 | #' and tracked with the dynamic mask. The dynamic mask has the same dimensions 8 | #' as the distributions (see [get_distr()]) with either a vector of [n_active()] 9 | #' for a single timestep or a matrix with [n_active()] rows if more than one 10 | #' timestep. The values are logical with TRUE corresponding to the cells that 11 | #' are part of the model (for the given timestep). 12 | #' 13 | #' 14 | #' @param x A BirdFlow object 15 | #' @inheritParams get_distr 16 | #' 17 | #' @return A vector or matrix with elements or rows corresponding to active 18 | #' cells in the model indicating whether a cell is included in the model for the 19 | #' given timestep. 20 | #' 21 | #' @export 22 | #' 23 | #' @examples 24 | #' library(terra) # For plotting of spatRaster 25 | #' bf <- BirdFlowModels::amewoo |> add_dynamic_mask() 26 | #' dm <- get_dynamic_mask(bf, c(1, 10, 21, 31, 42, 52)) 27 | #' r <- rasterize_distr(dm, bf) 28 | #' plot(r, legend = FALSE, mar = c(1.3, 1.3, 1.3, .3) ) 29 | #' 30 | get_dynamic_mask <- function(x, which = "all") { 31 | 32 | # Resolve timestep 33 | which <- lookup_timestep(which, bf = x) 34 | 35 | if (!has_dynamic_mask(x)) 36 | stop("'x' must have a dynamic mask to return the dynamic mask.") 37 | 38 | d <- x$geom$dynamic_mask[, which] 39 | if (length(which) == 1) { 40 | attr(d, "time") <- paste0("t", which) 41 | } 42 | return(reformat_distr_labels(d, x)) 43 | 44 | } 45 | -------------------------------------------------------------------------------- /R/get_marginal.R: -------------------------------------------------------------------------------- 1 | #' Return a marginal matrix from a BirdFlowR model 2 | #' 3 | #' Marginals in BirdFlow models are stored such that the cell \[i, j\] 4 | #' represents the probability of the bird being in state i in the prior 5 | #' timestep and state j in the next. Thus the number of rows in the marginal 6 | #' equals the number of cells within the dynamic mask for the prior timestep 7 | #' and the columns count is equal to the included cells for the following 8 | #' timestep. 9 | #' 10 | #' @param x A BirdFlow object 11 | #' @param marginal A marginal code, e.g. "M_01-02" 12 | #' @param from The first timestep associated with the marginal. Note marginals 13 | #' are always forward so the second marginal will be `from + 1` or `1` (when 14 | #' `from` is the last timestep). 15 | #' @return A marginal matrix 16 | #' 17 | #' @seealso [lookup_transitions()] will generate a list of the transitions 18 | #' needed to predict or route between two points in time. [get_transition()] 19 | #' will return a transition matrix - often calculated on the fly from a 20 | #' marginal. 21 | #' 22 | #' @export 23 | get_marginal <- function(x, marginal = NULL, from = NULL) { 24 | if (!has_marginals(x)) 25 | stop("x does not have marginals.") 26 | 27 | if (is.null(marginal)) { 28 | 29 | stopifnot(!is.null(from), 30 | is.numeric(from), 31 | length(from) == 1, 32 | from %in% seq_len(n_timesteps(x))) 33 | if (from == n_timesteps(x)) { 34 | if (!is_cyclical(x)) 35 | stop("x isn't cyclical so there's no marginal with from = ", from) 36 | to <- 1 37 | } else { 38 | to <- from + 1 39 | } 40 | 41 | 42 | marginal <- paste0("M_", 43 | pad_timestep(from, x), "-", 44 | pad_timestep(to, x)) 45 | } 46 | 47 | stopifnot(is.character(marginal), length(marginal) == 1, !is.na(marginal)) 48 | 49 | if (!marginal %in% names(x$marginals)) 50 | stop(marginal, "is not a marginal in x.") 51 | return(x$marginals[[marginal]]) 52 | 53 | } 54 | -------------------------------------------------------------------------------- /R/has.R: -------------------------------------------------------------------------------- 1 | 2 | #' @name has 3 | #' @title Does a BirdFlow object have certain components 4 | #' 5 | #' @description These functions return information about the contents of a 6 | #' BirdFlow object. 7 | #' 8 | #' 9 | #' @param x A BirdFlow model 10 | #' 11 | #' @return Logical indicating the BirdFlow model has the relevant element 12 | #' @export 13 | has_marginals <- function(x) { 14 | x$metadata$has_marginals 15 | } 16 | 17 | #' @rdname has 18 | #' @export 19 | has_transitions <- function(x) { 20 | x$metadata$has_transitions 21 | } 22 | 23 | #' @rdname has 24 | #' @export 25 | has_distr <- function(x) { 26 | x$metadata$has_distr 27 | } 28 | 29 | #' @rdname has 30 | #' @export 31 | has_dynamic_mask <- function(x) { 32 | ! is.null(x$geom$dynamic_mask) && is.matrix(x$geom$dynamic_mask) 33 | } 34 | -------------------------------------------------------------------------------- /R/ignore_unused_imports.R: -------------------------------------------------------------------------------- 1 | 2 | # This private function is here to avoid warnings and notes for packages 3 | # that I want to import but don't directly call. 4 | # This approach was suggested by: 5 | # https://r-pkgs.org/dependencies-in-practice.html#how-to-not-use-a-package-in-imports # nolint 6 | # Closes: https://github.com/birdflow-science/BirdFlowR/issues/102 7 | ignore_unused_imports <- function() { 8 | 9 | gifski::gifski 10 | # Without gifski gganimate will sometimes use a default file based 11 | # renderer to create animations. This results in unexpected files 12 | # written to the users home directory. 13 | # I don't call gifski directly but by having the package available 14 | # it becomes the default renderer used by gganimate::animate 15 | 16 | rnaturalearthdata::coastline50 17 | # rnaturalearthdata 18 | # rnaturalearth functions are called by get_coastline() and others. 19 | # get_coastline() is called by plot_routes() a core function of BirdFlowR 20 | # However, rnaturalearth doesn't import rnaturalearthdata instead it 21 | # checks for that package when needed and then attempts to install it. 22 | # This installation mechanism doesn't consistently work, and thus causes 23 | # problems especially in automated environments where the required 24 | # packes are installed by code. 25 | # 26 | # TLDS Although in theory BirdFlowR only directly depends on 27 | # rnaturalearth it imports rnaturalearthdata to streamline 28 | # installation and avoid relying on rnaturalearth::install_rnaturalearthdata. 29 | 30 | NULL 31 | } 32 | -------------------------------------------------------------------------------- /R/load_collection_index.R: -------------------------------------------------------------------------------- 1 | #' Load the index to a remote model collection 2 | #' 3 | #' Load the collection index for the current model collection. This function 4 | #' will return an up-to-date index for the current BirdFlow collection. It 5 | #' caches the index locally and will update the cached version if it is not 6 | #' up-to-date. 7 | #' 8 | #' The collection will default to the main BirdFlow model collection and most 9 | #' users will not need to set it. 10 | #' 11 | #' The local cache directory (for all collections) defaults to 12 | #' [birdflow_options("cache")](birdflow_otions()) the cache directory for the 13 | #' current collection will be in a subdirectory. Both of the above options 14 | #' can be changed for the duration of the session with [birdflow_options()], 15 | #' but the defaults should be suitable for most users. 16 | #' @inheritParams load_model 17 | #' @return A data frame with a row for every model in the collection. 18 | #' 19 | #' @export 20 | load_collection_index <- 21 | function(update = TRUE, 22 | collection_url = birdflow_options("collection_url")) { 23 | 24 | local_index <- file.path(cache_path(collection_url), "index.Rds") 25 | 26 | collection_url <- gsub("/*$", "/", collection_url) # force trailing slash 27 | 28 | if (!update) { 29 | if (!file.exists(local_index)) { 30 | stop("Do no set update to FALSE unless you have already downloaded your ", 31 | "model") 32 | } 33 | return(readRDS(local_index)) 34 | } 35 | 36 | 37 | md5_url <- paste0(collection_url, "index_md5.txt") 38 | index_url <- paste0(collection_url, "index.Rds") 39 | 40 | up_to_date <- FALSE 41 | 42 | if (file.exists(local_index)) { 43 | local_md5 <- tools::md5sum(local_index) 44 | remote_md5 <- base::readLines(md5_url) 45 | up_to_date <- local_md5 == remote_md5 46 | } 47 | 48 | if (!up_to_date) { 49 | bf_msg("Downloading collection index\n") 50 | dir.create(dirname(local_index), recursive = TRUE, showWarnings = FALSE) 51 | utils::download.file(index_url, local_index, mode = "wb") 52 | make_cache_readme(collection_url) 53 | } 54 | return(readRDS(local_index)) 55 | } 56 | -------------------------------------------------------------------------------- /R/lookup_transitions.R: -------------------------------------------------------------------------------- 1 | #' 2 | #' Lookup a series of transitions connecting two dates or timesteps 3 | #' 4 | #' The private function`lookup_transitions()` returns an ordered vector of 5 | #' transition names that connect start to end. If `start` and `end` are dates 6 | #' than their order determines whether the transitions flow forward or backward 7 | #' in time. If they are timesteps than the `direction` argument should be used 8 | #' to indicate whether to project "forward" or "backward" in time possibly 9 | #' passing the year boundary. 10 | #' 11 | #' @details Transitions are named "T_\[from\]-\[to\]" where \[from\] and \[to\] 12 | #' are timesteps padded with zeros. Direction is important; "T_03-04" 13 | #' represents a transition backward in time. 14 | #' @inheritDotParams lookup_timestep_sequence -x 15 | #' 16 | #' @return A character vector with the named transitions required to get between 17 | #' `start` and `end` 18 | #' @keywords internal 19 | lookup_transitions <- function(x, ...) { 20 | 21 | stopifnot(inherits(x, "BirdFlow")) 22 | steps <- lookup_timestep_sequence(x = x, ...) 23 | return(as_transitions(steps, x)) 24 | 25 | } 26 | -------------------------------------------------------------------------------- /R/make_cache_readme.R: -------------------------------------------------------------------------------- 1 | #' Internal function to create or update readme files within the local 2 | #' BirdFlow model cache. 3 | #' 4 | #' This is called anytime new files are downloaded to the cache by 5 | #' [load_collection_index()] or [load_model()]. 6 | #' @returns Nothing is returned 7 | #' 8 | #' @keywords internal 9 | make_cache_readme <- 10 | function(collection_url = birdflow_options("collection_url")) { 11 | 12 | main_readme_path <- file.path(birdflow_options("cache"), "readme.txt") 13 | collection_readme_path <- file.path(cache_path(collection_url), "readme.txt") 14 | 15 | main <- system.file("readme_templates/main_cache_readme.txt", 16 | package = "BirdFlowR") |> readLines() 17 | 18 | collection <- system.file("readme_templates/collection_cache_readme.txt", 19 | package = "BirdFlowR") |> readLines() 20 | 21 | # Local objects that exactly match field names in templates 22 | # eg "[date]" is a field in the template 23 | date <- lubridate::today() |> as.character() 24 | date # for lintr::object_usage_linter (it is used below with get() ) 25 | cache_path <- cache_path(collection_url) # local variable for the code below 26 | 27 | 28 | # For each text object in memory and for each field 29 | # replace the field alias with it's value. 30 | for (obj_name in c("main", "collection")) { 31 | text <- get(obj_name) 32 | for (field in c("date", "collection_url", "cache_path")) { 33 | text <- gsub(paste0("[", field, "]"), get(field), text, fixed = TRUE) 34 | } 35 | assign(obj_name, text) 36 | } 37 | 38 | # Write 39 | writeLines(main, main_readme_path) 40 | writeLines(collection, collection_readme_path) 41 | invisible() 42 | } 43 | -------------------------------------------------------------------------------- /R/make_mask.R: -------------------------------------------------------------------------------- 1 | #' Internal function to determine the extent of data in eBird rasters. 2 | #' 3 | #' This function returns a logical single layer SpatRaster 4 | #' which is `TRUE` if `x` has non-zero values in any layer. 5 | #' `NA` does not count as non-zero. The result is cropped to the extent of the 6 | #' data in `x`. It's used in BirdFlowR to preprocess data. 7 | #' 8 | #' `make_mask` is a private function. 9 | #' 10 | #' @param x A SpatRaster, typically it's multilayered and contains the 11 | #' distribution of a species over time. 12 | #' @param count If TRUE the returned value will be the count of non-zero cells 13 | #' at the raster location (across timesteps). 14 | #' Otherwise a logical is returned, with TRUE to indicate any non-zero value. 15 | #' @param assume_no_na Set to TRUE if there aren't any NA values in the raster 16 | #' for a slight efficiency improvement. 17 | #' @return A single layer SpatRaster with the same CRS, alignment, and 18 | #' resolution as `x`; cropped to the extent of the data in `x`. With 19 | #' `count = FALSE` the result is a logical that is `TRUE` if there are non-zero 20 | #' cells in any layer in `x` and `FALSE` otherwise. With `count = TRUE` the 21 | #' result is an integer with a count of the number of timesteps in which the 22 | #' cell appears (0 to 52 given weekly steps). 23 | #' @export 24 | #' @keywords internal 25 | make_mask <- function(x, count = FALSE, assume_no_na = FALSE) { 26 | # Clips to extent of the non-zero data 27 | m <- terra::values(x, mat = TRUE) 28 | 29 | if (!assume_no_na) { 30 | m[is.nan(m)] <- 0 31 | } 32 | mask <- apply(m, 1, function(x) sum(x != 0, na.rm = TRUE)) 33 | if (!count) { 34 | mask <- as.logical(mask) # TRUE if cell has data at any timestep 35 | } 36 | mask_mat <- matrix(mask, nrow = nrow(x), ncol = ncol(x), byrow = TRUE) 37 | mask_rast <- terra::rast(mask_mat, extent = ext(x), crs = crs(x)) 38 | 39 | # Rows and columns corresponding to maximum extent of data 40 | r <- which(apply(mask_mat, 1, function(x) any(as.numeric(x) > 0))) 41 | c <- which(apply(mask_mat, 2, function(x) any(as.numeric(x) > 0))) 42 | 43 | 44 | return(mask_rast[min(r):max(r), min(c):max(c), , drop = FALSE]) 45 | } 46 | -------------------------------------------------------------------------------- /R/marginal_stats.R: -------------------------------------------------------------------------------- 1 | 2 | #' marginal statistics 3 | #' 4 | #' Internal functions to calculate the sum of all marginals and the 5 | #' percent of marginal values that are zero. 6 | #' 7 | #' These are used by sparsify and fix_dead_ends. marginal_stats is slightly 8 | #' more efficient than calling the other two functions independently. 9 | #' 10 | #' @param bf A BirdFlow model. 11 | #' 12 | #' @return `marginal_stats()` returns a list with 13 | #' \item{sum}{the sum of all the marginals} 14 | #' \item{pct_zero}{the percent of the values across all marginals that are 15 | #' zero.} 16 | #' @keywords internal 17 | marginal_stats <- function(bf) { 18 | marginal_n <- marginal_zeros <- marginal_sums <- rep(0, n_transitions(bf)) 19 | mar_names <- unique(bf$marginals$index$marginal) 20 | for (i in seq_along(mar_names)) { 21 | m <- bf$marginals[[mar_names[i]]] 22 | marginal_sums[i] <- sum(m) 23 | marginal_zeros[i] <- sum(m == 0) 24 | marginal_n[i] <- prod(dim(m)) 25 | } 26 | pct_zero <- sum(marginal_zeros) / sum(marginal_n) * 100 27 | return(list(sum = sum(marginal_sums), pct_zero = pct_zero)) 28 | } 29 | 30 | #' @rdname marginal_stats 31 | #' @return `sum_marginals()` returns the sum of all marginals. 32 | #' @keywords internal 33 | sum_marginals <- function(bf) { 34 | marginal_sums <- rep(0, n_transitions(bf)) 35 | mar_names <- unique(bf$marginals$index$marginal) 36 | for (i in seq_along(mar_names)) { 37 | marginal_sums[i] <- sum(bf$marginals[[mar_names[i]]]) 38 | } 39 | return(sum(marginal_sums)) 40 | } 41 | 42 | #' @rdname marginal_stats 43 | #' @return `calc_pct_zero()` returns the percent of marginal values that are 44 | #' zero 45 | #' @keywords internal 46 | calc_pct_zero <- function(bf) { 47 | marginal_n <- marginal_zeros <- rep(0, n_transitions(bf)) 48 | mar_names <- unique(bf$marginals$index$marginal) 49 | for (i in seq_along(mar_names)) { 50 | m <- bf$marginals[[mar_names[i]]] 51 | marginal_zeros[i] <- sum(m == 0) 52 | marginal_n[i] <- prod(dim(m)) 53 | } 54 | return(sum(marginal_zeros) / sum(marginal_n) * 100) 55 | } 56 | -------------------------------------------------------------------------------- /R/n_parameters.R: -------------------------------------------------------------------------------- 1 | 2 | #' @rdname dimensions 3 | #' @export 4 | #' @return `n_parameters()` the number of of parameters that the BirdFlow model 5 | #' contains or will contain. This is the number of cells in the marginal 6 | #' matrices + the sum of the dynamic mask for the first timestep (number of 7 | #' unmasked cells at the first timestep). If the model isn't dynamically 8 | #' masked this is equivalent to `n_active(x)^2 * n_transitons(x) + n_active(x)` 9 | n_parameters <- function(x) { 10 | if (has_dynamic_mask(x)) { 11 | dm <- x$geom$dynamic_mask 12 | n_each <- apply(dm, 2, sum) # number of cells included for each timestep 13 | d <- get_dates(x) 14 | 15 | # Forumla below works with either non-cyclical models or cyclical models 16 | # that have been preprocessed only and thus have the first distribution 17 | # duplicated as the last 18 | if (!is_cyclical(x) || d$date[1] == d$date[nrow(d)]) { 19 | return(sum(n_each[1], n_each * dplyr::lag(n_each), na.rm = TRUE)) 20 | 21 | } else { # cyclical, fitted model 22 | n_each_lag <- c(n_each[-1], n_each[1]) # cyclical lag 23 | return(sum(n_each[1], n_each * n_each_lag, na.rm = TRUE)) 24 | } 25 | 26 | } # end fitted cyclical model 27 | 28 | # No dynamic mask. Every marginal has dimensions n_active x n_active. 29 | return(n_active(x)^2 * n_transitions(x) + n_active(x)) 30 | } 31 | -------------------------------------------------------------------------------- /R/pad_timestep.R: -------------------------------------------------------------------------------- 1 | #' pad timesteps from BirdFlow models 2 | #' 3 | #' This function is mostly for internal use but exported for advanced users. 4 | #' It's primary purpose is to pad timesteps with zeros for looking up 5 | #' transition names. It is called from [lookup_transitions()] which is in 6 | #' turn used by [get_transition()]. Padding is generally two digit but the 7 | #' level of padding is stored in the BirdFlow object so that we'll 8 | #' be able to switch to three digit timesteps easily if, for example, 9 | #' someday we decide to have daily timesteps. 10 | #' 11 | #' @param x A vector of timestep integers 12 | #' @param bf A BirdFlow model 13 | #' 14 | #' @return a string with padded versions of x; `1` becomes `"01"`. 15 | #' @export 16 | #' @keywords internal 17 | #' @examples 18 | #' bf <- BirdFlowModels::amewoo 19 | #' pad_timestep(1:5, bf) 20 | pad_timestep <- function(x, bf) { 21 | padding <- get_timestep_padding(bf) 22 | stringr::str_pad(x, width = padding, pad = "0") 23 | } 24 | -------------------------------------------------------------------------------- /R/print.R: -------------------------------------------------------------------------------- 1 | #' Print BirdFlow models 2 | #' 3 | #' This is a print method for BirdFlow objects. 4 | # 5 | #' @param x A BirdFlow object. 6 | #' @param ... arguments passed from other methods 7 | #' 8 | #' @return `x` returned invisibly and unchanged. 9 | #' @method print BirdFlow 10 | #' @export 11 | print.BirdFlow <- function(x, ...) { 12 | if (!is.na(x$species$common_name)) { 13 | cat(x$species$common_name, " ", sep = "") 14 | } 15 | cat("BirdFlow model\n") 16 | 17 | nc <- 15 # n characters before colon 18 | pad <- function(x) format(x, width = nc) 19 | cat(pad(" dimensions"), ": ", 20 | paste(nrow(x), ncol(x), n_timesteps(x), sep = ", "), 21 | " (nrow, ncol, ntimesteps)\n", 22 | sep = "" 23 | ) 24 | cat(pad(" resolution"), ": ", paste(res(x), collapse = ", "), 25 | " (x, y)\n", 26 | sep = "" 27 | ) 28 | cat(pad(" active cells"), ": ", n_active(x), "\n", sep = "") 29 | cat(pad(" size"), ": ", format(utils::object.size(x), unit = "auto"), 30 | "\n", 31 | sep = "" 32 | ) # drop size before package release 33 | invisible(x) 34 | } 35 | -------------------------------------------------------------------------------- /R/proportion_of_year.R: -------------------------------------------------------------------------------- 1 | proportion_of_year <- function(x) { 2 | (as.POSIXlt(x)$yday + 0.5) / 366 # proportion of year 3 | # 366 was used in ebirdst. max(yday+0.5) = 365.5 (on leap yr) 4 | } 5 | -------------------------------------------------------------------------------- /R/range_rescale.R: -------------------------------------------------------------------------------- 1 | 2 | # Helper function for plotting vector fields 3 | range_rescale <- function(x, min = 0, max = 1) { 4 | x / max(x) * (max - min) + min 5 | } 6 | -------------------------------------------------------------------------------- /R/read_geom.R: -------------------------------------------------------------------------------- 1 | #' Read geom component of a BirdFlow hdf5 2 | #' 3 | #' This internal function is called by [import_birdflow()] and 4 | #' [extend_birdflow()] to read and format the geom component of the model 5 | #' @param hdf5 the path to an hdf5 file 6 | #' @return The geom component of a birdflow model 7 | read_geom <- function(hdf5) { 8 | geom <- h5read(hdf5, name = "geom", native = TRUE) 9 | for (a in c("nrow", "ncol", "res", "ext")) { 10 | geom[[a]] <- as.numeric(geom[[a]]) 11 | } 12 | geom$crs <- as.character(geom$crs) 13 | nbf <- new_BirdFlow() 14 | 15 | # Filter to just standard items in standard order 16 | geom <- geom[names(nbf$geom)] 17 | 18 | return(geom) 19 | } 20 | -------------------------------------------------------------------------------- /R/reformat_timestep.R: -------------------------------------------------------------------------------- 1 | 2 | #' reformat timestep labels 3 | #' 4 | #' given a vector of timestep labels provide a vector of formatted labels based 5 | #' on the value of [birdflow_options("time_format")][birdflow_options()] (see 6 | #' that function for options.) 7 | #' 8 | #' Internally distributions are labeled with "t" and the timestep integer. 9 | #' When returning them to the user [reformat_distr_labels()] is called to change 10 | #' the format which in turn calls this function. 11 | #' 12 | #' @param x one (vector) or more (matrix) distributions, with column labels 13 | #' consisting of a "t" and the timestep. 14 | #' @param bf A BirdFlow object 15 | #' @keywords internal 16 | #' @return x with update column labels, as dictated by 17 | #' [birdflow_options("time_format")][birdflow_options()] 18 | reformat_timestep <- function(x, bf) { 19 | # Given a character vector of timestep labels eg c("t1', "t2") 20 | # return a vector indicating time in the format specified 21 | # by birdflow_options("time_format") 22 | format <- birdflow_options("time_format") 23 | 24 | if (format == "timestep") 25 | return(x) 26 | 27 | timestep <- as.numeric(gsub("^t", "", x)) 28 | if (anyNA(timestep)) 29 | stop("Unrecognized timestep labels") 30 | 31 | 32 | d <- get_dates(bf) # data frame with standard date info for bf 33 | mv <- match(timestep, d$timestep) # match vector for aligning to timesteps 34 | dates <- lubridate::as_date(d$date[mv]) # dates associated with timesteps 35 | 36 | 37 | if (format == "month_day") { 38 | return(d$label[mv]) 39 | } 40 | 41 | if (format == "date") { 42 | return(as.character(dates)) 43 | } 44 | 45 | if (format == "week") { 46 | return(paste0("w", stringr::str_pad(d$week[mv], width = 2, pad = "0"))) 47 | } 48 | 49 | stop("Unrecognized date format. ", 50 | "This is probably a programming error in the BirdFlowR package.") 51 | 52 | } 53 | -------------------------------------------------------------------------------- /R/route_migration.R: -------------------------------------------------------------------------------- 1 | 2 | #' Deprecated function to generate migration routes from a BirdFlow model 3 | #' 4 | #' This function is now deprecated and will eventually be deleted. Please 5 | #' transition to using `route()` which can now both generate starting locations 6 | #' by sampling the distributions in `bf` and use a season name to specify the 7 | #' time period to route over. The only adjustment that needs to be made is to 8 | #' use the `season` argument to `route()` in place of the `migration` argument 9 | #' to `route_migration()`. 10 | #' 11 | #' @param bf `BirdFlow` model 12 | #' @param n the number of routes to generate 13 | #' @param migration "prebreeding", "pre", or "spring" for the prebreeding 14 | #' migration; or "postbreeding", "post", or "fall" for the postbreeding 15 | #' migration. 16 | #' @param season_buffer a buffer in timesteps (likely weeks) to add to the 17 | #' beginning and end of the season. The default of 1 means we start a week 18 | #' before the metadata suggests the season starts and continue one week past 19 | #' the end. 20 | #' @inherit route return 21 | #' @seealso 22 | #' * [route()] should be used instead of this function. 23 | #' @export 24 | #' @keywords internal 25 | route_migration <- function(bf, n, migration = "prebreeding", 26 | season_buffer = 1) { 27 | 28 | warning("route_migration() is deprecated please transition to route()", 29 | "and change the migration argument to season.") 30 | 31 | rts <- route(bf = bf, n = n, season = migration, 32 | season_buffer = season_buffer) 33 | 34 | return(rts) 35 | } 36 | -------------------------------------------------------------------------------- /R/sf_methods.R: -------------------------------------------------------------------------------- 1 | 2 | # BirdFlow methods for sf functions 3 | # Currently no help is generated for them 4 | 5 | #' @importFrom sf st_crs 6 | #' @method st_crs BirdFlow 7 | #' @export 8 | st_crs.BirdFlow <- function(x, ...) { 9 | sf::st_crs(x$geom$crs, ...) 10 | } 11 | 12 | #' @importFrom sf st_bbox 13 | #' @method st_bbox BirdFlow 14 | #' @export 15 | st_bbox.BirdFlow <- function(obj, ...) { 16 | bb <- sf::st_bbox(ext(obj), ...) 17 | sf::st_crs(bb) <- st_crs(obj) 18 | return(bb) 19 | } 20 | 21 | #' @importFrom sf st_as_sf 22 | #' @method st_as_sf BirdFlowRoutes 23 | #' @export 24 | st_as_sf.BirdFlowRoutes <- function(x, type = "line", crs = NULL, ...) { 25 | type <- match.arg(type, c("line", "point")) 26 | 27 | if (is.null(crs)) { 28 | a <- attributes(x) 29 | if ("geom" %in% names(a)) { 30 | crs <- a$geom$crs 31 | cat("Set crs based on geom attribute.\n") 32 | } else if ("crs" %in% names(a)) { 33 | crs <- a$crs 34 | } 35 | } 36 | if (is.null(crs)) { 37 | stop("The coordinate reference system must be defined in the object ", 38 | "attributes or via the crs argument.") 39 | } 40 | crs <- sf::st_crs(crs) 41 | if (type == "line") { 42 | lines <- x |> 43 | dplyr::group_by(.data$route_id) |> 44 | dplyr::summarize( 45 | geometry = sf::st_geometry(convert_to_lines(.data$x, .data$y))) |> 46 | as.data.frame() |> 47 | sf::st_as_sf() 48 | sf::st_crs(lines) <- crs 49 | return(lines) 50 | } 51 | if (type == "point") { 52 | x <- as.data.frame(x) 53 | points <- sf::st_as_sf(x, coords = c("x", "y"), crs = crs) 54 | return(points) 55 | } 56 | } 57 | 58 | # Internal helper function to 59 | # Make x and y vectors into lines 60 | convert_to_lines <- function(x, y) { 61 | sf::st_linestring(cbind(x, y), "XY") 62 | } 63 | -------------------------------------------------------------------------------- /R/skip_if_no_big_models.R: -------------------------------------------------------------------------------- 1 | #' helper function for unit testing with testthat 2 | #' 3 | #' This allows skipping test that require large model files. In practice this 4 | #' means that those tests are only run in my local development environment, 5 | #' or, potentially, on another developer's local environment if they copy or 6 | #' recreate the ../Models/ folder. See `vignette("skipping")` in \pkg{testthat} 7 | #' for more information. 8 | #' @noRd 9 | skip_if_no_big_models <- function() { 10 | # testthat helper function 11 | # see testthat: vignette("skipping") 12 | if (!file.exists("../Models/run_big_tests.txt")) 13 | 14 | testthat::skip("Large model files are not available") 15 | 16 | } 17 | -------------------------------------------------------------------------------- /R/suppress_specific_warnings.R: -------------------------------------------------------------------------------- 1 | #' Suppress warnings that match one or more regular expressions 2 | #' 3 | #' `suppress_specific_warnings()` will suppress warnings that match regular 4 | #' expression patterns that are supplied via 5 | #' the `patterns` argument, without suppressing warnings that don't match the 6 | #' patterns. 7 | #' 8 | #' @keywords internal 9 | #' @param x An expression. 10 | #' @param patterns One or more patterns to check warning messages against. 11 | #' 12 | #' @return Possibly output from `x` 13 | #' @keywords internal 14 | suppress_specific_warnings <- function(x, patterns = NULL) { 15 | 16 | 17 | 18 | any_match <- function(cnd, patterns) { 19 | any(sapply(patterns, function(x) grepl(x, cnd))) 20 | } 21 | 22 | check_warning <- function(w) { 23 | if (any_match(conditionMessage(w), patterns)) 24 | invokeRestart("muffleWarning") 25 | } 26 | 27 | withCallingHandlers(x, warning = check_warning) 28 | 29 | } 30 | -------------------------------------------------------------------------------- /R/sysdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/birdflow-science/BirdFlowR/4a9ee028ecad572bccfdab4b3d45b8d28fd0dfe2/R/sysdata.rda -------------------------------------------------------------------------------- /R/ts_info.R: -------------------------------------------------------------------------------- 1 | #' Internal function to determine timestep sequence direction and whether 2 | #'it crosses year boundary 3 | #' 4 | #' It assumes that all lags between adjacent steps that don't cross the year 5 | #' boundary are either -1 or 1. 6 | #' 7 | #' @param ts A sequence of timesteps. 8 | #' @return A list with: 9 | #' \item{direction}{Either `"forward"` or `"backward"`.} 10 | #' \item{loops}{`TRUE` if the sequence crosses the year boundary, `FALSE` if it 11 | #' does not.} 12 | #' 13 | #' @keywords internal 14 | ts_info <- function(ts) { 15 | if (length(ts) == 1) 16 | return(list(loops = FALSE, direction = NA)) 17 | diffs <- ts[-1] - ts[-(length(ts))] 18 | 19 | # loops is TRUE if sequence crosses the year boundary 20 | loops <- !all(diffs %in% c(1, -1)) 21 | 22 | # Determine direction 23 | direction <- NULL 24 | diff <- diffs[1] 25 | if (diff == 1) 26 | direction <- "forward" 27 | if (diff == -1) 28 | direction <- "backward" 29 | if (diff > 1) # diff is large positive if backwards across year boundary 30 | direction <- "backward" 31 | if (diff < -1) 32 | direction <- "forward" # eg -51 at year boundary 33 | if (is.null(direction)) 34 | stop("Direction couldn't be resolved from sequence") 35 | 36 | return(list(loops = loops, direction = direction)) 37 | } 38 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://birdflow-science.github.io/BirdFlowR/ 2 | template: 3 | bootstrap: 5 4 | 5 | development: 6 | mode: unreleased 7 | 8 | home: 9 | links: 10 | - text: BirdFlow Science 11 | href: https://birdflow-science.github.io 12 | - text: BirdFlow (python) 13 | href: https://github.com/Miguel-Fuentes/birdflow 14 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | informational: true 10 | patch: 11 | default: 12 | target: auto 13 | threshold: 1% 14 | informational: true 15 | -------------------------------------------------------------------------------- /data-raw/ebirdst_weeks.R: -------------------------------------------------------------------------------- 1 | # This adds ebirdst_weeks as an internal dataset to the BirdFlowR package 2 | # so that it no longer needs to pull it from ebirdst. 3 | # 4 | # Note: Internal data is stored in R/sysdata.rda and must all be created in 5 | # a single call. 6 | # 7 | # ebirdst_weeks is from ebirdst version 2.2021.3. It is added to BirdFlowR 8 | # for use when preprocessing ebirdst 2021 data (with the old ebird package) 9 | # without referencing the copy in that package as doing so - even conditioned 10 | # on version - breaks CRAN checks when checking against newer ebirdst package 11 | # versions that do not have it. 12 | 13 | # ebirdst_weeks.rds added to data-raw with Using ebirdst v 2.2021.3 14 | # with this: saveRDS(ebirdst::ebirdst_weeks, "data-raw/ebirdst_weeks.rds") 15 | # which never need to run again. 16 | 17 | # Add the data-raw/ebirdst_weeks.rds to R/sysdata.rda 18 | ebirdst_weeks <- readRDS("./data-raw/ebirdst_weeks.rds") 19 | usethis::use_data(ebirdst_weeks, internal = TRUE) 20 | 21 | ### ROxygen Comments below copied from ebirdst/R/data.R v 2.2021.3 22 | ### They will not be rendered but kept here for reference. 23 | 24 | #' eBird Status and Trends weeks 25 | #' 26 | #' eBird Status and Trends predictions are made for each of 52 weeks of the 27 | #' year. This data frame provides the boundaries of the weeks. 28 | #' 29 | #' @format A data frame with 52 rows and 5 columns: 30 | #' \describe{ 31 | #' \item{week_number}{Integer week number from 1-52.} 32 | #' \item{date}{Date of the midpoint of the week.} 33 | #' \item{week_midpoint}{Date of the midpoint of the week expressed as a 34 | #' fraction of the year, i.e. a number from 0-1.} 35 | #' \item{week_start}{Date of the start of the week expressed as a fraction of 36 | #' the year, i.e. a number from 0-1.} 37 | #' \item{week_end}{Date of the end of the week expressed as a fraction of the 38 | #' year, i.e. a number from 0-1.} 39 | #' } 40 | "ebirdst_weeks" 41 | -------------------------------------------------------------------------------- /data-raw/ebirdst_weeks.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/birdflow-science/BirdFlowR/4a9ee028ecad572bccfdab4b3d45b8d28fd0dfe2/data-raw/ebirdst_weeks.rds -------------------------------------------------------------------------------- /data-raw/martern_parameters.R: -------------------------------------------------------------------------------- 1 | # nolint start 2 | 3 | # Note kl was originally l but that lead to warnings about partial argument 4 | # matching ambiguity so I changed it to kl for kernel length hyper parameter 5 | 6 | 7 | # Define a function to plot the probability contour that contains 95% of 8 | # the weight 9 | plot_95 <- function(T, k, gamma, kl, add = TRUE) { 10 | # kl <- 1/2 * T 11 | # gamma <- 4 * T 12 | xs <- seq(0, T, length.out = 50) 13 | ys <- sqrt(calc_variance(xs, T, k = k, gamma = gamma, kl = kl)) * 1.96 14 | # xs <- xs + 0.5 * T 15 | 16 | if (!add) { 17 | plot(NA, NA, xlim = range(xs), ylim = c(- max(ys), max(ys)), 18 | asp = 1, xlab = "", ylab = "") 19 | } 20 | polygon(x = c(xs, rev(xs)), y = c(ys, - rev(ys))) 21 | 22 | } 23 | 24 | 25 | # Set plot options 26 | gamma <- 60000 27 | kl <- 5000 28 | k <- k_m3 # k_sq, k_m1, k_m3, k_m5 29 | 30 | 31 | gamma <- 60000 32 | kl <- 5000 33 | lengths <- c(20000, 10000, 4000, 2000, 1000, 500, 200) 34 | 35 | # 36 | gamma <- 20000 37 | kl <- 2000 38 | lengths <- c(2000, 1000, 500, 200) # 20000, 10000, 4000, 39 | 40 | 41 | # Plot 42 | plot_95(lengths[1], k, gamma, kl, add = FALSE) 43 | for (i in 2:length(lengths)) { 44 | plot_95(lengths[i], k, gamma, kl) 45 | } 46 | 47 | abline(v = seq(0, lengths[1], 100), col = rgb(0, 0, 0, 0.25)) 48 | abline(h = seq(-lengths[1], lengths[1], 100), col = rgb(0, 0, 0, 0.25)) 49 | 50 | # nolint end 51 | -------------------------------------------------------------------------------- /inst/WORDLIST: -------------------------------------------------------------------------------- 1 | th 2 | bbdfc 3 | al 4 | Albers 5 | antnig 6 | Azimuthal 7 | BirdFlow 8 | BirdFlow's 9 | BirdFlowExtras 10 | BirdFlowIntervals 11 | BirdFlowPy 12 | BirdFlowRoutes 13 | BirdFlowModels 14 | BirdFlowOverview 15 | BirdFlowPipeline 16 | BugReports 17 | CMD 18 | Cornwell 19 | CRAN 20 | CRS 21 | CRSs 22 | Codecov 23 | codecov 24 | Dockerfile 25 | Doren 26 | EPSG 27 | et 28 | GeoTIFF 29 | GeoTIFFs 30 | HDF 31 | HPY 32 | Jax 33 | Julian 34 | MacOS 35 | Martern 36 | Motus 37 | Mollweide 38 | Nakagawa 39 | NDM 40 | polygonized 41 | PROJ 42 | Preprocess 43 | Probabilistically 44 | PY 45 | README 46 | RMarkdown 47 | RStudio 48 | RStudio's 49 | Rasters 50 | Rds 51 | Rmd 52 | Shinichi 53 | Sparsify 54 | SpatRaster 55 | WGS 56 | XXXXX 57 | amewoo 58 | amd 59 | bbdfc 60 | betweenness 61 | biocViews 62 | bioRxiv 63 | birdflow 64 | centroid 65 | compareGeom 66 | crs 67 | datatypes 68 | devtools 69 | directionality 70 | distr 71 | doi 72 | eBird 73 | eBird's 74 | ebirdst 75 | easting 76 | epsg 77 | filetype 78 | filetypes 79 | geospatial 80 | gganimate 81 | ggplot 82 | gifski 83 | github 84 | gitignore 85 | gpu 86 | hdf 87 | https 88 | iteratively 89 | io 90 | i'th 91 | laea 92 | lon 93 | lr 94 | marginal's 95 | md 96 | memoryless 97 | memorylessness 98 | mr 99 | multiband 100 | multilayer 101 | naturalearth 102 | ne 103 | northing 104 | pak 105 | pkgdown 106 | PNG 107 | png 108 | postbreeding 109 | pre 110 | prebreeding 111 | preprocess 112 | preprocessed 113 | probabilistically 114 | probabilistic 115 | programmatically 116 | proj 117 | quantile 118 | quantile's 119 | ragg 120 | rasterize 121 | rasters 122 | rda 123 | rds 124 | readme 125 | repo 126 | repos 127 | reproject 128 | reprojecting 129 | rescale 130 | rescaling 131 | rhdf 132 | rnaturalearth 133 | rnaturalearthdata 134 | sparsification 135 | sparsified 136 | sparsify 137 | spatiotemporal 138 | spatRaster 139 | terra 140 | testthat 141 | tibbles 142 | timespan 143 | timestep's 144 | titanx 145 | unresolvable 146 | viridis 147 | viridisLite 148 | wkt 149 | xmax 150 | xmin 151 | xres 152 | ymax 153 | ymin 154 | yml 155 | zig 156 | zag 157 | ℹ 158 | validators 159 | vectorized 160 | -------------------------------------------------------------------------------- /inst/markdown_templates/index_example.Rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/birdflow-science/BirdFlowR/4a9ee028ecad572bccfdab4b3d45b8d28fd0dfe2/inst/markdown_templates/index_example.Rds -------------------------------------------------------------------------------- /inst/readme_templates/collection_cache_readme.txt: -------------------------------------------------------------------------------- 1 | This directory was created by the R BirdFlowR Package to cache models 2 | downloaded from a specific remote collection: 3 | [collection_url] 4 | so they do not have to be redownloaded every time they are used. 5 | 6 | It is safe to delete with two caveots: 7 | 1. You will need to redownload models if you use them again - not a big deal. 8 | 2. If you have out-of-date models that you would like to use without updating 9 | you should not delete them as only up-to-date models are available for 10 | download. 11 | 12 | For more information consult the manual for BirdFlowR available online: 13 | https://birdflow-science.github.io/BirdFlowR/ 14 | 15 | Cache last updated on: 16 | [date] 17 | -------------------------------------------------------------------------------- /inst/readme_templates/main_cache_readme.txt: -------------------------------------------------------------------------------- 1 | This directory was created by the R BirdFlowR Package to cache models 2 | downloaded from remote collections so they do not have to be redownloaded every 3 | time they are used. 4 | 5 | It is safe to delete with two caveots: 6 | 1. You will need to redownload models if you use them again - not a big deal. 7 | 2. If you have out-of-date models that you would like to use without updating 8 | you should not delete them as only up-to-date models are available for 9 | download. 10 | 11 | Unless it's been manually deleted there should be at least one sub-directory 12 | with a 6 character name that contains the cached files for a specific remote 13 | directory. 14 | 15 | For more information consult the manual for BirdFlowR available online: 16 | https://birdflow-science.github.io/BirdFlowR/ 17 | 18 | Last collection updated: 19 | Collection URL: [collection_url] 20 | Cache directory: [cache_path] 21 | 22 | Cache last updated on: 23 | [date] 24 | -------------------------------------------------------------------------------- /man/add_dynamic_mask.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add_dynamic_mask.R 3 | \name{add_dynamic_mask} 4 | \alias{add_dynamic_mask} 5 | \title{Convert a BirdFlow object without a dynamic mask into one with a dynamic mask} 6 | \usage{ 7 | add_dynamic_mask(bf, dummy_mask = FALSE) 8 | } 9 | \arguments{ 10 | \item{bf}{A BirdFlow object} 11 | 12 | \item{dummy_mask}{If TRUE a mask is added to the object, but the mask is 13 | TRUE for every cell. This yields a BirdFlow object that works with the 14 | current mask dependent version of the package but mimics and old BirdFlow 15 | model. Note if the old model included state based sparsification the 16 | predictions should be identical even with \code{dummy_mask = FALSE} (the default).} 17 | } 18 | \value{ 19 | A BirdFlow object that has a dynamic_mask component and in which 20 | the marginals only includes transitions between cells that are not 21 | dynamically masked. 22 | } 23 | \description{ 24 | A dynamic mask is a logical matrix of the same dimensions as the distr matrix 25 | for \code{bf} holding TRUE for cells where the corresponding location (row) and 26 | time (column) is included in the model. 27 | } 28 | \examples{ 29 | bf <- add_dynamic_mask(BirdFlowModels::amewoo) 30 | 31 | } 32 | -------------------------------------------------------------------------------- /man/add_stay_id.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Routes-internal.R 3 | \name{add_stay_id} 4 | \alias{add_stay_id} 5 | \title{Add Stay IDs} 6 | \usage{ 7 | add_stay_id(df) 8 | } 9 | \arguments{ 10 | \item{df}{A data frame with spatial indices.} 11 | } 12 | \value{ 13 | A data frame with \code{stay_id} and \code{stay_len} columns added. 14 | } 15 | \description{ 16 | Adds stay IDs to a data frame based on 17 | changes in spatial indices. 18 | } 19 | \examples{ 20 | routes <- data.frame(list( 21 | route_id = c(1, 1, 1, 2, 2, 3, 3, 3), 22 | i = c(1, 1, 2, 2, 3, 4, 4, 5), 23 | date = as.Date(c( 24 | "2024-01-01", "2024-01-02", "2024-01-03", 25 | "2024-01-04", "2024-01-05", "2024-01-06", 26 | "2024-01-07", "2024-01-08" 27 | )) 28 | )) 29 | routes$i <- as.integer(routes$i) 30 | df_with_stay_ids <- add_stay_id(routes) 31 | } 32 | -------------------------------------------------------------------------------- /man/add_stay_id_with_varied_intervals.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Routes-internal.R 3 | \name{add_stay_id_with_varied_intervals} 4 | \alias{add_stay_id_with_varied_intervals} 5 | \title{Add Stay IDs with Temporal Thresholds} 6 | \usage{ 7 | add_stay_id_with_varied_intervals( 8 | df, 9 | date_col = "date", 10 | timediff_unit = "days" 11 | ) 12 | } 13 | \arguments{ 14 | \item{df}{A data frame with spatial and temporal data.} 15 | 16 | \item{date_col}{The name of the column containing the 17 | date information. Defaults to \code{"date"}.} 18 | 19 | \item{timediff_unit}{The unit of \code{stay_len}.} 20 | } 21 | \value{ 22 | A data frame with \code{stay_id} and \code{stay_len} columns added. 23 | } 24 | \description{ 25 | Adds stay IDs to a data frame, 26 | considering changes in spatial indices. 27 | Should only be applied on a single route, not multiple. 28 | Using \code{add_stay_id_with_varied_intervals()}, rather than \code{add_stay_id()}: 29 | It takes \code{date} as input so account for varying intervals, 30 | if the data is not sampled in the same frequency. 31 | } 32 | \examples{ 33 | routes <- data.frame(list( 34 | route_id = c(1, 1, 1, 2, 2, 3, 3, 3), 35 | i = as.integer(c(1, 1, 2, 2, 3, 4, 4, 5)), # Spatial index 36 | date = as.Date(c( 37 | "2010-01-01", "2010-01-02", "2010-01-05", "2010-01-06", 38 | "2010-01-10", "2010-01-15", "2010-01-16", "2010-01-20" 39 | )) # Time steps with varying intervals 40 | )) 41 | df_with_varied_stay_ids <- 42 | add_stay_id_with_varied_intervals(routes, "date", "days") 43 | } 44 | -------------------------------------------------------------------------------- /man/as_transitions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/as_transitions.R 3 | \name{as_transitions} 4 | \alias{as_transitions} 5 | \title{Convert a sequence of timesteps into a sequence of transition names} 6 | \usage{ 7 | as_transitions(timesteps, bf) 8 | } 9 | \arguments{ 10 | \item{timesteps}{A valid sequence of timesteps. See 11 | \code{lookup_timestep_sequence()}.} 12 | 13 | \item{bf}{A BirdFlowR model, used to determine how much padding 14 | is needed around the timesteps.} 15 | } 16 | \value{ 17 | A directional sequence of transitions that connect \code{timesteps}. 18 | } 19 | \description{ 20 | Convert a sequence of timesteps into a sequence of transition names 21 | } 22 | -------------------------------------------------------------------------------- /man/bf_msg.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bf_msg.R 3 | \name{bf_msg} 4 | \alias{bf_msg} 5 | \title{Internal function to send a message from within BirdFlow functions} 6 | \usage{ 7 | bf_msg(..., sep = "") 8 | } 9 | \arguments{ 10 | \item{...}{Text that will be pasted together to make a message.} 11 | 12 | \item{sep}{(optional) separator between text elements in \code{...} 13 | defaults to no separation.} 14 | } 15 | \value{ 16 | Nothing is returned if verbose is TRUE the message is printed. 17 | } 18 | \description{ 19 | It checks to see if BirdFlowR is in verbose mode 20 | (\verb{birdflow_options("verbose"}) and if so pastes it's arguments together 21 | and prints the result with \code{cat()}. 22 | In the future it might be updated to use \code{message()} 23 | } 24 | \seealso{ 25 | \code{\link[=birdflow_options]{birdflow_options()}} for changing verbosity. 26 | } 27 | \keyword{internal} 28 | -------------------------------------------------------------------------------- /man/bf_suppress_msg.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bf_msg.R 3 | \name{bf_suppress_msg} 4 | \alias{bf_suppress_msg} 5 | \title{Conditionally suppress messages from expressions in BirdFlowR code} 6 | \usage{ 7 | bf_suppress_msg(exp) 8 | } 9 | \arguments{ 10 | \item{exp}{R code that might throw a message (originating outside of 11 | \pkg{BirdFlowR}.} 12 | } 13 | \description{ 14 | This internal functions is used to suppress messages thrown 15 | by functions called in BirdFlowR code if \code{birdflow_options("verbose")} 16 | is \code{FALSE}. 17 | } 18 | \examples{ 19 | \dontrun{ 20 | # bf_suppress_msg isn't exported so can't be run in examples 21 | # in internal code or after devtools::load_all() example will work 22 | ob <- birdflow_options("verbose") 23 | birdflow_options(verbose = FALSE) 24 | bf_suppress_msg( message("hi" )) 25 | birdflow_options(verbose = TRUE) 26 | bf_suppress_msg( message("hi" )) 27 | birdflow_options(ob) 28 | } 29 | 30 | } 31 | \seealso{ 32 | \code{\link[=preprocess_species]{preprocess_species()}} uses this when calling \pkg{ebirdst} 33 | functions that display messages. 34 | When BirdFlowR functions generate messages they should use \code{\link[=bf_msg]{bf_msg()}} so that 35 | \code{birdflow_options("verbose")} is honored. 36 | } 37 | \keyword{internal} 38 | -------------------------------------------------------------------------------- /man/build_transitions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/build_transitions.R 3 | \name{build_transitions} 4 | \alias{build_transitions} 5 | \alias{drop_transitions} 6 | \title{Add or drop transition matrices} 7 | \usage{ 8 | build_transitions(x, rebuild = FALSE) 9 | 10 | drop_transitions(x) 11 | } 12 | \arguments{ 13 | \item{x}{BirdFlow object} 14 | 15 | \item{rebuild}{Set to TRUE to rebuild transitions if they are already 16 | present.} 17 | } 18 | \value{ 19 | BirdFlow object with transition matrices 20 | } 21 | \description{ 22 | Given a BirdFlow object with marginals and without transitions 23 | \code{build_transitions()} return a BirdFlow object with both marginals 24 | and transitions, \code{drop_tansitions()} will reverse the process. 25 | } 26 | \examples{ 27 | \dontrun{ 28 | bf1 <- BirdFlowModels::amewoo 29 | bf2 <- build_transitions(bf) 30 | bf2 31 | 32 | bf3 <- drop_transitions(bf2) 33 | bf3 34 | } 35 | } 36 | \seealso{ 37 | \code{\link[=has_transitions]{has_transitions()}} 38 | } 39 | -------------------------------------------------------------------------------- /man/cache_path.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cache_path.R 3 | \name{cache_path} 4 | \alias{cache_path} 5 | \title{Internal function to get the local path to the cache for the current 6 | model collection.} 7 | \usage{ 8 | cache_path(collection_url = birdflow_options("collection_url")) 9 | } 10 | \arguments{ 11 | \item{collection_url}{The url of a collection. Should be the path to 12 | the base directory (not an index.html file).} 13 | } 14 | \value{ 15 | Path to the local cache for the current collection including a 16 | trailing delimiter. 17 | } 18 | \description{ 19 | Use \href{birdflow_options()}{birdflow_options("cache")} to get the main cache 20 | directory (parent of the collection directory) and 21 | \href{birdflow_options()}{birdflow_options("collection_url")} for the current model 22 | collection url. 23 | } 24 | \keyword{internal} 25 | -------------------------------------------------------------------------------- /man/calc_abundance_stats.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calc_abundance_stats.R 3 | \name{calc_abundance_stats} 4 | \alias{calc_abundance_stats} 5 | \title{Calculate stats from a spatRaster with abundances for each timestep} 6 | \usage{ 7 | calc_abundance_stats(x, circular = TRUE) 8 | } 9 | \arguments{ 10 | \item{x}{a multilayer spatRaster with relative abundances for each timestep} 11 | 12 | \item{circular}{if TRUE (the default) use the first timestep abundance as the 13 | ending abundance.} 14 | } 15 | \value{ 16 | A list with 17 | \item{n_params}{The number of parameters there would be in the model if fit 18 | on \code{x}} 19 | \item{count}{ a vector of the number of cells occupied at each timestep} 20 | \item{area}{ a vector of area (sq m) that is in included cells for each 21 | timestep} \item{res}{ the resolution of the raster in km} 22 | } 23 | \description{ 24 | Calculate the total number of parameters and the occupied area for each 25 | timestep from an abundance raster. 26 | } 27 | \details{ 28 | This is a helper to \code{\link[=preprocess_species]{preprocess_species()}} 29 | } 30 | \keyword{internal} 31 | -------------------------------------------------------------------------------- /man/calc_dist_weights.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calc_distance_weights.R 3 | \name{calc_dist_weights} 4 | \alias{calc_dist_weights} 5 | \title{calculate the weights of transitions for flux points} 6 | \usage{ 7 | calc_dist_weights( 8 | dist_to_line, 9 | dist_along_line, 10 | line_lengths, 11 | radius_m, 12 | res_m, 13 | method = "m3" 14 | ) 15 | } 16 | \arguments{ 17 | \item{dist_to_line}{How far is the point from the line (m)} 18 | 19 | \item{dist_along_line}{How far along the line is the point, after 20 | projecting it onto the line (m)} 21 | 22 | \item{line_lengths}{How long is the line (m)} 23 | 24 | \item{radius_m}{The radius of the transect at the flux points - used to 25 | determine the band of probability density that will be added to form 26 | the weight.} 27 | 28 | \item{res_m}{The resolution of the associated bird flow model, used to 29 | determine the nugget added to the variance to represent the uncertainty in 30 | the starting and ending location of the transition.} 31 | 32 | \item{method}{The method used for calculating the standard deviation 33 | in the probability distribution. Currently \code{"m3"}, Martern 3/2; and 34 | \code{"bb"}, Brownian bridge are supported.} 35 | } 36 | \value{ 37 | A vector of weights of the same length as the first three arguments. 38 | } 39 | \description{ 40 | \code{calc_dist_weights()} is an internal function that takes summary stats 41 | on the relationship between points and a transition line and returns 42 | the weight that should be used for that transition. 43 | } 44 | \details{ 45 | The first three arguments can all be vectors in which case the calculations 46 | will be vectorized over the corresponding elements. 47 | 48 | This is a preliminary version of the function and will likely change. 49 | } 50 | \keyword{internal} 51 | -------------------------------------------------------------------------------- /man/calc_year_offset.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calc_year_offset.R 3 | \name{calc_year_offset} 4 | \alias{calc_year_offset} 5 | \title{Calculate year offset from a sequence of timesteps} 6 | \usage{ 7 | calc_year_offset(x) 8 | } 9 | \arguments{ 10 | \item{x}{a sequence of integers representing timesteps.} 11 | } 12 | \value{ 13 | sequence of year offsets these will be 0 or 1 for forward sequences 14 | and 0 or -1 for backwards. 15 | } 16 | \description{ 17 | This internal function assigns a year offset for each 18 | observation based on whether the sequence has passed over a presumed year 19 | boundary and started over. The sequence always starts with 0. 20 | Forward sequences increment with each new year, while backwards sequences 21 | decrements (0, -1, etc.). Elsewhere there are limitations on \code{route()} that 22 | prevent routes longer than 1 full year (back to start), but this function 23 | does not have that limit. 24 | } 25 | \details{ 26 | It is used by \code{route()} to convert from circular to linear time by 27 | making dates monotonic. 28 | } 29 | \keyword{internal} 30 | -------------------------------------------------------------------------------- /man/calculate_interval_sampling_strategy.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calculate_interval_sampling_strategy.R 3 | \name{calculate_interval_sampling_strategy} 4 | \alias{calculate_interval_sampling_strategy} 5 | \title{Calculate Interval Sampling Strategy} 6 | \usage{ 7 | calculate_interval_sampling_strategy( 8 | routes, 9 | n, 10 | min_day_interval, 11 | max_day_interval, 12 | min_km_interval, 13 | max_km_interval 14 | ) 15 | } 16 | \arguments{ 17 | \item{routes}{A data frame similar to the data feature in \code{Routes} -- 18 | with columns \code{route_id}, \code{date}, \code{lon} and \code{lat}.} 19 | 20 | \item{n}{The total maximum number of intervals to sample. Notice: 21 | The actual output of intervals might be less than n, 22 | because of data deficiency. But never larger than n.} 23 | 24 | \item{min_day_interval}{The minimum days required in an interval.} 25 | 26 | \item{max_day_interval}{The maximum days required in an interval.} 27 | 28 | \item{min_km_interval}{The minimum distance required for an interval.} 29 | 30 | \item{max_km_interval}{The maximum distance required for an interval.} 31 | } 32 | \value{ 33 | A data frame with the columns: 34 | \itemize{ 35 | \item \code{route_id}: The route ID. 36 | \item \code{time_points}: The number of time points in the route. 37 | \item \code{interval_pairs}: The total number of possible interval 38 | pairs for the route. 39 | \item \code{intervals_to_sample}: The number of intervals to sample for the route. 40 | } 41 | } 42 | \description{ 43 | Internal function used by \code{as_BirdFlowRoutes()} to determine 44 | how many intervals to sample from each route based on 45 | the total number of intervals requested. 46 | Ensures an even distribution across routes when possible. 47 | } 48 | \examples{ 49 | \dontrun{ 50 | # Example usage 51 | routes <- data.frame( 52 | route_id = c("A", "A", "B", "B", "B"), 53 | lon = c(100, 101, 102, 103, 104), 54 | lat = c(40, 42, 44, 46, 48), 55 | date = as.Date("2024-01-01") + (0:4) * 10 56 | ) 57 | sampling_strategy <- calculate_interval_sampling_strategy(routes, 58 | n = 10, 59 | min_day_interval = 20, min_km_interval = 100 60 | ) 61 | } 62 | } 63 | \keyword{internal} 64 | -------------------------------------------------------------------------------- /man/combine_transitions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/combine_transitions.R 3 | \name{combine_transitions} 4 | \alias{combine_transitions} 5 | \title{Function to combine a sequence of transition matrices into one} 6 | \usage{ 7 | combine_transitions(bf, ...) 8 | } 9 | \arguments{ 10 | \item{bf}{A BirdFlow object} 11 | 12 | \item{...}{ 13 | Arguments passed on to \code{\link[=lookup_transitions]{lookup_transitions}} 14 | \describe{ 15 | \item{\code{}}{} 16 | }} 17 | } 18 | \value{ 19 | This returns the transition probabilities associated with a 20 | sequence of timesteps. It will have a column for every unmasked cell 21 | at the starting timestep and a row for every unmasked cell in the 22 | last timestep, with cell values being the probably of transitioning from 23 | that row to that column between the start and end of the time sequence 24 | described by \code{...} 25 | } 26 | \description{ 27 | Function to combine a sequence of transition matrices into one 28 | } 29 | -------------------------------------------------------------------------------- /man/compareGeom-BirdFlow.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/compareGeom.R 3 | \name{compareGeom} 4 | \alias{compareGeom} 5 | \alias{compareGeom-BirdFlow} 6 | \alias{compareGeom,BirdFlow,BirdFlow-method} 7 | \alias{compareGeom,SpatRaster,BirdFlow-method} 8 | \alias{compareGeom,BirdFlow,SpatRaster-method} 9 | \title{BirdFlow compareGeom methods} 10 | \usage{ 11 | \S4method{compareGeom}{BirdFlow,BirdFlow}(x, y, ...) 12 | 13 | \S4method{compareGeom}{SpatRaster,BirdFlow}(x, y, ...) 14 | 15 | \S4method{compareGeom}{BirdFlow,SpatRaster}(x, y, ...) 16 | } 17 | \arguments{ 18 | \item{x}{A BirdFlow or SpatRaster object} 19 | 20 | \item{y}{A BirdFlow or SpatRaster object} 21 | 22 | \item{...}{ 23 | Arguments passed on to \code{\link[terra:compareGeom]{terra::compareGeom}} 24 | \describe{ 25 | \item{\code{}}{} 26 | }} 27 | } 28 | \description{ 29 | These are methods for \code{\link[terra:compareGeom]{terra::compareGeom()}} that work when one or both 30 | of arguments are BirdFlow objects. 31 | } 32 | -------------------------------------------------------------------------------- /man/compare_list_item_names.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/compare_list_item_names.R 3 | \name{compare_list_item_names} 4 | \alias{compare_list_item_names} 5 | \title{compare names of two nested lists} 6 | \usage{ 7 | compare_list_item_names(x, y, map = "x", differences) 8 | } 9 | \arguments{ 10 | \item{x}{list} 11 | 12 | \item{y}{reference list} 13 | 14 | \item{map}{used during recursion to tracking where in x differences are found} 15 | 16 | \item{differences}{used during recursion to collecting differences} 17 | } 18 | \value{ 19 | data frame with where and difference columns will have 0 rows if no 20 | differences found. 21 | } 22 | \description{ 23 | Look for difference in the list item names at any nested level. 24 | Used internally to verify BirdFlow object structure 25 | } 26 | \keyword{internal} 27 | -------------------------------------------------------------------------------- /man/dynamic_mask_index_conversions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dmi_to_i.R 3 | \name{dmi_to_i} 4 | \alias{dmi_to_i} 5 | \alias{i_to_dmi} 6 | \title{Convert between dynamic mask index and static location index} 7 | \usage{ 8 | dmi_to_i(dmi, timestep, bf) 9 | 10 | i_to_dmi(i, timestep, bf) 11 | } 12 | \arguments{ 13 | \item{dmi}{Dynamic mask index values. These will always be integers between 14 | \code{1} and the sum of the dynamic mask for the given timestep.} 15 | 16 | \item{timestep}{Either a single timestep to be used for all conversions 17 | or a vector of the timesteps associated with each input value: \code{dmi} for 18 | \code{dmi_to_i()} or \code{i} for \code{i_to_dmi()}.} 19 | 20 | \item{bf}{A BirdFlowR model. Note the conversion is specific to this 21 | model and not valid for any others.} 22 | 23 | \item{i}{Location index. This indicates a location based on an index of the 24 | cells included by the static mask. These start in the top left location and 25 | fill in by row.} 26 | } 27 | \value{ 28 | The location index,\code{i}, of each location indicated by \code{dmi} or 29 | vice versa. 30 | } 31 | \description{ 32 | \code{dmi_to_i()} and \code{i_to_dmi()} are for internal and advanced use; 33 | they are not likely to be helpful to most users. 34 | See \href{i_to_x}{index conversions} for, likely, more useful conversions. 35 | These two functions convert between indices along the cells that are 36 | included in the dynamic mask (\code{dmi}) and standard location 37 | indices (\code{i}) along the cells that are included by the static mask. 38 | This conversion requires knowing the \code{timestep} 39 | associated with each \code{dmi} or \code{i} value 40 | as the mapping between the two is different for each timestep. 41 | } 42 | \examples{ 43 | bf <- BirdFlowModels::amewoo 44 | dmi <- c(11:20) 45 | timesteps <- c(1, 1, 1, 1, 3, 3, 5,7:9 ) 46 | 47 | i <- dmi_to_i(dmi, timesteps, bf) 48 | dmi2 <- i_to_dmi(i, timesteps, bf) 49 | 50 | isTRUE(all.equal(dmi, dmi2)) 51 | } 52 | -------------------------------------------------------------------------------- /man/expand_distr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/expand_distr.R 3 | \name{expand_distr} 4 | \alias{expand_distr} 5 | \title{Convert a collapsed distribution into a expanded, raster equivalent} 6 | \usage{ 7 | expand_distr(distr, bf) 8 | } 9 | \arguments{ 10 | \item{distr}{Either a vector representing a single distribution with one 11 | value per location in the model or a matrix in which each column is such a 12 | vector. Higher dimensions are allowed (but unlikely); in all cases the 13 | first dimension is for locations in the model.} 14 | 15 | \item{bf}{A BirdFlow model} 16 | } 17 | \value{ 18 | An expanded version of \code{distr} with one additional dimension, in 19 | which the first two dimensions are rows and columns in space (a raster) and 20 | replace the first dimension in the input. 21 | } 22 | \description{ 23 | This function converts a collapsed distribution in which the first (and 24 | possibly only) dimension represents all the locations in the model into an 25 | expanded, raster state in which the first two dimensions represent the 26 | locations of the cell in physical space (row, col) and are thus suitable for 27 | plotting or conversion into spatial objects. 28 | } 29 | \details{ 30 | In its collapsed form a single distribution is stored as a vector. Each value 31 | can be interpreted as the relative abundance or probability of finding a bird 32 | at the corresponding location. A special case is when the vector has mostly 33 | 0's and a single 1 in which case it represents a single position of a bird or 34 | group of birds, a very concentrated distribution. 35 | 36 | Additional dimensions can represent multiple timesteps and/or multiple 37 | individual birds, model runs etc. 38 | 39 | The location information in the collapsed distribution is not easily 40 | accessible as position in the vector is ordered based on row-major ordered 41 | unmasked cells in the extent, and R uses column-major order. 42 | 43 | As of May 2023 this is now an internal function replaced by 44 | \link[=rasterize_distr]{rasterize_distr(format = "numeric")}. 45 | } 46 | \keyword{internal} 47 | -------------------------------------------------------------------------------- /man/extend_birdflow.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/extend_birdflow.R 3 | \name{extend_birdflow} 4 | \alias{extend_birdflow} 5 | \title{Extend BirdFlow extent} 6 | \usage{ 7 | extend_birdflow(x, y) 8 | } 9 | \arguments{ 10 | \item{x}{A single BirdFlow object, or one or more paths to BirdFlow objects 11 | stored as either hdf5 or rds files.} 12 | 13 | \item{y}{An extent or an object that yields an extent when passed 14 | to \code{\link[terra:ext]{terra::ext()}}.} 15 | } 16 | \value{ 17 | If \code{x} is a BirdFlow model object \code{extend_birdflow()} returns an 18 | extended version of the same model. If \code{x} is the path to one or more 19 | BirdFlow models than those files are modified and a logical vector of the 20 | same length is returned with TRUE for success. 21 | } 22 | \description{ 23 | Extend BirdFlow extent 24 | } 25 | \details{ 26 | Models can only be extended beyond their original extent, however if they 27 | have already been extended it is possible to "extend" them again to 28 | a smaller extent as long as it is also larger than the original extent. 29 | } 30 | \examples{ 31 | bf <- BirdFlowModels::amewoo 32 | 33 | # Define extended extent for example 34 | e <- ext(bf) 35 | buffer <- 3 * res(bf) 36 | e[1] <- e[1] - buffer[1] 37 | e[2] <- e[2] + buffer[1] 38 | e[3] <- e[3] - buffer[2] 39 | e[4] <- e[4] + buffer[2] 40 | 41 | bf2 <- extend_birdflow(bf, e) 42 | 43 | bf3 <- shrink_birdflow(bf2) 44 | 45 | # Compare extents 46 | data.frame(item = names(as.vector(ext(bf))), 47 | initial = as.vector(ext(bf)), 48 | extended = as.vector(ext(bf2)), 49 | shrunk = as.vector(ext(bf3))) 50 | 51 | \dontrun{ 52 | # Plot 53 | library(terra) 54 | plot_distr(get_distr(bf, 1), bf) 55 | plot_distr(get_distr(bf2, 1), bf2) 56 | plot_distr(get_distr(bf3, 1), bf3) 57 | } 58 | 59 | } 60 | \seealso{ 61 | \code{\link[=shrink_birdflow]{shrink_birdflow()}} returns a model to it's original extent. 62 | } 63 | -------------------------------------------------------------------------------- /man/extend_geom.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/extend_birdflow.R 3 | \name{extend_geom} 4 | \alias{extend_geom} 5 | \title{Extend geometry component of a BirdFlow object} 6 | \usage{ 7 | extend_geom(geom, y) 8 | } 9 | \arguments{ 10 | \item{geom}{The geometry component of a BirdFlow object} 11 | 12 | \item{y}{An object that returns an extent when passed to \code{\link[terra:ext]{terra::ext()}}, 13 | this can be an extent, a SpatRaster, or a BirdFlow model.} 14 | } 15 | \value{ 16 | extended geometry (covering larger area) 17 | } 18 | \description{ 19 | This is an internal helper function called twice by \code{\link[=extend_birdflow]{extend_birdflow()}} 20 | it adjusts the \code{nrow}, \code{ncol}, \code{ext}, and \code{mask} elements of the 21 | \code{geom} component of a BirdFlow model to expand the extent while preserving 22 | the same number, location, and alignment of the unmasked cells - 23 | thus nothing else in the object needs to change. 24 | } 25 | \keyword{internal} 26 | -------------------------------------------------------------------------------- /man/figures/BirdFlowR.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/birdflow-science/BirdFlowR/4a9ee028ecad572bccfdab4b3d45b8d28fd0dfe2/man/figures/BirdFlowR.png -------------------------------------------------------------------------------- /man/figures/README-examples-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/birdflow-science/BirdFlowR/4a9ee028ecad572bccfdab4b3d45b8d28fd0dfe2/man/figures/README-examples-1.png -------------------------------------------------------------------------------- /man/figures/README-movement_vectors-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/birdflow-science/BirdFlowR/4a9ee028ecad572bccfdab4b3d45b8d28fd0dfe2/man/figures/README-movement_vectors-1.png -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/birdflow-science/BirdFlowR/4a9ee028ecad572bccfdab4b3d45b8d28fd0dfe2/man/figures/logo.png -------------------------------------------------------------------------------- /man/find_threshold.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/find_threshold.R 3 | \name{find_threshold} 4 | \alias{find_threshold} 5 | \title{function to determine the threshold in values that preserves a given 6 | proportion of the value.} 7 | \usage{ 8 | find_threshold(x, p, method = "weight") 9 | } 10 | \arguments{ 11 | \item{x}{A vector of values} 12 | 13 | \item{p}{A proportion of x that we wish retain} 14 | 15 | \item{method}{Either \code{"weight"} to retain a proportion of the total weight 16 | or \code{"values"} to retain a proportion of non-zero values.} 17 | } 18 | \value{ 19 | A threshold in values of x such that dropping everything smaller than 20 | the threshold retains at least proportion \code{p} of the total weight or 21 | number of values in \code{x} 22 | } 23 | \description{ 24 | function to determine the threshold in values that preserves a given 25 | proportion of the value. 26 | } 27 | \keyword{internal} 28 | -------------------------------------------------------------------------------- /man/fix_current_dead_ends.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fix_dead_ends.R 3 | \name{fix_current_dead_ends} 4 | \alias{fix_current_dead_ends} 5 | \title{Fix the dead ends currently present in the model} 6 | \usage{ 7 | fix_current_dead_ends(bf, de) 8 | } 9 | \arguments{ 10 | \item{bf}{BirdFlow model} 11 | 12 | \item{de}{(optional) output from \code{\link[=find_dead_ends]{find_dead_ends()}}} 13 | } 14 | \value{ 15 | a BirdFlow model with selected marginal rows and columns zeroed out. 16 | } 17 | \description{ 18 | \code{fix_current_dead_ends()} zeros 19 | out the row or column of the marginal that leads into current dead ends, 20 | eliminating all transitions into the existing dead end states. It tends to 21 | create new dead ends in the process so is called iteratively by 22 | \code{\link[=fix_dead_ends]{fix_dead_ends()}}. 23 | } 24 | \keyword{internal} 25 | -------------------------------------------------------------------------------- /man/flatten_raster.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/flatten_raster.R 3 | \name{flatten_raster} 4 | \alias{flatten_raster} 5 | \title{Convert a raster bird distribution into its flattened, vector equivalent} 6 | \usage{ 7 | flatten_raster(x, bf) 8 | } 9 | \arguments{ 10 | \item{x}{Either a matrix representing a single bird distribution or an 11 | array representing multiple distributions with dimensions: row, col, and 12 | distribution.} 13 | 14 | \item{bf}{A \code{BirdFlow} model.} 15 | } 16 | \value{ 17 | Either a vector representing a single distribution in its collapsed 18 | form or, if \code{x} represents multiple distributions, a matrix with one 19 | distribution per column. 20 | } 21 | \description{ 22 | This function converts between a raster representation of data in which rows 23 | and columns indicate position in space and a vector representation that 24 | contains only the active (not masked) cells in row major order - starting at 25 | the top left and proceeding left to right along each row. The collapsed form 26 | is used for projecting the flow model while the expanded form is used to 27 | export, import, and visualize the data. 28 | } 29 | \seealso{ 30 | \itemize{ 31 | \item \code{\link[=expand_distr]{expand_distr()}} does the opposite of \code{flatten_raster()}. 32 | \item \code{\link[=rasterize_distr]{rasterize_distr()}} has replaced this function in the public API. With 33 | \code{format = "numeric"} it returns an identical object to \code{expand_distr()} but 34 | by default (`format = "SpatRaster" it goes one step further and adds spatial 35 | metadata to make a \link[terra:SpatRaster-class]{terra::SpatRaster}. 36 | \item \link{index_conversions} for ways to convert among indexes of the data in 37 | raster row and column, index along the flattened vector, and Cartesian space. 38 | } 39 | } 40 | -------------------------------------------------------------------------------- /man/get_distr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_distr.R 3 | \name{get_distr} 4 | \alias{get_distr} 5 | \title{Extract distributions from BirdFlow models} 6 | \usage{ 7 | get_distr(x, which = "all", from_marginals = FALSE) 8 | } 9 | \arguments{ 10 | \item{x}{A BirdFlow model} 11 | 12 | \item{which}{Indicates which timesteps to return. Can be one or more 13 | integers indicating timesteps; character dates in the format 14 | year-month-day e.g. \code{"2019-02-25"}; \code{\link[base:Dates]{Date}} objects; 15 | or \code{"all"} which will return distributions for all timesteps.} 16 | 17 | \item{from_marginals}{If TRUE and \code{x} has marginals the distribution will be 18 | from the marginals even if \code{x} also has distributions.} 19 | } 20 | \value{ 21 | Either a vector with a distribution for a single timestep or a matrix 22 | with a column for each distribution. 23 | } 24 | \description{ 25 | \code{get_distr} will return one or more distributions in their flattened form. A 26 | single distribution will be returned as a vector; if multiple they will be 27 | columns in a matrix. 28 | } 29 | \details{ 30 | If the BirdFlow object has stored distributions they will be the training 31 | distributions and will be returned by default unless \code{from_marginals = TRUE} 32 | in which case distributions calculated from the marginal will be returned. 33 | 34 | The training distributions and the distributions calculated from the marginal 35 | are very similar. 36 | } 37 | \seealso{ 38 | Distributions can be passed to \link[=predict.BirdFlow]{predict()} or 39 | converted to rasters with \code{\link[=expand_distr]{expand_distr()}} or converted to 40 | \link[terra:rast]{SpatRaster} with 41 | \code{\link[=rasterize_distr]{rasterize_distr()}}. \code{\link[=sample_distr]{sample_distr()}} will convert one cell to 1 and the 42 | rest to 0 probabilistically based on the densities in the distribution. 43 | } 44 | -------------------------------------------------------------------------------- /man/get_dynamic_mask.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_dynamic_mask.R 3 | \name{get_dynamic_mask} 4 | \alias{get_dynamic_mask} 5 | \title{Get the dynamic mask from a BirdFlow object} 6 | \usage{ 7 | get_dynamic_mask(x, which = "all") 8 | } 9 | \arguments{ 10 | \item{x}{A BirdFlow object} 11 | 12 | \item{which}{Indicates which timesteps to return. Can be one or more 13 | integers indicating timesteps; character dates in the format 14 | year-month-day e.g. \code{"2019-02-25"}; \code{\link[base:Dates]{Date}} objects; 15 | or \code{"all"} which will return distributions for all timesteps.} 16 | } 17 | \value{ 18 | A vector or matrix with elements or rows corresponding to active 19 | cells in the model indicating whether a cell is included in the model for the 20 | given timestep. 21 | } 22 | \description{ 23 | If a BirdFlow object has a dynamic mask it controls which subset of the 24 | active cells in the model are active for a given timestep. This is derived 25 | from eBird Status and Trends (S&T) distributions; cells that are zero in the 26 | S&T data for each timestep are excluded from the model for that timestep, 27 | and tracked with the dynamic mask. The dynamic mask has the same dimensions 28 | as the distributions (see \code{\link[=get_distr]{get_distr()}}) with either a vector of \code{\link[=n_active]{n_active()}} 29 | for a single timestep or a matrix with \code{\link[=n_active]{n_active()}} rows if more than one 30 | timestep. The values are logical with TRUE corresponding to the cells that 31 | are part of the model (for the given timestep). 32 | } 33 | \examples{ 34 | library(terra) # For plotting of spatRaster 35 | bf <- BirdFlowModels::amewoo |> add_dynamic_mask() 36 | dm <- get_dynamic_mask(bf, c(1, 10, 21, 31, 42, 52)) 37 | r <- rasterize_distr(dm, bf) 38 | plot(r, legend = FALSE, mar = c(1.3, 1.3, 1.3, .3) ) 39 | 40 | } 41 | -------------------------------------------------------------------------------- /man/get_loss.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_loss.R 3 | \name{get_loss} 4 | \alias{get_loss} 5 | \title{Get loss values for each step in the model fitting process} 6 | \usage{ 7 | get_loss(bf) 8 | } 9 | \arguments{ 10 | \item{bf}{A BirdFlow object.} 11 | } 12 | \value{ 13 | A data frame with columns: 14 | \item{dist}{The distance loss} 15 | \item{ent}{The entropy loss} 16 | \item{obs}{The observation loss} 17 | \item{total}{The total weighted loss} 18 | } 19 | \description{ 20 | \code{get_loss()} returns a data frame of loss values. Each row corresponds to 21 | a step in the fitting process. 22 | } 23 | \examples{ 24 | bf <- BirdFlowModels::amewoo 25 | get_loss(bf) 26 | } 27 | \seealso{ 28 | \code{\link[=plot_loss]{plot_loss()}} 29 | } 30 | -------------------------------------------------------------------------------- /man/get_marginal.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_marginal.R 3 | \name{get_marginal} 4 | \alias{get_marginal} 5 | \title{Return a marginal matrix from a BirdFlowR model} 6 | \usage{ 7 | get_marginal(x, marginal = NULL, from = NULL) 8 | } 9 | \arguments{ 10 | \item{x}{A BirdFlow object} 11 | 12 | \item{marginal}{A marginal code, e.g. "M_01-02"} 13 | 14 | \item{from}{The first timestep associated with the marginal. Note marginals 15 | are always forward so the second marginal will be \code{from + 1} or \code{1} (when 16 | \code{from} is the last timestep).} 17 | } 18 | \value{ 19 | A marginal matrix 20 | } 21 | \description{ 22 | Marginals in BirdFlow models are stored such that the cell [i, j] 23 | represents the probability of the bird being in state i in the prior 24 | timestep and state j in the next. Thus the number of rows in the marginal 25 | equals the number of cells within the dynamic mask for the prior timestep 26 | and the columns count is equal to the included cells for the following 27 | timestep. 28 | } 29 | \seealso{ 30 | \code{\link[=lookup_transitions]{lookup_transitions()}} will generate a list of the transitions 31 | needed to predict or route between two points in time. \code{\link[=get_transition]{get_transition()}} 32 | will return a transition matrix - often calculated on the fly from a 33 | marginal. 34 | } 35 | -------------------------------------------------------------------------------- /man/get_mask.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_mask.R 3 | \name{get_mask} 4 | \alias{get_mask} 5 | \title{Extract mask from BirdFlow model} 6 | \usage{ 7 | get_mask(bf, format = "SpatRaster") 8 | } 9 | \arguments{ 10 | \item{bf}{A BirdFlow model} 11 | 12 | \item{format}{One of \code{'SpatRaster'} for a \link[terra:SpatRaster-class]{terra::SpatRaster} object, 13 | \code{'numeric'} for a matrix or array, or\code{'dataframe'} for raster data 14 | suitable for plotting with \code{\link[ggplot2:geom_tile]{ggplot2::geom_raster()}}} 15 | } 16 | \value{ 17 | The return type of \code{get_mask()}depends on the \code{format} argument: 18 | \itemize{ 19 | \item \code{"SpatRaster"} (the default) returns a \link[terra:SpatRaster-class]{terra::SpatRaster} object. 20 | \item \code{"numeric"} returns the mask as a matrix. 21 | \item \code{"dataframe"} will return a data frame suitable for plotting with 22 | \link[ggplot2:geom_tile]{ggplot2::geom_raster} with columns: 23 | \itemize{ 24 | \item \code{row}, \code{col} the row and column indices of each cell. 25 | \item \code{x}, \code{y} the x and y coordinates of the cell center. 26 | \item \code{i} the location index (in \code{bf}) of the cell. 27 | \item \code{mask} \code{TRUE} for cells included in the \emph{model}, \code{FALSE} for excluded 28 | cells. 29 | } 30 | } 31 | } 32 | \description{ 33 | \code{get_mask()} extracts the static mask from a BirdFlow model. The 34 | static mask is a logical raster indicating which cells are included in the 35 | model (at any timestep). These are also the cells (in row major order) 36 | that correspond with distribution values, and location indices. 37 | } 38 | \examples{ 39 | bf <- BirdFlowModels::amewoo 40 | m <- get_mask(bf) 41 | 42 | \dontrun{ 43 | library(terra) 44 | plot(m) 45 | } 46 | 47 | } 48 | -------------------------------------------------------------------------------- /man/get_timestep_padding.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_timestep_padding.R 3 | \name{get_timestep_padding} 4 | \alias{get_timestep_padding} 5 | \title{Internal function to determine how much padding to use with transition 6 | numbers.} 7 | \usage{ 8 | get_timestep_padding(bf) 9 | } 10 | \arguments{ 11 | \item{bf}{} 12 | } 13 | \value{ 14 | An integer indicating how much to pad the numbers in transition 15 | names. 16 | } 17 | \description{ 18 | Return the level of padding that is used with timestep numbers in transition 19 | and marginal names. 20 | } 21 | \details{ 22 | So far (June 2023) in all BirdFlow models the padding used for timesteps in 23 | marginal and transition names has always been 2, as that's what's necessary 24 | to support 52 weeks (e.g. T_01-02) but this has, to date, been determined 25 | from the number of timesteps in the model. The idea was to not constrain 26 | the models to less than 100 transitions if in a hypothetical future we 27 | decided say, to have, 3 day timesteps instead of weekly. 28 | 29 | In June 2023 I added the ability to truncate models (to part of year), and 30 | didn't want to change the level of padding when truncating, so instead 31 | decided to store the padding in \code{metadat$timestep_padding}. 32 | 33 | This function is designed to work with any model regardless of whether the 34 | padding is stored in the metadata. 35 | } 36 | \keyword{internal} 37 | -------------------------------------------------------------------------------- /man/get_transition.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_transition.R 3 | \name{get_transition} 4 | \alias{get_transition} 5 | \title{Return a transition matrix from a BirdFlowR model} 6 | \usage{ 7 | get_transition(x, transition) 8 | } 9 | \arguments{ 10 | \item{x}{A BirdFlow object} 11 | 12 | \item{transition}{A transition code, e.g. "T_01-02"} 13 | } 14 | \value{ 15 | A transition matrix 16 | } 17 | \description{ 18 | This function retrieves a transition matrix from a BirdFlow object, 19 | possibly calculating it from a marginal. 20 | } 21 | \details{ 22 | \code{get_transition()} will construct a transition matrix from the 23 | marginals if \code{x} doesn't have transitions, or return the relevant stored 24 | transition matrix if it does. 25 | 26 | The format for a transition code is "T_[from]-[to]" where [from] and 27 | [to] are timesteps padded with zeros. Direction is important; "T_03-04" 28 | represents a transition backward in time. 29 | 30 | The transition matrices are structured such that you multiply the matrix by 31 | the distribution to project either forward or backwards. If more than one 32 | distribution is projected at once they should be stored in columns of a 33 | matrix with dimensions(\code{\link[=n_active]{n_active()}}, \code{\link[=n_distr]{n_distr()}}). 34 | 35 | Given a marginal in which the cell [i, j] represents the probability of 36 | the bird being in state i in the prior timestep and state j in the next, to 37 | generate the forward transition matrix we divide each row of the marginal 38 | by its sum and then transpose. Backwards transitions matrices are generated 39 | by dividing each column by its sum, without transposing. 40 | } 41 | \seealso{ 42 | \code{\link[=lookup_transitions]{lookup_transitions()}} will generate a list of the transitions 43 | needed to predict or route between two points in time that can then be 44 | passed to this function. The internal function \code{\link[=transition_from_marginal]{transition_from_marginal()}} 45 | does the calculations. 46 | } 47 | -------------------------------------------------------------------------------- /man/great_circle_distance_lonlat_input.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calculate_distance_matrix.R 3 | \name{great_circle_distance_lonlat_input} 4 | \alias{great_circle_distance_lonlat_input} 5 | \title{Calculate the great circle distance based on longitude and latitude} 6 | \usage{ 7 | great_circle_distance_lonlat_input(lat1, lon1, lat2, lon2) 8 | } 9 | \arguments{ 10 | \item{lat1}{latitude of point 1} 11 | 12 | \item{lon1}{longitude of point 1} 13 | 14 | \item{lat2}{latitude of point 2} 15 | 16 | \item{lon2}{longitude of point 2} 17 | } 18 | \value{ 19 | the great circle distance 20 | } 21 | \description{ 22 | Calculate the great circle distance 23 | } 24 | -------------------------------------------------------------------------------- /man/great_circle_distances.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calculate_distance_matrix.R 3 | \name{great_circle_distances} 4 | \alias{great_circle_distances} 5 | \title{Calculate great circle distances among BirdFlow object cells} 6 | \usage{ 7 | great_circle_distances(bf) 8 | } 9 | \arguments{ 10 | \item{bf}{a BirdFlow object} 11 | } 12 | \value{ 13 | a n x n matrix containing pairwise distances in kilometers between 14 | every active cell in the BirdFlow object. 15 | } 16 | \description{ 17 | This function calculates a square, distance matrix with \code{n_active()} cells 18 | on each side. Each cell represents the distance between its 19 | row index and column index treated as locations in the state space; e.g. 20 | The cell \verb{[3, 8]} represents the distance between locations 3 and 8 in the 21 | state space vector. 22 | } 23 | \examples{ 24 | # Calculate great circle distance matrix 25 | library(terra) 26 | bf <- BirdFlowModels::rewbla 27 | gs <- great_circle_distances(bf) 28 | 29 | # The above is all you need to use the function. 30 | # The rest of this is an exercise to visualize the error in CRS distances 31 | 32 | # Compare to euclidean distances in projected CRS space 33 | i <- seq_len(n_active(bf)) 34 | xy <- as.data.frame(i_to_xy(i, bf)) 35 | eu <- as.matrix(dist(xy)) / 1000 # euclidean in CRS (km) 36 | 37 | error_prop <- abs(gs - eu) / gs 38 | error_prop[is.nan(error_prop)] <- 0 39 | 40 | mean_error <- apply(error_prop, 1, mean) # mean error for cell 41 | max_error <- apply(error_prop, 1, max) # max error for cell 42 | 43 | # Calculate maximum error lines for each cell 44 | mel <- data.frame(i1 = 1:n_active(bf), i2 = apply(error_prop, 1, which.max)) 45 | xs <- t(cbind(i_to_x(mel$i1, bf), i_to_x(mel$i2, bf))) 46 | ys <- t(cbind(i_to_y(mel$i1, bf), i_to_y(mel$i2, bf))) 47 | 48 | # Plot maximum error for each cell and a line to the cell where the distance 49 | # had that error. 50 | plot(rasterize_distr(as.numeric(max_error), bf)) 51 | title(main = "Max proportional error") 52 | matlines(xs, ys, col = rgb(0, 0, 0, .25), lty = 1, lwd = 1) 53 | mtext(paste0( 54 | "lines connect cells to the cell which have greatest", 55 | " proportional error in distance" 56 | ), line = 0, cex = 0.7) 57 | } 58 | \keyword{internal} 59 | -------------------------------------------------------------------------------- /man/has.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/has.R 3 | \name{has} 4 | \alias{has} 5 | \alias{has_marginals} 6 | \alias{has_transitions} 7 | \alias{has_distr} 8 | \alias{has_dynamic_mask} 9 | \title{Does a BirdFlow object have certain components} 10 | \usage{ 11 | has_marginals(x) 12 | 13 | has_transitions(x) 14 | 15 | has_distr(x) 16 | 17 | has_dynamic_mask(x) 18 | } 19 | \arguments{ 20 | \item{x}{A BirdFlow model} 21 | } 22 | \value{ 23 | Logical indicating the BirdFlow model has the relevant element 24 | } 25 | \description{ 26 | These functions return information about the contents of a 27 | BirdFlow object. 28 | } 29 | -------------------------------------------------------------------------------- /man/import_birdflow_v3.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/import_birdflow_v3.R 3 | \name{import_birdflow_v3} 4 | \alias{import_birdflow_v3} 5 | \title{import BirdFlow model from an hdf5 file} 6 | \usage{ 7 | import_birdflow_v3(hdf5) 8 | } 9 | \arguments{ 10 | \item{hdf5}{Path to an HDF5 file} 11 | } 12 | \value{ 13 | a BirdFlow object 14 | } 15 | \description{ 16 | This function imports a BirdFlow model data from an HDF5 file written by 17 | python. It works for version 2 hdf5. 18 | } 19 | \keyword{internal} 20 | -------------------------------------------------------------------------------- /man/load_collection_index.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/load_collection_index.R 3 | \name{load_collection_index} 4 | \alias{load_collection_index} 5 | \title{Load the index to a remote model collection} 6 | \usage{ 7 | load_collection_index( 8 | update = TRUE, 9 | collection_url = birdflow_options("collection_url") 10 | ) 11 | } 12 | \arguments{ 13 | \item{update}{If \code{TRUE} (the default) then both the index and cached model 14 | file are checked against the server's version to make sure they are 15 | up-to-date and downloaded again if they are not. 16 | If \code{FALSE} then neither the index nor the model will be checked. 17 | Set to \code{FALSE} after downloading the model(s) you need if you want to make 18 | sure the model does not change during your analysis (even if updated on 19 | the server); or if working offline.} 20 | 21 | \item{collection_url}{The url of a collection. Should be the path to 22 | the base directory (not an index.html file).} 23 | } 24 | \value{ 25 | A data frame with a row for every model in the collection. 26 | } 27 | \description{ 28 | Load the collection index for the current model collection. This function 29 | will return an up-to-date index for the current BirdFlow collection. It 30 | caches the index locally and will update the cached version if it is not 31 | up-to-date. 32 | } 33 | \details{ 34 | The collection will default to the main BirdFlow model collection and most 35 | users will not need to set it. 36 | 37 | The local cache directory (for all collections) defaults to 38 | \href{birdflow_otions()}{birdflow_options("cache")} the cache directory for the 39 | current collection will be in a subdirectory. Both of the above options 40 | can be changed for the duration of the session with \code{\link[=birdflow_options]{birdflow_options()}}, 41 | but the defaults should be suitable for most users. 42 | } 43 | -------------------------------------------------------------------------------- /man/load_model.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/load_model.R 3 | \name{load_model} 4 | \alias{load_model} 5 | \title{Load BirdFlow models from a collection} 6 | \usage{ 7 | load_model( 8 | model, 9 | update = TRUE, 10 | collection_url = birdflow_options("collection_url"), 11 | timeout = 600 12 | ) 13 | } 14 | \arguments{ 15 | \item{model}{The model name to load.} 16 | 17 | \item{update}{If \code{TRUE} (the default) then both the index and cached model 18 | file are checked against the server's version to make sure they are 19 | up-to-date and downloaded again if they are not. 20 | If \code{FALSE} then neither the index nor the model will be checked. 21 | Set to \code{FALSE} after downloading the model(s) you need if you want to make 22 | sure the model does not change during your analysis (even if updated on 23 | the server); or if working offline.} 24 | 25 | \item{collection_url}{The url of a collection. Should be the path to 26 | the base directory (not an index.html file).} 27 | 28 | \item{timeout}{The number of seconds to allow for downloading. The default 29 | is 600 (ten minutes).} 30 | } 31 | \value{ 32 | The designated BirdFlow model is returned. 33 | } 34 | \description{ 35 | Load a named model from the current (likely the default) model collection. 36 | If the model doesn't exist in the local cache or isn't up-to-date the the 37 | cache will be updated prior to loading. 38 | } 39 | \examples{ 40 | \dontrun{ 41 | 42 | index <- load_collection_index() 43 | bf <- load_model(index$model[1]) 44 | 45 | } 46 | 47 | } 48 | \seealso{ 49 | \code{\link[=load_collection_index]{load_collection_index()}} 50 | } 51 | -------------------------------------------------------------------------------- /man/lookup_date.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lookup_date.R 3 | \name{lookup_date} 4 | \alias{lookup_date} 5 | \title{Retrieve date associated with timesteps, transitions, or marginals} 6 | \usage{ 7 | lookup_date(x, bf, timestep = NULL) 8 | } 9 | \arguments{ 10 | \item{x}{A vector of one of the following formats: 11 | \enumerate{ 12 | \item Integer between 1 and \code{n_timesteps(bf)} representing timestep. 13 | \item Character with "T" followed by digits that indicate timesteps, 14 | (this format is used internally to label timestep dimensions of objects) 15 | \item Marginal or Transition names. These start with either "T_" or "M_", and 16 | then have two timesteps represented by digits and separated by a dash, 17 | E.g. "T_01-02". 18 | }} 19 | 20 | \item{bf}{A BirdFlow object} 21 | 22 | \item{timestep}{Deprecated alternative to \code{x}. Previous versions of 23 | \code{lookup_dates()} only supported timestep input and used \code{timestep} as 24 | the first argument.} 25 | } 26 | \value{ 27 | A Date object 28 | } 29 | \description{ 30 | Retrieve date associated with timesteps, transitions, or marginals 31 | } 32 | \examples{ 33 | bf <- BirdFlowModels::amewoo 34 | lookup_date(1:5, bf) 35 | } 36 | \seealso{ 37 | \code{\link[=get_dates]{get_dates()}}, \code{\link[=lookup_timestep]{lookup_timestep()}}, \code{\link[=lookup_timestep_sequence]{lookup_timestep_sequence()}} 38 | } 39 | -------------------------------------------------------------------------------- /man/lookup_season_timesteps.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lookup_timestep_sequence.R 3 | \name{lookup_season_timesteps} 4 | \alias{lookup_season_timesteps} 5 | \title{Lookup breeding, non-breeding, or migration season timesteps} 6 | \usage{ 7 | lookup_season_timesteps(x, season, season_buffer = 1) 8 | } 9 | \arguments{ 10 | \item{x}{a BirdFlow object} 11 | 12 | \item{season}{one of the seasons 13 | returned by \code{\link[=species_info]{species_info()}}, a season alias, or or \code{"all"} 14 | for all timesteps in the model} 15 | 16 | \item{season_buffer}{the number of extra timesteps to add to the beginning 17 | and end of the season.} 18 | } 19 | \value{ 20 | a series of integers indicating which timesteps correspond with the 21 | (possibly buffered) season. 22 | } 23 | \description{ 24 | Retrieve the timesteps associated with a season for the species modeled by 25 | a BirdFlow object, possibly with a buffer (in timesteps) added on. Seasons 26 | dates are from \link[ebirdst:ebirdst_runs]{ebirdst::ebirdst_runs} and are directly accessible 27 | with \code{\link[=species_info]{species_info()}}. 28 | } 29 | \section{Season names and aliases}{ 30 | 31 | 32 | \code{season} can be \code{'all'}, one of the the four seasons, or an 33 | alias listed below.\tabular{ll}{ 34 | \strong{season} \tab \strong{aliases} \cr 35 | \code{prebreeding_migration} \tab \code{pre}, \code{prebreeding}, \code{spring} \cr 36 | \code{breeding} \tab \code{breed}, \code{summer} \cr 37 | \code{postbreeding_migration} \tab \code{post}, \code{postbreeding}, \code{fall} \cr 38 | \code{nonbreeding} \tab \code{non}, \code{winter} \cr 39 | } 40 | } 41 | 42 | \examples{ 43 | bf <- BirdFlowModels::rewbla 44 | lookup_season_timesteps(bf, "breeding", season_buffer = 0) 45 | 46 | } 47 | -------------------------------------------------------------------------------- /man/lookup_species_metadata.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lookup_species_metadata.R 3 | \name{lookup_species_metadata} 4 | \alias{lookup_species_metadata} 5 | \title{Lookup eBird species metadata} 6 | \usage{ 7 | lookup_species_metadata( 8 | species, 9 | skip_checks = FALSE, 10 | min_season_quality = 3, 11 | quiet = FALSE 12 | ) 13 | } 14 | \arguments{ 15 | \item{species}{An eBird species code, common name, or scientific name. It 16 | will be processed by \code{\link[ebirdst:get_species]{ebirdst::get_species()}}.} 17 | 18 | \item{skip_checks}{Set to \code{TRUE} to skip the checks for eBird model quality 19 | and for migrant status. Defaults to \code{TRUE} - do the tests.} 20 | 21 | \item{min_season_quality}{If \code{skip_checks = FALSE} and the model 22 | quality for any of the four seasons drops below this threshold an error 23 | is thrown.} 24 | 25 | \item{quiet}{Set to \code{TRUE} to suppress messages.} 26 | } 27 | \value{ 28 | A list of species information derived from ebirdst. 29 | See \code{\link[=species_info]{species_info()}} for a description of the items. 30 | } 31 | \description{ 32 | \code{lookup_species_metadata()} uses \pkg{ebirdst} to generate 33 | a list identical to the \code{species} component of a BirdFlow model. 34 | It is an internal function used by \code{\link[=preprocess_species]{preprocess_species()}} and \code{\link[=Routes]{Routes()}}. 35 | See \code{\link[=species_info]{species_info()}} for a description of the list items. 36 | } 37 | \seealso{ 38 | \itemize{ 39 | \item \code{\link[=species]{species()}} and \code{\link[=species_info]{species_info()}} for getting species information 40 | from a BirdFlow model. 41 | \item \code{\link[ebirdst:get_species]{ebirdst::get_species()}} to resolve a species name or code. 42 | \item \link[ebirdst:ebirdst_runs]{ebirdst::ebirdst_runs} for the source of the information. 43 | } 44 | } 45 | \keyword{internal} 46 | -------------------------------------------------------------------------------- /man/lookup_timestep.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lookup_timestep.R 3 | \name{lookup_timestep} 4 | \alias{lookup_timestep} 5 | \title{Lookup timestep} 6 | \usage{ 7 | lookup_timestep(x, bf, allow_failure = FALSE) 8 | } 9 | \arguments{ 10 | \item{x}{A character object representing date as year-month-day e.g. 11 | "2023-03-29", date object (\code{\link[base:Dates]{Date}}, 12 | \code{\link[base:DateTimeClasses]{POSIXct}}, or \code{\link[base:DateTimeClasses]{POSIXlt}}), 13 | a numeric timestep, a character representing a timestep e.g. "t1", or "all" 14 | for all timesteps in the model.} 15 | 16 | \item{bf}{A BirdFlow object.} 17 | 18 | \item{allow_failure}{If TRUE function will return NA values when it fails 19 | to resolve a timestep for any element of \code{x}. With the default, FALSE, 20 | the function will throw an error if not all elements of \code{x} are resolved 21 | to timesteps.} 22 | } 23 | \value{ 24 | A vector of timesteps corresponding to elements in \code{x}. 25 | } 26 | \description{ 27 | This function returns the timestep or timesteps associated with \code{x} in a 28 | particular BirdFlow model, where \code{x} represents dates or timesteps in 29 | various formats. 30 | } 31 | \details{ 32 | So far all BirdFlow objects have had timesteps corresponding with weeks of 33 | the year and matching the S&T timesteps. However, it is likely that 34 | we will add the ability to make BirdFlow objects that only model part of the 35 | year. If we do this the timestep values will not necessarily match weeks. 36 | For example a model that covers Week 6, to 20 would have timesteps from 1 37 | to 15. 38 | 39 | If \code{x} is numeric it is assumed to already be a timestep. This is useful 40 | when using this function internally to resolve arguments to other 41 | functions like \code{\link[=route]{route()}}, \code{\link[=predict]{predict()}}, and \code{\link[=get_distr]{get_distr()}}. 42 | } 43 | \examples{ 44 | bf <- BirdFlowModels::amewoo 45 | lookup_timestep(c("2001-3-23", "2022-12-05"), bf) 46 | 47 | } 48 | -------------------------------------------------------------------------------- /man/make_cache_readme.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/make_cache_readme.R 3 | \name{make_cache_readme} 4 | \alias{make_cache_readme} 5 | \title{Internal function to create or update readme files within the local 6 | BirdFlow model cache.} 7 | \usage{ 8 | make_cache_readme(collection_url = birdflow_options("collection_url")) 9 | } 10 | \value{ 11 | Nothing is returned 12 | } 13 | \description{ 14 | This is called anytime new files are downloaded to the cache by 15 | \code{\link[=load_collection_index]{load_collection_index()}} or \code{\link[=load_model]{load_model()}}. 16 | } 17 | \keyword{internal} 18 | -------------------------------------------------------------------------------- /man/make_dates.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/make_dates.R 3 | \name{make_dates} 4 | \alias{make_dates} 5 | \title{Internal function to make the dates component of a BirdFlow model} 6 | \usage{ 7 | make_dates(version_year = NULL) 8 | } 9 | \arguments{ 10 | \item{version_year}{leave NULL for typical usage. Set to 11 | a eBird version year to override. Used by \code{switch_date_format()}. 12 | version_year < 2021 will yield old date format.} 13 | } 14 | \value{ 15 | Dates table appropriate for the current version of \pkg{ebirdst} 16 | } 17 | \description{ 18 | Called from \link{preprocess_species} and not intended for other use. 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /man/make_marginal_index.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/make_marginal_index.R 3 | \name{make_marginal_index} 4 | \alias{make_marginal_index} 5 | \title{Internal function to make a marginal index for a BirdFlow object.} 6 | \usage{ 7 | make_marginal_index(bf) 8 | } 9 | \arguments{ 10 | \item{bf}{A BirdFlow object} 11 | } 12 | \value{ 13 | A data.frame that facilitates looking up marginals from transition 14 | names. It has columns: 15 | \item{from}{starting timestep for transition (direction matters)} 16 | \item{to}{ending timestep for transition} 17 | \item{direction}{transition direction, either "forward", or "backward"} 18 | \item{transition}{transition name e.g. "T_02-02"} 19 | \item{marginal}{marginal name e.g. "M_01-02", order matches 20 | forward transition order, so smaller number is generally first 21 | except with the last marginal in a circular model e.g. "M_52-01"} 22 | } 23 | \description{ 24 | \code{make_marginal_index()} is called by \verb{[import_birdflow()]} 25 | and \code{truncate_birdflow()} to add a marginal index to a BirdFlow object. 26 | } 27 | \details{ 28 | \code{\link[=n_transitions]{n_transitions()}}, \code{\link[=n_timesteps]{n_timesteps()}}, \code{\link[=is_cyclical]{is_cyclical()}}, and 29 | \code{\link[=get_timestep_padding]{get_timestep_padding()}} need to work on the object, which means that 30 | \code{metadata$n_timesteps}, \code{metatdata$n_transitions}, and 31 | \code{metadata$timestep_padding} should all be properly set. 32 | The marginals don't have to exist yet. 33 | } 34 | \keyword{internal} 35 | -------------------------------------------------------------------------------- /man/make_mask.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/make_mask.R 3 | \name{make_mask} 4 | \alias{make_mask} 5 | \title{Internal function to determine the extent of data in eBird rasters.} 6 | \usage{ 7 | make_mask(x, count = FALSE, assume_no_na = FALSE) 8 | } 9 | \arguments{ 10 | \item{x}{A SpatRaster, typically it's multilayered and contains the 11 | distribution of a species over time.} 12 | 13 | \item{count}{If TRUE the returned value will be the count of non-zero cells 14 | at the raster location (across timesteps). 15 | Otherwise a logical is returned, with TRUE to indicate any non-zero value.} 16 | 17 | \item{assume_no_na}{Set to TRUE if there aren't any NA values in the raster 18 | for a slight efficiency improvement.} 19 | } 20 | \value{ 21 | A single layer SpatRaster with the same CRS, alignment, and 22 | resolution as \code{x}; cropped to the extent of the data in \code{x}. With 23 | \code{count = FALSE} the result is a logical that is \code{TRUE} if there are non-zero 24 | cells in any layer in \code{x} and \code{FALSE} otherwise. With \code{count = TRUE} the 25 | result is an integer with a count of the number of timesteps in which the 26 | cell appears (0 to 52 given weekly steps). 27 | } 28 | \description{ 29 | This function returns a logical single layer SpatRaster 30 | which is \code{TRUE} if \code{x} has non-zero values in any layer. 31 | \code{NA} does not count as non-zero. The result is cropped to the extent of the 32 | data in \code{x}. It's used in BirdFlowR to preprocess data. 33 | } 34 | \details{ 35 | \code{make_mask} is a private function. 36 | } 37 | \keyword{internal} 38 | -------------------------------------------------------------------------------- /man/make_pyear_breaks.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/make_pyear_breaks.R 3 | \name{make_pyear_breaks} 4 | \alias{make_pyear_breaks} 5 | \title{Generate breakpoints in proportion of year values that correspond to nice 6 | dates} 7 | \usage{ 8 | make_pyear_breaks(range, dates, target_n = 8, hpy = TRUE) 9 | } 10 | \arguments{ 11 | \item{range}{A range in proportion of year (PY) or half proportion of year 12 | (HPY) values over which breaks will be calculated.} 13 | 14 | \item{dates}{A dates table as generated by \code{\link[=get_dates]{get_dates()}}} 15 | 16 | \item{target_n}{The target number of breaks} 17 | 18 | \item{hpy}{if \code{TRUE} than treat range as HPY. If FALSE as PY.} 19 | } 20 | \value{ 21 | a sequence of break points in PY or HPY units. 22 | } 23 | \description{ 24 | This internal function is used by \code{\link[=plot_routes]{plot_routes()}} to determine where to 25 | set the breaks (labels) in the color scale. The color corresponds to dates 26 | represented as a proportion of the year. This functions picks breaks that 27 | map to quarters of the year, the first of the month, the first and fifteenth 28 | of the month, or eBird S&T nominal weeks. Choosing from the above based on 29 | which method is closest to the target number of breaks (\code{target_n}). 30 | } 31 | \keyword{internal} 32 | -------------------------------------------------------------------------------- /man/marginal_stats.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/marginal_stats.R 3 | \name{marginal_stats} 4 | \alias{marginal_stats} 5 | \alias{sum_marginals} 6 | \alias{calc_pct_zero} 7 | \title{marginal statistics} 8 | \usage{ 9 | marginal_stats(bf) 10 | 11 | sum_marginals(bf) 12 | 13 | calc_pct_zero(bf) 14 | } 15 | \arguments{ 16 | \item{bf}{A BirdFlow model.} 17 | } 18 | \value{ 19 | \code{marginal_stats()} returns a list with 20 | \item{sum}{the sum of all the marginals} 21 | \item{pct_zero}{the percent of the values across all marginals that are 22 | zero.} 23 | 24 | \code{sum_marginals()} returns the sum of all marginals. 25 | 26 | \code{calc_pct_zero()} returns the percent of marginal values that are 27 | zero 28 | } 29 | \description{ 30 | Internal functions to calculate the sum of all marginals and the 31 | percent of marginal values that are zero. 32 | } 33 | \details{ 34 | These are used by sparsify and fix_dead_ends. marginal_stats is slightly 35 | more efficient than calling the other two functions independently. 36 | } 37 | \keyword{internal} 38 | -------------------------------------------------------------------------------- /man/new_BirdFlow.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/new_birdflow.R 3 | \name{new_BirdFlow} 4 | \alias{new_BirdFlow} 5 | \title{Private function to create the empty shell of a BirdFlow object} 6 | \usage{ 7 | new_BirdFlow() 8 | } 9 | \value{ 10 | An empty BirdFlow object 11 | } 12 | \description{ 13 | Private function to create the empty shell of a BirdFlow object 14 | } 15 | \keyword{internal} 16 | -------------------------------------------------------------------------------- /man/pad_timestep.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pad_timestep.R 3 | \name{pad_timestep} 4 | \alias{pad_timestep} 5 | \title{pad timesteps from BirdFlow models} 6 | \usage{ 7 | pad_timestep(x, bf) 8 | } 9 | \arguments{ 10 | \item{x}{A vector of timestep integers} 11 | 12 | \item{bf}{A BirdFlow model} 13 | } 14 | \value{ 15 | a string with padded versions of x; \code{1} becomes \code{"01"}. 16 | } 17 | \description{ 18 | This function is mostly for internal use but exported for advanced users. 19 | It's primary purpose is to pad timesteps with zeros for looking up 20 | transition names. It is called from \code{\link[=lookup_transitions]{lookup_transitions()}} which is in 21 | turn used by \code{\link[=get_transition]{get_transition()}}. Padding is generally two digit but the 22 | level of padding is stored in the BirdFlow object so that we'll 23 | be able to switch to three digit timesteps easily if, for example, 24 | someday we decide to have daily timesteps. 25 | } 26 | \examples{ 27 | bf <- BirdFlowModels::amewoo 28 | pad_timestep(1:5, bf) 29 | } 30 | \keyword{internal} 31 | -------------------------------------------------------------------------------- /man/plot_loss.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_loss.R 3 | \name{plot_loss} 4 | \alias{plot_loss} 5 | \title{Plot changes in component and total loss during model fitting} 6 | \usage{ 7 | plot_loss(bf, transform = "log10") 8 | } 9 | \arguments{ 10 | \item{bf}{A fitted Bird Flow model} 11 | 12 | \item{transform}{Passed to \code{\link[ggplot2:scale_continuous]{ggplot2::scale_y_continuous()}} to set the y-axis 13 | transformation. Reasonable values for this function include 14 | "identity", "log", "log10", "log2", and "sqrt".} 15 | } 16 | \value{ 17 | a \strong{ggplot2} plot object. 18 | } 19 | \description{ 20 | Model fitting - in \url{BirdFlowPy} - attempts to minimize the total weighted 21 | loss. This plot shows four lines: 22 | \itemize{ 23 | \item \strong{Total loss} is the weighted sum of the three loss components. The 24 | weighting may cause it to be lower than some of the components. 25 | \item \strong{Observation loss} captures how well the model predicts the Status and 26 | Trend distributions it was trained on. Its weight is always set to 1 and its 27 | relative weight is changed by adjusting the other to weights which are 28 | usually much less than 1. 29 | \item \strong{Distance loss} is lower when the routes encoded in the model are 30 | shorter. 31 | \item \strong{Entropy loss} is lower when the entropy in the model is higher. 32 | } 33 | } 34 | \examples{ 35 | bf <- BirdFlowModels::amewoo 36 | plot_loss(bf) 37 | } 38 | -------------------------------------------------------------------------------- /man/plot_movement_vectors.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_movement_vectors.R 3 | \name{plot_movement_vectors} 4 | \alias{plot_movement_vectors} 5 | \title{Plot bird movement vectors} 6 | \usage{ 7 | plot_movement_vectors(bf, start = 1, direction = "forward", mv) 8 | } 9 | \arguments{ 10 | \item{bf}{a BirdFlow object} 11 | 12 | \item{start}{The starting timestep for the transition to be modeled} 13 | 14 | \item{direction}{"Forward" by default. Set to "backward" to calculate 15 | vectors for a transition backwards in time.} 16 | 17 | \item{mv}{This is optional and primarily for internal use by 18 | \code{\link[=animate_movement_vectors]{animate_movement_vectors()}} it allows explicitly providing movement vectors 19 | as a data frame, in which case \code{start} and \code{direction} are ignored.} 20 | } 21 | \value{ 22 | an object that inherits classes \code{gg} and \code{ggplot} it can be plotted 23 | with \code{print()}. 24 | } 25 | \description{ 26 | This plots the mean movement out of every cell in a BirdFlow model for a 27 | given starting time, based on the transition probabilities for the following 28 | transition. Each arrow starts in a cell center and ends at the average 29 | location projected for Birds from that cell. The line width and alpha 30 | (transparency) are set such that arrows have more visual weight if there 31 | is a higher probability of a bird being at the starting location and time. 32 | } 33 | \details{ 34 | Importantly, this is a visual representation of the transitions encoded in 35 | the model, not of the average movement of a bird through a given cell at a 36 | given point in time, which would involve both the birds starting at that 37 | cell and birds passing through it from other starting locations. 38 | } 39 | \examples{ 40 | bf <- BirdFlowModels::amewoo 41 | plot_movement_vectors(bf, start = 7) 42 | 43 | 44 | } 45 | \seealso{ 46 | \itemize{ 47 | \item \code{\link[=calc_movement_vectors]{calc_movement_vectors()}} for the vector calculations. 48 | \item \code{\link[=animate_movement_vectors]{animate_movement_vectors()}} to produce animations of the vectors over 49 | time. 50 | } 51 | } 52 | -------------------------------------------------------------------------------- /man/predict_params.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calc_abundance_stats.R 3 | \name{predict_params} 4 | \alias{predict_params} 5 | \title{predict the number of parameters based on resolution} 6 | \usage{ 7 | predict_params(a_stats, res, adjustment = 0.4) 8 | } 9 | \arguments{ 10 | \item{a_stats}{output from \code{calc_abundance_stats()} the only used component 11 | is \code{area} which is a vector of area in square meters in the unmasked cells 12 | for each timestep.} 13 | 14 | \item{res}{the cell (presumed square) resolution in km.} 15 | 16 | \item{adjustment}{This is used} 17 | } 18 | \value{ 19 | The estimated number of parameters given a resolution of \code{res} 20 | } 21 | \description{ 22 | This function is called by \code{\link[=preprocess_species]{preprocess_species()}} to predicts how many 23 | parameters the model is likely to have at a different resolution 24 | given a set of stats on the number of cells and their area for each 25 | timestep at the current resolution, calculated by \code{calc_abundance_stats()} 26 | } 27 | \details{ 28 | \code{predict_params()} calculates a preliminary estimate based on the inaccurate 29 | assumption that the area covered by cells will be the same at the two 30 | resolutions. However, when changing the resolution not all of the fine cells 31 | underlying occupied coarse cells are occupied thus when increasing the 32 | resolution the number of cells are underestimated and when decreasing the 33 | resolution they will be overestimated. The amount of bias depends on the 34 | configuration of occupied cells with more fragmented occupied areas resulting 35 | in greater bias. 36 | 37 | \code{adjustment} allows compensating for this bias. \code{adjustment} is multiplied by 38 | both the proportional change in resolution: (res2 - res1)/res1 and by the 39 | initial area based estimate and the (possibly negative) result is added 40 | to the area based estimate. 41 | 42 | For example if you are doubling the resolution the proportional change is 1 43 | and with an adjustment of 0.35 you end up adding 35\% to the initial 44 | estimate. 45 | 46 | Conversely if you are halving the resolution the proportional change is -.5 47 | and you end up subtracting 17.5\% from the estimate. 48 | } 49 | \keyword{internal} 50 | -------------------------------------------------------------------------------- /man/print.BirdFlow.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print.R 3 | \name{print.BirdFlow} 4 | \alias{print.BirdFlow} 5 | \title{Print BirdFlow models} 6 | \usage{ 7 | \method{print}{BirdFlow}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{A BirdFlow object.} 11 | 12 | \item{...}{arguments passed from other methods} 13 | } 14 | \value{ 15 | \code{x} returned invisibly and unchanged. 16 | } 17 | \description{ 18 | This is a print method for BirdFlow objects. 19 | } 20 | -------------------------------------------------------------------------------- /man/print.BirdFlowIntervals.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print.BirdFlowIntervals.R 3 | \name{print.BirdFlowIntervals} 4 | \alias{print.BirdFlowIntervals} 5 | \title{Print a \code{BirdFlowIntervals} Object} 6 | \usage{ 7 | \method{print}{BirdFlowIntervals}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{A \code{BirdFlowIntervals} object to print.} 11 | 12 | \item{...}{other arguments not used by this method.} 13 | } 14 | \value{ 15 | Invisibly returns the input \code{birdflow_intervals} object. 16 | } 17 | \description{ 18 | Print method for \code{BirdFlowIntervals} objects, 19 | summarizing interval data 20 | and metadata, including temporal and spatial ranges. 21 | } 22 | \examples{ 23 | # Create a BirdFlowIntervals object 24 | interval_df <- data.frame( 25 | interval_id = 1:3, 26 | route_id = c("route1", "route1", "route2"), 27 | lon1 = c(-90, -89, -88), 28 | lon2 = c(-89, -88, -87), 29 | lat1 = c(40, 41, 42), 30 | lat2 = c(41, 42, 43), 31 | x1 = c(1000, 1100, 1200), 32 | x2 = c(1100, 1200, 1300), 33 | y1 = c(500, 600, 700), 34 | y2 = c(600, 700, 800), 35 | i1 = as.integer(c(1, 2, 3)), 36 | i2 = as.integer(c(2, 3, 4)), 37 | date1 = as.Date(c("2024-01-01", "2024-01-02", "2024-01-03")), 38 | date2 = as.Date(c("2024-01-02", "2024-01-03", "2024-01-04")), 39 | timestep1 = as.integer(c(1, 2, 3)), 40 | timestep2 = as.integer(c(2, 3, 4)), 41 | route_type = c("tracking", "tracking", "banding") 42 | ) 43 | bf <- BirdFlowModels::amewoo 44 | birdflow_intervals <- BirdFlowIntervals(interval_df, 45 | species = bf$species, 46 | metadata = NULL, geom = bf$geom, dates = get_dates(bf) 47 | ) 48 | 49 | print(birdflow_intervals) 50 | 51 | } 52 | -------------------------------------------------------------------------------- /man/print.Routes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print.Routes.R 3 | \name{print.Routes} 4 | \alias{print.Routes} 5 | \alias{print.BirdFlowRoutes} 6 | \title{Print Routes and BirdFlowRoutes objects} 7 | \usage{ 8 | \method{print}{Routes}(x, ...) 9 | } 10 | \arguments{ 11 | \item{x}{A \code{Routes} or \code{BirdFlowRoutes} object to print.} 12 | 13 | \item{...}{other arguments not used by this method.} 14 | } 15 | \value{ 16 | Invisibly returns the input object. 17 | } 18 | \description{ 19 | Print a summary of a \code{Routes} and \code{BirdFlowRoutes} objects 20 | } 21 | \examples{ 22 | # Create a Routes object 23 | route_df <- data.frame( 24 | route_id = c("001", "001", "001", "001", "001", 25 | "003", "003", "003", "004"), 26 | date = as.Date(c("2025-01-01", "2025-01-08", "2025-01-15", "2025-01-21", 27 | "2025-02-10", "2025-03-01", "2025-05-01", "2025-06-01", "2025-05-01")), 28 | lon = c(-75.0060, -75.0060, -74.0060, -87.6298, -87.6298, -87.6298, 29 | -89.6298, -85.6298, -95.3698), 30 | lat = c(39.7128, 39.7128, 40.7128, 41.8781, 41.8781, 41.8781, 31 | 42.8781, 40.8781, 29.7604), 32 | route_type = c("tracking", "tracking", "tracking", "tracking", 33 | "tracking", "motus", "motus", "motus", "motus") 34 | ) 35 | routes <- Routes(route_df, species = list(common_name = "American Woodcock")) 36 | 37 | print(routes) 38 | 39 | # BirdFlowRoutes 40 | bf <- BirdFlowModels::amewoo 41 | bf_routes <- as_BirdFlowRoutes(routes, bf) 42 | 43 | } 44 | -------------------------------------------------------------------------------- /man/print_type_breakdown.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print.Routes.R 3 | \name{print_type_breakdown} 4 | \alias{print_type_breakdown} 5 | \title{Print summary of route types, their count, and number of points} 6 | \usage{ 7 | print_type_breakdown(x, crossline) 8 | } 9 | \arguments{ 10 | \item{x}{A \code{Routes}, \code{BirdFlowROutes} or \code{BirdFlowIntervals} object.} 11 | 12 | \item{crossline}{Characters to be printed after printing the summary} 13 | } 14 | \value{ 15 | invisibly returns the table 16 | } 17 | \description{ 18 | This internal helper function is for use in the print methods for the 19 | route and interval data classes. 20 | } 21 | \details{ 22 | It only prints the breakdown of routes by type if there is more than one type 23 | of route in \code{x}. When there's only one type the output would be redundant. 24 | } 25 | \keyword{internal} 26 | -------------------------------------------------------------------------------- /man/read_geom.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/read_geom.R 3 | \name{read_geom} 4 | \alias{read_geom} 5 | \title{Read geom component of a BirdFlow hdf5} 6 | \usage{ 7 | read_geom(hdf5) 8 | } 9 | \arguments{ 10 | \item{hdf5}{the path to an hdf5 file} 11 | } 12 | \value{ 13 | The geom component of a birdflow model 14 | } 15 | \description{ 16 | This internal function is called by \code{\link[=import_birdflow]{import_birdflow()}} and 17 | \code{\link[=extend_birdflow]{extend_birdflow()}} to read and format the geom component of the model 18 | } 19 | -------------------------------------------------------------------------------- /man/reformat_distr_labels.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/reformat_distr_labels.R 3 | \name{reformat_distr_labels} 4 | \alias{reformat_distr_labels} 5 | \title{reformat distr time labels based on birdflow_options("time_format")} 6 | \usage{ 7 | reformat_distr_labels(x, bf) 8 | } 9 | \arguments{ 10 | \item{x}{An object containing bird distributions} 11 | 12 | \item{bf}{A BirdFlow object (used for its date information)} 13 | } 14 | \value{ 15 | \code{x} with (potentially) new labels 16 | } 17 | \description{ 18 | This is an internal function to change the labels of an object containing 19 | distributions to match the time format the user has specified in the global 20 | options. Internally distributions are stored and generated with labels 21 | based on timestep ("t1" etc.). 22 | } 23 | \details{ 24 | As of March 15, 2023 I'm experimenting with adding an attribute "time" to a 25 | vector distribution to keep track of the time label. 26 | 27 | If there are more than one distribution they are stored as a matrix and 28 | the colnames store the time associated with each distribution. 29 | 30 | This function currently returns the input object as is if it cannot resolve 31 | labels. 32 | } 33 | \keyword{internal} 34 | -------------------------------------------------------------------------------- /man/reformat_timestep.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/reformat_timestep.R 3 | \name{reformat_timestep} 4 | \alias{reformat_timestep} 5 | \title{reformat timestep labels} 6 | \usage{ 7 | reformat_timestep(x, bf) 8 | } 9 | \arguments{ 10 | \item{x}{one (vector) or more (matrix) distributions, with column labels 11 | consisting of a "t" and the timestep.} 12 | 13 | \item{bf}{A BirdFlow object} 14 | } 15 | \value{ 16 | x with update column labels, as dictated by 17 | \link[=birdflow_options]{birdflow_options("time_format")} 18 | } 19 | \description{ 20 | given a vector of timestep labels provide a vector of formatted labels based 21 | on the value of \link[=birdflow_options]{birdflow_options("time_format")} (see 22 | that function for options.) 23 | } 24 | \details{ 25 | Internally distributions are labeled with "t" and the timestep integer. 26 | When returning them to the user \code{\link[=reformat_distr_labels]{reformat_distr_labels()}} is called to change 27 | the format which in turn calls this function. 28 | } 29 | \keyword{internal} 30 | -------------------------------------------------------------------------------- /man/reset_index.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Routes-internal.R 3 | \name{reset_index} 4 | \alias{reset_index} 5 | \title{Reset Route Indices} 6 | \usage{ 7 | reset_index(routes) 8 | } 9 | \arguments{ 10 | \item{routes}{A \code{Routes} or data frame object.} 11 | } 12 | \value{ 13 | A data frame with updated route IDs. 14 | } 15 | \description{ 16 | Resets the route IDs in a \code{Routes} 17 | object to a new sequential numbering. 18 | } 19 | \keyword{internal} 20 | -------------------------------------------------------------------------------- /man/shrink_birdflow.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/shrink_birdflow.R 3 | \name{shrink_birdflow} 4 | \alias{shrink_birdflow} 5 | \title{Shrink BirdFlow extent} 6 | \usage{ 7 | shrink_birdflow(x) 8 | } 9 | \arguments{ 10 | \item{x}{A single BirdFlow object, or one or more paths to BirdFlow objects 11 | stored as either hdf5 or rds files.} 12 | } 13 | \value{ 14 | If \code{x} is an extended BirdFlow model, see \code{\link[=extend_birdflow]{extend_birdflow()}}\code{than}shrink_birdflow()` returns the same model with its original extent. 15 | 16 | If \code{x} is the path to one or more BirdFlow models than those files are 17 | shrunk to their original extent and a logical vector of the 18 | same length is returned with TRUE for success. 19 | } 20 | \description{ 21 | Shrink BirdFlow extent 22 | } 23 | \examples{ 24 | bf <- BirdFlowModels::amewoo 25 | 26 | # Define extended extent for example 27 | e <- ext(bf) 28 | buffer <- 3 * res(bf) 29 | e[1] <- e[1] - buffer[1] 30 | e[2] <- e[2] + buffer[1] 31 | e[3] <- e[3] - buffer[2] 32 | e[4] <- e[4] + buffer[2] 33 | 34 | bf2 <- extend_birdflow(bf, e) 35 | 36 | bf3 <- shrink_birdflow(bf2) 37 | 38 | # Compare extents 39 | data.frame(item = names(as.vector(ext(bf))), 40 | initial = as.vector(ext(bf)), 41 | extended = as.vector(ext(bf2)), 42 | shrunk = as.vector(ext(bf3))) 43 | 44 | \dontrun{ 45 | # Plot 46 | library(terra) 47 | plot_distr(get_distr(bf, 1), bf) 48 | plot_distr(get_distr(bf2, 1), bf2) 49 | plot_distr(get_distr(bf3, 1), bf3) 50 | } 51 | 52 | } 53 | -------------------------------------------------------------------------------- /man/shrink_geom.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/shrink_birdflow.R 3 | \name{shrink_geom} 4 | \alias{shrink_geom} 5 | \title{Shrink geometry component of a BirdFlow object} 6 | \usage{ 7 | shrink_geom(geom) 8 | } 9 | \arguments{ 10 | \item{geom}{The geometry component of a BirdFlow object} 11 | } 12 | \value{ 13 | shrunk (or original) geometry 14 | } 15 | \description{ 16 | This is an internal helper function called twice by \code{\link[=shrink_birdflow]{shrink_birdflow()}} 17 | it adjusts the \code{nrow}, \code{ncol}, \code{ext}, and \code{mask} elements of the 18 | \code{geom} component of a BirdFlow model to the original extent, 19 | while preserving the same number, location, and alignment of the 20 | unmasked cells - thus nothing else in the object needs to change. 21 | If the geometry has not be extended (\code{\link[=shrink_birdflow]{shrink_birdflow()}}, \code{\link[=extend_geom]{extend_geom()}}) 22 | then it is returned as is. 23 | } 24 | \keyword{internal} 25 | -------------------------------------------------------------------------------- /man/sort_by_id_and_dates.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Routes-internal.R 3 | \name{sort_by_id_and_dates} 4 | \alias{sort_by_id_and_dates} 5 | \title{Sort Routes by ID and Date} 6 | \usage{ 7 | sort_by_id_and_dates(routes) 8 | } 9 | \arguments{ 10 | \item{routes}{A \code{Routes} or data frame object.} 11 | } 12 | \value{ 13 | A sorted data frame. 14 | } 15 | \description{ 16 | Sorts a \code{Routes} or data frame object by route ID and date. 17 | } 18 | -------------------------------------------------------------------------------- /man/suppress_specific_warnings.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/suppress_specific_warnings.R 3 | \name{suppress_specific_warnings} 4 | \alias{suppress_specific_warnings} 5 | \title{Suppress warnings that match one or more regular expressions} 6 | \usage{ 7 | suppress_specific_warnings(x, patterns = NULL) 8 | } 9 | \arguments{ 10 | \item{x}{An expression.} 11 | 12 | \item{patterns}{One or more patterns to check warning messages against.} 13 | } 14 | \value{ 15 | Possibly output from \code{x} 16 | } 17 | \description{ 18 | \code{suppress_specific_warnings()} will suppress warnings that match regular 19 | expression patterns that are supplied via 20 | the \code{patterns} argument, without suppressing warnings that don't match the 21 | patterns. 22 | } 23 | \keyword{internal} 24 | -------------------------------------------------------------------------------- /man/target_columns.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/validate_RouteDataClass.R 3 | \name{target_columns} 4 | \alias{target_columns} 5 | \alias{get_target_columns_Routes} 6 | \alias{get_target_columns_BirdFlowRoutes} 7 | \alias{get_target_columns_BirdFlowIntervals} 8 | \title{Get Target Columns for Data Frames} 9 | \usage{ 10 | get_target_columns_Routes(type = "input") 11 | 12 | get_target_columns_BirdFlowRoutes(type = "input") 13 | 14 | get_target_columns_BirdFlowIntervals(type = "input") 15 | } 16 | \arguments{ 17 | \item{type}{A character string specifying the context for the columns. 18 | Either \code{'input'} (default) 19 | for required input columns or \code{'output'} for columns expected after 20 | processing.} 21 | } 22 | \value{ 23 | A character vector containing the expected column names. 24 | } 25 | \description{ 26 | A collection of internal utility functions to retrieve the 27 | required column names 28 | for \code{Routes}, \code{BirdFlowRoutes}, and \code{BirdFlowIntervals} objects. These 29 | functions ensure 30 | consistency in data frame structures across different processing steps. 31 | } 32 | \details{ 33 | These functions return the expected column names for \code{Routes}, 34 | \code{BirdFlowRoutes} and \code{BirdFlowIntervals} data classes. 35 | Columns may vary depending on whether the context is for input or output 36 | processing: 37 | \itemize{ 38 | \item \strong{Input Columns}: Columns required for validation or initial data 39 | ingestion. 40 | \item \strong{Output Columns}: Columns expected after processing or transformation. 41 | } 42 | \subsection{Functions Included:}{ 43 | \itemize{ 44 | \item \code{get_target_columns_Routes()}: Returns column names for \code{Routes} objects. 45 | \item \code{get_target_columns_BirdFlowRoutes()}: Returns column names for 46 | \code{BirdFlowRoutes} objects. 47 | \item \code{get_target_columns_BirdFlowIntervals()}: Returns column names for 48 | \code{BirdFlowIntervals} objects. 49 | } 50 | } 51 | } 52 | \seealso{ 53 | \itemize{ 54 | \item \href{?object_validators}{Object Validators} 55 | \item \href{?attribute_validators}{Attribute Validators} 56 | } 57 | } 58 | -------------------------------------------------------------------------------- /man/transition_from_marginal.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_transition.R 3 | \name{transition_from_marginal} 4 | \alias{transition_from_marginal} 5 | \title{convert a marginal into a transition matrix} 6 | \usage{ 7 | transition_from_marginal(m, direction) 8 | } 9 | \arguments{ 10 | \item{m}{a marginal} 11 | 12 | \item{direction}{the desired transition direction, either "forward" or 13 | "backward"} 14 | } 15 | \value{ 16 | a transition matrix formulated such that you multiply the matrix by a 17 | distribution to project the distribution. See \code{\link[=get_transition]{get_transition()}} for more 18 | details. 19 | } 20 | \description{ 21 | internal function to generate a transition matrix from a marginal 22 | } 23 | \details{ 24 | this is called from \code{\link[=get_transition]{get_transition()}}. If at some point we decide 25 | to store transitions rather than marginals it will also be called from 26 | \code{\link[=import_birdflow]{import_birdflow()}}. 27 | } 28 | \keyword{internal} 29 | -------------------------------------------------------------------------------- /man/ts_info.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ts_info.R 3 | \name{ts_info} 4 | \alias{ts_info} 5 | \title{Internal function to determine timestep sequence direction and whether 6 | it crosses year boundary} 7 | \usage{ 8 | ts_info(ts) 9 | } 10 | \arguments{ 11 | \item{ts}{A sequence of timesteps.} 12 | } 13 | \value{ 14 | A list with: 15 | \item{direction}{Either \code{"forward"} or \code{"backward"}.} 16 | \item{loops}{\code{TRUE} if the sequence crosses the year boundary, \code{FALSE} if it 17 | does not.} 18 | } 19 | \description{ 20 | It assumes that all lags between adjacent steps that don't cross the year 21 | boundary are either -1 or 1. 22 | } 23 | \keyword{internal} 24 | -------------------------------------------------------------------------------- /man/validate_BirdFlow.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/validate_BirdFlow.R 3 | \name{validate_BirdFlow} 4 | \alias{validate_BirdFlow} 5 | \title{Function to validate a BirdFlow object} 6 | \usage{ 7 | validate_BirdFlow(x, error = TRUE, allow_incomplete = FALSE) 8 | } 9 | \arguments{ 10 | \item{x}{A BirdFlow object.} 11 | 12 | \item{error}{If TRUE throw an error if there are problems if FALSE return 13 | any problems as a data.frame.} 14 | 15 | \item{allow_incomplete}{If TRUE allow the BirdFlow object to be missing 16 | both marginals and transitions (but not other components). This allows 17 | checking the output of \code{\link[=preprocess_species]{preprocess_species()}}.} 18 | } 19 | \value{ 20 | If \code{error = FALSE} the function returns 21 | a data.frame describing any errors with columns: 22 | \describe{ 23 | \item{problem}{A character description of any problems.} 24 | \item{type}{The problem type, either "error" or "incomplete."} 25 | } 26 | Otherwise, if there are no problems a similar data.frame with no rows is 27 | returned invisibly. 28 | } 29 | \description{ 30 | Throw an error if a BirdFlow object is malformed or incomplete. 31 | } 32 | \details{ 33 | \code{\link[=preprocess_species]{preprocess_species()}} creates a BirdFlow object that lacks both marginals 34 | and transitions and thus can't be used to make projections. 35 | \code{validate_BirdFlow()} tags the absence of these with the type "incomplete". 36 | Any other missing or malformed components are tagged "error". 37 | 38 | Since marginals can be used to calculate both distributions and 39 | transition matrices, a BirdFlow object can be complete if it has marginals; 40 | or has both transitions and distributions. Having redundancy in these three 41 | is not considered an error. 42 | 43 | Currently metadata and species information is not checked for completeness. 44 | 45 | Currently dead end transitions are permitted. See \code{\link[=find_dead_ends]{find_dead_ends()}} for 46 | checking for those. 47 | } 48 | -------------------------------------------------------------------------------- /man/validate_geom.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/validate_BirdFlow.R 3 | \name{validate_geom} 4 | \alias{validate_geom} 5 | \title{Validate geom component of a BirdFlow or related object} 6 | \usage{ 7 | validate_geom(geom, n_active, throw_error = TRUE) 8 | } 9 | \arguments{ 10 | \item{geom}{A geom list} 11 | 12 | \item{n_active}{The number of active cells in the model 13 | see \code{n_active()} also stored in \code{bf$metadat$n_active}} 14 | 15 | \item{throw_error}{If \code{TRUE} throw errors that are 16 | found. IF false return a problem data frame. 17 | throw_error = FALSE is for compatibility with 18 | \code{validate_BirdFlow}} 19 | } 20 | \value{ 21 | a problem data frame 22 | } 23 | \description{ 24 | This is called from \code{validate_BirdFlow}, as well 25 | as some of the route and interval validation functions 26 | } 27 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | # This file is part of the standard setup for testthat. 2 | # It is recommended that you do not modify it. 3 | # 4 | # Where should you do additional test configuration? 5 | # Learn more about the roles of various files in: 6 | # * https://r-pkgs.org/tests.html 7 | # * https://testthat.r-lib.org/reference/test_package.html#special-files 8 | 9 | library(testthat) 10 | library(BirdFlowR) 11 | 12 | test_check("BirdFlowR") 13 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/as_BirdFlowRoutes.md: -------------------------------------------------------------------------------- 1 | # Routes() -> as_BirdFlowRoutes() with different aggregations works 2 | 3 | Code 4 | my_bfroutes$data[1:10, c("route_id", "i", "timestep")] 5 | Output 6 | route_id i timestep 7 | 1 1 244 10 8 | 2 1 244 11 9 | 3 1 105 12 10 | 4 1 105 13 11 | 5 1 105 14 12 | 6 1 105 15 13 | 7 2 204 10 14 | 8 2 152 11 15 | 9 2 152 12 16 | 10 2 92 13 17 | 18 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/birdflow_options.md: -------------------------------------------------------------------------------- 1 | # birdflow_options works 2 | 3 | Code 4 | original[!names(original) == "cache"] 5 | Output 6 | $collection_url 7 | [1] "https://birdflow-science.s3.amazonaws.com/collection/" 8 | 9 | $max_param_per_gpu_gb 10 | [1] 23224801 11 | 12 | $time_format 13 | [1] "month_day" 14 | 15 | $verbose 16 | [1] TRUE 17 | 18 | 19 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/calc_flux.md: -------------------------------------------------------------------------------- 1 | # calc_flux() works without directionality 2 | 3 | Code 4 | top 5 | Output 6 | x y transition flux date 7 | 65 -2025000 -225000 T_01-02 3.623e-09 2021-01-07 8 | 66 -2025000 -225000 T_02-03 1.897e-08 2021-01-14 9 | 109 -1875000 -225000 T_01-02 1.061e-08 2021-01-07 10 | 110 -1875000 -225000 T_02-03 8.883e-08 2021-01-14 11 | 114 -1875000 -375000 T_02-03 1.173e-10 2021-01-14 12 | 149 -1725000 375000 T_01-02 2.287e-10 2021-01-07 13 | 14 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/calc_movement_vectors.md: -------------------------------------------------------------------------------- 1 | # calc_movement_vectors is consistent 2 | 3 | Code 4 | mv 5 | Output 6 | i start end start_x start_y end_x end_y weight 7 | 1 154 5 6 -1725000 375000 -822249.8 60429.72 8.105351e-05 8 | 2 155 5 6 -1575000 375000 -820426.2 62271.54 4.196808e-06 9 | 10 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/distribution_performance.md: -------------------------------------------------------------------------------- 1 | # distribution_performance works 2 | 3 | Code 4 | a 5 | Output 6 | 7 | min_step_cor 0.9961 8 | mean_step_cor 0.9961 9 | min_distr_cor 0.9896 10 | mean_distr_cor 0.9901 11 | st_traverse_cor 0.9917 12 | md_traverse_cor 0.9907 13 | n_states 273.0000 14 | 15 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/evaluate_performance.md: -------------------------------------------------------------------------------- 1 | # evaluate performance is consistent 2 | 3 | Code 4 | stats 5 | Output 6 | $mean_step_cor 7 | [1] 0.993717 8 | 9 | $min_step_cor 10 | [1] 0.9914898 11 | 12 | $traverse_cor 13 | [1] 0.9703605 14 | 15 | $mean_distr_cor 16 | [1] 0.9927127 17 | 18 | $min_distr_cor 19 | [1] 0.9858788 20 | 21 | 22 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/export_rasters.md: -------------------------------------------------------------------------------- 1 | # export_rasters() works with GeoTIFFs 2 | 3 | Code 4 | cat(files[c(1:8, (n - 4):n)], sep = "\n") 5 | Output 6 | amewoo_crs.txt 7 | amewoo_distr_01.tif 8 | amewoo_distr_02.tif 9 | amewoo_distr_03.tif 10 | amewoo_distr_04.tif 11 | amewoo_distr_05.tif 12 | amewoo_distr_06.tif 13 | amewoo_distr_07.tif 14 | amewoo_mask_48.tif 15 | amewoo_mask_49.tif 16 | amewoo_mask_50.tif 17 | amewoo_mask_51.tif 18 | amewoo_mask_52.tif 19 | 20 | # export_rasters() works with PNG and reprojection 21 | 22 | Code 23 | cat(png_export_files[c(1:8, (n - 4):n)], sep = "\n") 24 | Output 25 | amewoo_crs.txt 26 | amewoo_distr_01.png 27 | amewoo_distr_01.png.aux.xml 28 | amewoo_distr_02.png 29 | amewoo_distr_02.png.aux.xml 30 | amewoo_distr_03.png 31 | amewoo_distr_03.png.aux.xml 32 | amewoo_distr_04.png 33 | amewoo_mask_50.png.aux.xml 34 | amewoo_mask_51.png 35 | amewoo_mask_51.png.aux.xml 36 | amewoo_mask_52.png 37 | amewoo_mask_52.png.aux.xml 38 | 39 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/get_distr.md: -------------------------------------------------------------------------------- 1 | # get_distr() works 2 | 3 | Code 4 | colnames(d) 5 | Output 6 | [1] "January 4" "January 11" "January 18" "January 25" 7 | 8 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/get_naturalearth.md: -------------------------------------------------------------------------------- 1 | # get_naturalearth() works at edge of WGS84 2 | 3 | Code 4 | coast 5 | Output 6 | Simple feature collection with 23 features and 0 fields 7 | Geometry type: LINESTRING 8 | Dimension: XY 9 | Bounding box: xmin: -3665000 ymin: -5517335 xmax: 2434301 ymax: 2660450 10 | Projected CRS: PROJCRS["unknown", 11 | BASEGEOGCRS["unknown", 12 | DATUM["World Geodetic System 1984", 13 | ELLIPSOID["WGS 84",6378137,298.257223563, 14 | LENGTHUNIT["metre",1]], 15 | ID["EPSG",6326]], 16 | PRIMEM["Greenwich",0, 17 | ANGLEUNIT["degree",0.0174532925199433], 18 | ID["EPSG",8901]]], 19 | CONVERSION["unknown", 20 | METHOD["Mollweide"], 21 | PARAMETER["Longitude of natural origin",180, 22 | ANGLEUNIT["degree",0.0174532925199433], 23 | ID["EPSG",8802]], 24 | PARAMETER["False easting",0, 25 | LENGTHUNIT["metre",1], 26 | ID["EPSG",8806]], 27 | PARAMETER["False northing",0, 28 | LENGTHUNIT["metre",1], 29 | ID["EPSG",8807]]], 30 | CS[Cartesian,2], 31 | AXIS["(E)",east, 32 | ORDER[1], 33 | LENGTHUNIT["metre",1, 34 | ID["EPSG",9001]]], 35 | AXIS["(N)",north, 36 | ORDER[2], 37 | LENGTHUNIT["metre",1, 38 | ID["EPSG",9001]]]] 39 | First 10 features: 40 | geometry 41 | 1 LINESTRING (-3665000 -43162... 42 | 2 LINESTRING (-1250705 -19552... 43 | 3 LINESTRING (-1293033 -19280... 44 | 4 LINESTRING (-1365446 -25838... 45 | 5 LINESTRING (-2738641 -45242... 46 | 6 LINESTRING (-2867033 -72169... 47 | 7 LINESTRING (-1773562 -12933... 48 | 8 LINESTRING (-1820173 -11848... 49 | 9 LINESTRING (-1901454 -12184... 50 | 10 LINESTRING (-2028197 -99039... 51 | 52 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/get_transition.md: -------------------------------------------------------------------------------- 1 | # get_transition() is consistent for forward transitions 2 | 3 | Code 4 | histogram_counts 5 | Output 6 | upper_bound count 7 | 1 1e-04 10718 8 | 2 2e-03 1204 9 | 3 3e-03 65 10 | 4 4e-03 42 11 | 5 5e-03 22 12 | 6 6e-03 21 13 | 7 7e-03 13 14 | 8 8e-03 14 15 | 9 9e-03 7 16 | 10 1e-02 3 17 | 11 2e-02 45 18 | 12 4e-02 23 19 | 13 6e-02 13 20 | 14 8e-02 5 21 | 15 1e-01 2 22 | 16 2e-01 5 23 | 17 6e-01 11 24 | 18 1e+00 104 25 | 26 | # get_transition() is consistent for backwards transitions 27 | 28 | Code 29 | histogram_counts 30 | Output 31 | upper_bound count 32 | 1 1e-04 9307 33 | 2 2e-03 1874 34 | 3 3e-03 208 35 | 4 4e-03 124 36 | 5 5e-03 94 37 | 6 6e-03 72 38 | 7 7e-03 44 39 | 8 8e-03 49 40 | 9 9e-03 32 41 | 10 1e-02 34 42 | 11 2e-02 167 43 | 12 4e-02 103 44 | 13 6e-02 44 45 | 14 8e-02 19 46 | 15 1e-01 11 47 | 16 2e-01 26 48 | 17 6e-01 12 49 | 18 1e+00 97 50 | 51 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/interval_log_likelihood.md: -------------------------------------------------------------------------------- 1 | # interval_log_likelihood produces identical results with one_at_a_time = TRUE 2 | 3 | Code 4 | ll 5 | Output 6 | log_likelihood null_ll lag 7 | 1 -3.157935 -4.453952 47 8 | 2 -3.429942 -4.870969 50 9 | 3 -5.135462 -5.816720 21 10 | 4 -2.988073 -4.305398 47 11 | 12 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/is_between.md: -------------------------------------------------------------------------------- 1 | # is_between() works 2 | 3 | Code 4 | sum(between[[1]]) 5 | Output 6 | [1] 14278 7 | 8 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/lookup_date.md: -------------------------------------------------------------------------------- 1 | # lookup dates works with transitions and marginals 2 | 3 | Code 4 | d 5 | Output 6 | [1] "2021-12-24" "2021-12-31" "2021-01-07" "2021-01-14" 7 | 8 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/lookup_species_metadata.md: -------------------------------------------------------------------------------- 1 | # lookup_species_metadata() has consistent output 2 | 3 | Code 4 | lookup_species_metadata("amewoo") 5 | Output 6 | Species resolved to: 'amewoo' (American Woodcock) 7 | $species_code 8 | [1] "amewoo" 9 | 10 | $scientific_name 11 | [1] "Scolopax minor" 12 | 13 | $common_name 14 | [1] "American Woodcock" 15 | 16 | $breeding_quality 17 | [1] 3 18 | 19 | $breeding_start 20 | [1] "2022-05-17" 21 | 22 | $breeding_end 23 | [1] "2022-09-13" 24 | 25 | $nonbreeding_quality 26 | [1] 3 27 | 28 | $nonbreeding_start 29 | [1] "2022-12-20" 30 | 31 | $nonbreeding_end 32 | [1] "2022-01-11" 33 | 34 | $postbreeding_migration_quality 35 | [1] 3 36 | 37 | $postbreeding_migration_start 38 | [1] "2022-09-20" 39 | 40 | $postbreeding_migration_end 41 | [1] "2022-12-13" 42 | 43 | $prebreeding_migration_quality 44 | [1] 3 45 | 46 | $prebreeding_migration_start 47 | [1] "2022-01-18" 48 | 49 | $prebreeding_migration_end 50 | [1] "2022-05-10" 51 | 52 | 53 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/preprocess_species.md: -------------------------------------------------------------------------------- 1 | # preprocess_species runs on test dataset 2 | 3 | Code 4 | df 5 | Output 6 | i density 7 | 1 293 1.818734e-03 8 | 2 294 5.461779e-03 9 | 3 295 7.139737e-03 10 | 4 296 3.648285e-03 11 | 5 300 7.825097e-07 12 | 6 301 6.058527e-04 13 | 7 302 1.867900e-03 14 | 8 303 1.879675e-03 15 | 9 304 8.367624e-04 16 | 10 305 2.113106e-03 17 | 11 306 9.011818e-03 18 | 12 307 2.274691e-02 19 | 20 | --- 21 | 22 | Code 23 | ext(a) 24 | Output 25 | SpatExtent : 690000, 1500000, 690000, 1410000 (xmin, xmax, ymin, ymax) 26 | 27 | --- 28 | 29 | Code 30 | res(a) 31 | Output 32 | [1] 30000 30000 33 | 34 | # preprocess_species() works with clip 35 | 36 | Code 37 | ext(b) 38 | Output 39 | SpatExtent : 810000, 1500000, 690000, 1320000 (xmin, xmax, ymin, ymax) 40 | Code 41 | res(b) 42 | Output 43 | [1] 30000 30000 44 | 45 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/rasterize_distr.md: -------------------------------------------------------------------------------- 1 | # rasterize_distr() with data.frame output 2 | 3 | Code 4 | hdf 5 | Output 6 | x y i label value order 7 | 79 -2025000 -225000 221 January 4 1.295109e-05 1 8 | 101 -1875000 -225000 222 January 4 6.840829e-05 1 9 | 119 -1725000 375000 154 January 4 8.941192e-05 1 10 | 11 | --- 12 | 13 | Code 14 | hdf 15 | Output 16 | # A tibble: 3 x 6 17 | x y i label value order 18 | 19 | 1 -2025000 -225000 221 January 4 0.0000130 1 20 | 2 -2025000 -225000 221 January 11 0.0000111 2 21 | 3 -1875000 -225000 222 January 4 0.0000684 1 22 | 23 | # rasterize_distr() to dataframe works 24 | 25 | Code 26 | d 27 | Output 28 | x y i label value order 29 | 79 -2025000 -225000 221 January 4 1.295109e-05 1 30 | 101 -1875000 -225000 222 January 4 6.840829e-05 1 31 | 119 -1725000 375000 154 January 4 8.941192e-05 1 32 | 33 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/route.md: -------------------------------------------------------------------------------- 1 | # route() works with a single distribution 2 | 3 | Code 4 | pts 5 | Output 6 | route_id x y i lon lat timestep date 7 | 1 1 -225000 -375000 246 -87.58125 35.75464 5 2021-02-01 8 | 5 1 -75000 375000 164 -86.00650 42.53498 9 2021-03-01 9 | route_type stay_id stay_len 10 | 1 synthetic 1 3 11 | 5 synthetic 2 6 12 | 13 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/sparsify.md: -------------------------------------------------------------------------------- 1 | # sparsification works 2 | 3 | Code 4 | comparison 5 | Output 6 | full conditional marginal model 7 | pct_zero 0.000 82.522 96.361 95.691 8 | pct_density_lost 0.000 0.221 1.000 0.596 9 | mean_step_cor 0.996 0.996 0.996 0.996 10 | mean_distr_cor 0.990 0.990 0.990 0.990 11 | st_traverse_cor 0.992 0.991 0.991 0.992 12 | n_states 293.000 293.000 215.000 219.000 13 | 14 | -------------------------------------------------------------------------------- /tests/testthat/helper-buffer_extent.R: -------------------------------------------------------------------------------- 1 | #' Buffer a SpatExtent 2 | #' 3 | #' `buffer_extent()` is a helper function used in testing `extend_birdflow()`. 4 | #' 5 | #' @param e An SpatExtent as produced by [terra::ext()] 6 | #' @param buffer The buffer to add, in same units as the `SpatExtent`. 7 | #' @return a buffered SpatExtent 8 | buffer_extent <- function(e, buffer) { 9 | e[1] <- e[1] - buffer 10 | e[2] <- e[2] + buffer 11 | e[3] <- e[3] - buffer 12 | e[4] <- e[4] + buffer 13 | return(e) 14 | } 15 | -------------------------------------------------------------------------------- /tests/testthat/helper-change_date_format.R: -------------------------------------------------------------------------------- 1 | 2 | change_date_format <- function(bf, version_year = NULL) { 3 | 4 | if (is.null(version_year)) { 5 | # If nothing specified switch to the opposite format from e 6 | # what is present 7 | version_year <- ifelse(get_metadata(bf, "ebird_version_year") < 2022, 8 | 2022, 2021) 9 | } 10 | 11 | stopifnot(is.numeric(version_year), 12 | length(version_year) == 1, 13 | !is.na(version_year)) 14 | 15 | date_format <- ifelse(version_year < 2021.5, 2021, 2022) 16 | 17 | weeks <- bf$dates$week 18 | new_dates <- make_dates(version_year) 19 | new_dates <- new_dates[match(weeks, new_dates$week), ] 20 | rownames(new_dates) <- NULL 21 | 22 | if (date_format == 2021) { 23 | new_dates$interval <- seq_len(nrow(new_dates)) 24 | } else { 25 | new_dates$timestep <- seq_len(nrow(new_dates)) 26 | } 27 | 28 | bf$dates <- new_dates 29 | bf$metadata$ebird_version_year <- version_year 30 | 31 | bf 32 | } 33 | -------------------------------------------------------------------------------- /tests/testthat/helper-get_americas.R: -------------------------------------------------------------------------------- 1 | 2 | # Function to return americas - used for setting up "big run" clipping boundary 3 | # here so we can reproduce the clipping issue in that run. 4 | get_americas <- function(clip_to_mainland_us = FALSE, include_hawaii = FALSE) { 5 | earth <- rnaturalearth::ne_countries(scale = 50) 6 | americas <- earth[grep("America", earth$continent), , drop = FALSE] 7 | if (clip_to_mainland_us) { 8 | extent <- c(ymax = 50, ymin = 25, xmin = -130, xmax = -55) 9 | americas <- sf::st_crop(americas, extent) 10 | americas <- americas[americas$name == "United States", , drop = FALSE] 11 | } 12 | # Drop Hawaii 13 | if (!include_hawaii) { 14 | clip <- sf::st_bbox(c(ymax = 25, ymin = 15, xmin = -165, xmax = -150)) |> 15 | sf::st_as_sfc() 16 | sf::st_crs(clip) <- "EPSG:4326" 17 | americas <- sf::st_difference(americas, clip) 18 | } 19 | americas 20 | } 21 | -------------------------------------------------------------------------------- /tests/testthat/helper-local_quiet.R: -------------------------------------------------------------------------------- 1 | 2 | #' Silence BirdFlowR messages for the local scope 3 | #' 4 | #' This is intended for use with testing. Calling it once at the 5 | #' top of a test will silence BirdFlowR output for the test by setting 6 | #' `verbose` to `FALSE` just in the calling scope. 7 | #' 8 | #' @param env Necessary to capture the calling environment and set that 9 | #' as the scope within which verbose is temporarily set. Leave at default 10 | #' value. 11 | #' 12 | local_quiet <- function(env = parent.frame()) { 13 | ov <- birdflow_options("verbose") 14 | birdflow_options(verbose = FALSE) 15 | withr::defer(birdflow_options(verbose = ov), env) 16 | } 17 | -------------------------------------------------------------------------------- /tests/testthat/helper-local_test_dir.R: -------------------------------------------------------------------------------- 1 | #' Create a temporary directory for a test 2 | #' 3 | #' It will will be empty at start and cleared after test completes. 4 | #' Based on concepts from: 5 | #' https://testthat.r-lib.org/articles/test-fixtures.html#test-hygiene 6 | #' 7 | #' @param subdir The name of a directory within `tempdir()` to use for the test. 8 | #' @param env 9 | #' 10 | #' @return the path to the test directory 11 | #' @keywords internal 12 | local_test_dir <- function(subdir = "test_dir", env = parent.frame()) { 13 | test_dir <- file.path(tempdir(), subdir) 14 | if (file.exists(test_dir)) 15 | unlink(test_dir, recursive = TRUE) 16 | dir.create(test_dir) 17 | withr::defer(unlink(test_dir, recursive = TRUE), envir = env) 18 | return(test_dir) 19 | } 20 | -------------------------------------------------------------------------------- /tests/testthat/helper-make_fake_move_data.R: -------------------------------------------------------------------------------- 1 | make_fake_move_data <- function(bf) { 2 | # This makes a dataframe with bird_id, track_id, x, y, date 3 | # Dates are monotonic withing each combination of 4 | # bird_id, track_id combination. There are several dates per week 5 | # x, and y are random valid locations for the associated date. 6 | # There is no linearity to the tracks. 7 | # Initially written to test snap_to_birdflow() 8 | 9 | ### Make test data ### 10 | 11 | # 2 birds, 1 track for the first, 2 tracks for second. 12 | # dates of last track different from first two 13 | n1 <- 20 14 | d <- data.frame(bird_id = rep(1:2, each = n1), 15 | track_id = rep(1, n1 * 2), 16 | x = rep(NA_real_, n1 * 2), 17 | y = rep(NA_real_, n1 * 2), 18 | date = rep(seq(lubridate::ymd("2022-02-15"), 19 | lubridate::ymd("2022-04-15"), 20 | length.out = n1), 2)) 21 | n2 <- 25 22 | d <- rbind(d, data.frame(bird_id = rep(2, n2), 23 | track_id = rep(2, n2), 24 | x = rep(NA_real_, n2), 25 | y = rep(NA_real_, n2), 26 | date = seq( 27 | lubridate::ymd("2022-02-01"), 28 | lubridate::ymd("2022-04-30"), length.out = n2))) 29 | 30 | # Generate x,y by randomly selecting non-dynamically masked locations 31 | # There's no general motion direction here - except perhaps because the 32 | # non-masked cells are shifting during migration 33 | d$timestep <- lookup_timestep(d$date, bf) 34 | dm <- get_dynamic_mask(bf) 35 | for (ts in unique(d$timestep)) { 36 | sv <- d$timestep == ts 37 | n <- sum(sv) 38 | i <- sample(which(dm[, ts]), n, replace = TRUE) 39 | d[sv, c("x", "y")] <- i_to_xy(i, bf) 40 | } 41 | d$timestep <- NULL 42 | 43 | # Add noise 44 | rad <- xres(bf) / 2 45 | d$x <- d$x + runif(nrow(d), -rad, rad) 46 | d$y <- d$y + runif(nrow(d), -rad, rad) 47 | 48 | return(d) 49 | } 50 | -------------------------------------------------------------------------------- /tests/testthat/helper-skip_if_unsupported_ebirdst_version.R: -------------------------------------------------------------------------------- 1 | 2 | skip_if_unsupported_ebirdst_version <- function(use = "package") { # nolint: object_length_linter, line_length_linter 3 | supported <- ebirdst_ver_supported(use = use, throw_error = FALSE) 4 | 5 | v <- ebirdst_pkg_ver() 6 | if(!supported) { 7 | skip(message = paste0("ebirdst version:", v, " not supported by ", use)) 8 | } 9 | invisible() 10 | } 11 | -------------------------------------------------------------------------------- /tests/testthat/helper-skip_if_wrong_ebirdst_for_snapshot.R: -------------------------------------------------------------------------------- 1 | 2 | skip_if_wrong_ebirdst_for_snapshot <- function() { # nolint: object_length_linter, line_length_linter 3 | v <- ebirdst_pkg_ver() 4 | if (v < "3.2022.0") { 5 | skip(paste0( 6 | "ebirdst version ", as.character(v), 7 | " produces dated snapshots.")) 8 | } 9 | 10 | 11 | if (v >= "3.2023.0") { 12 | skip(paste0( 13 | "Birdflow snapshots are not yet updated for ebirdst version ", 14 | as.character(v))) 15 | } 16 | 17 | invisible() 18 | } 19 | -------------------------------------------------------------------------------- /tests/testthat/test-add_dynamic_mask.R: -------------------------------------------------------------------------------- 1 | test_that("Add dynamic mask works", { 2 | 3 | bf <- BirdFlowModels::amewoo 4 | expect_no_error(bf <- add_dynamic_mask(bf)) 5 | expect_no_error(validate_BirdFlow(bf)) 6 | expect_no_error(dbf <- add_dynamic_mask(bf, dummy_mask = TRUE)) 7 | expect_no_error(validate_BirdFlow(dbf)) 8 | 9 | }) 10 | -------------------------------------------------------------------------------- /tests/testthat/test-animate_distr.R: -------------------------------------------------------------------------------- 1 | test_that("animate_distr() works with default args", { 2 | bf <- BirdFlowModels::amewoo 3 | 4 | expect_no_error(a1 <- animate_distr(get_distr(bf, c(1, 10, 20)), bf)) 5 | suppressMessages( 6 | expect_no_error(print(a1)) 7 | ) 8 | 9 | }) 10 | 11 | test_that("animate_distr() works with dynamic masking", { 12 | bf <- BirdFlowModels::amewoo 13 | 14 | expect_no_error(a2 <- animate_distr(get_distr(bf, c(1, 10, 20)), bf, 15 | show_dynamic_mask = TRUE)) 16 | suppressMessages( 17 | expect_no_error(print(a2)) 18 | ) 19 | }) 20 | -------------------------------------------------------------------------------- /tests/testthat/test-animate_movement_vectors.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("animate_movement_vectors runs cleanly", { 3 | skip_on_cran() 4 | 5 | local_quiet() 6 | 7 | bf <- BirdFlowModels::amewoo 8 | expect_no_error(a <- animate_movement_vectors(bf, start = 1, end = 4)) 9 | 10 | # Setup and promise to delete temporary directory 11 | t_dir <- local_test_dir("animation_test") 12 | 13 | expect_no_error(bf_suppress_msg( 14 | gif <- 15 | gganimate::animate( 16 | a, 17 | fps = 1, 18 | renderer = gganimate::file_renderer(dir = t_dir), 19 | device = "ragg_png", 20 | width = 6, 21 | height = 5, 22 | res = 150, 23 | units = "in") 24 | )) 25 | }) 26 | -------------------------------------------------------------------------------- /tests/testthat/test-animate_routes.R: -------------------------------------------------------------------------------- 1 | test_that("animate_routes() runs", { 2 | 3 | bf <- BirdFlowModels::amewoo 4 | 5 | start <- lookup_timestep(species_info(bf, "prebreeding_migration_start"), bf) 6 | end <- start + 3 7 | 8 | xy <- get_distr(bf, start) |> 9 | sample_distr(n = 3) |> 10 | apply(2, function(x) which(as.logical(x))) |> 11 | i_to_xy(bf) |> 12 | as.data.frame() 13 | 14 | # Short routes 15 | set.seed(1) 16 | rts <- route(bf, x_coord = xy$x, y_coord = xy$y, start = start, end = end) 17 | expect_no_error(anim <- animate_routes(rts, bf)) 18 | 19 | timesteps <- sort(unique(rts$data$timestep)) 20 | 21 | skip_if_not_installed("ragg") 22 | 23 | suppressMessages( 24 | expect_no_error( 25 | gif <- 26 | gganimate::animate(anim, 27 | device = "ragg_png", # ragg_png is fast and pretty 28 | width = 6, height = 5, 29 | res = 150, units = "in", 30 | nframes = length(timesteps) * 2, fps = 2) 31 | )) 32 | 33 | }) 34 | -------------------------------------------------------------------------------- /tests/testthat/test-birdflow_options.R: -------------------------------------------------------------------------------- 1 | test_that("birdflow_options works", { 2 | 3 | expect_no_error(original <- birdflow_options()) 4 | on.exit(birdflow_options(original)) 5 | 6 | # Check default options for changes skip cache as it varies 7 | expect_snapshot(original[!names(original) == "cache"]) 8 | 9 | alt <- list( 10 | cache = tempdir(), 11 | collection_url = "https://birdflow-science.s3.amazonaws.com/test/", 12 | max_param_per_gpu_gb = 24000000, time_format = "timestep", 13 | verbose = FALSE) 14 | 15 | 16 | birdflow_options(alt) 17 | 18 | reset <- birdflow_options() 19 | expect_equal(alt[-1], reset[-1]) 20 | 21 | birdflow_options(original) 22 | expect_equal(original, birdflow_options()) 23 | 24 | 25 | expect_error(birdflow_options("cache", "time_format")) 26 | expect_error(birdflow_options("garbage"), 27 | "is not a BirdFlowR configuration option") 28 | 29 | 30 | 31 | }) 32 | -------------------------------------------------------------------------------- /tests/testthat/test-build_transitions.R: -------------------------------------------------------------------------------- 1 | test_that("build_transitions(0) and drop_transitions() work", { 2 | 3 | # Add and drop transitions and see if you end up with an identical object 4 | bf <- BirdFlowModels::amewoo 5 | tbf <- build_transitions(bf) 6 | bf2 <- drop_transitions(tbf) 7 | expect_equal(bf, bf2) 8 | expect_true(has_transitions(tbf)) 9 | 10 | # Delete marginals from object with transitions 11 | tbf$marginals <- NULL 12 | tbf$metadata$has_marginals <- FALSE 13 | # But transitions still the same 14 | expect_equal(get_transition(bf, "T_01-02"), get_transition(tbf, "T_01-02")) 15 | 16 | }) 17 | -------------------------------------------------------------------------------- /tests/testthat/test-cache_path.R: -------------------------------------------------------------------------------- 1 | test_that("cache_path() works", { 2 | expect_no_error(p <- cache_path()) 3 | expect_true(is.character(p) && !is.na(p) && nchar(p) > 1 && length(p) == 1) 4 | }) 5 | -------------------------------------------------------------------------------- /tests/testthat/test-calc_interval_metrics.R: -------------------------------------------------------------------------------- 1 | test_that("Interval validation works", { 2 | set.seed(42) 3 | 4 | # Setup 5 | fake_routes <- make_fake_routes() 6 | bf <- BirdFlowModels::amewoo 7 | species1 <- bf$species 8 | source1 <- "Testing" 9 | 10 | my_routes <- Routes(fake_routes, 11 | species = species1, 12 | source = source1 13 | ) 14 | my_bfroutes <- as_BirdFlowRoutes(my_routes, bf = bf) 15 | 16 | # Constraints 17 | min_day <- 7 18 | max_day <- 180 19 | min_km <- 200 20 | max_km <- 8000 21 | 22 | my_intervals <- BirdFlowR::as_BirdFlowIntervals(my_bfroutes, 23 | max_n = 1000, 24 | min_day_interval = min_day, 25 | max_day_interval = max_day, 26 | min_km_interval = min_km, 27 | max_km_interval = max_km 28 | ) 29 | 30 | expect_no_error(eval_res <- calc_interval_metrics(my_intervals, bf)) 31 | single_value_outputs <- eval_res[[1]] 32 | expect_true(single_value_outputs['n_intervals']>0) 33 | transition_level_outputs <- eval_res[[2]] 34 | expect_true(nrow(transition_level_outputs)>0) 35 | }) 36 | 37 | -------------------------------------------------------------------------------- /tests/testthat/test-calc_movement_vectors.R: -------------------------------------------------------------------------------- 1 | test_that("calc_movement_vectors is consistent", { 2 | bf <- BirdFlowModels::amewoo 3 | expect_no_error(mv <- calc_movement_vectors(bf, 5)) 4 | mv <- mv[1:2, !names(mv) == "width"] 5 | expect_snapshot(mv) 6 | }) 7 | -------------------------------------------------------------------------------- /tests/testthat/test-calc_year_offset.R: -------------------------------------------------------------------------------- 1 | test_that("calc_year_offset works across year boundaries", { 2 | forward <- c(50:52, 1:4) 3 | expect_no_error(f_res <- calc_year_offset(forward)) 4 | expect_equal(f_res, c(0, 0, 0, 1, 1, 1, 1)) 5 | 6 | backward <- rev(forward) 7 | expect_no_error(b_res <- calc_year_offset(backward)) 8 | 9 | expect_equal(b_res, c(0, 0, 0, 0, -1, -1, -1)) 10 | 11 | }) 12 | 13 | 14 | test_that("calc_year_offset works across multiple years", { 15 | forward <- rep(1:52, 3) 16 | expect_no_error(f_res <- calc_year_offset(forward)) 17 | expect_equal(f_res, rep(0:2, each = 52)) 18 | 19 | backward <- rep(52:1, 3) 20 | expect_no_error(b_res <- calc_year_offset(backward)) 21 | expect_equal(b_res, rep(0:-2, each = 52)) 22 | 23 | }) 24 | -------------------------------------------------------------------------------- /tests/testthat/test-combine_transitions.R: -------------------------------------------------------------------------------- 1 | test_that("combine_transitions is consistent with predict", { 2 | 3 | bf <- BirdFlowModels::amewoo 4 | 5 | start <- 5 6 | end <- 49 7 | direction <- "backward" 8 | 9 | # Combine the transitions 10 | expect_no_error( 11 | trans <- combine_transitions(bf, start = start, 12 | end = end, direction = direction) 13 | ) 14 | 15 | # predict ending distribution with bf 16 | # - by stepping through intervening transitions 17 | s_st <- get_distr(bf, start) 18 | e_st <- get_distr(bf, end) # status and trends 19 | p <- predict.BirdFlow(bf, s_st, start = start, 20 | end = end, direction = direction) 21 | e_bf <- p[, ncol(p)] # end distribution from Birdflow predict (active cells) 22 | 23 | start_dm <- get_dynamic_mask(bf, start) 24 | end_dm <- get_dynamic_mask(bf, end) 25 | 26 | # end distribution from consolidated transition (just dynamic) 27 | e_trans <- as.vector(trans %*% s_st[start_dm]) 28 | 29 | # They should be identical 30 | expect_equal <- cor(e_trans, e_bf[end_dm]) 31 | 32 | 33 | }) 34 | -------------------------------------------------------------------------------- /tests/testthat/test-compareGeom.R: -------------------------------------------------------------------------------- 1 | test_that("compareGeom() works", { 2 | bf1 <- BirdFlowModels::amewoo 3 | bf2 <- BirdFlowModels::rewbla 4 | 5 | # Two BirdFlow objects 6 | expect_error(compareGeom(bf1, bf2), regexp = "extents do not match") 7 | expect_true(compareGeom(bf1, bf1)) 8 | 9 | # One bf and one terra 10 | r1a <- rast(bf1, 1) # single band 11 | r1b <- rast(bf1, 1:3) # multi band 12 | 13 | # Matching 14 | expect_true(compareGeom(bf1, r1a)) 15 | expect_true(compareGeom(bf1, r1b)) 16 | expect_true(compareGeom(r1a, bf1)) 17 | 18 | # Not matching 19 | expect_error(compareGeom(bf2, r1a), "extents do not match") 20 | expect_error(compareGeom(r1b, bf2), "extents do not match") 21 | 22 | }) 23 | -------------------------------------------------------------------------------- /tests/testthat/test-dmi_to_i.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("dmi_to_i() is accurate", { 3 | 4 | bf <- BirdFlowModels::amewoo 5 | dmi <- 10 6 | timestep = 4 7 | this_dynamic_mask <- get_dynamic_mask(bf)[, timestep] 8 | 9 | # Make dynamic vector with indicated dmi hot 10 | d_vec <- rep(FALSE, sum(this_dynamic_mask)) 11 | d_vec[dmi] <- TRUE 12 | 13 | # Make standard location/distribution vector with corresponding cell hot 14 | vec <- rep(FALSE, n_active(bf)) 15 | vec[this_dynamic_mask] <- d_vec 16 | expected <- which(vec) 17 | 18 | expect_equal(dmi_to_i(dmi, timestep, bf), expected) 19 | }) 20 | 21 | test_that("dmi_to_i() and i_to_dmi() are reversable", { 22 | 23 | library(BirdFlowR) 24 | bf <- BirdFlowModels::amewoo 25 | 26 | dm <- get_dynamic_mask(bf) 27 | 28 | dmi <- c(11:20) 29 | timesteps <- c(1, 1, 1, 1, 3, 3, 5,7:9 ) 30 | 31 | 32 | i <- dmi_to_i(dmi, timesteps, bf) 33 | 34 | dmi2 <- i_to_dmi(i, timesteps, bf) 35 | 36 | expect_equal(dmi2, dmi) 37 | 38 | }) 39 | 40 | -------------------------------------------------------------------------------- /tests/testthat/test-evaluate_performance.R: -------------------------------------------------------------------------------- 1 | test_that("evaluate performance is consistent", { 2 | bf <- BirdFlowModels::amewoo 3 | bf <- truncate_birdflow(bf, start = 1, end = 4) 4 | 5 | expect_warning(stats <- evaluate_performance(bf)) 6 | expect_snapshot(stats) 7 | 8 | expect_warning(stats2 <- evaluate_performance(bf, distr_only = TRUE)) 9 | expect_equal(stats$min_distr_cor, stats2$min_distr_cor) 10 | expect_equal(stats$mean_distr_cor, stats2$mean_distr_cor) 11 | 12 | }) 13 | -------------------------------------------------------------------------------- /tests/testthat/test-export_rasters.R: -------------------------------------------------------------------------------- 1 | test_that("export_rasters() works with GeoTIFFs", { 2 | bf <- BirdFlowModels::amewoo 3 | bf <- add_dynamic_mask(bf) # Backwards compatibility 4 | dir <- withr::local_tempdir("export_geotiff_test") 5 | 6 | local_quiet() 7 | 8 | # GeoTIFF write 9 | expect_no_error(export_rasters(bf, dir, filetype = "GTiff")) 10 | 11 | # Expected files 12 | files <- sort(list.files(dir)) 13 | n <- length(files) 14 | expect_snapshot(cat(files[c(1:8, (n - 4):n)], sep = "\n")) 15 | 16 | 17 | # First exported distribution is very close to first distribution 18 | file <- file.path(dir, files[grep("distr", files)[1]]) 19 | r <- terra::rast(file) 20 | suppressWarnings(d1 <- as_distr(r, bf)) 21 | d2 <- get_distr(bf, 1) 22 | max_proportional_difference <- max(abs(d1 - d2) / d1, na.rm = TRUE) 23 | expect_true(max_proportional_difference < 1e-6) 24 | 25 | # Delete output 26 | unlink(dir, recursive = TRUE) 27 | 28 | }) 29 | 30 | test_that("export_rasters() works with PNG and reprojection", { 31 | bf <- BirdFlowModels::amewoo 32 | bf <- add_dynamic_mask(bf) # Backwards compatibility 33 | dir <- file.path(tempdir(), "export_png_test") 34 | crs <- "EPSG:4326" 35 | if (dir.exists(dir)) 36 | unlink(dir, recursive = TRUE) 37 | dir.create(dir) 38 | 39 | local_quiet() 40 | 41 | # PNG write 42 | expect_no_error(export_rasters(bf, dir, filetype = "PNG", crs = crs)) 43 | 44 | # Expected files 45 | png_export_files <- sort(list.files(dir)) 46 | n <- length(png_export_files) 47 | expect_snapshot(cat(png_export_files[c(1:8, (n - 4):n)], sep = "\n")) 48 | 49 | # First exported distribution is very close to first distribution 50 | file <- file.path(dir, png_export_files[grep("distr", png_export_files)[1]]) 51 | r <- terra::rast(file) 52 | suppressWarnings(d1 <- as_distr(r, bf)) # "average" interpolation 53 | d2 <- get_distr(bf, 1) # original distribution 54 | 55 | # Double transformation using nearest one way and average the other isn't 56 | # perfect. 57 | expect_true(cor(d1, d2) > 0.95) 58 | 59 | # Delete output 60 | unlink(dir, recursive = TRUE) 61 | 62 | }) 63 | -------------------------------------------------------------------------------- /tests/testthat/test-find_threshold.R: -------------------------------------------------------------------------------- 1 | test_that("man/find_threshold() works", { 2 | x <- rep(1e4, 100) + seq(0.01, 1, .01) 3 | x <- 1:1000 4 | p <- .90 5 | expect_no_error(t <- find_threshold(x = x, p = p)) 6 | 7 | # Sum of all values greater than or equal to threshold is greater than p 8 | expect_true(sum(x[x >= t]) / sum(x) > p) 9 | 10 | # With next highest value it's no longer true 11 | t2 <- min(x[x > t]) 12 | expect_true(sum(x[x >= t2]) / sum(x) < p) 13 | }) 14 | -------------------------------------------------------------------------------- /tests/testthat/test-flatten_raster.R: -------------------------------------------------------------------------------- 1 | 2 | #------------------------------------------------------------------------------# 3 | # numeric input 4 | #------------------------------------------------------------------------------# 5 | 6 | test_that("expand_distr and flatten_raster are reversable - 1 distr", { 7 | bf <- BirdFlowModels::amewoo 8 | d <- get_distr(bf, 1) 9 | r <- expand_distr(d, bf) 10 | f <- flatten_raster(r, bf) 11 | expect_equal(d, f) 12 | }) 13 | 14 | test_that("expand_distr and flatten_raster are reversable - multiple distr", { 15 | bf <- BirdFlowModels::amewoo 16 | d <- get_distr(bf, 3:4) 17 | r <- expand_distr(d, bf) 18 | f <- flatten_raster(r, bf) 19 | expect_equal(d, f) 20 | }) 21 | 22 | 23 | test_that("flatten_raster is consistent with i_to_rc() subset", { 24 | bf <- BirdFlowModels::amewoo 25 | d <- runif(n = n_active(bf)) 26 | m <- matrix(NA, nrow = nrow(bf), ncol = ncol(bf)) 27 | m[as.matrix(i_to_rc(seq_len(n_active(bf)), bf))] <- d 28 | d2 <- flatten_raster(m, bf) 29 | expect_equal(d, d2) 30 | }) 31 | 32 | 33 | #------------------------------------------------------------------------------# 34 | # SpatRaster input 35 | #------------------------------------------------------------------------------# 36 | 37 | test_that("rasterize_distr and flatten_raster are reversable - SpatRasters", { 38 | 39 | # Single distribution 40 | bf <- BirdFlowModels::amewoo 41 | r <- rast(bf, 1) 42 | d <- get_distr(bf, 1) 43 | fd <- flatten_raster(r, bf) 44 | expect_equal(fd, d) 45 | r2 <- rasterize_distr(d, bf) 46 | 47 | # Note. To compare SpatRasters use all.equal which has a method defined 48 | # in terra. expect_equal() relies on waldo::compare() which will flag 49 | # immaterial differences. 50 | expect_true(all.equal(r, r2)) 51 | 52 | }) 53 | -------------------------------------------------------------------------------- /tests/testthat/test-get_dates.R: -------------------------------------------------------------------------------- 1 | test_that("get_dates() works", { 2 | bf <- BirdFlowModels::rewbla 3 | d <- get_dates(bf) 4 | expect_equal(names(d), c("timestep", "date", "label", "julian", "week")) 5 | expect_equal(nrow(d), n_timesteps(bf)) 6 | expect_equal(lapply(d, class), list(timestep = "numeric", 7 | date = "character", 8 | label = "character", 9 | julian = "numeric", 10 | week = "integer")) 11 | expect_s3_class(d, "data.frame") 12 | 13 | 14 | }) 15 | -------------------------------------------------------------------------------- /tests/testthat/test-get_distr.R: -------------------------------------------------------------------------------- 1 | test_that("get_distr() works", { 2 | bf <- BirdFlowModels::rewbla 3 | d <- column_sums <- get_distr(bf, 1:4) 4 | expect_equal(d, bf$distr[, 1:4], ignore_attr = TRUE) 5 | expect_snapshot(colnames(d)) 6 | expect_equal(get_distr(bf, "2022-01-01"), bf$distr[, 1], ignore_attr = TRUE) 7 | 8 | expect_equal(get_distr(bf, "all"), bf$distr, ignore_attr = TRUE) 9 | 10 | expect_equal(get_distr(bf, lubridate::as_date("2022-12-28")), 11 | bf$distr[, 52], ignore_attr = TRUE) 12 | 13 | }) 14 | -------------------------------------------------------------------------------- /tests/testthat/test-get_marginal.R: -------------------------------------------------------------------------------- 1 | test_that("get_marginal() works", { 2 | bf <- BirdFlowModels::amewoo 3 | expect_no_condition(m <- get_marginal(bf, "M_52-01")) 4 | expect_true(is.matrix(m)) 5 | 6 | m2 <- get_marginal(bf, from = 52) 7 | 8 | 9 | }) 10 | -------------------------------------------------------------------------------- /tests/testthat/test-get_mask.R: -------------------------------------------------------------------------------- 1 | test_that("getmask works with numeric", { 2 | bf <- BirdFlowModels::amewoo 3 | expect_no_error(m <- get_mask(bf, format = "numeric")) 4 | expect_equal(m, bf$geom$mask) 5 | }) 6 | 7 | test_that("getmask works with data.frame", { 8 | bf <- BirdFlowModels::amewoo 9 | expect_no_error(df <- get_mask(bf, format = "dataframe")) 10 | expect_equal(sort(unique(df$i)), seq_len(n_active(bf))) 11 | expect_equal(sum(df$mask), n_active(bf)) 12 | }) 13 | 14 | test_that("getmask works with SpatRaster", { 15 | bf <- BirdFlowModels::amewoo 16 | expect_no_error(r <- get_mask(bf, format = "SpatRaster")) 17 | expect_equal(as.vector(terra::values(r)), as.logical(t(bf$geom$mask))) 18 | }) 19 | -------------------------------------------------------------------------------- /tests/testthat/test-get_metadata.R: -------------------------------------------------------------------------------- 1 | test_that("get_metadata() errors nicely with wrong input length", { 2 | bf <- BirdFlowModels::amewoo 3 | expect_error(get_metadata(bf, c("n_transitions", "n_timesteps")), 4 | "^what should be one of") 5 | }) 6 | -------------------------------------------------------------------------------- /tests/testthat/test-get_timestep_padding.R: -------------------------------------------------------------------------------- 1 | test_that("Timestep padding works", { 2 | 3 | bf <- BirdFlowModels::amewoo 4 | 5 | # 2. From marginals 6 | expect_equal(get_timestep_padding(bf), 2) 7 | 8 | # 3. From Transitions 9 | bft <- bftm <- BirdFlowR::build_transitions(bf) 10 | bft$marginals <- NULL 11 | bft$metadata$has_marginals <- FALSE 12 | expect_equal(get_timestep_padding(bf), 2) 13 | 14 | # 4. From n_timesteps() 15 | b <- bf 16 | b$marginals <- NULL 17 | b$metadata$has_marginals <- FALSE 18 | expect_equal(get_timestep_padding(b), 2) 19 | 20 | # 1. From metadata 21 | # should trump others - using wrong value to test with model that has 22 | # both transitions and marginals 23 | bftm$metadata$timestep_padding <- 3 24 | expect_equal(get_timestep_padding(bftm), 3) 25 | 26 | }) 27 | -------------------------------------------------------------------------------- /tests/testthat/test-is_between.R: -------------------------------------------------------------------------------- 1 | test_that("is_between() works", { 2 | 3 | local_quiet() 4 | 5 | # Sparsifying and truncating to speed things up 6 | bf <- BirdFlowModels::amewoo 7 | bf <- truncate_birdflow(bf, start = 1, end = 5) 8 | bf <- sparsify(bf, "conditional", .9, p_protected = 0.05) 9 | 10 | between <- is_between(bf) 11 | 12 | expect_snapshot(sum(between[[1]])) 13 | 14 | 15 | }) 16 | -------------------------------------------------------------------------------- /tests/testthat/test-load_collection_index.R: -------------------------------------------------------------------------------- 1 | test_that("load_collection_index() works", { 2 | expect_no_error(ci <- load_collection_index()) 3 | }) 4 | -------------------------------------------------------------------------------- /tests/testthat/test-load_model.R: -------------------------------------------------------------------------------- 1 | test_that("load_model() works", { 2 | skip_on_cran() 3 | expect_no_error(bf <- load_model("amewoo_prebreeding")) 4 | }) 5 | -------------------------------------------------------------------------------- /tests/testthat/test-lookup_date.R: -------------------------------------------------------------------------------- 1 | test_that("lookup dates works with timesteps", { 2 | bf <- BirdFlowModels::amewoo 3 | 4 | first_ten <- as.Date(get_dates(bf)$date[1:10]) 5 | expect_equal(lookup_date(1:10, bf), first_ten) 6 | expect_equal(lookup_date(paste0("T", 1:10), bf), first_ten) 7 | 8 | # All NA 9 | expect_equal(lookup_date(NA, bf), as.Date(NA)) 10 | expect_equal(lookup_date(NA_character_, bf), as.Date(NA)) 11 | expect_equal(lookup_date(NA_real_, bf), as.Date(NA)) 12 | 13 | # With NA 14 | expect_equal(lookup_date(c(1:10, NA), bf), c(first_ten, NA)) 15 | expect_equal(lookup_date(c(paste0("T", 1:10), NA), bf), c(first_ten, NA)) 16 | 17 | }) 18 | 19 | 20 | test_that("lookup dates works with transitions and marginals", { 21 | bf <- BirdFlowModels::amewoo 22 | 23 | trans <- lookup_transitions(bf, start = 51, end = 3, direction = "forward") 24 | d <- lookup_date(trans, bf) 25 | expect_snapshot(d) 26 | 27 | # with NA 28 | expect_equal(lookup_date(c(trans, NA), bf), c(d, NA)) 29 | 30 | # backwards 31 | trans <- lookup_transitions(bf, start = 3, end = 51, direction = "backward") 32 | backwards <- lookup_date(trans, bf) 33 | expect_equal(backwards, rev(d)) 34 | 35 | 36 | }) 37 | -------------------------------------------------------------------------------- /tests/testthat/test-lookup_species_metadata.R: -------------------------------------------------------------------------------- 1 | test_that("lookup_species_metadata() has consistent output", { 2 | 3 | skip_if_unsupported_ebirdst_version(use = "lookup_species_metadata") 4 | 5 | 6 | bf <- BirdFlowModels::amewoo 7 | expect_equal(names(lookup_species_metadata("amewoo")), 8 | names(new_BirdFlow()$species)) 9 | 10 | 11 | skip_if_not(ebirdst_pkg_ver()[1, 2], message = "Wrong ebirdst for snapshot") 12 | 13 | expect_snapshot(lookup_species_metadata("amewoo")) 14 | 15 | }) 16 | -------------------------------------------------------------------------------- /tests/testthat/test-marginal_stats.R: -------------------------------------------------------------------------------- 1 | test_that("marginal_stats and related functions work", { 2 | bf <- BirdFlowModels::amewoo 3 | expect_no_error(ms <- marginal_stats(bf)) 4 | expect_no_error(s <- sum_marginals(bf)) 5 | expect_no_error(pz <- calc_pct_zero(bf)) 6 | expect_equal(ms$sum, s) 7 | expect_equal(ms$pct_zero, pz) 8 | }) 9 | -------------------------------------------------------------------------------- /tests/testthat/test-n_parameters.R: -------------------------------------------------------------------------------- 1 | test_that("n_parameters() works", { 2 | bf <- BirdFlowModels::amewoo 3 | expect_no_error(np <- n_parameters(bf)) 4 | 5 | # Calculate n_param from marginals 6 | mar <- bf$marginals 7 | mar$index <- NULL 8 | np2 <- sum(sapply(mar, function(x) prod(dim(x))), get_dynamic_mask(bf, 1)) 9 | expect_equal(np, np2) 10 | 11 | # Hack to check bf without dynamic mask 12 | bf$geom$dynamic_mask <- NULL 13 | expect_no_error(full_np <- n_parameters(bf)) 14 | full_np2 <- n_active(bf)^2 * 52 + n_active(bf) 15 | expect_equal(full_np, full_np2) 16 | 17 | # Truncated Model 18 | bf <- BirdFlowModels::amewoo 19 | tbf <- truncate_birdflow(bf, start = 10, end = 15) 20 | expect_no_error(tnp <- n_parameters(bf)) 21 | tnp2 <- sum(sapply(mar, function(x) prod(dim(x))), get_dynamic_mask(bf, 1)) 22 | expect_equal(tnp, tnp2) 23 | }) 24 | -------------------------------------------------------------------------------- /tests/testthat/test-plot_loss.R: -------------------------------------------------------------------------------- 1 | test_that("get_loss() works", { 2 | bf <- BirdFlowModels::amewoo 3 | expect_no_error(loss <- get_loss(bf)) 4 | expect_equal(names(loss), c("dist", "ent", "obs", "total")) 5 | expect_s3_class(loss, "data.frame") 6 | }) 7 | 8 | 9 | test_that("plot_loss() works", { 10 | bf <- BirdFlowModels::amewoo 11 | expect_no_error(p <- plot_loss(bf)) 12 | expect_no_error(print(p)) 13 | }) 14 | -------------------------------------------------------------------------------- /tests/testthat/test-plot_movement_vectors.R: -------------------------------------------------------------------------------- 1 | test_that("plot_movement_vectors runs cleanly", { 2 | bf <- BirdFlowModels::amewoo 3 | expect_no_error(mv <- plot_movement_vectors(bf, 5)) 4 | }) 5 | -------------------------------------------------------------------------------- /tests/testthat/test-predict.R: -------------------------------------------------------------------------------- 1 | test_that("predicting preserves distribution over 5 weeks", { 2 | bf <- BirdFlowModels::amewoo 3 | if (!has_dynamic_mask(bf)) 4 | bf <- BirdFlowR:::add_dynamic_mask(bf) 5 | 6 | d1 <- get_distr(bf, 1) 7 | p <- predict(bf, d1, start = 1, end = 5) 8 | pred_d5 <- p[, 5] 9 | d5 <- get_distr(bf, 5) 10 | 11 | expect_gt(cor(d5, pred_d5), expected = .97) 12 | 13 | p <- predict(bf, d5, start = 5, end = 1, direction = "backward") 14 | pred_d1 <- p[, 5] 15 | 16 | expect_gt(cor(d1, pred_d1), expected = .97) 17 | 18 | }) 19 | 20 | 21 | 22 | test_that("predict() is consistent with full and sparse marginals", { 23 | # This refers to the format of the objects not the content. 24 | sparse_bf <- BirdFlowModels::amewoo 25 | if (!has_dynamic_mask(sparse_bf)) 26 | sparse_bf <- add_dynamic_mask(sparse_bf) 27 | full_bf <- sparse_bf 28 | for (marg in (c("M_01-02", "M_02-03", "M_03-04", "M_04-05"))) { 29 | full_bf$marginals[[marg]] <- as.matrix(full_bf$marginals[[marg]]) 30 | } 31 | distr <- get_distr(sparse_bf, 1) 32 | expect_no_error(sparse_pred <- predict(sparse_bf, distr, start = 1, end = 3)) 33 | expect_no_error(full_pred <- predict(full_bf, distr, start = 1, end = 3)) 34 | expect_equal(full_pred, sparse_pred) 35 | 36 | }) 37 | 38 | test_that("predict() is consistent with marginals and transitions", { 39 | bf <- BirdFlowModels::amewoo 40 | if (!has_dynamic_mask(bf)) 41 | bf <- add_dynamic_mask(bf) 42 | t_bf <- build_transitions(bf) 43 | distr <- get_distr(bf, 1) 44 | expect_no_error(pred <- predict(bf, distr, start = 1, end = 3)) 45 | expect_no_error(t_pred <- predict(t_bf, distr, start = 1, end = 3)) 46 | expect_equal(pred, t_pred) 47 | }) 48 | -------------------------------------------------------------------------------- /tests/testthat/test-print.R: -------------------------------------------------------------------------------- 1 | test_that("print works with BirdFlow model", { 2 | bf <- BirdFlowModels::amewoo 3 | expect_output(print(bf)) 4 | }) 5 | 6 | test_that("print works with BirdFlowRoutes object", { 7 | bf <- BirdFlowModels::amewoo 8 | rts <- route(bf, start = 10, end = 15) 9 | expect_output(print(rts)) 10 | }) 11 | -------------------------------------------------------------------------------- /tests/testthat/test-route_migration.R: -------------------------------------------------------------------------------- 1 | test_that("route_migration() works and throws deprecated warning", { 2 | bf <- BirdFlowModels::amewoo 3 | expect_warning(rts <- route_migration(bf, 4)) 4 | }) 5 | -------------------------------------------------------------------------------- /tests/testthat/test-shorten_distance_matrix.R: -------------------------------------------------------------------------------- 1 | test_that("shortening then expanding a distance matrix reproduces original", { 2 | # Create distance matrix 3 | x <- runif(5, 1, 100) 4 | y <- runif(5, 1, 100) 5 | dm <- as.matrix(dist(cbind(x, y))) 6 | 7 | # Test 8 | expect_no_condition(s <- shorten_distance_matrix(dm)) 9 | expect_no_condition(dm2 <- expand_distance_matrix(s)) 10 | expect_equal(dm, dm2, ignore_attr = TRUE) 11 | 12 | }) 13 | -------------------------------------------------------------------------------- /tests/testthat/test-shrink_birdflow.R: -------------------------------------------------------------------------------- 1 | test_that("shrink birdflow doesn't change original models", { 2 | bf1 <- BirdFlowModels::amewoo 3 | expect_no_error(bf2 <- shrink_birdflow(bf1)) 4 | expect_equal(bf1, bf2) 5 | }) 6 | 7 | test_that("shrink birdflow reverts extended BirdFlow to original", { 8 | bf1 <- BirdFlowModels::amewoo 9 | cell_buffer <- 2 10 | buffer <- xres(bf1) * cell_buffer # converted to map units (m) 11 | e <- ext(bf1) |> buffer_extent(buffer = buffer) 12 | bf2 <- extend_birdflow(bf1, e) 13 | expect_no_error(bf3 <- shrink_birdflow(bf2)) 14 | expect_equal(bf1, bf3) 15 | }) 16 | 17 | 18 | test_that("shrink birdflow doesn't drop internal columns or rows", { 19 | bf1 <- BirdFlowModels::amewoo 20 | bf1$geom$mask[, 3] <- FALSE # hacked and broken bf but will work for test 21 | bf1$geom$mask[2, ] <- FALSE # hacked and broken bf but will work for test 22 | bf2 <- shrink_birdflow(bf1) 23 | expect_equal(bf1, bf2) 24 | }) 25 | -------------------------------------------------------------------------------- /tests/testthat/test-sparsify.R: -------------------------------------------------------------------------------- 1 | test_that("sparsification works", { 2 | 3 | # Temporarily suppress BirdFlowR chatter 4 | o_verbose <- birdflow_options("verbose") 5 | birdflow_options(verbose = FALSE) 6 | on.exit(birdflow_options(verbose = o_verbose)) 7 | 8 | p_protected <- .1 9 | p <- 0.99 10 | 11 | bf <- BirdFlowModels::amewoo 12 | 13 | # Truncation is nonsensical here from a scientific perspective 14 | # but is done to speed testing 15 | bf <- truncate_birdflow(bf, start = 6, end = 8) 16 | 17 | # Test marginal 18 | expect_no_error(marginal <- sparsify(bf, method = "marginal", p = p)) 19 | set.seed(1) 20 | expect_no_error(rts <- route(marginal, 10, start = 1, 21 | end = n_timesteps(marginal))) 22 | 23 | # Test conditional 24 | 25 | expect_no_error(conditional <- sparsify(bf, method = "conditional", p = p, 26 | p_protected = p_protected)) 27 | set.seed(1) 28 | expect_no_error(rts <- route(conditional, 10, start = 1, 29 | end = n_timesteps(conditional))) 30 | s <- get_metadata(conditional, "sparse") 31 | 32 | # Expect no lost states under conditional with p_protected 33 | expect_true(all(s$stats$n_states == s$stats$n_states[1])) 34 | 35 | # Expect p_protected transitions to be retained 36 | # (only checking one dim of first marginal) 37 | m <- conditional$marginals[[1]] 38 | p_retained <- apply(m, 1, function(x) sum(x != 0) / length(x)) 39 | expect_true(all(p_retained > p_protected)) 40 | 41 | # Model 42 | expect_no_error(model <- sparsify(bf, "model", p = p)) 43 | 44 | # Compare performance 45 | comparison <- rbind(conditional$metadata$sparse$stats[c(1, 3), ], 46 | marginal$metadata$sparse$stats[3, , drop = FALSE], 47 | model$metadata$sparse$stats[3, , drop = FALSE]) 48 | comparison$model[2:4] <- c("conditional", "marginal", "model") 49 | comparison$md_traverse_cor <- NULL 50 | comparison$min_step_cor <- NULL 51 | comparison$min_distr_cor <- NULL 52 | rownames(comparison) <- comparison$model 53 | comparison$model <- NULL 54 | comparison <- t(comparison) 55 | comparison <- round(comparison, 3) 56 | 57 | expect_snapshot(comparison) 58 | 59 | 60 | }) 61 | -------------------------------------------------------------------------------- /tests/testthat/test-truncate_birdflow.R: -------------------------------------------------------------------------------- 1 | test_that("truncation works accross year boundary", { 2 | 3 | # Truncation across year boundary 4 | bf <- BirdFlowModels::amewoo # need circular 5 | expect_no_error(tbf <- truncate_birdflow(bf, start = 40, end = 10)) 6 | 7 | if (interactive()) { 8 | r <- route(tbf, season = "all") 9 | plot(r) # color guide is wrong. 10 | } 11 | }) 12 | 13 | 14 | test_that("truncation works", { 15 | 16 | bf <- BirdFlowModels::amewoo 17 | dates1 <- get_dates(bf) 18 | expect_no_error(tbf <- truncate_birdflow(bf, start = 5, end = 10)) 19 | dates2 <- get_dates(tbf) 20 | 21 | expect_equal(dates1[5:10, -1], dates2[, -1], ignore_attr = TRUE) 22 | 23 | expect_equal(get_distr(bf, 5), get_distr(tbf, 1)) 24 | 25 | expect_equal(get_dynamic_mask(bf, 5), get_dynamic_mask(tbf, 1)) 26 | 27 | expect_equal(n_timesteps(tbf), 6) 28 | expect_equal(is_cyclical(tbf), FALSE) 29 | expect_equal(n_transitions(tbf), 5) 30 | expect_equal(lookup_timestep_sequence(tbf), 1:6) 31 | 32 | }) 33 | -------------------------------------------------------------------------------- /tests/testthat/test-ts_info.R: -------------------------------------------------------------------------------- 1 | test_that("ts_info works", { 2 | # Forward loop 3 | a <- ts_info(c(1:5, 1)) 4 | expect_true(a$loops) 5 | expect_equal(a$direction, "forward") 6 | 7 | # Backward loop 8 | a <- ts_info(c(5:1, 5)) 9 | expect_true(a$loops) 10 | expect_equal(a$direction, "backward") 11 | 12 | # Forward 13 | a <- ts_info(1:5) 14 | expect_false(a$loops) # Forward 15 | expect_equal(a$direction, "forward") 16 | 17 | # Backward 18 | a <- ts_info(5:1) 19 | expect_false(a$loops) 20 | expect_equal(a$direction, "backward") 21 | 22 | # Single timestep 23 | a <- ts_info(1) 24 | expect_false(a$loops) 25 | expect_true(is.na(a$direction)) 26 | 27 | }) 28 | -------------------------------------------------------------------------------- /tests/testthat/test-validate_RouteDataClass.R: -------------------------------------------------------------------------------- 1 | test_that("Validations of Routes, BirdFlowRoutes, and BirdFlowIntervals work", { 2 | set.seed(42) 3 | 4 | fake_routes <- make_fake_routes() 5 | bf <- BirdFlowModels::amewoo 6 | species <- list( 7 | species_code = "amewoo", 8 | scientific_name = "Scolopax minor", 9 | common_name = "American Woodcock" 10 | ) 11 | source1 <- "Maine" 12 | 13 | expect_no_error(my_routes <- Routes(fake_routes, species = species, 14 | source = source1)) 15 | 16 | expect_no_error(validate_Routes(my_routes)) 17 | expect_no_error(my_bfroutes <- as_BirdFlowRoutes(my_routes, bf = bf)) 18 | expect_no_error(validate_BirdFlowRoutes(my_bfroutes)) 19 | expect_no_error(my_intervals <- as_BirdFlowIntervals(my_bfroutes)) 20 | expect_no_error(validate_BirdFlowIntervals(my_intervals)) 21 | }) 22 | -------------------------------------------------------------------------------- /tests/testthat/test-weight_between.R: -------------------------------------------------------------------------------- 1 | test_that("weight_between() works", { 2 | 3 | local_quiet() 4 | 5 | # Sparsifying and truncating to speed things up 6 | bf <- BirdFlowModels::amewoo 7 | bf <- truncate_birdflow(bf, start = 1, end = 5) 8 | bf <- sparsify(bf, "conditional", .9, p_protected = 0.05) 9 | 10 | expect_no_error(bw <- weight_between(bf)) 11 | 12 | 13 | }) 14 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | --------------------------------------------------------------------------------