Repository: edzer/sfr Branch: main Commit: 72ad7d000b93 Files: 340 Total size: 2.2 MB Directory structure: gitextract_91i9k_8r/ ├── .Rbuildignore ├── .gitattributes ├── .github/ │ ├── .gitignore │ ├── ISSUE_TEMPLATE/ │ │ ├── bug_report.md │ │ └── other_issue.md │ └── workflows/ │ ├── R-CMD-check.yaml │ ├── pkgdown.yaml │ ├── rhub.yaml │ ├── test-coverage.yaml │ └── tic-db.yml ├── .gitignore ├── CONDUCT.md ├── DESCRIPTION ├── LICENSE ├── NAMESPACE ├── NEWS.md ├── PROPOSAL.md ├── R/ │ ├── RcppExports.R │ ├── aggregate.R │ ├── agr.R │ ├── arith.R │ ├── bbox.R │ ├── bind.R │ ├── break_antimeridian.R │ ├── cast_sfc.R │ ├── cast_sfg.R │ ├── collection_extract.R │ ├── crop.R │ ├── crs.R │ ├── datasets.R │ ├── db.R │ ├── defunct.R │ ├── gdal_utils.R │ ├── geom-measures.R │ ├── geom-predicates.R │ ├── geom-transformers.R │ ├── geos-overlayng.R │ ├── graticule.R │ ├── grid.R │ ├── import-standalone-s3-register.R │ ├── init.R │ ├── jitter.R │ ├── join.R │ ├── m_range.R │ ├── make_grid.R │ ├── maps.R │ ├── nearest.R │ ├── normalize.R │ ├── plot.R │ ├── proj.R │ ├── read.R │ ├── s2.R │ ├── sample.R │ ├── sf-package.R │ ├── sf.R │ ├── sfc.R │ ├── sfg.R │ ├── sgbp.R │ ├── shift_longitude.R │ ├── sp.R │ ├── spatstat.R │ ├── stars.R │ ├── terra.R │ ├── tidyverse-vctrs.R │ ├── tidyverse.R │ ├── transform.R │ ├── valid.R │ ├── wkb.R │ ├── wkt.R │ └── z_range.R ├── README.md ├── _pkgdown.yml ├── cleanup ├── codecov.yml ├── configure ├── configure.ac ├── demo/ │ ├── 00Index │ ├── affine.R │ ├── basic.R │ ├── ggplot.R │ ├── meuse_sf.R │ ├── nc.R │ └── twitter.R ├── inst/ │ ├── CITATION │ ├── csv/ │ │ └── pt.csv │ ├── docker/ │ │ ├── README.md │ │ ├── alma/ │ │ │ ├── Dockerfile │ │ │ ├── README.md │ │ │ ├── build_command │ │ │ └── vito.repo │ │ ├── arrow/ │ │ │ └── Dockerfile │ │ ├── base/ │ │ │ └── Dockerfile │ │ ├── bionic/ │ │ │ └── Dockerfile │ │ ├── cran/ │ │ │ └── Dockerfile │ │ ├── custom/ │ │ │ └── Dockerfile │ │ ├── devel/ │ │ │ └── Dockerfile │ │ ├── fedora/ │ │ │ └── Dockerfile │ │ ├── gdal/ │ │ │ └── Dockerfile │ │ ├── gdal304/ │ │ │ └── Dockerfile │ │ ├── geos/ │ │ │ └── Dockerfile │ │ ├── lowest/ │ │ │ └── Dockerfile │ │ └── parquet/ │ │ └── Dockerfile │ ├── gml/ │ │ └── fmi_test.gml │ ├── gpkg/ │ │ ├── b_pump.gpkg │ │ ├── buildings.gpkg │ │ ├── grd_addr.gpkg │ │ ├── nc.gpkg │ │ ├── nospatial.gpkg │ │ └── tl.gpkg │ ├── include/ │ │ ├── sf.h │ │ └── sf_RcppExports.h │ ├── nc/ │ │ ├── cropped.nc │ │ └── zarr.py │ ├── osm/ │ │ └── overpass.osm │ ├── shape/ │ │ ├── olinda1.dbf │ │ ├── olinda1.prj │ │ ├── olinda1.shp │ │ ├── olinda1.shx │ │ ├── storms_xyz.dbf │ │ ├── storms_xyz.shp │ │ ├── storms_xyz.shx │ │ ├── storms_xyz_feature.dbf │ │ ├── storms_xyz_feature.shp │ │ ├── storms_xyz_feature.shx │ │ ├── storms_xyzm.dbf │ │ ├── storms_xyzm.shp │ │ ├── storms_xyzm.shx │ │ ├── storms_xyzm_feature.dbf │ │ ├── storms_xyzm_feature.shp │ │ └── storms_xyzm_feature.shx │ └── tif/ │ └── geomatrix.tif ├── man/ │ ├── Ops.Rd │ ├── aggregate.sf.Rd │ ├── bind.Rd │ ├── coerce-methods.Rd │ ├── dbDataType.Rd │ ├── dbWriteTable.Rd │ ├── db_drivers.Rd │ ├── dot-stop_geos.Rd │ ├── extension_map.Rd │ ├── gdal.Rd │ ├── gdal_addo.Rd │ ├── gdal_compressors.Rd │ ├── gdal_utils.Rd │ ├── geos_binary_ops.Rd │ ├── geos_binary_pred.Rd │ ├── geos_combine.Rd │ ├── geos_measures.Rd │ ├── geos_query.Rd │ ├── geos_unary.Rd │ ├── interpolate_aw.Rd │ ├── is_driver_available.Rd │ ├── is_driver_can.Rd │ ├── is_geometry_column.Rd │ ├── merge.sf.Rd │ ├── nc.Rd │ ├── plot.Rd │ ├── prefix_map.Rd │ ├── proj_tools.Rd │ ├── rawToHex.Rd │ ├── s2.Rd │ ├── sf-defunct.Rd │ ├── sf-package.Rd │ ├── sf.Rd │ ├── sf_extSoftVersion.Rd │ ├── sf_project.Rd │ ├── sfc.Rd │ ├── sgbp.Rd │ ├── st.Rd │ ├── st_agr.Rd │ ├── st_as_binary.Rd │ ├── st_as_grob.Rd │ ├── st_as_sf.Rd │ ├── st_as_sfc.Rd │ ├── st_as_text.Rd │ ├── st_bbox.Rd │ ├── st_break_antimeridian.Rd │ ├── st_cast.Rd │ ├── st_cast_sfc_default.Rd │ ├── st_collection_extract.Rd │ ├── st_coordinates.Rd │ ├── st_crop.Rd │ ├── st_crs.Rd │ ├── st_drivers.Rd │ ├── st_geometry.Rd │ ├── st_geometry_type.Rd │ ├── st_graticule.Rd │ ├── st_is.Rd │ ├── st_is_full.Rd │ ├── st_is_longlat.Rd │ ├── st_jitter.Rd │ ├── st_join.Rd │ ├── st_layers.Rd │ ├── st_line_project_point.Rd │ ├── st_line_sample.Rd │ ├── st_m_range.Rd │ ├── st_make_grid.Rd │ ├── st_nearest_feature.Rd │ ├── st_nearest_points.Rd │ ├── st_normalize.Rd │ ├── st_precision.Rd │ ├── st_read.Rd │ ├── st_relate.Rd │ ├── st_sample.Rd │ ├── st_shift_longitude.Rd │ ├── st_transform.Rd │ ├── st_viewport.Rd │ ├── st_write.Rd │ ├── st_z_range.Rd │ ├── st_zm.Rd │ ├── stars.Rd │ ├── summary.sfc.Rd │ ├── tibble.Rd │ ├── tidyverse.Rd │ ├── transform.sf.Rd │ └── valid.Rd ├── sf.Rproj ├── src/ │ ├── Makevars.in │ ├── Makevars.ucrt │ ├── Makevars.win │ ├── RcppExports.cpp │ ├── bbox.cpp │ ├── bbox.h │ ├── gdal.cpp │ ├── gdal.h │ ├── gdal_geom.cpp │ ├── gdal_read.cpp │ ├── gdal_read.h │ ├── gdal_read_stream.cpp │ ├── gdal_sf_pkg.h │ ├── gdal_utils.cpp │ ├── gdal_write.cpp │ ├── geos.cpp │ ├── hex.cpp │ ├── hex.h │ ├── mdim.cpp │ ├── ops.cpp │ ├── polygonize.cpp │ ├── proj.cpp │ ├── proj_info.cpp │ ├── raster2sf.cpp │ ├── sfc-sfg.cpp │ ├── signed_area.cpp │ ├── stars.cpp │ ├── wkb.cpp │ ├── wkb.h │ ├── zm_range.cpp │ └── zm_range.h ├── tests/ │ ├── aggregate.R │ ├── aggregate.Rout.save │ ├── bgmap.rda │ ├── cast.R │ ├── cast.Rout.save │ ├── crs.R │ ├── crs.Rout.save │ ├── dist.R │ ├── dist.Rout.save │ ├── dplyr.R │ ├── dplyr.Rout.save │ ├── empty.R │ ├── empty.Rout.save │ ├── full.R │ ├── full.Rout.save │ ├── gdal_geom.R │ ├── gdal_geom.Rout.save │ ├── geos.R │ ├── geos.Rout.save │ ├── graticule.R │ ├── graticule.Rout.save │ ├── grid.R │ ├── grid.Rout.save │ ├── maps.R │ ├── maps.Rout.save │ ├── plot.R │ ├── plot.Rout.save │ ├── read.R │ ├── read.Rout.save │ ├── roundtrip.R │ ├── roundtrip.Rout.save │ ├── s2.R │ ├── s2.Rout.save │ ├── sample.R │ ├── sample.Rout.save │ ├── sfc.R │ ├── sfc.Rout.save │ ├── sfg.R │ ├── sfg.Rout.save │ ├── spatstat.R │ ├── spatstat.Rout.save │ ├── stars.R │ ├── stars.Rout.save │ ├── test-by-element.R │ ├── test-by-element.Rout.save │ ├── testthat/ │ │ ├── test-aw.R │ │ ├── test-bbox.R │ │ ├── test-collection_extract.R │ │ ├── test-crs.R │ │ ├── test-gdal.R │ │ ├── test-geos.R │ │ ├── test-grid.R │ │ ├── test-normalize.R │ │ ├── test-plot.R │ │ ├── test-postgis_ODBC.R │ │ ├── test-postgis_RPostgreSQL.R │ │ ├── test-postgis_RPostgres.R │ │ ├── test-proj.R │ │ ├── test-read.R │ │ ├── test-s2.R │ │ ├── test-sample.R │ │ ├── test-sf.R │ │ ├── test-sfc.R │ │ ├── test-sfg.R │ │ ├── test-shift_longitude.R │ │ ├── test-sp.R │ │ ├── test-st_cast.R │ │ ├── test-tidyverse-vctrs.R │ │ ├── test-tidyverse.R │ │ ├── test-tm.R │ │ ├── test-valid.R │ │ ├── test-wkb.R │ │ ├── test-wkt.R │ │ ├── test-write.R │ │ └── test-zm_range.R │ ├── testthat.R │ ├── units.R │ ├── units.Rout.save │ ├── wkb.R │ └── wkb.Rout.save ├── tic.R ├── tools/ │ └── winlibs.R ├── vignettes/ │ ├── sf.fig │ ├── sf1.Rmd │ ├── sf2.Rmd │ ├── sf3.Rmd │ ├── sf4.Rmd │ ├── sf5.Rmd │ ├── sf6.Rmd │ ├── sf7.Rmd │ └── sf_fig.drawio └── vignettes.awk ================================================ FILE CONTENTS ================================================ ================================================ FILE: .Rbuildignore ================================================ .travis.yml PROPOSAL.md config.log config.status TODO ^windows ^appveyor\.yml$ ^.*\.Rproj$ ^\.Rproj\.user$ blog README.md CONDUCT.md rdev ^codecov\.yml$ hub tic.R NOTES ^\.ccache$ ^\.github$ ^tic\.R$ vignettes.awk ^\.gitattributes$ _pkgdown.yml docs pkgdown changes0.txt changes1.txt changes2.txt changes3.txt changes.txt aware.patch ================================================ FILE: .gitattributes ================================================ * text=auto data/* binary src/* text=lf R/* text=lf # Force the following filetypes to have unix eols, so Windows does not break them configure.ac text eol=lf ================================================ FILE: .github/.gitignore ================================================ *.html ================================================ FILE: .github/ISSUE_TEMPLATE/bug_report.md ================================================ --- name: Bug report about: Standard bug report template title: '' labels: '' assignees: '' --- **Describe the bug** A clear and concise description of what the bug is. **To Reproduce** It is easier for developers to help if they can reproduce the problem. Could you please provide a minimal reproducible example? **If reporting a change from previous versions** Please read https://cran.r-project.org/web/packages/sf/news/news.html first. **Additional context** Add any other context about the problem here.
Paste the output of your `sessionInfo()` and `sf::sf_extSoftVersion()`
================================================ FILE: .github/ISSUE_TEMPLATE/other_issue.md ================================================ --- name: Other issue about: Blank template for other issue types title: '' labels: '' assignees: '' --- ================================================ FILE: .github/workflows/R-CMD-check.yaml ================================================ # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help on: push: branches: [main, master] pull_request: branches: [main, master] schedule: - cron: "0 4 * * *" name: R-CMD-check jobs: R-CMD-check: runs-on: ${{ matrix.config.os }} name: ${{ matrix.config.os }} (${{ matrix.config.r }}) strategy: fail-fast: false matrix: config: - {os: macos-latest, r: 'release'} - {os: windows-latest, r: 'release'} - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} - {os: ubuntu-latest, r: 'release'} - {os: ubuntu-latest, r: 'oldrel-1'} - {os: ubuntu-latest, r: 'oldrel-2'} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} R_KEEP_PKG_SOURCE: yes steps: - uses: actions/checkout@v6 - uses: r-lib/actions/setup-pandoc@v2 - uses: r-lib/actions/setup-r@v2 with: r-version: ${{ matrix.config.r }} http-user-agent: ${{ matrix.config.http-user-agent }} use-public-rspm: true - name: Install macOS system dependencies if: runner.os == 'macos' run: brew install gdal proj - uses: r-lib/actions/setup-r-dependencies@v2 with: extra-packages: any::rcmdcheck needs: check - uses: r-lib/actions/check-r-package@v2 with: upload-snapshots: true ================================================ FILE: .github/workflows/pkgdown.yaml ================================================ # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help on: push: branches: [main, master] pull_request: branches: [main, master] release: types: [published] workflow_dispatch: name: pkgdown permissions: read-all jobs: pkgdown: runs-on: ubuntu-latest # Only restrict concurrency for non-PR jobs concurrency: group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} permissions: contents: write steps: - uses: actions/checkout@v6 - uses: r-lib/actions/setup-pandoc@v2 - uses: r-lib/actions/setup-r@v2 with: use-public-rspm: true - uses: r-lib/actions/setup-r-dependencies@v2 with: extra-packages: any::pkgdown, local::. needs: website - name: Build site run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) shell: Rscript {0} - name: Deploy to GitHub pages 🚀 if: github.event_name != 'pull_request' uses: JamesIves/github-pages-deploy-action@v4.8.0 with: clean: false branch: gh-pages folder: docs ================================================ FILE: .github/workflows/rhub.yaml ================================================ # R-hub's generic GitHub Actions workflow file. It's canonical location is at # https://github.com/r-hub/actions/blob/v1/workflows/rhub.yaml # You can update this file to a newer version using the rhub2 package: # # rhub::rhub_setup() # # It is unlikely that you need to modify this file manually. name: R-hub run-name: "${{ github.event.inputs.id }}: ${{ github.event.inputs.name || format('Manually run by {0}', github.triggering_actor) }}" on: workflow_dispatch: inputs: config: description: 'A comma separated list of R-hub platforms to use.' type: string default: 'linux,windows,macos' name: description: 'Run name. You can leave this empty now.' type: string id: description: 'Unique ID. You can leave this empty now.' type: string jobs: setup: runs-on: ubuntu-latest outputs: containers: ${{ steps.rhub-setup.outputs.containers }} platforms: ${{ steps.rhub-setup.outputs.platforms }} steps: # NO NEED TO CHECKOUT HERE - uses: r-hub/actions/setup@v1 with: config: ${{ github.event.inputs.config }} id: rhub-setup linux-containers: needs: setup if: ${{ needs.setup.outputs.containers != '[]' }} runs-on: ubuntu-latest name: ${{ matrix.config.label }} strategy: fail-fast: false matrix: config: ${{ fromJson(needs.setup.outputs.containers) }} container: image: ${{ matrix.config.container }} steps: - uses: r-hub/actions/checkout@v1 - uses: r-hub/actions/platform-info@v1 with: token: ${{ secrets.RHUB_TOKEN }} job-config: ${{ matrix.config.job-config }} - uses: r-hub/actions/setup-deps@v1 with: token: ${{ secrets.RHUB_TOKEN }} job-config: ${{ matrix.config.job-config }} - uses: r-hub/actions/run-check@v1 with: token: ${{ secrets.RHUB_TOKEN }} job-config: ${{ matrix.config.job-config }} other-platforms: needs: setup if: ${{ needs.setup.outputs.platforms != '[]' }} runs-on: ${{ matrix.config.os }} name: ${{ matrix.config.label }} strategy: fail-fast: false matrix: config: ${{ fromJson(needs.setup.outputs.platforms) }} steps: - uses: r-hub/actions/checkout@v1 - uses: r-hub/actions/setup-r@v1 with: job-config: ${{ matrix.config.job-config }} token: ${{ secrets.RHUB_TOKEN }} - uses: r-hub/actions/platform-info@v1 with: token: ${{ secrets.RHUB_TOKEN }} job-config: ${{ matrix.config.job-config }} - uses: r-hub/actions/setup-deps@v1 with: job-config: ${{ matrix.config.job-config }} token: ${{ secrets.RHUB_TOKEN }} - uses: r-hub/actions/run-check@v1 with: job-config: ${{ matrix.config.job-config }} token: ${{ secrets.RHUB_TOKEN }} ================================================ FILE: .github/workflows/test-coverage.yaml ================================================ # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help on: push: branches: [main, master] pull_request: branches: [main, master] name: test-coverage jobs: test-coverage: runs-on: ubuntu-latest env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - uses: actions/checkout@v4 - uses: r-lib/actions/setup-r@v2 with: use-public-rspm: true - uses: r-lib/actions/setup-r-dependencies@v2 with: extra-packages: any::covr needs: coverage - name: Test coverage run: | covr::codecov( quiet = FALSE, clean = FALSE, install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") ) shell: Rscript {0} - name: Show testthat output if: always() run: | ## -------------------------------------------------------------------- find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true shell: bash - name: Upload test results if: failure() uses: actions/upload-artifact@v4 with: name: coverage-test-failures path: ${{ runner.temp }}/package ================================================ FILE: .github/workflows/tic-db.yml ================================================ ## tic GitHub Actions template: linux ## revision date: 2021-06-27 # [Custom header] on: workflow_dispatch: push: branches: - main pull_request: # for now, CRON jobs only run on the default branch of the repo (i.e. usually on master) schedule: # * is a special character in YAML so you have to quote this string - cron: "0 4 * * *" name: tic-db jobs: all: runs-on: ${{ matrix.config.os }} name: ${{ matrix.config.os }} (${{ matrix.config.r }}) strategy: fail-fast: false matrix: config: # use a different tic template type if you do not want to build on all listed platforms - { os: ubuntu-latest, r: "release" } services: postgres: image: kartoza/postgis ports: - 5432:5432 env: # otherwise remotes::fun() errors cause the build to fail. Example: Unavailability of binaries R_REMOTES_NO_ERRORS_FROM_WARNINGS: true CRAN: ${{ matrix.config.cran }} # make sure to run `tic::use_ghactions_deploy()` to set up deployment TIC_DEPLOY_KEY: ${{ secrets.TIC_DEPLOY_KEY }} # prevent rgl issues because no X11 display is available RGL_USE_NULL: true # if you use bookdown or blogdown, replace "PKGDOWN" by the respective # capitalized term. This also might need to be done in tic.R BUILD_PKGDOWN: ${{ matrix.config.pkgdown }} # macOS >= 10.15.4 linking SDKROOT: /Library/Developer/CommandLineTools/SDKs/MacOSX.sdk # use GITHUB_TOKEN from GitHub to workaround rate limits in {remotes} GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - uses: actions/checkout@v4 - uses: r-lib/actions/setup-r@v2 with: r-version: ${{ matrix.config.r }} Ncpus: 4 # LaTeX. Installation time: # Linux: ~ 1 min # macOS: ~ 1 min 30s # Windows: never finishes - uses: r-lib/actions/setup-tinytex@v2 if: matrix.config.latex == 'true' - uses: r-lib/actions/setup-pandoc@v2 # set date/week for use in cache creation # https://github.community/t5/GitHub-Actions/How-to-set-and-access-a-Workflow-variable/m-p/42970 # - cache R packages daily # - name: "[Cache] Prepare daily timestamp for cache" # if: runner.os != 'Windows' # id: date # run: echo "::set-output name=date::$(date '+%d-%m')" # - name: "[Cache] Cache R packages" # if: runner.os != 'Windows' # uses: pat-s/always-upload-cache@v2 # with: # path: ${{ env.R_LIBS_USER }} # key: ${{ runner.os }}-r-${{ matrix.config.r }}-${{steps.date.outputs.date}} # restore-keys: ${{ runner.os }}-r-${{ matrix.config.r }}-${{steps.date.outputs.date}} - name: "[Stage] [Linux] Install required system libs" if: runner.os == 'Linux' run: sudo apt install libcurl4-openssl-dev libgit2-dev # for some strange Windows reason this step and the next one need to be decoupled - name: "[Stage] Prepare" run: | Rscript -e "if (!requireNamespace('remotes')) install.packages('remotes', type = 'source')" Rscript -e "if (getRversion() < '3.2' && !requireNamespace('curl')) install.packages('curl', type = 'source')" - name: "[Custom block] [Linux] Install spatial libraries" if: runner.os == 'Linux' run: sudo apt-get install libgdal-dev libproj-dev libgeos-dev libudunits2-dev - name: "[Custom block] [macOS] Install spatial libraries" if: runner.os == 'macOS' run: | # conflicts with gfortran from r-lib/actions when linking gcc rm '/usr/local/bin/gfortran' brew install pkg-config gdal proj geos - name: "[Stage] [macOS] Install libgit2" if: runner.os == 'macOS' run: brew install libgit2 - name: "[Stage] [macOS] Install system libs for pkgdown" if: runner.os == 'macOS' && matrix.config.pkgdown != '' run: brew install harfbuzz fribidi - name: "[Stage] [Linux] Install system libs for pkgdown" if: runner.os == 'Linux' && matrix.config.pkgdown != '' run: sudo apt install libharfbuzz-dev libfribidi-dev # Try to automatically check for system dependencies and install them # Note: this might not catch all required system libs and manual action might be needed - name: "[Stage] [Linux] Install linux system dependencies" if: runner.os == 'Linux' run: | while read -r cmd do eval sudo $cmd done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))') - name: "[Stage] Install" if: matrix.config.os != 'macOS-latest' || matrix.config.r != 'devel' run: Rscript -e "remotes::install_github('ropensci/tic')" -e "print(tic::dsl_load())" -e "tic::prepare_all_stages()" -e "tic::before_install()" -e "tic::install()" # macOS devel needs its own stage because we need to work with an option to suppress the usage of binaries - name: "[Stage] Prepare & Install (macOS-devel)" if: matrix.config.os == 'macOS-latest' && matrix.config.r == 'devel' run: | echo -e 'options(Ncpus = 4, pkgType = "source", repos = structure(c(CRAN = "https://cloud.r-project.org/")))' > $HOME/.Rprofile Rscript -e "remotes::install_github('ropensci/tic')" -e "print(tic::dsl_load())" -e "tic::prepare_all_stages()" -e "tic::before_install()" -e "tic::install()" - name: "[Stage] Script" run: Rscript -e 'tic::script()' - name: "[Stage] After Success" if: matrix.config.os == 'macOS-latest' && matrix.config.r == 'release' run: Rscript -e "tic::after_success()" - name: "[Stage] Upload R CMD check artifacts" if: failure() uses: actions/upload-artifact@v4 with: name: ${{ runner.os }}-r${{ matrix.config.r }}-results path: check ================================================ FILE: .gitignore ================================================ .Rproj.user .Rhistory .RData .Ruserdata src/*.o src/*.so src/*.dll src/Makevars config.log config.status windows/ inst/gdal/ inst/proj/ nc.shp nc.prj nc.dbf nc.shx docs/ tests/testthat/Rplots.pdf ================================================ FILE: CONDUCT.md ================================================ # Contributor Code of Conduct As contributors and maintainers of this project, we pledge to respect all people who contribute through reporting issues, posting feature requests, updating documentation, submitting pull requests or patches, and other activities. We are committed to making participation in this project a harassment-free experience for everyone, regardless of level of experience, gender, gender identity and expression, sexual orientation, disability, personal appearance, body size, race, ethnicity, age, or religion. Examples of unacceptable behavior by participants include the use of sexual language or imagery, derogatory comments or personal attacks, trolling, public or private harassment, insults, or other unprofessional conduct. Project maintainers have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct. Project maintainers who do not follow the Code of Conduct may be removed from the project team. Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by opening an issue or contacting one or more of the project maintainers. This Code of Conduct is adapted from the Contributor Covenant (http:contributor-covenant.org), version 1.0.0, available at http://contributor-covenant.org/version/1/0/0/ ================================================ FILE: DESCRIPTION ================================================ Package: sf Version: 1.1-1 Title: Simple Features for R Authors@R: c(person(given = "Edzer", family = "Pebesma", role = c("aut", "cre"), email = "edzer.pebesma@uni-muenster.de", comment = c(ORCID = "0000-0001-8049-7069")), person(given = "Roger", family = "Bivand", role = "ctb", comment = c(ORCID = "0000-0003-2392-6140")), person(given = "Etienne", family = "Racine", role = "ctb"), person(given = "Michael", family = "Sumner", role = "ctb"), person(given = "Ian", family = "Cook", role = "ctb"), person(given = "Tim", family = "Keitt", role = "ctb"), person(given = "Robin", family = "Lovelace", role = "ctb"), person(given = "Hadley", family = "Wickham", role = "ctb"), person(given = "Jeroen", family = "Ooms", role = "ctb", comment = c(ORCID = "0000-0002-4035-0289")), person(given = "Kirill", family = "M\u00fcller", role = "ctb"), person(given = "Thomas Lin", family = "Pedersen", role = "ctb"), person(given = "Dan", family = "Baston", role = "ctb"), person(given = "Dewey", family = "Dunnington", role = "ctb", comment = c(ORCID = "0000-0002-9415-4582")), person(given = "Alexandre", family = "Courtiol", role = "ctb", comment = c(ORCID = "0000-0003-0637-2959")) ) Description: Support for simple feature access, a standardized way to encode and analyze spatial vector data. Binds to 'GDAL' for reading and writing data, to 'GEOS' for geometrical operations, and to 'PROJ' for projection conversions and datum transformations. Uses by default the 's2' package for geometry operations on geodetic (long/lat degree) coordinates. License: GPL-2 | MIT + file LICENSE URL: https://r-spatial.github.io/sf/, https://github.com/r-spatial/sf BugReports: https://github.com/r-spatial/sf/issues Depends: methods, R (>= 4.1.0) Imports: classInt (>= 0.4-1), DBI (>= 0.8), graphics, grDevices, grid, s2 (>= 1.1.0), stats, tools, units (>= 0.7-0), utils Suggests: blob, nanoarrow, covr, dplyr (>= 1.0.0), ggplot2, knitr, lwgeom (>= 0.2-14), maps, mapview, Matrix, microbenchmark, odbc, pbapply, pillar, pool, raster, rlang, rmarkdown, RPostgres (>= 1.1.0), RPostgreSQL, RSQLite, sp (>= 1.2-4), spatstat (>= 2.0-1), spatstat.geom, spatstat.random, spatstat.linnet, spatstat.utils, stars (>= 0.6-0), terra, testthat (>= 3.0.0), tibble (>= 1.4.1), tidyr (>= 1.2.0), tidyselect (>= 1.0.0), tmap (>= 2.0), vctrs, wk (>= 0.9.0) LinkingTo: Rcpp VignetteBuilder: knitr Encoding: UTF-8 Config/testthat/edition: 2 Config/needs/coverage: XML Config/roxygen2/markdown: TRUE Config/roxygen2/version: 8.0.0 SystemRequirements: GDAL (>= 2.0.1), GEOS (>= 3.4.0), PROJ (>= 4.8.0), sqlite3 Collate: 'RcppExports.R' 'init.R' 'import-standalone-s3-register.R' 'crs.R' 'bbox.R' 'read.R' 'db.R' 'sfc.R' 'sfg.R' 'sf.R' 'bind.R' 'wkb.R' 'wkt.R' 'plot.R' 'geom-measures.R' 'geom-predicates.R' 'geom-transformers.R' 'transform.R' 'proj.R' 'sp.R' 'grid.R' 'arith.R' 'tidyverse.R' 'tidyverse-vctrs.R' 'cast_sfg.R' 'cast_sfc.R' 'graticule.R' 'datasets.R' 'aggregate.R' 'agr.R' 'maps.R' 'join.R' 'sample.R' 'valid.R' 'collection_extract.R' 'jitter.R' 'sgbp.R' 'spatstat.R' 'stars.R' 'crop.R' 'gdal_utils.R' 'nearest.R' 'normalize.R' 'sf-package.R' 'defunct.R' 'z_range.R' 'm_range.R' 'shift_longitude.R' 'make_grid.R' 's2.R' 'terra.R' 'geos-overlayng.R' 'break_antimeridian.R' ================================================ FILE: LICENSE ================================================ YEAR: 2016-2024 COPYRIGHT HOLDER: Edzer Pebesma ================================================ FILE: NAMESPACE ================================================ # Generated by roxygen2: do not edit by hand S3method("$",bbox) S3method("$",crs) S3method("$",m_range) S3method("$",z_range) S3method("$<-",sf) S3method("[",sf) S3method("[",sfc) S3method("[<-",sf) S3method("[<-",sfc) S3method("[[<-",sf) S3method("st_agr<-",sf) S3method("st_crs<-",bbox) S3method("st_crs<-",sf) S3method("st_crs<-",sfc) S3method("st_geometry<-",data.frame) S3method("st_geometry<-",sf) S3method(Ops,crs) S3method(Ops,sfc) S3method(Ops,sfg) S3method(Ops,sgbp) S3method(aggregate,sf) S3method(as.data.frame,sf) S3method(as.data.frame,sfc) S3method(as.data.frame,sgbp) S3method(as.matrix,sfg) S3method(as.matrix,sgbp) S3method(c,sfc) S3method(c,sfg) S3method(cbind,sf) S3method(dim,sgbp) S3method(duplicated,sf) S3method(format,bbox) S3method(format,crs) S3method(format,sfc) S3method(format,sfg) S3method(head,sfg) S3method(identify,sf) S3method(identify,sfc) S3method(is.na,bbox) S3method(is.na,crs) S3method(is.na,m_range) S3method(is.na,z_range) S3method(is_geometry_column,PqConnection) S3method(is_geometry_column,default) S3method(merge,sf) S3method(plot,sf) S3method(plot,sfc_CIRCULARSTRING) S3method(plot,sfc_GEOMETRY) S3method(plot,sfc_GEOMETRYCOLLECTION) S3method(plot,sfc_LINESTRING) S3method(plot,sfc_MULTILINESTRING) S3method(plot,sfc_MULTIPOINT) S3method(plot,sfc_MULTIPOLYGON) S3method(plot,sfc_POINT) S3method(plot,sfc_POLYGON) S3method(plot,sfg) S3method(points,sf) S3method(points,sfc) S3method(print,bbox) S3method(print,crs) S3method(print,m_range) S3method(print,proj_pipelines) S3method(print,sf) S3method(print,sf_layers) S3method(print,sfc) S3method(print,sfg) S3method(print,sgbp) S3method(print,z_range) S3method(rbind,sf) S3method(rep,sfc) S3method(st_agr,character) S3method(st_agr,default) S3method(st_agr,factor) S3method(st_agr,sf) S3method(st_area,sf) S3method(st_area,sfc) S3method(st_area,sfg) S3method(st_as_binary,sfc) S3method(st_as_binary,sfg) S3method(st_as_grob,CIRCULARSTRING) S3method(st_as_grob,COMPOUNDCURVE) S3method(st_as_grob,CURVEPOLYGON) S3method(st_as_grob,GEOMETRYCOLLECTION) S3method(st_as_grob,LINESTRING) S3method(st_as_grob,MULTILINESTRING) S3method(st_as_grob,MULTIPOINT) S3method(st_as_grob,MULTIPOLYGON) S3method(st_as_grob,MULTISURFACE) S3method(st_as_grob,POINT) S3method(st_as_grob,POLYGON) S3method(st_as_grob,sfc) S3method(st_as_grob,sfc_CIRCULARSTRING) S3method(st_as_grob,sfc_LINESTRING) S3method(st_as_grob,sfc_MULTILINESTRING) S3method(st_as_grob,sfc_MULTIPOINT) S3method(st_as_grob,sfc_MULTIPOLYGON) S3method(st_as_grob,sfc_POINT) S3method(st_as_grob,sfc_POLYGON) S3method(st_as_s2,sf) S3method(st_as_s2,sfc) S3method(st_as_sf,SpatVector) S3method(st_as_sf,Spatial) S3method(st_as_sf,data.frame) S3method(st_as_sf,lpp) S3method(st_as_sf,map) S3method(st_as_sf,owin) S3method(st_as_sf,ppp) S3method(st_as_sf,ppplist) S3method(st_as_sf,psp) S3method(st_as_sf,s2_geography) S3method(st_as_sf,sf) S3method(st_as_sf,sfc) S3method(st_as_sfc,SpatialLines) S3method(st_as_sfc,SpatialMultiPoints) S3method(st_as_sfc,SpatialPixels) S3method(st_as_sfc,SpatialPoints) S3method(st_as_sfc,SpatialPolygons) S3method(st_as_sfc,WKB) S3method(st_as_sfc,bbox) S3method(st_as_sfc,blob) S3method(st_as_sfc,character) S3method(st_as_sfc,dimensions) S3method(st_as_sfc,factor) S3method(st_as_sfc,list) S3method(st_as_sfc,map) S3method(st_as_sfc,owin) S3method(st_as_sfc,pq_geometry) S3method(st_as_sfc,psp) S3method(st_as_sfc,raw) S3method(st_as_sfc,s2_geography) S3method(st_as_sfc,sf) S3method(st_as_sfc,tess) S3method(st_as_text,crs) S3method(st_as_text,sfc) S3method(st_as_text,sfg) S3method(st_bbox,CIRCULARSTRING) S3method(st_bbox,COMPOUNDCURVE) S3method(st_bbox,CURVEPOLYGON) S3method(st_bbox,Extent) S3method(st_bbox,GEOMETRYCOLLECTION) S3method(st_bbox,LINESTRING) S3method(st_bbox,MULTICURVE) S3method(st_bbox,MULTILINESTRING) S3method(st_bbox,MULTIPOINT) S3method(st_bbox,MULTIPOLYGON) S3method(st_bbox,MULTISURFACE) S3method(st_bbox,POINT) S3method(st_bbox,POLYGON) S3method(st_bbox,POLYHEDRALSURFACE) S3method(st_bbox,Raster) S3method(st_bbox,SpatExtent) S3method(st_bbox,SpatRaster) S3method(st_bbox,SpatVector) S3method(st_bbox,Spatial) S3method(st_bbox,TIN) S3method(st_bbox,TRIANGLE) S3method(st_bbox,bbox) S3method(st_bbox,numeric) S3method(st_bbox,sf) S3method(st_bbox,sfc) S3method(st_boundary,sf) S3method(st_boundary,sfc) S3method(st_boundary,sfg) S3method(st_break_antimeridian,sf) S3method(st_break_antimeridian,sfc) S3method(st_buffer,sf) S3method(st_buffer,sfc) S3method(st_buffer,sfg) S3method(st_cast,CIRCULARSTRING) S3method(st_cast,COMPOUNDCURVE) S3method(st_cast,CURVE) S3method(st_cast,GEOMETRYCOLLECTION) S3method(st_cast,LINESTRING) S3method(st_cast,MULTICURVE) S3method(st_cast,MULTILINESTRING) S3method(st_cast,MULTIPOINT) S3method(st_cast,MULTIPOLYGON) S3method(st_cast,MULTISURFACE) S3method(st_cast,POINT) S3method(st_cast,POLYGON) S3method(st_cast,sf) S3method(st_cast,sfc) S3method(st_cast,sfc_CIRCULARSTRING) S3method(st_centroid,sf) S3method(st_centroid,sfc) S3method(st_centroid,sfg) S3method(st_collection_extract,sf) S3method(st_collection_extract,sfc) S3method(st_collection_extract,sfg) S3method(st_concave_hull,sf) S3method(st_concave_hull,sfc) S3method(st_concave_hull,sfg) S3method(st_convex_hull,sf) S3method(st_convex_hull,sfc) S3method(st_convex_hull,sfg) S3method(st_coordinates,sf) S3method(st_coordinates,sfc) S3method(st_coordinates,sfg) S3method(st_crop,sf) S3method(st_crop,sfc) S3method(st_crs,CRS) S3method(st_crs,Raster) S3method(st_crs,SpatRaster) S3method(st_crs,SpatVector) S3method(st_crs,Spatial) S3method(st_crs,bbox) S3method(st_crs,character) S3method(st_crs,crs) S3method(st_crs,default) S3method(st_crs,numeric) S3method(st_crs,sf) S3method(st_crs,sfc) S3method(st_difference,sf) S3method(st_difference,sfc) S3method(st_difference,sfg) S3method(st_drop_geometry,default) S3method(st_drop_geometry,sf) S3method(st_exterior_ring,sf) S3method(st_exterior_ring,sfc) S3method(st_exterior_ring,sfg) S3method(st_filter,sf) S3method(st_geometry,sf) S3method(st_geometry,sfc) S3method(st_geometry,sfg) S3method(st_inscribed_circle,sf) S3method(st_inscribed_circle,sfc) S3method(st_inscribed_circle,sfg) S3method(st_interpolate_aw,sf) S3method(st_intersection,sf) S3method(st_intersection,sfc) S3method(st_intersection,sfg) S3method(st_intersects,sf) S3method(st_intersects,sfc) S3method(st_intersects,sfg) S3method(st_is,sf) S3method(st_is,sfc) S3method(st_is,sfg) S3method(st_is_full,bbox) S3method(st_is_full,sf) S3method(st_is_full,sfc) S3method(st_is_full,sfg) S3method(st_is_valid,sf) S3method(st_is_valid,sfc) S3method(st_is_valid,sfg) S3method(st_join,sf) S3method(st_line_merge,sf) S3method(st_line_merge,sfc) S3method(st_line_merge,sfg) S3method(st_m_range,CIRCULARSTRING) S3method(st_m_range,COMPOUNDCURVE) S3method(st_m_range,CURVEPOLYGON) S3method(st_m_range,GEOMETRYCOLLECTION) S3method(st_m_range,LINESTRING) S3method(st_m_range,MULTICURVE) S3method(st_m_range,MULTILINESTRING) S3method(st_m_range,MULTIPOINT) S3method(st_m_range,MULTIPOLYGON) S3method(st_m_range,MULTISURFACE) S3method(st_m_range,POINT) S3method(st_m_range,POLYGON) S3method(st_m_range,POLYHEDRALSURFACE) S3method(st_m_range,TIN) S3method(st_m_range,TRIANGLE) S3method(st_m_range,m_range) S3method(st_m_range,numeric) S3method(st_m_range,sf) S3method(st_m_range,sfc) S3method(st_make_valid,sf) S3method(st_make_valid,sfc) S3method(st_make_valid,sfg) S3method(st_minimum_bounding_circle,sf) S3method(st_minimum_bounding_circle,sfc) S3method(st_minimum_bounding_circle,sfg) S3method(st_minimum_rotated_rectangle,sf) S3method(st_minimum_rotated_rectangle,sfc) S3method(st_minimum_rotated_rectangle,sfg) S3method(st_nearest_points,sf) S3method(st_nearest_points,sfc) S3method(st_nearest_points,sfg) S3method(st_node,sf) S3method(st_node,sfc) S3method(st_node,sfg) S3method(st_normalize,sf) S3method(st_normalize,sfc) S3method(st_normalize,sfg) S3method(st_point_on_surface,sf) S3method(st_point_on_surface,sfc) S3method(st_point_on_surface,sfg) S3method(st_polygonize,sf) S3method(st_polygonize,sfc) S3method(st_polygonize,sfg) S3method(st_precision,sf) S3method(st_precision,sfc) S3method(st_read,DBIObject) S3method(st_read,Pool) S3method(st_read,PostgreSQLConnection) S3method(st_read,character) S3method(st_read,default) S3method(st_reverse,sf) S3method(st_reverse,sfc) S3method(st_reverse,sfg) S3method(st_sample,bbox) S3method(st_sample,sf) S3method(st_sample,sfc) S3method(st_sample,sfg) S3method(st_segmentize,sf) S3method(st_segmentize,sfc) S3method(st_segmentize,sfg) S3method(st_set_precision,sf) S3method(st_set_precision,sfc) S3method(st_shift_longitude,sf) S3method(st_shift_longitude,sfc) S3method(st_simplify,sf) S3method(st_simplify,sfc) S3method(st_simplify,sfg) S3method(st_snap,sf) S3method(st_snap,sfc) S3method(st_snap,sfg) S3method(st_sym_difference,sf) S3method(st_sym_difference,sfc) S3method(st_sym_difference,sfg) S3method(st_transform,bbox) S3method(st_transform,sf) S3method(st_transform,sfc) S3method(st_transform,sfg) S3method(st_triangulate,sf) S3method(st_triangulate,sfc) S3method(st_triangulate,sfg) S3method(st_triangulate_constrained,sf) S3method(st_triangulate_constrained,sfc) S3method(st_triangulate_constrained,sfg) S3method(st_union,sf) S3method(st_union,sfc) S3method(st_union,sfg) S3method(st_voronoi,sf) S3method(st_voronoi,sfc) S3method(st_voronoi,sfg) S3method(st_wrap_dateline,sf) S3method(st_wrap_dateline,sfc) S3method(st_wrap_dateline,sfg) S3method(st_write,data.frame) S3method(st_write,sf) S3method(st_write,sfc) S3method(st_z_range,CIRCULARSTRING) S3method(st_z_range,COMPOUNDCURVE) S3method(st_z_range,CURVEPOLYGON) S3method(st_z_range,GEOMETRYCOLLECTION) S3method(st_z_range,LINESTRING) S3method(st_z_range,MULTICURVE) S3method(st_z_range,MULTILINESTRING) S3method(st_z_range,MULTIPOINT) S3method(st_z_range,MULTIPOLYGON) S3method(st_z_range,MULTISURFACE) S3method(st_z_range,POINT) S3method(st_z_range,POLYGON) S3method(st_z_range,POLYHEDRALSURFACE) S3method(st_z_range,TIN) S3method(st_z_range,TRIANGLE) S3method(st_z_range,numeric) S3method(st_z_range,sf) S3method(st_z_range,sfc) S3method(st_z_range,z_range) S3method(st_zm,list) S3method(st_zm,matrix) S3method(st_zm,sf) S3method(st_zm,sfc) S3method(st_zm,sfg) S3method(str,sfc) S3method(summary,sfc) S3method(t,sgbp) S3method(text,sf) S3method(text,sfc) S3method(transform,sf) S3method(unique,sfc) S3method(xtfrm,sfc) export("st_agr<-") export("st_crs<-") export("st_geometry<-") export("st_precision<-") export(.degAxis) export(.get_layout) export(.image_scale) export(.image_scale_factor) export(.stop_geos) export(FULL_bbox_) export(NA_agr_) export(NA_bbox_) export(NA_crs_) export(NA_m_range_) export(NA_z_range_) export(as_Spatial) export(gdal_addo) export(gdal_compressors) export(gdal_create) export(gdal_crs) export(gdal_extract) export(gdal_inv_geotransform) export(gdal_metadata) export(gdal_polygonize) export(gdal_rasterize) export(gdal_read) export(gdal_read_mdim) export(gdal_subdatasets) export(gdal_utils) export(gdal_write) export(gdal_write_mdim) export(get_key_pos) export(plot_sf) export(rawToHex) export(read_sf) export(sf.colors) export(sf_add_proj_units) export(sf_extSoftVersion) export(sf_proj_info) export(sf_proj_network) export(sf_proj_pipelines) export(sf_proj_search_paths) export(sf_project) export(sf_use_s2) export(st_agr) export(st_area) export(st_as_binary) export(st_as_grob) export(st_as_s2) export(st_as_sf) export(st_as_sfc) export(st_as_text) export(st_axis_order) export(st_bbox) export(st_bind_cols) export(st_boundary) export(st_break_antimeridian) export(st_buffer) export(st_can_transform) export(st_cast) export(st_centroid) export(st_collection_extract) export(st_combine) export(st_concave_hull) export(st_contains) export(st_contains_properly) export(st_convex_hull) export(st_coordinates) export(st_covered_by) export(st_covers) export(st_crop) export(st_crosses) export(st_crs) export(st_delete) export(st_difference) export(st_dimension) export(st_disjoint) export(st_distance) export(st_drivers) export(st_drop_geometry) export(st_equals) export(st_equals_exact) export(st_exterior_ring) export(st_filter) export(st_geometry) export(st_geometry_type) export(st_geometrycollection) export(st_graticule) export(st_inscribed_circle) export(st_interpolate_aw) export(st_intersection) export(st_intersects) export(st_is) export(st_is_empty) export(st_is_full) export(st_is_longlat) export(st_is_simple) export(st_is_valid) export(st_is_within_distance) export(st_jitter) export(st_join) export(st_layers) export(st_length) export(st_line_interpolate) export(st_line_merge) export(st_line_project) export(st_line_sample) export(st_linestring) export(st_m_range) export(st_make_grid) export(st_make_valid) export(st_minimum_bounding_circle) export(st_minimum_rotated_rectangle) export(st_multilinestring) export(st_multipoint) export(st_multipolygon) export(st_nearest_feature) export(st_nearest_points) export(st_node) export(st_normalize) export(st_overlaps) export(st_perimeter) export(st_point) export(st_point_on_surface) export(st_polygon) export(st_polygonize) export(st_precision) export(st_read) export(st_read_db) export(st_relate) export(st_reverse) export(st_sample) export(st_segmentize) export(st_set_agr) export(st_set_crs) export(st_set_geometry) export(st_set_precision) export(st_sf) export(st_sfc) export(st_shift_longitude) export(st_simplify) export(st_snap) export(st_sym_difference) export(st_touches) export(st_transform) export(st_triangulate) export(st_triangulate_constrained) export(st_union) export(st_viewport) export(st_voronoi) export(st_within) export(st_wrap_dateline) export(st_write) export(st_write_db) export(st_z_range) export(st_zm) export(write_sf) exportMethods(dbDataType) exportMethods(dbWriteTable) import(graphics) importClassesFrom(DBI,DBIObject) importFrom(DBI,dbConnect) importFrom(DBI,dbDisconnect) importFrom(DBI,dbExecute) importFrom(DBI,dbGetQuery) importFrom(DBI,dbReadTable) importFrom(DBI,dbSendQuery) importFrom(DBI,dbWriteTable) importFrom(classInt,classIntervals) importFrom(grDevices,cm) importFrom(grDevices,dev.size) importFrom(grDevices,rgb) importFrom(grid,convertHeight) importFrom(grid,convertUnit) importFrom(grid,convertWidth) importFrom(grid,current.viewport) importFrom(grid,gList) importFrom(grid,gpar) importFrom(grid,linesGrob) importFrom(grid,nullGrob) importFrom(grid,pathGrob) importFrom(grid,pointsGrob) importFrom(grid,polylineGrob) importFrom(grid,unit) importFrom(grid,viewport) importFrom(methods,"slot<-") importFrom(methods,as) importFrom(methods,new) importFrom(methods,slot) importFrom(methods,slotNames) importFrom(stats,aggregate) importFrom(stats,dist) importFrom(stats,na.omit) importFrom(stats,rbinom) importFrom(stats,runif) importFrom(stats,setNames) importFrom(tools,file_ext) importFrom(tools,file_path_sans_ext) importFrom(units,as_units) importFrom(units,drop_units) importFrom(units,make_unit_label) importFrom(units,set_units) importFrom(utils,compareVersion) importFrom(utils,globalVariables) importFrom(utils,head) importFrom(utils,object.size) importFrom(utils,packageVersion) importFrom(utils,str) importFrom(utils,tail) importMethodsFrom(DBI,dbDataType) importMethodsFrom(DBI,dbExistsTable) importMethodsFrom(DBI,dbWriteTable) useDynLib(sf, .registration=TRUE) ================================================ FILE: NEWS.md ================================================ # version 1.1-1 * use RAII in functions calling GEOS for handling context, based on how terra does this; #2604 * `st_graticule()` simplifies output lines; #1364 * `dplyr::count()` drops geometries if `.drop_geom = TRUE` is set; #2596 * better handle graticules crossing the antemeridian; #2561 * add the option `by_element = TRUE` to binary geometry predicates, measures and transformers; #2594 and #2595 by @rariariari w. help from Claude * add `MULTISURFACE` and `CURVEPOLYGON` to vctrs methods; #2589 #2601  * add argument `include_non_intersected` to `st_interpolate_aw()` * add argument `weights`, for dasymetric mapping, to `st_interpolate_aw()` (experimental) * replace magrittr pipe `%>%` with base pipe `|>`, and hence require R >= 4.1.0 # version 1.1-0 * `gdal_compressors()` queries GDAL compressor and decompressor capabilities * `st_cast.sfc()` deals with zero-length objects; #2584 * rewrite/migrate `vctrs` methods for `sf` and `sfc`; #2568, #2584, w. help from @DavisVaughan * `st_agr()` and `st_agr<-()` better handle multiple geometry columns * for an `sfc` object `x`, `x[0]` retains the class of `x`; #2568 * When sampling a degenerate (zero length) line, a warning is raised rather than a message; #2575 # version 1.0-24 * `gdal_write()` handles drivers that only have a `CreateCopy()` option; https://github.com/r-spatial/stars/issues/762 * if `datum` is missing in a call to `st_graticule()`, a graticule by default will try to use the geographic coordinate reference system of arguments `x` or `crs`; when nothing is found there it falls back to `OGC:CRS84` (WGS84). * the figure margins parameter `mar` can be specified in a call to `plot.sf()`; #2558 * fix class label setting in `[.sf()`; #2557 # version 1.0-23 * allow tests reading blosc compressed Zarr files to fail * `st_as_sf.data.frame()` sets `z_range` and `m_range` if needed; https://github.com/geoarrow/geoarrow-r/issues/75 # version 1.0-22 * `st_combine()` on `POINT` geometries ignores empty points; #2551 * handle empty points better in `st_point()`, `st_as_sf.data.frame()` and `st_distance()`; https://github.com/r-spatial/s2/issues/289 * for unprojected lines, `st_line_interpolate()` requires distance values with degree units; #2542 * `unique.sfc()` added; #2546 * for geodetic coordinates, `st_perimeter()` uses ellipsoidal computation if `sf_use_s2()` is `FALSE`; #2541 * `st_as_sf.owin()` and `st_as_sfc.owin()` no longer ignore `crs` argument; #2532 * clarify approximation errors in `st_buffer()` and how they differ for the GEOS or S2 backends, with examples by David Kaplan @dmkaplan2000; #2528 # version 1.0-21 * `st_crs(..., parameters = TRUE)` returns base geographic CRS as `gcs_crs`; #2524 * loading `sf` no longer initializes the RNG state; see https://github.com/r-quantities/units/issues/409 * fix `st_sample()` on geodetic coordinates; #2515 * use `compareVersion()` consistently to compare GDAL versions; #2512 # version 1.0-20 * `st_buffer()` on geodetic coordinates with negative buffer distance now automatically switches to using GEOS, while giving a warning; #1987 * `st_interpolate_aw()` fixes bug when a GEOMETRYCOLLECTION contains multiple POLYGON structures; found by @mtennekes * `st_buffer()` for geodetic coordinates allows `max_dist` and `min_level` to be specified by feature; #2488 and https://github.com/r-spatial/s2/pull/264 * `distinct.sf()` allows for comparing exact equality of geometries when `exact = TRUE`; #2484 * `st_minimum_bounding_circle()` returns geometries representing the smallest circle that contains the input; #2473 # version 1.0-19 * fix type checks in C++ GDAL area and length computation functions, anticipating GDAL 3.10.0; #2466, #2468, #2469 by @rsbivand and @rouault * improve test on empty geometries, which changed in 1.0-18; #2463 * `gdal_utils()` `ogrinfo` has an argument `read_only` which, when `TRUE` (or `options` includes `"-ro"`), opens a datasource in read-only mode (#2460; `sf` did this before 1.0-17); by default a datasource is opened in update (read-write) mode (since sf 1.0-17; #2420) * the `sf` -> `ppp` conversion `as.ppp.sf()` accepts a data.frame of marks instead of just 1 column #2450, by @agila5 * add flag for preservation of point order in `st_voronoi` #1371 for GEOS >= 3.12 # version 1.0-18 * support `POLYGON FULL` simple feature geometry, representing the entire Earth surface, as used by `s2geometry`; see also https://r-spatial.org/r/2024/10/11/polygonfull.html for a longer introduction; #2441 * `st_sfc()` has an argument `oriented` which, when set to `TRUE`, adds an attribute `oriented=TRUE` to an `sfc` object, indicating that this object should not be reoriented in conversion to `s2_geography` (avoiding using the global option `s2_oriented`); `st_as_sfc.bbox()` sets this to `TRUE`; #2441 * fix build failure with GDAL < 3.4.0 #2436 * `st_simplify()` now accepts feature-wise tolerance values when `s2` is switched on #2442 # version 1.0-17 * add `st_transform()` method for `bbox` objects; this uses OGRCoordinateTransformation::TransformBounds(), densifying first and antemeridian proof; #2415 * `st_filter.sf()` correctly scopes `x` and `y` arguments using !! operator; #2416 * `[.sfc` and `[<-.sfc` use matrix/array type subsetting for `sfc` objects that have a `dim` attribute * add `st_exterior_ring()` to extract exterior rings (remove holes); #2406 * add `text.sf()`, `text.sfc()`, `points.sf()`, `points.sfc()` to annotate base plots at geometry centroids; #2399 * `st_sf()` no longer strips `tbl` or `tbl_df` class labels; #2378 * `st_layers()` returns an object of class `c("sf_layers", "data.frame")`, with a dedicated `print` method. * when `dim` is not `XYZM`, `sf_as_sf.data.frame()` interprets a length 4 `coords` argument to specify the corners of a rectangular polygon; #2357 * `st_interpolate_aw()` gains an `na.rm` argument, for removing features with `NA` attributes before interpolating; #830 * `merge.sf()` no longer renames geometry column; #2334 # version 1.0-16 * `st_join()` no longer renames the geometry column; #2327 * `st_sample()` works when unprojected polygon geometry crosses the antemeridian; #2331 * clean up and modernization of S3 registration of methods and tests; #2285, #2288, #2316, #2341, #2342, by @olivroy * `[.sfc` works when setting argument `op`; #2320 * `st_sample()` for polygons is sensitive to setting `oriented = TRUE` to prevent wrongly correcting ring directions; #2308 * add support for the GDAL `footprint` utility (requiring GDAL >= 3.8.0) to `gdal_utils`; #2305, by @goergen95 * existing environment variables `PROJ_LIB` and `PROJ_DATA` are (again) ignored on `sf` binary CRAN installations (win + macos), effectively by overwriting them during the R session and restoring them on exit; this does not happen if environment variable `R_SF_USE_PROJ_DATA` is set to `true`. #2298 * add `st_line_project()` to find how far a point is when projected on a line; #2291 * add `st_line_interpolate()` to obtain a point at a certain distance along a line; #2291 # version 1.0-15 * add `st_perimeter()` generic to cover both geographic and projected coordinates; #268, #2279, by @JosiahParry * add `st_sample()` method for `bbox`, with special provisions for ellipsoidal coordinates; #2283 * documentation clean-up by @olivroy; #2266, #2285 * `st_convex_hull()` uses `s2::s2_convex_hull()` for geodetic coordinates; #2250 * add `directed` argument to `st_line_merge()`; #2264 * `st_union.sfc()` given `x` and `y` works consistently across geodetic and projected objects; #2262 * `st_union.sf()` given `x` and `y` unions pairwise if `by_feature = TRUE`; #2259 * `st_read()` work around issue with GPKG driver if `wkt_filter` is set; #2248 * `st_read()` uses GDAL's stream reading when `use_stream = TRUE`; #2238 by @paleolimbot * `st_transform()` responds to in-session changes to `sf_proj_network()`; #2166 * `plot.sf()`: `key.width` is sensitive to pointsize graphics parameter `par("ps")`; keys with factor levels suggest a proper size if they won't fit. * `plot.sf()`: `key.pos` can hold a second value in [0, 1] determining the relative position of the key in the available space * `[<-.sf` fixes the `agr` attribute when it is broken; #2211 * if the env. variable `ADD_SF_NAMESPACE` is set to `true`, `sf` objects get a new attribute, `.sf_namespace`, which forces loading the `sf` namespace when it has not been loaded so far, e.g. for proper printing or plotting of an `sf` object; #2212 by Mike Mahoney * `distinct.sf()` is type-safe for `sf` objects with zero rows; #2204 * `summarise.sf()` raises an error if `.by` is given but no `across()` on the geometry; #2207 * `st_write()` matches fields on name first, than on position; this matters for formats that have pre-defined names, such as GPX; #2202 # version 1.0-14 * fix `plot.sf()` when using a key for multiple factor variables; #2196, #2195 * fix use of `as.numeric_version` in a test, for upcoming change in r-devel * code tidy-ing: fix many lintr suggestions, thanks to Michael Chirico (#2181 - #2191) # version 1.0-13 * `gdal_utils()` adds `"ogrinfo"` utility (requires GDAL >= 3.7.0); #2160 * `st_as_sf()` catches errors when setting invalid crs values, raised by Jon Skøien * add `rename_with.sf()` method; #1472 * use GEOS' overlayNG routines for (GEOS) Intersection, Difference, Union and SymDifference; #2143 * added `duplicated.sf()`; #2138, #2140, thanks to @bart1 * `select.sf()` allows selecting the same column twice under different names; #1886 * `st_as_sf.ppplist()` is deprecated; #1926 * `st_cast()` handles empty geometries; #1961 * don't repeat longlat messages in `summarise.sf()`; #1519 * fix random sampling on the sphere; #2133 # version 1.0-12 * update NAMESPACE to `useDynLib(sf, .registration=TRUE)`; #2127 thanks to @eddelbuettel * fix call in `gdal_addo()`; #2124 * fix issues that came up with older GDAL version, use `GDAL_VERSION_NUM` consistently; #2123 #2121 #2119 # version 1.0-11 * `st_make_grid()` also accepts area units for `cellsize`, for square and hexagonal grids; #1505 * add `st_concave_hull()`, for concave hulls, if GEOS >= 3.11.0; #1964 * add `st_triangulate_constrained()`, for constrained Delaunay triangulation, if GEOS >= 3.10.0; #1964 * clean up the retrieval of length or angle units from WKT representations; https://lists.osgeo.org/pipermail/gdal-dev/2023-March/056994.html * conversion to GEOS uses the `GEOS_PREC_VALID_OUTPUT` flag, which makes sure that the "[o]utput is always valid. Collapsed geometry elements (including both polygons and lines) are removed." # version 1.0-10 * `gdal_utils()` has a `config_options` argument to set further GDAL options, just like `st_write()`; #2003 * fix slow writing of logical vectors in `st_write()`; #1409; #1689 * `st_drivers()` has an argument `regex` to filter on driver (long) name; #2090 * drop C++11 as a system requirement * `c.sfc()` (and, consequently, `dplyr::bind_rows()`) gives an error if components have different CRS; #1884 * data imported from `maps` are associated with the Clark 1866 ellipsoid; #2080 * fix importing legacy `SpatialPolygon` objects without comments; #2063, #2069, https://github.com/rstudio/leaflet/issues/833 * `st_read()` no longer errors on mixes of `XY` and `XYZ` geometries; #2046 #1592 * in `plot.sf()`, when numeric `breaks` are given a legend key is always plotted; #2065 * `st_crs()$axes` returns a `data.frame` with axes properties (name, orientation, conversion factor) when GDAL >= 3.0.0 * clean up unit handling for geometry measures (length, area, distance) and crs; * `st_crs(x)$ud_unit` returns `NULL` if units are unknown; #2049 * `st_write()` substitutes an `NA` crs with `ENGCRS["Undefined Cartesian SRS with unknown unit"]`; #2049, #2054 * `st_can_transform()` checks whether a transformation between two crs exists; see https://github.com/dieghernan/tidyterra/issues/64; #2049 * the matrix returned by `st_coordinates()` has no row names, to reduce output size # version 1.0-9 * adjust for changes how R-devel handles `POSIXlt`; #2028 * add `st_break_antimeridian()`; #1983, #1991 by Roger Bivand * add `Fibonacci` as a spatial sampling type in `st_sample()` * use the global `options("sf_use_s2")` to determine whether to use s2, rather than a value in a local environment; #1977 * fix utils `mdiminfo` and `mdimtranslate` in `gdal_utils()` * extend arguments of `gdal_read_mdim()` needed by `stars::read_mdim()` if `stars` >= 0.5-7; add `gdal_write_mdim()` * add `drop_na()` method for `sf` objects; #1975 # version 1.0-8 * `st_drop_geometry.default()` returns `x` unmodified; * `sf_project()` accepts 3- or 4-column matrices, containing z and t values; * optimization for `st_sfc()` by @paleolimbot; #1938, #1925 * `[<-.sfc()` recomputes the bounding box; `st_sfc()` gets parameter `compute_bbox`; #1965 * add new algorithm and drop option to `st_make_valid()` when using GEOS and GEOS >= 3.10.1; #1655 * add `st_minimum_rotated_rectangle()`, available when GEOS >= 3.9.0; #1953 * fix `st_sample()` with `type = "hexagonal"` for corner case (n=1), add a `progress` argument for a progress bar; #1945 * add package `pbapply` to Suggests; #1945 * add pdf driver to windows build; #1942 * clarify `pipeline` argument in `st_transform()` when axis order is ambiguous; #1934 * handle argument `xpd` in calls to `plot.sfc_POLYGON()` and `plot.sfc_MULTIPOLYGON()` * add `pivot_wider()` method, by Henning Teickner; #1915 * add `gdal_addo()` to add or remove overviews from raster images; #1921 * `st_layers()` returns `crs` of each layer in a `crs` list of `crs` objects * restore `st_graticule()` behaviour to pre-sf 1.0-0; https://github.com/tidyverse/ggplot2/issues/4571 * `gdal_metadata()` sets metadata item names properly * `st_read()` gains an argument `optional` passed on to `as.data.frame` to avoid changing column names; #1916 * GPX files are autodetected by `st_read()`; #1917 * unnecessary coordinate names are not returned in `st_sample()`, making the output size smaller; #1879 # version 1.0-7 * `st_drop_geometry()` is a generic; #1914 * `st_crs(x)$ud_unit` returns the unit of the coordinate reference system of `x` * geometric predicates return `sgbp` objects omitting self-intersections etc. by passing `remove_self = TRUE` and unique symmetric relationship by passing `retain_unique = TRUE` (to `...` if needed); this simplifies identifying (and removing) duplicated geometries; duplicates are identified by e.g. by `st_equals(x, retain_unique = TRUE) |> unlist() |> unique()`; #1893 * fix compile issue against GDAL < 2.5.0 introduced in 1.0-6; #1899 # version 1.0-6 * adapt to new `spatstat.random` package; #1892 * `st_geometry<-()` also allows to rename a geometry column in an `sf` object; #1890 * for `sf` objects, the `st_as_sfc()` method is an alias for `st_geometry()`; #1882 * `st_make_grid()` speeded up; #1579 thanks to Krzysztof Dyba * remove direct and indirect dependencies on `rgeos` and `rgdal`; #1869 * use `stats::dist` rather than GEOS for symmetric point-point Euclidian distance computation; #1874 # version 1.0-5 * package startup message reports status of `sf_use_s2()`; #1782 * `sf_use_s2()` uses `message()` to report a change; #1782 * `st_sample()` using regular sampling for ellipsoidal coordinates "works" as if coordinates were Cartesian; #1837 # version 1.0-4 * new function `st_delete()` deletes a data source, or layer(s) within a data source; #1828 * fix memory leak in `WKT1_ESRI` retrieval; #1690 # version 1.0-3 * cope with how GEOS >= 3.10.0 handles illegal geometries (e.g., non-closed rings); #1807 * `crs` objects have a `$srid` method to extract the SRID (as authority "name:code"); #1804 * `st_as_grob()` methods for `sfc_*` objects correctly handle empty geometries; #1789 with help from Hiroaki Yutani * when writing objects with `NA` as CRS to GeoPackage, assign "Unknown Cartesian CRS" first - this is in line with using Cartesian geometry operations for objects with `NA` as CRS; #1776 * add coerce method from `sgbp` to `sparseMatrix`; #1750 * fix `st_cast()` for `GEOMETRYCOLLECTIONS` containing empty geometries; #1767 * fix `st_is_valid()` for bogus polygons and projected coordinates; #1666, #1760; #1761 # version 1.0-2 * `st_read()` and `st_write()` using GDAL handle binary attributes (OFTBinary fields) ; #1721 * a `pivot_longer` method is added for `sf` objects (the `data.frame` method works, but raises a warning) * `rbind.sf` preserves primary geometry column; #1717 * `configure` constrains using `--static` to `Darwin` platform; #1702, #1712, #1713 * old-style `crs` objects created with sf < 0.9-0 generate a message, and will cause a warning in the future. * when `st_crs()` is called with a WKT2 as text input, its `input` field will be replaced with the CRS name (if it has one). * GEOS (>= 3.9.0) operations use `GEOSGeom_setPrecision_r` to set precision of geometries; #1535 * `st_read()` with specified `query` ignores argument `layers`, and warns if it is given; #1444 # version 1.0-1 * fix regression in `st_intersection()`: when using s2 attributes were assigned wrongly; #1704 * `crs` (sf) to `CRS` (sp) conversion no longer needs validation by `rgdal`; https://github.com/edzer/sp/issues/107 * retrieve ESRI's WKT version of CRS by `st_crs(id)$WKT1_ESRI`; #1690 # version 1.0-0 * add `s2` to Imports: * add Dewey Dunnington to contributors * `sf_use_s2()` prints a message when using s2 has been switched to on or off. * use `s2` spherical geometry as default when coordinates are ellipsoidal. This can be switched off (defaulting to planar geometry, using GEOS, as in sf < 1.0-0) by setting environment variable `_SF_USE_S2` to `false` before package `sf` is loaded, or by `sf_use_s2(FALSE)`; #1649 * `st_nearest_feature()` with missing `y` returns nearest features in the remaining set of `x`; https://github.com/r-spatial/s2/issues/111 * `st_write()` gains an argument `config_options` to set GDAL config options; #1618 * fix regression in `sf_project(..., keep = TRUE)`; #1635 # version 0.9-8 * add `st_as_sf()` method for terra's `SpatVector` class; #1567 * `distinct.sf()` works by default on all variables, and keeps active geometry active; #1613 * improve (fix?) polygonize/contour code; #1608 * `sf_proj_network()` reports whether PROJ uses network (CDN) grids, can switch it on or off, and can set the CDN url. * `st_write()` returns obj, invisibly; #1597 * fix regression in n-ary `st_intersection()`, #1595, introduced at #1549 * `st_inscribed_circle()` computes the maximum inscribed circle for polygons (requires GEOS >= 3.9.0) * allow to `st_cast()` from COMPOUNDCURVE, MULTISURFACE or CURVEPOLYGON to GEOMETRYCOLLECTION, and back; #1573 * Fixed a bug in `st_as_grob()` when plotting a mix of MULTI and non-MULTI geometries of the same base type # version 0.9-7 * n-ary `st_intersection()` skips failing geometries, rather than returning an error; #1549 * use `s2_centroid()` for geographical coordinates if `sf_use_s2()` is `TRUE`. * `st_as_text()` method for `crs` objects can return projjson (if GDAL >= 3.1.0 and PROJ > 6.2.0) * `st_transform()` no longer warns on conversions like `"+proj=ob_tran +o_proj=longlat +o_lat_p=45 +o_lon_p=30"` * `st_as_wkb()` takes `srid` from `wkt` field of `crs` when `input` field doesn't contain it; #1490 * `plot.sf()` adds `key.pos=0` option to run the logic behind the key without plotting it; #1487 * fix bug in `select.sf()` when selected variables were renamed; #1483 * `st_as_sf.stars(..., merge = TRUE)` now works if CRS is `NA`; #1389 * add (dynamically loaded) `as_wkb()` methods for `sf`, `sfc` and `sfg`, making `st_as_s2()` unnecessary * `st_as_s2()` transforms non-longlat objects to EPSG:4326 first # version 0.9-6 * `gdal_utils()` print (GDAL-style) progress bar if `quiet = FALSE` (except for `info` and `mdiminfo`) * fix `CPL_gdal_warper` for multi bands; https://github.com/r-spatial/stars/issues/320 * `sf_proj_search_paths()` retrieves and sets the proj search path (if GDAL > 3.0.3) * when loading sf, `sf_use_s2()` is set to `FALSE` unless environment variable `_SF_USE_S2` equals `true` (this changes to `TRUE` in sf 1.0-0) * resolve GDAL/PROJ version vulnerabilities in CRS-crs conversion; #1479 * `st_sample()` gains an argument, `by_polygon`, to more clevery sample `MULTIPOLYGON` geometries; #1480 * `st_sample()` accepts non-integer sample sizes, with a (suppressable) warning and handles values of sizes that would round to zero; #1480 * `gdal_utils()` adds utils `mdiminfo` and `mdimtranslate` (requires GDAL >= 3.1) * `st_union()` gains an argument `is_coverage`, which, when set to `TRUE`, leads to much faster unioning in case features form a coverage (polygons don't overlap); #1462 by Don Baston * fix `gdal_utils("translate")` locking input file; #1452 * `st_make_grid()` no longer selects cells intersecting with `x`; #1447 * use `s2::s2_dwithin_matrix()` in `st_is_within_distance()`; #1367 # version 0.9-5 * Only when package `s2` >= 1.0.1 is available: support for spherical geometry operators (predicates, transformers, measures, nearest point/feature) for geographic coordinates in package `s2` is now by default switched off, and can be switched on by `sf_use_s2(TRUE)`; see https://www.r-spatial.org/r/2020/06/17/s2.html and vignette sf7. It is planned to be switched on by default in sf 1.0-0. * drop Z and/or M coordinate in `st_as_s2()`, with message * geometry predicates and transformers gain an ... argument to pass `s2::s2_options()` * `dplyr::select()` now ensures the geometry column sticks to the back rather than the front of the data frame; #1425 * `dplyr::rename()` now preserves the active geometry column even when it is renamed; #1431 * proj units query adjusted to PROJ 7.1.0 release; #1434 # version 0.9-4 * empty geom generators take care of XYZ etc dim; #1400 * `write_sf()` and `read_sf()` no longer warn when reading tables without geometries * `st_write()` writes non-spatial tables when given a plain `data.frame` or `tbl_df`; #1345 * the default for `stringsAsFactors` in `st_read` and `st_sf` is `FALSE` for R version >= 4.1.0 * the sf method for `dplyr::select()` supports renaming the geometry column; #1415 # version 0.9-3 * `st_is_valid()` is a generic * Windows CRAN binaries use GDAL 3.0.4, PROJ 6.3.1 and GEOS 3.8.0, thanks to Jeroen Ooms' rwinlib work; #1275 * `plot.sf()` gains an `extent` argument to set the extent (xlim, ylim) of the plot; `extent` must be an object with an `st_bbox()` method, such as an `sf` or a `stars` object; #1193 # version 0.9-2 * `st_axis_order(TRUE)` gives and error if GDAL has version < 2.5.0 * loading PROJ units `link`, `us_in`, `ind_yd`, `ind_ft`, and `ind_ch` into the udunits database is no longer done at package load time, but when function `sf_add_proj_units()` is called. * fix line sampling for small densities; #1365 * `sf_project()` handles `crs` objects when PROJ version is below 6 using proj.4 string representations. * avoid using `isFALSE` in `st_write()`; #1342 * fix regression in `gdal_utils("translate", ...)`; #1339 # version 0.9-1 * fix an invalid read bug in `st_m_range()`; #1332 * `st_crs(4326) == st_crs("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs")` returns `TRUE` for GDAL >= 3.0, irrespective authority compliance of axis order; see #1331 and https://github.com/ropensci/scrubr/issues/34 * `sf_project()` has a parameter `authority_compliant` to return coordinates in "visualisation order"; when `TRUE` it returns coordinates in authority compliant axis order (e.g. EPSG:4326 latitude longitude); default is `st_axis_order()`. * fix test for Solaris and certain GDAL/PROJ versions * fix error reading category table through GDAL; https://github.com/r-spatial/stars/issues/245 # version 0.9-0 * see r-spatial blog post: https://www.r-spatial.org/r/2020/03/17/wkt.html * modify `crs` objects to reflect our post-proj4string world (#1146; #1225): crs objects contain two fields, `input` with the user input (if any), and `wkt` with a well-known-text (or WKT2) representation of the coordinate reference system. `crs` objects have a `$` method to dynamically retrieve the `epsg` (integer) or `proj4string` representation, using e.g. `x$epsg`. * support for PostGIS 3 using WKT and the new-style `crs` objects; #1234, #1303, #1308 by @etiennebr * `st_write_db()` and `st_read_db()` are defunct. Use `st_write` and `st_read` instead. * `st_write()` uses `append`, replacing (and deprecating) argument `update`; `st_write` fails when a layer already exists and `append` has not been set explicitly to `TRUE` (append) or `FALSE` (overwrite); #1266 * `st_proj_info()` was renamed into `sf_proj_info`; `sf_proj_info` can get and set the PROJ data search path and use of CDN; #1277 * adapt to new `dplyr` version; https://github.com/tidyverse/dplyr/issues/4917 * `st_sample()` is a generic * write `stars` rasters with wkt info, rather than proj4strings * when GEOS >= 3.8.0, `st_make_valid` is provided by `sf` rather than by `lwgeom` #989 * allow for single-sided buffers for linear geometries; #1001 * add `st_reverse()` methods to reverse points in a linestring (requires GEOS >= 3.7.0); #1246 * `st_make_grid()` returns grid cells or points that intersect with the target geometry, not its bounding box; #1260 * allow for PROJ >= 7; #1254 * `st_geometry_type()` accepts `by_geometry` argument; #1264 # version 0.8-1 * `st_as_sf.map()` no longer requires `maptools` and `sp`; dropped dependency on maptools. * work around a bug in 6.0.0 <= PROJ < 6.3.1: replace `+init=epsg:XXXX ...` strings with the `XXXX` EPSG integer, to work around a bug in PROJ; see https://github.com/OSGeo/PROJ/pull/1875 and links therein. If `...` arguments are present, raise a warning that these are ignored. * `st_as_sf.map()` no longer requires `maptools` and `sp`; drop dependency on maptools. * conversion between `spatstat` classes `owin`, `ppp` and `psp` and `sf` classes no longer use `maptools`; #1204 * `gdal_utils()` processes open options `-oo` and `-doo` properly; https://github.com/ITSLeeds/geofabric/issues/12 * `st_sample()` directly interfaces `spatstat` sampling methods, e.g. `type = "Thomas"` calls `spatstat::rThomas` after converting input arguments (window) and converts returned `ppp` object to `sf`'s `POINT` geometries; #1204 with help from Ege Rubak and Jakub Nowosad * `sf_project()` gains an option `keep = TRUE` to return `Inf` values for points not projectable; #1228 * support `vctrs` methods for geometry list columns; this makes `unnest` work again (#1172); #1196 by Lionel Henry * `st_as_sf.pq_geometry()` converts binary geom columns from RPostgres::dbGetQuery; #1195 * `st_cast()` can convert `MULTICURVE` to `MULTILINESTRING`; #1194 * `st_read()` gains a parameter `wkt_filter` for spatially filtering the features to be read; #1192 * `st_area()` and `st_length()` handle `+to_meter` argument in PROJ strings; #1170 * add `st_filter()` generic for filtering on spatial features only; #1148 * a new UBSAN error in `wkb_read()` was resolved; #1154, #1152 * new method `st_shift_longitude()` to re-center data for a Pacific view. #1218 * output of `st_as_text()` with `MULTIPOINT` has nested parentheses around points. E.g., `MULTIPOINT ((0 0), (1 1))` instead of `MULTIPOINT (0 0, 1 1)`; #1219, #1221 # version 0.8-0 * fix tests for PROJ 6.2.0 not accepting +units= * fixes for tidyr 1.0-0 release; attempt to port `nest.sf()` and `unnest.sf()`; #1068, #1145 * `gdal_utils()` better closes connections after use; #1143 * `st_write()` gains a `drivers` options, to limit the drivers attempted; #1142 * rather than replacing, `st_write()` and `write_sf()` append to an existing layer if `update=TRUE`; #1126 * improve plotting of `POSIXct` and `Date` attributes (`Date` requiring classInt >= 0.4-2) * `NULL` geometries read by GDAL are returned as empty geometries; #1119 * `gdal_utils('rasterize', ...)` accepts non-existing destinations, defined by e.g. resolution and extent options (see #1116 for an example), and overwrites if needed (see #1136 for an example) * add Dan Baston as contributor; #1120 and many others * in addition to `NULL`, `st_sfc()` also converts `NA` values into empty geometries; #1114. * `st_join()` is a generic # version 0.7-7 * `plot()` handles `POSIXct` values in legend * constructor functions like `st_linestring()` check and break on `NA` coordinates; #1101, #1102 # version 0.7-6 * have examples of `st_write` write only to the temporary R session directory # version 0.7-5 * `as(x, "Spatial")` gives a proper error message on empty geometries; #1093 * `st_cast()` takes care of empty polygons; #1094 * `st_nearest_*` functions warn in case they are used with geographic coordinates; #1081 * `st_union()` no longer segfaults on zero row `sf` objects; #1077 * `st_transform()` no longer breaks on zero row `sf` objects; #1075 * when PROJ >= 6.1.0 is available and sf comes with datum files (as is the case with statically linked Windows and OSX CRAN binaries), `PROJ_LIB` is no longer temporarily overwritten, but the PROJ C api is used to set the datum path; #1074, suggested by Jeroen Ooms * sf compiles against GDAL 3.x and PROJ 6.1.0, using the new `proj.h` interface; #1070 * `st_distance()` returns `NA` for empty geometries, rather than 0; #1055 # version 0.7-4 * add example on how voronoi polygons can be tied back to the points they contain; #1030 * `st_difference(x, y)`, with `x` an `sfc` with zero feature geometries, returns `x`; #1024 * don't reset (base) plot device when `add = TRUE` * `==` and `!=` return `NA` when one of the operands is an empty geometry; #1013 * `st_intersects()` is a generic * drop requiring `proj_api.h` in favor of `proj.h`, this enables compatibility to PROJ 6.0.0 and GDAL 2.5.0-dev; #988 * fix regression in binary predicates introduced in #855; #999 reported by Barry Rowlingson * fix bug in `gdal_utils` util `warper` on certain GDAL/OS combinations; https://github.com/r-spatial/stars/issues/117 * `c.sfc()` ignores the type (class) of empty `sfc` objects when choosing the result type; #985, #982 * rename the default value for `distance` to `"Euclidean"`, rather than `"distance"` in `st_distance()` # version 0.7-3 * add argument `exact` to `st_sample()`, defaulting to `FALSE`; #896 * fixed n-ary `st_difference()` for cases where geometries are entirely contained in others; #975, by Jonathan Marshall * faster `Ops.sfc()`, added `st_normalize()`; #973 by Thomas Lin Pedersen * new grob constructor for sfc objects; #971 by Thomas Lin Pedersen; add Thomas as contributor * add `group_split()` and `group_map()` methods for `sf` objects (experimental); #969 * make `st_interpolate_aw()` a generic; * argument `col` for `plot` of `GEOMETRY` `sfc`'s is `NA` (open) for (multi) polygon geometries # version 0.7-2 * feature IDs are no longer returned as names on the geometry list column, but optionally returned by `st_read` as attribute column; #812 * when plotting multiple attributes, plot.sf adds a (single, common) key if `key.pos` is set * precision can be specified in distance units; #901 * support log-scale in color legend by setting `logz` to `TRUE` in `plot.sf` * `st_intersects()` etc. will prepare `y` when `y` is polygons and `x` is points; #885 by Dan Baston * `st_write()` (and `write_sf()`) returns its first argument, invisibly; #889 # version 0.7-1 * fix bug that broke n-ary `st_intersection()` on platforms using clang; #867 # version 0.7-0 * adds several interfaces to GDAL functions, meant to be used by package `stars` * `st_read()` receives a `query` argument that can run queries against OGR datasets; #834, by Barry Rowlingson and Michael Sumner * `read_sf()` no longer first creates tibbles from `data.frame`s, but creates them directly; #853, db propagation by Etienne Racine * check difference between compile-time and run-time GEOS versions; #844 * all GEOS routines are (more) robust against memory leaks, by using unique pointers; #822, #845, by Dan Baston * `st_buffer()` receives the buffer styles `endCapStyle`, `joinStyle` and `mitreLimit`; #833, #842 by Michael Sumner # version 0.6-4 * `st_area()` is a generic; https://github.com/r-spatial/stars/issues/32 * `st_write()` resolves `~` correctly; #456 * read and write feature IDs as sfc list column names; #812 * `st_centroid()` works for empty geometries, returning an empty point #769 * add `st_nearest_points()`, to obtain the (`LINESTRING` connecting the) two nearest points for pairs of geometries; #788 * add hexagonal tiling to `st_make_grid()` * add regular and hexagonal sampling to `st_sample()` * fixes for PROJ 5.0.1; #545 * fixes for GDAL 2.3.0; #759 * `st_sample()` supports regular sampling of `LINESTRING`; #725 by @statnmap * Support reading and writing of database `Pool` objects; #756 * fix plotting of `sf` objects without attributes; #755 * add reference to the [R Journal article](https://journal.r-project.org/articles/RJ-2018-009/index.html) in CITATION # version 0.6-3 * move dependency `RPostgreSQL` from Imports: back to Suggests: * `st_centroid.sf()` and `st_point_on_surface.sf` also warn if attributes are not constant over geometries. * `summarise()` allows the user to define geometries for summaries; #714, by Kirill Mueller * `plot.sf()` emits a warning if `col` does not have length 1 or `nrow(x)`, and requires `pal` (rather than `col`) to set a palette for factors. * `plot.sf()` provides control over legend keys using `key.length` and `key.width`, decrease default key length; #731 * `sgbp` objects receive an `as.data.frame` method; #715 # version 0.6-2 * GDAL read/write supports logical variables; #722 * add `st_crop()` to simplify cropping objects with a rectangular area; #720 * fix bug in `[<-` when columns are added to an `sf` object; #718 * use dynamic registration of S3 methods, similar to how hms does this; #710 by Kirill Mueller * (partially) address writing GPKG to network drive, writing to temp file first; #628 * add Kirill Mueller as contributor * `st_make_grid()` is faster; #708, by Dan Baston * `st_read()` and `st_write()` are generic, with methods for directly reading from and writing to database connections; `st_read_db` and `st_write_db` are deprecated; #558, thanks to Etienne Racine @etiennebr * Package `RPostgreSQL` moved from Suggests to Imports * restore compatibility with GDAL 2.0.x versions (which won't have `gdal_utils`); #686 * `read_sf()` can also read tables without geometry; #684, by Andy Teucher # version 0.6-1 * method `distinct()` works; #669, #672 * `+`, `-`, `*` and `/` for pairs of geometries (`sfg`, `sfc`) return geometric union, difference, intersection and symmetric difference, respectively. * `st_cast()` from `MULTIPOLYGON` to `MULTILINESTRING` should work properly; #660 * all Rcpp interfaces needed by package `stars` have been moved into `sf`; pkg `stars` is R-only, and only `sf` needs linking to GDAL. * `gdal_utils()` interfaces the 9 gdal utils using the C++ API * improve resetting (base) plots; add `reset = FALSE` in a call to `plot` to enable adding to plots that have a legend * `st_read()` returns a `data.frame` when a table contains no geometries, rather than giving an error; it does emit a warning in this case. See https://stat.ethz.ch/pipermail/r-sig-geo/2018-February/026344.html * move `pillar` from `Imports:` to `Suggests:` * update to the new rwinlib distribution of gdal (adds JPG2000); #639 * speed up computation of centroids for largest polygon; #623 * add `st_as_sfc.raw` method * Bugfix: binary operations (`st_intersection`, `st_difference`, etc) no longer fail when operating on data frames of class `"tbl_df"` with common column names; #644 # version 0.6-0 * add `pillar` to Imports: to provide method for printing WKT geometries in tibbles * `st_as_text`, and subsequently `format` and `print`, use argument `digits` (or `options(digits = n)`) to control the number of digits used for printing coordinates; default is `options("digits")`, which is typically 7. * `st_is_within_distance` works with geographic coordinates * `st_cast` from `MULTIPOLYGON` to `MULTILINESTRING` no longer changes the number of features/feature geometries, but conversion from `MULTIPOLYGON` to `LINESTRING` (typically) does; #596 * `st_distance` for long/lat geographic coordinates uses `lwgeom`, accepting all geometry types; argument `dist_fun` is deprecated as a consequence, and distance calculations are different from those in sf versions 0.5-5 or earlier; #593 * add package `lwgeom` to Suggests; `st_area`, `st_length`, `st_distance`, `st_segmentize` for long/lat CRS use package `lwgeom` instead of `geosphere`; #593 * `st_length` returns zero for polygon-type geometries; #593 * if present, add units of attribute to default plot title; #591 * add `unnest` method, which depends on `tidyr` > 0.7-2; #570 PR by @karldw * add `largest` option to `st_join` to get largest intersection match only; #547, by @tiernanmartin * change default maximum number of feature to print to 10, controllable by `options(sf_max_print)`; #556 * add `Hausdorff` (and `Frechet` for those with GEOS 3.7.0) as options to `st_distance`; add `par` for densified versions * add `st_snap`, for snapping geometries to other geometries, within a tolerance * make `st_wrap_dateline` a generic, with methods for `sf`, `sfc` and `sfg`; #541 * `plot.sf` and `st_as_grob` (used by ggplot2) are robust against misspecified ring directions (holes that have the same direction as the exterior rings), by using `rule = "evenodd"`; #540 * functions depending on `liblwgeom` (`st_make_valid`, `st_geohash`, `st_plit`) have been moved to their own package, https://github.com/r-spatial/lwgeom; argument `use_gdal` of `st_transform` has been deprecated, instead one can use `lwgeom::st_transform_proj`; sf no longer tries to link to liblwgeom; #509, #537, #487 * `st_read`, `st_sf` and `st_sfc` gain a parameter `check_ring_dir` (default: `FALSE`) that checks ring directions and corrects to: exterior counter clockwise, holes clockwise, when seen from above. * get rid of `classInt::classIntervals` warning if number of unique values is smaller than the number of breaks asked for # version 0.5-5 * have `classInt` in Imports:, to not break other package checks * add vignettes 5: plotting sf objects and 6: miscellaneous; #324 * add (default) color key to `plot.sf` if single map is plotted, contributed by @hughjonesd; #528 * `st_as_sfc` can read EWKT; #530 * argument `max.plot` takes its default from `options(sf_max.plot=n)`, if present; #516 * `plot.sf` gets an arguments `pal` to specify a color palette function; #526 * `plot.sf` gets arguments `breaks` and `nbreaks`; add support for `classInt::classIntervals` styles for finding class intervals (using `breaks`) * add `st_as_sf` methods for `ppp`, `lpp` and `psp` objects from spatstat. * allow for direct route to proj.4 ignoring GDAL (requiring liblwgeom); #509, #511 * add `print` method for `crs` objects; #517 * `sf_extSoftVersion` reveals whether GDAL was linked to GEOS; #510 * better check input of `st_polygon`; #514 * add `st_node`, similar to `rgeos::gNode` * support for reading `OFTInteger64List` fields; #508 * sparse geometric binary predicate lists have a class, `sgbp`, and attributes `region.id` and `predicate`; #234, #524 * prevent `st_split` from stopping the R session; #492 * `st_intersection`, `st_union` and so on also print a message when used directly on long/lat coordinates; #496 * add `rep` method for `sfc` objects * comparing two `crs` objects uses the GDAL function `IsSame`; #180 * add `st_collection_extract`, which, given an object with geometries of type `GEOMETRY` or `GEOMETRYCOLLECTION`, returns an object consisting only of elements of the specified type; by Andy Teucher, #482 * `st_write` exports GeoJSON with UTF-8 encoding on Windows; #444 * move package methods from Imports: to Depends: ; #478 * deal better with precision setting and propagation; #476 * fix bug in `st_layers` in case layers have no geometry; #334 * clarify argument `envelope` in `st_voronoi`; #474 * change aggregate to make it return the same geometry as 'by', padding attributes with NA where needed; #453 # version 0.5-4 * fix compatibility problems introduced by `tidyr` 0.7-0 using rlang magic * convert path names to UTF-8 in `st_read`, `st_write` and `st_layers`; #471 * `st_sfc` converts `NULL` values into empty geometries, and correctly identifies empty `POINT`s; #466, #463 * `st_write` abbreviates column names if driver is `ESRI Shapefile`; #464 * add `of_largest_polygon` argument to `st_centroid`, to get the centroid of the largest polygon; #450 * fix use of `st_relate` as join predicate for `st_join`; #454 * fix bug where `st_intersects` with empty second argument would crash; #458 * produce better WKT; #463 * fix bug in `st_cast.sf`; #461, #462 * change `st_read` SRS assignment logic; corrects reading projected geojson with gdal 2.2.0; #449 * `st_intersection` etc. on `tbl` also return `tbl`; #448 * `[.sf` preserves class, e.g. of `tbl`; #448 # version 0.5-3 * support and propagate all Proj.4 +units=xx length units; #446 * allow for arith ops on empty `sfc` objects * have `st_graticule` return an empty graticule object when argument `datum` is `NA`; * export `as_Spatial`, to make it easier for packages to convert `sfc` objects without importing `sf` * `st_distance` gains a parameter `by_element` to obtain pairwise distances; #437 * add the ability to `aggregate` using a simple feature `by` argument; #429 * make the `op` argument to `[.sf` work * speed up `st_coordinates` for `POINT` geometries; #433 * fix performance regression for `st_bbox`; #418 * correct bug in `st_union`, `st_difference` and `st_sym_difference` introduced in 0.5-2; #431 * inform gdal about the CRS always through the proj4string, never through the epsg; see #424 * properly deal with kilometre units; #424 (fixed by Karl Dunkle Werner) * add `st_is_within_distance`, only to return a sparse index matrix; #419 * have `st_graticule` work with world2 (0,360); #421, #422, fixed by Ben Best * `st_graticule` to return graticules in native crs; https://github.com/tidyverse/ggplot2/issues/2200 (WIP) * `st_graticule` to support data in `NA_crs_`; https://github.com/tidyverse/ggplot2/issues/2199 * fix bug when joining an sf-tibble with a `tibble`; #414 * read gdal `StringList`, `RealList`, and `IntegerList` fields into a list-column; #416 # version 0.5-2 * made ready for rwinlib/gdal2; #408 * make `[.sf` for selections including `NA` values like `x[c(1,NA,2)]`; #403 * add a `[<-` method for `sfc` objects; automatically replaces `NULL` with an empty geometry; #411 * add `st_point_on_surface()` to return a point that is guaranteed to be on the surface (standard compliance) * `read_sf` returns an sf-tibble, an object of class `c("sf", "tbl_df", "tbl", "data.frame")` * work around for `dplyr::filter` not dispatching geometry column subsetting to `sf::[.sfc` * allow `units` object as `dist` argument to `st_buffer`; these must be convertable to `arc_degree` for geographic, and to a length unit for non-geographic data; #399 * prevent gdal from crashing when trying to `st_transform` an empty geometry; #398 * add `st_as_sfc` method for `bbox`, returning the bbox polygon; #377 * strip file name extension from default layer name in `st_write`; #392 * have `st_sf` replace `NULL` values in an `sfc` list-column with the appropriate empty geometry; #372 * allow setting `ndiscr` through `ggplot2::coords_sf` to improve graticule plotting in `geom_sf`; #396 # version 0.5-1 * add spatial indexes to most binary geometry operations; #394 and http://r-spatial.org/r/2017/06/22/spatial-index.html * drastically reduce memory footprint of `st_intersection` and similar; #394 * support RSQLite 2.0 by providing an `st_as_sfc` method for list columns of class `blob` * drop dependency on dbplyr # version 0.5-0 * better handle empty/NULL geometries in shapefiles; #351 * add `unite_.sf` method * deprecate `FUN` argument to `st_join`; #376 * improve graticule tic label placement in `ggplot2`; #375 and https://github.com/tidyverse/ggplot2/issues/2119 * improve `configure` logic to deal with libraries installed in custom locations; #335 * fix bug where `geom_sf` wouldn't deal with Z and/or M geoms; #373 * return more conveniently typed empty geoms; #372 * fix subsetting with `[` of `sf` using `drop = TRUE`, #370 * in addition to `m`, allow `rad` units to `st_segmentize` * add example how to `st_read` GeoJSON from a string; #185 * add `separate_.sf` method * add `st_split` to split geometries (only available if compiled against liblwgeom), #359 * fix bug reading and writing dates (months 1 off): #358 * [.sf and [.sfc also select on i when i is an `sfg` object, and accept a geometric predicate function with optional arguments; #352 * on reading through GDAL, empty (NULL) geometries no longer result in an error; on creation, they no longer automatically give a `GEOMETRY` object; #351 * on plotting with `ggplot2::geom_sf`, empty geometries no longer break; grid functions return `nullGrob()` for them; #351 * arith operations on empty geometries no longer break or give warnings; #351 * have `st_as_sf.data.frame` by default break on `NA` values in coordinates; #342 * have `st_join` accept further arguments, to be passed on to the `join` function (e.g. a pattern for `st_relate`) * have WKB reader throw an error on (some) malformed inputs, and check for buffer bounds # version 0.4-3 * back-port `do_union` argument to dplyr <= 0.5.0, using lazyeval * all strings returned from OGR/GDAL get encoding set to `UTF-8`, making them work on non-UTF-8 platforms; #5 * `$.crs` retrieves proj4string components, such as `st_crs(4326)$datum` in addition to `epsg` and `proj4string` * let `st_geohash` return geohash for (average) points (only when sf was linked to liblwgeom) # version 0.4-2 * `summarise.sf` always returns an `sf` object, also for global (non-grouped) summaries. * `summarise.sf` gains an argument `do_union` which determines whether to union the geometries for which a summary is given, or to `st_combine` them (not resolving boundaries); #331 * rename argument `union` of `aggregate.sf` into `do_union`, for consistency with `summarise`; #331 * add a `nest_` method for `sf` objects * `st_relate` gets a `pattern` parameter, same as `rgeos::gRelate`; add examples to get rook and queen neighbour lists using this; #234 * support for direct reading of spatialite and sqlite geometry wkb blobs * build proper support for `cbind` and `rbind` methods for `sf`, which work (as documented) when _all_ arguments are of class `sf`; `dplyr::bind_cols` or `st_sf(data.frame(sf, df))` work for binding `data.frame`s to an `sf` object. * `st_segmentize()` and `st_line_sample()` accept units arguments * document problem reading shapefiles from USB drives on OSX; #252 * improve docs of `st_is_valid` and `st_make_valid`; #296 * coercing `sf` to `data.frame` works better; #298 * `st_line_sample` gains argument `sample` to specify the points t.b. sampled; #299 #300 thanks to @joethorley * add compatibility to upcoming dplyr 0.6.0; #304 #42 * write GDAL fields by name, not by number, fixing a KML problem #308 * `st_write` gains arguments `delete_layer` and `delete_dsn` to allow overwrite capability #307 #274 * `write_sf` defaults to `delete_layer=TRUE`, silently overwriting layers if they're already present * compatibility with GDAL 2.2beta0; #303; #309 * replace `st_write_db` with a version that is fast for large datasets (#285), thanks to Josh London * take out more memory leaking examples in tests * the `aggregate` method for `sf` objects assumes the `by` argument to be identical to that of `stats::aggregate` * `st_wrap_dateline` wraps (cuts up) geometries crossing the antimeridian, such that they no longer cross it. # version 0.4-1 * restore 3.3.0 and c++11 requirement * `st_read` respects time that is read as UTC * `st_write` writes time always as UTC, since GDAL does not have a mechanism to define local timezones other than "unknown" or "local" * `st_length` works for POINT and MULTIPOINT (returning 0); POLYGON and MULTIPOLYGON are converted to MULTILINESTRING before computing length, thus giving polygon perimeter (#268) * `st_write` has `update` depend on driver; for databases, the default is `TRUE`, otherwise `FALSE` (it refers to update of the database, and not to overwriting the table in the database, this will by default not succeed); #274 * `st_read` supports reading objects with multiple geometry columns #257 #255 * support writing (exporting) objects with non-standard columns, such as `units` or `POSIXlt` #264 * catch dependencies on GEOS 3.3.5 (hence no 0.4-0 CRAN binary for MacOSX) #260 # version 0.4-0 * have `st_is_valid` catch corrupt geometries too, returning `NA` in that case (requiring GEOS 3.5.0) * add `st_make_valid`, only available when sf was linked to `liblwgeom` * add `st_coordinates` method, returning coordinates matrix with indexes * remove `unlist.sfg` * add `as.matrix.sfg`; have as.matrix.sfg add indexes to coordinates * add `st_bind_cols` method * improve handling features that can't be projected * support uniform sampling over polygons on the sphere * add `st_sample`, for sampling points on multipoints, linestrings, or polygons * add `c` method for `sfc` objects * import and export `magrittr::%>%` * support ggplot'ing geometrycollections * drop C++11 requirement, allowing build for older R versions * add `st_proj_info`, modelled after `rgdal::projInfo` * overwriting datasets with `st_write()` is no longer allowed; `update=TRUE` appends to them, permitted the driver supports appending. * `st_write` gains an argument, `update`, which when `TRUE` will try to append to existing datasets (#204) * added list of corresponding function for migration from sp, rgdal and rgeos to sf at https://github.com/edzer/sfr/wiki/migrating * remove deprecated `st_list` * rename `st_makegrid` to `st_make_grid`, and `st_linemerge` to `st_line_merge` * add NEWS.md file (#207) * faster conversion of `data.frame` into `POINT` `sf` object, using `st_as_sf` (Michael Sumner) * `rbind` method for `sf` objects keeps coordinate reference system # version 0.3-4, Feb 6, 2017 * add `st_contains_properly` spatial predicate * GEOS functions (geometry operations) accept XYZ geometries (and ignore Z) * make `prepared = TRUE` the default for all geometry binary operations # version 0.3-2, Feb 4, 2017 * add user interrupt checks in all GEOS geometry operations * make `st_graticule` do something useful for polar projections * make `st_graticule` return `NA` labels when labels are useless * add `merge.sf` methods to merge `sf` object and `data.frame` (#193) * add `st_join` for table joins based on (user-defined) spatial predicates * add `dplyr`-style non-spatial joins for `sf` objects (`left_join`, `full_join` etc.) (#193) * allow for multiple non-gathered variables (#196) * add missing meridian to `st_graticule` (#198) # version 0.3-1, Jan 31, 2017 * add `merge` method (#193) * `st_graticule` for laea (#198) * allow `st_buffer` with feature-dependent buffer distance (#197) * have `spread` return an `sf` object (#196) * clarify `overwrite = TRUE` in write docs * fix `st_as_sf.map` (#194) * add `prepared` arg to spatial binary predicates, to speed up large intersections * add `st_voronoi` interface (requires that lib GEOS >= 3.5.0) * add `st_as_sf` methods for `map` objects (library maps) * add RStudio project file * have `st_bbox` return a `bbox` object which has an `st_crs` method * rename `st_drop_zm` into `st_zm`, for general more handling of Z and M * allow for 3D coordinates returned, when `+proj=geocent` (#172; #103) * fix `NA_integer_` handling in shapefiles I/O (#184) * add and fix `st_agr` API, to set and get attribute-to-geometry relationships # version 0.2-8, Jan 5, 2017 ================================================ FILE: PROPOSAL.md ================================================ # Simple Features for R Applicant: [Edzer Pebesma](https://github.com/edzer/), [Institute for Geoinformatics](https://www.uni-muenster.de/Geoinformatics/en/), University of Muenster, Germany; [edzer.pebesma@uni-muenster.de](mailto:edzer.pebesma@uni-muenster.de) Supporting authors: Edzer Pebesma, Roger Bivand, Michael Sumner, Robert Hijmans, Virgilio Gómez-Rubio [Simple features](https://en.wikipedia.org/wiki/Simple_Features) is an open ([OGC](https://www.ogc.org/standard/sfa/) and [ISO](https://www.iso.org/standard/40114.html)) interface standard for access and manipulation of spatial vector data (points, lines, polygons). It includes a standard [SQL schema](http://www.opengeospatial.org/standards/sfs) that supports storage, retrieval, query and update of feature collections via a SQL interface. All commonly used databases provide this interface. [GeoJSON](https://geojson.org/) is a standard for encoding simple features in JSON, and is used in JavaScript and MongoDB. Well-known-text ([WKT](https://en.wikipedia.org/wiki/Well-known_text)) is a text representation of simple features used often in linked data; well-known-binary ([WKB] (https://en.wikipedia.org/wiki/Well-known_text)) a standard binary representation used in databases. _Simple Feature Access_ defines coordinate reference systems, and makes it easy to move data from longitude-latitude to projections back and forth in a standardized way. [GDAL](https://gdal.org/) is an open source C++ library for reading and writing both raster and vector data with more than 225 drivers (supported file formats, data base connectors, web service interfaces). GDAL is used by practically all open source geospatial projects and by many industry products (including ESRI's ArcGIS, ERDAS, and FME). It provides coordinate transformations (built on top of PROJ.4) and geometric operations (e.g. polygon intersections, unions, buffers and distance). Standards for coordinate transformations change over time; such changes are typically adopted directly in GDAL/PROJ.4 but do not easily find their way into R-only packages such as `mapproj`. Since [2005](https://stat.ethz.ch/pipermail/r-sig-geo/2005-April/000378.html), CRAN has package [sp](https://cran.r-project.org/package=sp) which provides classes and methods for spatial (point, line, polygon and raster) data. The approach `sp` takes is similar to how `xts` and `zoo` handle the time index of time series data: objects store spatial geometries separately from associated attribute data, matching by order. Package [spacetime](https://cran.r-project.org/package=spacetime), on CRAN since 2010, extends both `sp` and `xts` to handle data that varies over both space and time. Today, 221 CRAN packages depend on, import or link to `sp`, 259 when including _Suggests_; when including recursive dependencies these numbers are 376 and 5040. The implementation of `sp` does not follow simple features, but rather the practice used at the time of release, following how ESRI shapefiles are implemented. The cluster of packages around `sp` is shown in Andrie de Vries' [blog on CRAN's network structure](https://blog.revolutionanalytics.com/2015/07/the-network-structure-of-cran.html) in green. Off-CRAN package [rgdal2](https://github.com/thk686/rgdal2) is an interface to GDAL 2.0, which uses raw pointers to interface features, but does not import any data in R, using GDAL to handle everything. CRAN Package [wkb](https://cran.r-project.org/package=wkb), contributed by Tibco Software, converts between WKB representations of several simple feature classes and corresponding classes in `sp`, and seems to be needed for Tibco software purposes. ## The problem The problems we will solve are: 1. R can currently not represent simple features directly. It can read most simple feature classes in `sp` classes, but uses its own representation for this, and can only write data back without loss of information if it is furnished with ancilliary metadata encoded in a comment attribute to each Polygons object. It does for instance internally not distinguish between `POLYGON` and `MULTIPOLYGON` nor deal with several simple feature classes, including `TIN` and `GEOMETRYCOLLECTION`, nor handle `CURVE` geometries. 2. The current implementation of lines and vector data in package `sp` is partly ambiguous (both slot `ringDir` or slot `hole` indicate whether a Polygon is a hole but are superceded by the comment attribute), complicated (to which exterior polygon does a hole belong - handled by the comment attribute), and by some considered difficult to work with (S4). The current implementation is hard to maintain because it contains incremental changes from a baseline that predated the industry-standard OGC/ISO ([Simple Feature Interface Specification](https://www.ogc.org/standard/sfa/)). 3. The lack of support for simple features makes current interfaces to open source libraries (GDAL/OGR and PROJ.4: rgdal, GEOS: rgeos) difficult to understand and maintain, even though they work to specification. 4. The current implementation has no [scale model](https://libgeos.org/doxygen/classgeos_1_1geom_1_1PrecisionModel.html#details) for coordinates. 5. It is desirable that other R packages are offered the opportunity to migrate to more up-to-date libraries for coordinate transformations (providing proper support for datum transformation), and to avoid having to make simplifying assumptions (e.g., all spatial data come as longitude/latitude using datum `WGS84`; all web maps use [_web Mercator_](https://en.wikipedia.org/wiki/Web_Mercator)). Which users will benefit from solving these problems? It will mainly affect those who use data bases or modern javascript-based web APIs which largely converged on adopting simple features (such as [CartoDB](https://cartodb.com/)), as well as those who need a simpler and more light-weight handling of spatial data in R. It will also reduce the effort for users and developers to understand the way spatial information is represented in R, making it easier to build upon and reuse the R code for this, and lead to a good, sustainable shared R code base. In the longer run it will affect users of all packages currently reusing `sp` classes, when we manage to migrate `sp` to exclusively use the simple feature classes for representing vector data. Since the recent [2.0](https://gdal.org/index.html) release of GDAL integrates raster and vector data, having an R package that mirrors its classes makes it possible to implement operations in-database (similar to what `DBI`, `RPostgreSQL` and `dplyr` do), making it possible for R to manipulate spatial data that do not fit in memory. Big Data analysis with R often proceeds by connecting R to a database that holds the data. All commonly used commercial and open source databases store spatial point, line and polygon data in the form of simple features. Representing simple features in R will simplify big data analysis for spatial data. ## The plan We want to solve the problem by carrying out the following steps (M1 refers to month 1): 1. develop an R package that implements simple features in R, that is simple yet gives users access to the complete data, and includes an S3 representation that extends `data.frame` (M1-3) 2. add to this package a C++ interface to GDAL 2.0, to read and write simple feature data, and to interface other functionality (coordinate transformation, geometry operations) (M3-8) 3. develop and prototypically implement a migration path for sp to become compliant with simple features (M7-12) 4. write user-oriented tutorial vignettes showing how to use it with files, data base connections, web API's, leaflet, ggmap, dplyr and so on (M7-10) 5. write a tutorial vignette for R package writers reusing the package (M10) 6. Collect and process community feed back (M6-12). Failure modes and recovery plan: 1. Failure mode: S3 classes are too simple to represent simple features class hierarchy. Recovery plan: try (i) using a list column with geometry, and nested lists to represent nested structures; (ii) use a `WKT` character column; (iii) using a `WKB` blob column 2. Migrating `sp` breaks downstream packages. Recovery plan: involve Roger Bivand, Barry Rowlingson, Robert Hijmans (`raster`) and Tim Keitt (`rgdal`/`rgdal2`) how to proceed; be patient and smooth out problems together with package maintainers. ## How can the ISC help The following table contains the cost items. | Item | Cost | | ---- | ---- | | employ a student assistant for one year (10 hrs/week) | € 6500 | | one week visit of Roger Bivand to the Inst. for Geoinformatics | € 1000 | | present the results at UseR! 2016 | € 1500 | | Total: | € 9000 (9750 USD) | The visit of Roger is anticipated halfway the project; further communications will use skype. The project has a planned duration of 12 months. ## Dissemination Development will take place on github, information will be shared and reactions and contributions invited through [r-sig-geo](https://stat.ethz.ch/mailman/listinfo/r-sig-geo), as well as [StackOverflow](https://stackoverflow.com/) and [GIS StackExchange](https://gis.stackexchange.com/). The project will use an Apache 2.0 license for maximum dissemination (similar to GDAL, which uses X/MIT). The work will be published in 4 blogs (quarterly), announced on r-sig-geo (3300 subscribers), and intermediary results will be presented at [UseR! 2016](https://www.r-project.org/conferences/useR-2016/). The final result will be published in a paper either submitted to [The R Journal](https://journal.r-project.org/) or to the [Journal of Statistical Software](https://www.jstatsoft.org/index); this paper will be available before publication as a package vignette. ## UseR! slides UseR! 2016 slides are found [here](https://pebesma.staff.ifgi.de/pebesma_sfr.pdf). ================================================ FILE: R/RcppExports.R ================================================ # Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 CPL_get_bbox <- function(sf, depth = 0L) { .Call(`_sf_CPL_get_bbox`, sf, depth) } CPL_gdal_init <- function() { invisible(.Call(`_sf_CPL_gdal_init`)) } CPL_gdal_cleanup_all <- function() { invisible(.Call(`_sf_CPL_gdal_cleanup_all`)) } CPL_gdal_version <- function(what = "RELEASE_NAME") { .Call(`_sf_CPL_gdal_version`, what) } CPL_crs_parameters <- function(crs) { .Call(`_sf_CPL_crs_parameters`, crs) } CPL_crs_equivalent <- function(crs1, crs2) { .Call(`_sf_CPL_crs_equivalent`, crs1, crs2) } CPL_crs_from_input <- function(input) { .Call(`_sf_CPL_crs_from_input`, input) } CPL_roundtrip <- function(sfc) { .Call(`_sf_CPL_roundtrip`, sfc) } CPL_circularstring_to_linestring <- function(sfc) { .Call(`_sf_CPL_circularstring_to_linestring`, sfc) } CPL_multisurface_to_multipolygon <- function(sfc) { .Call(`_sf_CPL_multisurface_to_multipolygon`, sfc) } CPL_compoundcurve_to_linear <- function(sfc) { .Call(`_sf_CPL_compoundcurve_to_linear`, sfc) } CPL_curve_to_linestring <- function(sfc) { .Call(`_sf_CPL_curve_to_linestring`, sfc) } CPL_can_transform <- function(src, dst) { .Call(`_sf_CPL_can_transform`, src, dst) } CPL_transform <- function(sfc, crs, AOI, pipeline, reverse = FALSE, desired_accuracy = -1.0, allow_ballpark = TRUE) { .Call(`_sf_CPL_transform`, sfc, crs, AOI, pipeline, reverse, desired_accuracy, allow_ballpark) } CPL_transform_bounds <- function(bb, crs_dst, densify_pts = 21L) { .Call(`_sf_CPL_transform_bounds`, bb, crs_dst, densify_pts) } CPL_wrap_dateline <- function(sfc, opt, quiet = TRUE) { .Call(`_sf_CPL_wrap_dateline`, sfc, opt, quiet) } CPL_get_gdal_drivers <- function(dummy) { .Call(`_sf_CPL_get_gdal_drivers`, dummy) } CPL_sfc_from_wkt <- function(wkt) { .Call(`_sf_CPL_sfc_from_wkt`, wkt) } CPL_gdal_with_geos <- function() { .Call(`_sf_CPL_gdal_with_geos`) } CPL_axis_order_authority_compliant <- function(authority_compliant) { .Call(`_sf_CPL_axis_order_authority_compliant`, authority_compliant) } CPL_compressors <- function() { .Call(`_sf_CPL_compressors`) } CPL_area <- function(sfc) { .Call(`_sf_CPL_area`, sfc) } CPL_gdal_dimension <- function(sfc, NA_if_empty = TRUE) { .Call(`_sf_CPL_gdal_dimension`, sfc, NA_if_empty) } CPL_length <- function(sfc) { .Call(`_sf_CPL_length`, sfc) } CPL_gdal_segmentize <- function(sfc, dfMaxLength = 0.0) { .Call(`_sf_CPL_gdal_segmentize`, sfc, dfMaxLength) } CPL_gdal_linestring_sample <- function(sfc, distLst) { .Call(`_sf_CPL_gdal_linestring_sample`, sfc, distLst) } CPL_get_layers <- function(datasource, options, do_count = FALSE) { .Call(`_sf_CPL_get_layers`, datasource, options, do_count) } CPL_read_ogr <- function(datasource, layer, query, options, quiet, toTypeUser, fid_column_name, drivers, wkt_filter, promote_to_multi = TRUE, int64_as_string = FALSE, dsn_exists = TRUE, dsn_isdb = FALSE, width = 80L) { .Call(`_sf_CPL_read_ogr`, datasource, layer, query, options, quiet, toTypeUser, fid_column_name, drivers, wkt_filter, promote_to_multi, int64_as_string, dsn_exists, dsn_isdb, width) } CPL_read_gdal_stream <- function(stream_xptr, datasource, layer, query, options, quiet, drivers, wkt_filter, dsn_exists, dsn_isdb, fid_column, width) { .Call(`_sf_CPL_read_gdal_stream`, stream_xptr, datasource, layer, query, options, quiet, drivers, wkt_filter, dsn_exists, dsn_isdb, fid_column, width) } CPL_gdalinfo <- function(obj, options, oo, co) { .Call(`_sf_CPL_gdalinfo`, obj, options, oo, co) } CPL_ogrinfo <- function(obj, options, oo, co, read_only = FALSE) { .Call(`_sf_CPL_ogrinfo`, obj, options, oo, co, read_only) } CPL_gdaladdo <- function(obj, method, overviews, bands, oo, co, clean = FALSE, read_only = FALSE) { .Call(`_sf_CPL_gdaladdo`, obj, method, overviews, bands, oo, co, clean, read_only) } CPL_gdalwarp <- function(src, dst, options, oo, doo, co, quiet = TRUE, overwrite = FALSE) { .Call(`_sf_CPL_gdalwarp`, src, dst, options, oo, doo, co, quiet, overwrite) } CPL_gdalrasterize <- function(src, dst, options, oo, doo, co, overwrite = FALSE, quiet = TRUE) { .Call(`_sf_CPL_gdalrasterize`, src, dst, options, oo, doo, co, overwrite, quiet) } CPL_gdaltranslate <- function(src, dst, options, oo, co, quiet = TRUE) { .Call(`_sf_CPL_gdaltranslate`, src, dst, options, oo, co, quiet) } CPL_gdalfootprint <- function(src, dst, options, oo, co, quiet = TRUE) { .Call(`_sf_CPL_gdalfootprint`, src, dst, options, oo, co, quiet) } CPL_gdalvectortranslate <- function(src, dst, options, oo, doo, co, quiet = TRUE) { .Call(`_sf_CPL_gdalvectortranslate`, src, dst, options, oo, doo, co, quiet) } CPL_gdalbuildvrt <- function(src, dst, options, oo, co, quiet = TRUE) { .Call(`_sf_CPL_gdalbuildvrt`, src, dst, options, oo, co, quiet) } CPL_gdaldemprocessing <- function(src, dst, options, processing, colorfilename, oo, co, quiet = TRUE) { .Call(`_sf_CPL_gdaldemprocessing`, src, dst, options, processing, colorfilename, oo, co, quiet) } CPL_gdalnearblack <- function(src, dst, options, oo, doo, co, quiet = TRUE) { .Call(`_sf_CPL_gdalnearblack`, src, dst, options, oo, doo, co, quiet) } CPL_gdalgrid <- function(src, dst, options, oo, co, quiet = TRUE) { .Call(`_sf_CPL_gdalgrid`, src, dst, options, oo, co, quiet) } CPL_gdalmdiminfo <- function(obj, options, oo, co) { .Call(`_sf_CPL_gdalmdiminfo`, obj, options, oo, co) } CPL_gdalmdimtranslate <- function(src, dst, options, oo, co, quiet = TRUE) { .Call(`_sf_CPL_gdalmdimtranslate`, src, dst, options, oo, co, quiet) } CPL_gdal_warper <- function(infile, outfile, options, oo, doo, co, quiet = TRUE) { .Call(`_sf_CPL_gdal_warper`, infile, outfile, options, oo, doo, co, quiet) } CPL_write_ogr <- function(obj, dsn, layer, driver, dco, lco, geom, dim, fids, ConfigOptions, quiet, append, delete_dsn = FALSE, delete_layer = FALSE, write_geometries = TRUE, width = 80L) { .Call(`_sf_CPL_write_ogr`, obj, dsn, layer, driver, dco, lco, geom, dim, fids, ConfigOptions, quiet, append, delete_dsn, delete_layer, write_geometries, width) } CPL_delete_ogr <- function(dsn, layer, driver, quiet = TRUE) { .Call(`_sf_CPL_delete_ogr`, dsn, layer, driver, quiet) } CPL_geos_binop <- function(sfc0, sfc1, op, par = 0.0, pattern = "", prepared = FALSE) { .Call(`_sf_CPL_geos_binop`, sfc0, sfc1, op, par, pattern, prepared) } CPL_geos_binop_by_element <- function(sfc0, sfc1, op, par, pattern, prepared) { .Call(`_sf_CPL_geos_binop_by_element`, sfc0, sfc1, op, par, pattern, prepared) } CPL_geos_is_valid_reason <- function(sfc) { .Call(`_sf_CPL_geos_is_valid_reason`, sfc) } CPL_geos_make_valid <- function(sfc, method, keep_collapsed) { .Call(`_sf_CPL_geos_make_valid`, sfc, method, keep_collapsed) } CPL_geos_is_valid <- function(sfc, NA_on_exception = TRUE) { .Call(`_sf_CPL_geos_is_valid`, sfc, NA_on_exception) } CPL_geos_is_simple <- function(sfc) { .Call(`_sf_CPL_geos_is_simple`, sfc) } CPL_geos_is_empty <- function(sfc) { .Call(`_sf_CPL_geos_is_empty`, sfc) } CPL_geos_normalize <- function(sfc) { .Call(`_sf_CPL_geos_normalize`, sfc) } CPL_geos_union <- function(sfc, by_feature = FALSE, is_coverage = FALSE) { .Call(`_sf_CPL_geos_union`, sfc, by_feature, is_coverage) } CPL_geos_snap <- function(sfc0, sfc1, tolerance) { .Call(`_sf_CPL_geos_snap`, sfc0, sfc1, tolerance) } CPL_geos_op <- function(op, sfc, bufferDist, nQuadSegs, dTolerance, preserveTopology, bOnlyEdges = 1L, endCapStyle = 0L, joinStyle = 0L, mitreLimit = 1L, singleside = 0L) { .Call(`_sf_CPL_geos_op`, op, sfc, bufferDist, nQuadSegs, dTolerance, preserveTopology, bOnlyEdges, endCapStyle, joinStyle, mitreLimit, singleside) } CPL_geos_voronoi <- function(sfc, env, dTolerance = 0.0, bOnlyEdges = 1L) { .Call(`_sf_CPL_geos_voronoi`, sfc, env, dTolerance, bOnlyEdges) } CPL_geos_op2 <- function(op, sfcx, sfcy) { .Call(`_sf_CPL_geos_op2`, op, sfcx, sfcy) } CPL_geos_dist_by_element <- function(sfc0, sfc1, which, par) { .Call(`_sf_CPL_geos_dist_by_element`, sfc0, sfc1, which, par) } CPL_geos_version <- function(runtime = FALSE, capi = FALSE) { .Call(`_sf_CPL_geos_version`, runtime, capi) } CPL_geos_op2_by_element <- function(op, sfcx, sfcy) { .Call(`_sf_CPL_geos_op2_by_element`, op, sfcx, sfcy) } CPL_geos_dist <- function(sfc0, sfc1, which, par) { .Call(`_sf_CPL_geos_dist`, sfc0, sfc1, which, par) } CPL_geos_nearest_feature <- function(sfc0, sfc1) { .Call(`_sf_CPL_geos_nearest_feature`, sfc0, sfc1) } CPL_geos_nearest_points <- function(sfc0, sfc1, pairwise) { .Call(`_sf_CPL_geos_nearest_points`, sfc0, sfc1, pairwise) } CPL_transpose_sparse_incidence <- function(m, n) { .Call(`_sf_CPL_transpose_sparse_incidence`, m, n) } CPL_nary_difference <- function(sfc) { .Call(`_sf_CPL_nary_difference`, sfc) } CPL_nary_intersection <- function(sfc) { .Call(`_sf_CPL_nary_intersection`, sfc) } CPL_line_project <- function(lines, points, normalized) { .Call(`_sf_CPL_line_project`, lines, points, normalized) } CPL_line_interpolate <- function(lines, dists, normalized) { .Call(`_sf_CPL_line_interpolate`, lines, dists, normalized) } CPL_hex_to_raw <- function(cx) { .Call(`_sf_CPL_hex_to_raw`, cx) } CPL_raw_to_hex <- function(raw) { .Call(`_sf_CPL_raw_to_hex`, raw) } CPL_read_mdim <- function(file, array_names, oo, offset, count, step, proxy = FALSE, debug = FALSE) { .Call(`_sf_CPL_read_mdim`, file, array_names, oo, offset, count, step, proxy, debug) } CPL_write_mdim <- function(name, driver, dimensions, variables, wkt, xy, RootGroupOptions, CreationOptions, as_float = TRUE) { .Call(`_sf_CPL_write_mdim`, name, driver, dimensions, variables, wkt, xy, RootGroupOptions, CreationOptions, as_float) } opp_sfc <- function(geom, value, mult, crs) { .Call(`_sf_opp_sfc`, geom, value, mult, crs) } normalize_sfc <- function(geom, min, range, crs) { .Call(`_sf_normalize_sfc`, geom, min, range, crs) } CPL_polygonize <- function(raster, mask_name, raster_driver, vector_driver, vector_dsn, options, iPixValField, contour_options, use_contours = FALSE, use_integer = TRUE) { .Call(`_sf_CPL_polygonize`, raster, mask_name, raster_driver, vector_driver, vector_dsn, options, iPixValField, contour_options, use_contours, use_integer) } CPL_rasterize <- function(raster, raster_driver, sfc, values, options, NA_value) { .Call(`_sf_CPL_rasterize`, raster, raster_driver, sfc, values, options, NA_value) } CPL_proj_h <- function(b = FALSE) { .Call(`_sf_CPL_proj_h`, b) } CPL_get_pipelines <- function(crs, authority, AOI, Use, grid_availability, accuracy = -1.0, strict_containment = FALSE, axis_order_auth_compl = FALSE) { .Call(`_sf_CPL_get_pipelines`, crs, authority, AOI, Use, grid_availability, accuracy, strict_containment, axis_order_auth_compl) } CPL_get_data_dir <- function(from_proj = FALSE) { .Call(`_sf_CPL_get_data_dir`, from_proj) } CPL_is_network_enabled <- function(b = FALSE) { .Call(`_sf_CPL_is_network_enabled`, b) } CPL_enable_network <- function(url, enable = TRUE) { .Call(`_sf_CPL_enable_network`, url, enable) } CPL_set_data_dir <- function(data_dir, with_proj) { .Call(`_sf_CPL_set_data_dir`, data_dir, with_proj) } CPL_use_proj4_init_rules <- function(v) { .Call(`_sf_CPL_use_proj4_init_rules`, v) } CPL_proj_version <- function(b = FALSE) { .Call(`_sf_CPL_proj_version`, b) } CPL_proj_is_valid <- function(proj4string) { .Call(`_sf_CPL_proj_is_valid`, proj4string) } CPL_have_datum_files <- function(foo) { .Call(`_sf_CPL_have_datum_files`, foo) } CPL_proj_direct <- function(from_to, pts, keep, warn = TRUE, authority_compliant = FALSE) { .Call(`_sf_CPL_proj_direct`, from_to, pts, keep, warn, authority_compliant) } CPL_proj_info <- function(type) { .Call(`_sf_CPL_proj_info`, type) } CPL_xy2sfc <- function(cc, dim, to_points, which, cc_has_NAs) { .Call(`_sf_CPL_xy2sfc`, cc, dim, to_points, which, cc_has_NAs) } sfc_is_null <- function(sfc) { .Call(`_sf_sfc_is_null`, sfc) } sfc_unique_sfg_dims_and_types <- function(sfc) { .Call(`_sf_sfc_unique_sfg_dims_and_types`, sfc) } sfc_is_empty <- function(sfc) { .Call(`_sf_sfc_is_empty`, sfc) } sfc_is_full <- function(sfc) { .Call(`_sf_sfc_is_full`, sfc) } points_cpp <- function(pts, gdim = "XY") { .Call(`_sf_points_cpp`, pts, gdim) } CPL_signed_area <- function(pts) { .Call(`_sf_CPL_signed_area`, pts) } CPL_get_metadata <- function(obj, domain_item, options) { .Call(`_sf_CPL_get_metadata`, obj, domain_item, options) } CPL_get_crs <- function(obj, options) { .Call(`_sf_CPL_get_crs`, obj, options) } CPL_inv_geotransform <- function(gt_r) { .Call(`_sf_CPL_inv_geotransform`, gt_r) } CPL_read_gdal <- function(fname, options, driver, read_data, NA_value, RasterIO_parameters, max_cells) { .Call(`_sf_CPL_read_gdal`, fname, options, driver, read_data, NA_value, RasterIO_parameters, max_cells) } CPL_write_gdal <- function(x, fname, driver, options, Type, dims, from, gt, p4s, na_val, scale_offset, create = TRUE, only_create = FALSE) { invisible(.Call(`_sf_CPL_write_gdal`, x, fname, driver, options, Type, dims, from, gt, p4s, na_val, scale_offset, create, only_create)) } CPL_extract <- function(input, xy, interpolate) { .Call(`_sf_CPL_extract`, input, xy, interpolate) } CPL_create <- function(file, nxy, value, wkt, xlim, ylim) { invisible(.Call(`_sf_CPL_create`, file, nxy, value, wkt, xlim, ylim)) } CPL_read_wkb <- function(wkb_list, EWKB = FALSE, spatialite = FALSE) { .Call(`_sf_CPL_read_wkb`, wkb_list, EWKB, spatialite) } CPL_write_wkb <- function(sfc, EWKB = FALSE) { .Call(`_sf_CPL_write_wkb`, sfc, EWKB) } CPL_get_z_range <- function(sf, depth) { .Call(`_sf_CPL_get_z_range`, sf, depth) } CPL_get_m_range <- function(sf, depth) { .Call(`_sf_CPL_get_m_range`, sf, depth) } # Register entry points for exported C++ functions methods::setLoadAction(function(ns) { .Call(`_sf_RcppExport_registerCCallable`) }) ================================================ FILE: R/aggregate.R ================================================ #' aggregate an \code{sf} object #' #' aggregate an \code{sf} object, possibly union-ing geometries #' #' @note Does not work using the formula notation involving \code{~} defined in \link[stats]{aggregate}. #' #' @param x object of class \link{sf} #' @param by either a list of grouping vectors with length equal to \code{nrow(x)} (see \link[stats]{aggregate}), or an object of class \code{sf} or \code{sfc} with geometries that are used to generate groupings, using the binary predicate specified by the argument \code{join} #' @param FUN function passed on to \link[stats]{aggregate}, in case \code{ids} was specified and attributes need to be grouped #' @param ... arguments passed on to \code{FUN} #' @param do_union logical; should grouped geometries be unioned using \link{st_union}? See details. #' @param simplify logical; see \link[stats]{aggregate} #' @param join logical spatial predicate function to use if \code{by} is a simple features object or geometry; see \link{st_join} #' @return an \code{sf} object with aggregated attributes and geometries; additional grouping variables having the names of \code{names(ids)} or are named \code{Group.i} for \code{ids[[i]]}; see \link[stats]{aggregate}. #' @details In case \code{do_union} is \code{FALSE}, \code{aggregate} will simply combine geometries using \link{c.sfg}. When polygons sharing a boundary are combined, this leads to geometries that are invalid; see \url{https://github.com/r-spatial/sf/issues/681}. #' @aliases aggregate #' @examples #' m1 = cbind(c(0, 0, 1, 0), c(0, 1, 1, 0)) #' m2 = cbind(c(0, 1, 1, 0), c(0, 0, 1, 0)) #' pol = st_sfc(st_polygon(list(m1)), st_polygon(list(m2))) #' set.seed(1985) #' d = data.frame(matrix(runif(15), ncol = 3)) #' p = st_as_sf(x = d, coords = 1:2) #' plot(pol) #' plot(p, add = TRUE) #' (p_ag1 = aggregate(p, pol, mean)) #' plot(p_ag1) # geometry same as pol #' # works when x overlaps multiple objects in 'by': #' p_buff = st_buffer(p, 0.2) #' plot(p_buff, add = TRUE) #' (p_ag2 = aggregate(p_buff, pol, mean)) # increased mean of second #' # with non-matching features #' m3 = cbind(c(0, 0, -0.1, 0), c(0, 0.1, 0.1, 0)) #' pol = st_sfc(st_polygon(list(m3)), st_polygon(list(m1)), st_polygon(list(m2))) #' (p_ag3 = aggregate(p, pol, mean)) #' plot(p_ag3) #' # In case we need to pass an argument to the join function: #' (p_ag4 = aggregate(p, pol, mean, #' join = function(x, y) st_is_within_distance(x, y, dist = 0.3))) #' @export aggregate.sf = function(x, by, FUN, ..., do_union = TRUE, simplify = TRUE, join = st_intersects) { if (inherits(by, "sf") || inherits(by, "sfc")) { if (inherits(by, "sfc")) by = st_sf(by) i = join(st_geometry(by), st_geometry(x)) st_geometry(x) = NULL # dispatch to stats::aggregate: a = aggregate(x[unlist(i), , drop = FALSE], list(rep(seq_len(nrow(by)), lengths(i))), FUN, ...) nrow_diff = nrow(by) - nrow(a) if (is.matrix(a[[2]])) # https://github.com/r-spatial/sf/issues/2375 a = data.frame(a[1], as.data.frame(a[[2]])) if(nrow_diff > 0) { a_na = a[rep(NA, nrow(by)),] # 'top-up' missing rows a_na[a$Group.1,] = a a = a_na } a$Group.1 = NULL # remove row.names(a) = row.names(by) st_set_geometry(a, st_geometry(by)) } else { crs = st_crs(x) lst = lapply(split(st_geometry(x), by), function(y) do.call(c, y)) geom = do.call(st_sfc, lst[!sapply(lst, is.null)]) if (do_union) geom = st_union(st_set_precision(geom, st_precision(x)), by_feature = TRUE) st_geometry(x) = NULL x = aggregate(x, by, FUN, ..., simplify = simplify) st_geometry(x) = geom # coerces to sf st_crs(x) = crs # now set agr: geoms = which(vapply(x, function(vr) inherits(vr, "sfc"), TRUE)) agr_names = names(x)[-geoms] agr = rep("aggregate", length(agr_names)) names(agr) = agr_names # which ones are identity variables? n = if (!is.null(names(by))) names(by) else paste0("Group.", seq_along(by)) agr[n] = "identity" st_set_agr(x, agr) } } #' Area-weighted interpolation or dasymetric mapping of polygon data #' #' Area-weighted interpolation or dasymetric mapping of polygon data #' @name interpolate_aw #' @param x object of class \code{sf}, for which we want to aggregate attributes #' @param to object of class \code{sf} or \code{sfc}, with the target geometries #' @param extensive logical; if TRUE, the attribute variables are assumed to be spatially extensive (like population) and the sum is preserved, otherwise, spatially intensive (like population density) and the mean is preserved. #' @param na.rm logical; if `TRUE` remove features with `NA` attributes from `x` before interpolating #' @param ... ignored #' @param keep_NA logical; if \code{TRUE}, return all features in \code{to}, if \code{FALSE} return only those with non-NA values (but with \code{row.names} the index corresponding to the feature in \code{to}) #' @param include_non_intersected logical; for the case when `extensive=FALSE`, when set to `TRUE` divide by the target areas (including non-intersected areas), #' when `FALSE` divide by the sum of the source areas. #' @param weights character; name of column in `to` that indicates (extensive) weights, to be used instead of areas, for redistributing attributes in `x`; currently only works for `extensive=TRUE`. #' @details if `extensive` is `TRUE` and `na.rm` is set to `TRUE`, geometries with `NA` are effectively treated as having zero attribute values. Dasymetric mapping is obtained when `weights` are specified. #' @examples #' # example Area-weighted interpolation: #' nc = st_read(system.file("shape/nc.shp", package="sf")) #' g = st_make_grid(nc, n = c(10, 5)) #' a1 = st_interpolate_aw(nc["BIR74"], g, extensive = FALSE) #' sum(a1$BIR74) / sum(nc$BIR74) # not close to one: property is assumed spatially intensive #' a2 = st_interpolate_aw(nc["BIR74"], g, extensive = TRUE) #' # verify mass preservation (pycnophylactic) property: #' sum(a2$BIR74) / sum(nc$BIR74) #' a1$intensive = a1$BIR74 #' a1$extensive = a2$BIR74 #' \donttest{plot(a1[c("intensive", "extensive")], key.pos = 4)} #' #' # example Dasymetric mapping: #' # load nr of addresses per 10 km grid cell, to proxy population -> birth density: #' grd.addr = system.file("gpkg/grd_addr.gpkg", package="sf") |> read_sf() #' xgrd.addr = grd.addr # copy for plotting #' xgrd.addr$ones[grd.addr$ones==0] = 1 # so that logz shows finite values #' \donttest{plot(xgrd.addr, logz=TRUE, main = "nr of addresses per cell") # log scale} #' nc = st_transform(nc, st_crs(grd.addr)) #' # avoid "assumes attributes are constant or uniform over areas" warnings: #' st_agr(nc) = c(BIR74 = "constant", BIR79 = "constant") #' st_agr(grd.addr) = c(ones = "constant") #' # dasymetric mapping #' bir.grd = st_interpolate_aw(nc[c("BIR74","BIR79")], extensive = TRUE, grd.addr, weights = "ones") #' xbir.grd = bir.grd # copy for plotting #' xbir.grd$BIR74[xbir.grd$BIR74 == 0] = 1 # so that logz shows finite values #' \donttest{plot(xbir.grd["BIR74"], logz = TRUE, main = "redistributed birth counts, 1974-")} #' # verify sums: #' apply(as.data.frame(bir.grd)[1:2], 2, sum) #' apply(as.data.frame(nc)[c("BIR74", "BIR79")], 2, sum) #' # compare county-wise: #' st_agr(bir.grd) = c(BIR74 = "constant") #' aw = st_interpolate_aw(bir.grd["BIR74"], st_geometry(nc), extensive = TRUE) #' plot(nc$BIR74, aw$BIR74, log = 'xy', xlab = 'county-value', ylab = 'area-w interpolated') #' abline(0,1) #' @export st_interpolate_aw = function(x, to, extensive, ...) UseMethod("st_interpolate_aw") #' @export #' @name interpolate_aw st_interpolate_aw.sf = function(x, to, extensive, ..., keep_NA = FALSE, na.rm = FALSE, include_non_intersected = FALSE, weights = character(0)) { if (!inherits(to, "sf") && !inherits(to, "sfc")) { to <- try(st_as_sf(to)) if (inherits(to, "try-error")) stop("st_interpolate_aw requires geometries in argument to") } if (isTRUE(na.rm)) x = x[! apply(is.na(x), 1, any),] if (length(weights)) { stopifnot(length(weights) == 1, is.character(weights), inherits(to, "sf"), weights %in% names(to)) return(dasymetric(x, to[weights], extensive, keep_NA, include_non_intersected)) } if (! all_constant(x)) warning("st_interpolate_aw assumes attributes are constant or uniform over areas of x") i = st_intersection(st_geometry(x), st_geometry(to), dimensions = "polygon") idx = attr(i, "idx") # https://stackoverflow.com/questions/57767022/how-do-you-use-st-interpolate-aw-with-polygon-layers-that-legitimately-include-p gc = which(st_is(i, "GEOMETRYCOLLECTION")) # i[gc] = st_collection_extract(i[gc], "POLYGON") ## breaks if there are several POLYGONs in a GC i[gc] = do.call(c, lapply(i[gc], function(x) st_sfc(st_union(st_collection_extract(x, "POLYGON"))))) two_d = which(st_dimension(i) == 2) i[two_d] = st_cast(i[two_d], "MULTIPOLYGON") x_st = st_set_geometry(x, NULL)[idx[,1],, drop=FALSE] # create st table, remove geom if (any(!sapply(x_st, is.numeric))) stop("x contains non-numeric column(s)") area_i = try(st_area(i), silent = TRUE) if (inherits(area_i, "try-error")) area_i <- st_area(st_make_valid(i)) # work-around for https://github.com/r-spatial/sf/issues/1810 x_st$...area_st = unclass(area_i) x_st = if (extensive) { # compute area_s: x_st$...area_s = unclass(st_area(x))[idx[,1]] lapply(x_st, function(v) v * x_st$...area_st / x_st$...area_s) } else { # compute target area: target = if (include_non_intersected) setNames(as.numeric(st_area(to)), seq_len(NROW(to))) # use all of "to" else sapply(split(area_i, idx[, 2]), sum) # sum "to" parts intersecting "x" df = data.frame(area = target, idx = as.integer(names(target))) x_st$...area_t = merge(data.frame(idx = idx[,2]), df)$area lapply(x_st, function(v) v * x_st$...area_st / x_st$...area_t) } x_st = aggregate(x_st, list(idx[,2]), sum) df = if (keep_NA) { ix = rep(NA_integer_, length(to)) ix[x_st$Group.1] = seq_along(x_st$Group.1) st_sf(x_st[ix,], geometry = st_geometry(to)) } else st_sf(x_st, geometry = st_geometry(to)[x_st$Group.1], row.names = x_st$Group.1) # clean up: df$...area_t = df$...area_st = df$...area_s = df$Group.1 = NULL st_set_agr(df, "aggregate") } dasymetric = function(x, to, extensive, keep_NA, include_non_intersected) { stopifnot(isTRUE(extensive), !keep_NA, !include_non_intersected) # later... stopifnot(length(to) == 2) if (!inherits(to[[2]], "sfc")) to = to[2:1] # swap: geom last i = st_intersection(st_geometry(x), st_geometry(to), dimensions = "polygon") idx = attr(i, "idx") st_geometry(x) = NULL stopifnot(!("...x_s" %in% names(x))) # avoid overwrite x = x[idx[,1], , drop=FALSE] # x attributes corresponding to each area of i i = st_set_geometry(x[idx[,1], , drop = FALSE], i) # add geometry # https://stackoverflow.com/questions/57767022/how-do-you-use-st-interpolate-aw-with-polygon-layers-that-legitimately-include-p # i[gc] = st_collection_extract(i[gc], "POLYGON") ## breaks if there are several POLYGONs in a GC gc = which(st_is(i, "GEOMETRYCOLLECTION")) if (length(gc)) { g = st_geometry(i) g[gc] = do.call(c, lapply(g[gc,], function(x) st_sfc(st_union(st_collection_extract(x, "POLYGON"))))) st_geometry(i) = g } two_d = which(st_dimension(i) == 2) if (any(two_d)) { g = st_geometry(i) g[two_d] = st_cast(g[two_d], "MULTIPOLYGON") st_geometry(i) = g } x$...x_st = st_interpolate_aw(to, i, extensive = extensive)[[1]] # distribute weights over the intersection geometries # split according to source regions: # first copy over idx[,2], as split() will rearrange records x$...idx2 = idx[,2] spl = split(x, idx[,1]) # reconstruct idx2: idx2 = do.call(c, lapply(spl, function(x) x$...idx2)) # for each of the source regions, compute weighted sum spl = lapply(spl, function(u) { w = if ((s <- sum(u$...x_st)) == 0) NA_real_ else u$...x_st / s u$...x_st = u$...idx2 = NULL # remove as.data.frame(lapply(u, function(v) v * w)) }) x = do.call(rbind, spl) # sum over the target regions: # x = aggregate(x, list(idx[,2]), sum) x = aggregate(x, list(idx2), sum) df = if (keep_NA) { ix = rep(NA_integer_, length(to)) ix[x$Group.1] = seq_along(x$Group.1) st_sf(x[ix,], geometry = st_geometry(to)) } else st_sf(x, geometry = st_geometry(to)[x$Group.1], row.names = x$Group.1) # clean up: df$Group.1 = NULL st_set_agr(df, "aggregate") } ================================================ FILE: R/agr.R ================================================ agr_levels = c("constant", "aggregate", "identity") #' @name st_agr #' @details #' \code{NA_agr_} is the \code{agr} object with a missing value. #' @export NA_agr_ = factor(NA, levels = agr_levels) #' get or set relation_to_geometry attribute of an \code{sf} object #' #' get or set relation_to_geometry attribute of an \code{sf} object #' @name st_agr #' @param x object of class \code{sf} #' @param ... ignored #' @export st_agr = function(x, ...) UseMethod("st_agr") #' @export st_agr.sf = function(x, ...) { sfc_s = sapply(x, inherits, "sfc") nm = names(x)[!sfc_s] ret = attr(x, "agr")[nm] if (is.null(names(ret)) || all(is.na(names(ret)))) structure(rep(NA_agr_, length(nm)), names = nm) else ret } #' @export st_agr.character = function(x, ...) { structure(factor(x, levels = agr_levels), names = names(x)) } #' @export st_agr.factor = function(x, ...) { stopifnot(all(levels(x) == agr_levels)) x } #' @export st_agr.default = function(x = NA_character_, ...) { if (is.data.frame(x) && !is.null(attr(x, "agr"))) x = attr(x, "agr") structure(st_agr(as.character(x)), names = names(x)) } #' @name st_agr #' @param value character, or factor with appropriate levels; if named, names should correspond to the non-geometry list-column columns of \code{x} #' @export `st_agr<-` = function(x, value) UseMethod("st_agr<-") #' @export `st_agr<-.sf` = function(x, value) { stopifnot(is.character(value) || is.factor(value)) sfc_s = sapply(x, inherits, "sfc") # nv = setdiff(names(x), attr(x, "sf_column")) nv = names(x)[!sfc_s] if (length(value) == 0) attr(x, "agr") = setNames(NA_agr_[0], character()) else if (! is.null(names(value)) && length(value) == 1) { # as in: st_agr(x) = c(Group.1 = "identity"): replace one particular named if (!is.null(attr(x, "agr"))) attr(x, "agr")[names(value)] = st_agr(value) else attr(x, "agr") = st_agr(value) } else { value = rep(st_agr(value), length.out = length(nv)) if (! is.null(names(value))) value = value[match(nv, names(value))] else names(value) = nv attr(x, "agr") <- value } #print(paste("vars: ", paste(nv, collapse=","), "value(s):", paste(value, collapse = ","))) #print(rlang::trace_back()) # a = st_agr(x) # absent = setdiff(names(x), c(na.omit(names(a)), attr(x, "sf_column"))) # if (length(absent)) { # repair: # a[absent] = NA_agr_ # names(a[absent]) = absent # attr(x, "agr") = a[nv] # } x } #' @name st_agr #' @export st_set_agr = function(x, value) { if (!missing(value)) st_agr(x) = value else { # needs repair? value = st_agr(x) if (any(is.na(names(value))) && length(value) == length(x) - 1) { names(value) = setdiff(names(x), attr(x, "sf_column")) st_agr(x) = value } } x } summarize_agr = function(x) { su = summary(st_agr(x)) su = su[su > 0] paste0(names(su), " (", su, ")", collapse = ", ") } all_constant = function(x) { x = attr(x, "agr") !anyNA(x) && all(x %in% c("identity", "constant")) } ================================================ FILE: R/arith.R ================================================ #' Arithmetic operators for simple feature geometries #' @name Ops #' #' @param e1 object of class \code{sfg} or \code{sfc} #' @param e2 numeric, or object of class \code{sfg}; in case \code{e1} is of class \code{sfc} also an object of class \code{sfc} is allowed #' #' @details in case \code{e2} is numeric, +, -, *, /, %% and %/% add, subtract, multiply, divide, modulo, or integer-divide by \code{e2}. In case \code{e2} is an n x n matrix, * matrix-multiplies and / multiplies by its inverse. If \code{e2} is an \code{sfg} object, |, /, & and %/% result in the geometric union, difference, intersection and symmetric difference respectively, and \code{==} and \code{!=} return geometric (in)equality, using \link{st_equals}. If `e2` is an `sfg` or `sfc` object, for operations `+` and `-` it has to have `POINT` geometries. #' #' If \code{e1} is of class \code{sfc}, and \code{e2} is a length 2 numeric, then it is considered a two-dimensional point (and if needed repeated as such) only for operations \code{+} and \code{-}, in other cases the individual numbers are repeated; see commented examples. #' #' @details #' It has been reported (https://github.com/r-spatial/sf/issues/2067) that #' certain ATLAS versions result in invalid polygons, where the final point #' in a ring is no longer equal to the first point. In that case, setting #' the precisions with \link{st_set_precision} may help. #' @return object of class \code{sfg} #' @export #' #' @examples #' st_point(c(1,2,3)) + 4 #' st_point(c(1,2,3)) * 3 + 4 #' m = matrix(0, 2, 2) #' diag(m) = c(1, 3) #' # affine: #' st_point(c(1,2)) * m + c(2,5) #' # world in 0-360 range: #' if (require(maps, quietly = TRUE)) { #' w = st_as_sf(map('world', plot = FALSE, fill = TRUE)) #' w2 = (st_geometry(w) + c(360,90)) %% c(360) - c(0,90) #' w3 = st_wrap_dateline(st_set_crs(w2 - c(180,0), 4326)) + c(180,0) #' plot(st_set_crs(w3, 4326), axes = TRUE) #' } #' (mp <- st_point(c(1,2)) + st_point(c(3,4))) # MULTIPOINT (1 2, 3 4) #' mp - st_point(c(3,4)) # POINT (1 2) #' opar = par(mfrow = c(2,2), mar = c(0, 0, 1, 0)) #' a = st_buffer(st_point(c(0,0)), 2) #' b = a + c(2, 0) #' p = function(m) { plot(c(a,b)); plot(eval(parse(text=m)), col=grey(.9), add = TRUE); title(m) } #' o = lapply(c('a | b', 'a / b', 'a & b', 'a %/% b'), p) #' par(opar) #' sfc = st_sfc(st_point(0:1), st_point(2:3)) #' sfc + c(2,3) # added to EACH geometry #' sfc * c(2,3) # first geometry multiplied by 2, second by 3 Ops.sfg <- function(e1, e2) { if (nargs() == 1) { switch (.Generic, "-" = return(e1 * -1.0), "+" = return(e1), stop(paste("unary", .Generic, 'not defined for "sfg" objects')) ) } prd <- switch(.Generic, "*" = TRUE, "/" = TRUE, FALSE) pm <- switch(.Generic, "+" = , "-" = TRUE, FALSE) mod <- switch(.Generic, "%%" = TRUE, "%/%" = TRUE, FALSE) set <- switch(.Generic, "&" = TRUE, "|" = TRUE, FALSE) lgcl <- switch(.Generic, "==" = TRUE, "!=" = TRUE, FALSE) if (!(prd || pm || mod || set || lgcl)) stop(paste("operation", .Generic, "not supported for sfg objects")) e1_empty = st_is_empty(e1) e2_empty = inherits(e2, "sfg") && st_is_empty(e2) if (lgcl && (e1_empty || e2_empty)) return(NA) if (e1_empty && (.Generic %in% c("*", "+", "-", "%%"))) return(e1) if (inherits(e2, "sfg")) { e2 = switch(.Generic, "|" = st_union(e1, e2), "/" = st_difference(e1, e2), "&" = st_intersection(e1, e2), "%/%" = st_sym_difference(e1, e2), "==" = length(st_equals(e1, e2)[[1]]) != 0, "!=" = length(st_equals(e1, e2)[[1]]) == 0, unclass(e2)) if (inherits(e2, "sfg") || is.logical(e2)) return(e2) } dims = nchar(class(e1)[1]) Vec = rep(0, dims) Mat = matrix(0, dims, dims) diag(Mat) = 1 if (pm || mod) { if (length(e2) == 1) Vec = rep(e2, length.out = dims) else Vec = e2 if (.Generic == "-") Vec = -Vec } else if (prd) { if (length(e2) == 1 || length(e2) == dims) diag(Mat) = e2 else Mat = e2 if (.Generic == "/") Mat = solve(Mat) # inverse } if_pt = function(x, y) { if(inherits(x, "POINT")) as.vector(y) else y } fn = if (prd) function(x, Mat, Vec) structure(if_pt(x, x %*% Mat), class = class(x)) else if (pm) function(x, Mat, Vec) structure(if_pt(x, unclass(x) + conform(Vec, x)), class = class(x)) else # mod: function(x, Mat, Vec) structure(if_pt(x, unclass(x) %% conform(Vec, x)), class = class(x)) if (is.list(e1)) rapply(e1, fn, how = "replace", Mat = Mat, Vec = Vec) else fn(e1, Mat, Vec) } conform = function(vec, m) { if (is.matrix(m)) t(matrix(vec, ncol(m), nrow(m))) else vec } #' @export #' @name Ops #' @examples #' nc = st_transform(st_read(system.file("gpkg/nc.gpkg", package="sf")), 32119) # nc state plane, m #' b = st_buffer(st_centroid(st_union(nc)), units::set_units(50, km)) # shoot a hole in nc: #' plot(st_geometry(nc) / b, col = grey(.9)) Ops.sfc <- function(e1, e2) { if (length(e1) == 0) # empty set return(e1) if (is.numeric(e2) && !is.matrix(e2) && length(e2) <= 2 && .Generic %in% c("+", "-")) { if (.Generic == "-") e2 <- -e2 return(opp_sfc(e1, as.numeric(e2), 0L, NA_crs_)) } else if (.Generic %in% c("*", "/") && is.numeric(e2) && (length(e2) == 1 || (is_only_pos_diag(e2)))) { if (is.matrix(e2)) e2 <- diag(e2) if (.Generic == "/") e2 <- 1 / e2 return(opp_sfc(e1, as.numeric(e2), 1L, NA_crs_)) } if ((is.matrix(e2) && ncol(e2) == 2) || (is.numeric(e2) && length(e2) == 2)) e1 = st_zm(e1) # drop z and/or m if (!is.list(e2) && ((.Generic %in% c("+", "-") && length(e2) == 2) || is.matrix(e2))) e2 = list(e2) ret = switch( .Generic, "&" = mapply(function(x, y) { x & y }, e1, e2, SIMPLIFY = FALSE), "|" = mapply(function(x, y) { x | y }, e1, e2, SIMPLIFY = FALSE), "%/%" = mapply(function(x, y) { x %/% y}, e1, e2, SIMPLIFY = FALSE), "/" = mapply(function(x, y) { x / y }, e1, e2, SIMPLIFY = FALSE), "!=" = mapply(function(x, y) { x != y }, e1, e2, SIMPLIFY = TRUE), "==" = mapply(function(x, y) { x == y }, e1, e2, SIMPLIFY = TRUE), "*" = mapply(function(x, y) { x * y }, e1, e2, SIMPLIFY = FALSE), "+" = mapply(function(x, y) { x + y }, e1, e2, SIMPLIFY = FALSE), "-" = mapply(function(x, y) { x - y }, e1, e2, SIMPLIFY = FALSE), "%%" = mapply(function(x, y) { x %% y }, e1, e2, SIMPLIFY = FALSE), stop(paste("operation", .Generic, "not supported"))) if (!(.Generic %in% c("!=", "=="))) { crs = if (.Generic %in% c("&", "|", "%/%", "/") && inherits(e2, c("sfc", "sfg"))) # retain: st_crs(e1) else # geometry got displaced: NA_crs_ st_sfc(ret, crs = crs, precision = attr(e1, "precision"), recompute_bbox = TRUE) # also check_ring_dir, if polygons? #2377 } else ret } is_only_pos_diag <- function(x) { is.matrix(x) && all(`diag<-`(x, 0) == 0) && all(diag(x) >= 0) # nocov } ================================================ FILE: R/bbox.R ================================================ #' @name st_bbox #' @param x object of class \code{bbox} #' @export is.na.bbox = function(x) identical(x, NA_bbox_) bb_wrap = function(bb) { stopifnot(is.numeric(bb), length(bb) == 4) structure(as.double(bb), names = c("xmin", "ymin", "xmax", "ymax"), class = "bbox") } bbox.Set = function(obj, ...) { sel = !sfc_is_empty(obj) if (! any(sel)) NA_bbox_ else bb_wrap(CPL_get_bbox(unclass(obj)[sel], 0)) } bbox.Mtrx = function(obj, ...) { if (length(obj) == 0) NA_bbox_ else bb_wrap(CPL_get_bbox(list(obj), 1)) # note the list() } bbox.MtrxSet = function(obj, ...) { if (length(obj) == 0) NA_bbox_ else bb_wrap(CPL_get_bbox(obj, 1)) } bbox.MtrxSetSet = function(obj, ...) { if (length(obj) == 0) NA_bbox_ else bb_wrap(CPL_get_bbox(obj, 2)) } bbox.MtrxSetSetSet = function(obj, ...) { if (length(obj) == 0) NA_bbox_ else bb_wrap(CPL_get_bbox(obj, 3)) } #' Return bounding of a simple feature or simple feature set #' #' Return bounding of a simple feature or simple feature set #' @param obj object to compute the bounding box from #' @param ... for format.bbox, passed on to \link[base]{format} to format individual numbers #' @export #' @return a numeric vector of length four, with \code{xmin}, \code{ymin}, \code{xmax} #' and \code{ymax} values; if \code{obj} is of class \code{sf}, \code{sfc}, \code{Spatial} or \code{Raster}, the object #' returned has a class \code{bbox}, an attribute \code{crs} and a method to print the #' bbox and an \code{st_crs} method to retrieve the coordinate reference system #' corresponding to \code{obj} (and hence the bounding box). \link{st_as_sfc} has a #' methods for \code{bbox} objects to generate a polygon around the four bounding box points. #' @name st_bbox #' @examples #' a = st_sf(a = 1:2, geom = st_sfc(st_point(0:1), st_point(1:2)), crs = 4326) #' st_bbox(a) #' st_as_sfc(st_bbox(a)) st_bbox = function(obj, ...) UseMethod("st_bbox") #' @export #' @name st_bbox st_bbox.POINT = function(obj, ...) bb_wrap(c(obj[1L], obj[2L], obj[1L], obj[2L])) #' @export #' @name st_bbox st_bbox.MULTIPOINT = bbox.Mtrx #' @export #' @name st_bbox st_bbox.LINESTRING = bbox.Mtrx #' @export #' @name st_bbox st_bbox.POLYGON = function(obj, ...) if (st_is_full(obj)) FULL_bbox_ else bbox.MtrxSet(obj) #' @export #' @name st_bbox st_bbox.MULTILINESTRING = bbox.MtrxSet #' @export #' @name st_bbox st_bbox.MULTIPOLYGON = bbox.MtrxSetSet bbox_list = function(obj, ...) { s = vapply(obj, st_bbox, c(0.,0.,0.,0.)) # dispatch on class if (length(s) == 0 || all(is.na(s[1L,]))) NA_bbox_ else bb_wrap(c(min(s[1L,], na.rm = TRUE), min(s[2L,], na.rm = TRUE), max(s[3L,], na.rm = TRUE), max(s[4L,], na.rm = TRUE))) } #' @name st_bbox #' @export st_bbox.GEOMETRYCOLLECTION = bbox_list #' @name st_bbox #' @export st_bbox.MULTISURFACE = bbox_list #' @name st_bbox #' @export st_bbox.MULTICURVE = bbox_list #' @name st_bbox #' @export st_bbox.CURVEPOLYGON = bbox_list #' @name st_bbox #' @export st_bbox.COMPOUNDCURVE = bbox_list #' @name st_bbox #' @export st_bbox.POLYHEDRALSURFACE = bbox.MtrxSetSet #' @name st_bbox #' @export st_bbox.TIN = bbox.MtrxSetSet #' @name st_bbox #' @export st_bbox.TRIANGLE = bbox.MtrxSet #' @name st_bbox #' @export st_bbox.CIRCULARSTRING = function(obj, ...) { # this is of course wrong: st_bbox(st_cast(obj, "LINESTRING")) } #' @export print.bbox = function(x, ...) { x = structure(x, crs = NULL, class = NULL) print(set_units(x, attr(x, "units"), mode = "standard"), ...) } compute_bbox = function(obj) { switch(class(obj)[1], sfc_POINT = bb_wrap(bbox.Set(obj)), sfc_MULTIPOINT = bb_wrap(bbox.MtrxSet(obj)), sfc_LINESTRING = bb_wrap(bbox.MtrxSet(obj)), sfc_POLYGON = if (any(st_is_full(obj))) FULL_bbox_ else bb_wrap(bbox.MtrxSetSet(obj)), sfc_MULTILINESTRING = bb_wrap(bbox.MtrxSetSet(obj)), sfc_MULTIPOLYGON = bb_wrap(bbox.MtrxSetSetSet(obj)), bbox_list(obj) ) } #' @name st_bbox #' @export st_bbox.sfc = function(obj, ...) structure(attr(obj, "bbox"), crs = st_crs(obj)) #' @name st_bbox #' @export st_bbox.sf = function(obj, ...) st_bbox(st_geometry(obj)) #' @name st_bbox #' @export st_bbox.Spatial = function(obj, ...) { if (!requireNamespace("sp", quietly = TRUE)) stop("package sp required, please install it first") bb = sp::bbox(obj) structure(bb_wrap(c(bb[1,1],bb[2,1],bb[1,2],bb[2,2])), crs = st_crs(slot(obj, "proj4string"))) } #' @name st_bbox #' @export st_bbox.Raster = function(obj, ...) { if (!requireNamespace("sp", quietly = TRUE)) stop("package sp required, please install it first") if (!requireNamespace("raster", quietly = TRUE)) stop("package raster required, please install it first") bb = sp::bbox(obj) structure(bb_wrap(c(bb[1,1],bb[2,1],bb[1,2],bb[2,2])), crs = st_crs(sp::proj4string(obj))) } #' @name st_bbox #' @export st_bbox.Extent = function(obj, ..., crs = NA_crs_) { if (!requireNamespace("raster", quietly = TRUE)) stop("package raster required, please install it first") structure(bb_wrap(c(obj@xmin, obj@ymin, obj@xmax, obj@ymax)), crs = st_crs(crs)) } #' @name st_bbox #' @param crs object of class \code{crs}, or argument to \link{st_crs}, specifying the CRS of this bounding box. #' @examples #' st_bbox(c(xmin = 16.1, xmax = 16.6, ymax = 48.6, ymin = 47.9), crs = st_crs(4326)) #' @export st_bbox.numeric = function(obj, ..., crs = NA_crs_) { structure(bb_wrap(obj[c("xmin", "ymin", "xmax", "ymax")]), crs = st_crs(crs)) } #' @export st_bbox.bbox = function(obj, ...) obj #' @export "$.bbox" = function(x, name) { switch(name, xrange =, xlim = x[c("xmin", "xmax")], yrange =, ylim = x[c("ymin", "ymax")], xmin = x["xmin"], ymin = x["ymin"], xmax = x["xmax"], ymax = x["ymax"], stop("unsupported name") ) } #' @name st_bbox #' @details \code{NA_bbox_} represents the missing value for a \code{bbox} object #' @export NA_bbox_ = structure(rep(NA_real_, 4), names = c("xmin", "ymin", "xmax", "ymax"), crs = NA_crs_, class = "bbox") #' @name st_bbox #' @details \code{NA_bbox_} represents the missing value for a \code{bbox} object #' @export FULL_bbox_ = structure(c(-180.,-90.,180.,90.), names = c("xmin", "ymin", "xmax", "ymax"), crs = NA_crs_, class = "bbox") #' @name st_bbox #' @export format.bbox = function(x, ...) { p1 = paste0("(",paste0(c(format(x[1], ...), format(x[2], ...)), collapse=","),")") p2 = paste0("(",paste0(c(format(x[3], ...), format(x[4], ...)), collapse=","),")") paste0("(",p1,",",p2,")") } ================================================ FILE: R/bind.R ================================================ chk_equal_crs = function(dots) { if (length(dots) > 1L) { crs0 = st_crs(dots[[1]]) vapply(dots[-1L], function(x) { if (st_crs(x) != crs0) stop("arguments have different crs", call. = FALSE) TRUE }, TRUE) } NULL } #' Bind rows (features) of sf objects #' #' Bind rows (features) of sf objects #' @param ... objects to bind; note that for the rbind and cbind methods, all objects have to be of class \code{sf}; see \link{dotsMethods} #' @param deparse.level integer; see \link{rbind} #' @name bind #' @details both \code{rbind} and \code{cbind} have non-standard method dispatch (see \link[base]{cbind}): the \code{rbind} or \code{cbind} method for \code{sf} objects is only called when all arguments to be binded are of class \code{sf}. #' @export #' @examples #' crs = st_crs(3857) #' a = st_sf(a=1, geom = st_sfc(st_point(0:1)), crs = crs) #' b = st_sf(a=1, geom = st_sfc(st_linestring(matrix(1:4,2))), crs = crs) #' c = st_sf(a=4, geom = st_sfc(st_multilinestring(list(matrix(1:4,2)))), crs = crs) #' rbind(a,b,c) #' rbind(a,b) #' rbind(a,b) #' rbind(b,c) rbind.sf = function(..., deparse.level = 1) { dots = list(...) dots = dots[!sapply(dots, is.null)] nr = sapply(dots, NROW) sf_column = if (any(nr > 0)) attr(dots[[ which(nr > 0)[1] ]], "sf_column") else NULL chk_equal_crs(dots) ret = st_sf(rbind.data.frame(...), crs = st_crs(dots[[1]]), sf_column_name = sf_column) st_geometry(ret) = st_sfc(st_geometry(ret)) # might need to reclass to GEOMETRY bb = do.call(rbind, lapply(dots, st_bbox)) bb = bb_wrap(c(min(bb[,1L], na.rm = TRUE), min(bb[,2L], na.rm = TRUE), max(bb[,3L], na.rm = TRUE), max(bb[,4L], na.rm = TRUE))) attr(ret[[ attr(ret, "sf_column") ]], "bbox") = bb ret } #' Bind columns (variables) of sf objects #' #' Bind columns (variables) of sf objects #' @name bind #' @param sf_column_name character; specifies active geometry; passed on to \link{st_sf} #' @return \code{cbind} called with multiple \code{sf} objects warns about multiple geometry columns present when the geometry column to use is not specified by using argument \code{sf_column_name}; see also \link{st_sf}. #' @export #' @details If you need to \code{cbind} e.g. a \code{data.frame} to an \code{sf}, use \link{data.frame} directly and use \link{st_sf} on its result, or use \link[dplyr:bind]{bind_cols}; see examples. #' @examples #' cbind(a,b,c) # warns #' if (require(dplyr, quietly = TRUE)) #' dplyr::bind_cols(a,b) #' c = st_sf(a=4, geomc = st_sfc(st_multilinestring(list(matrix(1:4,2)))), crs = crs) #' cbind(a,b,c, sf_column_name = "geomc") #' df = data.frame(x=3) #' st_sf(data.frame(c, df)) #' if (require(dplyr, quietly = TRUE)) #' dplyr::bind_cols(c, df) cbind.sf = function(..., deparse.level = 1, sf_column_name = NULL) { # TODO: handle st_agr? st_sf(data.frame(...), sf_column_name = sf_column_name) } #' @name bind #' @export #' @details \code{st_bind_cols} is deprecated; use \code{cbind} instead. st_bind_cols = function(...) { # nocov start .Deprecated("cbind", msg = paste0("Use 'cbind' instead when all arguments", " to be binded are of class sf.\n", "If you need to cbind a data.frame to an sf,", " use 'st_sf' or 'dplyr::bind_cols' (see the examples).")) cbind.sf(...) # nocov end } ================================================ FILE: R/break_antimeridian.R ================================================ #' Break antimeridian for plotting not centred on Greenwich #' #' Longitudes can be broken at the antimeridian of a target central longitude #' to permit plotting of (usually world) line or polygon objects centred #' on the chosen central longitude. The method may only be used with #' non-projected, geographical coordinates and linestring or polygon objects. #' s2 is turned off internally to permit the use of a rectangular bounding #' box. If the input geometries go outside `[-180, 180]` degrees longitude, #' the protruding geometries will also be split using the same \code{tol=} #' values; in this case empty geometries will be dropped first. #' #' @param x object of class `sf` or `sfc` #' @param lon_0 target central longitude (degrees) #' @param tol half of break width (degrees, default 0.0001) #' @param ... ignored here #' @export #' @name st_break_antimeridian #' @examples #' \donttest{ #' if (require("maps", quietly=TRUE)) { #' opar = par(mfrow=c(3, 2)) #' wld = st_as_sf(map(fill=FALSE, interior=FALSE, plot=FALSE), fill=FALSE) #' for (lon_0 in c(-170, -90, -10, 10, 90, 170)) { #' br = st_break_antimeridian(wld, lon_0 = lon_0) #' tr = st_transform(br, paste0("+proj=natearth +lon_0=", lon_0)) #' plot(st_geometry(tr), main=lon_0) #' } #' par(opar) #' } #' } st_break_antimeridian = function(x, lon_0=0, tol=0.0001, ...) { ll = st_is_longlat(x) if (!isTRUE(ll)) stop("'st_break_antimeridian' requires non-projected geographic coordinates", call. = FALSE) UseMethod("st_break_antimeridian") } #' @export #' @name st_break_antimeridian st_break_antimeridian.sf = function(x, lon_0=0, tol=0.0001, ...) { type = st_geometry_type(x) if (length(grep("CURVE", type[grep("LINESTRING|POLYGON", type)], invert=TRUE)) == 0L) stop("'st_break_antimeridian' requires linestring or polygon objects", call. = FALSE) bb0 = st_bbox(x) low = bb0[1] < -(180+tol) high = bb0[3] > (180+tol) if (low || high) { warning("st_break_antimeridian: longitude coordinates outside [-180, 180]") # x_c = st_geometry(x) # g = ((x_c + c(360, 90)) %% c(360) - c(0, 90)) - c(180, 0) # st_crs(g) <- st_crs(x) # st_geometry(x) = g x <- st_within_pm180(x, tol=tol) bb0 = st_bbox(x) } if (lon_0 < 0) { am = lon_0 + 180 am_w = am - tol am_e = am + tol if (am_w > 180) am_w = am_w - 360 } else { am = lon_0 - 180 am_w = am - tol am_e = am + tol if (am_w < -180) am_w = am_w + 360 } if (lon_0 == 0) { bb1 = bb0 bb1[1] = am_e bb1[3] = am_w bb1 = st_as_sfc(bb1) } else { bb1w = bb1e = bb0 bb1w[3] = am_w # antimeridian of target minus fuzz bb1e[1] = am_e # plus fuzz bb1 = c(st_as_sfc(bb1w), st_as_sfc(bb1e)) } s2_status = sf_use_s2() sf_use_s2(FALSE) # avoid s2 because we need a planar bounding box on.exit(sf_use_s2(s2_status)) res = st_intersection(x, bb1) st_crs(res) = st_crs(x) res } #' @export #' @name st_break_antimeridian st_break_antimeridian.sfc = function(x, lon_0=0, tol=0.0001, ...) { # cannot reduce sf to sfc because the length of the returned object is # not restricted to the row count of the input object st_geometry(st_break_antimeridian(st_as_sf(x), lon_0=lon_0, tol=tol)) } st_within_pm180 <- function(x, tol=0.0001) { stopifnot(inherits(x, "sf")) xempt = st_is_empty(x) if (any(xempt)) x = x[!xempt,] xcrs = st_crs(x) xnames = names(x) xnames = xnames[grep(attr(x, "sf_column"), xnames, invert=TRUE)] x$st_within_pm180_ID = as.character(seq_len(nrow(x))) s2_status = sf_use_s2() sf_use_s2(FALSE) # avoid s2 because we need a planar bounding box bb0 = st_bbox(x) low = bb0[1] < -(180+tol) high = bb0[3] > (180+tol) bb1w = bb1e = bb0 if (low) { am = -180 am_w = am - tol am_e = am + tol if (am_w > 180) am_w = am_w - 360 bb1w[3] = am_w # 180 minus fuzz bb1e[1] = am_e # 180 plus fuzz xw = st_intersection(x, st_as_sfc(bb1w)) xe = st_intersection(x, st_as_sfc(bb1e)) gw = st_geometry(xw) gw = gw + c(360, 0) st_crs(gw) <- xcrs st_geometry(xw) <- gw o = rbind(xw, xe) x = aggregate(o, list(o$st_within_pm180_ID), head, 1) x = x[, xnames] st_crs(x) = xcrs } bb0 = st_bbox(x) bb1w = bb1e = bb0 if (high) { am = 180 am_w = am - tol am_e = am + tol if (am_w < -180) am_w = am_w + 360 bb1w[3] = am_w # 180 minus fuzz bb1e[1] = am_e # 180 plus fuzz xw = st_intersection(x, st_as_sfc(bb1w)) xe = st_intersection(x, st_as_sfc(bb1e)) ge = st_geometry(xe) ge = ge - c(360, 0) st_crs(ge) <- xcrs st_geometry(xe) <- ge o = rbind(xw, xe) x = aggregate(o, list(o$st_within_pm180_ID), head, 1) x = x[, xnames] st_crs(x) = xcrs } sf_use_s2(s2_status) st_crs(x) = xcrs x } ================================================ FILE: R/cast_sfc.R ================================================ #' Cast geometry to another type: either simplify, or cast explicitly #' #' Cast geometry to another type: either simplify, or cast explicitly #' #' @param x object of class \code{sfg}, \code{sfc} or \code{sf} #' @param to character; target type, if missing, simplification is tried; when \code{x} is of type \code{sfg} (i.e., a single geometry) then \code{to} needs to be specified. #' @return object of class \code{to} if successful, or unmodified object if unsuccessful. If information gets lost while type casting, a warning is raised. #' @examples #' s = st_multipoint(rbind(c(1,0))) #' st_cast(s, "POINT") #' @export st_cast <- function(x, to, ...) UseMethod("st_cast") # see this figure: # https://cloud.githubusercontent.com/assets/520851/21387553/5f1edcaa-c778-11e6-92d0-2d735e4c8e40.png # columns start counting at 0: which_sfc_col = function(cls) { stopifnot(!missing(cls)) switch(cls, POINT = 0, LINESTRING = 1, MULTIPOINT = 1, MULTILINESTRING = 2, POLYGON = 2, MULTIPOLYGON = 3, MULTICURVE = 3, GEOMETRYCOLLECTION = 4, COMPOUNDCURVE = 4, MULTISURFACE = 4, CURVEPOLYGON = 4, GEOMETRY = 5, stop(paste("st_cast for", cls, "not supported")) ) } # does this geometry type need closed polygons? need_close = function(cls) { switch(cls, POLYGON = TRUE, MULTIPOLYGON = TRUE, FALSE ) } # add y's attributes to x, return x add_attributes = function(x, y) { attributes(x) = attributes(y) x } close_polygon_or_multipolygon = function(x, to) { to_col = which_sfc_col(to) close_mat = function(m) { if (any(m[1,] != m[nrow(m),])) m = rbind(m, m[1,]) if (nrow(m) < 4) stop("polygons require at least 4 points") unclass(m) } add_attributes( if (to_col == 2) lapply(x, function(y) add_attributes(lapply(y, close_mat), y)) else if (to_col == 3) lapply(x, function(y) add_attributes(lapply(y, function(z) lapply(z, close_mat)), y)) else stop("invalid to_col value") , x) } # change the class of sfc x, and all its sfg list elements # (vertical cast) reclass = function(x, to, must_close) { l = if (length(x)) { full_cls = c(class(x[[1]])[1], to, "sfg") if (must_close) x = close_polygon_or_multipolygon(x, to) lapply(x, function(g) structure(g, class = full_cls)) } else list() attributes(l) = attributes(x) structure(l, class = c(paste0("sfc_", to), "sfc")) } # how long is each geometry in the sfc? get_lengths = function(x) { switch(class(x)[1], sfc_POINT = rep(1, length(x)), sfc_MULTIPOINT = vapply(x, nrow, 0L), sfc_LINESTRING = vapply(x, nrow, 0L), lengths(x) # list ) } #' Coerce geometry to MULTI* geometry #' #' Mixes of POINTS and MULTIPOINTS, LINESTRING and MULTILINESTRING, #' POLYGON and MULTIPOLYGON are returned as MULTIPOINTS, MULTILINESTRING and MULTIPOLYGONS respectively #' @param x list of geometries or simple features #' @details Geometries that are already MULTI* are left unchanged. #' Features that can't be cast to a single MULTI* geometry are return as a #' GEOMETRYCOLLECTION st_cast_sfc_default = function(x) { if (length(x) == 0) return(x) if (!identical(unique(vapply(x, function(w) class(w)[3L], "")), "sfg")) stop("list item(s) not of class sfg") # sanity check a <- attributes(x) ids = NULL cls = unique(vapply(x, function(x) class(x)[2L], "")) if (length(cls) > 1) { if (all(cls %in% c("POINT", "MULTIPOINT"))) { x <- lapply(x, function(x) if (inherits(x, "POINT")) POINT2MULTIPOINT(x) else x) class(x) <- c("sfc_MULTIPOINT", "sfc") } else if (all(cls %in% c("LINESTRING", "MULTILINESTRING"))) { x <- lapply(x, function(x) if (inherits(x, "LINESTRING")) LINESTRING2MULTILINESTRING(x) else x) class(x) <- c("sfc_MULTILINESTRING", "sfc") } else if (all(cls %in% c("POLYGON", "MULTIPOLYGON"))) { x <- lapply(x, function(x) if (inherits(x, "POLYGON")) POLYGON2MULTIPOLYGON(x) else x) class(x) <- c("sfc_MULTIPOLYGON", "sfc") } } else if (cls == "GEOMETRYCOLLECTION" && all(lengths(x))) { # https://github.com/r-spatial/sf/issues/1767 ids = get_lengths(x) x <- do.call(st_sfc, unlist(x, recursive = FALSE)) } attributes(x) <- a structure(st_sfc(x), ids = ids) } copy_sfc_attributes_from = function(x, ret) { structure(ret, precision = attr(x, "precision"), bbox = attr(x, "bbox"), crs = attr(x, "crs"), n_empty = attr(x, "n_empty"), z_range = attr(x, "z_range"), m_range = attr(x, "m_range")) } empty_sfg <- function(to) { switch(to, GEOMETRYCOLLECTION = st_geometrycollection(), MULTIPOLYGON = st_multipolygon(), POLYGON = st_polygon(), MULTILINESTRING = st_multilinestring(), LINESTRING = st_linestring(), MULTIPOINT = st_multipoint(), POINT = st_point() ) } is_exotic = function(x) { stopifnot(length(x) > 0) if (inherits(x, c("sfc_MULTICURVE", "sfc_COMPOUNDCURVE", "sfc_CURVEPOLYGON", "sfc_MULTISURFACE"))) # for which GEOS has no st_is_empty() TRUE else if (inherits(x, "sfc_GEOMETRY")) { cls = sapply(x, class) any(cls[2,] %in% c("MULTICURVE", "COMPOUNDCURVE", "CURVEPOLYGON", "MULTISURFACE")) } else FALSE } #' @name st_cast #' @param ids integer vector, denoting how geometries should be grouped (default: no grouping) #' @param group_or_split logical; if TRUE, group or split geometries; if FALSE, carry out a 1-1 per-geometry conversion. #' @param ... ignored #' @export #' @return In case \code{to} is missing, \code{st_cast.sfc} will coerce combinations of "POINT" and "MULTIPOINT", "LINESTRING" and "MULTILINESTRING", "POLYGON" and "MULTIPOLYGON" into their "MULTI..." form, or in case all geometries are "GEOMETRYCOLLECTION" will return a list of all the contents of the "GEOMETRYCOLLECTION" objects, or else do nothing. In case \code{to} is specified, if \code{to} is "GEOMETRY", geometries are not converted, else, \code{st_cast} will try to coerce all elements into \code{to}; \code{ids} may be specified to group e.g. "POINT" objects into a "MULTIPOINT", if not specified no grouping takes place. If e.g. a "sfc_MULTIPOINT" is cast to a "sfc_POINT", the objects are split, so no information gets lost, unless \code{group_or_split} is \code{FALSE}. #' @details When converting a GEOMETRYCOLLECTION to COMPOUNDCURVE, MULTISURFACE or CURVEPOLYGON, the user is responsible for the validity of the resulting object: no checks are being carried out by the software. #' #' When converting mixed, GEOMETRY sets, it may help to first convert to the MULTI-type, see examples #' @examples #' # https://github.com/r-spatial/sf/issues/1930: #' pt1 <- st_point(c(0,1)) #' pt23 <- st_multipoint(matrix(c(1,2,3,4), ncol = 2, byrow = TRUE)) #' d <- st_sf(geom = st_sfc(pt1, pt23)) #' st_cast(d, "POINT") # will not convert the entire MULTIPOINT, and warns #' st_cast(d, "MULTIPOINT") |> st_cast("POINT") st_cast.sfc = function(x, to, ..., ids = seq_along(x), group_or_split = TRUE) { if (missing(to)) return(st_cast_sfc_default(x)) if (length(x) == 0) # empty set return(structure(x, class = c(paste0("sfc_", to), "sfc"))) e = rep(FALSE, length(x)) if (!is_exotic(x)) { # for which GEOS has no st_is_empty() e = st_is_empty(x) if (all(e)) { x[e] = empty_sfg(to) return(x) # RETURNS } } if (any(e)) x = x[!e] from_cls = substr(class(x)[1], 5, 100) from_col = which_sfc_col(from_cls) to_col = which_sfc_col(to) ret = if (from_cls == to) x # returns x: do nothing else if (to == "GEOMETRY") # we can always do that: structure(x, class = c("sfc_GEOMETRY", "sfc")) else if (from_cls == "GEOMETRY" || !group_or_split) st_sfc(lapply(x, st_cast, to = to), crs = st_crs(x), precision = st_precision(x)) else if (from_col == to_col) # "vertical" conversion: only reclass, possibly close polygons reclass(x, to, need_close(to)) else if (abs(from_col - to_col) > 1) { if (to == "POINT") st_cast(st_cast(x, "MULTIPOINT"), "POINT") else if (to == "MULTIPOINT") { ret = lapply(x, function(y) structure(as.matrix(y), class = c(class(y)[1], to, "sfg"))) ret = copy_sfc_attributes_from(x, ret) reclass(ret, to, FALSE) } else #st_cast(st_cast(x, "MULTILINESTRING"), to) stop("use smaller steps for st_cast; first cast to MULTILINESTRING or POLYGON?") } else if (from_col < to_col) { # "horizontal", to the right: group ret = if (from_col == 0) lapply(unname(split(x, ids)), function(y) structure(do.call(rbind, y), class = class(x[[1]]))) else lapply(unname(split(x, ids)), function(y) structure(y, class = class(x[[1]]))) ret = copy_sfc_attributes_from(x, ret) reclass(ret, to, need_close(to)) } else if (from_col == 3 && to == "MULTILINESTRING") { if (from_cls == "MULTICURVE") { ret = lapply(x, st_cast, to = "MULTILINESTRING") } else { ret = lapply(x, unlist, recursive = FALSE) # unlist one level deeper; one MULTIPOLYGON -> one MULTILINESTRING if (length(ret)) class(ret[[1]]) = class(x[[1]]) # got dropped } ret = copy_sfc_attributes_from(x, ret) structure(reclass(ret, to, FALSE)) } else { # "horizontal", to the left: split ret = if (from_col == 1) # LINESTRING or MULTIPOINT to POINT unlist(lapply(x, function(m) lapply(seq_len(nrow(m)), function(i) m[i,])), recursive = FALSE) else { if (to_col == 0 && from_cls == "POLYGON") # POLYGON -> POINT lapply(x, function(y) do.call(rbind, y)) else unlist(x, recursive = FALSE) } ret = lapply(ret, function(y) structure(y, class = class(x[[1]]))) # will be reset by reclass() ret = copy_sfc_attributes_from(x, ret) # EJP: FIXME: structure(reclass(ret, to, need_close(to)), ids = get_lengths(x)) } if (any(e)) { crs = st_crs(x) x = vector("list", length = length(e)) x[e] = list(empty_sfg(to)) x[!e] = ret st_set_crs(do.call(st_sfc, x), crs) } else ret } #' @name st_cast #' @param warn logical; if \code{TRUE}, warn if attributes are assigned to sub-geometries #' @param do_split logical; if \code{TRUE}, allow splitting of geometries in sub-geometries #' @export #' @details the \code{st_cast} method for \code{sf} objects can only split geometries, e.g. cast \code{MULTIPOINT} into multiple \code{POINT} features. In case of splitting, attributes are repeated and a warning is issued when non-constant attributes are assigned to sub-geometries. To merge feature geometries and attribute values, use \link[sf:aggregate.sf]{aggregate} or \link[sf:tidyverse]{summarise}. st_cast.sf = function(x, to, ..., warn = TRUE, do_split = TRUE) { geom = st_cast(st_geometry(x), to, group_or_split = do_split) agr = st_agr(x) all_const = all_constant(x) sf_column = attr(x, "sf_column") # keep name st_geometry(x) = NULL # class(x) = setdiff(class(x), "sf") ids = attr(geom, "ids") # e.g. 3 2 4 if (!is.null(ids)) { # split: if (warn && ! all_const) warning("repeating attributes for all sub-geometries for which they may not be constant") reps = rep(seq_len(length(ids)), ids) # 1 1 1 2 2 3 3 3 3 etc agr[agr == "identity"] = "constant" # since we splitted x = x[reps,, drop = FALSE] stopifnot(nrow(x) == length(geom)) } attr(geom, "ids") = NULL # remove x[[sf_column]] = geom st_geometry(x) = sf_column st_agr(x) = agr x } #' @name st_cast #' @export st_cast.sfc_CIRCULARSTRING <- function(x, to, ...) { if (isTRUE(st_is_longlat(x))) message_longlat("st_cast") stopifnot(to == "LINESTRING") st_sfc(CPL_circularstring_to_linestring(st_sfc(x)), crs = st_crs(x)) # should add attributes? } #' test equality between the geometry type and a class or set of classes #' #' test equality between the geometry type and a class or set of classes #' @param x object of class \code{sf}, \code{sfc} or \code{sfg} #' @param type character; class, or set of classes, to test against #' @examples #' st_is(st_point(0:1), "POINT") #' sfc = st_sfc(st_point(0:1), st_linestring(matrix(1:6,,2))) #' st_is(sfc, "POINT") #' st_is(sfc, "POLYGON") #' st_is(sfc, "LINESTRING") #' st_is(st_sf(a = 1:2, sfc), "LINESTRING") #' st_is(sfc, c("POINT", "LINESTRING")) #' @export st_is = function(x, type) UseMethod("st_is") #' @export st_is.sf = function(x, type) st_is(st_geometry(x), type) #' @export st_is.sfc = function(x, type) vapply(x, inherits, type, FUN.VALUE = logical(1)) #' @export st_is.sfg = function(x, type) inherits(x, type) ================================================ FILE: R/cast_sfg.R ================================================ ## utility functions, patterns that are either used elsewhere or can be ## replaced by other changes ## ## worker functions from the internals of c.sfg ## to unclass the underlying coordinates Paste0 <- function(lst) lapply(lst, unclass) ## ## drop the tail coordinate of a polygon ring Tail1 <- function(lst) lapply(lst, head, -1) ClosePol <- function(mtrx) { stopifnot(is.matrix(mtrx)) if (!all(mtrx[1,] == mtrx[nrow(mtrx),])) mtrx = rbind(mtrx, mtrx[1,]) if (nrow(mtrx) < 4) stop("polygons require at least 4 points") mtrx } ## multi-polygon and polygon constructor, allow unclosed (but don't apply auto-closing) ## note use of local constructor below, not the sf-API one #st_multipolygon_close <- function(x = list(), dim = "XYZ") { # MtrxSetSet(x, dim, type = "MULTIPOLYGON", needClosed = FALSE) #} #st_polygon_close <- function(x = list(), dim = "XYZ") { # MtrxSet(x, dim, type = "POLYGON", needClosed = FALSE) #} # TODO # FIXME: warn on multi-part loss only if there are multiple parts # disallow auto-polygon-closure for two-point inputs: st_cast(st_linestring(cbind(0, 1:2)), "POLYGON") # -> that should give an error # check discussions, holes become lines, those lines become overlapping islands, or does polygonize auto-detect nesting ## and assign holes to islands as sp-comments did? # test on holes # warnings on these individual tests as here, or on detection of loss higher up? # geometrycollection conversions? # check comments and warnings are consistent in each case below #' @name st_cast #' @export #' @examples #' # example(st_read) #' nc = st_read(system.file("shape/nc.shp", package="sf")) #' mpl <- st_geometry(nc)[[4]] #' #st_cast(x) ## error 'argument "to" is missing, with no default' #' cast_all <- function(xg) { #' lapply(c("MULTIPOLYGON", "MULTILINESTRING", "MULTIPOINT", "POLYGON", "LINESTRING", "POINT"), #' function(x) st_cast(xg, x)) #' } #' st_sfc(cast_all(mpl)) #' ## no closing coordinates should remain for multipoint #' any(duplicated(unclass(st_cast(mpl, "MULTIPOINT")))) ## should be FALSE #' ## number of duplicated coordinates in the linestrings should equal the number of polygon rings #' ## (... in this case, won't always be true) #' sum(duplicated(do.call(rbind, unclass(st_cast(mpl, "MULTILINESTRING")))) #' ) == sum(unlist(lapply(mpl, length))) ## should be TRUE #' #' p1 <- structure(c(0, 1, 3, 2, 1, 0, 0, 0, 2, 4, 4, 0), .Dim = c(6L, 2L)) #' p2 <- structure(c(1, 1, 2, 1, 1, 2, 2, 1), .Dim = c(4L, 2L)) #' st_polygon(list(p1, p2)) st_cast.MULTIPOLYGON <- function(x, to, ...) { switch(to, MULTIPOLYGON = x, MULTILINESTRING = st_multilinestring( unlist(Paste0(x), recursive = FALSE, use.names = FALSE)), MULTIPOINT = st_multipoint(do.call(rbind, Tail1(unlist(Paste0(x), recursive = FALSE, use.names = FALSE)))), ## loss, drop to first part POLYGON = { if (length(x) > 1) warning("polygon from first part only") st_polygon(x[[1L]]) }, LINESTRING = {warning("line from first ring only"); st_linestring(x[[1L]][[1L]])}, ## loss, drop to first coordinate of first ring of first part POINT = {warning("point from first coordinate only"); st_point(x[[1L]][[1L]][1L, , drop = TRUE])}, GEOMETRYCOLLECTION = st_geometrycollection(list(x)) ) } #' @name st_cast #' @export #' @examples #' mls <- st_cast(st_geometry(nc)[[4]], "MULTILINESTRING") #' st_sfc(cast_all(mls)) st_cast.MULTILINESTRING <- function(x, to, ...) { switch(to, MULTIPOLYGON = st_multipolygon(list(lapply(x, ClosePol))), MULTILINESTRING = x, MULTIPOINT = st_multipoint(do.call(rbind, Paste0(x))), ## loss, drop to first line #POLYGON = {warning("keeping first linestring only"); st_polygon(x[1L])}, POLYGON = st_polygon(lapply(x, ClosePol)), LINESTRING = { if (length(x) > 1) warning("keeping first linestring only") st_linestring(x[[1L]]) }, ## loss, drop to first coordinate of first line POINT = { warning("keeping first coordinate only") st_point(x[[1L]][1L, , drop = TRUE]) }, GEOMETRYCOLLECTION = st_geometrycollection(list(x)) ) } #' @name st_cast #' @export #' @examples #' mpt <- st_cast(st_geometry(nc)[[4]], "MULTIPOINT") #' st_sfc(cast_all(mpt)) st_cast.MULTIPOINT <- function(x, to, ...) { switch(to, ## DANGER: polygon, linestring forms unlikely to be valid MULTIPOLYGON = st_multipolygon(list(list(ClosePol(unclass(x))))), MULTILINESTRING = st_multilinestring(list(unclass(x))), MULTIPOINT = x, POLYGON = st_polygon(list(unclass(ClosePol(x)))), LINESTRING = st_linestring(unclass(x)), ## loss, drop to first coordinate POINT = { if (st_is_empty(x)) { row <- NA_integer_ } else { warning("point from first coordinate only") row <- 1L } st_point(unclass(x)[row, , drop = TRUE]) }, GEOMETRYCOLLECTION = st_geometrycollection(list(x)) ) } #' @name st_cast #' @export #' @examples #' pl <- st_cast(st_geometry(nc)[[4]], "POLYGON") #' st_sfc(cast_all(pl)) st_cast.POLYGON <- function(x, to, ...) { switch(to, MULTIPOLYGON = { if (length(x)) x = list(lapply(Paste0(x), ClosePol)) st_multipolygon(x) }, MULTILINESTRING = st_multilinestring(unclass(x)), MULTIPOINT = st_multipoint(Tail1(unclass(x))[[1L]]), POLYGON = x, LINESTRING = st_linestring(unclass(x)[[1L]]), POINT = {warning("point from first coordinate only"); st_point(unclass(x)[[1L]][1L, , drop = TRUE])}, GEOMETRYCOLLECTION = st_geometrycollection(list(x)) ) } #' @name st_cast #' @export #' @examples #' ls <- st_cast(st_geometry(nc)[[4]], "LINESTRING") #' st_sfc(cast_all(ls)) st_cast.LINESTRING <- function(x, to, ...) { switch(to, MULTIPOLYGON = st_multipolygon(list(list(ClosePol(unclass(x))))), MULTILINESTRING = st_multilinestring(list(unclass(x))), MULTIPOINT = st_multipoint(unclass(x)), POLYGON = st_polygon(list(unclass(ClosePol(x)))), LINESTRING = x, POINT = {warning("point from first coordinate only"); st_point(unclass(x)[1L, , drop = TRUE])}, GEOMETRYCOLLECTION = st_geometrycollection(list(x)) ) } #' @name st_cast #' @export #' @examples #' pt <- st_cast(st_geometry(nc)[[4]], "POINT") #' ## st_sfc(cast_all(pt)) ## Error: cannot create MULTIPOLYGON from POINT #' st_sfc(lapply(c("POINT", "MULTIPOINT"), function(x) st_cast(pt, x))) st_cast.POINT <- function(x, to, ...) { switch(to, MULTIPOLYGON = stop("cannot create MULTIPOLYGON from POINT"), MULTILINESTRING = stop("cannot create MULTILINESTRING from POINT"), MULTIPOINT = st_multipoint(matrix(unclass(x), nrow = 1L)), POLYGON = stop("cannot create POLYGON from POINT"), LINESTRING = stop("cannot create LINESTRING from POINT"), POINT = x, GEOMETRYCOLLECTION = st_geometrycollection(list(x)) ) } #' @name st_cast #' @export st_cast.GEOMETRYCOLLECTION <- function(x, to, ...) { switch(to, GEOMETRYCOLLECTION = x, { if (length(x) > 1) warning("only first part of geometrycollection is retained") st_cast(x[[1]], to, ...) } ) } #' @name st_cast #' @export st_cast.CIRCULARSTRING <- function(x, to, ...) { if (to != "LINESTRING") stop("CIRCULARSTRING can only be converted into LINESTRING") CPL_circularstring_to_linestring(structure(list(x), crs = NA_crs_, precision = 0.0, class = c("sfc_CIRCULARSTRING", "sfc")))[[1]] } #' @name st_cast #' @export st_cast.MULTISURFACE <- function(x, to, ...) { if (! missing(to) && to != "MULTIPOLYGON") stop("MULTISURFACE can only be converted into MULTIPOLYGON") CPL_multisurface_to_multipolygon(structure(list(x), crs = NA_crs_, precision = 0.0, class = c("sfc_MULTISURFACE", "sfc")))[[1]] } #' @name st_cast #' @export st_cast.COMPOUNDCURVE <- function(x, to, ...) { if (! missing(to) && to != "LINESTRING") stop("to should be missing or LINESTRING") CPL_compoundcurve_to_linear(structure(list(x), crs = NA_crs_, precision = 0.0, class = c("sfc_COMPOUNDCURVE", "sfc")))[[1]] } #' @name st_cast #' @export st_cast.MULTICURVE <- function(x, to, ...) { if (! missing(to) && to != "MULTILINESTRING") stop("to should be missing or MULTILINESTRING") st_multilinestring(lapply(x, st_cast, to = "LINESTRING")) } #' @name st_cast #' @export st_cast.CURVE <- function(x, to, ...) { # nocov start if (! missing(to) && to != "LINESTRING") stop("CURVE can only be converted into LINESTRING") CPL_curve_to_linestring(structure(list(x), crs = NA_crs_, precision = 0.0, class = c("sfc_CURVE", "sfc")))[[1]] } # nocov end # st_cast.class <- function(x, to) { # switch(to, # MULTIPOLYGON = x, # MULTILINESTRING = x, # MULTIPOINT = x, # POLYGON = x, # LINESTRING = x, # POINT = x # ) # } ================================================ FILE: R/collection_extract.R ================================================ #' Given an object with geometries of type \code{GEOMETRY} or \code{GEOMETRYCOLLECTION}, #' return an object consisting only of elements of the specified type. #' #' Similar to ST_CollectionExtract in PostGIS. If there are no sub-geometries #' of the specified type, an empty geometry is returned. #' #' @param x an object of class \code{sf}, \code{sfc} or \code{sfg} that has #' mixed geometry (\code{GEOMETRY} or \code{GEOMETRYCOLLECTION}). #' @param type character; one of "POLYGON", "POINT", "LINESTRING" #' @param warn logical; if \code{TRUE}, warn if attributes are assigned to #' sub-geometries when casting (see \code{\link{st_cast}}) #' #' @return An object having the same class as \code{x}, with geometries #' consisting only of elements of the specified type. #' For \code{sfg} objects, an \code{sfg} object is returned if there is only #' one geometry of the specified type, otherwise the geometries are combined #' into an \code{sfc} object of the relevant type. If any subgeometries in the #' input are MULTI, then all of the subgeometries in the output will be MULTI. #' #' @export #' #' @examples #' pt <- st_point(c(1, 0)) #' ls <- st_linestring(matrix(c(4, 3, 0, 0), ncol = 2)) #' poly1 <- st_polygon(list(matrix(c(5.5, 7, 7, 6, 5.5, 0, 0, -0.5, -0.5, 0), ncol = 2))) #' poly2 <- st_polygon(list(matrix(c(6.6, 8, 8, 7, 6.6, 1, 1, 1.5, 1.5, 1), ncol = 2))) #' multipoly <- st_multipolygon(list(poly1, poly2)) #' #' i <- st_geometrycollection(list(pt, ls, poly1, poly2)) #' j <- st_geometrycollection(list(pt, ls, poly1, poly2, multipoly)) #' #' st_collection_extract(i, "POLYGON") #' st_collection_extract(i, "POINT") #' st_collection_extract(i, "LINESTRING") #' #' ## A GEOMETRYCOLLECTION #' aa <- rbind(st_sf(a=1, geom = st_sfc(i)), #' st_sf(a=2, geom = st_sfc(j))) #' #' ## With sf objects #' st_collection_extract(aa, "POLYGON") #' st_collection_extract(aa, "LINESTRING") #' st_collection_extract(aa, "POINT") #' #' ## With sfc objects #' st_collection_extract(st_geometry(aa), "POLYGON") #' st_collection_extract(st_geometry(aa), "LINESTRING") #' st_collection_extract(st_geometry(aa), "POINT") #' #' ## A GEOMETRY of single types #' bb <- rbind( #' st_sf(a = 1, geom = st_sfc(pt)), #' st_sf(a = 2, geom = st_sfc(ls)), #' st_sf(a = 3, geom = st_sfc(poly1)), #' st_sf(a = 4, geom = st_sfc(multipoly)) #' ) #' #' st_collection_extract(bb, "POLYGON") #' #' ## A GEOMETRY of mixed single types and GEOMETRYCOLLECTIONS #' cc <- rbind(aa, bb) #' #' st_collection_extract(cc, "POLYGON") #' st_collection_extract = function(x, type = c("POLYGON", "POINT", "LINESTRING"), warn = FALSE) { UseMethod("st_collection_extract") } #' @name st_collection_extract #' #' @export st_collection_extract.sfg = function(x, type = c("POLYGON", "POINT", "LINESTRING"), warn = FALSE) { type = match.arg(type) types = c(type, paste0("MULTI", type)) if (inherits(x, types)) { warning("x is already of type ", type, ".") return(x) } if (!inherits(x, "GEOMETRYCOLLECTION")) { stop("x is of singular geometry type that is different to supplied type: ", type) # nocov } # Find the geometries of the specified type and extract into a list matches = vapply(x, st_is, types, FUN.VALUE = logical(1)) x_types = x[which(matches)] if (length(x_types) == 0L) { ## return an empty sfg of the specified type warning("x contains no geometries of specified type") return(typed_empty(paste0("sfc_", type))) } else if (length(x_types) == 1L) { # Get the contents of the first (only) list element which is an sfg return(x_types[[1]]) } else { # turn list into an sfc, and cast it to single type. Will be multi # if any are multi return(st_cast(st_sfc(x_types), warn = warn)) } } #' @name st_collection_extract #' #' @export st_collection_extract.sfc = function(x, type = c("POLYGON", "POINT", "LINESTRING"), warn = FALSE) { type = match.arg(type) types = c(type, paste0("MULTI", type)) if (length(x) == 0) return(x) # Check it's not already what user is asking for if (inherits(st_geometry(x), paste0("sfc_", types))) { warning("x is already of type ", type, ".") # nocov return(x) # nocov } if (!inherits(st_geometry(x), c("sfc_GEOMETRY", "sfc_GEOMETRYCOLLECTION"))) { stop("x is of singular geometry type that is different to supplied type: ", type) } # Cast to GEOMETRYCOLLECTION if is GEOMETRY) if (inherits(st_geometry(x), "sfc_GEOMETRY")) { x = st_cast(x, "GEOMETRYCOLLECTION") } ## Cast GEOMETRYCOLLECTION into all components gc_casted = st_cast(x, warn = warn) ## Keep only components that match input type if (inherits(gc_casted, "sf")) { gc_types = gc_casted[st_is(gc_casted, types), ] } else { gc_types = gc_casted[st_is(gc_casted, types)] } ## Cast to specified (MULTI) type if (length(st_geometry(gc_types)) == 0L) { warning("x contains no geometries of specified type") return(gc_types) } st_cast(gc_types, warn = warn) } #' @name st_collection_extract #' #' @export st_collection_extract.sf = st_collection_extract.sfc ================================================ FILE: R/crop.R ================================================ #' crop an sf object to a specific rectangle #' @param x object of class \code{sf} or \code{sfc} #' @param y numeric vector with named elements \code{xmin}, \code{ymin}, \code{xmax} and \code{ymax}, or object of class \code{bbox}, or object for which there is an \link{st_bbox} method to convert it to a \code{bbox} object #' @param ... ignored #' @details #' setting arguments \code{xmin}, \code{ymin}, \code{xmax} and \code{ymax} implies that argument \code{y} gets ignored. #' @export #' @examples #' box = c(xmin = 0, ymin = 0, xmax = 1, ymax = 1) #' pol = st_sfc(st_buffer(st_point(c(.5, .5)), .6)) #' pol_sf = st_sf(a=1, geom=pol) #' plot(st_crop(pol, box)) #' plot(st_crop(pol_sf, st_bbox(box))) #' # alternative: #' plot(st_crop(pol, xmin = 0, ymin = 0, xmax = 1, ymax = 1)) #' @export st_crop = function(x, y, ...) UseMethod("st_crop") #' @export #' @name st_crop #' @param xmin minimum x extent of cropping area #' @param ymin minimum y extent of cropping area #' @param xmax maximum x extent of cropping area #' @param ymax maximum y extent of cropping area st_crop.sfc = function(x, y, ..., xmin, ymin, xmax, ymax) { if (!missing(xmin) && !missing(ymin) && !missing(xmax) && !missing(ymax)) y = c(xmin = xmin, ymin = ymin, xmax = xmax, ymax = ymax) if (! inherits(y, "bbox")) y = st_bbox(y) if (is.na(st_crs(y))) y = structure(y, crs = st_crs(x)) st_intersection(x, st_as_sfc(y)) } #' @export #' @name st_crop st_crop.sf = function(x, y, ...) { st_crop.sfc(x, y, ...) } ================================================ FILE: R/crs.R ================================================ # alternative, but more limiting from sp/R/CRS-methods.R, https://github.com/edzer/sp/pull/31 @hughjonesd # (no longer used) #identicalCRS1 = function(x, y) { # args_x <- strsplit(x, " +")[[1]] # args_y <- strsplit(y, " +")[[1]] # setequal(args_x, args_y) #} # this function establishes whether two crs objects are semantically identical. This is # the case when: (1) they are completely identical (including NA), or (2) GDAL considers # them equivalent #' @export Ops.crs <- function(e1, e2) { if (nargs() == 1) stop(paste("unary", .Generic, "not defined for \"crs\" objects"), call. = FALSE) cmp <- switch(.Generic, "==" =, "!=" = TRUE, FALSE) if (!cmp) stop(paste("operation", .Generic, "not supported for crs objects"), call. = FALSE) if (.Generic == "!=") !(e1 == e2) else { # "==": check semantic equality if (isTRUE(all.equal(e1, e2))) # includes both are NA_crs_ TRUE else if (is.na(e1) || is.na(e2)) # only one of them is NA_crs_ FALSE else isTRUE(try(CPL_crs_equivalent(e1, e2), silent = TRUE)) # use GDAL's srs1->IsSame(srs2) } } #' Retrieve coordinate reference system from object #' #' Retrieve coordinate reference system from sf or sfc object #' @name st_crs #' @param x numeric, character, or object of class \link{sf} or \link{sfc} #' @param ... ignored #' @export #' @return If \code{x} is numeric, return \code{crs} object for EPSG:\code{x}; #' if \code{x} is character, return \code{crs} object for \code{x}; #' if \code{x} is of class \code{sf} or \code{sfc}, return its \code{crs} object. #' @details The *crs functions create, get, set or replace the \code{crs} attribute #' of a simple feature geometry list-column. This attribute is of class \code{crs}, #' and is a list consisting of \code{input} (user input, e.g. "EPSG:4326" or "WGS84" #' or a proj4string), and \code{wkt}, an automatically generated wkt2 representation of the crs. #' If \code{x} is identical to the wkt2 representation, and the CRS has a name, this name #' is used for the \code{input} field. #' #' Comparison of two objects of class \code{crs} uses the GDAL function #' \code{OGRSpatialReference::IsSame}. #' @return Object of class \code{crs}, which is a list with elements \code{input} (length-1 character) #' and \code{wkt} (length-1 character). #' Elements may be \code{NA} valued; if all elements are \code{NA} the CRS is missing valued, and coordinates are #' assumed to relate to an arbitrary Cartesian coordinate system. st_crs = function(x, ...) UseMethod("st_crs") #' @name st_crs #' @export st_crs.sf = function(x, ...) st_crs(st_geometry(x), ...) #' @name st_crs #' @export st_crs.numeric = function(x, ...) { if (!is.finite(x)) NA_crs_ else make_crs(paste0("EPSG:", x)) } #' @name st_crs #' @export st_crs.character = function(x, ...) { if (is.na(x)) NA_crs_ else { crs = make_crs(x) if (is.na(crs)) stop(paste("invalid crs:", x)) # if we input wkt2, and CRS has a name, use it: if (identical(x, crs$wkt) && !identical(crs$Name, "unknown")) crs$input = crs$Name crs } } fix_crs = function(x) { if (all(c("epsg", "proj4string") %in% names(x))) { message("old-style crs object detected; please recreate object with a recent sf::st_crs()") x = unclass(x) if (!is.na(x$epsg)) st_crs(x$epsg) else st_crs(x$proj4string) } else x } #' @name st_crs #' @param parameters logical; \code{FALSE} by default; only for the `st_crs.sfc()` method: if \code{TRUE} return a classed list of coordinate reference system parameters, with named elements \code{SemiMajor}, \code{InvFlattening}, \code{units_gdal}, \code{IsVertical}, \code{WktPretty}, \code{Wkt}, \code{Name}, \code{proj4string}, \code{epsg}, \code{yx}, \code{ProjJson}, \code{WKT1_ESRI}, \code{srid} (in authority:code form), \code{axes} (a data.frame with columns \code{name} and \code{orientation}), \code{gcs_crs} with the WKT of the base geographic coordinate system, \code{ud_unit}. The list has class \code{crs_parameters}. #' @export st_crs.sfc = function(x, ..., parameters = FALSE) { crs = fix_crs(attr(x, "crs")) if (isTRUE(parameters)) { p = crs_parameters(crs) p$ud_unit = crs_ud_unit(crs) p } else crs } #' @name st_crs #' @export st_crs.bbox = function(x, ...) { crs = attr(x, "crs") if (is.null(crs)) NA_crs_ else crs } #' @name st_crs #' @export st_crs.CRS = function(x, ...) { if (is.null(comment(x)) || CPL_proj_version() < "6.0.0" || CPL_gdal_version() < "3.0.0") st_crs(x@projargs) else { ret = st_crs(comment(x)) name = ret$Name ret$input = if (name == "unknown") x@projargs else name ret } } #' @name st_crs #' @export st_crs.crs = function(x, ...) x #' @export st_crs.default = function(x, ...) NA_crs_ #' Set or replace coordinate reference system from object #' #' Set or replace retrieve coordinate reference system from object #' @name st_crs #' @param value one of (i) character: a string accepted by GDAL, (ii) integer, a valid EPSG value (numeric), or (iii) an object of class \code{crs}. #' @details In case a coordinate reference system is replaced, no transformation takes #' place and a warning is raised to stress this. #' #' @export `st_crs<-` = function(x, value) UseMethod("st_crs<-") #' @name st_crs #' @examples #' sfc = st_sfc(st_point(c(0,0)), st_point(c(1,1))) #' sf = st_sf(a = 1:2, geom = sfc) #' st_crs(sf) = 4326 #' st_geometry(sf) #' @export `st_crs<-.sf` = function(x, value) { st_crs(x[[ attr(x, "sf_column") ]]) = value x } # return crs object from crs, integer, or character string make_crs = function(x) { if (inherits(x, "CRS")) { x = if (is.null(comment(x)) || (CPL_proj_version() < "6.0.0" || CPL_gdal_version() < "3.0.0")) x@projargs else comment(x) # WKT2 } if (is.numeric(x) && !is.na(x)) x = paste0("EPSG:", x) # return: if (is.na(x)) NA_crs_ else if (inherits(x, "crs")) x else if (is.character(x)) { if (grepl("+init=epsg:", x) && compareVersion(sf_extSoftVersion()[["proj.4"]], "6.0.0") >= 0 && compareVersion(sf_extSoftVersion()[["proj.4"]], "6.3.1") < 0) { # nocov start FIXME: x = strsplit(x, " ")[[1]] if (length(x) > 1) warning(paste("the following proj4string elements are ignored:", paste(x[-1], collapse = " "), "; remove the +init=epsg:XXXX to undo this")) x = paste0("EPSG:", as.integer(substr(x[1], 12, 20))) # nocov end } CPL_crs_from_input(x) } else stop(paste("cannot create a crs from an object of class", class(x)), call. = FALSE) } #' @name st_crs #' @examples #' sfc = st_sfc(st_point(c(0,0)), st_point(c(1,1))) #' st_crs(sfc) = 4326 #' sfc #' @export `st_crs<-.sfc` = function(x, value) { if (is.null(attr(x, "crs"))) start_crs = NA_crs_ else start_crs = st_crs(x) end_crs = make_crs(value) if (!is.na(start_crs) && !is.na(end_crs) && start_crs != end_crs) warning("st_crs<- : replacing crs does not reproject data; use st_transform for that", call. = FALSE) if (is.na(end_crs) && !is.na(start_crs) && isTRUE(st_is_longlat(start_crs)) && any(st_is_full(x))) stop("To set the crs to NA, first remove the full polygons; see: st_is_full()") structure(x, crs = end_crs) } #' @export `st_crs<-.bbox` = function(x, value) { structure(x, crs = make_crs(value)) } #' @name st_crs #' @examples #' sfc = st_sfc(st_point(c(0,0)), st_point(c(1,1))) #' sfc |> st_set_crs(4326) |> st_transform(3857) #' @export st_set_crs = function(x, value) { st_crs(x) = value x } #' Assert whether simple feature coordinates are longlat degrees #' #' Assert whether simple feature coordinates are longlat degrees #' @param x object of class \link{sf} or \link{sfc}, or otherwise an object of a class that has an \link{st_crs} method returning a \code{crs} object #' @return `TRUE` if `x` has geographic coordinates, `FALSE` if it has projected coordinates, or `NA` if \code{is.na(st_crs(x))}. #' @export st_is_longlat = function(x) { crs = st_crs(x) if (is.na(crs)) NA else { ret = crs_parameters(crs)$IsGeographic if (ret && inherits(x, c("sf", "sfc", "stars")) && !is.null(attr(x, "bbox"))) { bb = st_bbox(x) # check for potentially meaningless value range: eps = sqrt(.Machine$double.eps) if (all(!is.na(unclass(bb))) && (bb["xmin"] < (-180-eps) || bb["xmax"] > (360+eps) || bb["ymin"] < (-90-eps) || bb["ymax"] > (90+eps))) warning("bounding box has potentially an invalid value range for longlat data") } ret } } # a = "b" => a is the proj.4 unit (try: cs2cs -lu); "b" is the udunits2 unit udunits_from_proj = list( # PROJ.4 UDUNITS `km` = as_units("km"), `m` = as_units("m"), `dm` = as_units("dm"), `cm` = as_units("cm"), `mm` = as_units("mm"), `kmi` = as_units("nautical_mile"), `in` = as_units("in"), `ft` = as_units("ft"), `yd` = as_units("yd"), `mi` = as_units("mi"), `fath` = as_units("fathom"), `ch` = as_units("chain"), `link` = as_units("link", check_is_valid = FALSE), # not (yet) existing; set in .onLoad() `us-in` = as_units("us_in", check_is_valid = FALSE), `us-ft` = as_units("US_survey_foot"), `us-yd` = as_units("US_survey_yard"), `us-ch` = as_units("chain"), `us-mi` = as_units("US_survey_mile"), `ind-yd` = as_units("ind_yd", check_is_valid = FALSE), `ind-ft` = as_units("ind_ft", check_is_valid = FALSE), `ind-ch` = as_units("ind_ch", check_is_valid = FALSE), `kilometre` = as_units("km"), `metre` = as_units("m"), `decimetre` = as_units("dm"), `centimetre` = as_units("cm"), `millimetre` = as_units("mm"), `nautical mile` = as_units("nautical_mile"), `Statute mile` = as_units("mi"), `US survey inch` = as_units("us_in", check_is_valid = FALSE), `US survey foot` = as_units("US_survey_foot"), `US survey yard` = as_units("US_survey_yard"), `US survey chain` = as_units("chain"), `US survey mile` = as_units("US_survey_mile"), `Indian yard (1937)` = as_units("ind_yd", check_is_valid = FALSE), `Indian foot (1937)` = as_units("ind_ft", check_is_valid = FALSE), `Indian chain` = as_units("ind_ch", check_is_valid = FALSE) ) crs_ud_unit = function(x) { stopifnot(inherits(x, "crs")) if (is.na(x)) return(NULL) x = crs_parameters(x) if (!is.null(x$units_gdal)) { u = udunits_from_proj[[x$units_gdal]] if (is.null(u)) { u = try(as_units(x$units_gdal), silent = TRUE) if (inherits(u, "try-error")) u = NULL } u } else NULL #2049 } crs_parameters = function(x) { stopifnot(inherits(x, "crs")) if (is.na(x)) list() else { ret = CPL_crs_parameters(x) units(ret$SemiMajor) = as_units("m") units(ret$SemiMinor) = as_units("m") ret } } epsg = function(x) { if (is.na(x)) NA_integer_ else if (grepl("^EPSG:", x[["input"]])) # else if (startsWith(x[["input"]], "EPSG:")) as.integer(gsub("^EPSG:(\\d+)\\b.*$", "\\1", x[["input"]])) else crs_parameters(x)[["epsg"]] } proj4string = function(x) { if (is.na(x)) NA_character_ else crs_parameters(x)[["proj4string"]] } #' @name st_as_text #' @param projjson logical; if TRUE, return projjson form (requires GDAL 3.1 and PROJ 6.2), else return well-known-text form #' @param pretty logical; if TRUE, print human-readable well-known-text representation of a coordinate reference system #' @export st_as_text.crs = function(x, ..., projjson = FALSE, pretty = FALSE) { if (is.na(x)) NA_character_ else if (projjson) { if (compareVersion(sf_extSoftVersion()["GDAL"], "3.1.0") == -1 || compareVersion(sf_extSoftVersion()["proj.4"], "6.2.0") == -1) stop("ProjJson requires GDAL >= 3.1.0 and PROJ >= 6.2.0") crs_parameters(x)$ProjJson } else { # wkt: if (pretty) crs_parameters(x)$WktPretty else crs_parameters(x)$Wkt } } #' @name st_crs #' @details #' \code{NA_crs_} is the \code{crs} object with missing values for \code{input} and \code{wkt}. #' @export NA_crs_ = structure( list(input = NA_character_, wkt = NA_character_), class = "crs") #' @name st_crs #' @export #' @method is.na crs is.na.crs = function(x) { identical(x, NA_crs_) } #' @name st_crs #' @param name element name #' @export #' @examples #' st_crs("EPSG:3857")$input #' st_crs(3857)$proj4string #' @details the `$` method for `crs` objects retrieves named elements #' using the GDAL interface; named elements include #' `SemiMajor`, `SemiMinor`, `InvFlattening`, `IsGeographic`, #' `units_gdal`, `IsVertical`, `WktPretty`, `Wkt`, #' `Name`, `proj4string`, `epsg`, `yx`, #' `ud_unit`, and `axes` (this may be subject to changes in future GDAL versions). #' #' Note that not all valid CRS have a corresponding `proj4string`. #' #' `ud_unit` returns a valid \link[units]{units} object or `NULL` if units are missing. #' @export `$.crs` = function(x, name) { if (!is.null(x[["proj4string"]])) { # old-style object: warning("CRS uses proj4string, which is deprecated.") x = st_crs(x[["proj4string"]]) # FIXME: should this be only for some transition period? Add test? } if (name == "ud_unit") crs_ud_unit(x) else if (is.na(x)) NA_character_ else if (is.numeric(name) || name %in% names(x)) x[[name]] else { p = crs_parameters(x) if (name %in% names(p)) p[[name]] else { tryNum = function(x) { n = suppressWarnings(as.numeric(x)); if (is.na(n)) x else n } p4s = strsplit(p$proj4string, " ")[[1]] p4s2 = strsplit(p4s, "=") vals = lapply(p4s2, function(x) if (length(x) == 1) TRUE else tryNum(x[2])) names(vals) = substring(sapply(p4s2, function(x) x[1]), 2) vals[[name]] } } } #' @export print.crs = function(x, ...) { cat("Coordinate Reference System:") if (is.na(x)) { cat(" NA\n") } else { cat("\n") if (is.na(x$input)) cat(" No user input\n") else cat(" User input:", x$input, "\n") # print wkt: if (!is.na(x$wkt)) cat(" wkt:\n", x$wkt, "\n", sep = "") } } #' @name st_crs #' @export #' @details format.crs returns NA if the crs is missing valued, or else #' the name of a crs if it is different from "unknown", or #' else the user input if it was set, or else its "proj4string" representation; format.crs = function(x, ...) { if (is.na(x)) NA_character_ else { p = crs_parameters(x) if (p$Name == "unknown") { if (x$input == "unknown") x$proj4string else x$input } else x$Name } } #' @export st_crs.Raster = function(x, ...) { crsobj <- raster::crs(x) st_crs(crsobj) # nocov } #' @export st_crs.Spatial = function(x, ...) { if (! requireNamespace("sp", quietly = TRUE)) stop("package sp required, please install it first") st_crs(x@proj4string) # nocov } #' @name st_crs #' @param authority_compliant logical; specify whether axis order should be #' handled compliant to the authority; if omitted, the current value is printed. #' @details #' \code{st_axis_order} can be used to get and set the axis order: \code{TRUE} #' indicates axes order according to the authority #' (e.g. EPSG:4326 defining coordinates to be latitude,longitude pairs), \code{FALSE} #' indicates the usual GIS (display) order (longitude,latitude). This can be useful #' when data are read, or have to be written, with coordinates in authority compliant order. #' The return value is the current state of this (\code{FALSE}, by default). #' @return \code{st_axis_order} returns the (logical) current value if called without #' argument, or (invisibly) the previous value if it is being set. #' @export #' @examples #' pt = st_sfc(st_point(c(0, 60)), crs = 4326) #' # st_axis_order() only has effect in GDAL >= 2.5.0: #' st_axis_order() # query default: FALSE means interpret pt as (longitude latitude) #' st_transform(pt, 3857)[[1]] #' old_value = FALSE #' if (compareVersion(sf_extSoftVersion()["GDAL"], "2.5.0") >= 0) #' (old_value = st_axis_order(TRUE)) #' # now interpret pt as (latitude longitude), as EPSG:4326 prescribes: #' st_axis_order() # query current value #' st_transform(pt, 3857)[[1]] #' st_axis_order(old_value) # set back to old value st_axis_order = function(authority_compliant = logical(0)) { ret = CPL_axis_order_authority_compliant(authority_compliant) if (length(authority_compliant)) invisible(ret) else ret } ================================================ FILE: R/datasets.R ================================================ #' North Carolina SIDS data #' #' Sudden Infant Death Syndrome (SIDS) sample data for North Carolina counties, #' two time periods (1974-78 and 1979-84). The details of the columns can be #' found in a [spdep package vignette](https://r-spatial.github.io/spdep/articles/sids.html). #' Please note that, though this is basically the same as \code{nc.sids} dataset in spData #' package, \code{nc} only contains a subset of variables. The differences are #' also discussed on the vignette. #' @format A `sf` object #' @name nc #' @docType data #' @seealso \url{https://r-spatial.github.io/spdep/articles/sids.html} #' @examples #' \donttest{ #' nc <- st_read(system.file("shape/nc.shp", package="sf")) #' } NULL ================================================ FILE: R/db.R ================================================ #' Read PostGIS table directly, using DBI and binary conversion #' #' Read PostGIS table directly through DBI and RPostgreSQL interface, converting #' Well-Know Binary geometries to sfc #' @param query SQL query to select records; see details #' @param EWKB logical; is the WKB of type EWKB? if missing, defaults to #' \code{TRUE} #' @param as_tibble logical; should the returned table be of class tibble or data.frame? #' @details if \code{table} is not given but \code{query} is, the spatial #' reference system (crs) of the table queried is only available in case it #' has been stored into each geometry record (e.g., by PostGIS, when using #' EWKB) #' @examples #' \dontrun{ #' library(RPostgreSQL) #' try(conn <- dbConnect(PostgreSQL(), dbname = "postgis")) #' if (exists("conn") && !inherits(conn, "try-error")) { #' x = st_read(conn, "meuse", query = "select * from meuse limit 3;") #' x = st_read(conn, table = "public.meuse") #' print(st_crs(x)) # SRID resolved by the database, not by GDAL! #' dbDisconnect(conn) #' } #' } #' @name st_read #' @details The function will automatically find the `geometry` type columns for #' drivers that support it. For the other drivers, it will try to cast all the #' character columns, which can be slow for very wide tables. #' @export st_read.DBIObject = function(dsn = NULL, layer = NULL, query = NULL, EWKB = TRUE, quiet = TRUE, as_tibble = FALSE, geometry_column = NULL, ...) { if (is.null(dsn)) stop("no connection provided") # nocov if (as_tibble && !requireNamespace("tibble", quietly = TRUE)) { stop("package tibble not available: install first?") # nocov } # check that ellipsis contains only what is needed expe <- setdiff(names(list(...)), names(formals(st_sf))) if(length(expe) > 0) { # error, these arguments would be passed to st_sf suggest <- NULL if("table" %in% expe){ suggest <- c(suggest, "\nMaybe you should use `layer` rather than `table` ?") } pref <- if(length(expe) > 1) "\t *" else "" stop( "Unused arguments: ", if(length(expe) > 1) "\n" else "", paste(pref, expe, "=", list(...)[expe], collapse = "\n", sep = " "), suggest, "\nCheck arguments for `st_sf()` for details.", call. = FALSE ) } # filter expected warnings (for RPostgreSQL driver) filter_warning <- function(expr, regexp) { wlist <- NULL warning_handler <- function(w) { wlist <<- c(wlist, list(w)) invokeRestart("muffleWarning") } msg <- function(x) x$message out <- withCallingHandlers(expr, warning = warning_handler) if(!all(grepl(regexp, wlist))) { lapply(vapply(wlist, msg, character(1)), warning, call. = FALSE) # nocov } return(out) } # Check layer and query conflict if (!is.null(layer)) { if (!is.null(query)) { warning("You provided both `layer` and `query` arguments,", " will only use `layer`.", call. = FALSE) } # capture warnings from RPostgreSQL package if (inherits(dsn, "PostgreSQLConnection")) { tbl <- filter_warning(dbReadTable(dsn, layer), "unrecognized PostgreSQL field type geometry") } else { tbl <- dbReadTable(dsn, layer) } } else if(is.null(query)) { stop("Provide either a `layer` or a `query`", call. = FALSE) } else { # capture warnings from RPostgreSQL package if (inherits(dsn, "PostgreSQLConnection")) { filter_warning(tbl <- dbGetQuery(dsn, query), "unrecognized PostgreSQL field type geometry") } else { tbl <- dbGetQuery(dsn, query) } } if (is.null(tbl)) { stop("Query `", query, "` returned no results.", call. = FALSE) #nocov } if (is.null(geometry_column)) { # scan table for simple features column geometry_column = is_geometry_column(dsn, tbl) tbl[geometry_column] <- lapply(tbl[geometry_column], try_postgis_as_sfc, EWKB = EWKB, conn = dsn) } else { if (!all(geometry_column %in% names(tbl))) { # prepare error message nm <- names(tbl) prefix <- "" new_line <- "" if(length(nm) > 1) { prefix <- " *" new_line <- "\n" } stop("Could not find `geometry_column` (\"", paste(geometry_column, collapse = "\", \""), "\") ", "in column names. Available names are:", new_line, paste(prefix, nm, collapse = "\n", sep = " "), call. = FALSE) } tbl[geometry_column] <- lapply(tbl[geometry_column], postgis_as_sfc, EWKB = EWKB, conn = dsn) } # if there are no simple features geometries, return a data frame if (! any(vapply(tbl, inherits, logical(1), "sfc"))) { # try reading blob columns: blob_columns = vapply(tbl, inherits, logical(1), "blob") success = FALSE for (i in which(blob_columns)) { try(sfc <- st_as_sfc(tbl[[i]]), silent = TRUE) if (!inherits(sfc, "try-error")) { tbl[[i]] = sfc success = TRUE } } if (! success) { warning("Could not find a simple features geometry column. Will return a `data.frame`.") return(tbl) } } x <- st_sf(tbl, ...) if (!quiet) print(x, n = 0) # nocov if (as_tibble) { x <- tibble::new_tibble(x, nrow = nrow(x), class = "sf") } return(x) } #' @export st_read.Pool = function(dsn = NULL, layer = NULL, ...) { if (! requireNamespace("pool", quietly = TRUE)) # nocov start stop("package pool required, please install it first") dsn = pool::poolCheckout(dsn) on.exit(pool::poolReturn(dsn)) st_read(dsn, layer = layer, ...) # nocov end } #' @export st_read.PostgreSQLConnection <- function(...) { st_read.DBIObject(...) } postgis_as_sfc <- function(x, EWKB, conn) { geom <- st_as_sfc(as_wkb_(x), EWKB = EWKB) srid <- attr(geom, "srid") if (!is.null(srid)) { st_crs(geom) = db_find_srid(conn, srid = srid, validate = FALSE) attr(geom, "srid") = NULL warning("Could not find database srid (", srid, ") locally; using the remote database definition.") } return(geom) } try_postgis_as_sfc <- function(x, EWKB, conn) { tryCatch(postgis_as_sfc(x, EWKB, conn), error = function(...) return(x)) } schema_table <- function(conn, table, public = "public") { if (!is.character(table)) stop("table must be a character vector", call. = FALSE) if (length(table) == 1L) table = c(public, table) else if (length(table) > 2) stop("table cannot be longer than 2 (schema, table)", call. = FALSE) if (anyNA(table)) stop("table and schema cannot be NA", call. = FALSE) return(table) } as_wkb_ <- function(x) { structure(x, class = "WKB") } get_possibly_new_srid <- function(conn, crs) { db_crs <- db_find_srid(conn, crs) if(!is.na(db_crs)) { return(db_crs) } db_crs <- db_find_srtext(conn, crs) if (!is.na(db_crs)) { return(db_crs) } db_insert_crs(conn, crs) } # Find srid in a database by using the srid # @param conn Dababase connection (e.g. `DBI`) # @param srid An integer descriing the srid to fetch # @param validate if TRUE, then the crs_local is used to validate the remote crs. # Use validate = FALSE when searching for an srid unavailable locally, or when # the wkt is unknown locally. # @returns a `crs` db_find_srid = function(conn, crs_local = st_crs(srid), srid = epsg(crs_local), validate = TRUE) { if (validate && is.na(crs_local)) return(st_crs(NA)) if (is.na(srid)) { return(st_crs(NA)) } query <- paste0("select srtext from spatial_ref_sys where srid = ", srid) db_crs <- dbGetQuery(conn, query) if (nrow(db_crs) < 1) { return(st_crs(NA)) } if (nrow(db_crs) > 1) { # TODO: pretty print db_spatial_ref stop("SRID should be unique, but the database returned ", nrow(db_crs), " matching crs. \n", db_crs, call. = FALSE) # nocov } crs_found <- st_crs(db_crs[["srtext"]]) crs_found[["input"]] <- build_epsg(srid) if(validate && crs_found != crs_local && !is.na(crs_local)) { # TODO: pretty print db_spatial_ref warning("Local crs different from database crs. You can inspect the ", "database crs using `dbReadtable(conn, \"spatial_ref_sys\")` ", "and compare it to `st_crs(", srid,")`.") # nocov } crs_found } # Find database projection using srtext (wkt) db_find_srtext = function(conn, crs_local = st_crs(wkt), wkt = st_as_text(crs_local)) { if (is.na(crs_local)) return(st_crs(NA)) if (is.na(wkt)) { return(st_crs(NA)) } query <- paste0("select * from spatial_ref_sys where srtext = '", wkt, "'") db_spatial_ref <- DBI::dbGetQuery(conn, query) if (nrow(db_spatial_ref) < 1) { # need to relax comparison # read table, and find equivalent projections using == query <- "select * from spatial_ref_sys where srtext is not null and srtext != ''" db_spatial_ref <- DBI::dbGetQuery(conn, query) db_crs <- lapply(db_spatial_ref[["srtext"]], function(string) try(st_crs(string))) reject <- vapply(db_crs, function(x) inherits(x, "try-error"), logical(1)) eq <- vapply(db_crs[!reject], function(x) crs_local == x, logical(1)) db_spatial_ref <- db_spatial_ref[eq, ] } if (nrow(db_spatial_ref) > 1) { # nocov start # Use the first match, but warn the user. # Only show first 10 matches db_spatial_ref <- db_spatial_ref[seq_len(min(nrow(db_spatial_ref), 10)), ] # TODO: make it a warning -- check classes so they can be grabbed in dbWriteTable.DBI message("Found multiple matching projections, will use srid = ", db_spatial_ref[["srid"]][[1]], ".\nOther database srid matching the projection WKT description: ", paste(db_spatial_ref[["srid"]][-1], collapse = ", "), "\n", "You can suppress this warning by setting the projection to `st_crs(", db_spatial_ref[["srid"]][[1]], ")`.") db_spatial_ref <- db_spatial_ref[1, ] } # nocov end if (nrow(db_spatial_ref) < 1) { return(st_crs(NA)) } else { crs_found <- make_empty_crs(db_spatial_ref[["srid"]], db_spatial_ref[["srtext"]]) } if(crs_found != crs_local) { # nocov start warning("Local crs different from database crs. You can inspect the ", "database crs using `dbReadtable(conn, \"spatial_ref_sys\")` ", "and compare it to `st_crs(\"", wkt,"\")`.") } # nocov end crs_found } make_empty_crs <- function(epsg = NA, text = NA, wkt = NA) { if(!is.na(epsg)) { epsg <- build_epsg(epsg)[1] } if(is.na(wkt)) { wkt = st_as_text(st_crs(text)) } structure( list( input = epsg, wkt = wkt), class = "crs") } build_epsg <- function(auth_srid, auth_name = "EPSG") { paste0(auth_name, ":", auth_srid) } db_insert_crs <- function(conn, crs, srid = epsg(crs), auth_name = "sf", auth_srid = srid, wkt = st_as_text(crs), proj4text = proj4string(crs), update = FALSE, verbose = TRUE) { # fail fast ---------------------------------------------- # We also try to provide all error messages at once error_msg <- NULL if (update) { if (is.na(srid)) { error_msg <- c(error_msg, paste0( "You need to provide an `srid` to update a projection, but the `srid` is NA.", "\n Either: \n * provide an `srid` or \n * use `update = FALSE` to receive an srid", collapse = "" )) } } if (is.na(wkt)) { error_msg <- c(error_msg, "You need to provide a `wkt` to update the database `spatial_ref_sys`.") } if (!is.null(error_msg)) { n_errors <- length(error_msg) if (n_errors > 1) { error_msg <- c(paste0("We found ", n_errors, " errors:\n"), error_msg) } stop(paste(error_msg, collapse = "\n"), call. = FALSE) } # end tests --------------------------------------- if (is.na(srid)) { srid <- get_new_postgis_srid(conn) } if (is.na(auth_srid)) { auth_srid <- auth_srid } crs <- make_empty_crs(epsg = srid, text = wkt) q <- function(x) paste0("'", x, "'") if (update) { query <- paste("UPDATE spatial_ref_sys SET", "auth_name =", q(auth_name), ", ", "auth_srid =", auth_srid, ", ", "srtext =", q(wkt), ", ", "proj4text =", q(proj4string(crs)), "WHERE srid =", srid, ";") } else { query <- paste("INSERT INTO spatial_ref_sys (srid, auth_name, auth_srid, srtext, proj4text)", "VALUES (", paste( srid, q(auth_name), auth_srid, q(wkt), q(proj4string(crs)), sep = ", "), ");") } tryCatch(dbExecute(conn, query), error = function(err) { if(grepl("permission denied", err)) { # nocov start stop("Write permission denied on table `spatial_ref_sys` because:", "\n * Local crs is not in the database; ", "\n * Write permission on table `spatial_ref_sys` is denied.", "\nEither: ", "\n * Change the crs locally using `st_transform()` on your `sf` object;", "\n * Set the crs to NA using `st_set_crs({your_sf}, NA)`.", "\n * Grant write access on `spatial_sys_ref`.", "\n * Ask the database administrator to add your projection with :", "\n ``` sql\n", query, "\n ```", call. = FALSE) } stop(err) # nocov end }) if (verbose) { message("Inserted local crs: `", wkt, "` in database as srid:", srid, ".") } return(crs) } db_check_user_permission <- function(conn, table, permission, strict = FALSE) { q <- paste0("select has_table_privilege('", table, "', '", permission, "') as has") can <- try(dbReadTable(conn, q)[["has"]]) if (inherits(can, "try-error")){ if (strict) { return(FALSE) } # we don't know if the user has the permission, but we'll let it pass since # the check isn't strict that way we can see what happens when the permission # is actually needed return(TRUE) } return(can) } delete_postgis_crs <- function(conn, crs) { if (is.na(epsg(crs))) stop("Missing SRID") wkt <- st_as_text(crs) query <- paste0("DELETE FROM spatial_ref_sys ", "WHERE srid = '", epsg(crs), "' ", "AND srtext = '", wkt, "' ", "AND proj4text = '", proj4string(crs), "';") dbExecute(conn, query) } get_new_postgis_srid <- function(conn) { query = paste0("select srid + 1 as srid from spatial_ref_sys order by srid desc limit 1;") dbGetQuery(conn, query)[["srid"]] } # for RPostgreSQL #' Write `sf` object to Database #' @inheritParams RPostgreSQL::postgresqlWriteTable #' @md #' @rdname dbWriteTable #' @importMethodsFrom DBI dbWriteTable #' @export setMethod("dbWriteTable", c("PostgreSQLConnection", "character", "sf"), function(conn, name, value, ..., row.names = FALSE, overwrite = FALSE, append = FALSE, field.types = NULL, binary = TRUE) { if (is.null(field.types)) field.types <- dbDataType(conn, value) tryCatch({ dbWriteTable(conn, name, to_postgis(conn, value, binary),..., row.names = row.names, overwrite = overwrite, append = append, field.types = field.types) }, warning=function(w) { stop(conditionMessage(w), call. = FALSE) }) } ) #' Write `sf` object to Database #' @inheritParams DBI::dbWriteTable #' @param conn DBIObject #' @param binary Send geometries serialized as Well-Known Binary (WKB); #' if `FALSE`, uses Well-Known Text (WKT). Defaults to `TRUE` (WKB). #' @param row.names Add a `row.name` column, or a vector of length `nrow(obj)` #' containing row.names; default `FALSE`. #' @param overwrite Will try to `drop` table before writing; default `FALSE`. #' @param append Append rows to existing table; default `FALSE`. #' @param field.types default `NULL`. Allows to override type conversion from R #' to PostgreSQL. See `dbDataType()` for details. #' @md #' @rdname dbWriteTable #' @importMethodsFrom DBI dbWriteTable dbExistsTable #' @export setMethod("dbWriteTable", c("DBIObject", "character", "sf"), function(conn, name, value, ..., row.names = FALSE, overwrite = FALSE, append = FALSE, field.types = NULL, binary = TRUE) { if (is.null(field.types)) field.types <- dbDataType(conn, value) # DBI cannot set field types with append, but if the table does not exist, # we need to set the field type. if (append) { if (!dbExistsTable(conn, name)) { append <- FALSE } else { field.types <- NULL } } dbWriteTable(conn, name, to_postgis(conn, value, binary),..., row.names = row.names, overwrite = overwrite, append = append, field.types = field.types) } ) to_postgis <- function(conn, x, binary) { geom_col <- vapply(x, inherits, TRUE, what = "sfc") x[geom_col] <- lapply(x[geom_col], sync_crs, conn = conn) if (binary) { x[geom_col] <- lapply(x[geom_col], db_binary) } else { x[geom_col] <- lapply(x[geom_col], st_as_text, EWKT = TRUE) } x <- as.data.frame(x) clean_columns(x, factorsAsCharacter = TRUE) } # Version of st_as_binary that allows locally invalid srids db_binary <- function(x) { st_as_binary(x, EWKB = TRUE, hex = TRUE, pureR = FALSE, srid = epsg(st_crs(x))) } sync_crs <- function(conn, geom) { crs <- st_crs(geom) srid <- epsg(crs) if (is.na(crs) || is.na(srid)) { if (is.na(st_as_text(crs))) crs <- st_crs(NA) else { crs <- get_possibly_new_srid(conn, crs) } } st_set_crs(geom, crs) } #' Determine database type for R vector #' #' @export #' @rdname dbDataType #' @importMethodsFrom DBI dbDataType setMethod("dbDataType", c("PostgreSQLConnection", "sf"), function(dbObj, obj) { dtyp <- vapply(obj, RPostgreSQL::dbDataType, character(1), dbObj = dbObj) gtyp <- vapply(obj, inherits, TRUE, what = "sfc") dtyp[gtyp] <- "geometry" # explicit cast for units gtyp <- vapply(obj, inherits, TRUE, what = "units") dtyp[gtyp] <- "numeric" return(dtyp) }) #' Determine database type for R vector #' #' @export #' @rdname dbDataType #' @importClassesFrom DBI DBIObject #' @importMethodsFrom DBI dbDataType #' @param dbObj DBIObject driver or connection. #' @param obj Object to convert setMethod("dbDataType", c("DBIObject", "sf"), function(dbObj, obj) { dtyp <- vapply(obj, DBI::dbDataType, character(1), dbObj = dbObj) gtyp <- vapply(obj, inherits, TRUE, what = "sfc") dtyp[gtyp] <- "geometry" # explicit cast for units gtyp <- vapply(obj, inherits, TRUE, what = "units") dtyp[gtyp] <- "numeric" return(dtyp) }) #' Check if the columns could be of a coercable type for sf #' #' @param con database connection #' @param x inherits data.frame #' @param classes classes inherited is_geometry_column <- function(con, x, classes = "") UseMethod("is_geometry_column") #' @export is_geometry_column.PqConnection <- function(con, x, classes = c("pq_geometry")) { vapply(x, inherits, logical(1), classes) } #' @export is_geometry_column.default <- function(con, x, classes = c("character")) { # try all character columns (in conjunction with try_postgis_as_sfc) vapply(x, function(x) inherits(x, classes) && !all(is.na(x)), FUN.VALUE = logical(1)) } # https://github.com/r-spatial/sf/issues/1195 : # RPostgres::dbGetQuery returns geometry columns of class pq_geometry: #' @name st_as_sfc #' @export st_as_sfc.pq_geometry <- function(x, ..., EWKB = TRUE, spatialite = FALSE, pureR = FALSE, crs = NA_crs_) { # nocov start st_as_sfc.WKB(x, ..., EWKB = EWKB, spatiallite = spatialite, pureR = pureR, crs = crs) } # nocov end ================================================ FILE: R/defunct.R ================================================ #' @title Deprecated functions in `sf` #' @name sf-defunct #' @description #' These functions are provided for compatibility with older version of `sf`. #' They will eventually be completely removed. #' #' * Use [st_read()] instead of `st_read_db()`. #' * Use [st_write()] instead_of `st_write_db()` #' @param conn open database connection #' @param table table name #' @param geom_column deprecated. Geometry column name #' @details The `geom_column` argument is deprecated. The function will #' automatically find the `geometry` type columns. For the `RPostgreSQL` drivers #' it will try to cast all the character columns, which can be long for very wide #' tables. #' @inheritParams st_read #' @export #' @keywords internal st_read_db <- function(conn = NULL, table = NULL, query = NULL, geom_column = NULL, EWKB = TRUE, ...) { .Defunct("st_read") } #' @rdname sf-defunct #' @inheritParams DBI::dbWriteTable #' @export st_write_db <- function(conn = NULL, obj, table = deparse(substitute(obj)), ..., drop = FALSE, append = FALSE) { .Defunct("st_write") } ================================================ FILE: R/gdal_utils.R ================================================ # nocov start resampling_method = function(option = "near") { if (length(option) != 1) stop("warper options should have length 1") switch(option, near = 0, bilinear = 1, cubic = 2, cubicspline = 3, lanczos = 4, average = 5, mode = 6, max = 8, min = 9, med = 10, q1 = 11, q3 = 12, sum = 13, stop(paste("unknown option:", options)) ) } # nocov end #' Native interface to gdal utils #' @name gdal_utils #' @param util character; one of \code{info}, \code{warp}, \code{rasterize}, \code{translate}, \code{vectortranslate} (for ogr2ogr), \code{buildvrt}, \code{demprocessing}, \code{nearblack}, \code{grid}, \code{mdiminfo} and \code{mdimtranslate} (the last two requiring GDAL 3.1), \code{ogrinfo} (requiring GDAL 3.7), \code{footprint} (requiring GDAL 3.8) #' @param source character; name of input layer(s); for \code{warp}, \code{buidvrt} or \code{mdimtranslate} this can be more than one #' @param destination character; name of output layer #' @param options character; options for the utility #' @param config_options named character vector with GDAL config options, like \code{c(option1=value1, option2=value2)} #' @param quiet logical; if \code{TRUE}, suppress printing the output for \code{info} and \code{mdiminfo}, and suppress printing progress #' @param processing character; processing options for \code{demprocessing} #' @param colorfilename character; name of color file for \code{demprocessing} (mandatory if \code{processing="color-relief"}) #' @param read_only logical; only for `ogrinfo`: if `TRUE`, source is opened in read-only mode #' @return \code{info} returns a character vector with the raster metadata; all other utils return (invisibly) a logical indicating success (i.e., \code{TRUE}); in case of failure, an error is raised. #' @export #' @seealso \link{gdal_addo} for adding overlays to a raster file; \link{st_layers} to query geometry type(s) and crs from layers in a (vector) data source #' @examples #' #' if (compareVersion(sf_extSoftVersion()["GDAL"], "2.1.0") == 1) { #' # info utils can be used to list information about a raster #' # dataset. More info: https://gdal.org/programs/gdalinfo.html #' in_file <- system.file("tif/geomatrix.tif", package = "sf") #' gdal_utils("info", in_file, options = c("-mm", "-proj4")) #' #' # vectortranslate utils can be used to convert simple features data between #' # file formats. More info: https://gdal.org/programs/ogr2ogr.html #' in_file <- system.file("shape/storms_xyz.shp", package="sf") #' out_file <- paste0(tempfile(), ".gpkg") #' gdal_utils( #' util = "vectortranslate", #' source = in_file, #' destination = out_file, # output format must be specified for GDAL < 2.3 #' options = c("-f", "GPKG") #' ) #' # The parameters can be specified as c("name") or c("name", "value"). The #' # vectortranslate utils can perform also various operations during the #' # conversion process. For example, we can reproject the features during the #' # translation. #' gdal_utils( #' util = "vectortranslate", #' source = in_file, #' destination = out_file, #' options = c( #' "-f", "GPKG", # output file format for GDAL < 2.3 #' "-s_srs", "EPSG:4326", # input file SRS #' "-t_srs", "EPSG:2264", # output file SRS #' "-overwrite" #' ) #' ) #' st_read(out_file) #' # The parameter s_srs had to be specified because, in this case, the in_file #' # has no associated SRS. #' st_read(in_file) #' } gdal_utils = function(util = "info", source, destination, options = character(0), quiet = !(util %in% c("info", "gdalinfo", "ogrinfo", "vectorinfo", "mdiminfo")) || ("-multi" %in% options), processing = character(0), colorfilename = character(0), config_options = character(0), read_only = FALSE) { stopifnot(is.character(options), is.character(config_options)) if (!quiet && "-multi" %in% options) stop("with -multi quiet should be set to FALSE") # if ("-co" %in% options) # options["-co" == options] = "-oo" if ("-oo" %in% options) { # -oo indicating opening options ooi = which("-oo" == options) oo = options[ooi + 1] options = options[-c(ooi, ooi+1)] } else oo = character(0) if ("-doo" %in% options) { # -oo indicating destination opening options ooi = which("-doo" == options) doo = options[ooi + 1] options = options[-c(ooi, ooi+1)] } else doo = character(0) if ("-doo" %in% options) # -oo indicating opening options stop("-doo options not (yet) supported; consider raising an issue") # nocov quiet = as.logical(quiet) ret = switch(util, gdalinfo =, info = CPL_gdalinfo(if (missing(source)) character(0) else source, options, oo, config_options), vectorinfo =, ogrinfo = CPL_ogrinfo(if (missing(source)) character(0) else source, options, oo, config_options, isTRUE(read_only) || "-ro" %in% options), warp = CPL_gdalwarp(source, destination, options, oo, doo, config_options, quiet, "-overwrite" %in% options), warper = CPL_gdal_warper(source, destination, as.integer(resampling_method(options)), oo, doo, config_options, quiet), # nocov rasterize = { # nocov start overwrite = any(options %in% c("-of", "-a_nodata", "-init", "-a_srs", "-co", "-te", "-tr", "-tap", "-ts", "-ot")) # https://gdal.org/programs/gdal_rasterize.html CPL_gdalrasterize(source, destination, options, oo, doo, config_options, overwrite, quiet) }, # nocov end footprint = CPL_gdalfootprint(source, destination, options, oo, config_options, quiet), translate = CPL_gdaltranslate(source, destination, options, oo, config_options, quiet), vectortranslate = CPL_gdalvectortranslate(source, destination, options, oo, doo, config_options, quiet), buildvrt = CPL_gdalbuildvrt(if (missing(source)) character(0) else source, destination, options, oo, config_options, quiet), demprocessing = CPL_gdaldemprocessing(source, destination, options, processing, colorfilename, oo, config_options, quiet), nearblack = CPL_gdalnearblack(source, destination, options, oo, config_options, doo, quiet), grid = CPL_gdalgrid(source, destination, options, oo, config_options, quiet), mdiminfo = CPL_gdalmdiminfo(source, options, oo, config_options), mdimtranslate = CPL_gdalmdimtranslate(source, destination, options, oo, config_options, quiet), stop(paste("unknown util value for gdal_utils:", util)) ) if (util %in% c("info", "gdalinfo", "ogrinfo", "vectorinfo", "mdiminfo")) { if (! quiet) cat(ret) invisible(ret) } else { # ret indicates error: if (ret) stop(paste0("gdal_utils ", util, ": an error occured")) invisible(! ret) # success } } ================================================ FILE: R/geom-measures.R ================================================ # unary, interfaced through GEOS: #' Dimension, simplicity, validity or is_empty queries on simple feature geometries #' @name geos_query #' @param x object of class \code{sf}, \code{sfc} or \code{sfg} #' @param NA_if_empty logical; if TRUE, return NA for empty geometries #' @return st_dimension returns a numeric vector with 0 for points, 1 for lines, 2 for surfaces, and, if \code{NA_if_empty} is \code{TRUE}, \code{NA} for empty geometries. #' @export #' @examples #' x = st_sfc( #' st_point(0:1), #' st_linestring(rbind(c(0,0),c(1,1))), #' st_polygon(list(rbind(c(0,0),c(1,0),c(0,1),c(0,0)))), #' st_multipoint(), #' st_linestring(), #' st_geometrycollection()) #' st_dimension(x) #' st_dimension(x, FALSE) st_dimension = function(x, NA_if_empty = TRUE) CPL_gdal_dimension(st_geometry(x), NA_if_empty) #' @name geos_measures #' @export #' @return If the coordinate reference system of \code{x} was set, these functions return values with unit of measurement; see \link[units]{set_units}. #' #' st_area returns the area of each feature geometry, computed in the coordinate reference system used. In case \code{x} has geodetic coordinates (unprojected), then if `sf_use_s2()` is `FALSE` \link[lwgeom:geod]{st_geod_area} is used for area calculation, if it is `TRUE` then \link[s2:s2_is_collection]{s2_area} is used: the former assumes an ellipsoidal shape, the latter a spherical shape of the Earth. In case of projected data, areas are computed in flat space. The argument `...` can be used to specify `radius` to \link[s2:s2_is_collection]{s2_area}, to modify the Earth radius. #' @examples #' b0 = st_polygon(list(rbind(c(-1,-1), c(1,-1), c(1,1), c(-1,1), c(-1,-1)))) #' b1 = b0 + 2 #' b2 = b0 + c(-0.2, 2) #' x = st_sfc(b0, b1, b2) #' st_area(x) st_area = function(x, ...) UseMethod("st_area") #' @name geos_measures #' @export st_area.sfc = function(x, ...) { if (isTRUE(st_is_longlat(x))) { if (sf_use_s2()) units::set_units(s2::s2_area(x, ...), "m^2", mode = "standard") else { if (! requireNamespace("lwgeom", quietly = TRUE)) stop("package lwgeom required, please install it first") lwgeom::st_geod_area(x) } } else { a = CPL_area(x) # ignores units: units of coordinates if (!is.null(u <- st_crs(x)$ud_unit)) units(a) = u^2 # coord units if (!is.null(to_m <- st_crs(x)$to_meter) && !is.na(to_m) && !inherits(a, "units")) a = set_units(a * to_m^2, "m^2", mode = "standard") a } } #' @export st_area.sf = function(x, ...) st_area(st_geometry(x), ...) #' @export st_area.sfg = function(x, ...) st_area(st_geometry(x), ...) #' @name geos_measures #' @export #' @return st_length returns the length of a \code{LINESTRING} or \code{MULTILINESTRING} geometry, using the coordinate reference system. \code{POINT}, \code{MULTIPOINT}, \code{POLYGON} or \code{MULTIPOLYGON} geometries return zero. #' If coordinates are geodetic (i.e., long/lat), great circle calculations are carried out on a sphere (if `sf_use_s2()` is `TRUE`), or a geodesic line is computed on an ellipsoid (if `sf_use_s2()` is `FALSE`). For all other non-geodetic, projected coordinate systems, length calculations are planar, Euclidean distance calculations in the units of the coordinate system. #' @seealso \link{st_dimension}, \link{st_cast} to convert geometry types #' #' @examples #' line = st_sfc(st_linestring(rbind(c(30,30), c(40,40))), crs = 4326) #' st_length(line) #' #' outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) #' hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) #' hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) #' #' poly = st_polygon(list(outer, hole1, hole2)) #' mpoly = st_multipolygon(list( #' list(outer, hole1, hole2), #' list(outer + 12, hole1 + 12) #' )) #' #' st_length(st_sfc(poly, mpoly)) st_length = function(x, ...) { x = st_geometry(x) if (isTRUE(st_is_longlat(x))) { if (sf_use_s2()) set_units(s2::s2_length(x, ...), "m", mode = "standard") else { if (! requireNamespace("lwgeom", quietly = TRUE)) stop("package lwgeom required, please install it first") lwgeom::st_geod_length(x) } } else { ret = CPL_length(x) ret[is.nan(ret)] = NA if (!is.null(u <- st_crs(x)$ud_unit)) units(ret) = u if (!is.null(to_m <- st_crs(x)$to_meter) && !is.na(to_m) && !inherits(ret, "units")) ret = set_units(ret * to_m, "m", mode = "standard") ret } } message_longlat = function(caller) { m = paste("although coordinates are longitude/latitude,", caller, "assumes that they are planar") m = strwrap(m, width = getOption("width")) message(paste0(m, collapse = "\n")) } #' @name geos_measures #' @export #' @examples #' if (requireNamespace("lwgeom", quietly = TRUE)) { #' st_perimeter(poly) #' st_perimeter(mpoly) #' } st_perimeter = function(x, ...) { x = st_geometry(x) if (sf_use_s2() && isTRUE(st_is_longlat(x))) { # for spherical geometries we use s2 if (!requireNamespace("s2", quietly = TRUE)) stop("package s2 required to calculate the perimeter of spherical geometries") # ensure units are set to meters units::set_units( s2::s2_perimeter(x, ...), "m", mode = "standard" ) } else { # non-spherical geometries use lwgeom: if (isTRUE(st_is_longlat(x))) units::set_units(st_length(st_boundary(x)), "m", mode = "standard") else { if (!requireNamespace("lwgeom", quietly = TRUE)) stop("package lwgeom required, please install it first") # note that units are handled appropriately by lwgeom lwgeom::st_perimeter_lwgeom(x) } } } #' Compute geometric measurements #' #' Compute Euclidean or great circle distance between pairs of geometries; compute, the area or the length of a set of geometries. #' @name geos_measures #' @param x object of class \code{sf}, \code{sfc} or \code{sfg} #' @param y object of class \code{sf}, \code{sfc} or \code{sfg}, defaults to \code{x} #' @param ... passed on to \link[s2]{s2_distance}, \link[s2]{s2_distance_matrix}, or \link[s2]{s2_perimeter} #' @param dist_fun deprecated #' @param by_element logical; if \code{TRUE}, return a vector with distance between the first elements of \code{x} and \code{y}, the second, etc; an error is raised if \code{x} and \code{y} are not the same length. If \code{FALSE}, return the dense matrix with all pairwise distances. #' @param which character; for Cartesian coordinates only: one of \code{Euclidean}, \code{Hausdorff} or \code{Frechet}; for geodetic coordinates, great circle distances are computed; see details #' @param par for \code{which} equal to \code{Hausdorff} or \code{Frechet}, optionally use a value between 0 and 1 to densify the geometry #' @param tolerance ignored if \code{st_is_longlat(x)} is \code{FALSE}; otherwise, if set to a positive value, the first distance smaller than \code{tolerance} will be returned, and true distance may be smaller; this may speed up computation. In meters, or a \code{units} object convertible to meters. #' @return If \code{by_element} is \code{FALSE} \code{st_distance} returns a dense numeric matrix of dimension length(x) by length(y); otherwise it returns a numeric vector the same length as \code{x} and \code{y} with an error raised if the lengths of \code{x} and \code{y} are unequal. Distances involving empty geometries are \code{NA}. #' @details great circle distance calculations use by default spherical distances (\link[s2]{s2_distance} or \link[s2]{s2_distance_matrix}); if \code{sf_use_s2()} is \code{FALSE}, ellipsoidal distances are computed using \link[lwgeom]{st_geod_distance} which uses function \code{geod_inverse} from GeographicLib (part of PROJ); see Karney, Charles FF, 2013, Algorithms for geodesics, Journal of Geodesy 87(1), 43--55 #' @examples #' p = st_sfc(st_point(c(0,0)), st_point(c(0,1)), st_point(c(0,2))) #' st_distance(p, p) #' st_distance(p, p, by_element = TRUE) #' @export st_distance = function(x, y, ..., dist_fun, by_element = FALSE, which = ifelse(isTRUE(st_is_longlat(x)), "Great Circle", "Euclidean"), par = 0.0, tolerance = 0.0) { missing_y = FALSE if (missing(y)) { y = x missing_y = TRUE } else stopifnot(st_crs(x) == st_crs(y)) if (! missing(dist_fun)) stop("dist_fun is deprecated: lwgeom is used for distance calculation") x = st_geometry(x) y = st_geometry(y) if (by_element) stopifnot(!missing_y, length(x) == length(y)) if (isTRUE(st_is_longlat(x)) && which == "Great Circle") { if (sf_use_s2()) { ret = if (by_element) s2::s2_distance(x, y, ...) else s2::s2_distance_matrix(x, y, ...) set_units(ret, "m", mode = "standard") } else { # lwgeom: if (which != "Great Circle") stop("for non-great circle distances, data should be projected; see st_transform()") units(tolerance) = as_units("m") if (by_element) { crs = st_crs(x) dist_ll = function(x, y, tolerance) lwgeom::st_geod_distance(st_sfc(x, crs = crs), st_sfc(y, crs = crs), tolerance = tolerance) d = mapply(dist_ll, x, y, tolerance = tolerance) units(d) = units(st_crs(x)$SemiMajor) d } else lwgeom::st_geod_distance(x, y, tolerance) } } else { d = if (by_element) { if (inherits(x, "sfc_POINT") && inherits(y, "sfc_POINT") && which == "Euclidean") { xc = st_coordinates(x) yc = st_coordinates(y) sqrt((xc[,1] - yc[,1])^2 + (xc[,2] - yc[,2])^2) } else CPL_geos_dist_by_element(x, y, which, par) } else { if (missing_y && inherits(x, "sfc_POINT") && which == "Euclidean") { m = as.matrix(stats::dist(cc <- st_coordinates(x))) e = is.na(cc[,1]) diag(m)[e] = NA_real_ m } else CPL_geos_dist(x, y, which, par) } if (!is.null(u <- st_crs(x)$ud_unit)) units(d) = u d } } check_lengths = function (dots) { lengths <- vapply(dots, length, integer(1)) non_constant_lengths <- unique(lengths[lengths != 1]) if (length(non_constant_lengths) == 0) { 1 } else if (length(non_constant_lengths) == 1) { non_constant_lengths } else { lengths_label <- paste0(non_constant_lengths, collapse = ", ") stop(sprintf("Incompatible lengths: %s", lengths_label), call. = FALSE) } } recycle_common = function (dots) { final_length <- check_lengths(dots) lapply(dots, rep_len, final_length) } #' Project point on linestring, interpolate along a linestring #' #' Project point on linestring, interpolate along a linestring #' @param line object of class `sfc` with `LINESTRING` geometry #' @param point object of class `sfc` with `POINT` geometry #' @param normalized logical; if `TRUE`, use or return distance normalised to 0-1 #' @name st_line_project_point #' @returns `st_line_project` returns the distance(s) of point(s) along line(s), when projected on the line(s) #' @export #' @details #' arguments `line`, `point` and `dist` are recycled to common length when needed #' @examples #' st_line_project(st_as_sfc("LINESTRING (0 0, 10 10)"), st_as_sfc(c("POINT (0 0)", "POINT (5 5)"))) #' st_line_project(st_as_sfc("LINESTRING (0 0, 10 10)"), st_as_sfc("POINT (5 5)"), TRUE) st_line_project = function(line, point, normalized = FALSE) { stopifnot(inherits(line, "sfc"), inherits(point, "sfc"), all(st_dimension(line) == 1), all(st_dimension(point) == 0), is.logical(normalized), length(normalized) == 1, st_crs(line) == st_crs(point)) line = st_cast(line, "LINESTRING") point = st_cast(point, "POINT") if (isTRUE(st_is_longlat(line))) message_longlat("st_project_point") recycled = recycle_common(list(line, point)) CPL_line_project(recycled[[1]], recycled[[2]], normalized) } ================================================ FILE: R/geom-predicates.R ================================================ #' @name geos_query #' @export #' @return st_is_simple returns a logical vector, indicating for each geometry whether it is simple (e.g., not self-intersecting) #' @examples #' ls = st_linestring(rbind(c(0,0), c(1,1), c(1,0), c(0,1))) #' st_is_simple(st_sfc(ls, st_point(c(0,0)))) st_is_simple = function(x) { x = st_geometry(x) not_full = !sfc_is_full(x) ret = rep(TRUE, length(x)) ret[not_full] = CPL_geos_is_simple(x[not_full]) ret } #' @name geos_query #' @export #' @return st_is_empty returns for each geometry whether it is empty #' @examples #' ls = st_linestring(rbind(c(0,0), c(1,1), c(1,0), c(0,1))) #' st_is_empty(st_sfc(ls, st_point(), st_linestring())) st_is_empty = function(x) sfc_is_empty(st_geometry(x)) # used to call # CPL_geos_is_empty(st_geometry(x)) # but this avoids a R -> WKB -> GEOS conversion is_symmetric = function(operation, pattern) { if (!is.na(pattern)) { m = matrix(sapply(1:9, function(i) substr(pattern, i, i)), 3, 3) isTRUE(all(m == t(m))) } else isTRUE(operation %in% c("intersects", "touches", "overlaps", "disjoint", "equals")) } # binary, interfaced through GEOS or S2: # [1] X "s2_contains_matrix" X "s2_covered_by_matrix" # [3] X "s2_covers_matrix" X "s2_disjoint_matrix" # [5] X "s2_distance_matrix" X "s2_dwithin_matrix" # [7] X "s2_equals_matrix" X "s2_intersects_matrix" # [9] "s2_max_distance_matrix" "s2_may_intersect_matrix" #[11] X "s2_touches_matrix" X "s2_within_matrix" # returning matrix, distance or relation string -- the work horse is: st_geos_binop = function(op, x, y, par = 0.0, pattern = NA_character_, sparse = TRUE, prepared = FALSE, model = "closed", ..., remove_self = FALSE, retain_unique = FALSE, by_element = FALSE) { longlat = inherits(x, "s2geography") || isTRUE(st_is_longlat(x)) if (by_element) { if (missing(y)) stop("y is required when by_element = TRUE") if (inherits(x, c("sf", "sfc")) && inherits(y, c("sf", "sfc"))) stopifnot(st_crs(x) == st_crs(y)) x = st_geometry(x) y = st_geometry(y) stopifnot(length(x) == length(y)) if (longlat && sf_use_s2() && op %in% c("intersects", "contains", "within", "covers", "covered_by", "disjoint", "equals", "touches")) { fn = get(paste0("s2_", op), envir = getNamespace("s2")) fn(x, y, s2::s2_options(model = model, ...)) } else { if (longlat && !(op %in% c("equals", "equals_exact"))) message_longlat(paste0("st_", op)) CPL_geos_binop_by_element(x, y, op, par, pattern, prepared)[[1]] } } else { if (missing(y)) y = x else if (inherits(x, c("sf", "sfc")) && inherits(y, c("sf", "sfc"))) stopifnot(st_crs(x) == st_crs(y)) if (longlat && sf_use_s2() && op %in% c("intersects", "contains", "within", "covers", "covered_by", "disjoint", "equals", "touches")) { fn = get(paste0("s2_", op, "_matrix"), envir = getNamespace("s2")) # get op function lst = fn(x, y, s2::s2_options(model = model, ...)) # call function id = if (is.null(row.names(x))) as.character(seq_along(lst)) else row.names(x) sgbp(lst, predicate = op, region.id = id, ncol = length(st_geometry(y)), sparse, remove_self = remove_self, retain_unique = retain_unique) } else { if (longlat && !(op %in% c("equals", "equals_exact"))) message_longlat(paste0("st_", op)) if (prepared && is_symmetric(op, pattern) && length(dx <- st_dimension(x)) && length(dy <- st_dimension(y)) && isTRUE(all(dx == 0)) && isTRUE(all(dy == 2))) { t(st_geos_binop(op, y, x, par = par, pattern = pattern, sparse = sparse, prepared = prepared, remove_self = remove_self, retain_unique = retain_unique, ...)) } else { ret = CPL_geos_binop(st_geometry(x), st_geometry(y), op, par, pattern, prepared) if (length(ret) == 0 || is.null(dim(ret[[1]]))) { id = if (is.null(row.names(x))) as.character(seq_along(ret)) else row.names(x) sgbp(ret, predicate = op, region.id = id, ncol = length(st_geometry(y)), sparse, remove_self = remove_self, retain_unique = retain_unique) } else # CPL_geos_binop returned a matrix, e.g. from op = "relate" ret[[1]] } } } } #' Compute DE9-IM relation between pairs of geometries, or match it to a given pattern #' @param x object of class \code{sf}, \code{sfc} or \code{sfg} #' @param y object of class \code{sf}, \code{sfc} or \code{sfg} #' @param pattern character; define the pattern to match to, see details. #' @param sparse logical; should a sparse matrix be returned (`TRUE`) or a dense matrix? #' @param ... may be used to specify `by_element=TRUE` to return a vector with element-wise relations or matches #' @return In case \code{pattern} is not given, \code{st_relate} returns a dense \code{character} matrix; element `[i,j]` has nine characters, referring to the DE9-IM relationship between `x[i]` and `y[j]`, encoded as IxIy,IxBy,IxEy,BxIy,BxBy,BxEy,ExIy,ExBy,ExEy where I refers to interior, B to boundary, and E to exterior, and e.g. BxIy the dimensionality of the intersection of the the boundary of `x[i]` and the interior of `y[j]`, which is one of: 0, 1, 2, or F; digits denoting dimensionality of intersection, F denoting no intersection. When \code{pattern} is given, a dense logical matrix or sparse index list returned with matches to the given pattern; see \link{st_intersects} for a description of the returned matrix or list. See also \url{https://en.wikipedia.org/wiki/DE-9IM} for further explanation. #' @export #' @examples #' p1 = st_point(c(0,0)) #' p2 = st_point(c(2,2)) #' pol1 = st_polygon(list(rbind(c(0,0),c(1,0),c(1,1),c(0,1),c(0,0)))) - 0.5 #' pol2 = pol1 + 1 #' pol3 = pol1 + 2 #' st_relate(st_sfc(p1, p2), st_sfc(pol1, pol2, pol3)) #' sfc = st_sfc(st_point(c(0,0)), st_point(c(3,3))) #' grd = st_make_grid(sfc, n = c(3,3)) #' st_intersects(grd) #' st_relate(grd, pattern = "****1****") # sides, not corners, internals #' st_relate(grd, pattern = "****0****") # only corners touch #' st_rook = function(a, b = a) st_relate(a, b, pattern = "F***1****") #' st_rook(grd) #' # queen neighbours, see \url{https://github.com/r-spatial/sf/issues/234#issuecomment-300511129} #' st_queen <- function(a, b = a) st_relate(a, b, pattern = "F***T****") st_relate = function(x, y, pattern = NA_character_, sparse = !is.na(pattern), ...) { if (!is.na(pattern)) { stopifnot(is.character(pattern), length(pattern) == 1, nchar(pattern) == 9) st_geos_binop("relate_pattern", x, y, pattern = pattern, sparse = sparse, ...) } else st_geos_binop("relate", x, y, sparse = FALSE, ...) } #' Geometric binary predicates on pairs of simple feature geometry sets #' #' Geometric binary predicates on pairs of simple feature geometry sets #' @name geos_binary_pred #' @param x object of class \code{sf}, \code{sfc} or \code{sfg} #' @param y object of class \code{sf}, \code{sfc} or \code{sfg}; if missing, \code{x} is used #' @param sparse logical; should a sparse index list be returned (`TRUE`) or a dense logical matrix? See below. #' @inheritDotParams s2::s2_options #' @param prepared logical; prepare geometry for `x`, before looping over `y`? See Details. #' @param by_element logical; if `TRUE`, return logical vector with x-y pair-wise predicate values #' @details If \code{prepared} is \code{TRUE}, and \code{x} contains POINT geometries and \code{y} contains polygons, then the polygon geometries are prepared, rather than the points. #' @return If \code{sparse=FALSE}, \code{st_predicate} (with \code{predicate} e.g. "intersects") returns a dense logical matrix with element \code{i,j} equal to \code{TRUE} when \code{predicate(x[i], y[j])} (e.g., when geometry of feature i and j intersect); if \code{sparse=TRUE}, an object of class \code{\link{sgbp}} is returned, which is a sparse list representation of the same matrix, with list element \code{i} an integer vector with all indices \code{j} for which \code{predicate(x[i],y[j])} is \code{TRUE} (and hence a zero-length integer vector if none of them is \code{TRUE}). From the dense matrix, one can find out if one or more elements intersect by \code{apply(mat, 1, any)}, and from the sparse list by \code{lengths(lst) > 0}, see examples below. If `by_element=TRUE`, return a vector of pair-wise predicate values. #' @details For most predicates, a spatial index is built on argument \code{x}; see \url{https://r-spatial.org/r/2017/06/22/spatial-index.html}. #' Specifically, \code{st_intersects}, \code{st_disjoint}, \code{st_touches} \code{st_crosses}, \code{st_within}, \code{st_contains}, \code{st_contains_properly}, \code{st_overlaps}, \code{st_equals}, \code{st_covers} and \code{st_covered_by} all build spatial indexes for more efficient geometry calculations. \code{st_relate}, \code{st_equals_exact}, and do not; \code{st_is_within_distance} uses a spatial index for geographic coordinates when \code{sf_use_s2()} is true. #' #' If \code{y} is missing, `st_predicate(x, x)` is effectively called, and a square matrix is returned with diagonal elements `st_predicate(x[i], x[i])`. #' #' Sparse geometry binary predicate (\code{\link{sgbp}}) lists have the following attributes: \code{region.id} with the \code{row.names} of \code{x} (if any, else \code{1:n}), \code{ncol} with the number of features in \code{y}, and \code{predicate} with the name of the predicate used. #' #' @note For intersection on pairs of simple feature geometries, use #' the function \code{\link{st_intersection}} instead of \code{st_intersects}. #' #' @examples #' pts = st_sfc(st_point(c(.5,.5)), st_point(c(1.5, 1.5)), st_point(c(2.5, 2.5))) #' pol = st_polygon(list(rbind(c(0,0), c(2,0), c(2,2), c(0,2), c(0,0)))) #' (lst = st_intersects(pts, pol)) #' (mat = st_intersects(pts, pol, sparse = FALSE)) #' # which points fall inside a polygon? #' apply(mat, 1, any) #' lengths(lst) > 0 #' # which points fall inside the first polygon? #' st_intersects(pol, pts)[[1]] #' # remove duplicate geometries: #' p1 = st_point(0:1) #' p2 = st_point(2:1) #' p = st_sf(a = letters[1:8], geom = st_sfc(p1, p1, p2, p1, p1, p2, p2, p1)) #' st_equals(p) #' st_equals(p, remove_self = TRUE) #' (u = st_equals(p, retain_unique = TRUE)) #' # retain the records with unique geometries: #' p[-unlist(u),] #' @export st_intersects = function(x, y, sparse = TRUE, ..., by_element = FALSE) UseMethod("st_intersects") #' @export st_intersects.sfc = function(x, y, sparse = TRUE, prepared = TRUE, ...) st_geos_binop("intersects", x, y, sparse = sparse, prepared = prepared, ...) #' @export st_intersects.sf = function(x, y, sparse = TRUE, prepared = TRUE, ...) st_geos_binop("intersects", x, y, sparse = sparse, prepared = prepared, ...) #' @export st_intersects.sfg = function(x, y, sparse = TRUE, prepared = TRUE, ...) st_geos_binop("intersects", x, y, sparse = sparse, prepared = prepared, ...) #' @name geos_binary_pred #' @export st_disjoint = function(x, y = x, sparse = TRUE, prepared = TRUE, ...) { # st_geos_binop("disjoint", x, y, sparse = sparse, prepared = prepared) -> didn't use STRtree int = st_geos_binop("intersects", x, y, sparse = sparse, prepared = prepared, ...) # disjoint = !intersects : if (sparse) sgbp(lapply(int, function(g) setdiff(seq_along(st_geometry(y)), g)), predicate = "disjoint", ncol = attr(int, "ncol"), region.id = attr(int, "region.id")) else !int } #' @name geos_binary_pred #' @export st_touches = function(x, y, sparse = TRUE, prepared = TRUE, ...) st_geos_binop("touches", x, y, sparse = sparse, prepared = prepared, ...) #' @name geos_binary_pred #' @export st_crosses = function(x, y, sparse = TRUE, prepared = TRUE, ...) st_geos_binop("crosses", x, y, sparse = sparse, prepared = prepared, ...) #' @name geos_binary_pred #' @export st_within = function(x, y, sparse = TRUE, prepared = TRUE, ...) st_geos_binop("within", x, y, sparse = sparse, prepared = prepared, ...) #' @name geos_binary_pred #' @param model character; polygon/polyline model; one of #' "open", "semi-open" or "closed"; see Details. #' @details for \code{model}, see https://github.com/r-spatial/s2/issues/32 #' @export st_contains = function(x, y, sparse = TRUE, prepared = TRUE, ..., model = "open") st_geos_binop("contains", x, y, sparse = sparse, prepared = prepared, ..., model = model) #' @name geos_binary_pred #' @export #' @details `st_contains_properly(A,B)` is true if A intersects B's interior, but not its edges or exterior; A contains A, but A does not properly contain A. #' #' See also \link{st_relate} and \url{https://en.wikipedia.org/wiki/DE-9IM} for a more detailed description of the underlying algorithms. st_contains_properly = function(x, y, sparse = TRUE, prepared = TRUE, ...) { if (! prepared) stop("non-prepared geometries not supported for st_contains_properly") st_geos_binop("contains_properly", x, y, sparse = sparse, prepared = TRUE, ...) } #' @name geos_binary_pred #' @export st_overlaps = function(x, y, sparse = TRUE, prepared = TRUE, ...) st_geos_binop("overlaps", x, y, sparse = sparse, prepared = prepared, ...) #' @name geos_binary_pred #' @param retain_unique logical; if `TRUE` (and `y` is missing) return only indexes of points larger than the current index; this can be used to select unique geometries, see examples. This argument can be used for all geometry predicates; see also \link{distinct.sf} to find records where geometries AND attributes are distinct. #' @param remove_self logical; if `TRUE` (and `y` is missing) return only indexes of geometries different from the current index; this can be used to omit self-intersections; see examples. This argument can be used for all geometry predicates #' @export st_equals = function(x, y, sparse = TRUE, prepared = FALSE, ..., retain_unique = FALSE, remove_self = FALSE) { if (prepared) stop("prepared geometries not supported for st_equals") st_geos_binop("equals", x, y, sparse = sparse, ..., retain_unique = retain_unique, remove_self = remove_self) } #' @name geos_binary_pred #' @export st_covers = function(x, y, sparse = TRUE, prepared = TRUE, ..., model = "closed") st_geos_binop("covers", x, y, sparse = sparse, prepared = prepared, ..., model = model) #' @name geos_binary_pred #' @export st_covered_by = function(x, y = x, sparse = TRUE, prepared = TRUE, ..., model = "closed") st_geos_binop("covered_by", x, y, sparse = sparse, prepared = prepared, ...) #' @name geos_binary_pred #' @export #' @param par numeric; parameter used for "equals_exact" (margin); #' @details \code{st_equals_exact} returns true for two geometries of the same type and their vertices corresponding by index are equal up to a specified tolerance. st_equals_exact = function(x, y, par, sparse = TRUE, prepared = FALSE, ...) { if (prepared) stop("prepared geometries not supported for st_equals_exact") st_geos_binop("equals_exact", x, y, par = par, sparse = sparse, ...) } #' @name geos_binary_pred #' @export #' @param dist distance threshold; geometry indexes with distances smaller or equal to this value are returned; numeric value or units value having distance units. st_is_within_distance = function(x, y = x, dist, sparse = TRUE, ..., remove_self = FALSE) { ret = if (isTRUE(st_is_longlat(x))) { units(dist) = as_units("m") # might convert r = if (sf_use_s2()) { if (inherits(dist, "units")) dist = drop_units(dist) s2::s2_dwithin_matrix(x, y, dist, ...) } else { if (!requireNamespace("lwgeom", quietly = TRUE) || utils::packageVersion("lwgeom") <= "0.1-2") stop("lwgeom > 0.1-2 required: install first?") lwgeom::st_geod_distance(x, y, tolerance = dist, sparse = TRUE) } sgbp(r, predicate = "is_within_distance", region.id = seq_along(x), remove_self = remove_self, ncol = length(st_geometry(y))) } else { if (!is.null(st_crs(x)$ud_unit)) units(dist) = st_crs(x)$ud_unit # might convert st_geos_binop("is_within_distance", x, y, par = dist, sparse = sparse, remove_self = remove_self, ...) } if (!sparse) as.matrix(ret) else ret } ================================================ FILE: R/geom-transformers.R ================================================ # unary, returning geometries #' Geometric unary operations on simple feature geometry sets #' #' Geometric unary operations on simple feature geometries. These are all generics, with methods for \code{sfg}, \code{sfc} and \code{sf} objects, returning an object of the same class. All operations work on a per-feature basis, ignoring all other features. #' @name geos_unary #' @param x object of class \code{sfg}, \code{sfc} or \code{sf} #' @param dist numeric or object of class `units`; buffer distance(s) for all, or for each of the elements in \code{x}. #' In case \code{x} has geodetic coordinates (lon/lat) and `sf_use_s2()` is `TRUE`, a numeric #' `dist` is taken as distance in meters and a `units` object in `dist` is converted to meters. #' In case \code{x} has geodetic coordinates (lon/lat) and `sf_use_s2()` is `FALSE`, a numeric #' `dist` is taken as degrees, and a `units` object in `dist` is converted to `arc_degree` (and warnings are issued). #' In case \code{x} does not have geodetic coordinates (projected) then #' numeric `dist` is assumed to have the units of the coordinates, and a `units` `dist` is converted to those if `st_crs(x)` is not `NA`. #' @param nQuadSegs integer; number of segments per quadrant (fourth of a circle), for all or per-feature; see details #' @param endCapStyle character; style of line ends, one of 'ROUND', 'FLAT', 'SQUARE'; see details #' @param joinStyle character; style of line joins, one of 'ROUND', 'MITRE', 'BEVEL'; see details #' @param mitreLimit numeric; limit of extension for a join if \code{joinStyle} 'MITRE' is used (default 1.0, minimum 0.0); see details #' @param singleSide logical; if \code{TRUE}, single-sided buffers are returned for linear geometries, #' in which case negative \code{dist} values give buffers on the right-hand side, positive on the left; see details #' @param ... in `st_buffer` passed on to [s2::s2_buffer_cells()], otherwise ignored #' @return an object of the same class of \code{x}, with manipulated geometry. #' @export #' @details \code{st_buffer} computes a buffer around this geometry/each geometry. Depending on the spatial #' coordinate system, a different engine (GEOS or S2) can be used, which have different function #' arguments. The \code{nQuadSegs}, \code{endCapsStyle}, \code{joinStyle}, \code{mitreLimit} and #' \code{singleSide} parameters only work if the GEOS engine is used (i.e. projected coordinates or #' when \code{sf_use_s2()} is set to \code{FALSE}). See \href{https://postgis.net/docs/ST_Buffer.html}{postgis.net/docs/ST_Buffer.html} #' for details. The \code{max_cells} and \code{min_level} parameters ([s2::s2_buffer_cells()]) work with the S2 #' engine (i.e. geographic coordinates) and can be used to change the buffer shape (e.g. smoothing). #' The S2 engine returns a polygon _around_ a number of S2 cells that #' contain the buffer, and hence will always have an area larger than the #' true buffer, depending on `max_cells`, and will be non-smooth when sufficiently zoomed in. #' The GEOS engine will return line segments between points #' on the circle, and so will always be _smaller_ than the true #' buffer, and be smooth, depending on the number of segments `nQuadSegs`. #' A negative `dist` value for geodetic coordinates using S2 does not give a proper (geodetic) buffer. #' #' @examples #' #' ## st_buffer, style options (taken from rgeos gBuffer) #' l1 = st_as_sfc("LINESTRING(0 0,1 5,4 5,5 2,8 2,9 4,4 6.5)") #' op = par(mfrow=c(2,3)) #' plot(st_buffer(l1, dist = 1, endCapStyle="ROUND"), reset = FALSE, main = "endCapStyle: ROUND") #' plot(l1,col='blue',add=TRUE) #' plot(st_buffer(l1, dist = 1, endCapStyle="FLAT"), reset = FALSE, main = "endCapStyle: FLAT") #' plot(l1,col='blue',add=TRUE) #' plot(st_buffer(l1, dist = 1, endCapStyle="SQUARE"), reset = FALSE, main = "endCapStyle: SQUARE") #' plot(l1,col='blue',add=TRUE) #' plot(st_buffer(l1, dist = 1, nQuadSegs=1), reset = FALSE, main = "nQuadSegs: 1") #' plot(l1,col='blue',add=TRUE) #' plot(st_buffer(l1, dist = 1, nQuadSegs=2), reset = FALSE, main = "nQuadSegs: 2") #' plot(l1,col='blue',add=TRUE) #' plot(st_buffer(l1, dist = 1, nQuadSegs= 5), reset = FALSE, main = "nQuadSegs: 5") #' plot(l1,col='blue',add=TRUE) #' par(op) #' #' #' l2 = st_as_sfc("LINESTRING(0 0,1 5,3 2)") #' op = par(mfrow = c(2, 3)) #' plot(st_buffer(l2, dist = 1, joinStyle="ROUND"), reset = FALSE, main = "joinStyle: ROUND") #' plot(l2, col = 'blue', add = TRUE) #' plot(st_buffer(l2, dist = 1, joinStyle="MITRE"), reset = FALSE, main = "joinStyle: MITRE") #' plot(l2, col= 'blue', add = TRUE) #' plot(st_buffer(l2, dist = 1, joinStyle="BEVEL"), reset = FALSE, main = "joinStyle: BEVEL") #' plot(l2, col= 'blue', add=TRUE) #' plot(st_buffer(l2, dist = 1, joinStyle="MITRE" , mitreLimit=0.5), reset = FALSE, #' main = "mitreLimit: 0.5") #' plot(l2, col = 'blue', add = TRUE) #' plot(st_buffer(l2, dist = 1, joinStyle="MITRE",mitreLimit=1), reset = FALSE, #' main = "mitreLimit: 1") #' plot(l2, col = 'blue', add = TRUE) #' plot(st_buffer(l2, dist = 1, joinStyle="MITRE",mitreLimit=3), reset = FALSE, #' main = "mitreLimit: 3") #' plot(l2, col = 'blue', add = TRUE) #' par(op) #' #' # compare approximation errors depending on S2 or GEOS backend: #' # geographic coordinates, uses S2: #' x = st_buffer(st_as_sf(data.frame(lon=0,lat=0), coords=c("lon","lat"),crs='OGC:CRS84'), #' units::as_units(1,"km")) #' y = units::set_units(st_area(x), "km^2") #' # error: postive, default maxcells = 1000 #' (units::drop_units(y)-pi)/pi #' x = st_buffer(st_as_sf(data.frame(lon=0,lat=0), coords=c("lon","lat"),crs='OGC:CRS84'), #' units::as_units(1,"km"), max_cells=1e5) #' y = units::set_units(st_area(x), "km^2") #' # error: positive but smaller: #' (units::drop_units(y)-pi)/pi #' #' # no CRS set: assumes Cartesian (projected) coordinates #' x = st_buffer(st_as_sf(data.frame(lon=0,lat=0), coords=c("lon","lat")), 1) #' y = st_area(x) #' # error: negative, nQuadSegs default at 30 #' ((y)-pi)/pi #' x = st_buffer(st_as_sf(data.frame(lon=0,lat=0), coords=c("lon","lat")), 1, nQuadSegs = 100) #' y = st_area(x) #' # error: negative but smaller: #' ((y)-pi)/pi st_buffer = function(x, dist, nQuadSegs = 30, endCapStyle = "ROUND", joinStyle = "ROUND", mitreLimit = 1.0, singleSide = FALSE, ...) UseMethod("st_buffer") #' @export st_buffer.sfg = function(x, dist, nQuadSegs = 30, endCapStyle = "ROUND", joinStyle = "ROUND", mitreLimit = 1.0, singleSide = FALSE, ...) get_first_sfg(st_buffer(st_sfc(x), dist, nQuadSegs = nQuadSegs, endCapStyle = endCapStyle, joinStyle = joinStyle, mitreLimit = mitreLimit, singleSide = singleSide, ...)) .process_style_opts = function(endCapStyle, joinStyle, mitreLimit, singleSide) { styls = list(with_styles = FALSE, endCapStyle = NA, joinStyle = NA, mitreLimit = NA) if (endCapStyle == "ROUND" && joinStyle == "ROUND" && mitreLimit == 1 && all(singleSide == FALSE)) return(styls) ecs = match(endCapStyle, c("ROUND", "FLAT", "SQUARE")) js = match(joinStyle, c("ROUND", "MITRE", "BEVEL")) if (is.na(mitreLimit) || !mitreLimit > 0) stop("mitreLimit must be > 0") if (is.na(ecs)) stop("endCapStyle must be 'ROUND', 'FLAT', or 'SQUARE'") if (is.na(js)) stop("joinStyle must be 'ROUND', 'MITRE', or 'BEVEL'") if (anyNA(singleSide)) stop("singleSide should be TRUE or FALSE") styls$with_styles = TRUE styls$endCapStyle = ecs styls$joinStyle = js styls$mitreLimit = mitreLimit styls } #' @export st_buffer.sfc = function(x, dist, nQuadSegs = 30, endCapStyle = "ROUND", joinStyle = "ROUND", mitreLimit = 1.0, singleSide = FALSE, ...) { longlat = isTRUE(st_is_longlat(x)) dist_n = dist if (inherits(dist_n, "units")) dist_n = drop_units(dist_n) if (longlat && sf_use_s2() && all(dist_n >= 0.0)) { # if (!missing(nQuadSegs) || !missing(endCapStyle) || !missing(joinStyle) || # !missing(mitreLimit) || !missing(singleSide)) # warning("all buffer style parameters are ignored; set st_use_s2(FALSE) first to use them") if (inherits(dist, "units")) { if (!inherits(try(units(dist) <- as_units("rad"), silent = TRUE), "try-error")) return(st_as_sfc(s2::s2_buffer_cells(x, dist, radius = 1, ...), crs = st_crs(x))) units(dist) = as_units("m") # make sure has dimension length, possibly convert dist = drop_units(dist) } st_as_sfc(s2::s2_buffer_cells(x, dist, ...), crs = st_crs(x)) } else { if (longlat) { warning("st_buffer does not correctly buffer longitude/latitude data") if (inherits(dist, "units")) units(dist) = as_units("arc_degrees") else message("dist is assumed to be in decimal degrees (arc_degrees).") } else if (inherits(dist, "units")) { if (is.na(st_crs(x))) stop("x does not have a crs set: can't convert units") if (is.null(st_crs(x)$units)) stop("x has a crs without units: can't convert units") if (!is.null(st_crs(x)$ud_unit)) units(dist) = st_crs(x)$ud_unit } dist = rep(dist, length.out = length(x)) nQ = rep(nQuadSegs, length.out = length(x)) styles = .process_style_opts(endCapStyle, joinStyle, mitreLimit, singleSide) if (styles$with_styles) { endCapStyle = rep(styles$endCapStyle, length.out = length(x)) joinStyle = rep(styles$joinStyle, length.out = length(x)) mitreLimit = rep(styles$mitreLimit, length.out = length(x)) singleSide = rep(as.logical(singleSide), length.out = length(x)) if (any(endCapStyle == 2) && any(st_geometry_type(x) == "POINT" | st_geometry_type(x) == "MULTIPOINT")) stop("Flat capstyle is incompatible with POINT/MULTIPOINT geometries") # nocov if (inherits(dist, "units")) dist = drop_units(dist) if (any(dist < 0) && any(st_dimension(x) < 1)) stop("Negative dist values may only be used with 1-D or 2-D geometries") # nocov st_sfc(CPL_geos_op("buffer_with_style", x, dist, nQ, numeric(0), logical(0), endCapStyle = endCapStyle, joinStyle = joinStyle, mitreLimit = mitreLimit, singleside = singleSide)) } else st_sfc(CPL_geos_op("buffer", x, dist, nQ, numeric(0), logical(0))) } } #' @export st_buffer.sf = function(x, dist, nQuadSegs = 30, endCapStyle = "ROUND", joinStyle = "ROUND", mitreLimit = 1.0, singleSide = FALSE, ...) { st_set_geometry(x, st_buffer(st_geometry(x), dist, nQuadSegs, endCapStyle = endCapStyle, joinStyle = joinStyle, mitreLimit = mitreLimit, singleSide = singleSide, ...)) } #' @name geos_unary #' @export #' @details \code{st_boundary} returns the boundary of a geometry st_boundary = function(x) UseMethod("st_boundary") #' @export st_boundary.sfg = function(x) get_first_sfg(st_boundary(st_sfc(x))) #' @export st_boundary.sfc = function(x) st_sfc(CPL_geos_op("boundary", x, numeric(0), integer(0), numeric(0), logical(0))) #' @export st_boundary.sf = function(x) { st_set_geometry(x, st_boundary(st_geometry(x))) } #' @name geos_unary #' @export #' @details \code{st_convex_hull} creates the convex hull of a set of points #' @seealso \link[grDevices]{chull} for a more efficient algorithm for calculating the convex hull #' @examples #' nc = st_read(system.file("shape/nc.shp", package="sf")) #' nc_g = st_geometry(nc) #' plot(st_convex_hull(nc_g)) #' plot(nc_g, border = grey(.5), add = TRUE) #' pt = st_combine(st_sfc(st_point(c(0,80)), st_point(c(120,80)), st_point(c(240,80)))) #' st_convex_hull(pt) # R2 #' st_convex_hull(st_set_crs(pt, 'OGC:CRS84')) # S2 st_convex_hull = function(x) UseMethod("st_convex_hull") #' @export st_convex_hull.sfg = function(x) get_first_sfg(st_convex_hull(st_sfc(x))) #' @export st_convex_hull.sfc = function(x) { if (isTRUE(st_is_longlat(x)) && sf_use_s2()) st_as_sfc(s2::s2_convex_hull(x), crs = st_crs(x)) else st_sfc(CPL_geos_op("convex_hull", x, numeric(0), integer(0), numeric(0), logical(0))) } #' @export st_convex_hull.sf = function(x) { st_set_geometry(x, st_convex_hull(st_geometry(x))) } #' @name geos_unary #' @export #' @details \code{st_concave_hull} creates the concave hull of a geometry #' @param ratio numeric; fraction convex: 1 returns the convex hulls, 0 maximally concave hulls #' @param allow_holes logical; if \code{TRUE}, the resulting concave hull may have holes #' @examples #' set.seed(131) #' if (compareVersion(sf_extSoftVersion()[["GEOS"]], "3.11.0") > -1) { #' pts = cbind(runif(100), runif(100)) #' m = st_multipoint(pts) #' co = sf:::st_concave_hull(m, 0.3) #' coh = sf:::st_concave_hull(m, 0.3, allow_holes = TRUE) #' plot(co, col = 'grey') #' plot(coh, add = TRUE, border = 'red') #' plot(m, add = TRUE) #' } st_concave_hull = function(x, ratio, ..., allow_holes) UseMethod("st_concave_hull") #' @export st_concave_hull.sfg = function(x, ratio, ..., allow_holes = FALSE) get_first_sfg(st_concave_hull(st_sfc(x), ratio, allow_holes)) #' @export st_concave_hull.sfc = function(x, ratio, ..., allow_holes = FALSE) { stopifnot(!missing(ratio), ratio >= 0, ratio <= 1.0, is.logical(allow_holes), !is.na(allow_holes)) st_sfc(CPL_geos_op("concave_hull", x, ratio, integer(0), numeric(0), allow_holes)) } #' @export st_concave_hull.sf = function(x, ratio, ..., allow_holes = FALSE) { st_set_geometry(x, st_concave_hull(st_geometry(x), ratio, allow_holes)) } #' @name geos_unary #' @export #' @details \code{st_simplify} simplifies lines by removing vertices. #' @param preserveTopology logical; carry out topology preserving #' simplification? May be specified for each, or for all feature geometries. #' Note that topology is preserved only for single feature geometries, not for #' sets of them. If not specified (i.e. the default), then it is internally #' set equal to \code{FALSE} when the input data is specified with projected #' coordinates or \code{sf_use_s2()} returns \code{FALSE}. Ignored in all the #' other cases (with a warning when set equal to \code{FALSE}) since the #' function implicitly calls \code{s2::s2_simplify} which always preserve #' topological relationships (per single feature). #' @param dTolerance numeric; tolerance parameter, specified for all or for each #' feature geometry. If you run \code{st_simplify}, the input data is #' specified with long-lat coordinates and \code{sf_use_s2()} returns #' \code{TRUE}, then the value of \code{dTolerance} must be specified in #' meters. #' @examples #' #' # st_simplify examples: #' op = par(mfrow = c(2, 3), mar = rep(0, 4)) #' plot(nc_g[1]) #' plot(st_simplify(nc_g[1], dTolerance = 1e3)) # 1000m #' plot(st_simplify(nc_g[1], dTolerance = 5e3)) # 5000m #' nc_g_planar = st_transform(nc_g, 2264) # planar coordinates, US foot #' plot(nc_g_planar[1]) #' plot(st_simplify(nc_g_planar[1], dTolerance = 1e3)) # 1000 foot #' plot(st_simplify(nc_g_planar[1], dTolerance = 5e3)) # 5000 foot #' par(op) #' st_simplify = function(x, preserveTopology, dTolerance = 0.0) UseMethod("st_simplify") #' @export st_simplify.sfg = function(x, preserveTopology, dTolerance = 0.0) get_first_sfg(st_simplify(st_sfc(x), preserveTopology, dTolerance = dTolerance)) #' @export st_simplify.sfc = function(x, preserveTopology, dTolerance = 0.0) { ll = isTRUE(st_is_longlat(x)) if (ll && sf_use_s2()) { if (!missing(preserveTopology) && isFALSE(preserveTopology)) warning("argument preserveTopology cannot be set to FALSE when working with ellipsoidal coordinates since the algorithm behind st_simplify always preserves topological relationships") if (length(dTolerance) == 1) { st_as_sfc(s2::s2_simplify(x, dTolerance), crs = st_crs(x)) } else { simplify <- function(x, dTolerance) st_as_sfc(s2::s2_simplify(x, dTolerance)) st_as_sfc(mapply(simplify, x, dTolerance), crs = st_crs(x)) } } else { if (missing(preserveTopology)) { preserveTopology = FALSE } stopifnot(mode(preserveTopology) == 'logical') if (ll) warning("st_simplify does not correctly simplify longitude/latitude data, dTolerance needs to be in decimal degrees") st_sfc(CPL_geos_op("simplify", x, numeric(0), integer(0), preserveTopology = rep(preserveTopology, length.out = length(x)), dTolerance = rep(dTolerance, length.out = length(x)))) } } #' @export st_simplify.sf = function(x, preserveTopology, dTolerance = 0.0) { st_set_geometry(x, st_simplify(st_geometry(x), preserveTopology, dTolerance)) } #' @name geos_unary #' @export #' @param bOnlyEdges logical; if \code{TRUE}, return lines, else return polygons #' @details \code{st_triangulate} triangulates set of points (not constrained). \code{st_triangulate} requires GEOS version 3.4 or above st_triangulate = function(x, dTolerance = 0.0, bOnlyEdges = FALSE) UseMethod("st_triangulate") #' @export st_triangulate.sfg = function(x, dTolerance = 0.0, bOnlyEdges = FALSE) get_first_sfg(st_triangulate(st_sfc(x), dTolerance, bOnlyEdges = bOnlyEdges)) #' @export st_triangulate.sfc = function(x, dTolerance = 0.0, bOnlyEdges = FALSE) { if (compareVersion(CPL_geos_version(), "3.4.0") > -1) { # >= ; see https://github.com/r-spatial/sf/issues/1653 if (isTRUE(st_is_longlat(x))) warning("st_triangulate does not correctly triangulate longitude/latitude data") st_sfc(CPL_geos_op("triangulate", x, numeric(0), integer(0), dTolerance = rep(as.double(dTolerance), length.out = length(x)), logical(0), bOnlyEdges = as.integer(bOnlyEdges))) } else stop("for triangulate, GEOS version 3.4.0 or higher is required") } #' @export st_triangulate.sf = function(x, dTolerance = 0.0, bOnlyEdges = FALSE) { st_set_geometry(x, st_triangulate(st_geometry(x), dTolerance, bOnlyEdges)) } #' @name geos_unary #' @export #' @details \code{st_triangulate_constrained} returns the constrained delaunay triangulation of polygons; requires GEOS version 3.10 or above #' @examples #' if (compareVersion(sf_extSoftVersion()[["GEOS"]], "3.10.0") > -1) { #' pts = rbind(c(0,0), c(1,0), c(1,1), c(.5,.5), c(0,1), c(0,0)) #' po = st_polygon(list(pts)) #' co = st_triangulate_constrained(po) #' tr = st_triangulate(po) #' plot(po, col = NA, border = 'grey', lwd = 15) #' plot(tr, border = 'green', col = NA, lwd = 5, add = TRUE) #' plot(co, border = 'red', col = 'NA', add = TRUE) #' } st_triangulate_constrained = function(x) UseMethod("st_triangulate_constrained") #' @export st_triangulate_constrained.sfg = function(x) get_first_sfg(st_triangulate_constrained(st_sfc(x))) #' @export st_triangulate_constrained.sfc = function(x) { if (compareVersion(CPL_geos_version(), "3.10.0") > -1) { # >= ; see https://github.com/r-spatial/sf/issues/1653 if (isTRUE(st_is_longlat(x))) warning("st_triangulate does not correctly triangulate longitude/latitude data") st_sfc(CPL_geos_op("triangulate_constrained", x, numeric(0), integer(0), numeric(0), logical(0))) } else stop("for triangulate_constrained, GEOS version 3.10.0 or higher is required") } #' @export st_triangulate_constrained.sf = function(x) { st_set_geometry(x, st_triangulate_constrained(st_geometry(x))) } #' @name geos_unary #' @export #' @details \code{st_inscribed_circle} returns the maximum inscribed circle for polygon geometries. #' For \code{st_inscribed_circle}, if \code{nQuadSegs} is 0 a 2-point LINESTRING is returned with the #' center point and a boundary point of every circle, otherwise a circle (buffer) is returned where #' \code{nQuadSegs} controls the number of points per quadrant to approximate the circle. #' \code{st_inscribed_circle} requires GEOS version 3.9 or above #' @examples #' if (compareVersion(sf_extSoftVersion()[["GEOS"]], "3.9.0") > -1) { #' nc_t = st_transform(nc, 'EPSG:2264') #' x = st_inscribed_circle(st_geometry(nc_t)) #' plot(st_geometry(nc_t), asp = 1, col = grey(.9)) #' plot(x, add = TRUE, col = '#ff9999') #' } st_inscribed_circle = function(x, dTolerance, ...) UseMethod("st_inscribed_circle") #' @export st_inscribed_circle.sfg = function(x, dTolerance, ...) { get_first_sfg(st_inscribed_circle(st_sfc(x), dTolerance, ...)) } #' @export st_inscribed_circle.sfc = function(x, dTolerance = sqrt(st_area(st_set_crs(x, NA_crs_)))/1000, ..., nQuadSegs = 30) { if (compareVersion(CPL_geos_version(), "3.9.0") > -1) { # >= if (isTRUE(st_is_longlat(x))) warning("st_inscribed_circle does not work correctly for longitude/latitude data") nQ = rep(nQuadSegs, length.out = length(x)) ret = st_sfc(CPL_geos_op("inscribed_circle", x, nQ, integer(0), dTolerance = rep(as.double(dTolerance), length.out = length(x)), logical(0), bOnlyEdges = as.integer(FALSE))) if (any(nQuadSegs > 0)) { pts = st_cast(ret, "POINT") idx = seq(1, length(pts) * 2, by = 2) ret = st_buffer(pts[idx], st_length(st_set_crs(ret, NA_crs_)), nQuadSegs = nQuadSegs) } ret } else stop("for st_inscribed_circle, GEOS version 3.9.0 or higher is required") } #' @export st_inscribed_circle.sf = function(x, dTolerance, ...) { st_set_geometry(x, st_inscribed_circle(st_geometry(x), dTolerance), ...) } #' @name geos_unary #' @details \code{st_minimum_rotated_rectangle} returns the minimum #' rotated rectangular POLYGON which encloses the input geometry. The #' rectangle has width equal to the minimum diameter, and a longer #' length. If the convex hill of the input is degenerate (a line or #' point) a linestring or point is returned. #' @export st_minimum_rotated_rectangle = function(x, ...) UseMethod("st_minimum_rotated_rectangle") #' @export st_minimum_rotated_rectangle.sfg = function(x, ...) { get_first_sfg(st_minimum_rotated_rectangle(st_sfc(x), ...)) } #' @export st_minimum_rotated_rectangle.sfc = function(x, ...) { if (compareVersion(CPL_geos_version(), "3.9.0") > -1) { # >= if (isTRUE(st_is_longlat(x))) warning("st_minimum_rotated_rectangle does not work correctly for longitude/latitude data") st_sfc(CPL_geos_op("minimum_rotated_rectangle", x, 0L, integer(0), dTolerance = 0., logical(0), bOnlyEdges = as.integer(FALSE))) } else stop("for st_minimum_rotated_rectangle, GEOS version 3.9.0 or higher is required") } #' @export st_minimum_rotated_rectangle.sf = function(x, dTolerance, ...) { st_set_geometry(x, st_minimum_rotated_rectangle(st_geometry(x)), ...) } #' @name geos_unary #' @details \code{st_minimum_bounding_circle} #' returns a geometry which represents the "minimum bounding circle", #' the smallest circle that contains the input. #' @export st_minimum_bounding_circle = function(x, ...) UseMethod("st_minimum_bounding_circle") #' @export st_minimum_bounding_circle.sfg = function(x, ...) { get_first_sfg(st_minimum_bounding_circle(st_sfc(x), ...)) } #' @export st_minimum_bounding_circle.sfc = function(x, ...) { if (compareVersion(CPL_geos_version(), "3.8.0") > -1) { # >= if (isTRUE(st_is_longlat(x))) warning("st_minimum_rotated_rectangle does not work correctly for longitude/latitude data") st_sfc(CPL_geos_op("bounding_circle", x, 0L, integer(0), dTolerance = 0., logical(0), bOnlyEdges = as.integer(FALSE))) } else stop("for st_minimum_bounding_circle, GEOS version 3.8.0 or higher is required") } #' @export st_minimum_bounding_circle.sf = function(x, ...) { st_set_geometry(x, st_minimum_bounding_circle(st_geometry(x)), ...) } #' @name geos_unary #' @export #' @param envelope object of class \code{sfc} or \code{sfg} containing a \code{POLYGON} with the envelope for a voronoi diagram; this only takes effect when it is larger than the default envelope, chosen when \code{envelope} is an empty polygon #' @param point_order logical; preserve point order if TRUE and GEOS version >= 3.12; overrides bOnlyEdges #' @details \code{st_voronoi} creates voronoi tessellation. \code{st_voronoi} requires GEOS version 3.5 or above #' @examples #' set.seed(1) #' x = st_multipoint(matrix(runif(10),,2)) #' box = st_polygon(list(rbind(c(0,0),c(1,0),c(1,1),c(0,1),c(0,0)))) #' if (compareVersion(sf_extSoftVersion()[["GEOS"]], "3.5.0") > -1) { #' v = st_sfc(st_voronoi(x, st_sfc(box))) #' plot(v, col = 0, border = 1, axes = TRUE) #' plot(box, add = TRUE, col = 0, border = 1) # a larger box is returned, as documented #' plot(x, add = TRUE, col = 'red', cex=2, pch=16) #' plot(st_intersection(st_cast(v), box)) # clip to smaller box #' plot(x, add = TRUE, col = 'red', cex=2, pch=16) #' # matching Voronoi polygons to data points: #' # https://github.com/r-spatial/sf/issues/1030 #' # generate 50 random unif points: #' n = 100 #' pts = st_as_sf(data.frame(matrix(runif(n), , 2), id = 1:(n/2)), coords = c("X1", "X2")) #' # compute Voronoi polygons: #' pols = st_collection_extract(st_voronoi(do.call(c, st_geometry(pts)))) #' # match them to points: #' pts_pol = st_intersects(pts, pols) #' pts$pols = pols[unlist(pts_pol)] # re-order #' if (isTRUE(try(compareVersion(sf_extSoftVersion()["GEOS"], "3.12.0") > -1, #' silent = TRUE))) { #' pols_po = st_collection_extract(st_voronoi(do.call(c, st_geometry(pts)), #' point_order = TRUE)) # GEOS >= 3.12 can preserve order of inputs #' pts_pol_po = st_intersects(pts, pols_po) #' print(all(unlist(pts_pol_po) == 1:(n/2))) #' } #' plot(pts["id"], pch = 16) # ID is color #' plot(st_set_geometry(pts, "pols")["id"], xlim = c(0,1), ylim = c(0,1), reset = FALSE) #' plot(st_geometry(pts), add = TRUE) #' layout(matrix(1)) # reset plot layout #' } st_voronoi = function(x, envelope, dTolerance = 0.0, bOnlyEdges = FALSE, point_order = FALSE) UseMethod("st_voronoi") #' @export st_voronoi.sfg = function(x, envelope = st_polygon(), dTolerance = 0.0, bOnlyEdges = FALSE, point_order = FALSE) get_first_sfg(st_voronoi(st_sfc(x), st_sfc(envelope), dTolerance, bOnlyEdges = bOnlyEdges, point_order = point_order)) #' @export st_voronoi.sfc = function(x, envelope = st_polygon(), dTolerance = 0.0, bOnlyEdges = FALSE, point_order = FALSE) { if (compareVersion(CPL_geos_version(), "3.5.0") > -1) { if (isTRUE(st_is_longlat(x))) warning("st_voronoi does not correctly triangulate longitude/latitude data") if (point_order) { if (compareVersion(CPL_geos_version(), "3.12.0") > -1) bOnlyEdges = 2L # GEOS enum GEOS_VORONOI_PRESERVE_ORDER else warning("Point order retention not supported for GEOS ", CPL_geos_version()) } st_sfc(CPL_geos_voronoi(x, st_sfc(envelope), dTolerance = dTolerance, bOnlyEdges = as.integer(bOnlyEdges))) } else stop("for voronoi, GEOS version 3.5.0 or higher is required") } #' @export st_voronoi.sf = function(x, envelope = st_polygon(), dTolerance = 0.0, bOnlyEdges = FALSE, point_order = FALSE) { st_set_geometry(x, st_voronoi(st_geometry(x), st_sfc(envelope), dTolerance, bOnlyEdges = bOnlyEdges, point_order = point_order)) } #' @name geos_unary #' @details \code{st_polygonize} creates a polygon from lines that form a closed ring. In case of \code{st_polygonize}, \code{x} must be an object of class \code{LINESTRING} or \code{MULTILINESTRING}, or an \code{sfc} geometry list-column object containing these #' @export #' @examples #' mls = st_multilinestring(list(matrix(c(0,0,0,1,1,1,0,0),,2,byrow=TRUE))) #' st_polygonize(st_sfc(mls)) st_polygonize = function(x) UseMethod("st_polygonize") #' @export st_polygonize.sfg = function(x) get_first_sfg(st_polygonize(st_sfc(x))) #' @export st_polygonize.sfc = function(x) { stopifnot(inherits(x, "sfc_LINESTRING") || inherits(x, "sfc_MULTILINESTRING")) st_sfc(CPL_geos_op("polygonize", x, numeric(0), integer(0), numeric(0), logical(0))) } #' @export st_polygonize.sf = function(x) { st_set_geometry(x, st_polygonize(st_geometry(x))) } #' @name geos_unary #' @export #' @param directed logical; if \code{TRUE}, lines with opposite directions will not be merged #' @details \code{st_line_merge} merges lines. In case of \code{st_line_merge}, \code{x} must be an object of class \code{MULTILINESTRING}, or an \code{sfc} geometry list-column object containing these #' @examples #' mls = st_multilinestring(list(rbind(c(0,0), c(1,1)), rbind(c(2,0), c(1,1)))) #' st_line_merge(st_sfc(mls)) st_line_merge = function(x, ..., directed = FALSE) UseMethod("st_line_merge") #' @export st_line_merge.sfg = function(x, ..., directed = FALSE) get_first_sfg(st_line_merge(st_sfc(x), directed = directed, ...)) #' @export st_line_merge.sfc = function(x, ..., directed = FALSE) { stopifnot(inherits(x, "sfc_MULTILINESTRING")) if (directed) st_sfc(CPL_geos_op("linemergedirected", x, numeric(0), integer(0), numeric(0), logical(0))) else st_sfc(CPL_geos_op("linemerge", x, numeric(0), integer(0), numeric(0), logical(0))) } #' @export st_line_merge.sf = function(x, ..., directed = FALSE) { st_set_geometry(x, st_line_merge(st_geometry(x), directed = directed, ...)) } #' @name geos_unary #' @param of_largest_polygon logical; for \code{st_centroid}: if \code{TRUE}, return centroid of the largest (sub)polygon of a \code{MULTIPOLYGON} rather than of the whole \code{MULTIPOLYGON} #' @export #' @details \code{st_centroid} gives the centroid of a geometry #' @examples #' plot(nc_g, axes = TRUE) #' plot(st_centroid(nc_g), add = TRUE, pch = 3, col = 'red') #' mp = st_combine(st_buffer(st_sfc(lapply(1:3, function(x) st_point(c(x,x)))), 0.2 * 1:3)) #' plot(mp) #' plot(st_centroid(mp), add = TRUE, col = 'red') # centroid of combined geometry #' plot(st_centroid(mp, of_largest_polygon = TRUE), add = TRUE, col = 'blue', pch = 3) st_centroid = function(x, ..., of_largest_polygon = FALSE) UseMethod("st_centroid") #' @export st_centroid.sfg = function(x, ..., of_largest_polygon = FALSE) get_first_sfg(st_centroid(st_sfc(x), of_largest_polygon = of_largest_polygon)) largest_ring = function(x) { pols = st_cast(x, "POLYGON", warn = FALSE) stopifnot(! is.null(attr(pols, "ids"))) areas = st_area(pols) spl = split(areas, rep(seq_along(x), attr(pols, "ids"))) # group by x l = c(0, head(cumsum(lengths(spl)), -1)) # 0-based indexes of first rings of a MULTIPOLYGON i = l + sapply(spl, which.max) # add relative index of largest ring st_sfc(pols[i], crs = st_crs(x)) } #' @export st_centroid.sfc = function(x, ..., of_largest_polygon = FALSE) { if (of_largest_polygon) { multi = which(sapply(x, inherits, what = "MULTIPOLYGON") & lengths(x) > 1) if (length(multi)) x[multi] = largest_ring(x[multi]) } longlat = isTRUE(st_is_longlat(x)) if (longlat && sf_use_s2()) st_as_sfc(s2::s2_centroid(x), crs = st_crs(x)) else { if (longlat) warning("st_centroid does not give correct centroids for longitude/latitude data") st_sfc(CPL_geos_op("centroid", x, numeric(0), integer(0), numeric(0), logical(0))) } } #' @export st_centroid.sf = function(x, ..., of_largest_polygon = FALSE) { if (any(st_dimension(x) > 0) && !all_constant(x)) warning("st_centroid assumes attributes are constant over geometries", call. = FALSE) ret = st_set_geometry(x, st_centroid(st_geometry(x), of_largest_polygon = of_largest_polygon)) agr = st_agr(ret) agr[ agr == "identity" ] = "constant" st_set_agr(ret, agr) } #' @name geos_unary #' @export #' @details \code{st_point_on_surface} returns a point guaranteed to be on the (multi)surface. #' @examples #' plot(nc_g, axes = TRUE) #' plot(st_point_on_surface(nc_g), add = TRUE, pch = 3, col = 'red') st_point_on_surface = function(x) UseMethod("st_point_on_surface") #' @export st_point_on_surface.sfg = function(x) get_first_sfg(st_point_on_surface(st_sfc(x))) #' @export st_point_on_surface.sfc = function(x) { if (isTRUE(st_is_longlat(x))) warning("st_point_on_surface may not give correct results for longitude/latitude data") st_sfc(CPL_geos_op("point_on_surface", x, numeric(0), integer(0), numeric(0), logical(0))) } #' @export st_point_on_surface.sf = function(x) { if (any(st_dimension(x) > 0) && !all_constant(x)) warning("st_point_on_surface assumes attributes are constant over geometries", call. = FALSE) st_set_geometry(x, st_point_on_surface(st_geometry(x))) } #' @name geos_unary #' @export #' @details \code{st_reverse} reverses the nodes in a line #' @examples #' if (compareVersion(sf_extSoftVersion()[["GEOS"]], "3.7.0") > -1) { #' st_reverse(st_linestring(rbind(c(1,1), c(2,2), c(3,3)))) #' } #nocov start st_reverse = function(x) UseMethod("st_reverse") #' @export st_reverse.sfg = function(x) get_first_sfg(st_reverse(st_sfc(x))) #' @export st_reverse.sfc = function(x) { st_sfc(CPL_geos_op("reverse", x, numeric(0), integer(0), numeric(0), logical(0))) } #' @export st_reverse.sf = function(x) { st_set_geometry(x, st_reverse(st_geometry(x))) } #nocov end #' @name geos_unary #' @export #' @details \code{st_node} adds nodes to linear geometries at intersections without a node, and only works on individual linear geometries #' @examples #' (l = st_linestring(rbind(c(0,0), c(1,1), c(0,1), c(1,0), c(0,0)))) #' st_polygonize(st_node(l)) #' st_node(st_multilinestring(list(rbind(c(0,0), c(1,1), c(0,1), c(1,0), c(0,0))))) st_node = function(x) UseMethod("st_node") #' @export st_node.sfg = function(x) get_first_sfg(st_node(st_sfc(x))) #' @export st_node.sfc = function(x) { dims = st_dimension(x) if (!all(is.na(dims) || dims == 1)) stop("st_node: all geometries should be linear") if (isTRUE(st_is_longlat(x))) warning("st_node may not give correct results for longitude/latitude data") st_sfc(CPL_geos_op("node", x, numeric(0), integer(0), numeric(0), logical(0))) } #' @export st_node.sf = function(x) { st_set_geometry(x, st_node(st_geometry(x))) } #' @name geos_unary #' @details \code{st_segmentize} adds points to straight lines #' @export #' @param dfMaxLength maximum length of a line segment. If \code{x} has geographical coordinates (long/lat), \code{dfMaxLength} is either a numeric expressed in meter, or an object of class \code{units} with length units \code{rad} or \code{degree}; segmentation in the long/lat case takes place along the great circle, using \link[lwgeom:geod]{st_geod_segmentize}. #' @examples #' sf = st_sf(a=1, geom=st_sfc(st_linestring(rbind(c(0,0),c(1,1)))), crs = 4326) #' if (require(lwgeom, quietly = TRUE)) { #' seg = st_segmentize(sf, units::set_units(100, km)) #' seg = st_segmentize(sf, units::set_units(0.01, rad)) #' nrow(seg$geom[[1]]) #' } st_segmentize = function(x, dfMaxLength, ...) UseMethod("st_segmentize") #' @export st_segmentize.sfg = function(x, dfMaxLength, ...) get_first_sfg(st_segmentize(st_sfc(x), dfMaxLength, ...)) #' @export st_segmentize.sfc = function(x, dfMaxLength, ...) { if (isTRUE(st_is_longlat(x))) { if (! requireNamespace("lwgeom", quietly = TRUE)) stop("package lwgeom required, please install it first") if (! inherits(dfMaxLength, "units")) units(dfMaxLength) = as_units("m") lwgeom::st_geod_segmentize(x, dfMaxLength) # takes care of rad or degree units } else { if (! is.na(st_crs(x)) && inherits(dfMaxLength, "units")) units(dfMaxLength) = units(st_crs(x)$SemiMajor) # might convert st_sfc(CPL_gdal_segmentize(x, dfMaxLength), crs = st_crs(x)) } } #' @export st_segmentize.sf = function(x, dfMaxLength, ...) { st_set_geometry(x, st_segmentize(st_geometry(x), dfMaxLength, ...)) } #' Combine or union feature geometries #' #' Combine several feature geometries into one, without unioning or resolving internal boundaries #' @name geos_combine #' @param x object of class \code{sf}, \code{sfc} or \code{sfg} #' @return \code{st_combine} returns a single, combined geometry, with no resolved boundaries; returned geometries may well be invalid. #' @export #' @details \code{st_combine} combines geometries without resolving borders, using \link{c.sfg} (analogous to \link[base]{c} for ordinary vectors). #' @examples #' nc = st_read(system.file("shape/nc.shp", package="sf")) #' st_combine(nc) st_combine = function(x) st_sfc(do.call(c, st_geometry(x)), crs = st_crs(x)) # flatten/merge # x: object of class sf # y: object of class sf or sfc # geoms: result from geos_op2: list of non-empty geometries with the intersection/union/difference/sym_difference # which has an idx attribute pointing to what is x, what is y geos_op2_df = function(x, y, geoms) { idx = attr(geoms, "idx") attr(geoms, "idx") = NULL all_constant_x = all_constant_y = TRUE all_constant_x = all_constant(x) df = x[idx[,1],,drop = FALSE] st_geometry(df) = NULL if (inherits(y, "sf")) { all_constant_y = all_constant(y) st_geometry(y) = NULL df = data.frame(df, y[idx[,2], , drop = FALSE]) } if (! (all_constant_x && all_constant_y)) warning("attribute variables are assumed to be spatially constant throughout all geometries", call. = FALSE) if (inherits(x, "tbl_df")) { if (!requireNamespace("tibble", quietly = TRUE)) stop("package tibble required: install first?") df = tibble::new_tibble(df, nrow = nrow(df), class = "sf") } df[[ attr(x, "sf_column") ]] = geoms st_sf(df, sf_column_name = attr(x, "sf_column")) } # after checking identical crs, # call geos_op2 function op on x and y: # DE-9IM compliant should use model = "closed", more robust seems: geos_op2_geom = function(op, x, y, ..., by_element = FALSE, model = "semi-open") { stopifnot(st_crs(x) == st_crs(y)) x = st_geometry(x) y = st_geometry(y) longlat = isTRUE(st_is_longlat(x)) if (by_element) { stopifnot(length(x) == length(y)) if (longlat && sf_use_s2()) { fn = switch(op, intersection = s2::s2_intersection, difference = s2::s2_difference, sym_difference = s2::s2_sym_difference, union = s2::s2_union, stop("invalid operator")) st_as_sfc(fn(x, y, s2::s2_options(model = model, ...)), crs = st_crs(x)) } else { if (longlat) message_longlat(paste0("st_", op)) st_sfc(CPL_geos_op2_by_element(op, x, y), crs = st_crs(x)) } } else { if (longlat && sf_use_s2()) { fn = switch(op, intersection = s2::s2_intersection, difference = s2::s2_difference, sym_difference = s2::s2_sym_difference, union = s2::s2_union, stop("invalid operator")) # to be optimized -- this doesn't index on y: lst = structure(unlist(lapply(y, function(yy) fn(x, yy, s2::s2_options(model = model, ...))), recursive = FALSE), class = "s2_geography") e = s2::s2_is_empty(lst) idx = cbind(rep(seq_along(x), length(y)), rep(seq_along(y), each = length(x))) lst = st_as_sfc(lst, crs = st_crs(x)) structure(lst[!e], idx = idx[!e,,drop = FALSE]) } else { if (longlat) message_longlat(paste0("st_", op)) st_sfc(CPL_geos_op2(op, x, y), crs = st_crs(x)) } } } # return first sfg, or empty geometry in case of zero features get_first_sfg = function(x) { if (length(x) == 0) st_geometrycollection() else x[[1]] } #' Geometric operations on pairs of simple feature geometry sets #' #' Perform geometric set operations with simple feature geometry collections #' @name geos_binary_ops #' @param x object of class \code{sf}, \code{sfc} or \code{sfg} #' @param y object of class \code{sf}, \code{sfc} or \code{sfg} #' @param ... arguments passed on to \link[s2]{s2_options} #' @param by_element logical; if `TRUE`, return pair-wise computed geometries, rather than set-wise; can be used for all binary operations #' @export #' @return The intersection, difference or symmetric difference between two sets of geometries. #' The returned object has the same class as that of the first argument (\code{x}) with the non-empty geometries resulting from applying the operation to all geometry pairs in \code{x} and \code{y}. In case \code{x} is of class \code{sf}, the matching attributes of the original object(s) are added. The \code{sfc} geometry list-column returned carries an attribute \code{idx}, which is an \code{n}-by-2 matrix with every row the index of the corresponding entries of \code{x} and \code{y}, respectively. #' @details When using GEOS and not using s2, a spatial index is built on argument \code{x}; see \url{https://r-spatial.org/r/2017/06/22/spatial-index.html}. The reference for the STR tree algorithm is: Leutenegger, Scott T., Mario A. Lopez, and Jeffrey Edgington. "STR: A simple and efficient algorithm for R-tree packing." Data Engineering, 1997. Proceedings. 13th international conference on. IEEE, 1997. For the pdf, search Google Scholar. #' @seealso \link{st_union} for the union of simple features collections; \link{intersect} and \link{setdiff} for the base R set operations. #' @export #' @note To find whether pairs of simple feature geometries intersect, use #' the function \code{\link{st_intersects}} instead of \code{st_intersection}. #' #' When using GEOS and not using s2 polygons contain their boundary. When using s2 this is determined by the \code{model} defaults of \link[s2]{s2_options}, which can be overridden via the ... argument, e.g. \code{model = "closed"} to force DE-9IM compliant behaviour of polygons (and reproduce GEOS results). #' @examples #' set.seed(131) #' library(sf) #' m = rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0)) #' p = st_polygon(list(m)) #' n = 100 #' l = vector("list", n) #' for (i in 1:n) #' l[[i]] = p + 10 * runif(2) #' s = st_sfc(l) #' plot(s, col = sf.colors(categorical = TRUE, alpha = .5)) #' title("overlapping squares") #' d = st_difference(s) # sequential differences: s1, s2-s1, s3-s2-s1, ... #' plot(d, col = sf.colors(categorical = TRUE, alpha = .5)) #' title("non-overlapping differences") #' i = st_intersection(s) # all intersections #' plot(i, col = sf.colors(categorical = TRUE, alpha = .5)) #' title("non-overlapping intersections") #' summary(lengths(st_overlaps(s, s))) # includes self-counts! #' summary(lengths(st_overlaps(d, d))) #' summary(lengths(st_overlaps(i, i))) #' sf = st_sf(s) #' i = st_intersection(sf) # all intersections #' plot(i["n.overlaps"]) #' summary(i$n.overlaps - lengths(i$origins)) st_intersection = function(x, y, ..., by_element = FALSE) UseMethod("st_intersection") #' @export st_intersection.sfg = function(x, y, ...) get_first_sfg(geos_op2_geom("intersection", x, y, ...)) #' @name geos_binary_ops #' @export #' @details When called with missing \code{y}, the \code{sfc} method for \code{st_intersection} returns all non-empty intersections of the geometries of \code{x}; an attribute \code{idx} contains a list-column with the indexes of contributing geometries. st_intersection.sfc = function(x, y, ...) { if (missing(y)) { if (isTRUE(st_is_longlat(x))) message_longlat("st_intersection") ret = CPL_nary_intersection(x) structure(st_sfc(ret), idx = attr(ret, "idx")) } else geos_op2_geom("intersection", x, y, ...) } #' @name geos_binary_ops #' @export #' @details when called with a missing \code{y}, the \code{sf} method for \code{st_intersection} returns an \code{sf} object with attributes taken from the contributing feature with lowest index; two fields are added: \code{n.overlaps} with the number of overlapping features in \code{x}, and a list-column \code{origins} with indexes of all overlapping features. st_intersection.sf = function(x, y, ...) { if (missing(y)) { geom = st_intersection(st_geometry(x), ...) idx = attr(geom, "idx") i = sapply(idx, function(i) i[1]) sf_column = attr(x, "sf_column") st_geometry(x) = NULL x = x[i, , drop = FALSE] x$n.overlaps = lengths(idx) x$origins = idx x[[ sf_column ]] = structure(geom, idx = NULL) st_sf(x) } else geos_op2_df(x, y, geos_op2_geom("intersection", x, y, ...)) } #' @name geos_binary_ops #' @export #' @examples #' # A helper function that erases all of y from x: #' st_erase = function(x, y) st_difference(x, st_union(st_combine(y))) st_difference = function(x, y, ...) UseMethod("st_difference") #' @export st_difference.sfg = function(x, y, ...) get_first_sfg(geos_op2_geom("difference", x, y, ...)) #' @name geos_binary_ops #' @export #' @details When \code{st_difference} is called with a single argument, #' overlapping areas are erased from geometries that are indexed at greater #' numbers in the argument to \code{x}; geometries that are empty #' or contained fully inside geometries with higher priority are removed entirely. #' The \code{st_difference.sfc} method with a single argument returns an object with #' an \code{"idx"} attribute with the original index for returned geometries. st_difference.sfc = function(x, y, ...) { if (missing(y)) { if (isTRUE(st_is_longlat(x))) message_longlat("st_difference") ret = CPL_nary_difference(x) structure(st_sfc(ret), ret = attr(ret, "idx")) } else geos_op2_geom("difference", x, y, ...) } #' @export st_difference.sf = function(x, y, ...) { if (missing(y)) { geom = st_difference(st_geometry(x)) sf_column = attr(x, "sf_column") st_geometry(x) = NULL x = x[attr(geom, "idx"), , drop=FALSE] x[[ sf_column ]] = structure(geom, idx = NULL) st_sf(x) } else geos_op2_df(x, y, geos_op2_geom("difference", x, y, ...)) } #' @name geos_binary_ops #' @export st_sym_difference = function(x, y, ...) UseMethod("st_sym_difference") #' @export st_sym_difference.sfg = function(x, y, ...) get_first_sfg(geos_op2_geom("sym_difference", x, y, ...)) #' @export st_sym_difference.sfc = function(x, y, ...) geos_op2_geom("sym_difference", x, y, ...) #' @export st_sym_difference.sf = function(x, y, ...) geos_op2_df(x, y, geos_op2_geom("sym_difference", x, y, ...)) #' @name geos_binary_ops #' @param tolerance tolerance values used for \code{st_snap}; numeric value or object of class \code{units}; may have tolerance values for each feature in \code{x} #' @details \code{st_snap} snaps the vertices and segments of a geometry to another geometry's vertices. If \code{y} contains more than one geometry, its geometries are merged into a collection before snapping to that collection. #' #' (from the GEOS docs:) "A snap distance tolerance is used to control where snapping is performed. Snapping one geometry to another can improve robustness for overlay operations by eliminating nearly-coincident edges (which cause problems during noding and intersection calculation). Too much snapping can result in invalid topology being created, so the number and location of snapped vertices is decided using heuristics to determine when it is safe to snap. This can result in some potential snaps being omitted, however." #' @examples #' poly = st_polygon(list(cbind(c(0, 0, 1, 1, 0), c(0, 1, 1, 0, 0)))) #' lines = st_multilinestring(list( #' cbind(c(0, 1), c(1, 1.05)), #' cbind(c(0, 1), c(0, -.05)), #' cbind(c(1, .95, 1), c(1.05, .5, -.05)) #' )) #' snapped = st_snap(poly, lines, tolerance=.1) #' plot(snapped, col='red') #' plot(poly, border='green', add=TRUE) #' plot(lines, lwd=2, col='blue', add=TRUE) #' @export st_snap = function(x, y, tolerance) UseMethod("st_snap") #' @export st_snap.sfg = function(x, y, tolerance) get_first_sfg(st_snap(st_sfc(x), y, tolerance)) #' @export st_snap.sfc = function(x, y, tolerance) { if (isTRUE(st_is_longlat(x))) stop("st_snap for longitude/latitude data not supported; use st_transform first?") else if (inherits(tolerance, "units") && !is.null(st_crs(x)$ud_unit)) units(tolerance) = st_crs(x)$ud_unit # coordinate units tolerance = rep(tolerance, length.out = length(x)) st_sfc(CPL_geos_snap(st_geometry(x), st_geometry(y), as.double(tolerance))) } #' @export st_snap.sf = function(x, y, tolerance) st_set_geometry(x, st_snap(st_geometry(x), st_geometry(y), tolerance)) #' @name geos_combine #' @export #' @param by_feature logical; if `TRUE`, union each feature if \code{y} is missing or else each pair of features; if `FALSE` return a single feature that is the geometric union of the set of features in \code{x} if \code{y} is missing, or else the unions of each of the elements of the Cartesian product of both sets #' @param is_coverage logical; if `TRUE`, use an optimized algorithm for features that form a polygonal coverage (have no overlaps) #' @param y object of class \code{sf}, \code{sfc} or \code{sfg} (optional) #' @param ... ignored #' @seealso \link{st_intersection}, \link{st_difference}, \link{st_sym_difference} #' @return If \code{y} is missing, \code{st_union(x)} returns a single geometry with resolved boundaries, else the geometries for all unioned pairs of `x[i]` and `y[j]`. #' @details #' If \code{st_union} is called with a single argument, \code{x}, (with \code{y} missing) and \code{by_feature} is \code{FALSE} all geometries are unioned together and an \code{sfg} or single-geometry \code{sfc} object is returned. #' If \code{by_feature} is \code{TRUE} each feature geometry is unioned individually. #' This can for instance be used to resolve internal boundaries after polygons were combined using \code{st_combine}. #' If \code{y} is provided, all elements of \code{x} and \code{y} are unioned, pairwise if \code{by_feature} is TRUE, or else as the Cartesian product of both sets. #' #' Unioning a set of overlapping polygons has the effect of merging the areas (i.e. the same effect as iteratively unioning all individual polygons together). #' Unioning a set of LineStrings has the effect of fully noding and dissolving the input linework. In this context "fully noded" means that there will be a node or endpoint in the output for every endpoint or line segment crossing in the input. #' "Dissolved" means that any duplicate (e.g. coincident) line segments or portions of line segments will be reduced to a single line segment in the output. Unioning a set of Points has the effect of merging all identical points (producing a set with no duplicates). #' @examples #' plot(st_union(nc)) st_union = function(x, y, ..., by_feature = FALSE, is_coverage = FALSE) UseMethod("st_union") #' @export st_union.sfg = function(x, y, ..., by_feature = FALSE, is_coverage = FALSE) { out = if (missing(y)) # unary union, possibly by_feature: st_sfc(CPL_geos_union(st_geometry(x), by_feature, is_coverage)) else st_union(st_geometry(x), st_geometry(y)) get_first_sfg(out) } #' @export st_union.sfc = function(x, y, ..., by_feature = isTRUE(list(...)$by_element), is_coverage = FALSE) { ll = isTRUE(st_is_longlat(x)) if (missing(y)) { # unary union, possibly by_feature: if (ll && sf_use_s2()) { if (! by_feature) { # see https://github.com/r-spatial/s2/issues/97 : if (is_coverage) st_as_sfc(s2::s2_coverage_union_agg(x, ...), crs = st_crs(x)) else st_as_sfc(s2::s2_union_agg(x, ...), crs = st_crs(x)) } else st_as_sfc(s2::s2_union(x, ...), crs = st_crs(x)) } else { if (ll) message_longlat("st_union") st_sfc(CPL_geos_union(x, by_feature, is_coverage)) } } else { y = st_geometry(y) stopifnot(st_crs(x) == st_crs(y)) if (is_coverage) message("in st_union(), is_coverage is ignored when y is given") if (by_feature) stopifnot(length(x) == length(y)) if (ll && sf_use_s2()) { if (by_feature) st_as_sfc(s2::s2_union(x, y, ...), crs = st_crs(x)) else { i = rep(seq_along(x), each = length(y)) j = rep(seq_along(y), length(x)) st_as_sfc(s2::s2_union(x[i], y[j], ...), crs = st_crs(x), precision = st_precision(x)) } } else { if (ll) message_longlat("st_union") if (by_feature) # old-style: in case by_element is not specified geos_op2_geom("union", x, y, by_element = TRUE, ...) else geos_op2_geom("union", x, y, ...) # handles by_element } } } #' @export st_union.sf = function(x, y, ..., by_feature = FALSE, is_coverage = FALSE) { if (missing(y)) { # unary union, possibly by_feature: geom = st_union(st_geometry(x), ..., by_feature = by_feature, is_coverage = is_coverage) if (by_feature) st_set_geometry(x, geom) else geom } else { if (by_feature) { df = cbind(st_drop_geometry(x), st_drop_geometry(y)) st_set_geometry(df, st_union(st_geometry(x), st_geometry(y), is_coverage = is_coverage)) } else geos_op2_df(x, y, geos_op2_geom("union", x, y, ...)) } } #' Sample points on a linear geometry #' @param x object of class \code{sf}, \code{sfc} or \code{sfg} #' @param n integer; number of points to choose per geometry; if missing, n will be computed as \code{round(density * st_length(geom))}. #' @param density numeric; density (points per distance unit) of the sampling, possibly a vector of length equal to the number of features (otherwise recycled); \code{density} may be of class \code{units}. #' @param type character; indicate the sampling type, either "regular" or "random" #' @param sample numeric; a vector of numbers between 0 and 1 indicating the points to sample - if defined sample overrules n, density and type. #' @export #' @examples #' ls = st_sfc(st_linestring(rbind(c(0,0),c(0,1))), #' st_linestring(rbind(c(0,0),c(10,0)))) #' st_line_sample(ls, density = 1) #' ls = st_sfc(st_linestring(rbind(c(0,0),c(0,1))), #' st_linestring(rbind(c(0,0),c(.1,0))), crs = 4326) #' try(st_line_sample(ls, density = 1/1000)) # error #' st_line_sample(st_transform(ls, 3857), n = 5) # five points for each line #' st_line_sample(st_transform(ls, 3857), n = c(1, 3)) # one and three points #' st_line_sample(st_transform(ls, 3857), density = 1/1000) # one per km #' st_line_sample(st_transform(ls, 3857), density = c(1/1000, 1/10000)) # one per km, one per 10 km #' st_line_sample(st_transform(ls, 3857), density = units::set_units(1, 1/km)) # one per km #' # five equidistant points including start and end: #' st_line_sample(st_transform(ls, 3857), sample = c(0, 0.25, 0.5, 0.75, 1)) st_line_sample = function(x, n, density, type = "regular", sample = NULL) { if (isTRUE(st_is_longlat(x))) stop("st_line_sample for longitude/latitude not supported; use st_segmentize?") l = st_length(x) distList = if (is.null(sample)) { n = if (missing(n)) { if (!is.null(st_crs(x)$ud_unit) && inherits(density, "units")) units(density) = 1/st_crs(x)$ud_unit # coordinate units round(rep(density, length.out = length(l)) * l) } else rep(n, length.out = length(l)) regular = function(n) { (seq_len(n) - 0.5)/n } random = function(n) { sort(runif(n)) } fn = switch(type, regular = regular, random = random, stop("unknown type")) lapply(seq_along(n), function(i) fn(n[i]) * l[i]) } else lapply(seq_along(l), function(i) sample * l[i]) x = st_geometry(x) stopifnot(inherits(x, "sfc_LINESTRING")) st_sfc(CPL_gdal_linestring_sample(x, distList), crs = st_crs(x)) } #' Internal functions #' @keywords internal #' @param msg error message #' @export .stop_geos = function(msg) { #nocov start on.exit(stop(msg)) lst = strsplit(msg, " at ")[[1]] pts = scan(text = lst[[length(lst)]], quiet = TRUE) if (length(pts) == 2 && is.numeric(pts)) assign(".geos_error", st_point(pts), envir=.sf_cache) } #nocov end #' @param dist numeric or units, vector with distance value(s), in units of the coordinates #' @name st_line_project_point #' @returns `st_line_interpolate` returns the point(s) at dist(s), when measured along (interpolated on) the line(s) #' @export #' @examples #' st_line_interpolate(st_as_sfc("LINESTRING (0 0, 1 1)"), 1) #' st_line_interpolate(st_as_sfc("LINESTRING (0 0, 1 1)"), 1, TRUE) #' # https://github.com/r-spatial/sf/issues/2542; use for geographic coordinates: #' l1 <- st_as_sfc("LINESTRING (10.1 50.1, 10.2 50.2)", crs = 'OGC:CRS84') #' dists = units::set_units(seq(0, sqrt(2)/10, length.out = 5), degrees) #' st_line_interpolate(l1, dists) st_line_interpolate = function(line, dist, normalized = FALSE) { stopifnot(inherits(line, "sfc"), all(st_dimension(line) == 1), is.logical(normalized), length(normalized) == 1, is.numeric(dist)) if (isTRUE(st_is_longlat(line))) { message_longlat("st_project_point") if (inherits(dist, "units")) dist = units::set_units(dist, "degree", mode = "standard") else stop("for interpolating geographic coordinates, dist should have units degree; see examples") } line = st_cast(line, "LINESTRING") recycled = recycle_common(list(line, dist)) st_sfc(CPL_line_interpolate(recycled[[1]], recycled[[2]], normalized), crs = st_crs(line)) } #' @export #' @name geos_unary #' @details \code{st_exterior_ring} returns the exterior rings of polygons, removing all holes. st_exterior_ring = function(x, ...) UseMethod("st_exterior_ring") #' @export st_exterior_ring.sf = function(x, ...) st_set_geometry(x, st_exterior_ring(st_geometry(x))) #' @export st_exterior_ring.sfg = function(x, ...) st_exterior_ring(st_sfc(x))[[1]] #' @export st_exterior_ring.sfc = function(x, ...) { stopifnot(all(st_dimension(x, NA_if_empty = FALSE) == 2)) exterior_sfg = function(x) { if (inherits(x, "MULTIPOLYGON")) st_multipolygon(lapply(st_cast(st_sfc(x), "POLYGON"), exterior_sfg)) else if (inherits(x, "POLYGON")) st_polygon(x[1]) else stop(paste("no exterior_ring method for objects of class", class(x)[1])) } st_as_sfc(lapply(x, exterior_sfg), crs = st_crs(x)) } ================================================ FILE: R/geos-overlayng.R ================================================ # nocov start is_overlayng <- function() { pl1 = st_polygon(list(matrix(c(0, 0, 2, 0, 1, 1, 0 ,0), byrow = TRUE, ncol=2))) pl2 = st_polygon(list(matrix(c(0, 0.5, 2, 0.5, 1, 1.5, 0, 0.5), byrow = TRUE, ncol = 2))) pl3 = st_polygon(list(matrix(c(0, 1.25, 2, 1.25, 1, 2.5, 0, 1.25), byrow = TRUE, ncol = 2))) in1 = st_sfc(list(pl1, pl2, pl3)) correct_geom = st_sfc(list( st_polygon(list(matrix(c(0, 2, 1, 0, 0, 0, 1, 0), ncol = 2))), st_polygon(list(matrix(c(0, 1, 2, 1.5, 1, 0.5, 0, 0.5, 1.5, 0.5, 0.5, 1, 0.5, 0.5), ncol = 2))), st_polygon(list(matrix(c(0, 1, 2, 1.25, 1, 0.75, 0, 1.25, 2.5, 1.25, 1.25, 1.5, 1.25, 1.25), ncol = 2))))) out1 = st_difference(in1) isTRUE(all.equal(out1[[2]][[1]], correct_geom[[2]][[1]])) } # nocov end ================================================ FILE: R/graticule.R ================================================ st_datum = function(x) { stopifnot(inherits(x, c("crs", "sf", "sfc"))) if (inherits(x, "crs")) x = st_sfc(st_point(), crs = x) x = st_geometry(x) # in case inherits(x, "sf") datum = st_crs(st_crs(x, parameters = TRUE)$gcs_crs) if (is.na(datum)) st_crs('OGC:CRS84') # + message or warning? else datum } #' Compute graticules and their parameters #' #' Compute graticules and their parameters #' #' @section Use of graticules: #' In cartographic visualization, the use of graticules is not advised, unless #' the graphical output will be used for measurement or navigation, or the #' direction of North is important for the interpretation of the content, or #' the content is intended to display distortions and artifacts created by #' projection. Unnecessary use of graticules only adds visual clutter but #' little relevant information. Use of coastlines, administrative boundaries #' or place names permits most viewers of the output to orient themselves #' better than a graticule. #' #' @export #' @param x object of class \code{sf}, \code{sfc} or \code{sfg} or numeric vector with bounding box given as (minx, miny, maxx, maxy). #' @param crs object of class \code{crs}, with the display coordinate reference system #' @param datum either an object of class \code{crs} with the coordinate reference system for the graticules, or \code{NULL} in which case a grid in the coordinate system of \code{x} is drawn, or \code{NA}, in which case an empty \code{sf} object is returned. If missing and \code{x} has a crs with a datum, the geographic coordinate system (datum) of \code{x} is taken. #' @param lon numeric; values in degrees East for the meridians, associated with \code{datum} #' @param lat numeric; values in degrees North for the parallels, associated with \code{datum} #' @param ndiscr integer; number of points to discretize a parallel or meridian #' @param margin numeric; small number to trim a longlat bounding box that touches or #' crosses +/-180 long or +/-90 latitude. #' @param ... ignored #' @return an object of class \code{sf} with additional attributes describing the type #' (E: meridian, N: parallel) degree value, label, start and end coordinates and angle; #' see example. #' @examples #' library(sf) #' if (require(maps, quietly = TRUE)) { #' #' usa = st_as_sf(map('usa', plot = FALSE, fill = TRUE)) #' laea = st_crs("+proj=laea +lat_0=30 +lon_0=-95") # Lambert equal area #' usa <- st_transform(usa, laea) #' #' bb = st_bbox(usa) #' bbox = st_linestring(rbind(c( bb[1],bb[2]),c( bb[3],bb[2]), #' c( bb[3],bb[4]),c( bb[1],bb[4]),c( bb[1],bb[2]))) #' #' g = st_graticule(usa) #' plot(usa, xlim = 1.2 * c(-2450853.4, 2186391.9), reset = FALSE) #' plot(g[1], add = TRUE, col = 'grey') #' plot(bbox, add = TRUE) #' points(g$x_start, g$y_start, col = 'red') #' points(g$x_end, g$y_end, col = 'blue') #' #' invisible(lapply(seq_len(nrow(g)), function(i) { #' if (g$type[i] == "N" && g$x_start[i] - min(g$x_start) < 1000) #' text(g$x_start[i], g$y_start[i], labels = parse(text = g$degree_label[i]), #' srt = g$angle_start[i], pos = 2, cex = .7) #' if (g$type[i] == "E" && g$y_start[i] - min(g$y_start) < 1000) #' text(g$x_start[i], g$y_start[i], labels = parse(text = g$degree_label[i]), #' srt = g$angle_start[i] - 90, pos = 1, cex = .7) #' if (g$type[i] == "N" && g$x_end[i] - max(g$x_end) > -1000) #' text(g$x_end[i], g$y_end[i], labels = parse(text = g$degree_label[i]), #' srt = g$angle_end[i], pos = 4, cex = .7) #' if (g$type[i] == "E" && g$y_end[i] - max(g$y_end) > -1000) #' text(g$x_end[i], g$y_end[i], labels = parse(text = g$degree_label[i]), #' srt = g$angle_end[i] - 90, pos = 3, cex = .7) #' })) #' plot(usa, graticule = st_crs(4326), axes = TRUE, lon = seq(-60,-130,by=-10)) #' } st_graticule = function(x = c(-180, -90, 180, 90), crs = st_crs(x), datum = st_crs('OGC:CRS84'), ..., lon = NULL, lat = NULL, ndiscr = 100, margin = 0.001) { s2 = sf_use_s2() on.exit(suppressMessages(sf_use_s2(s2))) suppressMessages(sf_use_s2(FALSE)) if (missing(x)) { crs = datum if (is.null(lon)) lon = seq(-180, 180, by = 20) if (is.null(lat)) lat = seq(-80, 80, by = 20) } else if (missing(datum)) { datum = if (inherits(x, c("sf", "sfc"))) st_datum(x) else st_datum(crs) } if (is.null(crs)) crs = NA_crs_ if (is.null(datum)) datum = crs if (is.na(datum)) return(st_graticule()[0,]) # empty set, but with all variables # Get the bounding box of the plotting space, in crs bb = if (inherits(x, "sf") || inherits(x, "sfc") || inherits(x, "sfg")) st_bbox(x) else x stopifnot(is.numeric(bb), length(bb) == 4) if (isTRUE(st_is_longlat(crs))) bb = trim_bb(bb, margin) ls1 = st_linestring(rbind(c(bb[1],bb[2]), c(bb[3],bb[2]), c(bb[3],bb[4]), c(bb[1],bb[4]), c(bb[1],bb[2]))) ls2 = st_linestring(rbind(c(bb[1],bb[2]), c(bb[3],bb[4]), c(bb[1],bb[4]), c(bb[3],bb[2]), c(bb[1],bb[2]))) box = st_sfc(ls1, ls2) # without crs, we segmentize in planar coordinates -- # segmentizing along great circles doesn't give parallels: box = st_segmentize(box, st_length(box)[1] / ndiscr) # and only now set the crs: st_crs(box) = crs # Now, in case we're not already in longlat, we convert to longlat: box_ll = if (! is.na(crs)) st_transform(box, datum, partial = TRUE) else { datum = NA_crs_ # nocov - remove when geom_sf is on CRAN box # nocov } # as in https://github.com/r-spatial/sf/issues/198 : # recreate, and ignore bbox_ll: if (any(!is.finite(st_bbox(box_ll)))) { # nocov start -- checked manually x = st_transform(st_graticule(datum = datum, ndiscr = ndiscr), crs) x$degree_label = NA_character_ return(x) } # nocov end bb = st_bbox(box_ll) if (is.null(lon)) { lon = if (bb[3] <= 180 && bb[1] < -170 && bb[3] > 170) # global, -180,180: seq(-180, 180, by = 60) else pretty(bb[c(1,3)], n = 6) } if (is.null(lat)) lat = pretty(bb[c(2,4)], n = 6) # sanity: if (isTRUE(st_is_longlat(datum))) { lon = if (min(lon) >= -15 && max(lon) > 195) # +- 4% lon[lon >= 0 & lon <= 360] # assume 0,360 else lon[lon >= -180 & lon <= 180] lat = lat[lat > -90 & lat < 90] } # widen bb if pretty() created values outside the box_ll: bb = c(min(bb[1], min(lon)), min(bb[2],min(lat)), max(bb[3], max(lon)), max(bb[4], max(lat))) long_list <- vector(mode="list", length=length(lon)) for (i in seq_along(long_list)) long_list[[i]] <- st_linestring(cbind(rep(lon[i], ndiscr), seq(bb[2], bb[4], length.out=ndiscr))) lat_list <- vector(mode="list", length=length(lat)) for (i in seq_along(lat_list)) lat_list[[i]] <- st_linestring(cbind(seq(bb[1], bb[3], length.out=ndiscr), rep(lat[i], ndiscr))) df = data.frame(degree = c(lon, lat)) df$type = c(rep("E", length(lon)), rep("N", length(lat))) df$degree_label = if (is.na(crs) || !isTRUE(st_is_longlat(datum))) c(format(lon), format(lat)) else c(degreeLabelsEW(lon), degreeLabelsNS(lat)) geom = st_sfc(c(long_list, lat_list), crs = datum) # Now we're moving the straight lines back to curves in crs: if (!is.na(crs)) geom = st_transform(geom, crs) st_geometry(df) = geom st_agr(df) = "constant" if (! missing(x)) # cut out box: df = suppressMessages(st_intersection(df, st_polygonize(box[1]))) df = st_line_merge(st_cast(df, "MULTILINESTRING")) df = st_cast(st_cast(df, "MULTILINESTRING"), "LINESTRING", warn = FALSE) graticule_attributes(df) } graticule_attributes = function(df) { object = st_geometry(df) if (nrow(df) == 0) return(df) xy = matrix(NA, nrow = length(object), ncol = 4) for (i in seq_along(object)) { pts = unclass(object[[i]]) xy[i, 1:2] = pts[1,] # start xy[i, 3:4] = pts[nrow(pts),] # end } df$x_start = xy[,1] df$y_start = xy[,2] df$x_end = xy[,3] df$y_end = xy[,4] dxdy = do.call(rbind, lapply(object, function(x) { apply(x[1:2,], 2, diff) } )) df$angle_start = apply(dxdy, 1, function(x) atan2(x[2], x[1])*180/pi) dxdy = do.call(rbind, lapply(object, function(x) { n = nrow(x); apply(x[(n-1):n,], 2, diff) } )) df$angle_end = apply(dxdy, 1, function(x) atan2(x[2], x[1])*180/pi) bb = st_bbox(df) selE = df$type == "E" & df$y_start < min(df$y_start) + 0.001 * (bb[3] - bb[1]) selN = df$type == "N" & df$x_start < min(df$x_start) + 0.001 * (bb[4] - bb[2]) df$plot12 = selE | selN df } # make sure lat stays slightly inside [-90,90], and lon inside [-180,180] or [0,360] trim_bb = function(bb = c(-180, -90, 180, 90), margin) { stopifnot(margin > 0, margin <= 1.0) fr = 1.0 - margin if (min(bb[c(1,3)]) >= -1. && max(bb[c(1,3)]) > 181.) { # 0-360 span: bb[1] = max(bb[1], 0.) bb[3] = min(bb[3], 360. * fr) } else { bb[1] = max(bb[1], -180. * fr) bb[3] = min(bb[3], 180. * fr) } bb[2] = max(bb[2], -90. * fr) bb[4] = min(bb[4], 90. * fr) bb } # copied from sp: degreeLabelsNS = function(x) { pos = sign(x) + 2 dir = c("*S", "", "*N") paste0('"', format(abs(x), digits = 10), '"', "*degree", dir[pos]) } degreeLabelsEW = function(x) { x <- ifelse(x > 180, x - 360, x) pos = sign(x) + 2 if (any(x == -180)) pos[x == -180] = 2 if (any(x == 180)) pos[x == 180] = 2 dir = c("*W", "", "*E") paste0('"', format(abs(x), digits = 10), '"', "*degree", dir[pos]) } ================================================ FILE: R/grid.R ================================================ #' Convert sf* object to a grob #' #' Convert sf* object to an grid graphics object (grob) #' @param x object to be converted into an object class \code{grob} #' @param ... passed on to the xxxGrob function, e.g. \code{gp = gpar(col = 'red')} #' @export st_as_grob = function(x, ...) UseMethod("st_as_grob") #' @export st_as_grob.POINT = function(x, pch = 1, size = unit(1, "char"), default.units = "native", name = NULL, gp = gpar(), vp = NULL, ...) { if (anyNA(x)) nullGrob() else pointsGrob(x[1], x[2], pch = pch, size = size, default.units = default.units, name = name, gp = gp, vp = vp) } #' @export st_as_grob.MULTIPOINT = function(x, pch = 1, size = unit(1, "char"), default.units = "native", name = NULL, gp = gpar(), vp = NULL, ...) { if (nrow(x) == 0) nullGrob() else pointsGrob(x[,1], x[,2], pch = pch, size = size, default.units = default.units, name = name, gp = gp, vp = vp) } #' @export st_as_grob.LINESTRING = function(x, arrow = NULL, default.units = "native", name = NULL, gp = gpar(), vp = NULL, ...) { if (nrow(x) == 0) nullGrob() else linesGrob(x[,1], x[,2], arrow = NULL, default.units = default.units, name = name, gp = gp, vp = vp) } #' @export st_as_grob.CIRCULARSTRING = function(x, y, ...) { st_as_grob(st_cast(x, "LINESTRING"), ...) } #' @export st_as_grob.MULTILINESTRING = function(x, arrow = NULL, default.units = "native", name = NULL, gp = gpar(), vp = NULL, ...) { if (length(x) == 0) nullGrob() else { get_x = function(x) unlist(sapply(x, function(y) y[,1])) get_y = function(x) unlist(sapply(x, function(y) y[,2])) polylineGrob(get_x(x), get_y(x), id.lengths = vapply(x, nrow, 0L), arrow = NULL, default.units = default.units, name = name, gp = gp, vp = vp) } } #' @export st_as_grob.POLYGON = function(x, default.units = "native", rule = "evenodd", name = NULL, gp = gpar(), vp = NULL, ...) { if (length(x) == 0) nullGrob() else { get_x = function(x) unlist(sapply(x, function(y) y[,1])) get_y = function(x) unlist(sapply(x, function(y) y[,2])) pathGrob(get_x(x), get_y(x), id.lengths = vapply(x, nrow, 0L), default.units = default.units, rule = rule, name = name, gp = gp, vp = vp) } } #' @export st_as_grob.MULTIPOLYGON = function(x, default.units = "native", rule = "evenodd", name = NULL, gp = gpar(), vp = NULL, ...) { if (length(x) == 0) nullGrob() else { get_x = function(x) unlist(sapply(x, function(y) sapply(y, function(z) z[,1]))) get_y = function(x) unlist(sapply(x, function(y) sapply(y, function(z) z[,2]))) get_l = function(x) unlist(sapply(x, function(y) vapply(y, nrow, 0L))) pathGrob(get_x(x), get_y(x), id.lengths = get_l(x), default.units = default.units, rule = rule, name = name, gp = gp, vp = vp) } } #' @export st_as_grob.GEOMETRYCOLLECTION = function(x, ...) { if (length(x) == 0) nullGrob() else do.call(grid::grobTree, lapply(x, st_as_grob, ...)) } #' @export st_as_grob.MULTISURFACE = st_as_grob.GEOMETRYCOLLECTION #' @export st_as_grob.CURVEPOLYGON = st_as_grob.GEOMETRYCOLLECTION #' @export st_as_grob.COMPOUNDCURVE = st_as_grob.GEOMETRYCOLLECTION #' Create viewport from sf, sfc or sfg object #' #' Create viewport from sf, sfc or sfg object #' @param x object of class sf, sfc or sfg object #' @param bbox the bounding box used for aspect ratio #' @param asp numeric; target aspect ratio (y/x), see Details #' @param ... parameters passed on to \link[grid]{viewport} #' @details parameters \code{width}, \code{height}, \code{xscale} and \code{yscale} are set such that aspect ratio is honoured and plot size is maximized in the current viewport; others can be passed as \code{...} #' @return The output of the call to \link[grid]{viewport} #' @details If \code{asp} is missing, it is taken as 1, except when \code{isTRUE(st_is_longlat(x))}, in which case it is set to \code{1.0 /cos(y)}, with \code{y} the middle of the latitude bounding box. #' @examples #' library(grid) #' nc = st_read(system.file("shape/nc.shp", package="sf")) #' grid.newpage() #' pushViewport(viewport(width = 0.8, height = 0.8)) #' pushViewport(st_viewport(nc)) #' invisible(lapply(st_geometry(nc), function(x) grid.draw(st_as_grob(x, gp = gpar(fill = 'red'))))) #' @export st_viewport = function(x, ..., bbox = st_bbox(x), asp) { xscale = bbox[c(1,3)] yscale = bbox[c(2,4)] # from rgdal2/R/graphics.R: current.viewport.size = function(units = "inches") { vp = current.viewport() vi = convertHeight(vp$height, units, valueOnly = TRUE) wi = convertWidth(vp$width, units, valueOnly = TRUE) c(width = wi, height = vi) } current.viewport.aspect = function() { sz = current.viewport.size() sz[2] / sz[1] } vp.asp = current.viewport.aspect() if (missing(asp)) asp = if (isTRUE(st_is_longlat(x))) 1.0 / cos((mean(yscale) * pi)/180) else 1.0 obj.asp = asp * diff(yscale) / diff(xscale) height = obj.asp / vp.asp width = 1 width = width / max(width, height) height = height / max(width, height) viewport(width = unit(width, "npc"), height = unit(height, "npc"), xscale = unit(xscale, "native"), yscale = unit(yscale, "native"), ...) } #' @export st_as_grob.sfc_POINT <- function(x, pch = 1, size = unit(1, "char"), default.units = "native", name = NULL, gp = gpar(), vp = NULL, ...) { if (any(is_e <- st_is_empty(x))) { gp = gp[!is_e] x = x[!is_e] } if (length(x)) { x <- matrix(unlist(x, use.names = FALSE), ncol = length(x)) pointsGrob(x[1, ], x[2, ], pch = pch, size = size, default.units = default.units, name = name, gp = gp, vp = vp) } else nullGrob() } #' @export #' @importFrom grid gpar st_as_grob.sfc_MULTIPOINT <- function(x, pch = 1, size = unit(1, "char"), default.units = "native", name = NULL, gp = gpar(), vp = NULL, ...) { if (any(is_e <- st_is_empty(x))) { gp = gp[!is_e] x = x[!is_e] } if (length(x)) { x <- unclass(x) n_points <- vapply(x, nrow, integer(1)) gp <- expand_gp(gp, n_points) if (length(pch) != 1) pch <- rep(rep(pch, length.out = length(x)), n_points) if (length(size) != 1) size <- rep(rep(size, length.out = length(x)), n_points) x <- do.call(rbind, x) pointsGrob(x[, 1], x[, 2], pch = pch, size = size, default.units = default.units, name = name, gp = gp, vp = vp) } else nullGrob() } #' @export st_as_grob.sfc_LINESTRING <- function(x, arrow = NULL, default.units = "native", name = NULL, gp = gpar(), vp = NULL, ...) { if (any(is_e <- st_is_empty(x))) { gp = gp[!is_e] x = x[!is_e] } if (length(x)) { x <- unclass(x) n_points <- vapply(x, nrow, integer(1)) x <- do.call(rbind, x) polylineGrob(x[, 1], x[, 2], id.lengths = n_points, arrow = arrow, default.units = default.units, name = name, gp = gp, vp = vp) } else nullGrob() } #' @export st_as_grob.sfc_MULTILINESTRING <- function(x, arrow = NULL, default.units = "native", name = NULL, gp = gpar(), vp = NULL, ...) { if (any(is_e <- st_is_empty(x))) { gp = gp[!is_e] x = x[!is_e] } if (length(x)) { x <- unclass(x) n_lines <- vapply(x, length, integer(1)) gp <- expand_gp(gp, n_lines) if (!is.null(arrow) && length(arrow) != 1) arrow <- rep(rep(arrow, length.out = length(x)), n_lines) x <- unlist(x, recursive = FALSE) n_points <- vapply(x, nrow, integer(1)) x <- do.call(rbind, x) polylineGrob(x[, 1], x[, 2], id.lengths = n_points, arrow = arrow, default.units = default.units, name = name, gp = gp, vp = vp) } else nullGrob() } #' @export st_as_grob.sfc_POLYGON <- function(x, rule = "evenodd", default.units = "native", name = NULL, gp = gpar(), vp = NULL, ...) { if (utils::packageVersion("grid") < "3.6") { return(scalar_grobs(x, rule = rule, default.units = default.units, name = name, gp = gp, vp = vp, ...)) # nocov } if (any(is_e <- st_is_empty(x))) { gp = gp[!is_e] x = x[!is_e] } if (length(x)) { x <- unclass(x) # nocov start n_poly <- vapply(x, length, integer(1)) x <- unlist(x, recursive = FALSE) n_points <- vapply(x, nrow, integer(1)) n_paths <- tapply(n_points, rep(seq_along(n_poly), n_poly), sum) x <- do.call(rbind, x) pathGrob(x[, 1], x[, 2], id.lengths = n_points, pathId.lengths = n_paths, rule = rule, default.units = default.units, name = name, gp = gp, vp = vp) # nocov end } else nullGrob() } #' @export st_as_grob.sfc_MULTIPOLYGON <- function(x, rule = "evenodd", default.units = "native", name = NULL, gp = gpar(), vp = NULL, ...) { if (utils::packageVersion("grid") < "3.6") { return(scalar_grobs(x, rule = rule, default.units = default.units, name = name, gp = gp, vp = vp, ...)) # nocov } if (any(is_e <- st_is_empty(x))) { gp = gp[!is_e] x = x[!is_e] } if (length(x)) { x <- unclass(x) # nocov start n_poly <- vapply(x, length, integer(1)) gp <- expand_gp(gp, n_poly) x <- unlist(x, recursive = FALSE) n_poly <- vapply(x, length, integer(1)) x <- unlist(x, recursive = FALSE) n_points <- vapply(x, nrow, integer(1)) n_paths <- tapply(n_points, rep(seq_along(n_poly), n_poly), sum) x <- do.call(rbind, x) pathGrob(x[, 1], x[, 2], id.lengths = n_points, pathId.lengths = n_paths, rule = rule, default.units = default.units, name = name, gp = gp, vp = vp) # nocov end } else nullGrob() } #' @export st_as_grob.sfc_CIRCULARSTRING <- function(x, ...) { st_as_grob(st_cast(x, 'LINESTRING'), ...) # nocov } #' @export #' @importFrom grid gList st_as_grob.sfc <- function(x, pch = 1, size = unit(1, "char"), arrow = NULL, gp = gpar(), ...) { old_length <- length(x) x <- st_cast_sfc_default(x) ids <- attr(x, 'ids') if (!is.null(ids)) { # x was a geometrycollection that has been unlisted. Need to match gpar if (length(pch) > 1) { pch <- rep(rep_len(pch, old_length), ids) } if (length(size) > 1) { size <- rep(rep_len(size, old_length), ids) } if (length(arrow) > 1) { arrow <- rep(rep_len(arrow, old_length), ids) } for (par in names(gp)) { if (length(gp[[par]]) > 1) { gp[[par]] <- rep(rep_len(gp[[par]], old_length), ids) } } } if (class(x)[1] %in% c('sfc_MULTIPOINT', 'sfc_MULTILINESTRING', 'sfc_MULTIPOLYGON')) st_as_grob(x, pch = pch, size = size, arrow = arrow, gp = gp, ...) else scalar_grobs(x, pch, size, arrow, gp, ...) } scalar_grobs <- function(x, pch = 1, size = unit(1, "char"), arrow = NULL, gp = gpar(), ...) { gp <- split_gp(gp, length(x)) pch <- rep(pch, length.out = length(x)) size <- rep(size, length.out = length(x)) if (!is.null(arrow)) arrow <- rep(arrow, length.out = length(x)) do.call(gList, lapply(seq_along(x), function(i) { st_as_grob(x[[i]], pch = pch[i], size = size[i], arrow = arrow[i], gp = gp[[i]], ...) })) } expand_gp <- function(gp, n) { if (length(gp) == 0) return(gp) gp <- unclass(gp) n_gp <- vapply(gp, length, integer(1)) gp[n_gp > 1] <- lapply(gp[n_gp > 1], rep, n) `class<-`(gp, 'gpar') } split_gp <- function(gp, n) { gp <- unclass(gp) gp <- lapply(gp, rep_len, n) lapply(seq_len(n), function(i) { `class<-`(lapply(gp, `[`, i), 'gpar') }) } ================================================ FILE: R/import-standalone-s3-register.R ================================================ # Standalone file: do not edit by hand # Source: # ---------------------------------------------------------------------- # # --- # repo: r-lib/rlang # file: standalone-s3-register.R # last-updated: 2022-08-29 # license: https://unlicense.org # --- # # nocov start #' Register a method for a suggested dependency #' #' Generally, the recommended way to register an S3 method is to use the #' `S3Method()` namespace directive (often generated automatically by the #' `@export` roxygen2 tag). However, this technique requires that the generic #' be in an imported package, and sometimes you want to suggest a package, #' and only provide a method when that package is loaded. `s3_register()` #' can be called from your package's `.onLoad()` to dynamically register #' a method only if the generic's package is loaded. #' #' For R 3.5.0 and later, `s3_register()` is also useful when demonstrating #' class creation in a vignette, since method lookup no longer always involves #' the lexical scope. For R 3.6.0 and later, you can achieve a similar effect #' by using "delayed method registration", i.e. placing the following in your #' `NAMESPACE` file: #' #' ``` #' if (getRversion() >= "3.6.0") { #' S3method(package::generic, class) #' } #' ``` #' #' @section Usage in other packages: #' To avoid taking a dependency on vctrs, you copy the source of #' [`s3_register()`](https://github.com/r-lib/rlang/blob/main/R/standalone-s3-register.R) #' into your own package. It is licensed under the permissive #' [unlicense](https://choosealicense.com/licenses/unlicense/) to make it #' crystal clear that we're happy for you to do this. There's no need to include #' the license or even credit us when using this function. #' #' @param generic Name of the generic in the form `"pkg::generic"`. #' @param class Name of the class #' @param method Optionally, the implementation of the method. By default, #' this will be found by looking for a function called `generic.class` #' in the package environment. #' @examples #' # A typical use case is to dynamically register tibble/pillar methods #' # for your class. That way you avoid creating a hard dependency on packages #' # that are not essential, while still providing finer control over #' # printing when they are used. #' #' .onLoad <- function(...) { #' s3_register("pillar::pillar_shaft", "vctrs_vctr") #' s3_register("tibble::type_sum", "vctrs_vctr") #' } #' @keywords internal #' @noRd s3_register <- function(generic, class, method = NULL) { stopifnot(is.character(generic), length(generic) == 1) stopifnot(is.character(class), length(class) == 1) pieces <- strsplit(generic, "::")[[1]] stopifnot(length(pieces) == 2) package <- pieces[[1]] generic <- pieces[[2]] caller <- parent.frame() get_method_env <- function() { top <- topenv(caller) if (isNamespace(top)) { asNamespace(environmentName(top)) } else { caller } } get_method <- function(method) { if (is.null(method)) { get(paste0(generic, ".", class), envir = get_method_env()) } else { method } } register <- function(...) { envir <- asNamespace(package) # Refresh the method each time, it might have been updated by # `devtools::load_all()` method_fn <- get_method(method) stopifnot(is.function(method_fn)) # Only register if generic can be accessed if (exists(generic, envir)) { registerS3method(generic, class, method_fn, envir = envir) } else if (identical(Sys.getenv("NOT_CRAN"), "true")) { warn <- .rlang_s3_register_compat("warn") warn(c( sprintf( "Can't find generic `%s` in package %s to register S3 method.", generic, package ), "i" = "This message is only shown to developers using devtools.", "i" = sprintf("Do you need to update %s to the latest version?", package) )) } } # Always register hook in case package is later unloaded & reloaded setHook(packageEvent(package, "onLoad"), function(...) { register() }) # For compatibility with R < 4.1.0 where base isn't locked is_sealed <- function(pkg) { identical(pkg, "base") || environmentIsLocked(asNamespace(pkg)) } # Avoid registration failures during loading (pkgload or regular). # Check that environment is locked because the registering package # might be a dependency of the package that exports the generic. In # that case, the exports (and the generic) might not be populated # yet (#1225). if (isNamespaceLoaded(package) && is_sealed(package)) { register() } invisible() } .rlang_s3_register_compat <- function(fn, try_rlang = TRUE) { # Compats that behave the same independently of rlang's presence out <- switch( fn, is_installed = return(function(pkg) requireNamespace(pkg, quietly = TRUE)) ) # Only use rlang if it is fully loaded (#1482) if (try_rlang && requireNamespace("rlang", quietly = TRUE) && environmentIsLocked(asNamespace("rlang"))) { switch( fn, is_interactive = return(rlang::is_interactive) ) # Make sure rlang knows about "x" and "i" bullets if (utils::packageVersion("rlang") >= "0.4.2") { switch( fn, abort = return(rlang::abort), warn = return((rlang::warn)), inform = return(rlang::inform) ) } } # Fall back to base compats is_interactive_compat <- function() { opt <- getOption("rlang_interactive") if (!is.null(opt)) { opt } else { interactive() } } format_msg <- function(x) paste(x, collapse = "\n") switch( fn, is_interactive = return(is_interactive_compat), abort = return(function(msg) stop(format_msg(msg), call. = FALSE)), warn = return(function(msg) warning(format_msg(msg), call. = FALSE)), inform = return(function(msg) message(format_msg(msg))) ) stop(sprintf("Internal error in rlang shims: Unknown function `%s()`.", fn)) } # nocov end ================================================ FILE: R/init.R ================================================ #' @importFrom utils head object.size str tail packageVersion compareVersion globalVariables #' @importFrom stats aggregate dist na.omit rbinom runif setNames #' @importFrom tools file_ext file_path_sans_ext #' @importFrom methods as new slot slotNames slot<- #' @importFrom grid convertHeight convertUnit convertWidth current.viewport linesGrob nullGrob pathGrob pointsGrob polylineGrob unit viewport #' @import graphics #' @importFrom grDevices dev.size rgb cm #' @importFrom DBI dbConnect dbDisconnect dbExecute dbGetQuery dbReadTable dbSendQuery dbWriteTable #' @importFrom units as_units drop_units make_unit_label set_units #' @importFrom classInt classIntervals #' @useDynLib sf, .registration=TRUE NULL setOldClass("sf") setOldClass(c("sfc_POINT", "sfc")) setOldClass(c("sfc_MULTIPOINT", "sfc")) setOldClass(c("sfc_LINESTRING", "sfc")) setOldClass(c("sfc_MULTILINESTRING", "sfc")) setOldClass(c("sfc_POLYGON", "sfc")) setOldClass(c("sfc_MULTIPOLYGON", "sfc")) setOldClass(c("sfc_GEOMETRY", "sfc")) setOldClass(c("sfc_GEOMETRYCOLLECTION", "sfc")) setOldClass("sfg") setOldClass("crs") setOldClass("bbox") .sf_cache <- new.env(FALSE, parent=globalenv()) pathGrob <- NULL .onLoad = function(libname, pkgname) { if (getRversion() < as.numeric_version("3.6")) { # nocov start pathGrob <<- function(..., pathId.lengths) { grid::pathGrob(...) } } # nocov end load_gdal() if ((s2 <- Sys.getenv("_SF_USE_S2")) != "") options(sf_use_s2 = s2 != "false") FULL_bbox_ <<- st_set_crs(FULL_bbox_, "OGC:CRS84") } .onUnload = function(libname, pkgname) { unload_gdal() # nocov } .onAttach = function(libname, pkgname) { m = paste0("Linking to GEOS ", strsplit(CPL_geos_version(TRUE), "-")[[1]][1], ", GDAL ", CPL_gdal_version(), ", PROJ ", CPL_proj_version(), "; sf_use_s2() is ", sf_use_s2()) m = strwrap(m, width = getOption("width")) packageStartupMessage(paste0(m, collapse = "\n")) if (length(grep(CPL_geos_version(FALSE, TRUE), CPL_geos_version(TRUE))) != 1) { # nocov start packageStartupMessage("WARNING: different compile-time and runtime versions for GEOS found:") packageStartupMessage(paste( "Linked against:", CPL_geos_version(TRUE, TRUE), "compiled against:", CPL_geos_version(FALSE, TRUE))) packageStartupMessage("It is probably a good idea to reinstall sf (and maybe lwgeom too)") } # nocov end } #' Provide the external dependencies versions of the libraries linked to sf #' #' Provide the external dependencies versions of the libraries linked to sf #' @export sf_extSoftVersion = function() { structure(c(CPL_geos_version(), CPL_gdal_version(), CPL_proj_version(), ifelse(CPL_gdal_with_geos(), "true", "false"), ifelse(CPL_proj_h(), "true", "false"), CPL_proj_version()), names = c("GEOS", "GDAL", "proj.4", "GDAL_with_GEOS", "USE_PROJ_H", "PROJ")) } save_and_replace = function(var, value, where) { if (Sys.getenv(var) != "") assign(paste0(".sf.", var), Sys.getenv(var), envir = where) # Sys.setenv(var = value) uses NSE and will set var, not the variable var points to: do.call(Sys.setenv, setNames(list(value), var)) } if_exists_restore = function(vars, where) { fn = function(var, where) { lname = paste0(".sf.", var) if (!is.null(get0(lname, envir = where))) do.call(Sys.setenv, setNames(list(get(lname, envir = where)), var)) # see above } lapply(vars, fn, where = where) } load_gdal <- function() { if (!identical(Sys.getenv("R_SF_USE_PROJ_DATA"), "true")) { if (file.exists(prj <- system.file("proj", package = "sf")[1])) { # nocov start if (! sf_proj_search_paths(prj)) { # if TRUE, uses C API to set path, leaving PROJ_LIB / PROJ_DATA alone save_and_replace("PROJ_LIB", prj, .sf_cache) save_and_replace("PROJ_DATA", prj, .sf_cache) } # CPL_use_proj4_init_rules(1L) # nocov end } if (file.exists(gdl <- system.file("gdal", package = "sf")[1])) save_and_replace("GDAL_DATA", gdl, .sf_cache) } CPL_gdal_init() register_all_s3_methods() # dynamically registers non-imported pkgs (tidyverse) } unload_gdal <- function() { CPL_gdal_cleanup_all() if_exists_restore(c("PROJ_LIB", "PROJ_DATA", "GDAL_DATA"), .sf_cache) } #' @export #' @name sf_project #' @details \code{sf_add_proj_units} loads the PROJ units `link`, `us_in`, `ind_yd`, `ind_ft`, and `ind_ch` into the udunits database, and returns \code{TRUE} invisibly on success. #' @examples #' sf_add_proj_units() sf_add_proj_units = function() { #nocov start units::install_unit("link", "0.201168 m") units::install_unit("us_in", "1./39.37 m") units::install_unit("ind_yd", "0.91439523 m") units::install_unit("ind_ft", "0.30479841 m") units::install_unit("ind_ch", "20.11669506 m") invisible(TRUE) #nocov end } ================================================ FILE: R/jitter.R ================================================ #' jitter geometries #' @param x object of class \code{sf} or \code{sfc} #' @param amount numeric; amount of jittering applied; if missing, the amount is set to factor * the bounding box diagonal; units of coordinates. #' @param factor numeric; fractional amount of jittering to be applied #' @details jitters coordinates with an amount such that \code{runif(1, -amount, amount)} is added to the coordinates. x- and y-coordinates are jittered independently but all coordinates of a single geometry are jittered with the same amount, meaning that the geometry shape does not change. For longlat data, a latitude correction is made such that jittering in East and North directions are identical in distance in the center of the bounding box of \code{x}. #' @examples #' nc = st_read(system.file("gpkg/nc.gpkg", package="sf")) #' pts = st_centroid(st_geometry(nc)) #' plot(pts) #' plot(st_jitter(pts, .05), add = TRUE, col = 'red') #' plot(st_geometry(nc)) #' plot(st_jitter(st_geometry(nc), factor = .01), add = TRUE, col = '#ff8888') #' @export st_jitter = function(x, amount, factor = 0.002) { stopifnot(inherits(x, "sf") || inherits(x, "sfc")) bb = st_bbox(x) if (missing(amount)) amount = factor * sqrt(diff(bb[c(3,1)])^2 + diff(bb[c(4,2)])^2) ay = amount ax = if (isTRUE(st_is_longlat(x))) amount * cos(pi * mean(bb[c(2,4)]) / 180) else amount f = function(z, amount_x, amount_y) { st_point(c(runif(1L, -amount_x, amount_x), runif(1L, -amount_y, amount_y))) } geom = st_geometry(x) geom = st_set_crs(geom + lapply(geom, f, amount_x = ax, amount_y = ay), st_crs(x)) if (inherits(x, "sf")) st_set_geometry(x, geom) else geom } ================================================ FILE: R/join.R ================================================ check_join = function(x, y) { if (inherits(y, "sf")) stop("y should not have class sf; for spatial joins, use st_join", call. = FALSE) } sf_join = function(g, sf_column, suffix_x = ".x") { if (!(sf_column %in% names(g))) { sf_column = paste0(sf_column, suffix_x) stopifnot(sf_column %in% names(g)) } attr(g[[ sf_column ]], "bbox") = NULL # remove, so that st_sfc() recomputes: g[[ sf_column ]] = st_sfc(g[[ sf_column ]]) st_sf(g, sf_column_name = sf_column) } #' @name tidyverse #' @inheritParams dplyr::inner_join inner_join.sf = function(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) { check_join(x, y) class(x) = setdiff(class(x), "sf") sf_join(NextMethod(), attr(x, "sf_column"), suffix[1]) } #' @name tidyverse left_join.sf = function(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) { check_join(x, y) class(x) = setdiff(class(x), "sf") sf_join(NextMethod(), attr(x, "sf_column"), suffix[1]) } #' @name tidyverse right_join.sf = function(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) { check_join(x, y) class(x) = setdiff(class(x), "sf") sf_join(NextMethod(), attr(x, "sf_column"), suffix[1]) } #' @name tidyverse full_join.sf = function(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) { check_join(x, y) class(x) = setdiff(class(x), "sf") sf_join(NextMethod(), attr(x, "sf_column"), suffix[1]) } #' @name tidyverse semi_join.sf = function(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) { check_join(x, y) class(x) = setdiff(class(x), "sf") sf_join(NextMethod(), attr(x, "sf_column"), suffix[1]) } #' @name tidyverse anti_join.sf = function(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) { check_join(x, y) class(x) = setdiff(class(x), "sf") sf_join(NextMethod(), attr(x, "sf_column"), suffix[1]) } #' spatial join, spatial filter #' #' spatial join, spatial filter #' @name st_join #' @export st_join = function(x, y, join, ...) UseMethod("st_join") #' @name st_join #' @param x object of class \code{sf} #' @param y object of class \code{sf} #' @param join geometry predicate function with the same profile as \link{st_intersects}; see details #' @param suffix length 2 character vector; see \link[base]{merge} #' @param ... for \code{st_join}: arguments passed on to the \code{join} function or to \code{st_intersection} when \code{largest} is \code{TRUE}; for \code{st_filter} arguments passed on to the \code{.predicate} function, e.g. \code{prepared}, or a pattern for \link{st_relate} #' @param left logical; if \code{TRUE} return the left join, otherwise an inner join; see details. #' see also \link[dplyr:mutate-joins]{left_join} #' @param largest logical; if \code{TRUE}, return \code{x} features augmented with the fields of \code{y} that have the largest overlap with each of the features of \code{x}; see https://github.com/r-spatial/sf/issues/578 #' #' @details alternative values for argument \code{join} are: #' \itemize{ #' \item \link{st_contains_properly}, #' \item \link{st_contains}, #' \item \link{st_covered_by}, #' \item \link{st_covers}, #' \item \link{st_crosses}, #' \item \link{st_disjoint}, #' \item \link{st_equals_exact}, #' \item \link{st_equals}, #' \item \link{st_is_within_distance}, #' \item \link{st_nearest_feature}, #' \item \link{st_overlaps}, #' \item \link{st_touches}, #' \item \link{st_within}, #' \item \link{st_relate} (which will require `pattern` to be set), #' \item or any user-defined function of the same profile as the above #' } #' A left join returns all records of the \code{x} object with \code{y} fields for non-matched records filled with \code{NA} values; an inner join returns only records that spatially match. #' #' To replicate the results of \code{st_within(x, y)} you will need to use \code{st_join(x, y, join = "st_within", left = FALSE)}. #' #' @return an object of class \code{sf}, joined based on geometry #' @examples #' a = st_sf(a = 1:3, #' geom = st_sfc(st_point(c(1,1)), st_point(c(2,2)), st_point(c(3,3)))) #' b = st_sf(a = 11:14, #' geom = st_sfc(st_point(c(10,10)), st_point(c(2,2)), st_point(c(2,2)), st_point(c(3,3)))) #' st_join(a, b) #' st_join(a, b, left = FALSE) #' # two ways to aggregate y's attribute values outcome over x's geometries: #' j = st_join(a, b) #' aggregate(j, list(j$a.x), mean) #' if (require(dplyr, quietly = TRUE)) { #' st_join(a, b) |> group_by(a.x) |> summarise(mean(a.y)) #' } #' # example of largest = TRUE: #' nc <- st_transform(st_read(system.file("shape/nc.shp", package="sf")), 2264) #' gr = st_sf( #' label = apply(expand.grid(1:10, LETTERS[10:1])[,2:1], 1, paste0, collapse = " "), #' geom = st_make_grid(st_as_sfc(st_bbox(nc)))) #' gr$col = sf.colors(10, categorical = TRUE, alpha = .3) #' # cut, to check, NA's work out: #' gr = gr[-(1:30),] #' nc_j <- st_join(nc, gr, largest = TRUE) #' # the two datasets: #' opar = par(mfrow = c(2,1), mar = rep(0,4)) #' plot(st_geometry(nc_j)) #' plot(st_geometry(gr), add = TRUE, col = gr$col) #' text(st_coordinates(st_centroid(gr)), labels = gr$label) #' # the joined dataset: #' plot(st_geometry(nc_j), border = 'black', col = nc_j$col) #' text(st_coordinates(st_centroid(nc_j)), labels = nc_j$label, cex = .8) #' plot(st_geometry(gr), border = 'green', add = TRUE) #' par(opar) #' # st_filter keeps the geometries in x where .predicate(x,y) returns any match in y for x #' st_filter(a, b) #' # for an anti-join, use the union of y #' st_filter(a, st_union(b), .predicate = st_disjoint) #' @export st_join.sf = function(x, y, join = st_intersects, ..., suffix = c(".x", ".y"), left = TRUE, largest = FALSE) { if (!inherits(y, "sf")) stop("second argument should be of class sf: maybe revert the first two arguments?") # nocov i = if (largest) { x$.grp_a = seq_len(nrow(x)) y$.grp_b = seq_len(nrow(y)) st_intersection(x, y, ...) } else join(x, y, ...) st_geometry(y) = NULL which.x = which(names(x) %in% names(y)) which.y = which(names(y) %in% names(x)) if (length(which.x)) names(x)[which.x] = paste0(names(x)[which.x], suffix[1]) if (length(which.y)) names(y)[which.y] = paste0(names(y)[which.y], suffix[2]) # create match index ix & i: if (largest) { x$.grp_a = y$.grp_b = NULL # clean up i$.size = if (all(st_dimension(i) < 2)) st_length(i) else st_area(i) l = lapply(split(i, i$.grp_a), function(x) x[which.max(x$.size), ]$.grp_b) ix = as.integer(names(l)) # non-empty x features i = unlist(l) # matching largest y feature if (left) { # fill NA's idx = rep(NA_integer_, nrow(x)) # all x features idx[ix] = i ix = seq_len(nrow(x)) i = idx } } else { if (left) # fill NA y values when no match: i = lapply(i, function(x) { if (length(x) == 0) NA_integer_ else x }) ix = rep(seq_len(nrow(x)), lengths(i)) } if (inherits(x, "tbl_df") && requireNamespace("dplyr", quietly = TRUE)) st_sf(dplyr::bind_cols(x[ix,], y[unlist(i), , drop = FALSE])) else st_sf(cbind(as.data.frame(x)[ix, ,drop=FALSE], y[unlist(i), , drop = FALSE])) } #' @export #' @name st_join st_filter = function(x, y, ...) UseMethod("st_filter") #' @export #' @name st_join #' @param .predicate geometry predicate function with the same profile as \link{st_intersects}; see details st_filter.sf = function(x, y, ..., .predicate = st_intersects) { if (!requireNamespace("dplyr", quietly = TRUE)) stop("dplyr is not installed: install first?") dplyr::filter(x, lengths(.predicate(!!x, !!y, ...)) > 0) # will call filter.sf } ================================================ FILE: R/m_range.R ================================================ #' @name st_m_range #' @param x object of class \code{m_range} #' @export is.na.m_range = function(x) identical(x, NA_m_range_) mb_wrap = function(mb) { stopifnot(is.numeric(mb), length(mb) == 2) structure(mb, names = c("mmin", "mmax"), class = "m_range") } m_range.Set = function(obj, ...) { sel = vapply(obj, function(x) { length(x) && !all(is.na(x)) }, TRUE) if (! any(sel)) NA_m_range_ else mb_wrap(CPL_get_m_range(unclass(obj)[sel], 0)) } m_range.Mtrx = function(obj, ...) { if (length(obj) == 0) NA_m_range_ else mb_wrap(CPL_get_m_range(list(obj), 1)) # note the list() } m_range.MtrxSet = function(obj, ...) { if (length(obj) == 0) NA_m_range_ else mb_wrap(CPL_get_m_range(obj, 1)) } m_range.MtrxSetSet = function(obj, ...) { if (length(obj) == 0) NA_m_range_ else mb_wrap(CPL_get_m_range(obj, 2)) } m_range.MtrxSetSetSet = function(obj, ...) { if (length(obj) == 0) NA_m_range_ else mb_wrap(CPL_get_m_range(obj, 3)) } #' Return 'm' range of a simple feature or simple feature set #' #' Return 'm' range of a simple feature or simple feature set #' @param obj object to compute the m range from #' @param ... ignored #' @export #' @return a numeric vector of length two, with \code{mmin} and \code{mmax} values; #' if \code{obj} is of class \code{sf} or \code{sfc} the object #' if \code{obj} is of class \code{sf} or \code{sfc} the object #' returned has a class \code{m_range} #' @name st_m_range #' @examples #' a = st_sf(a = 1:2, geom = st_sfc(st_point(0:3), st_point(1:4)), crs = 4326) #' st_m_range(a) st_m_range = function(obj, ...) UseMethod("st_m_range") #' @export #' @name st_m_range st_m_range.POINT = function(obj, ...) mb_wrap(if (inherits(obj, "XYM")) c(obj[3L], obj[3L]) else c(obj[4L],obj[4L])) #' @export #' @name st_m_range st_m_range.MULTIPOINT = m_range.Mtrx #' @export #' @name st_m_range st_m_range.LINESTRING = m_range.Mtrx #' @export #' @name st_m_range st_m_range.POLYGON = m_range.MtrxSet #' @export #' @name st_m_range st_m_range.MULTILINESTRING = m_range.MtrxSet #' @export #' @name st_m_range st_m_range.MULTIPOLYGON = m_range.MtrxSetSet m_range_list = function(obj, ...) { s = vapply(obj, st_m_range, c(0.,0.)) # dispatch on class if (length(s) == 0 || all(is.na(s[1L,]))) NA_m_range_ else mb_wrap(c(min(s[1L,], na.rm = TRUE), max(s[2L,], na.rm = TRUE))) } #' @name st_m_range #' @export st_m_range.GEOMETRYCOLLECTION = m_range_list #' @name st_m_range #' @export st_m_range.MULTISURFACE = m_range_list #' @name st_m_range #' @export st_m_range.MULTICURVE = m_range_list #' @name st_m_range #' @export st_m_range.CURVEPOLYGON = m_range_list #' @name st_m_range #' @export st_m_range.COMPOUNDCURVE = m_range_list #' @name st_m_range #' @export st_m_range.POLYHEDRALSURFACE = m_range.MtrxSetSet #' @name st_m_range #' @export st_m_range.TIN = m_range.MtrxSetSet #' @name st_m_range #' @export st_m_range.TRIANGLE = m_range.MtrxSet #' @name st_m_range #' @export st_m_range.CIRCULARSTRING = function(obj, ...) { # this is of course wrong: st_m_range(st_cast(obj, "LINESTRING")) # nocov } #' @export print.m_range = function(x, ...) { x = structure(x, crs = NULL, class = NULL) # nocov print(set_units(x, attr(x, "units"), mode = "standard")) # nocov } compute_m_range = function(obj) { switch(class(obj)[1], sfc_POINT = mb_wrap(m_range.Set(obj)), sfc_MULTIPOINT = mb_wrap(m_range.MtrxSet(obj)), sfc_LINESTRING = mb_wrap(m_range.MtrxSet(obj)), sfc_POLYGON = mb_wrap(m_range.MtrxSetSet(obj)), sfc_MULTILINESTRING = mb_wrap(m_range.MtrxSetSet(obj)), sfc_MULTIPOLYGON = mb_wrap(m_range.MtrxSetSetSet(obj)), m_range_list(obj) ) } #' @name st_m_range #' @export st_m_range.sfc = function(obj, ...) { a = attr(obj, "m_range") if(is.null(a)) return( NULL ) ## TODO return null? structure(a, crs = st_crs(obj)) } #' @name st_m_range #' @export st_m_range.sf = function(obj, ...) st_m_range(st_geometry(obj)) #' @name st_m_range #' @param crs object of class \code{crs}, or argument to \link{st_crs}, specifying the CRS of this bounding box. #' @examples #' st_m_range(c(mmin = 16.1, mmax = 16.6), crs = st_crs(4326)) #' @export st_m_range.numeric = function(obj, ..., crs = NA_crs_) { structure(mb_wrap(obj[c("mmin", "mmax")]), crs = st_crs(crs)) # nocov } #' @export st_m_range.m_range = function(obj, ...) obj # nocov #' @export "$.m_range" = function(x, name) { # nocov start switch(name, mmin = x["mmin"], mmax = x["mmax"], stop("unsupported name") ) } # nocov end #' @name st_m_range #' @details \code{NA_m_range_} represents the missing value for a \code{m_range} object #' @export NA_m_range_ = structure(rep(NA_real_, 2), names = c("mmin", "mmax"), crs = NA_crs_, class = "m_range") ================================================ FILE: R/make_grid.R ================================================ #' Create a regular tesselation over the bounding box of an sf or sfc object #' #' Create a square or hexagonal grid covering the bounding box of the geometry of an sf or sfc object #' @param x object of class \link{sf} or \link{sfc} #' @param cellsize numeric of length 1 or 2 with target cellsize: for square or rectangular cells the width and height, for hexagonal cells the distance between opposite edges (edge length is cellsize/sqrt(3)). A length units object can be passed, or an area unit object with area size of the square or hexagonal cell. #' @param offset numeric of length 2; lower left corner coordinates (x, y) of the grid #' @param n integer of length 1 or 2, number of grid cells in x and y direction (columns, rows) #' @param crs object of class \code{crs}; coordinate reference system of the target grid in case argument \code{x} is missing, if \code{x} is not missing, its crs is inherited. #' @param what character; one of: \code{"polygons"}, \code{"corners"}, or \code{"centers"} #' @param square logical; if \code{FALSE}, create hexagonal grid #' @param flat_topped logical; if \code{TRUE} generate flat topped hexagons, else generate pointy topped #' @return Object of class \code{sfc} (simple feature geometry list column) with, depending on \code{what} and \code{square}, #' square or hexagonal polygons, corner points of these polygons, or center points of these polygons. #' @examples #' plot(st_make_grid(what = "centers"), axes = TRUE) #' plot(st_make_grid(what = "corners"), add = TRUE, col = 'green', pch=3) #' sfc = st_sfc(st_polygon(list(rbind(c(0,0), c(1,0), c(1,1), c(0,0))))) #' plot(st_make_grid(sfc, cellsize = .1, square = FALSE)) #' plot(sfc, add = TRUE) #' # non-default offset: #' plot(st_make_grid(sfc, cellsize = .1, square = FALSE, offset = c(0, .05 / (sqrt(3)/2)))) #' plot(sfc, add = TRUE) #' nc = st_read(system.file("shape/nc.shp", package="sf")) #' g = st_make_grid(nc) #' plot(g) #' plot(st_geometry(nc), add = TRUE) #' # g[nc] selects cells that intersect with nc: #' plot(g[nc], col = '#ff000088', add = TRUE) #' @export st_make_grid = function(x, cellsize = c(diff(st_bbox(x)[c(1,3)]), diff(st_bbox(x)[c(2,4)]))/n, offset = st_bbox(x)[c("xmin", "ymin")], n = c(10, 10), crs = if (missing(x)) NA_crs_ else st_crs(x), what = "polygons", square = TRUE, flat_topped = FALSE) { if (!inherits(crs, "crs")) crs = st_crs(crs) # #2057 if (missing(x) && missing(cellsize) && missing(offset) && missing(n) && missing(crs)) # create global 10 x 10 degree grid return(st_make_grid(cellsize = c(10,10), offset = c(-180,-90), n = c(36,18), crs = st_crs(4326), what = what)) if (! square) { # hexagons: if (!is.null(crs$ud_unit)) { if (inherits(cellsize, "units")) { if (units::ud_are_convertible(units(cellsize), "m^2")) { # size in area # convert: https://github.com/r-spatial/sf/issues/1505 a = sqrt(cellsize * 2 / (3 * sqrt(3))) cellsize = a * sqrt(3) } units(cellsize) = units(crs$ud_unit) cellsize = units::drop_units(cellsize) } if (inherits(offset, "units")) { units(offset) = units(crs$ud_unit) offset = units::drop_units(offset) } } hex = make_hex_grid(x, dx = cellsize[1]/sqrt(3), pt = offset, what = what, flat_topped = flat_topped) if (what == "corners") hex = st_cast(hex, "POINT")[x] return(hex) } bb = if (!missing(n) && !missing(offset) && !missing(cellsize)) { cellsize = rep(cellsize, length.out = 2) n = rep(n, length.out = 2) bb_wrap(c(offset, offset + n * cellsize)) } else st_bbox(x) cellsize_missing = if (! missing(cellsize)) { cellsize = rep(cellsize, length.out = 2) FALSE } else TRUE if (!is.null(crs$ud_unit)) { if (inherits(cellsize, "units")) { if (units::ud_are_convertible(units(cellsize), "m^2")) # size in area cellsize = sqrt(cellsize) units(cellsize) = units(crs$ud_unit) cellsize = units::drop_units(cellsize) } if (inherits(offset, "units")) { units(offset) = units(crs$ud_unit) offset = units::drop_units(offset) } } if (missing(n)) { nx = ceiling((bb[3] - offset[1])/cellsize[1]) ny = ceiling((bb[4] - offset[2])/cellsize[2]) } else { n = rep(n, length.out = 2) nx = n[1] ny = n[2] } # corner points: if (cellsize_missing) { xc = seq(offset[1], bb[3], length.out = nx + 1) yc = seq(offset[2], bb[4], length.out = ny + 1) } else { xc = offset[1] + (0:nx) * cellsize[1] yc = offset[2] + (0:ny) * cellsize[2] } if (what == "polygons") { ret = vector("list", nx * ny) square = function(x1, y1, x2, y2) st_polygon(list(matrix(c(x1, x2, x2, x1, x1, y1, y1, y2, y2, y1), 5))) for (i in 1:nx) for (j in 1:ny) ret[[(j - 1) * nx + i]] = square(xc[i], yc[j], xc[i+1], yc[j+1]) st_sfc(ret, crs = crs) } else if (what == "centers") { e = expand.grid(x = xc[-1] - 0.5 * diff(xc[1:2]), y = yc[-1] - 0.5 * diff(yc[1:2]), KEEP.OUT.ATTRS = FALSE) st_geometry(st_as_sf(e, coords = c("x", "y"), crs = crs)) } else if (what == "corners") { e = expand.grid(x = xc, y = yc, KEEP.OUT.ATTRS = FALSE) st_geometry(st_as_sf(e, coords = c("x", "y"), crs = crs)) } else stop("unknown value of `what'") } ### hex grid tesselation that ## - covers a bounding box st_bbox(obj) ## - contains pt ## - has x spacing dx: the shortest distance between x coordinates with identical y coordinate make_hex_grid = function(obj, pt, dx, what, flat_topped = TRUE) { dy = sqrt(3) * dx / 2 bb = st_bbox(obj) if (!flat_topped) { # pointy topped -- swap x and y: ylim = bb[c("xmin", "xmax")] xlim = bb[c("ymin", "ymax")] pt = pt[2:1] } else { xlim = bb[c("xmin", "xmax")] ylim = bb[c("ymin", "ymax")] } offset = c(x = (pt[1] - xlim[1]) %% dx, y = (pt[2] - ylim[1]) %% (2 * dy)) x0 = seq(xlim[1] - dx, xlim[2] + 2 * dx, dx) + offset[1] y0 = seq(ylim[1] - 2 * dy, ylim[2] + 2 * dy, dy) + offset[2] y <- rep(y0, each = length(x0)) x <- rep(c(x0, x0 + dx / 2), length.out = length(y)) xy = cbind(x, y) # the coordinates # compute the indexes, using double coordinates: odd <- seq(1, by = 2, length.out = length(x0)) even <- seq(2, by = 2, length.out = length(x0)) xi <- rep(c(odd, even), length.out = length(y)) yi <- rep(seq_along(y0), each = length(x0)) # hexagon centers are columns with x index 3, 6, 9, ... : centers = cbind(xi,yi)[xi %in% seq(3, max(xi) - 2, by = 3) & yi > 1 & yi < max(yi),] # relative offset in double coordinates, https://www.redblobgames.com/grids/hexagons/ nx = length(x0) xy_pattern = rbind(c(-2,0), c(-1,-1), c(1,-1), c(2,0), c(1,1), c(-1,1), c(-2,0)) i_from_x = function(x) ((x[,1] - 1) %/% 2 + 1) + (x[,2] - 1) * nx mk_point = if (flat_topped) function(center) st_point(xy[i_from_x(matrix(center, ncol = 2)),]) else function(center) st_point(xy[i_from_x(matrix(center, ncol = 2)),2:1]) mk_pol = if (flat_topped) function(center) { m = matrix(center, ncol=2, nrow = 7, byrow=TRUE) + xy_pattern st_polygon(list(xy[i_from_x(m),])) } else function(center) { m = matrix(center, ncol=2, nrow = 7, byrow=TRUE) + xy_pattern st_polygon(list(xy[i_from_x(m),2:1])) } if (what == "centers") st_sfc(lapply(seq_len(nrow(centers)), function(i) mk_point(centers[i,])), crs = st_crs(bb)) else # points: st_sfc(lapply(seq_len(nrow(centers)), function(i) mk_pol(centers[i,])), crs = st_crs(bb)) } ================================================ FILE: R/maps.R ================================================ NAmat2xyList <- function(xy) { NAs <- unclass(attr(na.omit(xy), "na.action")) if ((length(NAs) == 1L) && (NAs == nrow(xy))) { xy <- xy[-nrow(xy)] # nocov NAs <- NULL # nocov } # NA problem found by Edzer Pebesma, 24/8-06 diffNAs <- diff(NAs) if (any(diffNAs == 1)) { xy <- xy[-(NAs[which(diffNAs == 1)] + 1), ] # nocov NAs <- unclass(attr(na.omit(xy), "na.action")) # nocov } nParts <- length(NAs) + 1L # two NAs at end of file 070905 RSB # no NAs at all RSB 080814 if (!is.null(NAs) && nrow(xy) == NAs[length(NAs)]) nParts <- nParts - 1 res <- vector(mode="list", length=nParts) from <- integer(nParts) to <- integer(nParts) from[1] <- 1 to[nParts] <- nrow(xy) # two NAs at end of file 070905 RSB # no NAs at all RSB 080814 if (!is.null(NAs) && nrow(xy) == NAs[length(NAs)]) to[nParts] <- to[nParts] - 1 if (nParts > 1) { for (i in 2:nParts) { to[(i-1)] <- NAs[(i-1)]-1 from[i] <- NAs[(i-1)]+1 } } for (i in seq_len(nParts)) res[[i]] <- xy[from[i]:to[i],, drop = FALSE] res } map2pol = function(xyList, ID) { # close rings: xyList = lapply(xyList, ClosePol) # group into MULTIPOLYGON: uID = unique(ID) ret = vector("list", length(uID)) for (g in seq_along(uID)) ret[[g]] = st_multipolygon(lapply(xyList[ uID[g] == ID ], function(x) list(x))) st_sfc(ret) } map2lin = function(xyList, ID) { # group into MULTILINESTRING: uID = unique(ID) ret = vector("list", length(uID)) for (g in seq_along(uID)) { x = xyList[uID[g] == ID] x = x[!sapply(x, is.null)] ret[[g]] = st_multilinestring(x) } # ret[[g]] = st_multilinestring(xyList[ uID[g] == ID ]) st_sfc(ret) } #' @export #' @name st_as_sf #' @param fill logical; the value for \code{fill} that was used in the call to \link[maps]{map}. #' @param group logical; if \code{TRUE}, group id labels from \link[maps]{map} by their prefix before \code{:} st_as_sf.map = function(x, ..., fill = TRUE, group = TRUE) { ID = if (group) vapply(strsplit(x$names, ":"), function(y) y[1], "") else x$names xyList <- NAmat2xyList(cbind(x$x, x$y)) geom = if (fill) map2pol(xyList, ID) else map2lin(xyList, ID) ID = unique(ID) stopifnot(length(ID) == length(geom)) st_sf(ID = ID, geom = geom, crs = "+proj=longlat +ellps=clrk66 +no_defs +type=crs", row.names = ID) } #' @export #' @name st_as_sfc st_as_sfc.map = function(x, ...) { st_geometry(st_as_sf(x, ...)) } ================================================ FILE: R/nearest.R ================================================ #' get nearest points between pairs of geometries #' #' get nearest points between pairs of geometries #' @param x object of class \code{sfg}, \code{sfc} or \code{sf} #' @param y object of class \code{sfg}, \code{sfc} or \code{sf}; needs to have the same number of geometries of `x` when `by_element=TRUE` #' @param by_element logical; if \code{FALSE} (default) return nearest points between all possible pairs, if \code{TRUE}, return nearest points between row-wise x-y pairs. #' @param pairwise logical; deprecated in favour of `by_element` #' @param ... ignored #' @seealso \link{st_nearest_feature} for finding the nearest feature #' @return an \link{sfc} object with all two-point \code{LINESTRING} geometries of point pairs from the first to the second geometry, of length x * y if `by_element=FALSE` (with y cycling fastest), or lf length `length(x)` when `by_element=TRUE`. See examples for ideas how to convert these to \code{POINT} geometries. #' @details in case \code{x} lies inside \code{y}, when using S2, the end points #' are on polygon boundaries, when using GEOS the end point are identical to \code{x}. #' @examples #' r = sqrt(2)/10 #' pt1 = st_point(c(.1,.1)) #' pt2 = st_point(c(.9,.9)) #' pt3 = st_point(c(.9,.1)) #' b1 = st_buffer(pt1, r) #' b2 = st_buffer(pt2, r) #' b3 = st_buffer(pt3, r) #' (ls0 = st_nearest_points(b1, b2)) # sfg #' (ls = st_nearest_points(st_sfc(b1), st_sfc(b2, b3))) # sfc #' plot(b1, xlim = c(-.2,1.2), ylim = c(-.2,1.2), col = NA, border = 'green') #' plot(st_sfc(b2, b3), add = TRUE, col = NA, border = 'blue') #' plot(ls, add = TRUE, col = 'red') #' #' nc = st_read(system.file("gpkg/nc.gpkg", package="sf")) #' plot(st_geometry(nc)) #' ls = st_nearest_points(nc[1,], nc) #' plot(ls, col = 'red', add = TRUE) #' pts = st_cast(ls, "POINT") # gives all start & end points #' # starting, "from" points, corresponding to x: #' plot(pts[seq(1, 200, 2)], add = TRUE, col = 'blue') #' # ending, "to" points, corresponding to y: #' plot(pts[seq(2, 200, 2)], add = TRUE, col = 'green') #' #' @export st_nearest_points = function(x, y, ..., by_element = FALSE) UseMethod("st_nearest_points") #' @export #' @name st_nearest_points st_nearest_points.sfc = function(x, y, ..., pairwise = by_element, by_element = FALSE) { stopifnot(st_crs(x) == st_crs(y)) longlat = isTRUE(st_is_longlat(x)) if (longlat && sf_use_s2()) { ret = if (pairwise) s2::s2_minimum_clearance_line_between(x, y) else do.call(c, lapply(x, s2::s2_minimum_clearance_line_between, y)) st_as_sfc(ret, crs = st_crs(x)) } else { if (longlat) message_longlat("st_nearest_points") st_sfc(CPL_geos_nearest_points(x, st_geometry(y), pairwise), crs = st_crs(x)) } } #' @export #' @name st_nearest_points st_nearest_points.sfg = function(x, y, ...) { st_nearest_points(st_geometry(x), st_geometry(y), ...) } #' @export #' @name st_nearest_points st_nearest_points.sf = function(x, y, ...) { st_nearest_points(st_geometry(x), st_geometry(y), ...) } #' get index of nearest feature #' #' get index of nearest feature #' @param x object of class \code{sfg}, \code{sfc} or \code{sf} #' @param y object of class \code{sfg}, \code{sfc} or \code{sf}; if missing, features in \code{x} will be compared to all remaining features in \code{x}. #' @param ... ignored #' @param check_crs logical; should \code{x} and \code{y} be checked for CRS equality? #' @param longlat logical; does \code{x} have ellipsoidal coordinates? #' @return for each feature (geometry) in \code{x} the index of the nearest feature (geometry) in #' set \code{y}, or in the remaining set of \code{x} if \code{y} is missing; #' empty geometries result in \code{NA} indexes #' @seealso \link{st_nearest_points} for finding the nearest points for pairs of feature geometries #' @export #' @examples #' ls1 = st_linestring(rbind(c(0,0), c(1,0))) #' ls2 = st_linestring(rbind(c(0,0.1), c(1,0.1))) #' ls3 = st_linestring(rbind(c(0,1), c(1,1))) #' (l = st_sfc(ls1, ls2, ls3)) #' #' p1 = st_point(c(0.1, -0.1)) #' p2 = st_point(c(0.1, 0.11)) #' p3 = st_point(c(0.1, 0.09)) #' p4 = st_point(c(0.1, 0.9)) #' #' (p = st_sfc(p1, p2, p3, p4)) #' try(st_nearest_feature(p, l)) #' try(st_nearest_points(p, l[st_nearest_feature(p,l)], pairwise = TRUE)) #' #' r = sqrt(2)/10 #' b1 = st_buffer(st_point(c(.1,.1)), r) #' b2 = st_buffer(st_point(c(.9,.9)), r) #' b3 = st_buffer(st_point(c(.9,.1)), r) #' circles = st_sfc(b1, b2, b3) #' plot(circles, col = NA, border = 2:4) #' pts = st_sfc(st_point(c(.3,.1)), st_point(c(.6,.2)), st_point(c(.6,.6)), st_point(c(.4,.8))) #' plot(pts, add = TRUE, col = 1) #' # draw points to nearest circle: #' nearest = try(st_nearest_feature(pts, circles)) #' if (inherits(nearest, "try-error")) # GEOS 3.6.1 not available #' nearest = c(1, 3, 2, 2) #' ls = st_nearest_points(pts, circles[nearest], pairwise = TRUE) #' plot(ls, col = 5:8, add = TRUE) #' # compute distance between pairs of nearest features: #' st_distance(pts, circles[nearest], by_element = TRUE) st_nearest_feature = function(x, y, ..., check_crs = TRUE, longlat = isTRUE(st_is_longlat(x))) { if (missing(y)) { # https://github.com/r-spatial/s2/issues/111#issuecomment-835306261 longlat = force(longlat) # evaluate only once x = st_geometry(x) ind <- vapply( seq_along(x), function(i) st_nearest_feature(x[i], x[-i], check_crs = FALSE, longlat = longlat), integer(1) ) ifelse(ind >= seq_along(x), ind + 1, ind) } else { if (check_crs) stopifnot(st_crs(x) == st_crs(y)) if (longlat && sf_use_s2()) s2::s2_closest_feature(x, y) else { if (longlat) message_longlat("st_nearest_feature") CPL_geos_nearest_feature(st_geometry(x), st_geometry(y)) } } } ================================================ FILE: R/normalize.R ================================================ #' Normalize simple features #' #' \code{st_normalize} transforms the coordinates in the input feature to fall #' between 0 and 1. By default the current domain is set to the bounding box of #' the input, but other domains can be used as well #' #' @param x object of class sf, sfc or sfg #' @param domain The domain \code{x} should be normalized from as a length 4 #' vector of the form \code{c(xmin, ymin, xmax, ymax)}. Defaults to the #' bounding box of \code{x} #' @param ... ignored #' #' @export #' #' @examples #' p1 = st_point(c(7,52)) #' st_normalize(p1, domain = c(0, 0, 10, 100)) #' #' p2 = st_point(c(-30,20)) #' sfc = st_sfc(p1, p2, crs = 4326) #' sfc #' sfc_norm <- st_normalize(sfc) #' st_bbox(sfc_norm) #' st_normalize <- function(x, domain = st_bbox(x), ...) { UseMethod("st_normalize") } #' @export st_normalize.sfg <- function(x, domain = st_bbox(x), ...) { (x - domain[c(1, 2)]) / diag(c(domain[3] - domain[1], domain[4] - domain[2])) } #' @export st_normalize.sfc <- function(x, domain = st_bbox(x), ...) { domain <- as.numeric(domain) if (length(x) == 0) return(x) min <- -domain[c(1, 2)] range <- 1 / c(domain[3] - domain[1], domain[4] - domain[2]) if (any(is.infinite(range)) || any(range < 0)) { stop("domain must have a positive range") # nocov } normalize_sfc(x, min, range, NA_crs_) } #' @export st_normalize.sf <- function(x, domain = st_bbox(x), ...) { x[[ attr(x, "sf_column") ]] = st_normalize(st_geometry(x), domain, ...) x } ================================================ FILE: R/plot.R ================================================ kw_dflt = function(x, key.pos) { if (is.null(key.pos) || key.pos[1] == 0) # no key: return(lcm(0)) font_scale = par("ps") / 12 if (key.pos[1] == -1) lcm(1.8 * font_scale) else if (key.pos[1] %in% c(2, 4) && (is.character(x[[1]]) || is.factor(x[[1]]))) { strings = if (is.factor(x[[1]])) levels(x[[1]]) else x[[1]] lcm(cm(max(strwidth(strings, "inches"))) * 1.3 + font_scale) # cm #lcm(cm(max(strwidth(strings, "inches"))) * 1.3) # cm } else lcm(1.8 * font_scale) } # like cut.default, but only return integers, and allow for duplicate breaks: sf_cut = function(values, breaks, include.lowest = TRUE) { i = findInterval(values, breaks, left.open = TRUE) if (include.lowest) i[values == breaks[1]] = 1 i[i == 0 | i == length(breaks)] = NA i } #' plot sf object #' #' plot one or more attributes of an sf object on a map #' Plot sf object #' #' @param x object of class sf #' @param y ignored #' @param ... further specifications, see \link{plot_sf} and \link{plot} and details. #' @param main title for plot (\code{NULL} to remove) #' @param pal palette function, similar to \link{rainbow}, or palette values; if omitted, \code{sf.colors} is used #' @param nbreaks number of colors breaks (ignored for \code{factor} or \code{character} variables) #' @param breaks either a numeric vector with the actual breaks, or a name of a method accepted by the \code{style} argument of \link[classInt]{classIntervals} #' @param max.plot integer; lower boundary to maximum number of attributes to plot; the default value (9) can be overridden by setting the global option \code{sf_max.plot}, e.g. \code{options(sf_max.plot=2)} #' @param key.pos numeric; side to plot a color key: 1 bottom, 2 left, 3 top, 4 right; set to \code{NULL} to omit key completely, 0 to only not plot the key, or -1 to select automatically. If multiple columns are plotted in a single function call by default no key is plotted and every submap is stretched individually; if a key is requested (and \code{col} is missing) all maps are colored according to a single key. Auto select depends on plot size, map aspect, and, if set, parameter \code{asp}. If it has lenght 2, the second value, ranging from 0 to 1, determines where the key is placed in the available space (default: 0.5, center). #' @param key.width amount of space reserved for the key (incl. labels), thickness/width of the scale bar #' @param key.length amount of space reserved for the key along its axis, length of the scale bar #' @param pch plotting symbol #' @param cex symbol size #' @param bg symbol background color #' @param lty line type #' @param lwd line width #' @param col color for plotting features; if \code{length(col)} does not equal 1 or \code{nrow(x)}, a warning is emitted that colors will be recycled. Specifying \code{col} suppresses plotting the legend key. #' @param border color of polygon border(s); using \code{NA} hides them #' @param add logical; add to current plot? Note that when using \code{add=TRUE}, you may have to set \code{reset=FALSE} in the first plot command. #' @param type plot type: 'p' for points, 'l' for lines, 'b' for both #' @param reset logical; if \code{FALSE}, keep the plot in a mode that allows adding further map elements; if \code{TRUE} restore original mode after plotting \code{sf} objects with attributes; see details. #' @param logz logical; if \code{TRUE}, use log10-scale for the attribute variable. In that case, \code{breaks} and \code{at} need to be given as log10-values; see examples. #' @param extent object with an \code{st_bbox} method to define plot extent; defaults to \code{x} #' @param xlim numeric; x-axis limits; overrides \code{extent} #' @param ylim numeric; y-axis limits; overrides \code{extent} #' @param compact logical; compact sub-plots over plotting space? #' @method plot sf #' @name plot #' @details \code{plot.sf} maximally plots \code{max.plot} maps with colors following from attribute columns, #' one map per attribute. It uses \code{sf.colors} for default colors. For more control over placement of individual maps, #' set parameter \code{mfrow} with \link{par} prior to plotting, and plot single maps one by one; note that this only works #' in combination with setting parameters \code{key.pos=NULL} (no legend) and \code{reset=FALSE}. #' #' \code{plot.sfc} plots the geometry, additional parameters can be passed on #' to control color, lines or symbols. #' #' When setting \code{reset} to \code{FALSE}, the original device parameters are lost, and the device must be reset using \code{dev.off()} in order to reset it. #' #' parameter \code{at} can be set to specify where labels are placed along the key; see examples. #' #' parameter \code{mar} can be set in \code{...} to override default margins. #' #' The features are plotted in the order as they apppear in the sf object. See examples for when a different plotting order is wanted. #' #' @examples #' nc = st_read(system.file("gpkg/nc.gpkg", package="sf"), quiet = TRUE) #' # plot single attribute, auto-legend: #' plot(nc["SID74"]) #' # plot multiple: #' plot(nc[c("SID74", "SID79")]) # better use ggplot2::geom_sf to facet and get a single legend! #' # adding to a plot of an sf object only works when using reset=FALSE in the first plot: #' plot(nc["SID74"], reset = FALSE) #' plot(st_centroid(st_geometry(nc)), add = TRUE) #' # log10 z-scale: #' plot(nc["SID74"], logz = TRUE, breaks = c(0,.5,1,1.5,2), at = c(0,.5,1,1.5,2)) #' # and we need to reset the plotting device after that, e.g. by #' layout(1) #' # when plotting only geometries, the reset=FALSE is not needed: #' plot(st_geometry(nc)) #' plot(st_geometry(nc)[1], col = 'red', add = TRUE) #' # add a custom legend to an arbitray plot: #' layout(matrix(1:2, ncol = 2), widths = c(1, lcm(2))) #' plot(1) #' .image_scale(1:10, col = sf.colors(9), key.length = lcm(8), key.pos = 4, at = 1:10) #' # manipulate plotting order, plot largest polygons first: #' p = st_polygon(list(rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0)))) #' x = st_sf(a=1:4, st_sfc(p, p * 2, p * 3, p * 4)) # plot(x, col=2:5) only shows the largest polygon! #' plot(x[order(st_area(x), decreasing = TRUE),], col = 2:5) # plot largest polygons first #' #' @export plot.sf <- function(x, y, ..., main, pal = NULL, nbreaks = 10, breaks = "pretty", max.plot = getOption("sf_max.plot", default = 9), key.pos = get_key_pos(x, ...), key.length = .618, key.width = kw_dflt(x, key.pos), reset = TRUE, logz = FALSE, extent = x, xlim = st_bbox(extent)[c(1,3)], ylim = st_bbox(extent)[c(2,4)], compact = FALSE) { stopifnot(missing(y)) nbreaks.missing = missing(nbreaks) key.pos.missing = missing(key.pos) max_plot_missing = missing(max.plot) dots = list(...) col_missing = is.null(dots$col) breaks_numeric = is.numeric(breaks) reset_layout_needed = reset x = swap_axes_if_needed(x) # The following code defines an expression which resets the plotting layout. # The on.exit approach is needed since the plotting routing may fail for # various reasons leaving the plot layout in a broken state. The on.exit # ensures that we "clean" such broken state regardless of the failure/success # of the plotting routing. See also #2519 for more details. on.exit( expr = { if (!isTRUE(dots$add) && reset) { # reset device: if (reset_layout_needed) layout(matrix(1)) par(opar) } }, add = TRUE ) opar = par(no.readonly = TRUE) if (ncol(x) > 2 && !isTRUE(dots$add)) { # multiple maps to plot... cols = setdiff(names(x), attr(x, "sf_column")) lt = .get_layout(st_bbox(x), min(max.plot, length(cols)), par("din"), key.pos[1], key.width) if (key.pos.missing || key.pos[1] == -1) key.pos = lt$key.pos layout(lt$m, widths = lt$widths, heights = lt$heights, respect = compact) mar = if (is.null(dots$mar)) { if (isTRUE(dots$axes)) c(2.1, 2.1, 1.2, 0) else c(0, 0, 1.2, 0) } else dots$mar par(mar = mar) if (max_plot_missing) max.plot = prod(lt$mfrow) if (isTRUE(is.finite(max.plot)) && ncol(x) - 1 > max.plot && max_plot_missing && is.null(options("sf_max.plot")[[1]])) warning(paste("plotting the first", max.plot, "out of", ncol(x)-1, "attributes; use max.plot =", ncol(x) - 1, "to plot all"), call. = FALSE) # col selection may have changed; set cols again: cols = setdiff(names(x), attr(x, "sf_column")) if (length(cols) > max.plot) cols = cols[1:max.plot] if (!is.null(key.pos)) { values = do.call(c, as.data.frame(x)[cols]) if (is.character(values)) values = as.factor(values) if (logz) values = log10(values) if (is.character(breaks) && is.numeric(values)) { # compute breaks from values: v0 = values[!is.na(values)] n.unq = length(unique(v0)) breaks = if (! all(is.na(values)) && n.unq > 1) classInt::classIntervals(v0, min(nbreaks, n.unq), breaks, warnSmallN = FALSE)$brks else range(values, na.rm = TRUE) # lowest and highest! nbreaks = length(breaks) - 1 } } if (nbreaks.missing && is.numeric(breaks)) nbreaks = length(breaks) - 1 # loop over each map to plot: lapply(cols, function(cname) plot(x[, cname], main = cname, pal = pal, nbreaks = nbreaks, breaks = breaks, key.pos = NULL, reset = FALSE, logz = logz, xlim = xlim, ylim = ylim,...)) for (i in seq_len(prod(lt$mfrow) - length(cols))) # empty panels: plot.new() # plot key? if (!is.null(key.pos) && key.pos[1] != 0 && col_missing) { if (is.null(pal)) pal = function(n) sf.colors(n, categorical = is.factor(values)) colors = if (is.function(pal)) pal(nbreaks) else pal if (is.factor(values)) .image_scale_factor(levels(values), colors, key.pos = key.pos, key.width = key.width, key.length = key.length, ...) else .image_scale(values, colors, breaks = breaks, key.pos = key.pos, key.length = key.length, logz = logz, ...) } } else { # single map, or dots$add == TRUE: if (ncol(x) == 1) { # no attributes to choose colors from: plot geometry plot(st_geometry(x), xlim = xlim, ylim = ylim, ...) reset_layout_needed = FALSE } else { # generate plot with colors and possibly key if (ncol(x) > 2) { # add = TRUE warning("ignoring all but the first attribute") x = x[,1] } # store attribute in "values": values = x[[setdiff(names(x), attr(x, "sf_column"))]] if (is.list(values)) { reset_layout_needed = TRUE # nocov stop("plotting list-columns not supported") # nocov } if (is.character(values)) values = as.factor(values) else if (logz) values = log10(as.numeric(values)) if (is.null(pal)) pal = function(n) sf.colors(n, categorical = is.factor(values)) else if (! col_missing) { reset_layout_needed = TRUE stop("specify only one of `col' and `pal'") } if (col_missing) { # compute colors from values: col = if (is.factor(values)) { if (key.pos.missing && nlevels(values) > 30) # doesn't make sense: key.pos = NULL colors = if (is.function(pal)) pal(nlevels(values)) else pal colors[as.numeric(values)] } else { if (! inherits(values, c("POSIXt", "Date"))) values = as.numeric(values) # drop units, if any if (is.character(breaks)) { # compute breaks from values: v0 = values[!is.na(values)] n.unq = length(unique(v0)) breaks = if (! all(is.na(values)) && n.unq > 1) classInt::classIntervals(v0, min(nbreaks, n.unq), breaks, warnSmallN = FALSE)$brks else range(values, na.rm = TRUE) # lowest and highest! } # this is necessary if breaks were specified either as character or as numeric # "pretty" takes nbreaks as advice only: nbreaks = length(breaks) - 1 cuts = if (all(is.na(values))) rep(NA_integer_, length(values)) else if (!breaks_numeric && diff(range(values, na.rm = TRUE)) == 0) ifelse(is.na(values), NA_integer_, 1L) else if (inherits(values, c("POSIXt", "Date"))) cut(values, breaks, include.lowest = TRUE) else sf_cut(values, breaks, include.lowest = TRUE) colors = if (is.function(pal)) pal(nbreaks) else pal colors[cuts] } } else { col = dots$col if (length(col) != 1 && length(col) != nrow(x)) warning("col is not of length 1 or nrow(x): colors will be recycled; use pal to specify a color palette") key.pos = NULL # no key! } if (!isTRUE(dots$add) && !is.null(key.pos) && !all(is.na(values)) && (is.factor(values) || length(unique(na.omit(values))) > 1 || breaks_numeric) && # 2065 length(col) > 1) { # plot key? switch(key.pos[1], layout(matrix(c(2,1), nrow = 2, ncol = 1), widths = 1, heights = c(1, key.width)), # 1 bottom layout(matrix(c(1,2), nrow = 1, ncol = 2), widths = c(key.width, 1), heights = 1), # 2 left layout(matrix(c(1,2), nrow = 2, ncol = 1), widths = 1, heights = c(key.width, 1)), # 3 top layout(matrix(c(2,1), nrow = 1, ncol = 2), widths = c(1, key.width), heights = 1) # 4 right ) if (is.factor(values)) { .image_scale_factor(levels(values), colors, key.pos = key.pos, key.width = key.width, key.length = key.length, ...) } else .image_scale(values, colors, breaks = breaks, key.pos = key.pos, key.length = key.length, logz = logz, ...) } else reset_layout_needed = FALSE # as we didn't call layout() # plot the map: if (!isTRUE(dots$add)) { if (is.null(dots$mar)) { mar = c(1, 1, 1.2, 1) if (isTRUE(dots$axes)) mar[1:2] = 2.1 } else mar = dots$mar par(mar = mar) } if (col_missing) plot(st_geometry(x), col = col, xlim = xlim, ylim = ylim, ...) else plot(st_geometry(x), xlim = xlim, ylim = ylim, ...) } if (! isTRUE(dots$add)) { # title? if (missing(main)) { main = setdiff(names(x), attr(x, "sf_column")) if (length(main) && inherits(x[[main]], "units")) main = make_unit_label(main, x[[main]]) } localTitle <- function(..., extent, col, bg, pch, cex, lty, lwd, axes, type, bgMap, border, graticule, xlim, ylim, asp, bgc, xaxs, yaxs, lab, setParUsrBB, expandBB, col_graticule, at, lon, lat, crs, datum, ndiscr, margin) # absorb title(...) localTitle(main, ...) } } invisible() } swap_axes_if_needed = function(x) { crs = st_crs(x) if (st_axis_order() && !is.na(crs) && crs$yx) st_transform(x, pipeline = "+proj=pipeline +step +proj=axisswap +order=2,1") else x } #' @name plot #' @export get_key_pos = function(x, ...) { bb = st_bbox(x) if (anyNA(bb) || (inherits(x, "sf") && ncol(x) > 2)) NULL else { pin = par("pin") # (width, height) asp_plt = pin[2]/pin[1] # y/x: < 1 means wide asp_box = diff(bb[c(4,2)]) / diff(bb[c(3,1)]) asp = list(...)$asp if (is.null(asp)) asp <- ifelse(isTRUE(st_is_longlat(x)), 1/cos((mean(bb[c(2,4)]) * pi)/180), 1.0) asp_box = asp_box * asp if (!is.finite(asp_box) || asp_box < asp_plt) # plot is wider than device: below 1 else # plot is taller than device: to the right 4 } } #' @name plot #' @method plot sfc_POINT #' @export plot.sfc_POINT = function(x, y, ..., pch = 1, cex = 1, col = 1, bg = 0, lwd = 1, lty = 1, type = 'p', add = FALSE) { stopifnot(missing(y)) if (! add) plot_sf(x, ...) npts = length(x) if (npts == 0) return() pch = rep(pch, length.out = npts) col = rep(col, length.out = npts) bg = rep(bg, length.out = npts) cex = rep(cex, length.out = npts) mat = t(matrix(unlist(x, use.names = FALSE), ncol = length(x))) #933 if (!is.null(mat)) { ne = !is.na(rowMeans(mat)) ## faster than apply; #933 points(mat[ne,, drop = FALSE], pch = pch[ne], col = col[ne], bg = bg[ne], cex = cex[ne], lwd = lwd, lty = lty, type = type) } } #' @name plot #' @method plot sfc_MULTIPOINT #' @export plot.sfc_MULTIPOINT = function(x, y, ..., pch = 1, cex = 1, col = 1, bg = 0, lwd = 1, lty = 1, type = 'p', add = FALSE) { stopifnot(missing(y)) if (! add) plot_sf(x, ...) n = length(x) if (n == 0) return() pch = rep(pch, length.out = n) col = rep(col, length.out = n) bg = rep(bg, length.out = n) cex = rep(cex, length.out = n) lwd = rep(lwd, length.out = n) lty = rep(lty, length.out = n) non_empty = ! st_is_empty(x) lapply(seq_along(x), function(i) if (non_empty[i]) points(x[[i]], pch = pch[i], col = col[i], bg = bg[i], cex = cex[i], lwd = lwd[i], lty = lty[i], type = type)) invisible(NULL) } #' @name plot #' @method plot sfc_LINESTRING #' @export plot.sfc_LINESTRING = function(x, y, ..., lty = 1, lwd = 1, col = 1, pch = 1, type = 'l', add = FALSE) { # FIXME: take care of lend, ljoin, and lmitre stopifnot(missing(y)) if (! add) plot_sf(x, ...) lty = rep(lty, length.out = length(x)) lwd = rep(lwd, length.out = length(x)) col = rep(col, length.out = length(x)) pch = rep(pch, length.out = length(x)) non_empty = ! st_is_empty(x) lapply(seq_along(x), function(i) if (non_empty[i]) lines(x[[i]], lty = lty[i], lwd = lwd[i], col = col[i], pch = pch[i], type = type)) invisible(NULL) } #' @name plot #' @method plot sfc_CIRCULARSTRING #' @export plot.sfc_CIRCULARSTRING = function(x, y, ...) { plot(st_cast(x, "LINESTRING"), ...) } #' @name plot #' @method plot sfc_MULTILINESTRING #' @export plot.sfc_MULTILINESTRING = function(x, y, ..., lty = 1, lwd = 1, col = 1, pch = 1, type = 'l', add = FALSE) { # FIXME: take care of lend, ljoin, and lmitre stopifnot(missing(y)) if (! add) plot_sf(x, ...) lty = rep(lty, length.out = length(x)) lwd = rep(lwd, length.out = length(x)) col = rep(col, length.out = length(x)) pch = rep(pch, length.out = length(x)) non_empty = ! st_is_empty(x) lapply(seq_along(x), function(i) if (non_empty[i]) lapply(x[[i]], function(L) lines(L, lty = lty[i], lwd = lwd[i], col = col[i], pch = pch[i], type = type))) invisible(NULL) } # sf (list) -> polypath (mtrx) : rbind polygon rings with NA rows inbetween p_bind = function(lst) { if (length(lst) == 1) lst[[1]] else { ret = vector("list", length(lst) * 2 - 1) ret[seq(1, length(lst) * 2 - 1, by = 2)] = lst # odd elements ret[seq(2, length(lst) * 2 - 1, by = 2)] = NA # even elements do.call(rbind, ret) # replicates the NA to form an NA row } } #' @name plot #' @param rule see \link[graphics]{polypath}; for \code{winding}, exterior ring direction should be opposite that of the holes; with \code{evenodd}, plotting is robust against misspecified ring directions #' @param xpd see \link[graphics]{par}; sets polygon clipping strategy; only implemented for POLYGON and MULTIPOLYGON #' @export plot.sfc_POLYGON = function(x, y, ..., lty = 1, lwd = 1, col = NA, cex = 1, pch = NA, border = 1, add = FALSE, rule = "evenodd", xpd = par("xpd")) { # FIXME: take care of lend, ljoin, and lmitre stopifnot(missing(y)) if (! add) plot_sf(x, ...) lty = rep(lty, length.out = length(x)) lwd = rep(lwd, length.out = length(x)) col = rep(col, length.out = length(x)) border = rep(border, length.out = length(x)) non_empty = ! st_is_empty(x) lapply(seq_along(x), function(i) if (non_empty[i]) polypath(p_bind(x[[i]]), border = border[i], lty = lty[i], lwd = lwd[i], col = col[i], rule = rule, xpd = xpd)) # if (any(!is.na(pch))) { # pch = rep(pch, length.out = length(x)) # cex = rep(cex, length.out = length(x)) # lapply(seq_along(x), function(i) # if (non_empty[i]) # points(p_bind(x[[i]]), pch = pch[i], cex = cex[i], type = 'p')) # } invisible(NULL) } #' @name plot #' @method plot sfc_MULTIPOLYGON #' @export plot.sfc_MULTIPOLYGON = function(x, y, ..., lty = 1, lwd = 1, col = NA, border = 1, add = FALSE, rule = "evenodd", xpd = par("xpd")) { # FIXME: take care of lend, ljoin, and lmitre stopifnot(missing(y)) if (! add) plot_sf(x, ...) lty = rep(lty, length.out = length(x)) lwd = rep(lwd, length.out = length(x)) col = rep(col, length.out = length(x)) border = rep(border, length.out = length(x)) non_empty = ! st_is_empty(x) lapply(seq_along(x), function(i) if (non_empty[i]) lapply(x[[i]], function(L) polypath(p_bind(L), border = border[i], lty = lty[i], lwd = lwd[i], col = col[i], rule = rule, xpd = xpd))) invisible(NULL) } # plot single geometrycollection: plot_gc = function(x, pch, cex, bg, border = 1, lty, lwd, col, add) { lapply(x, function(subx) { args = list(st_sfc(subx), pch = pch, cex = cex, bg = bg, border = border, lty = lty, lwd = lwd, col = col, add = TRUE) fn = switch(class(subx)[2], POINT = plot.sfc_POINT, MULTIPOINT = plot.sfc_MULTIPOINT, LINESTRING = plot.sfc_LINESTRING, MULTILINESTRING = plot.sfc_MULTILINESTRING, POLYGON = plot.sfc_POLYGON, CIRCULARSTRING = plot.sfc_CIRCULARSTRING, MULTIPOLYGON = plot.sfc_MULTIPOLYGON, MULTISURFACE = plot.sfc_GEOMETRYCOLLECTION, CURVEPOLYGON = plot.sfc_GEOMETRYCOLLECTION, COMPOUNDCURVE = plot.sfc_GEOMETRYCOLLECTION, GEOMETRYCOLLECTION = plot.sfc_GEOMETRYCOLLECTION, stop(paste("plotting of", class(x)[2], "not yet supported: use st_cast?")) ) do.call(fn, args) }) invisible(NULL) } #' @name plot #' @method plot sfc_GEOMETRYCOLLECTION #' @export plot.sfc_GEOMETRYCOLLECTION = function(x, y, ..., pch = 1, cex = 1, bg = 0, lty = 1, lwd = 1, col = 1, border = 1, add = FALSE) { # FIXME: take care of lend, ljoin, xpd, and lmitre stopifnot(missing(y)) if (! add) plot_sf(x, ...) cex = rep(cex, length.out = length(x)) pch = rep(pch, length.out = length(x)) lty = rep(lty, length.out = length(x)) lwd = rep(lwd, length.out = length(x)) col = rep(col, length.out = length(x)) border = rep(border, length.out = length(x)) lapply(seq_along(x), function(i) plot_gc(x[[i]], pch = pch[i], cex = cex[i], bg = bg[i], border = border[i], lty = lty[i], lwd = lwd[i], col = col[i])) invisible(NULL) } #' @name plot #' @method plot sfc_GEOMETRY #' @export plot.sfc_GEOMETRY = function(x, y, ..., pch = 1, cex = 1, bg = 0, lty = 1, lwd = 1, col = ifelse(st_dimension(x) == 2, NA, 1), border = 1, add = FALSE) { stopifnot(missing(y)) if (! add) plot_sf(x, ...) cex = rep(cex, length.out = length(x)) pch = rep(pch, length.out = length(x)) lty = rep(lty, length.out = length(x)) lwd = rep(lwd, length.out = length(x)) col = rep(col, length.out = length(x)) border = rep(border, length.out = length(x)) lapply(seq_along(x), function(i) plot_gc(st_sfc(x[[i]]), pch = pch[i], cex = cex[i], bg = bg[i], border = border[i], lty = lty[i], lwd = lwd[i], col = col[i])) invisible(NULL) } #' @name plot #' @method plot sfg #' @export plot.sfg = function(x, ...) { plot(st_sfc(x), ...) } # set up plotting area & axes; reuses sp:::plot.Spatial #' @name plot #' @param xlim see \link{plot.window} #' @param ylim see \link{plot.window} #' @param asp see below, and see \link{par} #' @param axes logical; should axes be plotted? (default FALSE) #' @param bgc background color #' @param xaxs see \link{par} #' @param yaxs see \link{par} #' @param lab see \link{par} #' @param setParUsrBB default FALSE; set the \code{par} \dQuote{usr} bounding box; see below #' @param bgMap object of class \code{ggmap}, or returned by function \code{RgoogleMaps::GetMap} #' @param expandBB numeric; fractional values to expand the bounding box with, #' in each direction (bottom, left, top, right) #' @param graticule logical, or object of class \code{crs} (e.g., \code{st_crs('OGC:CRS84')} for a WGS84 graticule), or object created by \link{st_graticule} #' @param col_graticule color to used for the graticule (if present) #' @export #' @details \code{plot_sf} sets up the plotting area, axes, graticule, or webmap background; it #' is called by all \code{plot} methods before anything is drawn. #' #' The argument \code{setParUsrBB} may be used to pass the logical value \code{TRUE} to functions within \code{plot.Spatial}. When set to \code{TRUE}, par(\dQuote{usr}) will be overwritten with \code{c(xlim, ylim)}, which defaults to the bounding box of the spatial object. This is only needed in the particular context of graphic output to a specified device with given width and height, to be matched to the spatial object, when using par(\dQuote{xaxs}) and par(\dQuote{yaxs}) in addition to \code{par(mar=c(0,0,0,0))}. #' #' The default aspect for map plots is 1; if however data are not #' projected (coordinates are long/lat), the aspect is by default set to #' 1/cos(My * pi/180) with My the y coordinate of the middle of the map #' (the mean of \code{ylim}, which defaults to the y range of bounding box). This #' implies an \href{https://en.wikipedia.org/wiki/Equirectangular_projection}{Equirectangular projection}. #' plot_sf = function(x, xlim = NULL, ylim = NULL, asp = NA, axes = FALSE, bgc = par("bg"), ..., xaxs, yaxs, lab, setParUsrBB = FALSE, bgMap = NULL, expandBB = c(0,0,0,0), graticule = NA_crs_, col_graticule = 'grey', border, extent = x) { # sp's bbox: matrix # min max # x # y bbox = matrix(st_bbox(extent), 2, dimnames = list(c("x", "y"), c("min", "max"))) # expandBB: 1=below, 2=left, 3=above and 4=right. expBB = function(lim, expand) c(lim[1] - expand[1] * diff(lim), lim[2] + expand[2] * diff(lim)) if (is.null(xlim)) xlim <- expBB(bbox[1,], expandBB[c(2,4)]) if (is.null(ylim)) ylim <- expBB(bbox[2,], expandBB[c(1,3)]) if (is.na(asp)) asp <- ifelse(isTRUE(st_is_longlat(x)), 1/cos((mean(ylim) * pi)/180), 1.0) if (anyNA(bbox)) stop("NA value(s) in bounding box. Trying to plot empty geometries?") plot.new() args = list(xlim = xlim, ylim = ylim, asp = asp) if (!missing(xaxs)) args$xaxs = xaxs if (!missing(yaxs)) args$yaxs = yaxs if (!missing(lab)) args$lab = lab do.call(plot.window, args) if (setParUsrBB) par(usr=c(xlim, ylim)) pl_reg <- par("usr") rect(xleft = pl_reg[1], ybottom = pl_reg[3], xright = pl_reg[2], ytop = pl_reg[4], col = bgc, border = FALSE) linAxis = function(side, ..., lon, lat, ndiscr, reset, at) axis(side = side, ...) if (!missing(graticule) && !identical(graticule, FALSE)) { g = if (isTRUE(graticule)) st_graticule(pl_reg[c(1,3,2,4)], st_crs(x), st_datum(x), ...) else if (inherits(graticule, "crs") && !is.na(graticule)) st_graticule(pl_reg[c(1,3,2,4)], st_crs(x), graticule, ...) else graticule plot(st_geometry(g), col = col_graticule, add = TRUE) box() if (axes) { sel = g$type == "E" & g$plot12 linAxis(1L, g$x_start[sel], parse(text = g$degree_label[sel]), ...) sel = g$type == "N" & g$plot12 linAxis(2L, g$y_start[sel], parse(text = g$degree_label[sel]), ...) } } else if (axes) { box() if (isTRUE(st_is_longlat(x))) { local_degAxis = function(side, ..., at) .degAxis(side, ...) # absorb at local_degAxis(1, ...) local_degAxis(2, ...) } else { linAxis(1, ...) linAxis(2, ...) } } localTitle <- function(..., col, bgc, pch, cex, lty, lwd, lon, lat, ndiscr, at, labels, reset) title(...) localTitle(...) if (!is.null(bgMap)) { mercator = FALSE if (inherits(bgMap, "ggmap")) { bb = bb2merc(bgMap, "ggmap") mercator = TRUE } else if (all(c("lat.center","lon.center","zoom","myTile","BBOX") %in% names(bgMap))) { # an object returned by RgoogleMaps::GetMap bb = bb2merc(bgMap, "RgoogleMaps") bgMap = bgMap$myTile mercator = TRUE } else bb = c(xlim[1], ylim[1], xlim[2], ylim[2]) # can be any crs! if (mercator && st_crs(x) != st_crs(3857)) warning("crs of plotting object differs from that of bgMap, which is assumed to be st_crs(3857)") # nocov rasterImage(bgMap, bb[1], bb[2], bb[3], bb[4], interpolate = FALSE) } } #' @param n integer; number of colors #' @param cutoff.tails numeric, in `[0,0.5]` start and end values #' @param alpha numeric, in `[0,1]`, transparency #' @param categorical logical; do we want colors for a categorical variable? (see details) #' @name plot #' @export #' @details non-categorical colors from \code{sf.colors} were taken from \link[sp]{bpy.colors}, with modified \code{cutoff.tails} defaults #' If categorical is \code{TRUE}, default colors are from \url{https://colorbrewer2.org/} (if n < 9, Set2, else Set3). #' @examples #' sf.colors(10) sf.colors = function (n = 10, cutoff.tails = c(0.35, 0.2), alpha = 1, categorical = FALSE) { if (categorical) { cb = if (n <= 8) # 8-class Set2: c('#66c2a5','#fc8d62','#8da0cb','#e78ac3','#a6d854','#ffd92f','#e5c494','#b3b3b3') # 12-class Set3: else c('#8dd3c7','#ffffb3','#bebada','#fb8072','#80b1d3','#fdb462','#b3de69','#fccde5','#d9d9d9','#bc80bd','#ccebc5','#ffed6f') # TODO: deal with alpha if (alpha != 1.0) cb = paste0(cb, as.hexmode(ceiling(alpha * 255))) rep(cb, length.out = n) } else { i = seq(0.5 * cutoff.tails[1], 1 - 0.5 * cutoff.tails[2], length.out = n) r = ifelse(i < .25, 0, ifelse(i < .57, i / .32 - .78125, 1)) g = ifelse(i < .42, 0, ifelse(i < .92, 2 * i - .84, 1)) b = ifelse(i < .25, 4 * i, ifelse(i < .42, 1, ifelse(i < .92, -2 * i + 1.84, i / .08 - 11.5))) rgb(r, g, b, alpha) } } # Add text to an existing (base) plot # #' @param labels character, text to draw (one per row of input) #' @name plot #' @export #' @details `text.sf` adds text to an existing base graphic. Text is placed at the centroid of #' each feature in \code{x}. Provide POINT features for further control of placement. #' `points.sf` adds point symbols to an existing base graphic. If points of text are not shown #' correctly, try setting argument `reset` to `FALSE` in the `plot()` call. #' @examples #' text(nc, labels = substring(nc$NAME,1,1)) text.sf = function(x, labels = row.names(x), ...) { text(st_geometry(x), labels = labels, ...) } #' @export #' @name plot #' @param of_largest_polygon logical, passed on to \link{st_centroid} text.sfc = function(x, labels = seq_along(x), ..., of_largest_polygon = FALSE){ x = st_centroid(x, of_largest_polygon = of_largest_polygon) xy = st_coordinates(x) text(xy[,1], xy[,2], labels = labels, ...) } #' @name plot #' @export points.sf = function(x, ...) { points(st_geometry(x), ...) } #' @name plot #' @export points.sfc = function(x, ..., of_largest_polygon = FALSE) { x = st_centroid(x, of_largest_polygon = of_largest_polygon) xy = st_coordinates(x) points(xy[,1], xy[,2], ...) } # get the aspect ratio of a bounding box, for geodetic coords true scale at mid latitude: get_asp = function(bb) { asp = diff(bb[c(2,4)])/diff(bb[c(1,3)]) if (!is.finite(asp)) # 0/0 asp = 1 if (isTRUE(st_is_longlat(bb))) asp = asp / cos(mean(bb[c(2,4)]) * pi /180) asp } #' functions only exported to be used internally by stars #' @keywords internal #' @name stars #' @param bb ignore #' @param n ignore #' @param total_size ignore #' @param key.width ignore #' @param key.length ignore #' @param mfrow length-2 integer vector with number of rows, columns #' @param main main or sub title #' @export .get_layout = function(bb, n, total_size, key.pos, key.width, mfrow = NULL, main = NULL) { # return list with "m" matrix, "key.pos", "widths" and "heights" fields # if key.pos = -1 on input, it will be a return value, "optimally" placed asp = get_asp(bb) strip = if (is.character(main)) # strheight(main, "inches") par("cin")[2] else 0.0 size = function(nrow, n, asp, strip = 0) { # given nrow n asp, what size does a single tile occupy? ncol = ceiling(n / nrow) xsize = total_size[1] / ncol ysize = xsize * asp + strip if (xsize * ysize * n > prod(total_size)) { ysize = total_size[2] / nrow - strip xsize = ysize / asp } c(xsize, ysize) } sz = vapply(1:n, function(nrow) size(nrow, n, asp, strip), c(0.0, 0.0)) if (is.null(mfrow)) { nrow = which.max(apply(sz, 2, prod)) ncol = ceiling(n / nrow) } else { stopifnot(is.numeric(mfrow), length(mfrow) == 2) nrow = mfrow[1] ncol = mfrow[2] } xsize = sz[1, nrow] ysize = sz[2, nrow] asp = ysize / xsize ret = list() ret$mfrow = c(nrow, ncol) # the following is right now only used by stars; FIXME: # nocov start ret$key.pos = if (!is.null(key.pos) && key.pos == -1L) { # figure out here: right or bottom? newasp = asp * nrow / ncol # of the composition dispasp = total_size[2] / total_size[1] ifelse(newasp > dispasp, 4, 1) } else key.pos m = matrix(seq_len(nrow * ncol), nrow, ncol, byrow = TRUE) if (!is.null(ret$key.pos) && ret$key.pos != 0) { # add key row or column: k = key.width n = nrow * ncol + 1 switch(ret$key.pos, { ret$m = rbind(m, n); ret$widths = c(rep(1, ncol)); ret$heights = c(rep(asp, nrow), k) }, { ret$m = cbind(n, m); ret$widths = c(k, rep(1, ncol)); ret$heights = c(rep(asp, nrow)) }, { ret$m = rbind(n, m); ret$widths = c(rep(1, ncol)); ret$heights = c(k, rep(asp, nrow)) }, { ret$m = cbind(m, n); ret$widths = c(rep(1, ncol), k); ret$heights = c(rep(asp, nrow)) } ) } else { ret$m = m ret$widths = rep(1, ncol) ret$heights = rep(asp, nrow) } # nocov end ret } bb2merc = function(x, cls = "ggmap") { # return bbox in the appropriate "web mercator" CRS wgs84 = st_crs(4326) merc = st_crs(3857) # http://wiki.openstreetmap.org/wiki/EPSG:3857 pts = if (cls == "ggmap") { b = vapply(attr(x, "bb"), c, 0.0) st_sfc(st_point(c(b[2:1])), st_point(c(b[4:3])), crs = wgs84) } else if (cls == "RgoogleMaps") st_sfc(st_point(rev(x$BBOX$ll)), st_point(rev(x$BBOX$ur)), crs = wgs84) else stop("unknown cls") st_bbox(st_transform(pts, merc)) } #' @rdname stars #' @param side ignore #' @param at ignore #' @param labels ignore #' @param lon ignore #' @param lat ignore #' @param ndiscr ignore #' @param reset ignore #' @export .degAxis = function (side, at, labels, ..., lon, lat, ndiscr, reset) { if (missing(at)) at = axTicks(side) if (missing(labels)) { labels = FALSE if (side == 1 || side == 3) labels = parse(text = degreeLabelsEW(at)) else if (side == 2 || side == 4) labels = parse(text = degreeLabelsNS(at)) } axis(side, at = at, labels = labels, ...) } # find out where to place the legend key: # given range r = (a, b), key.length l, key offset o, return a value range that: # (i) scales such that (b - a) / (y - x) = l, and # (ii) shifts linearly within [x, y] from a = x when o = 0 to b = y when o = 1 xy_from_r = function(r, l, o) { stopifnot(length(r) == 2, l <= 1, l > 0, o >= 0, o <= 1) r = as.numeric(r) a = r[1]; b = r[2] if (o == 1) { y = b x = b - (b - a)/l } else { i = o / (o - 1) y = (a + (b - a)/l - i * b)/(1 - i) x = i * (y - b) + a } c(x, y) } #' @rdname stars #' @param z ignore #' @param col ignore #' @param breaks ignore #' @param key.pos ignore #' @param add.axis ignore #' @param axes ignore #' @param logz ignore #' @param ... ignore #' @param lab ignore #' @param cex.axis see \link{par} #' @export .image_scale = function(z, col, breaks = NULL, key.pos, add.axis = TRUE, at = NULL, ..., axes = FALSE, key.length, logz = FALSE, lab = "", cex.axis = par("cex.axis")) { if (!is.null(breaks) && length(breaks) != (length(col) + 1)) stop("must have one more break than colour") stopifnot(is.null(lab) || is.character(lab) || is.expression(lab)) lab_set = (is.character(lab) && lab != "") || is.expression(lab) zlim = range(z, na.rm = TRUE) if (is.null(breaks)) breaks = seq(zlim[1], zlim[2], length.out = length(col) + 1) offset = 0.5 if (length(key.pos) == 2) { offset = key.pos[2] key.pos = key.pos[1] } if (is.character(key.length)) { kl = as.numeric(gsub(" cm", "", key.length)) sz = if (key.pos %in% c(1,3)) dev.size("cm")[1] else dev.size("cm")[2] key.length = kl/sz } if (is.null(at)) { br = range(breaks) at = pretty(br) at = at[at > br[1] & at < br[2]] } if (key.pos %in% c(1,3)) { ylim = c(0, 1) xlim = xy_from_r(range(breaks), key.length, offset) mar = c(0, ifelse(axes, 2.1, 1), 0, 1) } if (key.pos %in% c(2,4)) { ylim = xy_from_r(range(breaks), key.length, offset) xlim = c(0, 1) mar = c(ifelse(axes, 2.1, 1), 0, 1.2, 0) } mar[key.pos] = 2.1 + 1.5 * lab_set par(mar = mar) plot(1, 1, type = "n", ylim = ylim, xlim = xlim, axes = FALSE, xlab = "", ylab = "", xaxs = "i", yaxs = "i") if (!is.null(lab) && lab != "") mtext(lab, side = key.pos, line = 2.5, cex = .8) poly = vector(mode="list", length(col)) for (i in seq(poly)) poly[[i]] = c(breaks[i], breaks[i+1], breaks[i+1], breaks[i]) offset = 0.2 offs = switch(key.pos, c(0, 0, -offset, -offset), c(0, 0, -offset, -offset), c(offset, offset, 0, 0), c(offset, offset, 0, 0)) for(i in seq_along(poly)) { if (key.pos %in% c(1,3)) polygon(poly[[i]], c(0, 0, 1, 1) + offs, col = col[i], border = NA) if (key.pos %in% c(2,4)) polygon(c(0, 0, 1, 1) + offs, poly[[i]], col = col[i], border = NA) } # box() now would draw around [0,1]: bx = c(breaks[1], rep(tail(breaks, 1), 2), breaks[1]) if (key.pos %in% c(1, 3)) polygon(bx, c(0, 0, 1, 1) + offs, col = NA, border = 'black') if (key.pos %in% c(2, 4)) polygon(c(0, 0, 1, 1) + offs, bx, col = NA, border = 'black') labels = if (logz) parse(text = paste0("10^", at)) else if (inherits(breaks, c("POSIXt", "Date"))) format(at) else TRUE if (add.axis) axis(key.pos, at = at, labels = labels, cex.axis = cex.axis) } #' @rdname stars #' @param key.width ignore #' @export .image_scale_factor = function(z, col, key.pos, add.axis = TRUE, ..., axes = FALSE, key.width, key.length, cex.axis = par("cex.axis")) { to_num = function(x) as.numeric(gsub(" cm", "", x)) n = length(z) if ((kw <- to_num(key.width)) < to_num(kw_dflt(list(z), key.pos))) { # cut z until it fits: m = max(nchar(z)) while(kw < to_num(kw_dflt(list(z), key.pos))) { # cut z: m = m - 1 z = substr(z, 1, m) } } ksz = max(1.5 + max(nchar(z))/2, max(strwidth(z, "inches")) / par("cin")[1]) # in "mar" lines breaks = (0:n) + 0.5 offset = 0.5 if (length(key.pos) == 2) { offset = key.pos[2] key.pos = key.pos[1] } if (is.character(key.length)) { kl = to_num(key.length) sz = if (key.pos %in% c(1, 3)) dev.size("cm")[1] else dev.size("cm")[2] key.length = kl/sz } if (key.pos %in% c(1, 3)) { ylim = c(0, 1) xlim = xy_from_r(range(breaks), key.length, offset) mar = c(0, ifelse(axes, 2.1, 1), 0, 1) mar[key.pos] = 2.1 } else { ylim = xy_from_r(range(breaks), key.length, offset) xlim = c(0, 1) mar = c(ifelse(axes, 2.1, 1), 0, 1.2, 0) mar[key.pos] = ksz } par(mar = mar) poly = vector(mode="list", length(col)) for (i in seq(poly)) poly[[i]] = c(breaks[i], breaks[i+1], breaks[i+1], breaks[i]) tryCatch({ plot(1, 1, type = "n", ylim = ylim, xlim = xlim, axes = FALSE, xlab = "", ylab = "", xaxs = "i", yaxs = "i") }, error = function(x) { sz = cm(max(strwidth(z, "inches"))) * 1.3 + par("ps")/12 # cm stop(paste0("key.width too small, try key.width = lcm(", signif(sz, 3), ")"), call. = FALSE) } ) for(i in seq_along(poly)) { if (key.pos %in% c(1, 3)) polygon(poly[[i]], c(0, 0, 1, 1), col = col[i], border = NA) if (key.pos %in% c(2, 4)) polygon(c(0, 0, 1, 1), poly[[i]], col = col[i], border = NA) } # box() now would draw around [0,1]: bx = c(breaks[1], rep(tail(breaks, 1), 2), breaks[1]) if (key.pos %in% c(1,3)) polygon(bx, c(0, 0, 1, 1), col = NA, border = 'black') if (key.pos %in% c(2,4)) polygon(c(0, 0, 1, 1), bx, col = NA, border = 'black') if (add.axis) { opar = par(las = 1) axis(key.pos, at = 1:n, labels = z, cex.axis = cex.axis) par(opar) } } # nocov start #' @export identify.sfc = function(x, ..., n = min(10, length(x)), type = "n") { l = locator(n, type = type) pts = st_as_sf(as.data.frame(do.call(cbind, l)), coords = c("x", "y"), crs = st_crs(x)) sapply(st_intersects(pts, x), function(x) if (length(x)) x[1] else NA_integer_) } #' @export identify.sf = function(x, ...) { identify(st_geometry(x), ...) } # nocov end ================================================ FILE: R/proj.R ================================================ #' @name st_transform #' @param type character; one of `have_datum_files`, `proj`, `ellps`, `datum`, `units`, `path`, or `prime_meridians`; see Details. #' @param path character; PROJ search path to be set #' @export #' @details \code{sf_proj_info} lists the available projections, ellipses, datums, units, or data search path of the PROJ library when \code{type} is equal to proj, ellps, datum, units or path; when \code{type} equals \code{have_datum_files} a boolean is returned indicating whether datum files are installed and accessible (checking for \code{conus}). `path` returns the `PROJ_INFO.searchpath` field directly, as a single string with path separaters (`:` or `;`). #' #' for PROJ >= 6, \code{sf_proj_info} does not provide option \code{type = "datums"}. #' PROJ < 6 does not provide the option \code{type = "prime_meridians"}. #' #' for PROJ >= 7.1.0, the "units" query of \code{sf_proj_info} returns the \code{to_meter} #' variable as numeric, previous versions return a character vector containing a numeric expression. #' @examples #' sf_proj_info("datum") sf_proj_info = function(type = "proj", path) { if (type == "have_datum_files") return(CPL_have_datum_files(0)) if (type == "path") return(CPL_get_data_dir(TRUE)) if (!missing(path) && is.character(path)) return(invisible(unique(CPL_set_data_dir(path, TRUE)))) if (type == "network") return(CPL_is_network_enabled(TRUE)) opts <- c("proj", "ellps", "datum", "units", "prime_meridians") if (!(type %in% opts)) stop("unknown type") # nocov t <- as.integer(match(type[1], opts) - 1) res = CPL_proj_info(as.integer(t)) if (type == "proj") res$description <- sapply(strsplit(as.character(res$description), "\n"), function(x) x[1]) data.frame(res) } #' directly transform a set of coordinates #' #' directly transform a set of coordinates #' @param from character description of source CRS, or object of class \code{crs}, #' or pipeline describing a transformation #' @param to character description of target CRS, or object of class \code{crs} #' @param pts two-, three- or four-column numeric matrix, or object that can be coerced into a matrix; columns 3 and 4 contain z and t values. #' @param keep logical value controlling the handling of unprojectable points. If #' `keep` is `TRUE`, then such points will yield `Inf` or `-Inf` in the #' return value; otherwise an error is reported and nothing is returned. #' @param warn logical; if \code{TRUE}, warn when non-finite values are generated #' @param authority_compliant logical; \code{TRUE} means handle axis order authority compliant (e.g. EPSG:4326 implying x=lat, y=lon), \code{FALSE} means use visualisation order (i.e. always x=lon, y=lat) #' @return two-column numeric matrix with transformed/converted coordinates, returning invalid values as \code{Inf} #' @export sf_project = function(from = character(0), to = character(0), pts, keep = FALSE, warn = TRUE, authority_compliant = st_axis_order()) { if (!is.logical(keep) || length(keep) != 1 || is.na(keep)) stop("'keep' must be single-length non-NA logical value") proj_from_crs = function(x) { if (inherits(x, "crs")) { x = if (compareVersion(sf_extSoftVersion()["proj.4"], "6.0.0") >= 0) x$wkt else x$proj4string } if (length(x)) { v = CPL_proj_is_valid(x) if (!v[[1]]) stop(paste0(v[[2]], ": ", x)) x[1] } else x # empty: character(0) } from_to = c(proj_from_crs(from), proj_from_crs(to)) if ((length(from_to) == 1) && !missing(authority_compliant)) stop("when specifying a projection pipeline, setting authority_compliant has no effect") CPL_proj_direct(from_to, as.matrix(pts), keep, warn, authority_compliant) } #' Manage PROJ settings #' #' Query or manage PROJ search path and network settings #' @param paths the search path to be set; omit if paths need to be queried #' @param with_proj logical; if `NA` set for both GDAL and PROJ, otherwise set either for PROJ (`TRUE`) or GDAL (`FALSE`) #' @return `sf_proj_search_paths()` returns the search path (possibly after setting it) #' @name proj_tools #' @export sf_proj_search_paths = function(paths = character(0), with_proj = NA) { if (length(paths) == 0) CPL_get_data_dir(FALSE) else { if (is.na(with_proj) || !isTRUE(with_proj)) CPL_set_data_dir(as.character(paths), FALSE) # set GDAL if (is.na(with_proj) || isTRUE(with_proj)) { # set for PROJ if (length(paths) > 1) { paths = paste0(paths, collapse = .Platform$path.sep) message(paste("setting proj path(s) to", paths)) } CPL_set_data_dir(as.character(paths), TRUE) } } } #' @param enable logical; set this to enable (`TRUE`) or disable (`FALSE`) the proj network search facility #' @param url character; use this to specify and override the default proj network CDN #' @return `sf_proj_network` when called without arguments returns a logical indicating whether #' network search of datum grids is enabled, when called with arguments it returns a character #' vector with the URL of the CDN used (or specified with `url`). #' @name proj_tools #' @export sf_proj_network = function(enable = FALSE, url = character(0)) { if (missing(enable) && missing(url)) CPL_is_network_enabled() else CPL_enable_network(url, enable) } #' @param source_crs,target_crs object of class `crs` or character #' @param authority character; constrain output pipelines to those of authority #' @param AOI length four numeric; desired area of interest for the resulting #' coordinate transformations (west, south, east, north, in degrees). #' For an area of interest crossing the anti-meridian, west will be greater than east. #' @param Use one of "NONE", "BOTH", "INTERSECTION", "SMALLEST", indicating how AOI's #' of source_crs and target_crs are being used #' @param grid_availability character; one of "USED" (Grid availability is only used for sorting #' results. Operations where some grids are missing will be sorted last), "DISCARD" #' (Completely discard an operation if a required grid is missing) #' , "IGNORED" (Ignore grid availability at all. Results will be presented as if all grids were #' available.), or "AVAILABLE" (Results will be presented as if grids known to PROJ (that is #' registered in the grid_alternatives table of its database) were available. Used typically when #' networking is enabled.) #' @param desired_accuracy numeric; only return pipelines with at least this accuracy #' @param strict_containment logical; default `FALSE`; permit partial matching of the area #' of interest; if `TRUE` strictly contain the area of interest. #' The area of interest is either as given in AOI, or as implied by the #' source/target coordinate reference systems #' @param axis_order_authority_compliant logical; if `FALSE` always #' choose ‘x’ or longitude for the first #' axis; if TRUE, follow the axis orders given by the coordinate reference systems when #' constructing the for the first axis; if `FALSE`, follow the axis orders given by #' @return `sf_proj_pipelines()` returns a table with candidate coordinate transformation #' pipelines along with their accuracy; `NA` accuracy indicates ballpark accuracy. #' @name proj_tools #' @export sf_proj_pipelines = function(source_crs, target_crs, authority = character(0), AOI = numeric(0), Use = "NONE", grid_availability = "USED", desired_accuracy = -1.0, strict_containment = FALSE, axis_order_authority_compliant = st_axis_order()) { stopifnot(!missing(source_crs), !missing(target_crs)) if (inherits(source_crs, "crs")) source_crs = source_crs$wkt if (inherits(target_crs, "crs")) target_crs = target_crs$wkt stopifnot(is.character(source_crs), is.character(target_crs)) ret = CPL_get_pipelines(c(source_crs, target_crs), as.character(authority), as.numeric(AOI), as.character(Use), as.character(grid_availability), as.numeric(desired_accuracy), as.logical(strict_containment), as.logical(axis_order_authority_compliant)) if (nrow(ret)) { if (!startsWith(ret$definition[1], "+")) # paste + to every word ret$definition = sapply(strsplit(ret$definition, " "), function(x) paste0(paste0("+", x), collapse=" ")) ret$containment = strict_containment structure(ret, class = c("proj_pipelines", "data.frame"), source_crs = source_crs, target_crs = target_crs) } else invisible(NULL) } #' @export print.proj_pipelines = function(x, ...) { cat("Candidate coordinate operations found: ", nrow(x), "\n") nos <- which(!x$instantiable) if (length(nos) > 0L) xx <- x[-nos,] else xx <- x xx <- xx[order(xx$accuracy),] y = xx[1,] cat("Strict containment: ", y$containment, "\n") cat("Axis order auth compl: ", y$axis_order, "\n") cat("Source: ", attr(x, "source_crs"), "\n") cat("Target: ", attr(x, "target_crs"), "\n") if (is.na(y$accuracy)) cat("Best instantiable operation has only ballpark accuracy", "\n") else cat("Best instantiable operation has accuracy:", y$accuracy, "m\n") cat("Description: ") desc <- strwrap(y$description, exdent=13, width=0.8*getOption("width")) if (length(desc) == 1L) cat(desc, "\n") else cat(desc, sep="\n") cat("Definition: ") def <- strwrap(y$definition, exdent=13, width=0.8*getOption("width")) if (length(def) == 1L) cat(def, "\n") else cat(def, sep="\n") # nos: if (length(nos) > 0L) { grds <- attr(x, "grids") for (i in seq(along.with = nos)) { grd <- grds[[nos[i]]] ii <- length(grd) if (ii > 0L) { cat("Operation", nos[i], "is lacking", ii, ifelse(ii == 1L, "grid", "grids"), "with accuracy", x$accuracy[nos[i]], "m\n") for (j in 1:ii) { cat("Missing grid:", grd[[j]][[1]], "\n") if (nzchar(grd[[j]][[2]])) cat("Name:", grd[[j]][[2]], "\n") if (nzchar(grd[[j]][[4]])) cat("URL:", grd[[j]][[4]], "\n") } } } } invisible(x) } ================================================ FILE: R/read.R ================================================ sf_stringsAsFactors = function() { if (getRversion() < "4.1.0") default.stringsAsFactors() else FALSE } set_utf8 = function(x) { n = names(x) Encoding(n) = "UTF-8" to_utf8 = function(x) { if (is.character(x)) Encoding(x) = "UTF-8" x } structure(lapply(x, to_utf8), names = n) } #' Read simple features or layers from file or database #' #' Read simple features from file or database, or retrieve layer names and their #' geometry type(s) #' @param dsn data source name (interpretation varies by driver - for some #' drivers, \code{dsn} is a file name, but may also be a folder, or contain #' the name and access credentials of a database); in case of GeoJSON, #' \code{dsn} may be the character string holding the geojson data. It can #' also be an open database connection. #' @param layer layer name (varies by driver, may be a file name without #' extension); in case \code{layer} is missing, \code{st_read} will read the #' first layer of \code{dsn}, give a warning and (unless \code{quiet = TRUE}) #' print a message when there are multiple layers, or give an error if there #' are no layers in \code{dsn}. If \code{dsn} is a database connection, then #' \code{layer} can be a table name or a database identifier (see #' \code{\link[DBI]{Id}}). It is also possible to omit \code{layer} and rather #' use the \code{query} argument. #' @param ... parameter(s) passed on to \link{st_as_sf} #' @param options character; driver dependent dataset open options, multiple #' options supported. For possible values, see the "Open options" section #' of the GDAL documentation of the corresponding driver, and #' for an example. #' @param quiet logical; suppress info on name, driver, size and spatial #' reference, or signaling no or multiple layers #' @param geometry_column integer or character; in case of multiple geometry #' fields, which one to take? #' @param type integer; ISO number of desired simple feature type; see details. #' If left zero, and \code{promote_to_multi} is \code{TRUE}, in case of mixed #' feature geometry types, conversion to the highest numeric type value found #' will be attempted. A vector with different values for each geometry column #' can be given. #' @param promote_to_multi logical; in case of a mix of Point and MultiPoint, or #' of LineString and MultiLineString, or of Polygon and MultiPolygon, convert #' all to the Multi variety; defaults to \code{TRUE} #' @param stringsAsFactors logical; should character vectors be #' converted to factors? Default for \code{read_sf} or R version >= 4.1.0 is #' \code{FALSE}, for \code{st_read} and R version < 4.1.0 equal to #' \code{default.stringsAsFactors()} #' @param int64_as_string logical; if `TRUE`, Int64 attributes are returned as #' string; if `FALSE`, they are returned as double and a warning is given when #' precision is lost (i.e., values are larger than 2^53). #' @param check_ring_dir logical; if `TRUE`, polygon ring directions are checked #' and if necessary corrected (when seen from above: exterior ring counter #' clockwise, holes clockwise) #' @details for \code{geometry_column}, see also #' \url{https://gdal.org/en/latest/development/rfc/rfc41_multiple_geometry_fields.html} #' #' for values for \code{type} see #' \url{https://en.wikipedia.org/wiki/Well-known_text_representation_of_geometry#Well-known_binary}, #' but note that not every target value may lead to successful conversion. The #' typical conversion from POLYGON (3) to MULTIPOLYGON (6) should work; the #' other way around (type=3), secondary rings from MULTIPOLYGONS may be dropped #' without warnings. \code{promote_to_multi} is handled on a per-geometry column #' basis; \code{type} may be specified for each geometry column. #' #' Note that stray files in data source directories (such as \code{*.dbf}) may #' lead to spurious errors that accompanying \code{*.shp} are missing. #' #' In case of problems reading shapefiles from USB drives on OSX, please see #' \url{https://github.com/r-spatial/sf/issues/252}. Reading shapefiles (or other #' data sources) directly from zip files can be done by prepending the path #' with \code{/vsizip/}. This is part of the GDAL Virtual File Systems interface #' that also supports .gz, curl, and other operations, including chaining; see #' \url{https://gdal.org/en/latest/user/virtual_file_systems.html} for a complete #' description and examples. #' #' For \code{query} with a character \code{dsn} the query text is handed to #' 'ExecuteSQL' on the GDAL/OGR data set and will result in the creation of a #' new layer (and \code{layer} is ignored). See 'OGRSQL' #' \url{https://gdal.org/en/latest/user/ogr_sql_dialect.html} for details. Please note that the #' 'FID' special field is driver-dependent, and may be either 0-based (e.g. ESRI #' Shapefile), 1-based (e.g. MapInfo) or arbitrary (e.g. OSM). Other features of #' OGRSQL are also likely to be driver dependent. The available layer names may #' be obtained with #' \link{st_layers}. Care will be required to properly escape the use of some layer names. #' #' @return object of class \link{sf} when a layer was successfully read; in case #' argument \code{layer} is missing and data source \code{dsn} does not #' contain a single layer, an object of class \code{sf_layers} is returned #' with the layer names, each with their geometry type(s). Note that the #' number of layers may also be zero. #' @seealso \link{st_layers}, \link{st_drivers} #' @examples #' nc = st_read(system.file("shape/nc.shp", package="sf")) #' summary(nc) # note that AREA was computed using Euclidian area on lon/lat degrees #' #' ## only three fields by select clause #' ## only two features by where clause #' nc_sql = st_read(system.file("shape/nc.shp", package="sf"), #' query = "SELECT NAME, SID74, FIPS FROM \"nc\" WHERE BIR74 > 20000") #' \dontrun{ #' library(sp) #' example(meuse, ask = FALSE, echo = FALSE) #' try(st_write(st_as_sf(meuse), "PG:dbname=postgis", "meuse", #' layer_options = "OVERWRITE=true")) #' try(st_meuse <- st_read("PG:dbname=postgis", "meuse")) #' if (exists("st_meuse")) #' summary(st_meuse) #' } #' #' \dontrun{ #' ## note that we need special escaping of layer within single quotes (nc.gpkg) #' ## and that geom needs to be included in the select, otherwise we don't detect it #' layer <- st_layers(system.file("gpkg/nc.gpkg", package = "sf"))$name[1] #' nc_gpkg_sql = st_read(system.file("gpkg/nc.gpkg", package = "sf"), #' query = sprintf("SELECT NAME, SID74, FIPS, geom FROM \"%s\" WHERE BIR74 > 20000", layer)) #' } #' # spatial filter, as wkt: #' wkt = st_as_text(st_geometry(nc[1,])) #' # filter by (bbox overlaps of) first feature geometry: #' st_read(system.file("gpkg/nc.gpkg", package="sf"), wkt_filter = wkt) #' @export st_read = function(dsn, layer, ...) UseMethod("st_read") #' @export st_read.default = function(dsn, layer, ...) { if (missing(dsn)) stop("dsn should specify a data source or filename") else { dsn_is_null = is.null(dsn) class_dsn = class(dsn) tr <- try(dsn <- as.character(dsn)) if (dsn_is_null || inherits(tr, "try-error")) stop(paste("no st_read method available for objects of class", paste(class_dsn, collapse = ", "))) else st_read.character(dsn, layer, ...) } } process_cpl_read_ogr = function(x, quiet = FALSE, ..., check_ring_dir = FALSE, stringsAsFactors = ifelse(as_tibble, FALSE, sf_stringsAsFactors()), geometry_column = 1, as_tibble = FALSE, optional = FALSE) { which.geom = which(vapply(x, function(f) inherits(f, "sfc"), TRUE)) if (as_tibble && !requireNamespace("tibble", quietly = TRUE)) stop("package tibble not available: install first?") # in case no geometry is present: if (length(which.geom) == 0) { if (! quiet) warning("no simple feature geometries present: returning a data.frame or tbl_df", call. = FALSE) x = if (!as_tibble) { if (any(sapply(x, is.list))) warning("list-column(s) present: in case of failure, try read_sf() or as_tibble=TRUE") # nocov as.data.frame(x , stringsAsFactors = stringsAsFactors, optional = optional) } else tibble::as_tibble(x) return(x) } nm = names(x)[which.geom] Encoding(nm) = "UTF-8" geom = x[which.geom] lc.other = setdiff(which(vapply(x, is.list, TRUE)), which.geom) # non-sfc list-columns list.cols = x[lc.other] nm.lc = names(x)[lc.other] if (length(x) == length(geom)) { # ONLY geometry column(s) if (as_tibble) x <- tibble::tibble(row.names = seq_along(geom[[1]]))[-1] else x <- data.frame(row.names = seq_along(geom[[1]])) } else { x <- as.data.frame(set_utf8(x[-c(lc.other, which.geom)]), stringsAsFactors = stringsAsFactors, optional = optional || as_tibble) if (as_tibble) { # "sf" class is added later by `st_as_sf` (and sets all the attributes) x <- tibble::new_tibble(x, nrow = nrow(x)) } } for (i in seq_along(lc.other)) x[[ nm.lc[i] ]] = list.cols[[i]] for (i in seq_along(geom)) { if (is.null(attr(geom[[i]], "bbox"))) { x[[ nm[i] ]] = st_sfc(geom[[i]], crs = attr(geom[[i]], "crs")) # computes bbox } else { x[[ nm[i] ]] = geom[[i]] } } x = st_as_sf(x, ..., sf_column_name = if (is.character(geometry_column)) geometry_column else nm[geometry_column], check_ring_dir = check_ring_dir) if (! quiet) print(x, n = 0) else x } # Allow setting the default to TRUE to make it easier to run existing tests # of st_read() through the stream interface default_st_read_use_stream = function() { getOption( "sf.st_read_use_stream", identical(Sys.getenv("R_SF_ST_READ_USE_STREAM"), "true") ) } process_cpl_read_ogr_stream = function(x, geom_column_info, num_features, fid_column_name, crs = NULL, promote_to_multi = TRUE, ...) { is_geometry_column = vapply( x$get_schema()$children, function(s) identical(s$metadata[["ARROW:extension:name"]], "ogc.wkb"), logical(1) ) geom_column_info$index = which(is_geometry_column) if (num_features == -1) { num_features = NULL } # Suppress warnings about extension type conversion (since we want the # default behaviour of converting the storage type) df = suppressWarnings(nanoarrow::convert_array_stream(x, size = num_features)) for (i in seq_len(nrow(geom_column_info))) { crs = if (is.null(crs)) st_crs(geom_column_info$crs[[i]]) else st_crs(crs) name = geom_column_info$name[[i]] index = geom_column_info$index[[i]] column_wkb = df[[index]] attributes(column_wkb) = NULL column_sfc = wk::wk_handle( wk::new_wk_wkb(column_wkb), wk::sfc_writer(promote_multi = promote_to_multi) ) df[[index]] = st_set_crs(column_sfc, crs) names(df)[index] = name } # Rename OGC_FID to fid_column_name and move to end if (length(fid_column_name) == 1 && "OGC_FID" %in% names(df)) { df = df[c(setdiff(names(df), "OGC_FID"), "OGC_FID")] names(df)[names(df) == "OGC_FID"] = fid_column_name } # All geometry columns to the end df = df[c(setdiff(seq_along(df), geom_column_info$index), geom_column_info$index)] process_cpl_read_ogr(df, ...) } #' @name st_read #' @param fid_column_name character; name of column to write feature IDs to; defaults to not doing this #' @param drivers character; limited set of driver short names to be tried (default: try all) #' @param wkt_filter character; WKT representation of a spatial filter (may be used as bounding box, selecting overlapping geometries); see examples #' @param optional logical; passed to \link[base]{as.data.frame}; always \code{TRUE} when \code{as_tibble} is \code{TRUE} #' @param use_stream Use `TRUE` to use the experimental columnar interface introduced in GDAL 3.6. #' @note The use of \code{system.file} in examples make sure that examples run regardless where R is installed: #' typical users will not use \code{system.file} but give the file name directly, either with full path or relative #' to the current working directory (see \link{getwd}). "Shapefiles" consist of several files with the same basename #' that reside in the same directory, only one of them having extension \code{.shp}. #' @export st_read.character = function(dsn, layer, ..., query = NA, options = NULL, quiet = FALSE, geometry_column = 1L, type = 0, promote_to_multi = TRUE, stringsAsFactors = sf_stringsAsFactors(), int64_as_string = FALSE, check_ring_dir = FALSE, fid_column_name = character(0), drivers = character(0), wkt_filter = character(0), optional = FALSE, use_stream = default_st_read_use_stream()) { layer = if (missing(layer)) character(0) else enc2utf8(layer) if (nchar(dsn) < 1) stop("`dsn` must point to a source, not an empty string.", call. = FALSE) dsn_exists = file.exists(dsn) dsn_isdb = is_db_driver(dsn) if (length(dsn) == 1 && dsn_exists && !dsn_isdb) dsn = enc2utf8(normalizePath(dsn)) if (length(promote_to_multi) > 1) stop("`promote_to_multi' should have length one, and applies to all geometry columns") if (use_stream) { stream = nanoarrow::nanoarrow_allocate_array_stream() info = CPL_read_gdal_stream(stream, dsn, layer, query, as.character(options), quiet, drivers, wkt_filter, dsn_exists, dsn_isdb, fid_column_name, getOption("width")) geom_column_info = data.frame(name = info[[1]], crs = info[[2]], stringsAsFactors = FALSE) process_cpl_read_ogr_stream(stream, geom_column_info, num_features = info[[3]], fid_column_name = fid_column_name, stringsAsFactors = stringsAsFactors, quiet = quiet, promote_to_multi = promote_to_multi, ...) } else { x = CPL_read_ogr(dsn, layer, query, as.character(options), quiet, type, fid_column_name, drivers, wkt_filter, promote_to_multi, int64_as_string, dsn_exists, dsn_isdb, getOption("width")) process_cpl_read_ogr(x, quiet, check_ring_dir = check_ring_dir, stringsAsFactors = stringsAsFactors, geometry_column = geometry_column, optional = optional, ...) } } #' @name st_read #' @export #' @details \code{read_sf} and \code{write_sf} are aliases for \code{st_read} and \code{st_write}, respectively, with some #' modified default arguments. #' \code{read_sf} and \code{write_sf} are quiet by default: they do not print information #' about the data source. \code{read_sf} returns an sf-tibble rather than an sf-data.frame. #' \code{write_sf} delete layers by default: it overwrites existing files without asking or warning. #' @examples #' # read geojson from string: #' geojson_txt <- paste("{\"type\":\"MultiPoint\",\"coordinates\":", #' "[[3.2,4],[3,4.6],[3.8,4.4],[3.5,3.8],[3.4,3.6],[3.9,4.5]]}") #' x = st_read(geojson_txt) #' x read_sf <- function(..., quiet = TRUE, stringsAsFactors = FALSE, as_tibble = TRUE) { st_read(..., quiet = quiet, stringsAsFactors = stringsAsFactors, as_tibble = as_tibble) } clean_columns = function(obj, factorsAsCharacter) { permitted = c("character", "integer", "numeric", "Date", "POSIXct", "logical", "list") for (i in seq_along(obj)) { if (is.factor(obj[[i]])) { obj[[i]] = if (factorsAsCharacter) as.character(obj[[i]]) else as.numeric(obj[[i]]) } if (! inherits(obj[[i]], permitted)) { if (inherits(obj[[i]], "POSIXlt")) obj[[i]] = as.POSIXct(obj[[i]]) else if (is.numeric(obj[[i]])) obj[[i]] = as.numeric(obj[[i]]) # strips class } if (is.character(obj[[i]])) obj[[i]] = enc2utf8(obj[[i]]) } ccls.ok = vapply(obj, function(x) inherits(x, permitted), TRUE) if (any(!ccls.ok)) { # nocov start nms <- names(obj)[!ccls.ok] cls <- sapply(obj, function(x) paste(class(x), collapse=";"))[!ccls.ok] warning("Dropping column(s) ", paste(nms, collapse=","), " of class(es) ", paste(cls, collapse=",")) obj = obj[ccls.ok] # nocov end } colclasses = vapply(obj, function(x) permitted[ which(inherits(x, permitted, which = TRUE) > 0)[1] ] , "") # check that list columns contain raw vectors: for (lc in which(colclasses == "list")) { if (!all(sapply(obj[[lc]], inherits, "raw"))) stop("list columns are only allowed with raw vector contents") } structure(obj, colclasses = colclasses) } abbreviate_shapefile_names = function(x) { # from: rgdal/pkg/R/ogr_write.R: fld_names <- names(x) # if (!is.null(encoding)) { # fld_names <- iconv(fld_names, from=encoding, to="UTF-8") # } if (any(nchar(fld_names) > 10)) { fld_names <- abbreviate(fld_names, minlength = 7) warning("Field names abbreviated for ESRI Shapefile driver") if (any(nchar(fld_names) > 10)) fld_names <- abbreviate(fld_names, minlength = 5) # nocov } # fix for dots in DBF field names 121124 if (length(wh. <- grep("\\.", fld_names) > 0)) fld_names[wh.] <- gsub("\\.", "_", fld_names[wh.]) if (anyDuplicated(fld_names)) stop("Non-unique field names") # nocov names(x) = fld_names x } #' Write simple features object to file or database #' #' Write simple features object to file or database #' @param obj object of class \code{sf} or \code{sfc} #' @param dsn data source name. Interpretation varies by driver: can be #' a filename, a folder, a database name, or a Database Connection #' (we officially test support for #' \code{\link[RPostgres:Postgres]{RPostgres::Postgres()}} connections). #' @param layer layer name. Varies by driver, may be a file name without #' extension; for database connection, it is the name of the table. If layer #' is missing, the \code{basename} of \code{dsn} is taken. #' @param driver character; name of driver to be used; if missing and \code{dsn} is not a Database Connection, a driver name is guessed from \code{dsn}; #' \code{st_drivers()} returns the drivers that are available with their properties; links to full driver documentation #' are found at \url{https://gdal.org/en/latest/drivers/vector/index.html} #' @param ... other arguments passed to \link[DBI]{dbWriteTable} when \code{dsn} is a #' Database Connection #' @param dataset_options character; driver dependent dataset creation options; #' multiple options supported. #' @param layer_options character; driver dependent layer creation options; #' multiple options supported. #' @param quiet logical; suppress info on name, driver, size and spatial #' reference #' @param factorsAsCharacter logical; convert \code{factor} levels to character #' strings (\code{TRUE}, default), otherwise into numbers when #' factorsAsCharacter is \code{FALSE}. For database connections, #' \code{factorsAsCharacter} is always \code{TRUE}. #' @param append logical; should we append to an existing layer, or replace it? #' if \code{TRUE} append, if \code{FALSE} replace. #' The default for \code{st_write} is \code{NA} which raises an error if the layer exists. #' The default for \code{write_sf} is \code{FALSE}, which overwrites any existing data. #' See also next two arguments for more control on overwrite behavior. #' @param delete_dsn logical; delete data source \code{dsn} before attempting #' to write? #' @param delete_layer logical; delete layer \code{layer} before attempting to #' write? #' The default for \code{st_write} is \code{FALSE} which raises an error if the layer exists. #' The default for \code{write_sf} is \code{TRUE}. #' @param fid_column_name character, name of column with feature IDs; if #' specified, this column is no longer written as feature attribute. #' @param config_options character, named vector with GDAL config options #' @details #' Columns (variables) of a class not supported are dropped with a warning. #' #' When updating an existing layer, records are appended to it if the updating #' object has the right variable names and types. If names don't match an #' error is raised. If types don't match, behaviour is undefined: GDAL may #' raise warnings or errors or fail silently. #' #' When deleting layers or data sources is not successful, no error is emitted. #' \code{delete_dsn} and \code{delete_layer} should be #' handled with care; the former may erase complete directories or databases. #' @seealso \link{st_drivers}, \link[DBI]{dbWriteTable} #' @return \code{obj}, invisibly #' @examples #' nc = st_read(system.file("shape/nc.shp", package="sf")) #' st_write(nc, paste0(tempdir(), "/", "nc.shp")) #' st_write(nc, paste0(tempdir(), "/", "nc.shp"), delete_layer = TRUE) # overwrites #' if (require(sp, quietly = TRUE)) { #' data(meuse, package = "sp") # loads data.frame from sp #' meuse_sf = st_as_sf(meuse, coords = c("x", "y"), crs = 28992) #' # writes X and Y as columns: #' st_write(meuse_sf, paste0(tempdir(), "/", "meuse.csv"), layer_options = "GEOMETRY=AS_XY") #' st_write(meuse_sf, paste0(tempdir(), "/", "meuse.csv"), layer_options = "GEOMETRY=AS_WKT", #' delete_dsn=TRUE) # overwrites #' \dontrun{ #' library(sp) #' example(meuse, ask = FALSE, echo = FALSE) #' try(st_write(st_as_sf(meuse), "PG:dbname=postgis", "meuse_sf", #' layer_options = c("OVERWRITE=yes", "LAUNDER=true"))) #' demo(nc, ask = FALSE) #' try(st_write(nc, "PG:dbname=postgis", "sids", layer_options = "OVERWRITE=true")) #' } #' } #' @export st_write = function(obj, dsn, layer, ...) UseMethod("st_write") #' @name st_write #' @export st_write.sfc = function(obj, dsn, layer, ...) { if (missing(layer)) st_write.sf(st_sf(geom = obj), dsn, ...) else st_write.sf(st_sf(geom = obj), dsn, layer, ...) invisible(obj) } #' @name st_write #' @export st_write.sf = function(obj, dsn, layer = NULL, ..., driver = guess_driver_can_write(dsn), dataset_options = NULL, layer_options = NULL, quiet = FALSE, factorsAsCharacter = TRUE, append = NA, delete_dsn = FALSE, delete_layer = !is.na(append) && !append, fid_column_name = NULL, config_options = character(0)) { return_obj = ret = obj if (!is.null(list(...)$update)) { .Deprecated("append", old = "update") # deprecated at 0.9-0 if (is.na(append)) append = list(...)$update } # else if (length(list(...))) # stop(paste("unrecognized argument(s)", names(list(...)), "\n")) if (missing(dsn)) stop("dsn should specify a data source or filename") if (inherits(dsn, c("DBIObject", "PostgreSQLConnection", "Pool"))) { if (inherits(dsn, "Pool")) { if (! requireNamespace("pool", quietly = TRUE)) # nocov start stop("package pool required, please install it first") dsn = pool::poolCheckout(dsn) on.exit(pool::poolReturn(dsn)) # nocov end } if (is.null(layer)) { layer = deparse(substitute(obj)) } if (is.na(append)) { append = FALSE } # check arguments cl <- as.list(match.call())[-1L] if ("overwrite" %in% names(cl)) { stop("Argument `overwrite` in `st_write()` is deprecated, use `delete_layer` instead.", call. = FALSE) } check_append_delete(append, delete_layer) dbWriteTable(dsn, name = layer, value = obj, append = append, overwrite = delete_layer, factorsAsCharacter = factorsAsCharacter, ...) return(invisible(return_obj)) } else if (!inherits(dsn, "character")) { # add methods for other dsn classes here... stop(paste("no st_write method available for dsn of class", class(dsn)[1])) } if (!is.na(append) && append == FALSE && delete_layer == FALSE) stop("cannot replace a layer if delete_layer is FALSE") if (is.null(layer)) layer <- file_path_sans_ext(basename(dsn)) if (length(dsn) == 1 && length(grep("~", dsn)) == 1) # resolve ~ dsn = normalizePath(dsn, mustWork = FALSE) # nocov # this seems to be always a good idea: dsn = enc2utf8(dsn) # handle the case where obj does not have a geometry column: if (write_geometries <- inherits(obj, "sf")) { geom = st_geometry(obj) obj[[attr(obj, "sf_column")]] = NULL if (is.na(st_crs(geom))) { message('writing: substituting ENGCRS["Undefined Cartesian SRS with unknown unit"] for missing CRS') st_crs(geom) = st_crs("ENGCRS[\"Undefined Cartesian SRS with unknown unit\",EDATUM[\"Unknown engineering datum\"],CS[Cartesian,2],AXIS[\"X\",unspecified,ORDER[1],LENGTHUNIT[\"unknown\",0]],AXIS[\"Y\",unspecified,ORDER[2],LENGTHUNIT[\"unknown\",0]]]") } } else { # create fake geometries: v = vector("list", nrow(obj)) v[seq_len(nrow(obj))] = list(st_point()) geom = st_sfc(v) } if (driver == "ESRI Shapefile") { # remove trailing .shp from layer name layer = sub(".shp$", "", layer) obj = abbreviate_shapefile_names(obj) } obj = clean_columns(as.data.frame(obj), factorsAsCharacter) # this attaches attr colclasses names(obj) = enc2utf8(names(obj)) dim = if (length(geom) == 0) "XY" else class(geom[[1]])[1] fids = if (!is.null(fid_column_name)) { fids = as.character(obj[[fid_column_name]]) obj[[fid_column_name]] = NULL fids } else character(0) ret = CPL_write_ogr(obj, dsn, layer, driver, as.character(dataset_options), as.character(layer_options), geom, dim, fids, config_options, quiet, append, delete_dsn, delete_layer, write_geometries, getOption("width")) if (ret == 1) { # try through temp file: tmp = tempfile(fileext = paste0(".", tools::file_ext(dsn))) # nocov start if (!quiet) message(paste("writing first to temporary file", tmp)) if (CPL_write_ogr(obj, tmp, layer, driver, as.character(dataset_options), as.character(layer_options), geom, dim, fids, config_options, quiet, append, delete_dsn, delete_layer, write_geometries, getOption("width")) == 1) stop(paste("failed writing to temporary file", tmp)) if (!file.copy(tmp, dsn, overwrite = append || delete_dsn || delete_layer)) stop(paste("copying", tmp, "to", dsn, "failed")) if (!file.remove(tmp)) warning(paste("removing", tmp, "failed")) } # nocov end invisible(return_obj) } #' @name st_write #' @export st_write.data.frame <- function(obj, dsn, layer = NULL, ...) { sf = try(st_as_sf(obj), silent = TRUE) if (!inherits(sf, "try-error")) st_write.sf(sf, dsn = dsn, layer = layer, ...) else st_write.sf(obj, dsn = dsn, layer = layer, ...) invisible(obj) } #' @name st_write #' @export write_sf <- function(..., quiet = TRUE, append = FALSE, delete_layer = !append) { st_write(..., quiet = quiet, append = append, delete_layer = delete_layer) } #' Get GDAL drivers #' #' Get a list of the available GDAL drivers #' @param what character: `"vector"` or `"raster"`, anything else will return all #' drivers. #' @param regex character; regular expression to filter the `name` and `long_name` #' fields on #' @details The drivers available will depend on the installation of GDAL/OGR, #' and can vary; the `st_drivers()` function shows all the drivers that are #' readable, and which may be written. The field `vsi` refers to the driver's #' capability to read/create datasets through the VSI*L API. [See GDAL website #' for additional details on driver #' support](https://gdal.org/en/latest/drivers/vector/index.html) #' @return A `data.frame` with driver metadata. #' @export #' @md #' @examples #' # The following driver lists depend on the GDAL setup and platform used: #' st_drivers() #' st_drivers("raster", "GeoT") st_drivers = function(what = "vector", regex) { ret = CPL_get_gdal_drivers(0) row.names(ret) = ret$name ret = switch(what, vector = ret[ret$is_vector,], raster = ret[ret$is_raster,], ret) if (missing(regex)) ret else { fn = function(x, pattern) any(grepl(x, pattern = pattern)) ret[apply(ret[c("name", "long_name")], 1, fn, pattern = regex), ] } } #' @export print.sf_layers = function(x, ...) { n_gt = max(sapply(x$geomtype, length)) x$geomtype = vapply(x$geomtype, function(x) paste(x, collapse = ", "), "") cat(paste("Driver:", x$driver, "\n")) x$driver = NULL x$features[x$features < 0] = NA cat("Available layers:\n") if (length(x$name) == 0) { cat("\n") # nocov invisible(x) # nocov } else { crs = sapply(x$crs, function(crs) crs$input) x$crs = crs df = data.frame(unclass(x)) gt = if (n_gt > 1) "geometry_types" else "geometry_type" names(df) = c("layer_name", gt, "features", "fields", "crs_name") print(df) invisible(df) } } #' Return properties of layers in a datasource #' #' Return properties of layers in a datasource #' @param dsn data source name (interpretation varies by driver - for some drivers, \code{dsn} is a file name, but may also be a #' folder, or contain the name and access credentials of a database) #' @param options character; driver dependent dataset open options, multiple options supported. #' @param do_count logical; if TRUE, count the features by reading them, even if their count is not reported by the driver #' @name st_layers #' @return list object of class \code{sf_layers} with elements #' \describe{ #' \item{name}{name of the layer} #' \item{geomtype}{list with for each layer the geometry types} #' \item{features}{number of features (if reported; see \code{do_count})} #' \item{fields}{number of fields} #' \item{crs}{list with for each layer the \code{crs} object} #' } #' @export st_layers = function(dsn, options = character(0), do_count = FALSE) { if (missing(dsn)) stop("dsn should specify a data source or filename") if (length(dsn) == 1 && file.exists(dsn)) dsn = enc2utf8(normalizePath(dsn)) ret = CPL_get_layers(dsn, options, do_count) if (length(ret[[1]]) > 0) { Encoding(ret[[1]]) <- "UTF-8" ret[[1]] <- enc2native(ret[[1]]) } structure(ret, row.names = seq_along(ret[[1]]), class = c("sf_layers", "data.frame")) } guess_driver = function(dsn) { stopifnot(is.character(dsn)) stopifnot(length(dsn) == 1) # find match: try extension first drv = extension_map[tolower(tools::file_ext(dsn))] if (is_db_driver(dsn)) drv = prefix_map[tolower(strsplit(dsn, ":")[[1]][1])] drv <- unlist(drv) if (is.null(drv)) { # no match return(NA) } drv } is_db_driver = function(dsn) { any(grep(":", gsub(":[/\\]", "/", dsn))) } guess_driver_can_write = function(dns, drv = guess_driver(dns)) { if(is.na(drv)) { stop("Could not guess driver for ", dns, call. = FALSE) } if(!is_driver_available(drv)) { stop(unlist(drv), " driver not available in supported drivers, see `st_drivers()'", call. = FALSE) } if(!is_driver_can(drv, operation = "write")) { stop("Driver ", drv, " cannot write. see `st_drivers()'", call. = FALSE) } return(drv) } #' Check if driver is available #' #' Search through the driver table if driver is listed #' @param drv character. Name of driver #' @param drivers data.frame. Table containing driver names and support. Default #' is from \code{\link{st_drivers}} is_driver_available = function(drv, drivers = st_drivers()) { i = match(drv, drivers$name) if (is.na(i)) return(FALSE) return(TRUE) } #' Check if a driver can perform an action #' #' Search through the driver table to match a driver name with #' an action (e.g. \code{"write"}) and check if the action is supported. #' @param drv character. Name of driver #' @param drivers data.frame. Table containing driver names and support. Default #' is from \code{\link{st_drivers}} #' @param operation character. What action to check is_driver_can = function(drv, drivers = st_drivers(), operation = "write") { stopifnot(operation %in% names(drivers)) i = match(drv, drivers$name) if (!drivers[i, operation]) return(FALSE) return(TRUE) } #' Map extension to driver #' @docType data extension_map <- list( "bna" = "BNA", "csv" = "CSV", "e00" = "AVCE00", "fgb" = "FlatGeobuf", "gdb" = "OpenFileGDB", "geojson" = "GeoJSON", "gml" = "GML", "gmt" = "GMT", "gpkg" = "GPKG", "gps" = "GPSBabel", "gpx" = "GPX", "gtm" = "GPSTrackMaker", "gxt" = "Geoconcept", "jml" = "JML", "kml" = "KML", "map" = "WAsP", "mdb" = "Geomedia", "nc" = "netCDF", "ods" = "ODS", "osm" = "OSM", "pbf" = "OSM", "shp" = "ESRI Shapefile", "sqlite" = "SQLite", "vdv" = "VDV", "xls" = "xls", "xlsx" = "XLSX") #' Map prefix to driver #' @docType data prefix_map <- list( "couchdb" = "CouchDB", "db2odbc" = "DB2ODBC", "dods" = "DODS", "gft" = "GFT", "mssql" = "MSSQLSpatial", "mysql" = "MySQL", "oci" = "OCI", "odbc" = "ODBC", "pg" = "PostgreSQL", "sde" = "SDE") #' Drivers for which update should be \code{TRUE} by default #' @docType data db_drivers <- c(unlist(prefix_map), "GPKG", "SQLite") # Utils ---------------------------------------------------------------------- check_append_delete <- function(append, delete) { if (append && delete) { stop("`delete_layer` and `append` cannot both be `TRUE`", call. = FALSE) } } #' @name st_write #' @export #' @details `st_delete()` deletes layer(s) in a data source, or a data source if layers are #' omitted; it returns `TRUE` on success, `FALSE` on failure, invisibly. st_delete = function(dsn, layer = character(0), driver = guess_driver_can_write(dsn), quiet = FALSE) { invisible(CPL_delete_ogr(dsn, layer, driver, quiet) == 0) } ================================================ FILE: R/s2.R ================================================ # see https://docs.google.com/presentation/d/1Hl4KapfAENAOf4gv-pSngKwvS_jwNVHRPZTTDzXXn6Q/view?pli=1#slide=id.i0 # and the r-spatial/s2 package: # https://github.com/r-spatial/s2 #' @export #' @param ... passed on #' @param use_s2 logical; if \code{TRUE}, use the s2 spherical geometry package #' for geographical coordinate operations #' @name s2 #' @return \code{sf_use_s2} returns the value of this variable before (re)setting it, #' invisibly if \code{use_s2} is not missing. sf_use_s2 = function(use_s2) { ret_val = getOption("sf_use_s2", default = TRUE) if (! missing(use_s2)) { stopifnot(is.logical(use_s2), length(use_s2)==1, !is.na(use_s2)) if (ret_val != use_s2) message(paste0("Spherical geometry (s2) switched ", ifelse(use_s2, "on", "off"))) options(sf_use_s2 = use_s2) invisible(ret_val) } else ret_val } #' @name st_as_sfc #' @export #' @param crs coordinate reference system to be assigned; object of class \code{crs} #' @param endian integer; 0 or 1: defaults to the endian of the native machine st_as_sfc.s2_geography = function(x, ..., crs = st_crs(4326), endian = match(.Platform$endian, c("big", "little")) - 1L) { st_cast(st_as_sfc(s2::s2_as_binary(x, endian = endian), ..., crs = crs)) } #' @name st_as_sf #' @param crs coordinate reference system to be assigned; object of class \code{crs} #' @export st_as_sf.s2_geography = function(x, ..., crs = st_crs(4326)) { st_sf(geometry = st_as_sfc(x, ..., crs = crs)) } # dynamically exported in tidyverse.R as_s2_geography.sfg <- function(x, ..., oriented = getOption("s2_oriented", FALSE)) { b = structure(list(st_as_binary(x)), class = "WKB") s2::as_s2_geography(b, ..., oriented = oriented) } # dynamically exported in tidyverse.R as_s2_geography.sfc <- function(x, ..., oriented = getOption("s2_oriented", FALSE) || isTRUE(attr(x, "oriented"))) { st_as_s2.sfc(x, ..., oriented = oriented) } # dynamically exported in tidyverse.R as_s2_geography.sf <- function(x, ...) { st_as_s2.sf(x, ...) } #' functions for spherical geometry, using s2 package #' #' functions for spherical geometry, using the s2 package based on the google s2geometry.io library #' @name s2 #' @param x object of class \code{sf}, \code{sfc} or \code{sfg} #' @export #' @details \code{st_as_s2} converts an \code{sf} POLYGON object into a form readable by \code{s2}. #' @examples #' m = rbind(c(-1,-1), c(1,-1), c(1,1), c(-1,1), c(-1,-1)) #' m1 = rbind(c(-1,-1), c(1,-1), c(1,1), c(-1,1), c(-1,0), c(-1,-1)) #' m0 = m[5:1,] #' mp = st_multipolygon(list( #' list(m, 0.8 * m0, 0.01 * m1 + 0.9), #' list(0.7* m, 0.6*m0), #' list(0.5 * m0), #' list(m+2), #' list(m+4,(.9*m0)+4) #' )) #' sf = st_sfc(mp, mp, crs = 'EPSG:4326') #' s2 = st_as_s2(sf) st_as_s2 = function(x, ...) UseMethod("st_as_s2") #' @name s2 #' @export st_as_s2.sf = function(x, ...) st_as_s2(st_geometry(x), ...) #' @name s2 #' @param oriented logical; if \code{FALSE}, polygons that #' cover more than half of the globe are inverted; if \code{TRUE}, no reversal #' takes place and it is assumed that the inside of the polygon is to the #' left of the polygon's path. #' @param rebuild logical; call \link[s2]{s2_rebuild} on the geometry (think of this as a \code{st_make_valid} on the sphere) #' @export st_as_s2.sfc = function(x, ..., oriented = getOption("s2_oriented", FALSE) || isTRUE(attr(x, "oriented")), rebuild = FALSE) { if (!is.na(st_crs(x)) && !st_is_longlat(x)) x = st_transform(x, ifelse(st_axis_order(), "OGC:CRS84", "EPSG:4326")) if (length(x) && nchar(class(x[[1]])[1]) > 2) { # Z, M, ZM: message("st_as_s2(): dropping Z and/or M coordinate") x = st_zm(x) } if (rebuild) s2::s2_rebuild(s2::as_s2_geography(st_as_binary(x), ..., oriented = oriented, check = FALSE)) else s2::as_s2_geography(st_as_binary(x), ..., oriented = oriented) } ================================================ FILE: R/sample.R ================================================ #' @export #' @name st_sample st_sample = function(x, size, ...) UseMethod("st_sample") #' sample points on or in (sets of) spatial features #' #' Sample points on or in (sets of) spatial features. #' By default, returns a pre-specified number of points that is equal to #' \code{size} (if \code{type = "random"} and \code{exact = TRUE}) or an approximation of #' \code{size} otherwise. \code{spatstat} methods are #' interfaced and do not use the \code{size} argument, see examples. #' #' The function is vectorised: it samples \code{size} points across all geometries in #' the object if \code{size} is a single number, or the specified number of points #' in each feature if \code{size} is a vector of integers equal in length to the geometry #' of \code{x}. #' #' @param x object of class \code{sf} or \code{sfc} #' @param size sample size(s) requested; either total size, or a numeric vector with sample sizes for each feature geometry. When sampling polygons, the returned sampling size may differ from the requested size, as the bounding box is sampled, and sampled points intersecting the polygon are returned. #' @param warn_if_not_integer logical; if \code{FALSE} then no warning is emitted if \code{size} is not an integer #' @param ... passed on to \link[base]{sample} for \code{multipoint} sampling, or to \code{spatstat} functions for spatstat sampling types (see details) #' @param type character; indicates the spatial sampling type; one of \code{random}, \code{hexagonal} (triangular really), \code{regular}, \code{Fibonacci}, #' or one of the \code{spatstat} methods such as \code{Thomas} for calling \code{spatstat.random::rThomas} (see Details). #' @param exact logical; should the length of output be exactly #' @param by_polygon logical; for \code{MULTIPOLYGON} geometries, should the effort be split by \code{POLYGON}? See https://github.com/r-spatial/sf/issues/1480 #' the same as specified by \code{size}? \code{TRUE} by default. Only applies to polygons, and #' when \code{type = "random"}. #' @param progress logical; if \code{TRUE} show progress bar (only if \code{size} is a vector). #' @param force logical; if `TRUE` continue when the sampled bounding box area is more than 1e4 times the area of interest, else (default) stop with an error. If this error is not justified, try setting `oriented=TRUE`, see details. #' @return an \code{sfc} object containing the sampled \code{POINT} geometries #' @details if \code{x} has dimension 2 (polygons) and geographical coordinates (long/lat), uniform random sampling on the sphere is applied, see e.g. \url{https://mathworld.wolfram.com/SpherePointPicking.html}. #' #' For \code{regular} or \code{hexagonal} sampling of polygons, the resulting size is only an approximation. #' #' As parameter called \code{offset} can be passed to control ("fix") regular or hexagonal sampling: for polygons a length 2 numeric vector (by default: a random point from \code{st_bbox(x)}); for lines use a number like \code{runif(1)}. #' #' Fibonacci sampling see: Alvaro Gonzalez, 2010. Measurement of Areas on a Sphere Using Fibonacci and Latitude-Longitude Lattices. #' Mathematical Geosciences 42(1), p. 49-64 #' #' For regular sampling on the sphere, see also \code{geosphere::regularCoordinates}. #' #' Sampling methods from package \code{spatstat} are interfaced (see examples), and need their own parameters to be set. #' For instance, to use \code{spatstat.random::rThomas()}, set \code{type = "Thomas"}. #' #' For sampling polygons one can specify `oriented=TRUE` to make sure that polygons larger than half the globe are not reverted, e.g. when specifying a polygon from a bounding box of a global dataset. The `st_sample` method for `bbox` does this by default. #' @examples #' nc = st_read(system.file("shape/nc.shp", package="sf")) #' p1 = st_sample(nc[1:3, ], 6) #' p2 = st_sample(nc[1:3, ], 1:3) #' plot(st_geometry(nc)[1:3]) #' plot(p1, add = TRUE) #' plot(p2, add = TRUE, pch = 2) #' x = st_sfc(st_polygon(list(rbind(c(0,0),c(90,0),c(90,90),c(0,90),c(0,0)))), crs = st_crs(4326)) #' plot(x, axes = TRUE, graticule = TRUE) #' if (compareVersion(sf_extSoftVersion()["proj.4"], "4.9.0") >= 0) #' plot(p <- st_sample(x, 1000), add = TRUE) #' if (require(lwgeom, quietly = TRUE)) { # for st_segmentize() #' x2 = st_transform(st_segmentize(x, 1e4), st_crs("+proj=ortho +lat_0=30 +lon_0=45")) #' g = st_transform(st_graticule(), st_crs("+proj=ortho +lat_0=30 +lon_0=45")) #' plot(x2, graticule = g) #' if (compareVersion(sf_extSoftVersion()["proj.4"], "4.9.0") >= 0) { #' p2 = st_transform(p, st_crs("+proj=ortho +lat_0=30 +lon_0=45")) #' plot(p2, add = TRUE) #' } #' } #' x = st_sfc(st_polygon(list(rbind(c(0,0),c(90,0),c(90,10),c(0,90),c(0,0))))) # NOT long/lat: #' plot(x) #' p_exact = st_sample(x, 1000, exact = TRUE) #' p_not_exact = st_sample(x, 1000, exact = FALSE) #' length(p_exact); length(p_not_exact) #' plot(st_sample(x, 1000), add = TRUE) #' x = st_sfc(st_polygon(list(rbind(c(-180,-90),c(180,-90),c(180,90),c(-180,90),c(-180,-90)))), #' crs=st_crs(4326)) #' # FIXME: #' #if (compareVersion(sf_extSoftVersion()["proj.4"], "4.9.0") >= 0) { #' # p = st_sample(x, 1000) #' # st_sample(p, 3) #' #} #' # hexagonal: #' sfc = st_sfc(st_polygon(list(rbind(c(0,0), c(1,0), c(1,1), c(0,0))))) #' plot(sfc) #' h = st_sample(sfc, 100, type = "hexagonal") #' h1 = st_sample(sfc, 100, type = "hexagonal") #' plot(h, add = TRUE) #' plot(h1, col = 'red', add = TRUE) #' c(length(h), length(h1)) # approximate! #' pt = st_multipoint(matrix(1:20,,2)) #' ls = st_sfc(st_linestring(rbind(c(0,0),c(0,1))), #' st_linestring(rbind(c(0,0),c(.1,0))), #' st_linestring(rbind(c(0,1),c(.1,1))), #' st_linestring(rbind(c(2,2),c(2,2.00001)))) #' st_sample(ls, 80) #' plot(st_sample(ls, 80)) #' # spatstat example: #' if (require(spatstat.random)) { #' x <- sf::st_sfc(sf::st_polygon(list(rbind(c(0, 0), c(10, 0), c(10, 10), c(0, 0))))) #' # for spatstat.random::rThomas(), set type = "Thomas": #' pts <- st_sample(x, kappa = 1, mu = 10, scale = 0.1, type = "Thomas") #' } #' @export #' @name st_sample st_sample.sf = function(x, size, ...) st_sample(st_geometry(x), size, ...) #' @export #' @name st_sample st_sample.sfc = function(x, size, ..., type = "random", exact = TRUE, warn_if_not_integer = TRUE, by_polygon = FALSE, progress = FALSE, force = FALSE) { if (!missing(size) && warn_if_not_integer && any(size %% 1 != 0)) warning("size is not an integer") if (!missing(size) && length(size) > 1) { # recurse: size = rep(size, length.out = length(x)) ret = if (progress) { if (!requireNamespace("pbapply", quietly = TRUE)) stop("package pbapply required, please install it first") pbapply::pblapply(seq_along(x), function(i) st_sample(x[i], size[i], type = type, exact = exact, ...)) } else lapply(seq_along(x), function(i) st_sample(x[i], size[i], type = type, exact = exact, ...)) st_set_crs(do.call(c, ret), st_crs(x)) } else { res = switch(max(st_dimension(x)) + 1, st_multipoints_sample(do.call(c, x), size = size, ..., type = type), st_ll_sample(st_cast(x, "LINESTRING"), size = size, ..., type = type), st_poly_sample(x, size = size, ..., type = type, by_polygon = by_polygon, force = force)) if (exact && type == "random" && all(st_geometry_type(res) == "POINT")) { diff = size - length(res) if (diff > 0) { # too few points res_additional = st_sample_exact(x = x, size = diff, ..., type = type, by_polygon = by_polygon) res = c(res, res_additional) } else if (diff < 0) { # too many points res = res[1:size] } } res } } #' @export #' @name st_sample st_sample.sfg = function(x, size, ...) { st_sample(st_geometry(x), size, ...) } #' @export #' @name st_sample #' @param great_circles logical; if `TRUE`, great circle arcs are used to connect the bounding box vertices, if `FALSE` parallels (graticules) #' @param segments units, or numeric (degrees); segment sizes for segmenting a bounding box polygon if `great_circles` is `FALSE` #' @examples #' bbox = st_bbox( #' c(xmin = 0, xmax = 40, ymax = 70, ymin = 60), #' crs = st_crs('OGC:CRS84') #' ) #' set.seed(13531) #' s1 = st_sample(bbox, 400) #' st_bbox(s1) # within bbox #' s2 = st_sample(bbox, 400, great_circles = TRUE) #' st_bbox(s2) # outside bbox st_sample.bbox = function(x, size, ..., great_circles = FALSE, segments = units::set_units(2, "degree", mode = "standard")) { polygon = st_as_sfc(x) crs = st_crs(x) if (isTRUE(st_is_longlat(x)) && !great_circles) { st_crs(polygon) = NA_crs_ # to fool segmentize that we're on R2: segments = units::drop_units(units::set_units(segments, "degree", mode = "standard")) polygon = st_set_crs(st_segmentize(polygon, segments), crs) } st_sample(polygon, size, ..., oriented = TRUE) } st_poly_sample = function(x, size, ..., type = "random", offset = st_sample(st_as_sfc(st_bbox(x)), 1)[[1]], by_polygon = FALSE, oriented = FALSE, force = FALSE) { if (by_polygon && inherits(x, "sfc_MULTIPOLYGON")) { # recurse into polygons: sum_a = units::drop_units(sum(st_area(x))) x = lapply(suppressWarnings(st_cast(st_geometry(x), "POLYGON")), st_sfc, crs = st_crs(x)) a = sapply(x, st_area) ret = mapply(st_poly_sample, x, size = size * a / sum_a, type = type, ...) do.call(c, ret) } else if (type %in% c("hexagonal", "regular", "random", "Fibonacci")) { if (isTRUE(st_is_longlat(x))) { if (type == "regular") { message_longlat("st_sample") x = st_set_crs(x, NA) } if (type == "hexagonal") stop("hexagonal sampling on geographic coordinates not supported; consider projecting first") } else if (type == "Fibonacci") stop("Fibonacci sampling requires geographic (longlat) coordinates") global = FALSE bb = st_bbox(x) if (isTRUE(st_is_longlat(x))) { if (sf_use_s2()) { # if FALSE, the user wants the coord ranges to be the bbox if (!requireNamespace("lwgeom", quietly = TRUE)) warning("coordinate ranges not computed along great circles; install package lwgeom to get rid of this warning") else { # see https://github.com/r-spatial/sf/issues/2331 # bb = st_bbox(st_segmentize(st_as_sfc(bb), # units::set_units(1, "degree", mode = "standard"))) # get coordinate range on S2 dfMaxLength = units::set_units(100000, "m", mode = "standard") if (! is.na(st_crs(x))) units(dfMaxLength) = units(st_crs(x)$SemiMajor) # might convert seg = st_sfc(CPL_gdal_segmentize(x, dfMaxLength), crs = st_crs(x)) # avoid lwgeom path bb = st_bbox(seg) } } R = s2::s2_earth_radius_meters() earth_surface = 4 * pi * R^2. toRad = pi / 180. h1 = sin(bb["ymax"] * toRad) h2 = sin(bb["ymin"] * toRad) a0 = 2 * pi * R^2. * (h1 - h2) * (bb["xmax"] - bb["xmin"]) / 360. # total a1 = sum(s2::s2_area(st_as_s2(x, oriented = oriented))) # actual if (!is.finite(a1)) stop("One or more geometries have a non-finite area") global = (a0 / earth_surface) > .9999 if (a0 / a1 > 1e4 && !force) stop(paste0("sampling box is ", format(a0/a1), " times larger than sampling region;\nuse force=TRUE if you really want this, or try setting oriented=TRUE\n(after reading the documentation)"), call. = FALSE) size = round(size * a0 / a1) } else { a0 = as.numeric(st_area(st_as_sfc(bb))) # total a1 = as.numeric(sum(st_area(x))) # actual # we're sampling from a box, so n should be size_desired * a0 / a1 if (is.finite(a0) && is.finite(a1) && a0 > a0 * 0.0 && a1 > a1 * 0.0) { # FIXME: reqs can be removed, now we handle long/lat separately? r = size * a0 / a1 size = if (round(r) == 0) rbinom(1, 1, r) else round(r) } } size = max(1, size) pts = if (type == "hexagonal") { dx = sqrt(a0 / size / (sqrt(3)/2)) hex_grid_points(x, pt = offset, dx = dx) } else if (type == "regular") { dx = as.numeric(sqrt(a0 / size)) offset = c((offset[1] - bb["xmin"]) %% dx, (offset[2] - bb["ymin"]) %% dx) + bb[c("xmin", "ymin")] n = c(round((bb["xmax"] - offset[1])/dx), round((bb["ymax"] - offset[2])/dx)) st_make_grid(x, cellsize = c(dx, dx), offset = offset, n = n, what = "corners") } else { m = if (type == "random") { lon = runif(size, bb[1], bb[3]) lat = if (isTRUE(st_is_longlat(x))) { # sampling on the sphere: toRad = pi/180 lat0 = (sin(bb[2] * toRad) + 1)/2 lat1 = (sin(bb[4] * toRad) + 1)/2 y = runif(size, lat0, lat1) asin(2 * y - 1) / toRad # http://mathworld.wolfram.com/SpherePointPicking.html } else runif(size, bb[2], bb[4]) structure(cbind(lon, lat), dimnames = NULL) } else if (type == "Fibonacci") fiboGrid(size %/% 2, bb[c("xmin", "xmax")], bb[c("ymin", "ymax")]) else stop("unknown value for type") # st_sfc(lapply(seq_len(nrow(m)), function(i) st_point(m[i,])), crs = st_crs(x)) st_as_sf(as.data.frame(m), coords = 1:2, crs = st_crs(x))[["geometry"]] } if (global) pts else pts[x] # cut out x from bbox } else { # try to go into spatstat if (!requireNamespace("spatstat.random", quietly = TRUE)) stop("package spatstat.random required, please install it (or the full spatstat package) first") spatstat_fun = try(get(paste0("r", type), asNamespace("spatstat.random")), silent = TRUE) if (inherits(spatstat_fun, "try-error")) stop(paste0("r", type), " is not an exported function from spatstat.random.") pts = if ("win" %in% names(as.list(args(spatstat_fun)))) try(spatstat_fun(..., win = spatstat.geom::as.owin(x)), silent = TRUE) else try(spatstat_fun(..., W = spatstat.geom::as.owin(x)), silent = TRUE) if (inherits(pts, "try-error")) stop("The spatstat function ", paste0("r", type), " did not return a valid result. Consult the help file.\n", "Error message from spatstat:\n", pts) st_as_sf(pts)[-1,] } } st_multipoints_sample = function(x, size, ..., type = "random") { if (!inherits(x, "MULTIPOINT")) stop("points sampling only implemented for MULTIPOINT; use sample to sample individual features", call.=FALSE) m = unclass(x) st_sfc(st_multipoint(m[sample(nrow(m), size, ...),]), crs = st_crs(x)) } st_ll_sample = function(x, size, ..., type = "random", offset = runif(1)) { crs = st_crs(x) if (isTRUE(st_is_longlat(x))) { message_longlat("st_sample") st_crs(x) = NA_crs_ } l = st_length(x) if (inherits(l, "units")) l = drop_units(l) if (type == "random") { d = runif(size, 0, sum(l)) } else if (type == "regular") { d = ((1:size) - (1. - (offset %% 1)))/size * sum(l) } else { stop(paste("sampling type", type, "not available for LINESTRING")) # nocov } lcs = c(0, cumsum(l)) if (sum(l) == 0) { grp = list(0) # nocov warning("line is of length zero, only one point is sampled") # nocov } else { grp = split(d, cut(d, lcs, include.lowest = TRUE)) grp = lapply(seq_along(x), function(i) grp[[i]] - lcs[i]) } st_sfc(CPL_gdal_linestring_sample(x, grp), crs = crs) } ### return points on a triangular grid that ## - covers a bounding box st_bbox(obj) ## - contains pt ## - has x spacing dx: the shortest distance between x coordinates with identical y coordinate hex_grid_points = function(obj, pt, dx) { bb = st_bbox(obj) dy = sqrt(3) * dx / 2 xlim = bb[c("xmin", "xmax")] ylim = bb[c("ymin", "ymax")] offset = c(x = (pt[1] - xlim[1]) %% dx, y = (pt[2] - ylim[1]) %% (2 * dy)) x = seq(xlim[1] - dx, xlim[2] + dx, dx) + offset[1] y = seq(ylim[1] - 2 * dy, ylim[2] + 2 * dy, dy) + offset[2] y = rep(y, each = length(x)) x = rep(c(x, x + dx / 2), length.out = length(y)) xy = cbind(x, y)[x >= xlim[1] & x <= xlim[2] & y >= ylim[1] & y <= ylim[2], , drop = FALSE] colnames(xy) = NULL st_sfc(lapply(seq_len(nrow(xy)), function(i) st_point(xy[i,])), crs = st_crs(bb)) } fiboGrid <- function(N, xlim = c(-180,180), ylim = c(-90,90)) { if (max(xlim) <= 180) subtr = 180 else subtr = 0 phi = (1 + sqrt(5))/2 i = seq(-N, N) P = 2 * N + 1 lat = asin(2*i / P) * 180 / pi lon = ((2 * pi * i / phi) %% pi) * 360 / pi - subtr sel = lon <= xlim[2] & lon >= xlim[1] & lat <= ylim[2] & lat >= ylim[1] cbind(lon, lat)[sel, ] } st_sample_exact = function(x, size, ..., type, by_polygon) { random_pt = st_sample(x = x, size = size, ..., type = type, exact = FALSE) while (length(random_pt) < size) { diff = size - length(random_pt) random_pt_new = st_sample(x, size = diff, ..., type, exact = FALSE, by_polygon = by_polygon) random_pt = c(random_pt, random_pt_new) } if (length(random_pt) > size) { random_pt = random_pt[1:size] } random_pt } ================================================ FILE: R/sf-package.R ================================================ #' @keywords internal #' @aliases sf-package #' @references #' Pebesma, E. and Bivand, R. (2023). Spatial Data #' Science: With Applications in R. Chapman and Hall/CRC. #' \doi{10.1201/9780429459016} which is also found freely #' online at #' #' Pebesma, E., 2018. Simple Features for R: Standardized Support #' for Spatial Vector Data. The R Journal 10 (1), 439-446, #' \doi{10.32614/RJ-2018-009} (open access) "_PACKAGE" ================================================ FILE: R/sf.R ================================================ #' Convert foreign object to an sf object #' #' Convert foreign object to an sf object #' @param x object to be converted into an object class \code{sf} #' @export st_as_sf = function(x, ...) UseMethod("st_as_sf") #' @name st_as_sf #' #' @param agr character vector; see details section of \link{st_sf} #' @param coords in case of point data: names or numbers of the numeric columns holding coordinates #' @param wkt name or number of the character column that holds WKT encoded geometries #' @param dim specify what 3- or 4-dimensional points reflect: passed on to \link{st_point} (only when argument coords is given) #' @param remove logical; when coords or wkt is given, remove these columns from data.frame? #' @param na.fail logical; if \code{TRUE}, raise an error if coordinates contain missing values #' @param sf_column_name character; name of the active list-column with simple feature geometries; in case #' there is more than one and \code{sf_column_name} is \code{NULL}, the first one is taken. #' @param ... passed on to \link{st_sf}, might included named arguments \code{crs} or \code{precision} #' @details setting argument \code{wkt} annihilates the use of argument \code{coords}. If \code{x} contains a column called "geometry", \code{coords} will result in overwriting of this column by the \link{sfc} geometry list-column. Setting \code{wkt} will replace this column with the geometry list-column, unless \code{remove} is \code{FALSE}. #' #' If `coords` has length 4, and `dim` is not `XYZM`, the four columns are taken as the xmin, ymin, xmax, ymax corner coordinates of a rectangle, and polygons are returned. #' #' @examples #' pt1 = st_point(c(0,1)) #' pt2 = st_point(c(1,1)) #' st_sfc(pt1, pt2) #' d = data.frame(a = 1:2) #' d$geom = st_sfc(pt1, pt2) #' df = st_as_sf(d) #' d$geom = c("POINT(0 0)", "POINT(0 1)") #' df = st_as_sf(d, wkt = "geom") #' d$geom2 = st_sfc(pt1, pt2) #' st_as_sf(d) # should warn #' if (require(sp, quietly = TRUE)) { #' data(meuse, package = "sp") #' meuse_sf = st_as_sf(meuse, coords = c("x", "y"), crs = 28992, agr = "constant") #' meuse_sf[1:3,] #' summary(meuse_sf) #' } #' @export st_as_sf.data.frame = function(x, ..., agr = NA_agr_, coords, wkt, dim = "XYZ", remove = TRUE, na.fail = TRUE, sf_column_name = NULL) { if (! missing(wkt)) { if (remove) x[[wkt]] = st_as_sfc(as.character(x[[wkt]])) else x$geometry = st_as_sfc(as.character(x[[wkt]])) } else if (! missing(coords)) { cc = as.matrix(as.data.frame(lapply(x[coords], as.numeric))) anyna = anyNA(cc) if (na.fail && anyna) stop("missing values in coordinates not allowed") if (anyna) cc[apply(cc, 1, anyNA),] = NA_real_ # classdim = getClassDim(rep(0, length(coords)), length(coords), dim, "POINT") if (is.null(sf_column_name)) sf_column_name = "geometry" x[[sf_column_name]] = if (nchar(dim) < 4 && ncol(cc) == 4) { # create POLYGONs: fn = function(x) st_as_sfc(st_bbox(c(xmin = x[[1]], ymin = x[[2]], xmax = x[[3]], ymax = x[[4]]))) do.call(c, apply(cc, 1, fn)) } else { # points: structure(points_rcpp(cc, dim), n_empty = 0L, precision = 0, crs = NA_crs_, bbox = structure( c(xmin = min(cc[,1], na.rm = TRUE), ymin = min(cc[,2], na.rm = TRUE), xmax = max(cc[,1], na.rm = TRUE), ymax = max(cc[,2], na.rm = TRUE)), class = "bbox"), class = c("sfc_POINT", "sfc" ), names = NULL) } if (remove) { if (is.character(coords)) coords = match(coords, names(x)) x = x[-coords] } if (length(coords) > 2 && grepl("Z", dim)) attr(x[[sf_column_name]], "z_range") = compute_z_range(x[[sf_column_name]]) if (length(coords) > 2 && grepl("M", dim)) attr(x[[sf_column_name]], "m_range") = compute_m_range(x[[sf_column_name]]) } st_sf(x, ..., agr = agr, sf_column_name = sf_column_name) } #' @name st_as_sf #' @export st_as_sf.sf = function(x, ...) x #' @name st_as_sf #' @export st_as_sf.sfc = function(x, ...) st_sf(x, ...) #' Get, set, replace or rename geometry from an sf object #' #' Get, set, replace or rename geometry from an sf object #' @param obj object of class \code{sf} or \code{sfc} #' @param ... ignored #' @return st_geometry returns an object of class \link{sfc}, a list-column with geometries #' @export st_geometry = function(obj, ...) UseMethod("st_geometry") #' @name st_geometry #' @export st_geometry.sf = function(obj, ...) { ret = obj[[attr(obj, "sf_column")]] if (!inherits(ret, "sfc")) # corrupt! stop('attr(obj, "sf_column") does not point to a geometry column.\nDid you rename it, without setting st_geometry(obj) <- "newname"?') ret } #' @name st_geometry #' @export st_geometry.sfc = function(obj, ...) obj #' @name st_geometry #' @export st_geometry.sfg = function(obj, ...) st_sfc(obj) #' @name st_geometry #' @param x object of class \code{data.frame} or \code{sf} #' @param value object of class \code{sfc}, or \code{character} to set, replace, or rename the geometry of \code{x} #' @export #' @return \code{st_geometry} returns an object of class \link{sfc}. Assigning geometry to a \code{data.frame} creates an \link{sf} object, assigning it to an \link{sf} object replaces the geometry list-column. #' @details when applied to a \code{data.frame} and when \code{value} is an object of class \code{sfc}, \code{st_set_geometry} and \code{st_geometry<-} will first check for the existence of an attribute \code{sf_column} and overwrite that, or else look for list-columns of class \code{sfc} and overwrite the first of that, or else write the geometry list-column to a column named \code{geometry}. In case \code{value} is character and \code{x} is of class \code{sf}, the "active" geometry column is set to \code{x[[value]]}. #' #' the replacement function applied to \code{sf} objects will overwrite the geometry list-column, if \code{value} is \code{NULL}, it will remove it and coerce \code{x} to a \code{data.frame}. #' @examples #' df = data.frame(a = 1:2) #' sfc = st_sfc(st_point(c(3,4)), st_point(c(10,11))) #' st_geometry(sfc) #' st_geometry(df) <- sfc #' class(df) #' st_geometry(df) #' st_geometry(df) <- sfc # replaces #' st_geometry(df) <- NULL # remove geometry, coerce to data.frame `st_geometry<-` = function(x, value) UseMethod("st_geometry<-") #' @export `st_geometry<-.data.frame` = function(x, value) { stopifnot(inherits(value, "sfc") || is.character(value)) if (inherits(value, "sfc")) stopifnot(nrow(x) == length(value)) if (is.character(value)) st_sf(x, sf_column_name = value) else { a = vapply(x, function(v) inherits(v, "sfc"), TRUE) if (any(a)) { w = which(a) sf_col = attr(x, "sf_column") if (! is.null(sf_col)) x[[ sf_col ]] = value else { if (length(w) > 1) warning("overwriting first sfc column") x[[ which(a)[1L] ]] = value } } else x$geometry = value st_sf(x) } } #' @export `st_geometry<-.sf` = function(x, value) { if (! is.null(value)) { stopifnot(is.character(value) || inherits(value, "sfc")) if (inherits(value, "sfc")) stopifnot(nrow(x) == length(value)) } if (!is.null(value) && is.character(value)) { # set flag to another column: if (!(value %in% names(x))) names(x)[names(x) == attr(x, "sf_column")] = value attr(x, "sf_column") <- value } else # replace, remove, or set list-column x[[attr(x, "sf_column")]] <- value if (is.null(value)) structure(x, sf_column = NULL, agr = NULL, class = setdiff(class(x), "sf")) else x } #' @name st_geometry #' @export #' @examples #' sf <- st_set_geometry(df, sfc) # set geometry, return sf #' st_set_geometry(sf, NULL) # remove geometry, coerce to data.frame st_set_geometry = function(x, value) { st_geometry(x) = value x } #' @export st_as_sfc.sf = function(x, ...) st_geometry(x) list_column_to_sfc = function(x) { if (is.list(x) && !inherits(x, "data.frame")) { if (inherits(try(y <- st_as_sfc(x), silent = TRUE), "try-error")) x else y } else x } #' Create sf object #' #' Create sf, which extends data.frame-like objects with a simple feature list column. #' To convert a data frame object to `sf`, use [st_as_sf()] #' @name sf #' @aliases st_sf #' @param ... column elements to be binded into an \code{sf} object or a single \code{list} or \code{data.frame} with such columns; at least one of these columns shall be a geometry list-column of class \code{sfc} or be a list-column that can be converted into an \code{sfc} by \link{st_as_sfc}. #' @param crs coordinate reference system, something suitable as input to \link{st_crs} #' @param agr character vector; see details below. #' @param row.names row.names for the created \code{sf} object #' @param stringsAsFactors logical; see \link{st_read} #' @param precision numeric; see \link{st_as_binary} #' @param sf_column_name character; name of the active list-column with simple feature geometries; in case #' there is more than one and \code{sf_column_name} is \code{NULL}, the first one is taken. #' @param sfc_last logical; if \code{TRUE}, \code{sfc} columns are always put last, otherwise column order is left unmodified. #' @param check_ring_dir see \link{st_read} #' @details \code{agr}, attribute-geometry-relationship, specifies for each non-geometry attribute column how it relates to the geometry, and can have one of following values: "constant", "aggregate", "identity". "constant" is used for attributes that are constant throughout the geometry (e.g. land use), "aggregate" where the attribute is an aggregate value over the geometry (e.g. population density or population count), "identity" when the attributes uniquely identifies the geometry of particular "thing", such as a building ID or a city name. The default value, \code{NA_agr_}, implies we don't know. #' #' When a single value is provided to \code{agr}, it is cascaded across all input columns; otherwise, a named vector like \code{c(feature1='constant', ...)} will set \code{agr} value to \code{'constant'} for the input column named \code{feature1}. See \code{demo(nc)} for a worked example of this. #' #' When confronted with a data.frame-like object, \code{st_sf} will try to find a geometry column of class \code{sfc}, and otherwise try to convert list-columns when available into a geometry column, using \link{st_as_sfc}. #' @examples #' g = st_sfc(st_point(1:2)) #' st_sf(a=3,g) #' st_sf(g, a=3) #' st_sf(a=3, st_sfc(st_point(1:2))) # better to name it! #' # create empty structure with preallocated empty geometries: #' nrows <- 10 #' geometry = st_sfc(lapply(1:nrows, function(x) st_geometrycollection())) #' df <- st_sf(id = 1:nrows, geometry = geometry) #' @export st_sf = function(..., agr = NA_agr_, row.names, stringsAsFactors = sf_stringsAsFactors(), crs, precision, sf_column_name = NULL, check_ring_dir = FALSE, sfc_last = TRUE) { x = list(...) if (length(x) == 1L && (inherits(x[[1L]], "data.frame") || (is.list(x) && !inherits(x[[1L]], "sfc")))) x = x[[1L]] # find the sfc column(s): all_sfc_columns = vapply(x, function(x) inherits(x, "sfc"), TRUE) if (! any(all_sfc_columns)) { # try to create sfc from list-columns: xlst = lapply(x, list_column_to_sfc) all_sfc_columns = vapply(xlst, function(x) inherits(x, "sfc"), TRUE) if (! any(all_sfc_columns)) stop("no simple features geometry column present") x[all_sfc_columns] = xlst[all_sfc_columns] } all_sfc_columns = which(unlist(all_sfc_columns)) # set names if not present: all_sfc_names = if (!is.null(names(x)) && any(nzchar(names(x)[all_sfc_columns]))) names(x)[all_sfc_columns] else { object = as.list(substitute(list(...)))[-1L] arg_nm = sapply(object, function(x) deparse(x)) if (identical(arg_nm, ".")) arg_nm = "geometry" make.names(arg_nm[all_sfc_columns]) } if (! is.null(sf_column_name)) { stopifnot(sf_column_name %in% all_sfc_names) sf_column = match(sf_column_name, all_sfc_names) sfc_name = sf_column_name } else { sf_column = all_sfc_columns[1L] sfc_name = all_sfc_names[1L] } if (missing(row.names)) row.names = seq_along(x[[sf_column]]) df = if (inherits(x, c("tbl_df", "tbl"))) # no worries: x else if (length(x) == 1) # ONLY one sfc data.frame(row.names = row.names) else if (!sfc_last && inherits(x, "data.frame")) x else if (sfc_last && inherits(x, "data.frame")) x[-all_sfc_columns] else if (inherits(x[[1]], c("tbl_df", "tbl"))) x[[1]] else cbind(data.frame(row.names = row.names), as.data.frame(x[-all_sfc_columns], stringsAsFactors = stringsAsFactors, optional = TRUE)) if (check_ring_dir) { # process: for (i in seq_along(all_sfc_names)) df[[ all_sfc_names[i] ]] = st_sfc(x[[ all_sfc_columns[i] ]], check_ring_dir = check_ring_dir) } else { # copy: for (i in seq_along(all_sfc_names)) df[[ all_sfc_names[i] ]] = x[[ all_sfc_columns[i] ]] } if (! missing(precision)) attr(df[[sfc_name]], "precision") = precision # add attributes: attr(df, "sf_column") = sfc_name if (! inherits(df, "sf")) class(df) = c("sf", class(df)) st_agr(df) = agr if (! missing(crs)) st_crs(df) = crs if (Sys.getenv("ADD_SF_NAMESPACE") == "true") attr(df, ".sf_namespace") <- .sf_namespace df } .sf_namespace <- function() NULL #' @name sf #' @param x object of class \code{sf} #' @param i record selection, see \link{[.data.frame}, or a \code{sf} object to work with the \code{op} argument #' @param j variable selection, see \link{[.data.frame} #' @param drop logical, default \code{FALSE}; if \code{TRUE} drop the geometry column and return a \code{data.frame}, else make the geometry sticky and return a \code{sf} object. #' @param op function; geometrical binary predicate function to apply when \code{i} is a simple feature object #' @details \code{[.sf} will return a \code{data.frame} or vector if the geometry column (of class \code{sfc}) is dropped (\code{drop=TRUE}), an \code{sfc} object if only the geometry column is selected, and otherwise return an \code{sf} object; see also \link{[.data.frame}; for \code{[.sf} \code{...} arguments are passed to \code{op}. #' @examples #' g = st_sfc(st_point(1:2), st_point(3:4)) #' s = st_sf(a=3:4, g) #' s[1,] #' class(s[1,]) #' s[,1] #' class(s[,1]) #' s[,2] #' class(s[,2]) #' g = st_sf(a=2:3, g) #' pol = st_sfc(st_polygon(list(cbind(c(0,3,3,0,0),c(0,0,3,3,0))))) #' h = st_sf(r = 5, pol) #' g[h,] #' h[g,] #' @export "[.sf" = function(x, i, j, ..., drop = FALSE, op = st_intersects) { nargs = nargs() agr = st_agr(x) if (!missing(i) && (inherits(i, "sf") || inherits(i, "sfc") || inherits(i, "sfg"))) i = lengths(op(x, i, ...)) != 0 sf_column = attr(x, "sf_column") geom = st_geometry(x) if (!missing(i) && nargs > 2) { # e.g. a[3:4,] not a[3:4] if (is.character(i)) i = match(i, row.names(x)) geom = geom[i] } # x = as.data.frame(x) class(x) = setdiff(class(x), "sf") # one step down x = if (missing(j)) { if (nargs == 2) # `[`(x,i) x[i] # do sth else for tbl? else x[i, , drop = drop] } else x[i, j, drop = drop] if (!missing(j)) agr = agr[j] else if (!missing(i) && nargs <= 2) agr = agr[i] # e.g., obj["name"] if (inherits(x, "sfc")) # drop was TRUE, and we selected geom column only x else if (! drop) { x[[ sf_column ]] = geom x = st_sf(x, sf_column_name = sf_column, sfc_last = FALSE) st_set_agr(x, agr[match(setdiff(names(x), sf_column), names(agr))]) } else { if (inherits(x, "sf")) structure(x, class = setdiff(class(x), "sf")) else x } } #' @export "$<-.sf" = function(x, i, value) { if (is.null(value) && inherits(x[[i]], "sfc") && ((is.character(i) && i == attr(x, "sf_column")) || (is.integer(i) && names(x)[i] == attr(x, "sf_column")))) st_set_geometry(x, NULL) else { x[[i]] = value x } } #' @export "[<-.sf" = function(x, i, j, value) { st_as_sf(st_set_agr(NextMethod())) } #' @export "[[<-.sf" = function(x, i, value) { agr = st_agr(x) setting_geom = (i == attr(x, "sf_column")) || inherits(value, "sfc") if (! setting_geom) { # need to handle agr: ix = if (is.character(i)) which(i == names(x)) else i if (is.null(value)) # remove agr = agr[-ix] else { if (length(ix) == 0 || ix > length(names(x))) # add: agr = st_agr(c(as.character(agr), NA_character_)) else # replace: agr[ix] = NA } } x = structure(NextMethod(), class = c("sf", setdiff(class(x), "sf"))) if (! setting_geom) st_agr(x) = agr x } #' @rdname sf #' @param n maximum number of features to print; can be set globally by \code{options(sf_max_print=...)} #' @export print.sf = function(x, ..., n = getOption("sf_max_print", default = 10)) { geoms = which(vapply(x, function(col) inherits(col, "sfc"), TRUE)) nf = length(x) - length(geoms) app = paste("and", nf, ifelse(nf == 1, "field", "fields")) if (any(!is.na(st_agr(x)))) app = paste0(app, "\n", "Attribute-geometry relationship", ifelse(nf > 1, "s: ", ": "), summarize_agr(x)) if (length(geoms) > 1) app = paste0(app, "\n", "Active geometry column: ", attr(x, "sf_column")) print(st_geometry(x), n = 0, what = "Simple feature collection with", append = app) if (n > 0) { if (inherits(x, c("tbl_df", "tbl"))) NextMethod() else { y <- x if (nrow(y) > n) { cat(paste("First", n, "features:\n")) y <- x[1:n, , drop = FALSE] } print.data.frame(y, ...) } } invisible(x) } #' merge method for sf and data.frame object #' #' merge method for sf and data.frame object #' @param x object of class \code{sf} #' @param y object of class \code{data.frame} #' @param ... arguments passed on to \code{merge.data.frame} #' @export #' @examples #' a = data.frame(a = 1:3, b = 5:7) #' st_geometry(a) = st_sfc(st_point(c(0,0)), st_point(c(1,1)), st_point(c(2,2))) #' b = data.frame(x = c("a", "b", "c"), b = c(2,5,6)) #' merge(a, b) #' merge(a, b, all = TRUE) merge.sf = function(x, y, ...) { if (inherits(y, "sf")) stop("merge on two sf objects not supported") sf_column = attr(x, "sf_column") ret = NextMethod() # if data.table, drops sf_column attribute; class(ret) = setdiff(class(ret), "sf") g = ret[[sf_column]] # may have NULL values in it ret[[sf_column]] = st_sfc(g) # fix NULL values st_set_geometry(ret, sf_column) # FIXME: set agr } #' @export as.data.frame.sf = function(x, ...) { class(x) <- setdiff(class(x), "sf") NextMethod() } #' @export duplicated.sf <- function(x, incomparables = FALSE, fromLast = FALSE, ...) { if (length(x) != 1L) { if (any(i <- vapply(x, is.factor, NA))) { for (j in names(i[i])) { x[[j]] <- lapply(x[[j]], as.numeric) } } if (any(i <- (lengths(lapply(x, dim)) == 2L))) { for (j in names(i[i])) { x[[j]] <- lapply(x[[j]], split.data.frame, seq_len(nrow(x))) } } } NextMethod() } #' @export #' @name st_geometry #' @details if \code{x} is of class \code{sf}, \code{st_drop_geometry} drops the geometry of its argument, and reclasses it accordingly; otherwise it returns \code{x} unmodified. st_drop_geometry = function(x, ...) UseMethod("st_drop_geometry") #' @export #' @name st_geometry st_drop_geometry.sf = function(x, ...) { st_set_geometry(x, NULL) } #' @export #' @name st_geometry st_drop_geometry.default = function(x, ...) { x } #' transform method for sf objects #' #' Can be used to create or modify attribute variables; for transforming geometries see #' \link{st_transform}, and all other functions starting with \code{st_}. #' #' @param _data object of class \code{sf} #' @param ... Further arguments of the form `new_variable = expression` #' #' @export #' @examples #' a = data.frame(x1 = 1:3, x2 = 5:7) #' st_geometry(a) = st_sfc(st_point(c(0,0)), st_point(c(1,1)), st_point(c(2,2))) #' transform(a, x1_sq = x1^2) #' transform(a, x1_x2 = x1*x2) transform.sf <- function (`_data`, ...) { st_as_sf(NextMethod(), agr = st_agr(`_data`), sf_column_name = attr(`_data`, "sf_column")) } ================================================ FILE: R/sfc.R ================================================ #' @export str.sfc <- function(object, ...) { n <- length(object) cat(paste0(class(object)[1], " of length ", n)) if (n > 0) { cat("; first list element: ") str(object[[1]], ...) } } #' @export format.sfc = function(x, ..., width = 30) { vapply(x, format, "", ..., width = width) } #' Create simple feature geometry list column #' #' Create simple feature geometry list column, set class, and add coordinate reference system and precision. #' For data.frame alternatives see [st_sf()]. To convert a foreign object to `sfc`, see [st_as_sfc()] #' #' @name sfc #' @aliases sfc_POINT sfc_LINESTRING sfc_POLYGON sfc_MULTIPOINT sfc_MULTILINESTRING sfc_MULTIPOLYGON sfc_GEOMETRYCOLLECTION #' @param ... input: zero or more simple feature geometries (objects of class \code{sfg}), or a single list of such objects; \code{NULL} values will get replaced by empty geometries. #' @param crs coordinate reference system: integer with the EPSG code, or character with proj4string #' @param precision numeric; see \link{st_as_binary} #' @param check_ring_dir see \link{st_read} #' @param dim character; if this function is called without valid geometries, this argument may carry the right dimension to set empty geometries #' @param recompute_bbox logical; use \code{TRUE} to force recomputation of the bounding box #' @param oriented logical; if \code{TRUE}, the ring is oriented such that left of the edges is inside the polygon; this is #' needed for convering polygons larger than half the globe to s2 #' @param fall_back_class character; class for return object when no geometries are provided as input #' @return an object of class \code{sfc}, which is a classed list-column with simple feature geometries. #' #' @details A simple feature geometry list-column is a list of class #' \code{c("stc_TYPE", "sfc")} which most often contains objects of identical type; #' in case of a mix of types or an empty set, \code{TYPE} is set to the #' superclass \code{GEOMETRY}. #' @examples #' pt1 = st_point(c(0,1)) #' pt2 = st_point(c(1,1)) #' (sfc = st_sfc(pt1, pt2)) #' sfc[sfc[1], op = st_is_within_distance, dist = 0.5] #' d = st_sf(data.frame(a=1:2, geom=sfc)) #' @export st_sfc = function(..., crs = NA_crs_, precision = 0.0, check_ring_dir = FALSE, dim, recompute_bbox = FALSE, oriented = NA, fall_back_class = c("sfc_GEOMETRY", "sfc")) { lst = list(...) # if we have only one arg, which is already a list with sfg's, but NOT a geometrycollection: # (this is the old form of calling st_sfc; it is way faster to call st_sfc(lst) if lst # already contains a zillion sfg objects, than do.call(st_sfc, lst) ... if (length(lst) && inherits(lst[[1]], "sf")) stop("use st_as_sfc() to extract geometries from an sf object") if (length(lst) == 1 && is.list(lst[[1]]) && !inherits(lst[[1]], "sfg") && (length(lst[[1]]) == 0 || inherits(lst[[1]][[1]], "sfg") || is.null(lst[[1]][[1]]))) lst = lst[[1]] stopifnot(is.numeric(crs) || is.character(crs) || inherits(crs, "crs")) # check for NULLs: a = attributes(lst) is_null = sfc_is_null(lst) lst = unclass(lst) lst = lst[! is_null] attributes(lst) = a dims_and_types = sfc_unique_sfg_dims_and_types(lst) cls = if (length(lst) == 0) # empty set: no geometries to learn from fall_back_class else { # class: do we have a mix of geometry types? single = if (!is.null(attr(lst, "single_type"))) # set by CPL_read_wkb: attr(lst, "single_type") else length(dims_and_types[[2]]) == 1L attr(lst, "single_type") = NULL # clean up if (single) c(paste0("sfc_", dims_and_types[[2]][1]), "sfc") else c("sfc_GEOMETRY", "sfc") # the mix } if (any(is_null)) { if (missing(dim)) { dim = if (length(lst) == 0) # we have no clue: "XY" else dims_and_types[[1]][1] } ret = vector("list", length(is_null)) ret[!is_null] = lst ret[ is_null] = list(typed_empty(cls, nchar(dim), dim = dim)) attributes(ret) = attributes(lst) lst = ret dims_and_types = sfc_unique_sfg_dims_and_types(lst) } # set class: class(lst) = cls # set precision if (! missing(precision) || is.null(attr(lst, "precision"))) attr(lst, "precision") = precision # compute bbox, if not set: bb = attr(lst, "bbox") if (is.null(bb) || anyNA(bb) || recompute_bbox) attr(lst, "bbox") = compute_bbox(lst) # compute z_range, if dims permit and not set zr = attr(lst, "z_range") if (is.null(zr) || anyNA(zr)) { u <- dims_and_types[[1]] if( "XYZM" %in% u ) { attr(lst, "z_range") = compute_z_range(lst) attr(lst, "m_range") = compute_m_range(lst) } else if ( "XYZ" %in% u ) { attr(lst, "z_range") = compute_z_range(lst) } else if ("XYM" %in% u ) { attr(lst, "m_range") = compute_m_range(lst) } } # check ring directions: if (check_ring_dir) # also GEOMETRYCOLLECTION? lst = check_ring_dir(lst) # get & set crs: if (is.na(crs) && !is.null(attr(lst, "crs"))) crs = attr(lst, "crs") st_crs(lst) = crs # set classes attr in case of GEOMETRY attr(lst, "classes") = if (inherits(lst, "sfc_GEOMETRY")) # recompute, as NULL's may have been substituted: vapply(lst, class, rep(NA_character_, 3))[2L,] # else NULL: removes when present; #2567 # set n_empty, check XY* is uniform: if (is.null(attr(lst, "n_empty")) || any(is_null)) { # n_empty is set by CPL_read_wkb: attr(lst, "n_empty") = sum(sfc_is_empty(lst)) # https://github.com/r-spatial/sf/issues/1592 : # if (length(u <- unique(sfg_classes[1L,])) > 1) # stop(paste("found multiple dimensions:", paste(u, collapse = " "))) } if (isTRUE(oriented)) attr(lst, "oriented") = TRUE lst } #' @name sfc #' @param x object of class \code{sfc} #' @param i record selection. Might also be an \code{sfc}/\code{sf} object to work with the \code{op} argument #' @param j ignored if `op` is specified #' @param op function, geometrical binary predicate function to apply when #' \code{i} is a \code{sf}/\code{sfc} object. Additional arguments can be #' specified using \code{...}, see examples. #' @details if `x` has a `dim` attribute (i.e. is an `array` or `matrix`) then `op` cannot be used. #' @export "[.sfc" = function(x, i, j, ..., op = st_intersects) { precision = st_precision(x) crs = st_crs(x) dim = if (length(x)) class(x[[1]])[1] else "XY" if (!missing(i) && inherits(i, c("sf", "sfc", "sfg"))) i = lengths(op(x, i, ...)) != 0 st_sfc(unclass(x)[i], crs = crs, precision = precision, dim = dim, fall_back_class = class(x)) } #' @export "[<-.sfc" = function (x, i, j, ..., value) { if (is.null(value) || inherits(value, "sfg")) value = list(value) ret = st_sfc(NextMethod(), recompute_bbox = TRUE) structure(ret, n_empty = sum(sfc_is_empty(ret))) } #' @export c.sfc = function(..., recursive = FALSE) { lst = list(...) chk_equal_crs(lst) classes = sapply(lst, function(x) class(x)[1]) le = lengths(lst) if (any(le > 0)) classes = classes[le > 0] # removes the empty set GEOMETRY objects ucls = unique(classes) cls = if (length(ucls) > 1) # a mix: c("sfc_GEOMETRY", "sfc") else c(ucls, "sfc") ret = unlist(lapply(lst, unclass), recursive = FALSE) attributes(ret) = attributes(lst[[1]]) # crs class(ret) = cls attr(ret, "bbox") = compute_bbox(ret) # dispatch on class attr(ret, "n_empty") = sum(sapply(lst, attr, which = "n_empty")) if (inherits(ret, "sfc_GEOMETRY")) attr(ret, "classes") = vapply(ret, class, rep("", 3))[2L,] ret } #' @export print.sfc = function(x, ..., n = 5L, what = "Geometry set for", append = "") { sep = if (length(x) != 1) "s" else "" cls = substr(class(x)[1], 5, nchar(class(x)[1])) cat(paste0(what, " ", length(x), " feature", sep, " ", append)) if (! is.null(attr(x, "n_empty"))) { ne = attr(x, "n_empty") if (ne > 0) cat(paste0(" (with ", ne, ifelse(ne > 1, " geometries ", " geometry "), "empty)")) } if (!is.null(dim(x))) cat(paste0(" [dim: ", paste(dim(x), collapse = " x "), "]")) cat("\n") if (length(x) || !inherits(x, "sfc_GEOMETRY")) cat(paste0("Geometry type: ", cls, "\n")) if (length(x)) { u = sort(unique(sapply(x, function(x) class(x)[1]))) cat(paste0("Dimension: ", paste(u, collapse = ", "), "\n")) } cat( paste0("Bounding box: ")) bb = signif(attr(x, "bbox"), options("digits")$digits) cat(paste(paste(names(bb), bb[], sep = ": "), collapse = " ")) cat("\n") if( !is.null( attr(x, "z_range"))) { cat(paste0("z_range: ")) zb = signif(attr(x, "z_range"), options("digits")$digits) cat(paste(paste(names(zb), zb[], sep = ": "), collapse = " ")) cat("\n") } if( !is.null( attr(x, "m_range"))) { cat(paste0("m_range: ")) mb = signif(attr(x, "m_range"), options("digits")$digits) cat(paste(paste(names(mb), mb[], sep = ": "), collapse = " ")) cat("\n") } # attributes: epsg, proj4string, precision crs = st_crs(x) if (is.na(crs)) cat(paste0("CRS: NA\n")) else { p = crs_parameters(crs) if (p$Name == "unknown") { if (is.character(crs$input) && !is.na(crs$input) && crs$input != "unknown") p$Name = crs$input else p$Name = crs$proj4string } if (p$IsGeographic) cat(paste0("Geodetic CRS: ", p$Name, "\n")) else cat(paste0("Projected CRS: ", p$Name, "\n")) } if (attr(x, "precision") != 0.0) { cat( paste0("Precision: ")) if (attr(x, "precision") < 0.0) cat("float (single precision)\n") else cat(paste(attr(x, "precision"), "\n")) } # else cat("double (default; no precision model)\n") if (length(x) > n && n > 0) cat(paste0("First ", n, " geometries:\n")) for (i in seq_len(min(n, length(x)))) if (inherits(x[[i]], "sfg")) print(x[[i]], width = 50, crs = crs) else print(x[[i]], crs = crs) invisible(x) } #' Summarize simple feature column #' #' Summarize simple feature column #' @param object object of class \code{sfc} #' @param ... ignored #' @param maxsum maximum number of classes to summarize the simple feature column to #' @param maxp4s maximum number of characters to print from the PROJ string #' @method summary sfc #' @export summary.sfc = function(object, ..., maxsum = 7L, maxp4s = 10L) { u = factor(vapply(object, function(x) WKT_name(x, FALSE), "")) epsg = paste0("epsg:", st_crs(object)$epsg) levels(u) = c(levels(u), epsg) p4s = attr(object, "crs")$proj4string if (!is.na(p4s)) { if (nchar(p4s) > maxp4s) p4s = paste0(substr(p4s, 1L, maxp4s), "...") levels(u) = c(levels(u), p4s) } summary(u, maxsum = maxsum, ...) } #' @export as.data.frame.sfc = function(x, ...) { ret = data.frame(row.names = seq_along(x)) ret$geometry = x ret } #' @name st_geometry #' @export st_geometry.sfc = function(obj, ...) obj #' Return geometry type of an object #' #' Return geometry type of an object, as a factor #' @param x object of class \link{sf} or \link{sfc} #' @param by_geometry logical; if \code{TRUE}, return geometry type of each geometry, #' else return geometry type of the set #' @return a factor with the geometry type of each simple feature geometry #' in \code{x}, or that of the whole set #' @export st_geometry_type = function(x, by_geometry = TRUE) { x = st_geometry(x) f = if (by_geometry) vapply(x, function(y) class(y)[2], "") else substring(class(x)[1], 5) factor(f, levels = c("GEOMETRY", "POINT", "LINESTRING", "POLYGON", "MULTIPOINT", "MULTILINESTRING", "MULTIPOLYGON", "GEOMETRYCOLLECTION", "CIRCULARSTRING", "COMPOUNDCURVE", "CURVEPOLYGON", "MULTICURVE", "MULTISURFACE", "CURVE", "SURFACE", "POLYHEDRALSURFACE", "TIN", "TRIANGLE")) } #' Drop or add Z and/or M dimensions from feature geometries #' #' Drop Z and/or M dimensions from feature geometries, resetting classes appropriately #' @param x object of class \code{sfg}, \code{sfc} or \code{sf} #' @param ... ignored #' @param drop logical; drop, or (`FALSE`) add? #' @param what character which dimensions to drop or add #' @details Only combinations \code{drop=TRUE}, \code{what = "ZM"}, and \code{drop=FALSE}, \code{what="Z"} are supported so far. #' In the latter case, \code{x} should have \code{XY} geometry, and zero values are added for the \code{Z} dimension. #' @examples #' st_zm(st_linestring(matrix(1:32,8))) #' x = st_sfc(st_linestring(matrix(1:32,8)), st_linestring(matrix(1:8,2))) #' st_zm(x) #' a = st_sf(a = 1:2, geom=x) #' st_zm(a) #' @export st_zm <- function(x, ..., drop = TRUE, what = "ZM") UseMethod("st_zm") #' @export st_zm.sf <- function(x, ..., drop = TRUE, what = "ZM") { st_geometry(x) = st_zm(st_geometry(x), drop = drop, what = what) x } #' @export st_zm.sfc <- function(x, ..., drop = TRUE, what = "ZM") { st_sfc(lapply(x, st_zm, drop = drop, what = what), crs = st_crs(x)) } #' @export st_zm.sfg <- function(x, ..., drop = TRUE, what = "ZM") { if (drop && what == "ZM") { ret = if (is.list(x)) lapply(x, st_zm, drop = drop, what = what) else if (is.matrix(x)) x[, 1:2, drop = FALSE] else x[1:2] structure(ret, class = c("XY", class(x)[2:3])) } else if (!drop && what == "Z") { if (class(x)[1] != "XY") stop("adding Z only supported for XY geometries") ret = if (is.list(x)) lapply(x, st_zm, drop = drop, what = what) else if (is.matrix(x)) cbind(unclass(x), 0) else c(unclass(x), 0) structure(ret, class = c("XYZ", class(x)[2:3])) } else stop("this combination of `x', `drop' and `what' is not implemented") } #' @export st_zm.list <- function(x, ..., drop = TRUE, what = "ZM") lapply(x, st_zm, drop = drop, what = what) #' @export st_zm.matrix <- function(x, ..., drop = TRUE, what = "ZM") { if (drop && what == "ZM") { x[,1:2] } else if (!drop && what == "Z") { cbind(unclass(x), 0) } else stop("this combination of drop and what is not implemented") } #' Get precision #' #' @param x object of class \code{sfc} or \code{sf} #' @export st_precision <- function(x) { UseMethod("st_precision") } #' @export st_precision.sf <- function(x) { x <- st_geometry(x) st_precision(x) } #' @export st_precision.sfc <- function(x) { attr(x, "precision") } #' Set precision #' #' @rdname st_precision #' @param precision numeric, or object of class \code{units} with distance units (but see details); see \link{st_as_binary} for how to do this. #' @details If \code{precision} is a \code{units} object, the object on which we set precision must have a coordinate reference system with compatible distance units. #' #' Setting a \code{precision} has no direct effect on coordinates of geometries, but merely set an attribute tag to an \code{sfc} object. #' The effect takes place in \link{st_as_binary} or, more precise, in the C++ function \code{CPL_write_wkb}, where simple feature geometries are being serialized to well-known-binary (WKB). #' This happens always when routines are called in GEOS library (geometrical operations or predicates), for writing geometries using \link{st_write} or \link{write_sf}, \code{st_make_valid} in package \code{lwgeom}; also \link{aggregate} and \link{summarise} by default union geometries, which calls a GEOS library function. #' Routines in these libraries receive rounded coordinates, and possibly return results based on them. \link{st_as_binary} contains an example of a roundtrip of \code{sfc} geometries through WKB, in order to see the rounding happening to R data. #' #' The reason to support precision is that geometrical operations in GEOS or liblwgeom may work better at reduced precision. For writing data from R to external resources it is harder to think of a good reason to limiting precision. #' #' @seealso \link{st_as_binary} for an explanation of what setting precision does, and the examples therein. #' @examples #' x <- st_sfc(st_point(c(pi, pi))) #' st_precision(x) #' st_precision(x) <- 0.01 #' st_precision(x) #' @export st_set_precision <- function(x, precision) { UseMethod("st_set_precision") } #' @export st_set_precision.sfc <- function(x, precision) { if (length(precision) != 1) { stop("Precision applies to all dimensions and must be of length 1.", call. = FALSE) } if (inherits(precision, "units")) { u = st_crs(x)$ud_unit if (is.null(u)) stop("cannot use precision expressed as units when target object has no units (CRS) set") units(precision) = 1/u # convert precision = as.numeric(precision) } if (is.na(precision) || !is.numeric(precision)) { stop("Precision must be numeric", call. = FALSE) } structure(x, precision = precision) } #' @export st_set_precision.sf <- function(x, precision) { st_geometry(x) <- st_set_precision(st_geometry(x), precision) return(x) } #' @name st_precision #' @param value precision value #' @export "st_precision<-" <- function(x, value) { st_set_precision(x, value) } typed_empty = function(cls, ncol = 2, dim = "XY") { switch(cls[1], sfc_POINT = st_point(rep(NA_real_, ncol), dim = dim), sfc_MULTIPOINT = st_multipoint(matrix(numeric(0), ncol = ncol), dim = dim), sfc_LINESTRING = st_linestring(matrix(numeric(0), ncol = ncol), dim = dim), sfc_MULTILINESTRING = st_multilinestring(dim = dim), sfc_POLYGON = st_polygon(dim = dim), sfc_MULTIPOLYGON = st_multipolygon(dim = dim), st_geometrycollection(dims = dim)) } #' retrieve coordinates in matrix form #' #' retrieve coordinates in matrix form #' @param x object of class sf, sfc or sfg #' @param ... ignored #' @return matrix with coordinates (X, Y, possibly Z and/or M) in rows, possibly followed by integer indicators \code{L1},...,\code{L3} that point out to which structure the coordinate belongs; for \code{POINT} this is absent (each coordinate is a feature), for \code{LINESTRING} \code{L1} refers to the feature, for \code{MULTILINESTRING} \code{L1} refers to the part and \code{L2} to the simple feature, for \code{POLYGON} \code{L1} refers to the main ring or holes and \code{L2} to the simple feature, for \code{MULTIPOLYGON} \code{L1} refers to the main ring or holes, \code{L2} to the ring id in the \code{MULTIPOLYGON}, and \code{L3} to the simple feature. #' #' For \code{POLYGONS}, \code{L1} can be used to identify exterior rings and inner holes. #' The exterior ring is when \code{L1} is equal to 1. Interior rings are identified #' when \code{L1} is greater than 1. \code{L2} can be used to differentiate between the #' feature. Whereas for \code{MULTIPOLYGON}, \code{L3} refers to the \code{MULTIPOLYGON} #' feature and \code{L2} refers to the component \code{POLYGON}. #' #' @export st_coordinates = function(x, ...) UseMethod("st_coordinates") #' @export st_coordinates.sf = function(x, ...) st_coordinates(st_geometry(x)) #' @export st_coordinates.sfg = function(x, ...) st_coordinates(st_geometry(x)) #' @export st_coordinates.sfc = function(x, ...) { if (length(x) == 0) return(matrix(nrow = 0, ncol = 2)) ret = switch(class(x)[1], sfc_POINT = matrix(unlist(x, use.names = FALSE), nrow = length(x), byrow = TRUE, dimnames = NULL), sfc_MULTIPOINT = , sfc_LINESTRING = coord_2(x), sfc_MULTILINESTRING = , sfc_POLYGON = coord_3(x), sfc_MULTIPOLYGON = coord_4(x), stop(paste("not implemented for objects of class", class(x)[1])) ) Dims = class(x[[1]])[1] ncd = nchar(Dims) colnames(ret)[1:ncd] = vapply(seq_len(ncd), function(i) substr(Dims, i, i), "") ret } coord_2 = function(x) { # x is a list with matrices cbind(do.call(rbind, x), L1 = rep(seq_along(x), times = vapply(x, nrow, 0L))) } coord_3 = function(x) { # x is a list of lists with matrices x = lapply(x, coord_2) cbind(do.call(rbind, x), L2 = rep(seq_along(x), times = vapply(x, nrow, 0L))) } coord_4 = function(x) { # x is a list of lists of lists with matrices x = lapply(x, coord_3) cbind(do.call(rbind, x), L3 = rep(seq_along(x), times = vapply(x, nrow, 0L))) } #' @export rep.sfc = function(x, ...) { st_sfc(NextMethod(), crs = st_crs(x)) } check_ring_dir = function(x) { check_polygon = function(pol) { sa = sapply(pol, CPL_signed_area) revert = if (length(sa)) c(sa[1] < 0, sa[-1] > 0) else logical(0) pol[revert] = lapply(pol[revert], function(m) m[nrow(m):1,]) pol } cls = if (inherits(x, "sfg")) class(x)[2] else class(x)[1] ret = switch(cls, POLYGON = check_polygon(x), MULTIPOLYGON = , sfc_POLYGON = lapply(x, check_polygon), sfc_MULTIPOLYGON = lapply(x, function(y) structure(lapply(y, check_polygon), class = class(y))), stop(paste("check_ring_dir: not supported for class", class(x)[1])) ) attributes(ret) = attributes(x) ret } #' @name st_as_sfc #' @export st_as_sfc.list = function(x, ..., crs = NA_crs_) { if (length(x) == 0) return(st_sfc(crs = crs)) if (is.raw(x[[1]])) st_as_sfc.WKB(structure(x, class = "WKB"), ..., crs = crs) else if (inherits(x[[1]], "sfg")) st_sfc(x, crs = crs) else if (is.character(x[[1]])) { # hex wkb or wkt: ch12 = substr(x[[1]], 1, 2) if (ch12 == "0x" || ch12 == "00" || ch12 == "01") # hex wkb st_as_sfc.WKB(structure(x, class = "WKB"), ..., crs = crs) else st_as_sfc(unlist(x), ..., crs = crs) # wkt } else stop(paste("st_as_sfc.list: don't know what to do with list with elements of class", class(x[[1]]))) } #' @name st_as_sfc #' @export st_as_sfc.blob = function(x, ...) { st_as_sfc.list(x, ...) } #' @name st_as_sfc #' @export st_as_sfc.bbox = function(x, ...) { if (st_is_full(x)) st_as_sfc("POLYGON FULL", crs = st_crs(x)) else { box = st_polygon(list(matrix(x[c(1, 2, 3, 2, 3, 4, 1, 4, 1, 2)], ncol = 2, byrow = TRUE))) st_sfc(box, crs = st_crs(x), oriented = TRUE) } } POLYGON_FULL = matrix(c(0,-90,0,-90), 2, byrow = TRUE) #' predicate whether a geometry is equal to a POLYGON FULL #' #' predicate whether a geometry is equal to a POLYGON FULL #' @param x object of class `sfg`, `sfc` or `sf` #' @param ... ignored, except when it contains a `crs` argument to inform unspecified `is_longlat` #' @returns logical, indicating whether geometries are POLYGON FULL (a spherical #' polygon covering the entire sphere) #' @export st_is_full = function(x, ...) UseMethod("st_is_full") #' @export #' @name st_is_full #' @param is_longlat logical; output of \link{st_is_longlat} of the parent `sfc` object st_is_full.sfg = function(x, ..., is_longlat = NULL) { if (identical(is_longlat, FALSE)) # we know these are Cartesian coordinates: FALSE else sf_use_s2() && inherits(x, "POLYGON") && length(x) == 1 && nrow(x[[1]]) == 2 && identical(x[[1]], POLYGON_FULL) } #' @export #' @name st_is_full st_is_full.sfc = function(x, ...) { if (sf_use_s2() && inherits(x, c("sfc_POLYGON", "sfc_GEOMETRY"))) sfc_is_full(x) else rep_len(FALSE, length(x)) } #' @export #' @name st_is_full st_is_full.sf = function(x, ...) { st_is_full(st_geometry(x), ...) } #' @export #' @name st_is_full st_is_full.bbox = function(x, ...) { isTRUE(sf_use_s2() && st_is_longlat(x) && all(x == c(-180,-90,180,90))) } #' @export unique.sfc = function(x, ...) { st_sfc(unique(unclass(x),...), crs = st_crs(x), precision = st_precision(x)) } #' @export xtfrm.sfc = function(x) { d = st_dimension(x, FALSE) ne = !st_is_empty(x) v = vector("double", length(x)) if (0 %in% d) v[d == 0] = 0 # or # of pts in MULTIPOINT? if (1 %in% d) { l = st_length(x[d == 1]) if (max(l) > 1) l = l / max(l) v[d == 1] = l } if (2 %in% d) { a = st_area(x[d == 2]) if (max(a) > 1) a = a / max(a) v[d == 2] = a } xtfrm(ne + d * 2.1 + v) } ================================================ FILE: R/sfg.R ================================================ # dim: what does the third dimension, if present, refer to? (XYZ or XYM) getClassDim = function(x, d, dim = "XYZ", type) { type = toupper(type) if (d == 2) c("XY", type, "sfg") else if (d == 3) { stopifnot(dim %in% c("XYZ", "XYM")) c(dim, type, "sfg") } else if (d == 4) c("XYZM", type, "sfg") else stop(paste(d, "is an illegal number of columns for a", type)) } valid_numeric_matrix = function(x) { stopifnot(is.numeric(x), is.matrix(x), !anyNA(x)) } Mtrx = function(x, dim = "XYZ", type) { valid_numeric_matrix(x) structure(x, class = getClassDim(x, ncol(x), dim, type)) } # creates object of class c(dim, type, "sfg") from list x, possibly checking rings are closed MtrxSet = function(x, dim = "XYZ", type, needClosed = FALSE) { stopifnot(is.list(x)) if (length(x) > 0) { # list() lapply(x, valid_numeric_matrix) nc = unique(vapply(x, ncol, 0L)) if (length(nc) != 1) stop("matrices have unequal numbers of columns") NotClosed = function(y) any(y[1, ] != y[nrow(y), ]) if (needClosed && any(vapply(x, NotClosed, TRUE))) stop("polygons not (all) closed") structure(x, class = getClassDim(x, nc, dim, type)) } else structure(x, class = getClassDim(x, nchar(dim), dim, type)) } # creates object of class c(dim, type, "sfg") from list x, d, possibly checking rings are closed MtrxSetSet = function(x, dim = "XYZ", type, needClosed = FALSE) { stopifnot(is.list(x), vapply(x, is.list, TRUE)) if (length(x)) { nc = unique(unlist(lapply(x, function(y) vapply(y, ncol, 0L)))) if (length(nc) != 1) stop("matrices have unequal numbers of columns") lapply(x, function(y) lapply(y, valid_numeric_matrix)) NotClosed = function(y) any(y[1, ] != y[nrow(y), ]) if (needClosed && any(unlist(lapply(x, function(y) vapply(y, NotClosed, TRUE))))) stop("polygons not (all) closed") structure(x, class = getClassDim(x, nc, dim, type)) } else structure(x, class = getClassDim(x, nchar(dim), dim, type)) } #return "XY", "XYZ", "XYM", or "XYZM" Dimension = function(x) { stopifnot(inherits(x, "sfg")) class(x)[1] } ## internal function to get a list of sfg POINT for st_as_sf(, coords = ...) ## src/sfg.cpp ## https://github.com/r-spatial/sf/issues/700 points_rcpp <- function(pts, gdim = "XY", ...) { stopifnot(gdim %in% c("XY", "XYZ", "XYZM", "XYM")) if (dim(pts)[2L] == 2L && nchar(gdim) > 2L) gdim = "XY" stopifnot(dim(pts)[2] == nchar(gdim)) points_cpp(pts, gdim) } #' Create simple feature from a numeric vector, matrix or list #' #' Create simple feature from a numeric vector, matrix or list #' @param x for \code{st_point}, numeric vector (or one-row-matrix) of length 2, 3 or 4; for \code{st_linestring} and \code{st_multipoint}, numeric matrix with points in rows; for \code{st_polygon} and \code{st_multilinestring}, list with numeric matrices with points in rows; for \code{st_multipolygon}, list of lists with numeric matrices; for \code{st_geometrycollection} list with (non-geometrycollection) simple feature geometry (sfg) objects; see examples below #' @param dim character, indicating dimensions: "XY", "XYZ", "XYM", or "XYZM"; only really needed for three-dimensional points (which can be either XYZ or XYM) or empty geometries; see details #' @name st #' @details "XYZ" refers to coordinates where the third dimension represents altitude, "XYM" refers to three-dimensional coordinates where the third dimension refers to something else ("M" for measure); checking of the sanity of \code{x} may be only partial. #' @return object of the same nature as \code{x}, but with appropriate class attribute set #' @examples #' (p1 = st_point(c(1,2))) #' class(p1) #' st_bbox(p1) #' (p2 = st_point(c(1,2,3))) #' class(p2) #' (p3 = st_point(c(1,2,3), "XYM")) #' pts = matrix(1:10, , 2) #' (mp1 = st_multipoint(pts)) #' pts = matrix(1:15, , 3) #' (mp2 = st_multipoint(pts)) #' (mp3 = st_multipoint(pts, "XYM")) #' pts = matrix(1:20, , 4) #' (mp4 = st_multipoint(pts)) #' pts = matrix(1:10, , 2) #' (ls1 = st_linestring(pts)) #' pts = matrix(1:15, , 3) #' (ls2 = st_linestring(pts)) #' (ls3 = st_linestring(pts, "XYM")) #' pts = matrix(1:20, , 4) #' (ls4 = st_linestring(pts)) #' outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) #' hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) #' hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) #' pts = list(outer, hole1, hole2) #' (ml1 = st_multilinestring(pts)) #' pts3 = lapply(pts, function(x) cbind(x, 0)) #' (ml2 = st_multilinestring(pts3)) #' (ml3 = st_multilinestring(pts3, "XYM")) #' pts4 = lapply(pts3, function(x) cbind(x, 0)) #' (ml4 = st_multilinestring(pts4)) #' outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) #' hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) #' hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) #' pts = list(outer, hole1, hole2) #' (pl1 = st_polygon(pts)) #' pts3 = lapply(pts, function(x) cbind(x, 0)) #' (pl2 = st_polygon(pts3)) #' (pl3 = st_polygon(pts3, "XYM")) #' pts4 = lapply(pts3, function(x) cbind(x, 0)) #' (pl4 = st_polygon(pts4)) #' pol1 = list(outer, hole1, hole2) #' pol2 = list(outer + 12, hole1 + 12) #' pol3 = list(outer + 24) #' mp = list(pol1,pol2,pol3) #' (mp1 = st_multipolygon(mp)) #' pts3 = lapply(mp, function(x) lapply(x, function(y) cbind(y, 0))) #' (mp2 = st_multipolygon(pts3)) #' (mp3 = st_multipolygon(pts3, "XYM")) #' pts4 = lapply(mp2, function(x) lapply(x, function(y) cbind(y, 0))) #' (mp4 = st_multipolygon(pts4)) #' (gc = st_geometrycollection(list(p1, ls1, pl1, mp1))) #' st_geometrycollection() # empty geometry #' @export st_point = function(x = c(NA_real_, NA_real_), dim = "XYZ") { stopifnot(is.numeric(x) && length(x) >= 2) if (is.matrix(x)) stopifnot(nrow(x) == 1) # because we want to be able to call rbind on points if (any(is.na(x))) x = rep(NA_real_, length(x)) structure(x, class = getClassDim(x, length(x), dim, "POINT")) } #' @name st #' @export st_multipoint = function(x = matrix(numeric(0), 0, 2), dim = "XYZ") Mtrx(x, dim, type = "MULTIPOINT") #' @name st #' @export st_linestring = function(x = matrix(numeric(0), 0, 2), dim = "XYZ") Mtrx(x, dim, type = "LINESTRING") #' @name st #' @export st_polygon = function(x = list(), dim = if(length(x)) "XYZ" else "XY") { MtrxSet(x, dim, type = "POLYGON", needClosed = TRUE) } #' @name st #' @export st_multilinestring = function(x = list(), dim = if (length(x)) "XYZ" else "XY") MtrxSet(x, dim, type = "MULTILINESTRING", needClosed = FALSE) #' @name st #' @export st_multipolygon = function(x = list(), dim = if (length(x)) "XYZ" else "XY") MtrxSetSet(x, dim, type = "MULTIPOLYGON", needClosed = TRUE) #' @name st #' @param dims character; specify dimensionality in case of an empty (NULL) geometrycollection, in which case \code{x} is the empty \code{list()}. #' @export st_geometrycollection = function(x = list(), dims = "XY") { cls = vapply(x, class, rep("", 3)) if (length(cls)) { if (!is.matrix(cls) || !is.character(cls) || nrow(cls) != 3) stop("st_geometrycollection parameter x error: list elements should be simple features") stopifnot(all(cls[3,] == "sfg")) stopifnot(all(cls[2,] != "GEOMETRYCOLLECTION")) # can't recurse! # check all dimensions are equal: dims = unique(cls[1,]) if (length(dims) > 1) stop(paste("multiple dimensions found:", paste(dims, collapse = ", "))) } structure(x, class = c(dims, "GEOMETRYCOLLECTION", "sfg")) # TODO: no Z/M/ZM modifier here?? } POINT2MULTIPOINT = function(x, dim = "XYZ") { if (length(x) == 3) # disambiguate Z/M: dim = class(x)[1] st_multipoint(matrix(unclass(x), 1), dim = dim) } LINESTRING2MULTILINESTRING = function(x, dim = "XYZ") { if (ncol(x) == 3) # disambiguate Z/M: dim = class(x)[1] st_multilinestring(list(unclass(x)), dim = dim) } POLYGON2MULTIPOLYGON = function(x, dim = "XYZ") { if (st_is_empty(x)) { return(st_multipolygon(dim = class(x)[1])) } if (ncol(x[[1]]) == 3) # disambiguate Z/M: dim = class(x)[1] st_multipolygon(list(unclass(x)), dim = dim) } #' @name st #' @param width integer; number of characters to be printed (max 30; 0 means print everything) #' @export print.sfg = function(x, ..., width = 0) { # avoids having to write print methods for 68 classes: f = format(x, ..., width = width) message(f) invisible(x) } #' @name st #' @param n integer; number of elements to be selected #' @export head.sfg = function(x, n = 10L, ...) { structure(head(unclass(x), n = n, ...), class = class(x)) } # get_start = function(x, n = 30) { if (is.list(x)) # recurse into first element: structure(lapply(x, get_start, n = n), class = class(x)) else # matrix: head(x, round(n/3)) } #' @name st #' @export format.sfg = function(x, ..., width = 30) { if (is.null(width)) width = 30 if (object.size(x) > 1000 && width > 0) x = get_start(x, n = width) pr = st_as_text(x, ...) if (width > 0 && nchar(pr) > width) paste0(substr(pr, 1, width - 3), "...") else pr } #' @export #' @name st #' @param ... objects to be pasted together into a single simple feature #' @param recursive logical; ignored #' @param flatten logical; if `TRUE`, try to simplify results; if `FALSE`, return geometrycollection containing all objects #' @examples #' c(st_point(1:2), st_point(5:6)) #' c(st_point(1:2), st_multipoint(matrix(5:8,2))) #' c(st_multipoint(matrix(1:4,2)), st_multipoint(matrix(5:8,2))) #' c(st_linestring(matrix(1:6,3)), st_linestring(matrix(11:16,3))) #' c(st_multilinestring(list(matrix(1:6,3))), st_multilinestring(list(matrix(11:16,3)))) #' pl = list(rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0))) #' c(st_polygon(pl), st_polygon(pl)) #' c(st_polygon(pl), st_multipolygon(list(pl))) #' c(st_linestring(matrix(1:6,3)), st_point(1:2)) #' c(st_geometrycollection(list(st_point(1:2), st_linestring(matrix(1:6,3)))), #' st_geometrycollection(list(st_multilinestring(list(matrix(11:16,3)))))) #' c(st_geometrycollection(list(st_point(1:2), st_linestring(matrix(1:6,3)))), #' st_multilinestring(list(matrix(11:16,3))), st_point(5:6), #' st_geometrycollection(list(st_point(10:11)))) #' @details When \code{flatten=TRUE}, this method may merge points into a multipoint structure, and may not preserve order, and hence cannot be reverted. When given fish, it returns fish soup. c.sfg = function(..., recursive = FALSE, flatten = TRUE) { stopifnot(! recursive) Paste0 = function(lst) lapply(lst, unclass) Paste1 = function(lst) do.call(c, lapply(lst, unclass)) lst = list(...) if (flatten) { cls = vapply(lst, function(x) class(x)[2], "") ucls = unique(cls) if (length(ucls) == 1) { switch(ucls, POINT = st_multipoint(na.omit(do.call(rbind, lst))), # CURVE = st_multicurve(Paste0(lst)) # CIRCULARSTRING = st_geometrycollection(lst), # FIXME?? LINESTRING = st_multilinestring(Paste0(lst)), # SURFACE = st_multisurface(Paste0(lst)), POLYGON = st_multipolygon(Paste0(lst)), # TRIANGLE = st_geometrycollection(lst), MULTIPOINT = st_multipoint(do.call(rbind, lst)), MULTILINESTRING = st_multilinestring(Paste1(lst)), # MULTICURVE = st_multicurve(Paste1(lst)), MULTIPOLYGON = st_multipolygon(Paste1(lst)), # MULTISURFACE = st_multisurface(Paste1(lst)), # POLYHEDRALSURFACE = st_polyhedralsurface(Paste1(lst)), # TIN = st_tin(Paste1(lst)), GEOMETRYCOLLECTION = st_geometrycollection(Paste1(lst)), stop(paste("type", cls, "not supported")) ) } else if (all(ucls %in% c("POINT", "MULTIPOINT"))) st_multipoint(do.call(rbind, lst)) else if (all(cls %in% c("LINESTRING", "MULTILINESTRING"))) { ls = which(cls == "LINESTRING") mls = st_multilinestring(lst[ls]) st_multilinestring(c(unlist(lst[-ls], FALSE), unclass(mls))) } else if (all(cls %in% c("POLYGON", "MULTIPOLYGON"))) { po = which(cls == "POLYGON") mpo = st_multipolygon(lst[po]) st_multipolygon(c(unlist(lst[-po], FALSE), unclass(mpo))) } else { # unfold GC objects first, then gc = (cls == "GEOMETRYCOLLECTION") ret = lst[!gc] if (any(gc)) { # append the _contents_ of GC's to the non-GC elements: wgc = which(gc) for (i in seq_len(length(wgc))) ret = append(ret, lst[[wgc[i]]]) } st_geometrycollection(ret) } } else # !flatten: st_geometrycollection(lst) # breaks if one of them is a GC } #' @name st #' @method as.matrix sfg #' @export #' @return as.matrix returns the set of points that form a geometry as a single matrix, where each point is a row; use \code{unlist(x, recursive = FALSE)} to get sets of matrices. as.matrix.sfg = function(x, ...) { switch(class(x)[2], POINT = matrix(x, 1), MULTIPOINT = as.matrix(unclass(x)), LINESTRING = as.matrix(unclass(x)), POLYGON = do.call(rbind, x), MULTILINESTRING = do.call(rbind, x), MULTIPOLYGON = do.call(rbind, lapply(x, function(y) do.call(rbind, y))), GEOMETRYCOLLECTION = do.call(rbind, lapply(x, as.matrix)), NextMethod() ) } ================================================ FILE: R/sgbp.R ================================================ sgbp = function(x, predicate, region.id, ncol, sparse = TRUE, remove_self = FALSE, retain_unique = FALSE) { if (remove_self || retain_unique) { if (length(x) != ncol) stop("remove_self or retain_unique only work for square sparse matrices") x = if (retain_unique) # (includes doing remove_self) mapply(function(x, y) { x[x > y] }, x, seq_along(x), SIMPLIFY = FALSE) else # remove_self mapply(setdiff, x, seq_along(x), SIMPLIFY = FALSE) } ret = structure(x, predicate = predicate, region.id = region.id, remove_self = remove_self, retain_unique = retain_unique, ncol = ncol, class = c("sgbp", "list")) if (! sparse) as.matrix(ret) else ret } #' Methods for dealing with sparse geometry binary predicate lists #' #' Methods for dealing with sparse geometry binary predicate lists #' @name sgbp #' @export #' @param x object of class \code{sgbp} #' @param ... ignored #' @param n integer; maximum number of items to print #' @param max_nb integer; maximum number of neighbours to print for each item #' @details \code{sgbp} are sparse matrices, stored as a list with integer vectors holding the ordered \code{TRUE} indices of each row. This means that for a dense, \eqn{m \times n}{m x n} matrix \code{Q} and a list \code{L}, if \code{Q[i,j]} is \code{TRUE} then \eqn{j} is an element of \code{L[[i]]}. Reversed: when \eqn{k} is the value of \code{L[[i]][j]}, then \code{Q[i,k]} is \code{TRUE}. print.sgbp = function(x, ..., n = 10, max_nb = 10) { n = min(length(x), n) hd = paste0("Sparse geometry binary predicate list of length ", length(x), ", ", "where the predicate was `", attr(x, "predicate"), "'") if (isTRUE(attr(x, "retain_unique"))) hd = paste0(hd, ", with retain_unique = TRUE") else if (isTRUE(attr(x, "remove_self"))) hd = paste0(hd, ", with remove_self = TRUE") cat(strwrap(hd), sep = "\n") if (n < length(x)) cat("first ", n, " elements:\n", sep = "") nbh = function(i, m) { X = x[[i]] end = if (length(X) > m) ", ..." else "" cat(" ", i, ": ", sep = "") if (length(X)) cat(paste(head(X, m), collapse = ", "), end, "\n", sep = "") else cat("(empty)\n") } lapply(1:n, nbh, m = max_nb) invisible(x) } #' @name sgbp #' @export t.sgbp = function(x) { m = attr(x, "ncol") structure(sgbp(CPL_transpose_sparse_incidence(x, m), predicate = attr(x, "predicate"), region.id = as.character(1:m), ncol = length(x)), dim = NULL) } #' @name sgbp #' @export as.matrix.sgbp = function(x, ...) { nc = attr(x, "ncol") get_vec = function(x, n) { v = rep(FALSE, n); v[x] = TRUE; v } do.call(rbind, lapply(x, get_vec, n = nc)) } #' @name sgbp #' @export dim.sgbp = function(x) { c(length(x), attr(x, "ncol")) } #' @name sgbp #' @param e1 object of class `sgbp` #' @param e2 object of class `sgbp` #' @export #' @details `==` compares only the dimension and index values, not the attributes of two `sgbp` object; use `identical` to check for equality of everything. Ops.sgbp = function(e1, e2) { switch(.Generic, "!" = { nc = 1:attr(e1, "ncol") sgbp(lapply(e1, function(x) setdiff(nc, x)), predicate = paste0("!", attr(e1, "predicate")), region.id = attr(e1, "region.id"), ncol = attr(e1, "ncol")) }, "==" = (length(e1) == length(e2)) && all(mapply(function(x,y) identical(x, y), e1, e2)), "!=" = return(!(e1 == e2)), stop("only operators !, == and != are supported for sgbp objects") ) } #' @name sgbp #' @export as.data.frame.sgbp = function(x, ...) { data.frame(row.id = rep(seq_along(x), lengths(x)), col.id = unlist(x)) } setOldClass("sgbp") setAs("sgbp", "sparseMatrix", function(from) { if (! requireNamespace("Matrix", quietly = TRUE)) stop("package Matrix required, please install it first") idx = as.data.frame(from) Matrix::sparseMatrix(i = idx$row.id, j = idx$col.id, x = 1) }) ================================================ FILE: R/shift_longitude.R ================================================ #' Shift or re-center geographical coordinates for a Pacific view #' #' @description #' All longitudes < 0 are added to 360, to avoid for instance parts of Alaska #' being represented on the far left and right of a plot because they have #' values straddling 180 degrees. In general, using a projected #' coordinate reference system is to be preferred, but this method permits a #' geographical coordinate reference system to be used. This is the sf #' equivalent of [recenter][sp::recenter] in the sp package and #' `ST_ShiftLongitude` in PostGIS. #' #' @param x object of class `sf` or `sfc` #' @param ... ignored #' #' @export st_shift_longitude = function(x) { ll = st_is_longlat(x) if (!isTRUE(ll)) stop("'st_shift_longitude' requires non-projected geographic coordinates", call. = FALSE) UseMethod("st_shift_longitude") } #' @name st_shift_longitude #' @export #' @examples #' ## sfc #' pt1 = st_point(c(-170, 50)) #' pt2 = st_point(c(170, 50)) #' (sfc = st_sfc(pt1, pt2)) #' sfc = st_set_crs(sfc, 4326) #' st_shift_longitude(sfc) #' st_shift_longitude.sfc = function(x, ...) { xcrs = st_crs(x) g = (x + c(360, 90)) %% c(360) - c(0, 90) st_set_crs(g, xcrs) } #' @name st_shift_longitude #' @export #' @examples #' ## sf #' d = st_as_sf(data.frame(id = 1:2, geometry = sfc)) #' st_shift_longitude(d) st_shift_longitude.sf = function(x, ...) { st_geometry(x) = st_shift_longitude(st_geometry(x)) x } ================================================ FILE: R/sp.R ================================================ ## Method coordinates ## @name coordinates ## @exportMethod coordinates #if (!isGeneric("coordinates")) # setGeneric("coordinates", function(obj, ...) # standardGeneric("coordinates")) # #setMethod("coordinates", "sfc_POINT", # function(obj, ...) # do.call(rbind, obj) #) # #setMethod("coordinates", "sfc", # function(obj, ...) # stop("coordinates for this object type not implemented") #) # #setMethod("coordinates", "sf", # function(obj, ...) # coordinates(st_geometry(obj), ...) #) #' @rdname st_as_sf #' @examples #' if (require(sp, quietly = TRUE)) { #' x = rbind(c(-1,-1), c(1,-1), c(1,1), c(-1,1), c(-1,-1)) #' x1 = 0.1 * x + 0.1 #' x2 = 0.1 * x + 0.4 #' x3 = 0.1 * x + 0.7 #' y = x + 3 #' y1 = x1 + 3 #' y3 = x3 + 3 #' m = matrix(c(3, 0), 5, 2, byrow = TRUE) #' z = x + m #' z1 = x1 + m #' z2 = x2 + m #' z3 = x3 + m #' p1 = Polygons(list( Polygon(x[5:1,]), Polygon(x2), Polygon(x3), #' Polygon(y[5:1,]), Polygon(y1), Polygon(x1), Polygon(y3)), "ID1") #' p2 = Polygons(list( Polygon(z[5:1,]), Polygon(z2), Polygon(z3), Polygon(z1)), #' "ID2") #' r = SpatialPolygons(list(p1,p2)) #' a = suppressWarnings(st_as_sf(r)) #' summary(a) #' demo(meuse, ask = FALSE, echo = FALSE) #' summary(st_as_sf(meuse)) #' summary(st_as_sf(meuse.grid)) #' summary(st_as_sf(meuse.area)) #' summary(st_as_sf(meuse.riv)) #' summary(st_as_sf(as(meuse.riv, "SpatialLines"))) #' pol.grd = as(meuse.grid, "SpatialPolygonsDataFrame") #' # summary(st_as_sf(pol.grd)) #' # summary(st_as_sf(as(pol.grd, "SpatialLinesDataFrame"))) #' } #' @export st_as_sf.Spatial = function(x, ...) { if ("data" %in% slotNames(x)) { if (!isTRUE(all.equal(row.names(x@data), row.names(x)))) row.names(x@data) <- row.names(x) df = x@data } else { df = data.frame(row.names = row.names(x)) # empty } if ("geometry" %in% names(df)) warning("column \"geometry\" will be overwritten by geometry column") if (! requireNamespace("sp", quietly = TRUE)) stop("package sp required, please install it first") if (sp::gridded(x) && sp::fullgrid(x)) sp::fullgrid(x) = FALSE df$geometry = st_as_sfc(sp::geometry(x), ...) st_as_sf(df) } #' Convert foreign geometry object to an sfc object #' #' Convert foreign geometry object to an sfc object #' @param x object to convert #' @param ... further arguments #' @param precision precision value; see \link{st_as_binary} #' @param forceMulti logical; if \code{TRUE}, force coercion into \code{MULTIPOLYGON} or \code{MULTILINE} objects, else autodetect #' @export st_as_sfc = function(x, ...) UseMethod("st_as_sfc") handle_bbox = function(sfc, sp) { bb = structure(bb_wrap(as.vector(sp::bbox(sp)[1:2,])), class = "bbox") structure(sfc, "bbox" = bb) } #' @rdname st_as_sfc #' @export st_as_sfc.SpatialPoints = function(x, ..., precision = 0.0) { cc = x@coords dimnames(cc) = NULL lst = lapply(seq_len(nrow(cc)), function(x) st_point(cc[x,])) handle_bbox(do.call(st_sfc, append(lst, list(crs = st_crs(x@proj4string), precision = precision))), x) } #' @rdname st_as_sfc #' @export st_as_sfc.SpatialPixels = function(x, ..., precision = 0.0) { handle_bbox(st_as_sfc(as(x, "SpatialPoints"), precision = precision), x) } #' @rdname st_as_sfc #' @export st_as_sfc.SpatialMultiPoints = function(x, ..., precision = 0.0) { lst = lapply(x@coords, st_multipoint) handle_bbox(do.call(st_sfc, append(lst, list(crs = st_crs(x@proj4string), precision = precision))), x) } #' @rdname st_as_sfc #' @export st_as_sfc.SpatialLines = function(x, ..., precision = 0.0, forceMulti = FALSE) { lst = if (forceMulti || any(sapply(x@lines, function(x) length(x@Lines)) != 1)) lapply(x@lines, function(y) { crd_list <- lapply(y@Lines, function(z) z@coords) crd_list1 <- lapply(crd_list, function(z) { if (nrow(z) < 2L) res <- z[0,] else res <- z res }) st_multilinestring(crd_list1) }) else lapply(x@lines, function(y) { crds = y@Lines[[1]]@coords if (nrow(crds) < 2L) res = st_linestring() else res = st_linestring(crds) res }) handle_bbox(do.call(st_sfc, append(lst, list(crs = st_crs(x@proj4string), precision = precision))), x) } #' @rdname st_as_sfc #' @export st_as_sfc.SpatialPolygons = function(x, ..., precision = 0.0, forceMulti = FALSE) { lst = if (forceMulti || any(sapply(x@polygons, function(x) moreThanOneOuterRing(x@Polygons)))) { if (is.null(comment(x)) || comment(x) == "FALSE") { # if (!requireNamespace("rgeos", quietly = TRUE)) # stop("package rgeos required for finding out which hole belongs to which exterior ring") # x = rgeos::createSPComment(x) # https://github.com/r-spatial/sf/pull/1869/files/7f1921c9acc1000b92a81b3a0aa7126330d4ef12..cfa303c8fcdd0b9a7ea33eae402c1135bb8e50ba : # warning("no comment found showing which hole belongs to which exterior ring") # (warning causes revdep problem in pkg amt) process_pl_comment <- function(pl) { ID <- slot(pl, "ID") crds <- lapply(slot(pl, "Polygons"), function(xx) slot(xx, "coords")) holes <- sapply(slot(pl, "Polygons"), slot, "hole") raw0 <- st_sfc(lapply(crds, function(x) st_polygon(list(x)))) if (!any(holes)) { val <- st_union(st_make_valid(raw0)) } else { wkts <- vector("list", sum(!holes)) for (i in seq_along(wkts)) { wkts[[i]] <- st_as_text(raw0[!holes][i]) } cp0 <- st_contains(raw0[!holes], raw0[holes]) areas <- sapply(slot(pl, "Polygons"), slot, "area") hole_assigned <- rep(FALSE, sum(holes)) names(cp0) <- seq_along(cp0) cp1 <- cp0[order(areas[!holes])] for (i in seq_along(cp1)) { cp1i <- cp1[[i]] tgt <- as.integer(names(cp1[i])) if (length(cp1i) > 0L) { for (j in cp1i) { wkts[[tgt]] <- paste(sub("))", "),", wkts[[tgt]]), sub("POLYGON \\(", "", st_as_text(raw0[holes][j]))) hole_assigned[j] <- TRUE } } for (ii in i:length(cp1)) { for (j in cp1i) { cp1[[ii]] <- setdiff(cp1[[ii]], j) } } } if (any(!hole_assigned)) warning("orphaned hole, cannot find containing polygon") raw0 <- st_as_sfc(wkts) raw1 <- st_make_valid(raw0) if (any(st_is(raw1, "GEOMETRYCOLLECTION"))) raw1 <- st_collection_extract(raw1, "POLYGON") val <- st_union(raw1) } if (inherits(val, "sfc_GEOMETRYCOLLECTION")) val = st_collection_extract(val, "POLYGON") res <- slot(as(val, "Spatial"), "polygons")[[1]] slot(res, "ID") <- ID res } # process_pl_comment <- function(pl) { # ID <- slot(pl, "ID") # crds <- lapply(slot(pl, "Polygons"), function(xx) slot(xx, "coords")) # raw <- st_sfc(st_polygon(crds)) # val <- st_make_valid(raw) # if (inherits(val, "sfc_GEOMETRYCOLLECTION")) # val = st_collection_extract(val, "POLYGON") # res <- slot(as(val, "Spatial"), "polygons")[[1]] # slot(res, "ID") <- ID # res # } slot(x, "polygons") <- lapply(slot(x, "polygons"), process_pl_comment) comment(x) <- "TRUE" } lapply(x@polygons, function(y) st_multipolygon(Polygons2MULTIPOLYGON(y@Polygons, comment(y)))) } else lapply(x@polygons, function(y) st_polygon(Polygons2POLYGON(y@Polygons))) handle_bbox(do.call(st_sfc, append(lst, list(crs = st_crs(x@proj4string), precision = precision))), x) } moreThanOneOuterRing = function(PolygonsLst) { holes = sapply(PolygonsLst, function(x) x@hole) length(holes) - length(which(holes)) > 1 } Polygons2MULTIPOLYGON = function(PolygonsLst, cmt) { idx = scan(text = cmt, quiet = TRUE) # idx tells which outer rings (0) enclose which holes (idx == which(idx == 0)) outer_rings = which(idx == 0) # loop over outer_rings: lapply(outer_rings, function(x) Polygons2POLYGON(PolygonsLst[c(x, which(idx == x))])) } Polygons2POLYGON = function(PolygonsLst) { # here we have one outer ring, followed by (0+) holes inside this ring lapply(PolygonsLst, function(x) x@coords) } #' @name as #' @rdname coerce-methods #' @aliases Spatial sf-method setAs("Spatial", "sf", function(from) st_as_sf(from)) #' @name as #' @rdname coerce-methods #' @aliases coerce Spatial sfc-method setAs("Spatial", "sfc", function(from) st_as_sfc(from)) #' @name as #' @rdname coerce-methods #' @aliases coerce Spatial-method setAs("sf", "Spatial", function(from) { if (!requireNamespace("sp", quietly = TRUE)) stop("package sp required, please install it first") geom = st_geometry(from) from[[attr(from, "sf_column")]] = NULL # remove sf column list sp::addAttrToGeom(as_Spatial(geom, IDs = row.names(from)), data.frame(from), match.ID = FALSE) }) #' @name as #' @rdname coerce-methods #' @aliases coerce Spatial-method setAs("sfc", "Spatial", function(from) as_Spatial(from)) # create empy class setOldClass("XY") setAs("XY", "Spatial", function(from) as(st_sfc(from), "Spatial")) #' Methods to coerce simple features to `Spatial*` and `Spatial*DataFrame` objects #' #' [as_Spatial()] allows to convert `sf` and `sfc` to `Spatial*DataFrame` and #' `Spatial*` for `sp` compatibility. You can also use `as(x, "Spatial")` To transform #' `sp` objects to `sf` and `sfc` with `as(x, "sf")`. #' @rdname coerce-methods #' @name as_Spatial #' @param from object of class `sf`, `sfc_POINT`, `sfc_MULTIPOINT`, `sfc_LINESTRING`, #' `sfc_MULTILINESTRING`, `sfc_POLYGON`, or `sfc_MULTIPOLYGON`. #' @param cast logical; if `TRUE`, [st_cast()] `from` before converting, so that e.g. #' `GEOMETRY` objects with a mix of `POLYGON` and `MULTIPOLYGON` are cast to `MULTIPOLYGON`. #' @param IDs character vector with IDs for the `Spatial*` geometries #' @details Package \code{sp} supports three dimensions for `POINT` and `MULTIPOINT` (`SpatialPoint*`). #' Other geometries must be two-dimensional (`XY`). Dimensions can be dropped using #' [st_zm()] with `what = "M"` or `what = "ZM"`. #' #' For converting simple features (i.e., \code{sf} objects) to their \code{Spatial} counterpart, use \code{as(obj, "Spatial")} #' @return geometry-only object deriving from `Spatial`, of the appropriate class #' @export #' @examples #' nc <- st_read(system.file("shape/nc.shp", package="sf")) #' if (require(sp, quietly = TRUE)) { #' # convert to SpatialPolygonsDataFrame #' spdf <- as_Spatial(nc) #' # identical to #' spdf <- as(nc, "Spatial") #' # convert to SpatialPolygons #' as(st_geometry(nc), "Spatial") #' # back to sf #' as(spdf, "sf") #' } as_Spatial = function(from, cast = TRUE, IDs = paste0("ID", seq_along(from))) { if (inherits(from, "sf")) { geom = st_geometry(from) from[[attr(from, "sf_column")]] = NULL # remove sf column list if (ncol(from)) sp::addAttrToGeom(as_Spatial(geom, cast = cast, IDs = row.names(from)), data.frame(from), match.ID = FALSE) else { if (missing(IDs)) IDs = paste0("ID", seq_along(geom)) as_Spatial(geom, cast, IDs) } } else { .as_Spatial(from, cast, IDs) } } .as_Spatial = function(from, cast = TRUE, IDs = paste0("ID", seq_along(from))) { if (cast) from = st_cast(from) zm = class(from[[1]])[1] if (zm %in% c("XYM", "XYZM")) stop("geometries containing M not supported by sp\n", 'use `st_zm(..., what = "M")`') if (any(st_is_empty(from))) stop("empty geometries are not supported by sp classes: conversion failed") StopZ = function(zm) { if (zm == "XYZ") stop("sp supports Z dimension only for POINT and MULTIPOINT.\n", 'use `st_zm(...)` to coerce to XY dimensions') } switch(class(from)[1], "sfc_POINT" = sfc2SpatialPoints(from), # "sfc_POINT" = sfc2SpatialPoints(from, IDs), "sfc_MULTIPOINT" = sfc2SpatialMultiPoints(from), "sfc_LINESTRING" = , "sfc_MULTILINESTRING" = { StopZ(zm); sfc2SpatialLines(from, IDs) }, "sfc_POLYGON" = , "sfc_MULTIPOLYGON" = { StopZ(zm); sfc2SpatialPolygons(from, IDs) }, stop(paste("conversion from feature type", class(from)[1], "to sp is not supported")) ) } sfc2SpatialPoints = function(from, IDs) { if (!requireNamespace("sp", quietly = TRUE)) stop("package sp required, please install it first") sp::SpatialPoints(do.call(rbind, from), proj4string = as(st_crs(from), "CRS")) } sfc2SpatialMultiPoints = function(from) { if (!requireNamespace("sp", quietly = TRUE)) stop("package sp required, please install it first") sp::SpatialMultiPoints(lapply(from, unclass), proj4string = as(st_crs(from), "CRS")) } sfc2SpatialLines = function(from, IDs = paste0("ID", seq_along(from))) { if (!requireNamespace("sp", quietly = TRUE)) stop("package sp required, please install it first") l = if (class(from)[1] == "sfc_MULTILINESTRING") lapply(from, function(x) sp::Lines(lapply(x, function(y) sp::Line(unclass(y))), "ID")) else lapply(from, function(x) sp::Lines(list(sp::Line(unclass(x))), "ID")) for (i in seq_along(from)) l[[i]]@ID = IDs[i] sp::SpatialLines(l, proj4string = as(st_crs(from), "CRS")) } sfc2SpatialPolygons = function(from, IDs = paste0("ID", seq_along(from))) { if (!requireNamespace("sp", quietly = TRUE)) stop("package sp required, please install it first") l = if (class(from)[1] == "sfc_MULTIPOLYGON") lapply(from, function(x) # for each sfc item, return a Polygons sp::Polygons(unlist(lapply(x, function(y) # to each sub-polygon, lapply(seq_along(y), function(i) sp::Polygon(y[[i]], i > 1))), recursive = FALSE), "ID")) else lapply(from, function(x) sp::Polygons(lapply(seq_along(x), function(i) sp::Polygon(x[[i]], i > 1)), "ID")) # set comment: ?Polygons: "Exterior rings are coded zero, while interior rings are # coded with the 1-based index of the exterior ring to which they belong.": for (i in seq_along(from)) { l[[i]]@ID = IDs[i] if (class(from)[1] == "sfc_MULTIPOLYGON") comm = get_comment(from[[i]]) else comm = c(0, rep(1, length(from[[i]])-1)) comment(l[[i]]) = paste(as.character(comm), collapse = " ") } sp::SpatialPolygons(l, proj4string = as(st_crs(from), "CRS")) } get_comment = function(mp) { # for MULTIPOLYGON l = lapply(mp, function(from) c(0, rep(1, length(from) - 1))) offset = 0 for (i in seq_along(l)) { l[[i]] = l[[i]] + offset offset = offset + length(l[[i]]) l[[i]][1] = 0 } unlist(l) } #' @name as #' @rdname coerce-methods #' @aliases coerce crs CRS-method setAs("crs", "CRS", function(from) CRS_from_crs(from)) CRS_from_crs = function(from) { if (! requireNamespace("sp", quietly = TRUE)) stop("package sp required, please install it first") nm <- "CRS" attr(nm, "package") <- "sp" # See ?new: obj <- new(nm, projargs = from$proj4string) if (!is.na(from$wkt) && CPL_proj_version() >= "6.0.0" && CPL_gdal_version() >= "3.0.0") comment(obj) <- from$wkt obj # we don't use sp::CRS(SRS_string = from$wkt) as rgdal may not be available, # which would break, and from$wkt has already been validated by GDAL: } ================================================ FILE: R/spatstat.R ================================================ # window_polygons_from_edges = function(w) { # mw = as.matrix(w$ends) # lst1 = lapply(seq_len(NROW(mw)), function(i) st_linestring(matrix(mw[i,], 2, byrow = TRUE))) # p0 = st_polygonize(do.call(c, do.call(st_sfc, lst1))) # if (length(p0) > 1) # multiple POLYGONs, returned as sfc_ # do.call(c, st_collection_extract(p0, "POLYGON")) # MULTIPOLYGON # else # st_cast(p0, "POLYGON") # } wrp = function(x) paste(strwrap(x), collapse = "\n") check_spatstat_ll = function(x) { if (isTRUE(st_is_longlat(x))) stop(wrp("Only projected coordinates may be converted to spatstat class objects"), call. = FALSE) } check_spatstat <- function(pkg, X = NULL) { if (!requireNamespace(pkg, quietly = TRUE)) stop("package ", pkg, " required, please install it (or the full spatstat package) first", call. = FALSE) spst_ver <- try(packageVersion("spatstat"), silent = TRUE) if (!inherits(spst_ver, "try-error") && spst_ver < "2.0-0") stop(wrp(paste0("You have an old version of spatstat installed that is incompatible with ", pkg, ". Please update spatstat (or uninstall it).")), call. = FALSE) if (!is.null(X)) check_spatstat_ll(X) } #' @name st_as_sf #' @export #' @examples #' if (require(spatstat.geom)) { #' g = st_as_sf(gorillas) #' # select only the points: #' g[st_is(g, "POINT"),] #' } st_as_sf.ppp = function(x, ...) { check_spatstat("spatstat.geom") # window: win = st_sf(label = "window", geom = st_as_sfc(spatstat.geom::as.owin(x))) # points: m = as.matrix(data.frame(x$x, x$y)) pointwork = st_sfc(lapply(seq_len(NROW(m)), function(i) st_point(m[i,]))) points_sf = st_sf(label = rep("point", NROW(m)), geom = pointwork) # merge window and points: ret = rbind(win, points_sf) if (spatstat.geom::is.marked(x)) { # add marks: m = as.data.frame(spatstat.geom::marks(x)) cbind.sf(m[c(NA, seq_len(nrow(m))), , drop = FALSE], ret) } else ret } #' @export st_as_sf.ppplist = function(x, ...) { .Deprecated(msg = "see https://github.com/r-spatial/sf/issues/1926") # sf 1.0-13, Mar 27 2023 w = st_geometry(st_as_sf(x[[1]]))[1] sim = st_sfc(lapply(x, function(p) do.call(c, st_geometry(st_as_sf(p))[-1]))) st_sf(label = c("window", names(x)), geom = c(w, sim)) } #' @name st_as_sf #' @export st_as_sf.psp = function(x, ...) { check_spatstat("spatstat.geom") # line segments: m = as.matrix(x$ends) lst1 = lapply(seq_len(NROW(m)), function(i) st_linestring(matrix(m[i,], 2, byrow = TRUE))) # window: win = st_as_sfc(spatstat.geom::as.owin(x))[[1]] label = c("window", rep("segment", NROW(m))) ret = st_sf(label = label, geom = st_sfc(c(list(win), lst1))) if (spatstat.geom::is.marked(x)) { # add marks: m = as.data.frame(spatstat.geom::marks(x)) cbind.sf(m[c(NA, seq_len(nrow(m))), , drop = FALSE], ret) } else ret } # 111117 from psp to SpatialLines, Rolf Turner, Adrian Baddeley, Mathieu Rajerison #' @export st_as_sfc.psp <- function(x, ...) { # ends2line <- function(x) matrix(x, ncol=2, byrow=TRUE) # munch <- function(z) { list(ends2line(as.numeric(z[1:4]))) } # ends <- as.data.frame(x)[,1:4] # y <- lapply(seq_len(nrow(ends)), function(i) munch(ends[i,])) # st_sfc(st_multilinestring(y)) st_geometry(st_as_sf(x, ...)) } #' @name st_as_sf #' @export #' @examples #' if (require(spatstat.linnet)) { #' data(chicago) #' plot(st_as_sf(chicago)["label"]) #' plot(st_as_sf(chicago)[-1,"label"]) #' } st_as_sf.lpp = function(x, ...) { check_spatstat("spatstat.linnet") # lines, polygon: linework_sf = st_as_sf(spatstat.geom::as.psp(spatstat.geom::domain(x))) # points: m = as.matrix(as.data.frame(x$data)[1:2]) pointwork = st_sfc(lapply(seq_len(NROW(m)), function(i) st_point(m[i,]))) sf = rbind(linework_sf, st_sf(label = rep("point", NROW(m)), geom = pointwork)) # de-select point coordinates m = as.data.frame(x$data)[c(rep(NA,nrow(linework_sf)),seq_len(nrow(m))), -(1:2)] structure(cbind.sf(sf, m), row.names = seq_len(nrow(m))) } # as.ppp etc methods: from maptools/pkg/R/spatstat1.R as.ppp.sfc = function(X, W = NULL, ..., check = TRUE) { check_spatstat("spatstat.geom", X) d = st_dimension(X) if (is.null(W)) { if (d[1] == 2 && all(d[-1] == 0)) { W = spatstat.geom::as.owin(X[1]) X = X[-1] } else if (all(d == 0)) { # no window in first feature geometry: bb <- st_bbox(X) W = spatstat.geom::owin(bb[c("xmin", "xmax")], bb[c("ymin", "ymax")]) if (missing(check)) check = FALSE } else stop("sfc object does not consist of points, or a window followed by points") } cc = st_coordinates(X) spatstat.geom::ppp(cc[,1], cc[,2], window = W, marks = NULL, check = check) } as.ppp.sf = function(X, ...) { check_spatstat("spatstat.geom", X) pp = spatstat.geom::as.ppp(st_geometry(X), ...) if (st_dimension(X[1,]) == 2) X = X[-1,] st_geometry(X) = NULL # remove geometry column if (ncol(X) == 0) { pp } else { spatstat.geom::setmarks(pp, X) } } as.owin.POLYGON = function(W, ..., fatal, check_polygons = TRUE) { check_spatstat("spatstat.geom", W) if (check_polygons) W = check_ring_dir(W) bb = st_bbox(W) spatstat.geom::owin(bb[c("xmin", "xmax")], bb[c("ymin", "ymax")], poly = W) } as.owin.MULTIPOLYGON = function(W, ..., fatal, check_polygons = TRUE) { check_spatstat("spatstat.geom", W) if (check_polygons) W = check_ring_dir(W) bb = st_bbox(W) spatstat.geom::owin(bb[c("xmin", "xmax")], bb[c("ymin", "ymax")], poly = unlist(W, recursive = FALSE)) } as.owin.sfc_POLYGON = function(W, ..., fatal, check_polygons = TRUE) { check_spatstat_ll(W) if (check_polygons) W = check_ring_dir(W) as.owin.MULTIPOLYGON(W, check_polygons = FALSE) # I know, this looks wrong, but isn't: sfc_POLYGON is a logically a MULTIPOLYGON } as.owin.sfc_MULTIPOLYGON = function(W, ..., fatal, check_polygons = TRUE) { check_spatstat_ll(W) if (check_polygons) W = check_ring_dir(W) as.owin.sfc_POLYGON(st_cast(W, "POLYGON"), check_polygons = FALSE) } as.owin.sfc = function(W, ...) { if (!all(st_dimension(W) == 2)) stop("as.owin.sfc needs polygonal geometries") as.owin.sfc_MULTIPOLYGON(st_cast(W, "MULTIPOLYGON"), ...) } as.owin.sf = function(W, ...) { as.owin.sfc(st_geometry(W), ...) } #' @export st_as_sfc.owin = function(x, ..., crs = NA) { # FROM: methods for coercion to Spatial Polygons by Adrian Baddeley, pkg maptools check_spatstat("spatstat.geom") # Check internal spatstat multiplier: mult <- x$units$multiplier if(is.null(mult)){ mult <- 1 } if(mult!=1){ warning("The spatstat object has an measurement unit multiplier != 1. Consider rescaling before converting.") } # Enforce polygonal format and proceed from there: x <- spatstat.geom::as.polygonal(x) closering <- function(df) { df[c(seq(nrow(df)), 1), ] } pieces <- lapply(x$bdry, function(p) st_polygon(list(closering(cbind(p$x,p$y))))) h = sapply(x$bdry, spatstat.utils::is.hole.xypolygon) # holes holes = do.call(st_sfc, pieces[h]) exteriors = pieces = do.call(st_sfc, pieces[!h]) # assign each hole to the smallest exterior it is covered by: cb = st_covered_by(holes, pieces) for (i in seq_along(cb)) { w = which.min(st_area(exteriors[ cb[[i]] ])) pieces[[w]] = st_polygon(c(unclass(pieces[[w]]), unclass(holes[[i]]))) } st_crs(pieces) = crs if (length(pieces) > 1) # multiple POLYGONs, collapse: st_sfc(do.call(c, pieces)) else pieces } #' @export st_as_sf.owin = function(x, ...) { st_sf(geom = st_as_sfc(x, ...)) } #' @export st_as_sfc.tess <- function(x, ...) { check_spatstat("spatstat.geom") stopifnot(spatstat.geom::is.tess(x)) y <- spatstat.geom::tiles(x) nam <- names(y) z <- list() for(i in seq_along(y)) { zi <- try(st_as_sfc(y[[i]], nam[i]), silent=TRUE) if (inherits(zi, "try-error")) warning(paste("tile", i, "defective\n", as.character(zi))) else z[[i]] <- zi } do.call(c, z) } # methods for 'as.psp' for sp classes by Adrian Baddeley as.psp.LINESTRING <- function(from, ..., window=NULL, marks=NULL, fatal) { check_spatstat("spatstat.geom") xy <- unclass(from) df <- as.data.frame(cbind(xy[-nrow(xy), , drop=FALSE], xy[-1, , drop=FALSE])) if (is.null(window)) { xrange <- range(xy[,1]) yrange <- range(xy[,2]) window <- spatstat.geom::owin(xrange, yrange) } spatstat.geom::as.psp(df, window=window, marks=marks) } as.psp.MULTILINESTRING <- function(from, ..., window=NULL, marks=NULL, fatal) { check_spatstat("spatstat.geom") y <- lapply(from, as.psp.LINESTRING, window=window) z <- do.call(spatstat.geom::superimpose,c(y,list(W=window))) if(!is.null(marks)) spatstat.geom::setmarks(z, marks) else z } as.psp.sfc_MULTILINESTRING <- function(from, ..., window=NULL, marks=NULL, characterMarks=FALSE, fatal) { check_spatstat("spatstat.geom", from) if(is.null(window)) { bb = st_bbox(from) window = spatstat.geom::owin(bb[c("xmin", "xmax")], bb[c("ymin", "ymax")]) } lin <- unclass(from) y <- lapply(lin, as.psp.MULTILINESTRING, window=window) z <- do.call(spatstat.geom::superimpose, c(y, list(W = window))) if(!is.null(marks)) spatstat.geom::setmarks(z, marks) else z } as.psp.sfc = function(from, ...) { as.psp.sfc_MULTILINESTRING(st_cast(from, "MULTILINESTRING")) } as.psp.sf <- function(from, ..., window=NULL, marks=NULL, fatal) { check_spatstat("spatstat.geom", from) y <- st_geometry(from) if (!inherits(y, "sfc_MULTILINESTRING")) stop("geometries should be of type LINESTRING") z <- spatstat.geom::as.psp(y, window=window, marks=marks) if(is.null(marks)) { # extract marks from first column of data frame st_geometry(from) = NULL # remove geometry column nseg.LINESTRING <- function(x) { nrow(x) - 1 } nseg.MULTILINESTRING <- function(x) { sum(unlist(lapply(x, nseg.LINESTRING))) } nrep <- unlist(lapply(y, nseg.MULTILINESTRING)) spatstat.geom::setmarks(z, from[rep(seq_len(nrow(from)), nrep),]) } else z } ================================================ FILE: R/stars.R ================================================ #' functions to interact with gdal not meant to be called directly by users (but e.g. by stars::read_stars) #' #' @param x character vector, possibly of length larger than 1 when more than one raster is read #' @param ... ignored #' @param options character; raster layer read options #' @param driver character; driver short name; when empty vector, driver is auto-detected. #' @param read_data logical; if \code{FALSE}, only the imagery metadata is returned #' @param NA_value (double) non-NA value to use for missing values; if \code{NA}, when writing missing values are not specially flagged in output dataset, when reading the default (dataset) missing values are used (if present / set). #' @param RasterIO_parameters list with named parameters to GDAL's RasterIO; see the stars::read_stars documentation. #' @details These functions are exported for the single purpose of being used by package stars, they are not meant to be used directly and may change or disappear without prior notice or deprecation warnings. #' @name gdal #' @keywords internal #' @export gdal_read = function(x, ..., options = character(0), driver = character(0), read_data = TRUE, NA_value = NA_real_, RasterIO_parameters = list()) { if (is.numeric(read_data)) { max_cells = as.double(read_data) read_data = FALSE } else max_cells = as.double(-1.) CPL_read_gdal(as.character(x), as.character(options), as.character(driver), as.logical(read_data), as.double(NA_value), RasterIO_parameters, max_cells) } #' @rdname gdal #' @export #' @param type gdal write type #' @param geotransform length 6 numeric vector with GDAL geotransform parameters. #' @param update logical; \code{TRUE} if in an existing raster file pixel values shall be updated. #' @param scale_offset length 2 numeric; contains scale and offset values gdal_write = function(x, ..., file, driver = "GTiff", options = character(0), type = "Float32", NA_value = NA_real_, geotransform, update = FALSE, scale_offset = c(1.0, 0.0)) { if (!requireNamespace("stars", quietly = TRUE)) stop("stars required: install that first") # nocov if (any(scale_offset != c(1.0, 0.0)) && packageVersion("sf") <= "1.0-9") warning("handling scale_offset requires sf > 1.0-9") d = stars::st_dimensions(x) xydims = attr(d, "raster")$dimensions if (!isTRUE(all.equal(match(xydims, names(d)), 1:2))) stop("x and y raster dimensions need to be in place 1 and 2") from = c(d[[1]]$from, d[[2]]$from) - 1 dims = c(d[[1]]$to, d[[2]]$to) if (length(d) == 3) dims = c(dims, d[[3]]$to - d[[3]]$from + 1) if (inherits(x, "stars_proxy")) { mat = matrix(0, 0, 0) # nocov start only_create = TRUE # don't write any pixel data if (!all(from == 0)) warning("writing raster to original size") # otherwise, geotransform needs to be modified from = c(0, 0) # nocov end } else { mat = x[[1]] dm = dim(mat) if (is.factor(mat)) { rgba = NULL ex = attr(mat, "exclude") if (is.null(ex)) lev = c("", levels(mat)) # add "" for value 0: R factors start at 1 else { if (any(ex)) { lev = vector("character", length(ex)) # fills with "" lev[!ex] = levels(mat) rgba = if (!is.null(co <- attr(mat, "rgba"))) { n = length(ex) coltab = cbind(rep(0., n), rep(0, n), rep(0, n), rep(255, n)) coltab[!ex,] = co coltab } values = which(!ex) - 1 mat = values[as.numeric(mat)] } else lev = levels(mat) } mat = structure(mat, class = NULL, levels = lev, dim = dm, rgba = rgba) } only_create = FALSE # write x too if (! update) { if (!all(from == 0)) stop("cannot write sub-rasters only") if (!all(dims == dm)) stop("dimensions don't match") } dim(mat) = c(dm[1], prod(dm[-1])) # flatten to 2-D matrix } if (length(dims) == 2) dims = c(dims, 1) # one band else if (is.character(d[[3]]$values)) # add band descriptions? attr(mat, "descriptions") = d[[3]]$values CPL_write_gdal(mat, file, driver, options, type, dims, from, geotransform, st_crs(x)[[2]], as.double(NA_value), scale_offset, create = !update, only_create = only_create) } #' @param gt double vector of length 6 #' @rdname gdal #' @details gdal_inv_geotransform returns the inverse geotransform #' @export gdal_inv_geotransform = function(gt) CPL_inv_geotransform(as.double(gt)) ## @param x two-column matrix with columns and rows, as understood by GDAL; 0.5 refers to the first cell's center; ## FIXME: this is now duplicate in sf and stars xy_from_colrow = function(x, geotransform, inverse = FALSE) { # http://www.gdal.org/classGDALDataset.html , search for geotransform: # 0-based indices: # Xp = geotransform[0] + P*geotransform[1] + L*geotransform[2]; # Yp = geotransform[3] + P*geotransform[4] + L*geotransform[5]; if (inverse) { geotransform = gdal_inv_geotransform(geotransform) # nocov start if (anyNA(geotransform)) stop("geotransform not invertible") # nocov end } stopifnot(ncol(x) == 2) matrix(geotransform[c(1, 4)], nrow(x), 2, byrow = TRUE) + x %*% matrix(geotransform[c(2, 3, 5, 6)], nrow = 2, ncol = 2) } # convert x/y gdal dimensions into a list of points, or a list of square polygons #' @export st_as_sfc.dimensions = function(x, ..., as_points = NA, use_cpp = TRUE, which = seq_len(prod(dim(x))), geotransform) { if (is.na(as_points)) stop("as_points should be set to TRUE (`points') or FALSE (`polygons')") xy2sfc = function(cc, dm, as_points) { # form points or polygons from a matrix with corner points if (as_points) unlist(apply(cc, 1, function(x) list(st_point(x))), recursive = FALSE)[which] else { stopifnot(prod(dm) == nrow(cc)) lst = vector("list", length = prod(dm - 1)) for (y in 1:(dm[2]-1)) { for (x in 1:(dm[1]-1)) { i1 = (y - 1) * dm[1] + x # top-left i2 = (y - 1) * dm[1] + x + 1 # top-right i3 = (y - 0) * dm[1] + x + 1 # bottom-right i4 = (y - 0) * dm[1] + x # bottlom-left lst[[ (y-1)*(dm[1]-1) + x ]] = st_polygon(list(cc[c(i1,i2,i3,i4,i1),])) } } lst[which] } } raster = attr(x, "raster") xy_names = raster$dimensions xd = x[[ xy_names[1] ]] yd = x[[ xy_names[2] ]] cc = if (!is.na(xd$offset) && !is.na(yd$offset)) { xy = if (as_points) # grid cell centres: expand.grid(x = seq(xd$from, xd$to) - 0.5, y = seq(yd$from, yd$to) - 0.5) else # grid corners: from 0 to n expand.grid(x = seq(xd$from - 1, xd$to), y = seq(yd$from - 1, yd$to)) xy_from_colrow(as.matrix(xy), geotransform) } else if (is.null(xd$values) || is.null(yd$values)) { # only one of [xd|yd] has $values: if (!requireNamespace("stars", quietly = TRUE)) # nocov start stop("stars required: install that first") if (! as_points) stop("st_as_sfc(): mixed regular and rectilinear dimensions only supported if as_points = TRUE") as.matrix(st_coordinates(x)) # nocov end } else { # both xd and yd have $values: expand = function(x) { # might fail on the poles or dateline d = diff(x) c(x[1] - 0.5 * d[1], x + 0.5 * c(d, tail(d, 1))) } if (raster$curvilinear) { # expand jointly: if (!as_points && all(dim(xd$values) == dim(x)[xy_names])) { # expand from points to cells/polygons: xd$values = apply((apply(xd$values, 1, expand)), 1, expand) yd$values = apply((apply(yd$values, 1, expand)), 1, expand) } cbind(as.vector(xd$values), as.vector(yd$values)) } else { # rectlinear: expand independently if (! as_points) { xd$values = if (inherits(xd$values, "intervals")) c(xd$values$start, tail(xd$values$end, 1)) else expand(xd$values) yd$values = if (inherits(yd$values, "intervals")) c(yd$values$start, tail(yd$values$end, 1)) else expand(yd$values) } else { if (inherits(xd$values, "intervals")) xd$values = 0.5 * (xd$values$start + xd$values$end) if (inherits(yd$values, "intervals")) yd$values = 0.5 * (yd$values$start + yd$values$end) } as.matrix(expand.grid(x = xd$values, y = yd$values)) } } dims = dim(x) + !as_points if (use_cpp) { bb = if (cc_has_NAs <- anyNA(cc)) bbox.Mtrx(na.omit(cc)) else bbox.Mtrx(cc) structure(CPL_xy2sfc(cc, as.integer(dims), as_points, as.integer(which), cc_has_NAs), crs = st_crs(xd$refsys), n_empty = 0L, bbox = bb) } else st_sfc(xy2sfc(cc, dims, as_points), crs = xd$refsys) } #' @details gdal_crs reads coordinate reference system from GDAL data set #' @param file character; file name #' @return object of class \code{crs}, see \link{st_crs}. #' @rdname gdal #' @export gdal_crs = function(file, options = character(0)) { st_crs(CPL_get_crs(file, options)$crs) } #' @details get_metadata gets metadata of a raster layer #' @rdname gdal #' @export #' @param domain_item character vector of length 0, 1 (with domain), or 2 (with domain and item); use \code{""} for the default domain, use \code{NA_character_} to query the domain names. #' @param parse logical; should metadata be parsed into a named list (\code{TRUE}) or returned as character data? #' @return named list with metadata items #' @examples #' \dontrun{ #' f = system.file("tif/L7_ETMs.tif", package="stars") #' f = system.file("nc/avhrr-only-v2.19810901.nc", package = "stars") #' gdal_metadata(f) #' gdal_metadata(f, NA_character_) #' try(gdal_metadata(f, "wrongDomain")) #' gdal_metadata(f, c("", "AREA_OR_POINT")) #' } gdal_metadata = function(file, domain_item = character(0), options = character(0), parse = TRUE) { stopifnot(is.character(file)) stopifnot(is.character(domain_item)) stopifnot(length(domain_item) <= 2) stopifnot(is.character(options)) if (length(domain_item) >= 1 && !is.na(domain_item[1]) && !(domain_item[1] %in% CPL_get_metadata(file, NA_character_, options))) stop("domain_item[1] not found in available metadata domains") p = CPL_get_metadata(file, domain_item, options) if (!is.na(domain_item[1]) && parse) split_strings(p) else p } split_strings = function(md, split = "=") { splt = strsplit(md, split) lst = lapply(splt, function(x) if (length(x) <= 1) NA_character_ else x[[2]]) structure(lst, names = sapply(splt, function(x) x[[1]]), class = "gdal_metadata") } #' @param name logical; retrieve name of subdataset? If \code{FALSE}, retrieve description #' @export #' @return \code{gdal_subdatasets} returns a zero-length list if \code{file} does not have subdatasets, and else a named list with subdatasets. #' @rdname gdal #' @details gdal_subdatasets returns the subdatasets of a gdal dataset gdal_subdatasets = function(file, options = character(0), name = TRUE) { if (!("SUBDATASETS" %in% CPL_get_metadata(file, NA_character_, options))) list() else { md = gdal_metadata(file, "SUBDATASETS", options, TRUE) if (name) md[seq(1, length(md), by = 2)] else md[seq(2, length(md), by = 2)] } } #' @param use_integer boolean; if \code{TRUE}, raster values are read as (and rounded to) unsigned 32-bit integers values; if \code{FALSE} they are read as 32-bit floating points numbers. The former is supposedly faster. #' @param mask stars object with NA mask (0 where NA), or NULL #' @param breaks numeric vector with break values for contour polygons (or lines) #' @param use_contours logical; #' @param contour_lines logical; #' @param connect8 logical; if \code{TRUE} use 8 connection algorithm, rather than 4 #' @rdname gdal #' @export gdal_polygonize = function(x, mask = NULL, file = tempfile(), driver = "GTiff", use_integer = TRUE, geotransform, breaks = classInt::classIntervals(na.omit(as.vector(x[[1]])))$brks, use_contours = FALSE, contour_lines = FALSE, connect8 = FALSE, ...) { gdal_write(x, file = file, driver = driver, geotransform = geotransform) # nocov start on.exit(unlink(file)) mask_name = if (!is.null(mask)) { mask_name = tempfile() gdal_write(mask, file = mask_name, driver = driver, geotransform = geotransform) on.exit(unlink(mask_name)) mask_name } else character(0) contour_options = if (use_contours) { # construct contour_options: nbreaks = breaks if (max(breaks) == max(x[[1]], na.rm = TRUE)) # expand, because GDAL will not include interval RHS nbreaks[length(nbreaks)] = breaks[length(breaks)] * 1.01 c(paste0("FIXED_LEVELS=", paste0(nbreaks, collapse = ",")), "ELEV_FIELD=0", "ELEV_FIELD_MIN=1", "ELEV_FIELD_MAX=2", paste0("POLYGONIZE=", ifelse(contour_lines, "NO", "YES"))) } else character(0) options = if (connect8) "8CONNECTED=8" else character(0) mem = ifelse(compareVersion(sf_extSoftVersion()["GDAL"], "3.11.0") >= 0, "MEM", "Memory") pol = CPL_polygonize(file, mask_name, "GTiff", mem, "foo", options, 0, contour_options, use_contours, use_integer) out = process_cpl_read_ogr(pol, quiet = TRUE) names(out)[1] = names(x)[1] if (! contour_lines && use_contours) { # if (out$Min[1] == 0 && out$Min[1] > min(breaks)) # out$Min[1] = -Inf # # https://github.com/r-spatial/sf/pull/1608 : i <- match(out$Max[1], sort(breaks)) out$Min[1] = if (!is.na(i) && i > 1) sort(breaks)[i - 1] else -Inf out$Max[out$Max == 2^32 - 1] = Inf f = paste0("[", out$Min, ",", out$Max, ")") out[[1]] = factor(f, levels = f) } else out$Min = out$Max = NULL out # nocov end } #' @param sf object of class \code{sf} #' @name gdal #' @export gdal_rasterize = function(sf, x, gt, file, driver = "GTiff", options = character()) { gdal_write(x, file = file, driver = driver, geotransform = gt) geoms = which(sapply(sf, inherits, "sfc")) values = as.double(t(as.matrix(as.data.frame(sf)[-geoms]))) CPL_rasterize(file, driver, st_geometry(sf), values, options, NA_real_); } #' @export #' @rdname gdal #' @param f gdal raster data source filename #' @param pts points matrix #' @param resampling character; resampling method; for method cubic or cubicspline, #' `stars_proxy` objects should be used and GDAL should have version >= 3.10.0 gdal_extract = function(f, pts, resampling = c("nearest", "bilinear", "cubic", "cubicspline")) { CPL_extract(f, pts, match.arg(resampling)) } #' @rdname gdal #' @param file file name #' @param array_name array name #' @param offset offset (pixels) #' @param count number of pixels to read #' @param step step size (pixels) #' @param proxy logical; return proxy object? #' @param debug logical; print debug messages? #' @export gdal_read_mdim = function(file, array_name = character(0), options = character(0), offset = integer(0), count = integer(0), step = integer(0), proxy = FALSE, debug = FALSE) { CPL_read_mdim(file, array_name, options, offset, count, step, proxy, debug) } #' @rdname gdal #' @param dimx integer named vector with dimensions of object #' @param cdl list with variables, each having a named dim attribute #' @param wkt character; WKT of crs #' @param xy character; names of the spatial x and y dimension #' @param root_group_options character; driver specific options regarding the creation of the root group #' @param options character; driver specific options regarding reading or creating the dataset #' @param as_float logical; when \code{TRUE} write 4-byte floating point numbers, when \code{FALSE} write 8-byte doubles. #' @export gdal_write_mdim = function(file, driver, dimx, cdl, wkt, xy, ..., root_group_options = character(0), options = character(0), as_float = TRUE) { CPL_write_mdim(file, driver, dimx, cdl, wkt, xy, root_group_options, options, as_float) } #' @name gdal #' @param f character; file name #' @param nxy integer vector of length 2 #' @param values fill value #' @param crs object of class \code{crs} #' @param xlim numeric #' @param ylim numeric #' @export gdal_create = function(f, nxy, values, crs, xlim, ylim) { CPL_create(as.character(f), as.integer(nxy), as.double(values), crs$wkt, as.double(xlim), as.double(ylim)) } #' Add or remove overviews to/from a raster image #' #' add or remove overviews to/from a raster image #' @param file character; file name #' @param overviews integer; overview levels #' @param method character; method to create overview; one of: nearest, average, rms, gauss, cubic, cubicspline, lanczos, average_mp, average_magphase, mode #' @param layers integer; layers to create overviews for (default: all) #' @param options character; dataset opening options #' @param config_options named character vector with GDAL config options, like \code{c(option1=value1, option2=value2)} #' @param clean logical; if \code{TRUE} only remove overviews, do not add #' @param read_only logical; if \code{TRUE}, add overviews to another file with extension \code{.ovr} added to \code{file} #' @return \code{TRUE}, invisibly, on success #' @seealso \link{gdal_utils} for access to other gdal utilities that have a C API #' @export gdal_addo = function(file, overviews = c(2,4,8,16), method = "NEAREST", layers = integer(0), options = character(0), config_options = character(0), clean = FALSE, read_only = FALSE) { stopifnot(length(method) == 1, is.character(method), is.numeric(overviews), is.character(config_options)) invisible(CPL_gdaladdo(file, method, as.integer(overviews), as.integer(layers), as.character(options), config_options, as.logical(clean)[1], as.logical(read_only)[1])) } #' List GDAL compressors and decompressors #' #' List GDAL compressors and decompressors #' @return named list with two character vectors, containing compressors and decompressors #' @export gdal_compressors = function() { CPL_compressors() } ================================================ FILE: R/terra.R ================================================ # see https://github.com/r-spatial/sf/issues/1567 #' @export st_as_sf.SpatVector = function(x, ..., hex = TRUE, crs = st_crs(x)) { if(!requireNamespace("terra", quietly = TRUE)) stop("package terra required, please install it first") if (!utils::packageVersion("terra") >= "1.1-5") stop("package terra version 1.1-5 required") d <- terra::as.data.frame(x, geom = "hex") d$geometry <- structure(as.list(d$geometry), class = "WKB") st_as_sf(d, crs = crs) } #' @export st_crs.SpatRaster = function(x, ...) { if (!requireNamespace("terra", quietly = TRUE)) stop("package terra required, please install it first") # nocov string = terra::crs(x) if (string == "") NA_crs_ else st_crs(string) } #' @export st_crs.SpatVector = st_crs.SpatRaster #' @export st_bbox.SpatExtent = function(obj, ..., crs = NA_crs_) { if (!requireNamespace("terra", quietly = TRUE)) stop("package terra required, please install it first") # nocov bb = as.vector(obj)[c(1,3,2,4)] names(bb) = c("xmin", "ymin", "xmax", "ymax") st_bbox(bb, crs = crs) } #' @export st_bbox.SpatRaster = function(obj, ...) { if (!requireNamespace("terra", quietly = TRUE)) stop("package terra required, please install it first") # nocov st_bbox(terra::ext(obj), crs = st_crs(obj)) } #' @export st_bbox.SpatVector = function(obj, ...) { if (!requireNamespace("terra", quietly = TRUE)) stop("package terra required, please install it first") # nocov bb = as.vector(terra::ext(obj))[c(1,3,2,4)] names(bb) = c("xmin", "ymin", "xmax", "ymax") st_bbox(bb, crs = st_crs(obj)) } ================================================ FILE: R/tidyverse-vctrs.R ================================================ types = c("POINT", "MULTIPOINT", "LINESTRING", "MULTILINESTRING", "POLYGON", "MULTIPOLYGON", "GEOMETRYCOLLECTION", "GEOMETRY", "MULTISURFACE", "CURVEPOLYGON") sfc_types = paste0("sfc_", types) # All S3 methods in this file are registered lazily when vctrs is loaded register_vctrs_methods = function() { # Register vec_proxy, vec_restore, vec_ptype for all types for (type in sfc_types) { s3_register("vctrs::vec_proxy", type) s3_register("vctrs::vec_proxy_order", type) s3_register("vctrs::vec_restore", type) s3_register("vctrs::vec_ptype", type) } # Register vec_ptype2 for all pairs for (i in seq_along(sfc_types)) { for (j in seq_along(sfc_types)) { s3_register("vctrs::vec_ptype2", paste0(sfc_types[i], ".", sfc_types[j])) } } # Register vec_cast for all pairs for (i in seq_along(sfc_types)) { for (j in seq_along(sfc_types)) { s3_register("vctrs::vec_cast", paste0(sfc_types[i], ".", sfc_types[j])) } } s3_register("vctrs::vec_proxy", "sf") s3_register("vctrs::vec_restore", "sf") s3_register("vctrs::vec_ptype2", "sf.sf") s3_register("vctrs::vec_ptype2", "sf.data.frame") s3_register("vctrs::vec_ptype2", "data.frame.sf") s3_register("vctrs::vec_ptype2", "sf.tbl_df") s3_register("vctrs::vec_ptype2", "tbl_df.sf") s3_register("vctrs::vec_cast", "sf.sf") s3_register("vctrs::vec_cast", "data.frame.sf") s3_register("vctrs::vec_cast", "sf.data.frame") s3_register("vctrs::vec_cast", "sf.tbl_df") s3_register("vctrs::vec_cast", "tbl_df.sf") } vec_proxy_sfc = function(x) sf_unstructure(x) vec_restore_sfc = function(x, to) { st_sfc( x, crs = st_crs(to), precision = st_precision(to), fall_back_class = class(to) ) } vec_ptype_sfc = function(x) { st_sfc( crs = st_crs(x), precision = st_precision(x), fall_back_class = class(x) ) } #vec_proxy_order_sfc = function(x, ...) { # Same as `vctrs:::vec_proxy_order.list()`. # Allows sfc columns to be "sorted" by first appearance. # xtfrm(x) #} vec_proxy_order_sfc = function(x, ...) { # Same as `vctrs:::vec_proxy_order.list()`. # Allows sfc columns to be "sorted" by first appearance. x = sf_unstructure(x) out = vctrs::vec_duplicate_id(x) if (vctrs::vec_any_missing(x)) { missing = vctrs::vec_detect_missing(x) out = vctrs::vec_assign(out, missing, NA_integer_) } out } # sfc single methods: for (type in sfc_types) { assign(paste0("vec_proxy.", type), function(x, y, ...) vec_proxy_sfc(x)) assign(paste0("vec_proxy_order.", type), function(x, y, ...) vec_proxy_order_sfc(x)) assign(paste0("vec_restore.", type), function(x, to, ...) vec_restore_sfc(x, to)) assign(paste0("vec_ptype.", type), function(x, ...) vec_ptype_sfc(x)) } # Single implementation that works for all type pairs vec_ptype2_impl = function(x, y) { check_same_crs(x, y) check_same_precision(x, y) if (identical(class(x), class(y))) x else # return empty sfc_GEOMETRY for mixed types st_sfc(crs = st_crs(x), precision = st_precision(x)) } # Then assign to all pairs for (type1 in sfc_types) { for (type2 in sfc_types) { assign(paste0("vec_ptype2.", type1, ".", type2), function(x, y, ...) vec_ptype2_impl(x, y)) } } for (type1 in sfc_types) { for (type2 in sfc_types) { if (type1 == type2) assign(paste0("vec_cast.", type1, ".", type2), function(x, to, ...) vec_cast_sfc_sfc(x, to)) else assign(paste0("vec_cast.", type1, ".", type2), function(x, to, ...) vec_cast_to_geometry(x, to)) } } vec_cast_sfc_sfc = function(x, to) { check_same_crs(x, to) check_same_precision(x, to) x } vec_cast_to_geometry = function(x, to) { check_same_crs(x, to) check_same_precision(x, to) st_cast(x, "GEOMETRY") } ## sf methods: sf_unstructure = function(x) { if (is.data.frame(x)) { x = vctrs::new_data_frame(x, row.names = .row_names_info(x, 0L)) } else if (!is.null(dim(x))) { attributes(x) = list(dim = dim(x), dimnames = dimnames(x)) } else { attributes(x) = list(names = names(x)) } x } vec_proxy.sf = function(x, ...) { # Strip attributes to ensure `vec_restore()`'s call to `st_as_sf()` uses the # data frame S3 method, and can't use any information from `x`'s original # `sf` state sf_unstructure(x) } vec_restore.sf = function(x, to, ...) { # Due to the way `vec_ptype()` works, `vec_df_restore()` will preemptively # restore the `to` attributes by straight up copying them over. We really # don't want that! `sf::st_as_sf()` needs to S3 dispatch to the data frame # method. If `to` attributes are preemptively restored (including the class) # then it will instead dispatch on the sf method, and will "reuse" # attributes from `x`, which is incorrect. It should only use `to` # attributes when restoring. See TODO in `vec_df_restore()`. x = sf_unstructure(x) sf_column_name = attr(to, "sf_column") crs = st_crs(to) prec = st_precision(to) if (inherits(to, "tbl_df")) x = tibble::as_tibble(x) st_as_sf( x, sf_column_name = sf_column_name, crs = crs, precision = prec, stringsAsFactors = FALSE ) } sf_ptype2 = function(x, y, ...) { data = vctrs::df_ptype2(x, y, ...) # Take active geometry from left-hand side sf_column_name = attr(x, "sf_column") # CRS and precision must match check_same_crs(x, y) check_same_precision(x, y) st_as_sf(data, sf_column_name = sf_column_name) } vec_ptype2.sf.sf = function(x, y, ...) { sf_ptype2(x, y, ...) } vec_ptype2.sf.data.frame = function(x, y, ...) { vctrs::df_ptype2(x, y, ...) } vec_ptype2.data.frame.sf = function(x, y, ...) { vctrs::df_ptype2(x, y, ...) } vec_ptype2.sf.tbl_df = function(x, y, ...) { vctrs::tib_ptype2(x, y, ...) } vec_ptype2.tbl_df.sf = function(x, y, ...) { vctrs::tib_ptype2(x, y, ...) } #sf_cast = function(x, to, ...) { # data = vctrs::df_cast(x, to, ...) # # sf_column_name = attr(to, "sf_column") # crs = st_crs(to) # prec = st_precision(to) # # st_as_sf( # data, # sf_column_name = sf_column_name, # crs = crs, # precision = prec, # stringsAsFactors = FALSE # ) #} sf_cast = function(x, to, ...) { data = vctrs::df_cast(x, to, ...) # CRS and precision must match check_same_crs(x, to) check_same_precision(x, to) if (inherits(to, "tbl_df")) data = tibble::as_tibble(data) sf_column_name = attr(to, "sf_column") st_as_sf(data, sf_column_name = sf_column_name) } # Because `vec_ptype2.sf.sf()` returns a sf vec_cast.sf.sf = function(x, to, ...) { sf_cast(x, to, ...) } # Because `vec_ptype2.sf.data.frame()` returns a data frame vec_cast.data.frame.sf = function(x, to, ...) { vctrs::df_cast(x, to, ...) } # Opt out of `vec_default_cast()` support for data.frame -> sf. # Would never be called automatically, and likely not meaningful. vec_cast.sf.data.frame = function(x, to, ..., x_arg = "", to_arg = "") { vctrs::stop_incompatible_cast(x, to, x_arg = x_arg, to_arg = to_arg) } # Because `vec_ptype2.sf.tbl_df()` returns a tibble vec_cast.tbl_df.sf = function(x, to, ...) { vctrs::tib_cast(x, to, ...) } # Opt out of `vec_default_cast()` support for tibble -> sf. # Would never be called automatically, and likely not meaningful. vec_cast.sf.tbl_df = function(x, to, ..., x_arg = "", to_arg = "") { vctrs::stop_incompatible_cast(x, to, x_arg = x_arg, to_arg = to_arg) } # Take conservative approach of requiring equal CRS check_same_crs = function(x, y) { lhs = st_crs(x) rhs = st_crs(y) if (lhs != rhs) stop(paste("CRS mismatch:", lhs$input, "vs", rhs$input), call. = FALSE) invisible() } check_same_precision = function(x, y) { lhs = st_precision(x) rhs = st_precision(y) if (lhs != rhs) stop(paste("Precision mismatch:", lhs, "vs", rhs), call. = FALSE) invisible() } ================================================ FILE: R/tidyverse.R ================================================ ## dplyr methods: ------ #group_map.sf <- function(.tbl, .f, ...) { # st_as_sf(NextMethod()) # nocov #} # This is currently only used in `bind_rows()` and `bind_cols()` # because sf overrides all default implementations dplyr_reconstruct.sf = function(data, template) { sfc_name = attr(template, "sf_column") if (inherits(template, "tbl_df")) data = dplyr::as_tibble(data) # Return a bare data frame if the geometry column is no longer there if (sfc_name %in% names(data)) # reconstruct sf: st_as_sf( data, sf_column_name = sfc_name, crs = st_crs(template), precision = st_precision(template) ) else data } #' Tidyverse methods for sf objects #' #' Tidyverse methods for sf objects. Geometries are sticky, use \link{as.data.frame} to let \code{dplyr}'s own methods drop them. #' Use these methods after loading the tidyverse package with the generic (or after loading package tidyverse). #' @param .data data object of class \link{sf} #' @param .dots see corresponding function in package \code{dplyr} #' @param ... other arguments #' @name tidyverse #' @examples #' if (require(dplyr, quietly = TRUE)) { #' nc = read_sf(system.file("shape/nc.shp", package="sf")) #' nc |> filter(AREA > .1) |> plot() #' # plot 10 smallest counties in grey: #' st_geometry(nc) |> plot() #' nc |> select(AREA) |> arrange(AREA) |> slice(1:10) |> plot(add = TRUE, col = 'grey') #' title("the ten counties with smallest area") #' nc2 <- nc |> mutate(area10 = AREA/10) #' nc |> slice(1:2) #' } filter.sf <- function(.data, ..., .dots) { agr = st_agr(.data) class(.data) <- setdiff(class(.data), "sf") .re_sf(NextMethod(), sf_column_name = attr(.data, "sf_column"), agr) } #' @name tidyverse #' @examples #' # plot 10 smallest counties in grey: #' if (require(dplyr, quietly = TRUE)) { #' st_geometry(nc) |> plot() #' nc |> select(AREA) |> arrange(AREA) |> slice(1:10) |> plot(add = TRUE, col = 'grey') #' title("the ten counties with smallest area") #' } arrange.sf <- function(.data, ..., .dots) { sf_column_name = attr(.data, "sf_column") class(.data) = setdiff(class(.data), "sf") st_as_sf(NextMethod(), sf_column_name = sf_column_name) } #' @name tidyverse #' @param add see corresponding function in dplyr #' @examples #' if (require(dplyr, quietly = TRUE)) { #' nc$area_cl = cut(nc$AREA, c(0, .1, .12, .15, .25)) #' nc |> group_by(area_cl) |> class() #' } group_by.sf <- function(.data, ..., add = FALSE) { sf_column_name = attr(.data, "sf_column") class(.data) <- setdiff(class(.data), "sf") st_as_sf(NextMethod(), sf_column_name = sf_column_name) } #' @name tidyverse ungroup.sf <- function(x, ...) { sf_column_name = attr(x, "sf_column") class(x) <- setdiff(class(x), "sf") st_as_sf(NextMethod(), sf_column_name = sf_column_name) } #' @name tidyverse rowwise.sf <- function(x, ...) { sf_column_name = attr(x, "sf_column") class(x) <- setdiff(class(x), "sf") st_as_sf(NextMethod(), sf_column_name = sf_column_name) } .re_sf = function(x, sf_column_name, agr, geom = NULL) { stopifnot(!inherits(x, "sf"), !missing(sf_column_name), !missing(agr)) # non-geom attribute names att = names(x)[!sapply(x, inherits, what = "sfc")] agr = setNames(agr[att], att) # NA's new columns if (!is.null(geom)) { stopifnot(length(geom) == nrow(x)) x[[ sf_column_name ]] = geom } structure(x, sf_column = sf_column_name, agr = agr, class = c("sf", class(x))) } #' @name tidyverse #' @examples #' if (require(dplyr, quietly = TRUE)) { #' nc2 <- nc |> mutate(area10 = AREA/10) #' } mutate.sf <- function(.data, ..., .dots) { #st_as_sf(NextMethod(), sf_column_name = attr(.data, "sf_column")) agr = st_agr(.data) sf_column_name = attr(.data, "sf_column") class(.data) <- setdiff(class(.data), "sf") .re_sf(NextMethod(), sf_column_name = sf_column_name, agr) } #' @name tidyverse #' @examples #' if (require(dplyr, quietly = TRUE)) { #' nc |> transmute(AREA = AREA/10) |> class() #' } transmute.sf <- function(.data, ..., .dots) { sf_column_name = attr(.data, "sf_column") agr = st_agr(.data) geom = st_geometry(.data) class(.data) = setdiff(class(.data), "sf") .re_sf(NextMethod(), sf_column_name = sf_column_name, agr, geom) } #' @name tidyverse #' @examples #' if (require(dplyr, quietly = TRUE)) { #' nc |> select(SID74, SID79) |> names() #' nc |> select(SID74, SID79) |> class() #' } #' @details \code{select} keeps the geometry regardless whether it is selected or not; to deselect it, first pipe through \code{as.data.frame} to let dplyr's own \code{select} drop it. select.sf <- function(.data, ...) { if (!requireNamespace("tidyselect", quietly = TRUE)) stop("tidyselect required: install that first") # nocov loc = tidyselect::eval_select(quote(c(...)), .data) sf_column = attr(.data, "sf_column") sf_column_loc = match(sf_column, names(.data)) if (length(sf_column_loc) != 1 || is.na(sf_column_loc)) stop("internal error: can't find sf column") # nocov agr = st_agr(.data) #vars = names(.data)[setdiff(loc, sf_column_loc)] # see #1886, change into: lloc = loc if (sf_column_loc %in% loc) lloc = lloc[loc != sf_column_loc] vars = names(.data)[lloc] sf_column_loc_loc = match(sf_column_loc, loc) if (is.na(sf_column_loc_loc)) { # The sf column was subsetted out, select it back in new_agr = setNames(agr[vars], names(loc)) loc = c(loc, sf_column_loc) names(loc)[[length(loc)]] = sf_column } else { # The sf column was not subsetted out but it might have been renamed sf_column = names(loc[sf_column_loc_loc]) new_agr = setNames(agr[vars], setdiff(names(loc), sf_column)) } ret = .data class(ret) = setdiff(class(ret), "sf") ret = ret[loc] names(ret) = names(loc) st_set_agr(st_as_sf(ret, sf_column_name = sf_column), new_agr) } #' @name tidyverse #' @examples #' if (require(dplyr, quietly = TRUE)) { #' nc2 <- nc |> rename(area = AREA) #' } rename.sf <- function(.data, ...) { if (!requireNamespace("tidyselect", quietly = TRUE)) stop("tidyselect required: install that first") # nocov loc = tidyselect::eval_rename(quote(c(...)), .data) sf_column = attr(.data, "sf_column") sf_column_loc = match(sf_column, names(.data)) if (length(sf_column_loc) != 1 || is.na(sf_column_loc)) stop("internal error: can't find sf column") # nocov agr = st_agr(.data) agr_loc = match(names(agr), setdiff(names(.data), sf_column)) if (anyNA(agr_loc)) stop("internal error: can't find `agr` columns") # nocov vars_loc = loc[loc %in% agr_loc] # https://github.com/r-spatial/sf/issues/1472 # but only fixes for the single sfc column case sfcs = which(sapply(.data, inherits, "sfc")) if (length(vars_loc) == 1 && any(vars_loc > sfcs[1])) { w = which(vars_loc > sfcs) vars_loc[w] = vars_loc[w] - 1 } names(agr)[vars_loc] = names(vars_loc) sf_column_loc_loc = match(sf_column_loc, loc) if (!is.na(sf_column_loc_loc)) sf_column = names(loc[sf_column_loc_loc]) ret = .data class(ret) = setdiff(class(ret), "sf") names(ret)[loc] = names(loc) st_set_agr(st_as_sf(ret, sf_column_name = sf_column), agr) } #' @name tidyverse #' @param .fn,.cols see original docs rename_with.sf = function(.data, .fn, .cols, ...) { if (!requireNamespace("rlang", quietly = TRUE)) stop("rlang required: install that first") # nocov .fn = rlang::as_function(.fn) is_tibble = inherits(.data, "tbl") sf_column = attr(.data, "sf_column") sf_column_loc = match(sf_column, names(.data)) if (length(sf_column_loc) != 1 || is.na(sf_column_loc)) stop("internal error: can't find sf column") # nocov agr = st_agr(.data) .data = as.data.frame(.data) ret = if (missing(.cols)) { if (!requireNamespace("tidyselect", quietly = TRUE)) { stop("tidyselect required: install that first") # nocov } dplyr::rename_with( .data = .data, .fn = .fn, .cols = tidyselect::everything(), ... ) } else { dplyr::rename_with( .data = .data, .fn = .fn, .cols = {{ .cols }}, ... ) } if (is_tibble) ret = dplyr::as_tibble(ret) ret = st_as_sf(ret, sf_column_name = names(ret)[sf_column_loc]) names(agr) = .fn(names(agr), ...) st_agr(ret) = agr ret } #' @name tidyverse #' @examples #' if (require(dplyr, quietly = TRUE)) { #' nc |> slice(1:2) #' } slice.sf <- function(.data, ..., .dots) { class(.data) <- setdiff(class(.data), "sf") sf_column <- attr(.data, "sf_column") st_as_sf(NextMethod(), sf_column_name = sf_column) } #' @name tidyverse #' @aliases summarise #' @param do_union logical; in case \code{summary} does not create a geometry column, should geometries be created by unioning using \link{st_union}, or simply by combining using \link{st_combine}? Using \link{st_union} resolves internal boundaries, but in case of unioning points, this will likely change the order of the points; see Details. #' @param is_coverage logical; if \code{do_union} is \code{TRUE}, use an optimized algorithm for features that form a polygonal coverage (have no overlaps) #' @return an object of class \link{sf} #' @details #' In case one or more of the arguments (expressions) in the \code{summarise} call creates a geometry list-column, the first of these will be the (active) geometry of the returned object. If this is not the case, a geometry column is created, depending on the value of \code{do_union}. #' #' In case \code{do_union} is \code{FALSE}, \code{summarise} will simply combine geometries using \link{c.sfg}. When polygons sharing a boundary are combined, this leads to geometries that are invalid; see for instance \url{https://github.com/r-spatial/sf/issues/681}. #' @examples #' if (require(dplyr, quietly = TRUE)) { #' nc$area_cl = cut(nc$AREA, c(0, .1, .12, .15, .25)) #' nc.g <- nc |> group_by(area_cl) #' nc.g |> summarise(mean(AREA)) #' nc.g |> summarise(mean(AREA)) |> plot(col = grey(3:6 / 7)) #' nc |> as.data.frame() |> summarise(mean(AREA)) #' # counting geometries (after duplicating each row): #' nc.dupl <- nc[rep(seq_along(nc), each = 2), ] #' nc.dupl |> summarise(n = n(), .by = "geometry") #' } summarise.sf <- function(.data, ..., .dots, do_union = TRUE, is_coverage = FALSE) { sf_column = attr(.data, "sf_column") precision = st_precision(.data) crs = st_crs(.data) geom = st_geometry(.data) class(.data) = setdiff(class(.data), "sf") ret = NextMethod() if (!missing(do_union)) ret$do_union = NULL if (!missing(is_coverage)) ret$is_coverage = NULL if (! any(sapply(ret, inherits, what = "sfc"))) { geom = if (inherits(.data, "grouped_df") || inherits(.data, "grouped_dt")) { if (!requireNamespace("dplyr", quietly = TRUE)) stop("dplyr required: install that first") # nocov i = dplyr::group_indices(.data) # geom = st_geometry(.data) geom = if (do_union) lapply(sort(unique(i)), function(x) { if (x == 1) st_union(geom[i == x], is_coverage = is_coverage) else suppressMessages(st_union(geom[i == x], is_coverage = is_coverage)) }) else lapply(sort(unique(i)), function(x) st_combine(geom[i == x])) geom = unlist(geom, recursive = FALSE) if (is.null(geom)) geom = list() #676 #nocov do.call(st_sfc, c(geom, crs = list(crs), precision = precision)) } else { # single group: if (nrow(ret) > 1) stop(paste0("when using .by, also add across(", sf_column, ", st_union) as argument")) # https://github.com/r-spatial/sf/issues/2207 if (do_union) st_union(geom, is_coverage = is_coverage) else st_combine(geom) } ret[[ sf_column ]] = geom } # need to re-sort out the geometry column class now: st_as_sf(structure(ret, sf_column = NULL)) } #' @name tidyverse #' @param wt see original function docs #' @param sort see original function docs #' @param name see original function docs #' @param name see original function docs #' @param .drop_geometry logical; if `TRUE`, remove geometry column before computing counts #' @examples #' if (require(dplyr, quietly = TRUE)) { #' nc$area_cl <- cut(nc$AREA, c(0, .1, .12, .15, .25)) #' nc |> count(area_cl, .drop_geometry = TRUE) #' } #' @details The functions \code{count} and \code{tally} drop all geometries. #' For counting geometries use \code{summarise(.data, n = n(), .by = "geometry")}. count.sf <- function(x, ..., wt = NULL, sort = FALSE, name = "n", .drop_geometry = FALSE) { if (!requireNamespace("dplyr", quietly = TRUE)) stop("dplyr required: install that first") # nocov if (isTRUE(.drop_geometry)) x <- st_drop_geometry(x) NextMethod() } #' @name tidyverse #' @param .keep_all see corresponding function in dplyr #' @param exact logical; if `TRUE` use \link{st_equals_exact} for geometry comparisons #' @param par numeric; passed on to \link{st_equals_exact} #' @examples #' if (require(dplyr, quietly = TRUE)) { #' nc[c(1:100, 1:10), ] |> distinct() |> nrow() #' } #' @details \code{distinct} gives distinct records for which all attributes and geometries are distinct; \link{st_equals} is used to find out which geometries are distinct. distinct.sf <- function(.data, ..., .keep_all = FALSE, exact = FALSE, par = 0.) { sf_column = attr(.data, "sf_column") geom = st_geometry(.data) eq = if (exact) sapply(st_equals_exact(.data, par = par), head, n = 1) else sapply(st_equals(.data), head, n = 1) if (is.list(eq) && length(eq) == 0) # empty list: geometry was empty set eq = integer(0) empties = which(lengths(eq) == 0) eq[ empties ] = empties[1] # first empty record .data[[ sf_column ]] = unlist(eq) class(.data) = setdiff(class(.data), "sf") if (!requireNamespace("dplyr", quietly = TRUE)) stop("dplyr required: install that first") # nocov if (!requireNamespace("rlang", quietly = TRUE)) stop("rlang required: install first?") .data = dplyr::distinct(.data, ..., .keep_all = .keep_all) if (is.null(.data[[ sf_column ]])) .data else { .data[[ sf_column ]] = geom[ .data[[ sf_column ]] ] st_as_sf(.data, sf_column_name = sf_column) } } ## tidyr methods: -------- #' @name tidyverse #' @param data see original function docs #' @param key see original function docs #' @param value see original function docs #' @param na.rm see original function docs #' @param factor_key see original function docs #' @examples #' if (require(tidyr, quietly = TRUE) && require(dplyr, quietly = TRUE) && "geometry" %in% names(nc)) { #' nc |> select(SID74, SID79) |> gather("VAR", "SID", -geometry) |> summary() #' } gather.sf <- function(data, key, value, ..., na.rm = FALSE, convert = FALSE, factor_key = FALSE) { if (! requireNamespace("rlang", quietly = TRUE)) stop("rlang required: install first?") key = rlang::enquo(key) value = rlang::enquo(value) if (!requireNamespace("tidyr", quietly = TRUE)) stop("tidyr required: install first?") class(data) <- setdiff(class(data), "sf") st_as_sf(tidyr::gather(data, !!key, !!value, ..., na.rm = na.rm, convert = convert, factor_key = factor_key), sf_column_name = attr(data, "sf_column")) } #' @name tidyverse #' @param data see original function docs #' @param cols see original function docs #' @param names_to,names_pattern,names_ptypes,names_transform see [tidyr::pivot_longer()] #' @param values_to,values_drop_na,values_ptypes,values_transform See [tidyr::pivot_longer()] pivot_longer.sf <- function (data, cols, names_to = "name", names_prefix = NULL, names_sep = NULL, names_pattern = NULL, names_ptypes = NULL, names_transform = NULL, names_repair = "check_unique", values_to = "value", values_drop_na = FALSE, values_ptypes = NULL, values_transform = NULL, ...) { sf_column_name = attr(data, "sf_column") data = as.data.frame(data) # instead of: # st_as_sf(NextMethod(), sf_column_name = sf_column_name) # we avoid NextMethod(); for the reason # see https://github.com/tidyverse/tidyr/issues/1171: if (!requireNamespace("tidyr", quietly = TRUE)) stop("tidyr required: install first?") out <- tidyr::pivot_longer( data = data, cols = {{ cols }}, names_to = names_to, names_prefix = names_prefix, names_sep = names_sep, names_pattern = names_pattern, names_ptypes = names_ptypes, names_transform = names_transform, names_repair = names_repair, values_to = values_to, values_drop_na = values_drop_na, values_ptypes = values_ptypes, values_transform = values_transform, ... ) st_as_sf(out, sf_column_name = sf_column_name) } globalVariables(c("name", "value")) # https://github.com/r-spatial/sf/issues/1915 #' @name tidyverse #' @param id_cols,id_expand,names_from,names_sort,names_glue,names_vary,names_expand see [tidyr::pivot_wider()] # names_prefix,names_sep and names_repair are shared between pivot_longer() and pivot_wider() #' @param names_prefix,names_sep,names_repair see original function docs. #' @param values_from,values_fill,values_fn,unused_fn see [tidyr::pivot_wider()] pivot_wider.sf = function(data, ..., id_cols = NULL, id_expand = FALSE, names_from = name, names_prefix = "", names_sep = "_", names_glue = NULL, names_sort = FALSE, names_vary = "fastest", names_expand = FALSE, names_repair = "check_unique", values_from = value, values_fill = NULL, values_fn = NULL, unused_fn = NULL) { agr = st_agr(data) sf_column_name = attr(data, "sf_column") data = as.data.frame(data) if (!requireNamespace("tidyr", quietly = TRUE)) stop("tidyr required: install first?") ret = tidyr::pivot_wider( data = data, ..., id_cols = {{ id_cols }}, id_expand = id_expand, names_from = {{ names_from }}, names_prefix = names_prefix, names_sep = names_sep, names_glue = names_glue, names_sort = names_sort, names_vary = names_vary, names_expand = names_expand, names_repair = names_repair, values_from = {{ values_from }}, values_fill = values_fill, values_fn = values_fn, unused_fn = unused_fn ) st_as_sf(ret, sf_column_name = sf_column_name, agr = agr) } #' @name tidyverse #' @param fill see original function docs #' @param drop see original function docs #' @examples #' if (require(tidyr, quietly = TRUE) && require(dplyr, quietly = TRUE) && "geometry" %in% names(nc)) { #' nc$row = 1:100 # needed for spread to work #' nc |> select(SID74, SID79, geometry, row) |> #' gather("VAR", "SID", -geometry, -row) |> #' spread(VAR, SID) |> head() #' } spread.sf <- function(data, key, value, fill = NA, convert = FALSE, drop = TRUE, sep = NULL) { if (!requireNamespace("rlang", quietly = TRUE)) stop("rlang required: install first?") key = rlang::enquo(key) value = rlang::enquo(value) class(data) <- setdiff(class(data), "sf") st_as_sf(tidyr::spread(data, !!key, !!value, fill = fill, convert = convert, drop = drop, sep = sep), sf_column_name = attr(data, "sf_column")) } #' @name tidyverse #' @param tbl see original function docs #' @param size see original function docs #' @param replace see original function docs #' @param weight see original function docs #' @param .env see original function docs sample_n.sf <- function(tbl, size, replace = FALSE, weight = NULL, .env = parent.frame()) { st_sf(NextMethod(), sf_column_name = attr(tbl, "sf_column")) } #' @name tidyverse sample_frac.sf <- function(tbl, size = 1, replace = FALSE, weight = NULL, .env = parent.frame()) { st_sf(NextMethod(), sf_column_name = attr(tbl, "sf_column")) } #' @name tidyverse #' @param .tbl see original function docs #' @param .keep see original function docs group_split.sf <- function(.tbl, ..., .keep = TRUE) { class(.tbl) = setdiff(class(.tbl), "sf") if (inherits(.tbl, "rowwise_df")) { lapply(dplyr::group_split(.tbl, ...), st_as_sf) } else { lapply(dplyr::group_split(.tbl, ..., .keep = .keep), st_as_sf) } } #' @name tidyverse #' @examples #' if (require(tidyr, quietly = TRUE) && require(dplyr, quietly = TRUE)) { #' storms.sf = st_as_sf(storms, coords = c("long", "lat"), crs = 4326) #' x <- storms.sf |> group_by(name, year) |> nest() #' trs = lapply(x$data, function(tr) st_cast(st_combine(tr), "LINESTRING")[[1]]) |> #' st_sfc(crs = 4326) #' trs.sf = st_sf(x[,1:2], trs) #' plot(trs.sf["year"], axes = TRUE) #' } #' @details \code{nest} assumes that a simple feature geometry list-column was among the columns that were nested. nest.sf = function(.data, ...) { if (!requireNamespace("rlang", quietly = TRUE)) stop("rlang required: install first?") if (!requireNamespace("tidyr", quietly = TRUE)) stop("tidyr required: install first?") class(.data) <- setdiff(class(.data), "sf") ret = tidyr::nest(.data, ...) lst = which(sapply(ret, inherits, "list"))[1] # re-sf: ret[[lst]] = lapply(ret[[lst]], st_as_sf, sf_column_name = attr(.data, "sf_column")) ret } #' @name tidyverse #' @param col see \link[tidyr]{separate} #' @param into see \link[tidyr]{separate} #' @param remove see \link[tidyr]{separate} #' @param extra see \link[tidyr]{separate} separate.sf = function(data, col, into, sep = "[^[:alnum:]]+", remove = TRUE, convert = FALSE, extra = "warn", fill = "warn", ...) { if (!requireNamespace("rlang", quietly = TRUE)) stop("rlang required: install first?") col = rlang::enquo(col) if (!requireNamespace("tidyr", quietly = TRUE)) stop("tidyr required: install first?") class(data) <- setdiff(class(data), "sf") st_as_sf(tidyr::separate(data, !!col, into = into, sep = sep, remove = remove, convert = convert, extra = extra, fill = fill, ...), sf_column_name = attr(data, "sf_column")) } #' @name tidyverse #' @param sep see \link[tidyr]{separate_rows} #' @param convert see \link[tidyr]{separate_rows} separate_rows.sf <- function(data, ..., sep = "[^[:alnum:]]+", convert = FALSE) { if (!requireNamespace("tidyr", quietly = TRUE)) stop("tidyr required: install first?") class(data) <- setdiff(class(data), "sf") ret = tidyr::separate_rows(data, ..., sep = sep, convert = convert) st_as_sf(ret, sf_column_name = attr(data, "sf_column")) } #' @name tidyverse unite.sf <- function(data, col, ..., sep = "_", remove = TRUE) { class(data) <- setdiff(class(data), "sf") if (!requireNamespace("rlang", quietly = TRUE)) stop("rlang required: install first?") col = rlang::enquo(col) st_as_sf(tidyr::unite(data, !!col, ..., sep = sep, remove = remove), sf_column_name = attr(data, "sf_column")) } #' @name tidyverse #' @param .preserve see \link[tidyr:nest]{unnest} unnest.sf = function(data, ..., .preserve = NULL) { # nocov start sf_column_name = attr(data, "sf_column", exact = TRUE) if (!requireNamespace("tidyr", quietly = TRUE)) stop("unnest requires tidyr; install that first") class(data) = setdiff(class(data), "sf") st_sf(NextMethod(), sf_column_name = sf_column_name) # nocov end } #' @name tidyverse drop_na.sf <- function(x, ...) { sf_column_name = attr(x, "sf_column") class(x) <- setdiff(class(x), "sf") st_as_sf(NextMethod(), sf_column_name = sf_column_name) } ## tibble methods: ------- #' Summarize simple feature type for tibble #' #' Summarize simple feature type / item for tibble #' @param x object of class `sfc` #' @param ... ignored #' @name tibble #' @details see \link[pillar]{type_sum} type_sum.sfc <- function(x, ...) { cls = substring(class(x)[1], 5) u = st_crs(x)$ud_unit if (!is.null(u)) # add [units]: cls = paste0(cls, " [", enc2utf8(as.character(units(u))), "]") cls } #' @rdname tibble obj_sum.sfc <- function(x) { vapply(x, function(sfg) format(sfg, width = 15L), "") } #' @rdname tibble pillar_shaft.sfc <- function(x, ...) { digits = options("pillar.sigfig")$pillar.sigfig if (is.null(digits)) digits = options("digits")$digits out <- format(x, width = 100, digits = digits, ...) if (!inherits(x, "sfc_GEOMETRY") && !inherits(x, "sfc_GEOMETRYCOLLECTION")) out <- sub("[A-Z]+ ", "", out) pillar::new_pillar_shaft_simple(out, align = "right", min_width = 25) } #nocov start register_all_s3_methods = function() { s3_register("dplyr::dplyr_reconstruct", "sf") s3_register("dplyr::anti_join", "sf") s3_register("dplyr::arrange", "sf") s3_register("dplyr::count", "sf") s3_register("dplyr::distinct", "sf") s3_register("dplyr::filter", "sf") s3_register("dplyr::full_join", "sf") s3_register("dplyr::group_by", "sf") s3_register("dplyr::group_split", "sf") s3_register("dplyr::inner_join", "sf") s3_register("dplyr::left_join", "sf") s3_register("dplyr::mutate", "sf") s3_register("dplyr::rename", "sf") s3_register("dplyr::rename_with", "sf") s3_register("dplyr::right_join", "sf") s3_register("dplyr::rowwise", "sf") s3_register("dplyr::sample_frac", "sf") s3_register("dplyr::sample_n", "sf") s3_register("dplyr::select", "sf") s3_register("dplyr::semi_join", "sf") s3_register("dplyr::slice", "sf") s3_register("dplyr::summarise", "sf") s3_register("dplyr::transmute", "sf") s3_register("dplyr::ungroup", "sf") s3_register("tidyr::drop_na", "sf") s3_register("tidyr::gather", "sf") s3_register("tidyr::pivot_longer", "sf") s3_register("tidyr::pivot_wider", "sf") s3_register("tidyr::spread", "sf") s3_register("tidyr::nest", "sf") s3_register("tidyr::separate", "sf") s3_register("tidyr::separate_rows", "sf") s3_register("tidyr::unite", "sf") s3_register("tidyr::unnest", "sf") s3_register("pillar::obj_sum", "sfc") s3_register("pillar::type_sum", "sfc") s3_register("pillar::pillar_shaft", "sfc") s3_register("spatstat.geom::as.ppp", "sfc") s3_register("spatstat.geom::as.ppp", "sf") s3_register("spatstat.geom::as.owin", "POLYGON") s3_register("spatstat.geom::as.owin", "MULTIPOLYGON") s3_register("spatstat.geom::as.owin", "sfc_POLYGON") s3_register("spatstat.geom::as.owin", "sfc_MULTIPOLYGON") s3_register("spatstat.geom::as.owin", "sfc") s3_register("spatstat.geom::as.owin", "sf") s3_register("spatstat.geom::as.psp", "LINESTRING") s3_register("spatstat.geom::as.psp", "MULTILINESTRING") s3_register("spatstat.geom::as.psp", "sfc_MULTILINESTRING") s3_register("spatstat.geom::as.psp", "sfc") s3_register("spatstat.geom::as.psp", "sf") s3_register("s2::as_s2_geography", "sfg") s3_register("s2::as_s2_geography", "sfc") s3_register("s2::as_s2_geography", "sf") register_vctrs_methods() } # nocov end ================================================ FILE: R/transform.R ================================================ chk_pol = function(x, dim = class(x)[1]) { PolClose = function(y) { if (any(head(y[[1]], 1) != tail(y[[1]], 1))) # close y[[1]] = rbind(y[[1]], head(y[[1]], 1)) else if (nrow(y[[1]]) == 3) # closed, but line return(st_polygon(dim = dim)) y } if (length(x) > 0 && nrow(x[[1]]) > 2) PolClose(x) else st_polygon(dim = dim) } chk_mpol = function(x) { cln = lapply(x, function(y) unclass(chk_pol(y, class(x)[1]))) empty = if (length(cln)) lengths(cln) == 0 else TRUE # print(empty) st_multipolygon(cln[!empty], dim = class(x)[1]) } sanity_check = function(x) { d = st_dimension(x) # flags empty geoms as NA if (any(d == 2, na.rm = TRUE)) { # the polygon stuff x = st_cast(x[d == 2]) # convert GEOMETRY to POLYGON or MULTIPOLYGON, if possible if (inherits(x, "sfc_POLYGON")) st_sfc(lapply(x, chk_pol), crs = st_crs(x)) else if (inherits(x, "sfc_MULTIPOLYGON")) st_sfc(lapply(x, chk_mpol), crs = st_crs(x)) else stop(paste("no check implemented for", class(x)[1])) } else x # nocov } #' @export #' @name st_transform #' @param src source crs #' @param dst destination crs #' @details \code{st_can_transform} returns a boolean indicating whether #' coordinates with CRS src can be transformed into CRS dst st_can_transform = function(src, dst) { CPL_can_transform(st_crs(src), st_crs(dst)) } #' Transform or convert coordinates of simple feature #' #' Transform or convert coordinates of simple feature #' #' @param x object of class sf, sfc or sfg #' @param crs target coordinate reference system: object of class `crs`, or input string for \link{st_crs} #' @param ... ignored #' @param aoi area of interest, in degrees: #' WestLongitude, SouthLatitude, EastLongitude, NorthLatitude #' @param pipeline character; coordinate operation pipeline, for overriding the default operation #' @param reverse boolean; has only an effect when \code{pipeline} is defined: #' if \code{TRUE}, the inverse operation of the pipeline is applied #' @param desired_accuracy numeric; Only coordinate operations that offer an accuracy of #' at least the one specified will be considered; a negative value disables this feature #' (requires GDAL >= 3.3) #' @param allow_ballpark logical; are ballpark (low accuracy) transformations allowed? #' (requires GDAL >= 3.3) #' @param partial logical; allow for partial projection, if not all points of a geometry can be projected (corresponds to setting environment variable \code{OGR_ENABLE_PARTIAL_REPROJECTION} to \code{TRUE}) #' @param check logical; if \code{TRUE}, perform a sanity check on resulting polygons #' @details Transforms coordinates of object to new projection. #' Features that cannot be transformed are returned as empty geometries. #' Transforms using the \code{pipeline=} argument may fail if there is #' ambiguity in the axis order of the specified coordinate reference system; #' if you need the traditional GIS order, use \code{"OGC:CRS84"}, not #' \code{"EPSG:4326"}. Extra care is needed with the ESRI Shapefile format, #' because WKT1 does not store axis order unambiguously. #' #' @seealso \link[lwgeom]{st_transform_proj}, part of package lwgeom. #' #' \link{sf_project} projects a matrix of coordinates, bypassing GDAL altogether #' @examples #' p1 = st_point(c(7,52)) #' p2 = st_point(c(-30,20)) #' sfc = st_sfc(p1, p2, crs = 4326) #' sfc #' st_transform(sfc, 3857) #' @export st_transform = function(x, crs, ...) UseMethod("st_transform") #' @name st_transform #' @export #' @examples #' st_transform(st_sf(a=2:1, geom=sfc), "EPSG:3857") #' if (compareVersion(sf_extSoftVersion()["GDAL"], "3.0.0") >= 0) { #' st_transform(sfc, pipeline = #' "+proj=pipeline +step +proj=axisswap +order=2,1") # reverse axes #' st_transform(sfc, pipeline = #' "+proj=pipeline +step +proj=axisswap +order=2,1", reverse = TRUE) # also reverse axes #' } st_transform.sfc = function(x, crs = st_crs(x), ..., aoi = numeric(0), pipeline = character(0), reverse = FALSE, desired_accuracy = -1.0, allow_ballpark = TRUE, partial = TRUE, check = FALSE) { stopifnot(is.character(pipeline), length(pipeline) %in% 0:1) crs_missing = missing(crs) if (length(pipeline) == 0) { if (is.na(st_crs(x))) stop("cannot transform sfc object with missing crs") if (missing(crs)) stop("argument crs cannot be missing") } else stopifnot(length(pipeline) == 1) crs_input = crs crs = make_crs(crs) if (crs_parameters(crs)$is_geocentric && length(x) && Dimension(x[[1]]) == "XY") # add z: x = st_zm(x, drop = FALSE, what = "Z") if (partial) { orig = Sys.getenv("OGR_ENABLE_PARTIAL_REPROJECTION") if (orig != "") on.exit(Sys.setenv(OGR_ENABLE_PARTIAL_REPROJECTION = orig)) Sys.setenv(OGR_ENABLE_PARTIAL_REPROJECTION = "TRUE") } if (length(pipeline)) { if (!crs_missing) { # verify pipeline is a legitimate option: if (!(pipeline %in% sf_proj_pipelines(st_crs(x), crs)$definition)) { warning("pipeline not found in PROJ-suggested candidate transformations; setting crs = NA") crs = NA_crs_ } } else crs = NA_crs_ # to avoid st_crs(x) is crs of the returned object } ret = st_sfc(structure(CPL_transform(x, crs, aoi, pipeline, reverse, desired_accuracy, allow_ballpark), single_type = NULL, crs = crs)) # hard-sets crs to new crs if (check) sanity_check(ret) else ret } #' @name st_transform #' @export #' @examples #' nc = st_read(system.file("shape/nc.shp", package="sf")) #' st_area(nc[1,]) # area from long/lat #' st_area(st_transform(nc[1,], 32119)) # NC state plane, m #' st_area(st_transform(nc[1,], 2264)) # NC state plane, US foot #' library(units) #' set_units(st_area(st_transform(nc[1,], 2264)), m^2) st_transform.sf = function(x, crs = st_crs(x), ...) { x[[ attr(x, "sf_column") ]] = if (missing(crs)) st_transform(st_geometry(x), ...) else st_transform(st_geometry(x), crs = crs, ...) x } #' @name st_transform #' @export #' @details The \code{st_transform} method for \code{sfg} objects assumes that the CRS of the object is available as an attribute of that name. #' @examples #' st_transform(structure(p1, proj4string = "EPSG:4326"), "EPSG:3857") st_transform.sfg = function(x, crs = st_crs(x), ...) { x = st_sfc(x, crs = attr(x, "proj4string")) if (missing(crs)) stop("argument crs cannot be missing") crs = make_crs(crs) structure(st_transform(x, crs = crs, ...)[[1]], crs = crs) } #' @name st_transform #' @export #' @param densify integer, number of points for discretizing lines between bounding box corner points; see Details #' @details the method for `bbox` objects densifies lines for geographic coordinates along Cartesian lines, not great circle arcs st_transform.bbox = function(x, crs, ..., densify = 21) { if (compareVersion(sf_extSoftVersion()["GDAL"], "3.4.0") >= 0) st_bbox(CPL_transform_bounds(x, st_crs(crs), densify), crs = crs) else stop("method not available for GDAL: ", sf_extSoftVersion()["GDAL"]) } #' @name st_transform #' @export st_wrap_dateline = function(x, options, quiet) UseMethod("st_wrap_dateline") #' @name st_transform #' @param options character; should have "WRAPDATELINE=YES" to function; another parameter that is used is "DATELINEOFFSET=10" (where 10 is the default value) #' @param quiet logical; print options after they have been parsed? #' @export #' @examples #' st_wrap_dateline(st_sfc(st_linestring(rbind(c(-179,0),c(179,0))), crs = 4326)) #' @details For a discussion of using \code{options}, see \url{https://github.com/r-spatial/sf/issues/280} and \url{https://github.com/r-spatial/sf/issues/1983} #' @seealso \link{st_break_antimeridian} st_wrap_dateline.sfc = function(x, options = "WRAPDATELINE=YES", quiet = TRUE) { if (is.na(st_crs(x))) warning("crs not set: assuming geographic coordinates") else stopifnot(st_is_longlat(x)) stopifnot(is.character(options)) stopifnot(is.logical(quiet), length(quiet) == 1) st_sfc(CPL_wrap_dateline(x, options, quiet), crs = st_crs(x)) } #' @name st_transform #' @export st_wrap_dateline.sf = function(x, options = "WRAPDATELINE=YES", quiet = TRUE) { st_set_geometry(x, st_sfc(CPL_wrap_dateline(st_geometry(x), options, quiet), crs = st_crs(x))) } #' @name st_transform #' @export st_wrap_dateline.sfg = function(x, options = "WRAPDATELINE=YES", quiet = TRUE) { st_sfc(CPL_wrap_dateline(st_geometry(x), options, quiet), crs = st_crs(x))[[1]] } ================================================ FILE: R/valid.R ================================================ #' @name valid #' @param NA_on_exception logical; if TRUE, for polygons that would otherwise raise a GEOS error (exception, e.g. for a POLYGON having more than zero but less than 4 points, or a LINESTRING having one point) return an \code{NA} rather than raising an error, and suppress warning messages (e.g. about self-intersection); if FALSE, regular GEOS errors and warnings will be emitted. #' @param reason logical; if \code{TRUE}, return a character with, for each geometry, the reason for invalidity, \code{NA} on exception, or \code{"Valid Geometry"} otherwise. #' @return \code{st_is_valid} returns a logical vector indicating for each geometries of \code{x} whether it is valid. \code{st_make_valid} returns an object with a topologically valid geometry. #' @export #' @examples #' p1 = st_as_sfc("POLYGON((0 0, 0 10, 10 0, 10 10, 0 0))") #' st_is_valid(p1) #' st_is_valid(st_sfc(st_point(0:1), p1[[1]]), reason = TRUE) st_is_valid = function(x, ...) UseMethod("st_is_valid") #' @export #' @name valid st_is_valid.sfc = function(x, ..., NA_on_exception = TRUE, reason = FALSE) { if (sf_use_s2() && isTRUE(st_is_longlat(x))) { if (reason) { r = s2::s2_is_valid_detail(x) r$reason[r$is_valid] = "Valid Geometry" r$reason } else s2::s2_is_valid(x) } else if (reason) { if (NA_on_exception) { ret = rep(NA_character_, length(x)) not_na = !is.na(st_is_valid(x, reason = FALSE)) ret[not_na] = CPL_geos_is_valid_reason(x[not_na]) ret } else CPL_geos_is_valid_reason(x) } else CPL_geos_is_valid(x, as.logical(NA_on_exception)) } #' @export #' @name valid st_is_valid.sf = function(x, ...) { st_is_valid(st_geometry(x), ...) } #' @name valid #' @export st_is_valid.sfg = function(x, ...) { st_is_valid(st_geometry(x), ...) } #' Check validity or make an invalid geometry valid #' #' Checks whether a geometry is valid, or makes an invalid geometry valid #' @name valid #' @param x object of class \code{sfg}, \code{sfc} or \code{sf} #' @return Object of the same class as \code{x} #' @details For projected geometries, \code{st_make_valid} uses the \code{lwgeom_makevalid} method also used by the PostGIS command \code{ST_makevalid} if the GEOS version linked to is smaller than 3.8.0, and otherwise the version shipped in GEOS; for geometries having ellipsoidal coordinates \code{s2::s2_rebuild} is being used. #' @examples #' library(sf) #' x = st_sfc(st_polygon(list(rbind(c(0,0),c(0.5,0),c(0.5,0.5),c(0.5,0),c(1,0),c(1,1),c(0,1),c(0,0))))) #' suppressWarnings(st_is_valid(x)) #' y = st_make_valid(x) #' st_is_valid(y) #' y |> st_cast() #' @export st_make_valid = function(x, ...) UseMethod("st_make_valid") #' @export #' @name valid st_make_valid.sfg = function(x, ...) { st_make_valid(st_geometry(x), ...)[[1]] } #' @name valid #' @export #' @param ... passed on to \link[s2]{s2_options} #' @param oriented logical; only relevant if \code{st_is_longlat(x)} is \code{TRUE}; see \link{s2} #' @param s2_options only relevant if \code{st_is_longlat(x)} is \code{TRUE}; options for \link[s2]{s2_rebuild}, see \link[s2]{s2_options} and Details. #' @param geos_method character; either "valid_linework" (Original method, combines all rings into a set of noded lines and then extracts valid polygons from that linework) or "valid_structure" (Structured method, first makes all rings valid then merges shells and subtracts holes from shells to generate valid result. Assumes that holes and shells are correctly categorized.) (requires GEOS >= 3.10.1) #' @param geos_keep_collapsed logical; When this parameter is not set to \code{FALSE}, the "valid_structure" method will keep any component that has collapsed into a lower dimensionality. For example, a ring collapsing to a line, or a line collapsing to a point (requires GEOS >= 3.10.1) #' @details if \code{s2_options} is not specified and \code{x} has a non-zero precision set, then this precision value will be used as the value in \code{s2_snap_precision}, passed on to \code{s2_options}, rather than the 1e7 default. st_make_valid.sfc = function(x, ..., oriented = FALSE, s2_options = s2::s2_options(snap = s2::s2_snap_precision(1e7), ...), geos_method = "valid_structure", geos_keep_collapsed = TRUE) { crs = st_crs(x) if (sf_use_s2() && isTRUE(st_is_longlat(x))) { if (!missing(geos_method) || !missing(geos_keep_collapsed)) warning("arguments geos_method and geos_keep_collapsed are ignored for geodetic coordinates as sf_use_s2() is TRUE") s2 = s2::as_s2_geography(st_as_binary(st_set_precision(x, 0.0)), oriented = oriented, check = FALSE) if (st_precision(x) != 0 && missing(s2_options)) s2_options = s2::s2_options(snap = s2::s2_snap_precision(st_precision(x)), ...) full = st_is_full(x) # workaround, see https://github.com/r-spatial/s2/issues/262 s2 = s2::s2_rebuild(s2, s2_options) ret = st_as_sfc(s2, crs = crs) ret[full] = st_polygon(list(POLYGON_FULL)) ret } else if (compareVersion(CPL_geos_version(), "3.8.0") == -1) { if (!missing(geos_method) || !missing(geos_keep_collapsed)) warning("ignoring arguments geos_method and geos_keep_collapsed, as these require GEOS >= 3.8.0") if (!requireNamespace("lwgeom", quietly = TRUE)) stop("package lwgeom required, please install it first") # nocov st_sfc(lwgeom::lwgeom_make_valid(x), crs = crs) } else st_sfc(CPL_geos_make_valid(x, geos_method, geos_keep_collapsed), crs = crs) } #' @export st_make_valid.sf = function(x, ...) { st_set_geometry(x, st_make_valid(st_geometry(x), ...)) } ================================================ FILE: R/wkb.R ================================================ # convert character string, as typically PostgreSQL returned blobs, to raw vector; # skips a leading "0x", as this is created by PostGIS when using ST_asBinary() # # most wkb read/write stuff was modified & extended from Ian Cook's wkb package, # https://cran.r-project.org/web/packages/wkb/index.html # hex_to_raw = function(y) { stopifnot((nchar(y) %% 2) == 0) if (startsWith(y, "0x")) y = substr(y, 3, nchar(y)) as.raw(as.numeric(paste0("0x", vapply(seq_len(nchar(y)/2), function(x) substr(y, (x-1)*2+1, x*2), "")))) # SLOW, hence the Rcpp implementation } skip0x = function(x) { if (is.na(x)) "010700000000000000" # empty GeometryCollection, st_as_binary(st_geometrycollection()) else if (startsWith(x, "0x")) substr(x, 3, nchar(x)) else x } #' @name st_as_sfc #' @param EWKB logical; if `TRUE`, parse as EWKB (extended WKB; PostGIS: ST_AsEWKB), otherwise as ISO WKB (PostGIS: ST_AsBinary) #' @param spatialite logical; if \code{TRUE}, WKB is assumed to be in the spatialite dialect, see \url{https://www.gaia-gis.it/gaia-sins/BLOB-Geometry.html}; this is only supported in native endian-ness (i.e., files written on system with the same endian-ness as that on which it is being read). #' @param pureR logical; if `TRUE`, use only R code, if `FALSE`, use compiled (C++) code; use `TRUE` when the endian-ness of the binary differs from the host machine (\code{.Platform$endian}). #' @details When converting from WKB, the object \code{x} is either a character vector such as typically obtained from PostGIS (either with leading "0x" or without), or a list with raw vectors representing the features in binary (raw) form. #' @examples #' wkb = structure(list("01010000204071000000000000801A064100000000AC5C1441"), class = "WKB") #' st_as_sfc(wkb, EWKB = TRUE) #' wkb = structure(list("0x01010000204071000000000000801A064100000000AC5C1441"), class = "WKB") #' st_as_sfc(wkb, EWKB = TRUE) #' @export st_as_sfc.WKB = function(x, ..., EWKB = FALSE, spatialite = FALSE, pureR = FALSE, crs = NA_crs_) { if (EWKB && spatialite) stop("arguments EWKB and spatialite cannot both be TRUE") if (spatialite && pureR) stop("pureR implementation for spatialite reading is not available") if (all(vapply(x, is.character, TRUE))) { x <- if (pureR) structure(lapply(x, hex_to_raw), class = "WKB") else structure(CPL_hex_to_raw(vapply(x, skip0x, USE.NAMES = FALSE, "")), class = "WKB") } else # direct call with raw: stopifnot(inherits(x, "WKB"), vapply(x, is.raw, TRUE)) # WKB as raw if (any(lengths(x) == 0)) stop("cannot read WKB object from zero-length raw vector") ret = if (pureR) R_read_wkb(x, readWKB, EWKB = EWKB) else CPL_read_wkb(x, EWKB, spatialite) if (is.na(crs) && (EWKB || spatialite) && !is.null(attr(ret, "srid")) && attr(ret, "srid") != 0) crs = attr(ret, "srid") if (! is.na(st_crs(crs))) { attr(ret, "srid") = NULL # remove st_sfc(ret, crs = crs) } else st_sfc(ret) # leave attr srid in place: PostGIS srid that is not an EPSG code } #' @export #' @examples #' st_as_sfc(st_as_binary(st_sfc(st_point(0:1)))[[1]], crs = 4326) #' @name st_as_sfc st_as_sfc.raw = function(x, ...) { st_as_sfc(structure(list(x), class = "WKB"), ...) } R_read_wkb = function(x, readWKB, EWKB = EWKB) { ret = lapply(x, readWKB, EWKB = EWKB) srid = attr(ret[[1]], "srid") ret = lapply(ret, function(x) { attr(x, "srid") = NULL; x }) attr(ret, "srid") = srid ret } sf.tp = toupper(c( # "Geometry", # 0 "Point", # 1 "LineString", # 2 "Polygon", # 3 "MultiPoint", # 4 "MultiLineString", # 5 "MultiPolygon", # 6 "GeometryCollection", # 7 "CircularString", # 8 x "CompoundCurve", # 9 x "CurvePolygon", # 10 x "MultiCurve", # 11 x "MultiSurface", # 12 x "Curve", # 13 x * "Surface", # 14 x * "PolyhedralSurface", # 15 "TIN", # 16 "Triangle" # 17 )) # "Geometry" = 0, should not be matched, is a superclass only # x: not described in ISO document # *: GDAL support see https://trac.osgeo.org/gdal/ticket/6401 readWKB = function(x, EWKB = FALSE) { stopifnot(inherits(x, "raw")) rc <- rawConnection(x, "r") on.exit(close(rc)) seek(rc, 0L) # read data: readData(rc, EWKB = EWKB) } parseTypeEWKB = function(wkbType, endian) { # following the OGC doc, 3001 is POINT with ZM; turns out, PostGIS does sth else - # read WKB, as well as EWKB; this post is more inormative of what is going on: # https://lists.osgeo.org/pipermail/postgis-devel/2004-December/000710.html # (without SRID, Z, M and ZM this all doesn't matter) # comparison ISO WKB and EWKB: # https://lists.osgeo.org/pipermail/postgis-devel/2004-December/000695.html stopifnot(length(wkbType) == 4) if (endian == "little") { sf_type = as.numeric(wkbType[1]) info = as.raw(as.integer(wkbType[4]) %/% 2^4) } else { sf_type = as.numeric(wkbType[4]) info = as.raw(as.integer(wkbType[1]) %/% 2^4) } tp = sf.tp[sf_type] stopifnot(!is.na(tp)) has_srid = as.logical(info & as.raw(2)) # 2-bit is "on"? zm = if ((info & as.raw(12)) == as.raw(12)) "XYZM" else if (info & as.raw(8)) "XYZ" else if (info & as.raw(4)) "XYM" else if (info == as.raw(0) || info == as.raw(2)) "XY" else stop(paste("unknown value for info:", info)) list(dims = nchar(zm), zm = zm, tp = tp, has_srid = has_srid) } parseTypeISO = function(wkbType) { tp = sf.tp[wkbType %% 1000] stopifnot(!is.na(tp)) dd = wkbType %/% 1000 zm = if (dd == 0) "XY" else if (dd == 1) "XYZ" else if (dd == 2) "XYM" else if (dd == 3) "XYZM" else stop(paste("unknown value for wkbType:", wkbType)) list(dims = nchar(zm), zm = zm, tp = tp, has_srid = FALSE) } readData = function(rc, EWKB = FALSE) { # read byte order: byteOrder <- readBin(rc, what = "raw", size = 1L) stopifnot(byteOrder %in% c(as.raw(0L), as.raw(1L))) endian = ifelse(byteOrder == as.raw(1L), "little", "big") # read wkbType: srid = NA_integer_ if (EWKB) { wkbType <- readBin(rc, what = "raw", n = 4L, size = 1L, endian = endian) pt <- parseTypeEWKB(wkbType, endian) if (pt$has_srid) srid <- readBin(rc, what = "integer", size = 4L, endian = endian) } else { wkbType <- readBin(rc, what = "integer", n = 1L, size = 4L, endian = endian) pt <- parseTypeISO(wkbType) } # read data part: ret = switch(pt$tp, POINT = readPoint(rc, pt$dims, endian), CURVE = , CIRCULARSTRING = , LINESTRING = readMatrix(rc, pt$dims, endian), SURFACE = , POLYGON = , TRIANGLE = readMatrixList(rc, pt$dims, endian), MULTIPOINT = readMPoints(rc, pt$dims, endian, EWKB), MULTILINESTRING = , MULTICURVE = , MULTIPOLYGON = , MULTISURFACE = , POLYHEDRALSURFACE = , TIN = lapply(readGC(rc, pt$dims, endian, EWKB), unclass), GEOMETRYCOLLECTION = readGC(rc, pt$dims, endian, EWKB), CURVEPOLYGON = readGC(rc, pt$dims, endian, EWKB), stop(paste("type", pt$tp, "unsupported"))) class(ret) <- c(pt$zm, pt$tp, "sfg") if (!is.na(srid)) attr(ret, "srid") <- srid ret } readPoint = function(rc, dims, endian) { readBin(rc, what = "double", n = as.integer(dims), size = 8L, endian = endian) } readMPoints = function(rc, dims, endian, EWKB) { npts = readBin(rc, what = "integer", n = 1L, size = 4L, endian = endian) do.call(rbind, lapply(seq_len(npts), function(x) readData(rc, EWKB))) } readMatrix = function(rc, dims, endian) { npts = readBin(rc, what = "integer", n = 1L, size = 4L, endian = endian) m = readBin(rc, what = "double", n = as.integer(npts * dims), size = 8L, endian = endian) t(matrix(m, nrow = dims)) # x1 y1, x2 y2 etc -> t() } readMatrixList = function(rc, dims, endian) { nmtrx = readBin(rc, what = "integer", n = 1L, size = 4L, endian = endian) lapply(seq_len(nmtrx), function(x) readMatrix(rc, dims, endian)) } #readMatrixListList = function(rc, dims, endian) { # nmtrxl = readBin(rc, what = "integer", n = 1L, size = 4L, endian = endian) # lapply(seq_len(nmtrxl), function(x) readMatrixList(rc, dims, endian)) #} readGC = function(rc, dims, endian, EWKB) { ngc = readBin(rc, what = "integer", n = 1L, size = 4L, endian = endian) lapply(seq_len(ngc), function(x) readData(rc, EWKB)) } #' Convert sfc object to an WKB object #' #' Convert sfc object to an WKB object #' @param x object to convert #' @param ... ignored #' @name st_as_binary #' @export st_as_binary = function(x, ...) UseMethod("st_as_binary") #' @name st_as_binary #' @param endian character; either "big" or "little"; default: use that of platform #' @param EWKB logical; use EWKB (PostGIS), or (default) ISO-WKB? #' @param pureR logical; use pure R solution, or C++? #' @param precision numeric; if zero, do not modify; to reduce precision: negative values convert to float (4-byte real); positive values convert to round(x*precision)/precision. See details. #' @param hex logical; return as (unclassed) hexadecimal encoded character vector? #' @param srid integer; override srid (can be used when the srid is unavailable locally). #' @details \code{st_as_binary} is called on sfc objects on their way to the GDAL or GEOS libraries, and hence does rounding (if requested) on the fly before e.g. computing spatial predicates like \link{st_intersects}. The examples show a round-trip of an \code{sfc} to and from binary. #' #' For the precision model used, see also \url{https://locationtech.github.io/jts/javadoc/org/locationtech/jts/geom/PrecisionModel.html}. There, it is written that: ``... to specify 3 decimal places of precision, use a scale factor of 1000. To specify -3 decimal places of precision (i.e. rounding to the nearest 1000), use a scale factor of 0.001.''. Note that ALL coordinates, so also Z or M values (if present) are affected. #' @export #' @examples #' # examples of setting precision: #' st_point(c(1/3, 1/6)) |> st_sfc(precision = 1000) |> st_as_binary() |> st_as_sfc() #' st_point(c(1/3, 1/6)) |> st_sfc(precision = 100) |> st_as_binary() |> st_as_sfc() #' st_point(1e6 * c(1/3, 1/6)) |> st_sfc(precision = 0.01) |> st_as_binary() |> st_as_sfc() #' st_point(1e6 * c(1/3, 1/6)) |> st_sfc(precision = 0.001) |> st_as_binary() |> st_as_sfc() st_as_binary.sfc = function(x, ..., EWKB = FALSE, endian = .Platform$endian, pureR = FALSE, precision = attr(x, "precision"), hex = FALSE) { stopifnot(endian %in% c("big", "little")) if (pureR && precision != 0.0) stop("for non-zero precision values, use pureR = FALSE") ret = if (pureR) structure(lapply(x, st_as_binary.sfg, EWKB = EWKB, pureR = pureR, endian = endian), class = "WKB") else { stopifnot(endian == .Platform$endian) attr(x, "precision") = precision structure(CPL_write_wkb(x, EWKB), class = "WKB") } if (hex) vapply(ret, CPL_raw_to_hex, "") else ret } createType = function(x, endian, EWKB = FALSE) { dims = x[1] # "XY", "XYZ", "XYM", or "XYZM" cl = x[2] m = match(cl, sf.tp) if (is.na(m)) stop(paste("Class", cl, "not matched")) # return: if (! EWKB) # ISO: add 1000s as.integer(m + switch(dims, "XYZ" = 1000, "XYM" = 2000, "XYZM" = 3000, 0)) else { # EWKB: set higher bits ret = raw(4) ret[1] = as.raw(m) # set up little-endian ret[4] = as.raw(switch(dims, "XYZ" = 0x80, "XYM" = 0x40, "XYZM" = 0xC0, 0)) if (endian == "big") rev(ret) else ret } } #' @name st_as_binary #' @export st_as_binary.sfg = function(x, ..., endian = .Platform$endian, EWKB = FALSE, pureR = FALSE, hex = FALSE, srid = 0) { # if pureR, it's done here, if not, it's done in st_as_binary.sfc stopifnot(endian %in% c("big", "little")) if (! pureR) st_as_binary.sfc(st_sfc(x), endian == endian, EWKB = EWKB, pureR = pureR, hex = hex, srid = srid, ...)[[1]] else { rc <- rawConnection(raw(0), "r+") on.exit(close(rc)) writeData(x, rc, endian, EWKB) r = rawConnectionValue(rc) if (hex) r = rawToHex(r) r } } #' Convert raw vector(s) into hexadecimal character string(s) #' #' Convert raw vector(s) into hexadecimal character string(s) #' @param x raw vector, or list with raw vectors #' @export rawToHex = function(x) { if (is.raw(x)) CPL_raw_to_hex(x) else if (is.list(x) && all(vapply(x, is.raw, TRUE))) vapply(x, function(rw) CPL_raw_to_hex(rw), "") else stop(paste("not implemented for objects of class", class(x))) } writeData = function(x, rc, endian, EWKB = FALSE) { if (endian == "big") writeBin(as.raw(0L), rc) else writeBin(as.raw(1L), rc) if (EWKB) writeBin(createType(class(x), endian, TRUE), rc, size = 1L, endian = endian) else writeBin(createType(class(x)), rc, size = 4L, endian = endian) # TODO (?): write SRID in case of EWKB? # write out x: switch(class(x)[2], POINT = writeBin(as.vector(as.double(x)), rc, size = 8L, endian = endian), LINESTRING = writeMatrix(x, rc, endian), POLYGON = , TRIANGLE = writeMatrixList(x, rc, endian), MULTIPOINT = writeMPoints(x, rc, endian, EWKB), POLYHEDRALSURFACE = , TIN = , MULTILINESTRING = , MULTIPOLYGON = writeMulti(x, rc, endian, EWKB), GEOMETRYCOLLECTION = writeGC(x, rc, endian, EWKB), stop(paste("unimplemented class to write:", class(x)[2])) ) } writeMulti = function(x, rc, endian, EWKB) { unMulti = if (inherits(x, "MULTILINESTRING")) st_linestring else # MULTIPOLYGON, POLYHEDRALSURFACE, TIN: st_polygon writeBin(as.integer(length(x)), rc, size = 4L, endian = endian) lapply(lapply(x, unMulti, class(x)[1]), writeData, rc = rc, endian = endian, EWKB = EWKB) } writeGC = function(x, rc, endian, EWKB) { writeBin(as.integer(length(x)), rc, size = 4L, endian = endian) lapply(x, writeData, rc = rc, endian = endian, EWKB = EWKB) } writeMatrix = function(x, rc, endian) { writeBin(as.integer(nrow(x)), rc, size = 4L, endian = endian) writeBin(as.double(as.vector(t(x))), rc, size = 8L, endian = endian) } writeMatrixList = function(x, rc, endian) { writeBin(as.integer(length(x)), rc, size = 4L, endian = endian) lapply(x, function(y) writeMatrix(y, rc, endian)) } writeMPoints = function(x, rc, endian, EWKB) { writeBin(as.integer(nrow(x)), rc, size = 4L, endian = endian) if (nrow(x)) apply(x, 1, function(y) writeData(st_point(y, class(x)[1]), rc, endian, EWKB)) } ================================================ FILE: R/wkt.R ================================================ # composed, WKT class name: "XYZ", "POINT" -> "POINT Z" WKT_name = function(x, EWKT = TRUE) { cls = class(x) zm = substr(cls[1], 3, 4) retval = if (zm == "") cls[2] else paste(cls[2], substr(cls[1], 3, 4)) if (EWKT && !is.null(attr(x, "epsg")) && !is.na(attr(x, "epsg"))) paste0("SRID=", attr(x, "epsg"), ";", retval) else retval } empty = "EMPTY" # skip leading white space; ... passes on digits: fmt = function(x, ...) sub("^[ ]+", "", sapply(unclass(x), format, ...)) # print helper functions prnt.POINT = function(x, ..., EWKT = TRUE) { pt = if (any(!is.finite(x))) empty else paste0("(", paste0(fmt(x, ...), collapse = " "), ")") paste(WKT_name(x, EWKT = EWKT), pt) } prnt.Matrix = function(x, nested_parens = FALSE, ...) { pf = function(x, ..., collapse) paste0(fmt(x, ...), collapse = collapse) if (nrow(x) == 0) empty else if (nested_parens) paste0("((", paste0(apply(x, 1, pf, collapse = " ", ...), collapse = "), ("), "))") else paste0("(", paste0(apply(x, 1, pf, collapse = " ", ...), collapse = ", "), ")") } prnt.MatrixList = function(x, ...) { if (length(x) == 0) empty else paste0("(", paste0(unlist(lapply(x, prnt.Matrix, ...)), collapse = ", "), ")") } prnt.MatrixListList = function(x, ...) { if (length(x) == 0) empty else paste0("(", paste0(unlist(lapply(x, prnt.MatrixList, ...)), collapse = ", "), ")") } prnt.MULTIPOINT = function(x, ..., EWKT = TRUE, nested_parens = FALSE) { paste(WKT_name(x, EWKT = EWKT), prnt.Matrix(x, nested_parens = nested_parens, ...)) } prnt.LINESTRING = function(x, ..., EWKT = TRUE) paste(WKT_name(x, EWKT = EWKT), prnt.Matrix(x, ...)) prnt.POLYGON = function(x, ..., EWKT = TRUE) { if (st_is_full(x, ...)) "POLYGON FULL" else paste(WKT_name(x, EWKT = EWKT), prnt.MatrixList(x, ...)) } prnt.MULTILINESTRING = function(x, ..., EWKT = TRUE) paste(WKT_name(x, EWKT = EWKT), prnt.MatrixList(x, ...)) prnt.MULTIPOLYGON = function(x, ..., EWKT = TRUE) paste(WKT_name(x, EWKT = EWKT), prnt.MatrixListList(x, ...)) prnt.GEOMETRYCOLLECTION = function(x, ..., EWKT = TRUE) { body = if (length(x) == 0) empty else paste0("(", paste0(vapply(x, st_as_text, "", ...), collapse=", "), ")") paste(WKT_name(x, EWKT = EWKT), body) } #' Return Well-known Text representation of simple feature geometry or coordinate reference system #' #' Return Well-known Text representation of simple feature geometry or coordinate reference system #' @param x object of class \code{sfg}, \code{sfc} or \code{crs} #' @param ... modifiers; in particular \code{digits} can be passed to control the number of digits used #' @name st_as_text #' @details The returned WKT representation of simple feature geometry conforms to the #' \href{https://en.wikipedia.org/wiki/Simple_Features}{simple features access} specification and extensions #' (known as EWKT, supported by PostGIS and other simple features implementations for addition of #' a SRID to a WKT string). #' @note To improve conversion performance, the lwgeom package can be used (it must be installed #' beforehand) and set the \code{Sys.setenv("LWGEOM_WKT" = "true")} environment variable. This #' will also result in faster printing of complex geometries. Note that the representation as WKT is #' different from the sf package and may cause reproducibility problems. An alternative solution is #' to use the [lwgeom::st_astext()] or [wk::as_wkt()] functions. #' #' @export st_as_text = function(x, ...) UseMethod("st_as_text") #' @name st_as_text #' @export #' @examples #' st_as_text(st_point(1:2)) #' st_as_text(st_sfc(st_point(c(-90,40)), crs = 4326), EWKT = TRUE) st_as_text.sfg = function(x, ...) { if (Sys.getenv("LWGEOM_WKT") == "true" && requireNamespace("lwgeom", quietly = TRUE) && utils::packageVersion("lwgeom") >= "0.1-5") lwgeom::st_astext(x, ...) else switch(class(x)[2], POINT = prnt.POINT(x, ...), MULTIPOINT = prnt.MULTIPOINT(x, ..., nested_parens = TRUE), LINESTRING = prnt.LINESTRING(x, ...), POLYGON = prnt.POLYGON(x, ...), MULTILINESTRING = prnt.MULTILINESTRING(x, ...), MULTIPOLYGON = prnt.MULTIPOLYGON(x, ...), GEOMETRYCOLLECTION =prnt.GEOMETRYCOLLECTION(x, ...), CIRCULARSTRING = prnt.MULTIPOINT(x, ...), COMPOUNDCURVE = prnt.GEOMETRYCOLLECTION(x, ...), CURVE = prnt.MULTIPOINT(x, ...), CURVEPOLYGON = prnt.GEOMETRYCOLLECTION(x, ...), MULTICURVE = prnt.GEOMETRYCOLLECTION(x, ...), MULTISURFACE = prnt.GEOMETRYCOLLECTION(x, ...), POLYHEDRALSURFACE = prnt.MULTIPOLYGON(x, ...), TRIANGLE = prnt.POLYGON(x, ...), TIN = prnt.MULTIPOLYGON(x, ...), stop(paste("no print method available for object of class", class(x)[2])) # nocov ) } #' @name st_as_text #' @param EWKT logical; if TRUE, print SRID=xxx; before the WKT string if \code{epsg} is available #' @export st_as_text.sfc = function(x, ..., EWKT = FALSE) { if (Sys.getenv("LWGEOM_WKT") == "true" && requireNamespace("lwgeom", quietly = TRUE) && utils::packageVersion("lwgeom") >= "0.1-5") lwgeom::st_astext(x, ..., EWKT = EWKT) else { if (EWKT) { epsg = attr(x, "crs")$epsg if (!is.na(epsg) && epsg != 0) x = lapply(x, function(sfg) structure(sfg, epsg = epsg)) } vapply(x, st_as_text, "", ..., EWKT = EWKT) } } #' @name st_as_sfc #' @rdname st_as_sfc #' @md #' @details If `x` is a character vector, it should be a vector containing #' [well-known-text](https://www.ogc.org/standards/wkt-crs/), or #' Postgis EWKT or GeoJSON representations of a single geometry for each vector element. #' @param crs integer or character; coordinate reference system for the #' @param GeoJSON logical; if \code{TRUE}, try to read geometries from GeoJSON text strings #' geometry, see [st_crs()] #' @export #' @examples #' st_as_sfc("SRID=3978;LINESTRING(1663106 -105415,1664320 -104617)") st_as_sfc.character = function(x, crs = NA_integer_, ..., GeoJSON = FALSE) { if (length(x) == 0) st_sfc(crs = crs) else if (GeoJSON) { ret = st_geometry(do.call(rbind, lapply(x, st_read, quiet = TRUE))) if (is.na(st_crs(ret))) st_set_crs(ret, crs) else ret } else { if (all(is_ewkt(x)) && is.na(crs)) { # EWKT crs = get_crs_ewkt(x) crs = unique(crs) if (length(crs) != 1) { stop("sf does not support multiple crs (", paste(crs, collapse = ", "), ") within a single geometry column.", "You can override the crs from the string by using the ", "`crs` option from `st_as_sfc()`.", call. = FALSE) } x = ewkt_to_wkt(x) } if (sf_use_s2() && !identical(st_is_longlat(crs), FALSE) && any(full <- (x == "POLYGON FULL"))) x[full] = "POLYGON((0 -90,0 -90))" # s2 struct for POLYGON FULL ret = st_sfc(CPL_sfc_from_wkt(x)) st_crs(ret) = crs ret } } #' @name st_as_sfc #' @details If \code{x} is a \code{factor}, it is converted to \code{character}. #' @export st_as_sfc.factor = function(x, ...) { st_as_sfc(as.character(x), ...) } is_ewkt = function(x) { grepl("^SRID=(\\d+);", x) } get_crs_ewkt = function(x) { as.numeric(gsub("^SRID=(\\d+);.+$", "\\1", x)) } ewkt_to_wkt = function(x) { gsub("^SRID=(\\d+);(.+)$", "\\2", x) } ================================================ FILE: R/z_range.R ================================================ #' @name st_z_range #' @param x object of class \code{z_range} #' @export is.na.z_range = function(x) identical(x, NA_z_range_) zb_wrap = function(zb) { stopifnot(is.numeric(zb), length(zb) == 2) structure(zb, names = c("zmin", "zmax"), class = "z_range") } z_range.Set = function(obj, ...) { sel = vapply(obj, function(x) { length(x) && !all(is.na(x)) }, TRUE) if (! any(sel)) NA_z_range_ else zb_wrap(CPL_get_z_range(unclass(obj)[sel], 0)) } z_range.Mtrx = function(obj, ...) { if (length(obj) == 0) NA_z_range_ else zb_wrap(CPL_get_z_range(list(obj), 1)) # note the list() } z_range.MtrxSet = function(obj, ...) { if (length(obj) == 0) NA_z_range_ else zb_wrap(CPL_get_z_range(obj, 1)) } z_range.MtrxSetSet = function(obj, ...) { if (length(obj) == 0) NA_z_range_ else zb_wrap(CPL_get_z_range(obj, 2)) } z_range.MtrxSetSetSet = function(obj, ...) { if (length(obj) == 0) NA_z_range_ else zb_wrap(CPL_get_z_range(obj, 3)) } #' Return 'z' range of a simple feature or simple feature set #' #' Return 'z' range of a simple feature or simple feature set #' @param obj object to compute the z range from #' @param ... ignored #' @export #' @return a numeric vector of length two, with \code{zmin} and \code{zmax} values; #' if \code{obj} is of class \code{sf} or \code{sfc} the object #' returned has a class \code{z_range} #' @name st_z_range #' @examples #' a = st_sf(a = 1:2, geom = st_sfc(st_point(0:2), st_point(1:3)), crs = 4326) #' st_z_range(a) st_z_range = function(obj, ...) UseMethod("st_z_range") #' @export #' @name st_z_range st_z_range.POINT = function(obj, ...) zb_wrap(c(obj[3L], obj[3L])) #' @export #' @name st_z_range st_z_range.MULTIPOINT = z_range.Mtrx #' @export #' @name st_z_range st_z_range.LINESTRING = z_range.Mtrx #' @export #' @name st_z_range st_z_range.POLYGON = z_range.MtrxSet #' @export #' @name st_z_range st_z_range.MULTILINESTRING = z_range.MtrxSet #' @export #' @name st_z_range st_z_range.MULTIPOLYGON = z_range.MtrxSetSet z_range_list = function(obj, ...) { s = vapply(obj, st_z_range, c(0.,0.)) # dispatch on class if (length(s) == 0 || all(is.na(s[1L,]))) NA_z_range_ else zb_wrap(c(min(s[1L,], na.rm = TRUE), max(s[2L,], na.rm = TRUE))) } #' @name st_z_range #' @export st_z_range.GEOMETRYCOLLECTION = z_range_list #' @name st_z_range #' @export st_z_range.MULTISURFACE = z_range_list #' @name st_z_range #' @export st_z_range.MULTICURVE = z_range_list #' @name st_z_range #' @export st_z_range.CURVEPOLYGON = z_range_list #' @name st_z_range #' @export st_z_range.COMPOUNDCURVE = z_range_list #' @name st_z_range #' @export st_z_range.POLYHEDRALSURFACE = z_range.MtrxSetSet #' @name st_z_range #' @export st_z_range.TIN = z_range.MtrxSetSet #' @name st_z_range #' @export st_z_range.TRIANGLE = z_range.MtrxSet #' @name st_z_range #' @export st_z_range.CIRCULARSTRING = function(obj, ...) { # this is of course wrong: st_z_range(st_cast(obj, "LINESTRING")) # nocov } #' @export print.z_range = function(x, ...) { x = structure(x, crs = NULL, class = NULL) # nocov print(set_units(x, attr(x, "units"), mode = "standard")) # nocov } compute_z_range = function(obj) { switch(class(obj)[1], sfc_POINT = zb_wrap(z_range.Set(obj)), sfc_MULTIPOINT = zb_wrap(z_range.MtrxSet(obj)), sfc_LINESTRING = zb_wrap(z_range.MtrxSet(obj)), sfc_POLYGON = zb_wrap(z_range.MtrxSetSet(obj)), sfc_MULTILINESTRING = zb_wrap(z_range.MtrxSetSet(obj)), sfc_MULTIPOLYGON = zb_wrap(z_range.MtrxSetSetSet(obj)), z_range_list(obj) ) } #' @name st_z_range #' @export st_z_range.sfc = function(obj, ...) { a = attr(obj, "z_range") if(is.null(a)) return( NULL ) ## TODO return null? structure(a, crs = st_crs(obj)) } #' @name st_z_range #' @export st_z_range.sf = function(obj, ...) st_z_range(st_geometry(obj)) #' @name st_z_range #' @param crs object of class \code{crs}, or argument to \link{st_crs}, specifying the CRS of this bounding box. #' @examples #' st_z_range(c(zmin = 16.1, zmax = 16.6), crs = st_crs(4326)) #' @export st_z_range.numeric = function(obj, ..., crs = NA_crs_) { structure(zb_wrap(obj[c("zmin", "zmax")]), crs = st_crs(crs)) # nocov } #' @export st_z_range.z_range = function(obj, ...) obj # nocov #' @export "$.z_range" = function(x, name) { # nocov start switch(name, zmin = x["zmin"], zmax = x["zmax"], stop("unsupported name") ) } # nocov end #' @name st_z_range #' @details \code{NA_z_range_} represents the missing value for a \code{z_range} object #' @export NA_z_range_ = structure(rep(NA_real_, 2), names = c("zmin", "zmax"), crs = NA_crs_, class = "z_range") ================================================ FILE: README.md ================================================ [![R-CMD-check](https://github.com/r-spatial/sf/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/r-spatial/sf/actions/workflows/R-CMD-check.yaml) [![tic-db](https://github.com/r-spatial/sf/actions/workflows/tic-db.yml/badge.svg)](https://github.com/r-spatial/sf/actions/workflows/tic-db.yml) [![Coverage Status](https://img.shields.io/codecov/c/github/r-spatial/sf/main.svg)](https://app.codecov.io/gh/r-spatial/sf) [![License](http://img.shields.io/badge/license-GPL%20%28%3E=%202%29-brightgreen.svg?style=flat)](http://www.gnu.org/licenses/gpl-2.0.html) [![CRAN](https://www.r-pkg.org/badges/version/sf)](https://cran.r-project.org/package=sf) [![cran checks](https://badges.cranchecks.info/worst/sf.svg)](https://cran.r-project.org/web/checks/check_results_sf.html) [![Downloads](https://cranlogs.r-pkg.org/badges/sf?color=brightgreen)](https://www.r-pkg.org/pkg/sf) [![status](https://tinyverse.netlify.app/badge/sf)](https://CRAN.R-project.org/package=sf) # Simple Features for R A package that provides [simple features access](https://en.wikipedia.org/wiki/Simple_Features) for R. [Blogs, links](#blogs-presentations-vignettes-sp-sf-wiki) • [Cheatsheet](#cheatsheet) • [Installing](#installing) • [Contributing](#contributing) • [Acknowledgment](#acknowledgment) • [How to cite](#how-to-cite) Package sf: * represents simple features as records in a `data.frame` or `tibble` with a geometry list-column * represents natively in R all 17 simple feature types for all dimensions (XY, XYZ, XYM, XYZM) * interfaces to [GEOS](https://libgeos.org) for geometrical operations on projected coordinates, and (through R package [s2](https://cran.r-project.org/package=s2)) to [s2geometry](http://s2geometry.io/) for geometrical operations on ellipsoidal coordinates * interfaces to [GDAL](https://gdal.org/), supporting all driver options, `Date` and `POSIXct` and list-columns * interfaces to [PRØJ](http://proj.org/) for coordinate reference system conversion and transformation * uses [well-known-binary](https://en.wikipedia.org/wiki/Well-known_text#Well-known_binary) serialisations written in C++/Rcpp for fast I/O with GDAL and GEOS * reads from and writes to spatial databases such as [PostGIS](http://postgis.net/) using [DBI](https://cran.r-project.org/package=DBI) * is extended by * [lwgeom](https://github.com/r-spatial/lwgeom/) for selected liblwgeom/PostGIS functions * [stars](https://github.com/r-spatial/stars/) for raster data, and raster or vector data cubes (spatial time series) * [sfnetworks](https://luukvdmeer.github.io/sfnetworks/) for geospatial network data (Illustration (c) 2018 by Allison Horst) ## Books, journal articles, blogs, presentations, vignettes, sp-sf wiki * an open access [R Journal article](https://journal.r-project.org/archive/2018/RJ-2018-009/index.html) summarizes the package * two books: [Spatial Data Science: with applications in R](https://r-spatial.org/book/), [Geocomputation with R](https://r.geocompx.org/) * package vignettes: [first](https://r-spatial.github.io/sf/articles/sf1.html), [second](https://r-spatial.github.io/sf/articles/sf2.html), [third](https://r-spatial.github.io/sf/articles/sf3.html), [fourth](https://r-spatial.github.io/sf/articles/sf4.html), [fifth](https://r-spatial.github.io/sf/articles/sf5.html), [sixth](https://r-spatial.github.io/sf/articles/sf6.html), [seventh](https://r-spatial.github.io/sf/articles/sf7.html) * blog posts: [first](https://r-spatial.org/r/2016/02/15/simple-features-for-r.html), [second](https://r-spatial.org/r/2016/07/18/sf2.html), [third](https://r-spatial.org/r/2016/11/02/sfcran.html), [fourth](https://r-spatial.org/r/2017/01/12/newssf.html) * the original R Consortium ISC [proposal](PROPOSAL.md), the R Consortium [blog post](https://www.r-consortium.org/blog/2017/01/03/simple-features-now-on-cran) * presentations: [rstudio::conf 2018](https://edzer.github.io/rstudio_conf/#1) ([video](https://posit.co/resources/videos/tidy-spatial-data-analysis/)), [UseR! 2016](http://pebesma.staff.ifgi.de/pebesma_sfr.pdf) * wiki page describing [sp-sf migration](https://github.com/r-spatial/sf/wiki/Migrating) ## Cheatsheet [CC 4.0](https://creativecommons.org/licenses/by/4.0/) BY [Ryan Garnett](https://github.com/ryangarnett) ## Installing Install either from CRAN with: ```r install.packages("sf") ``` This will install binary packages on Windows and MacOS, unless you configured R such that it tries to install source packages; in that case, see below. Install development versions from GitHub with: ```r library(remotes) install_github("r-spatial/sf") ``` ### Windows Installing sf from source works under Windows when [Rtools](https://cran.r-project.org/bin/windows/Rtools/) is installed. ### MacOS MacOS users are strongly encouraged to install the `sf` binary packages from CRAN, unless they are familiar with compilers, linking, C++ source code, and homebrew. If you experience that R tries to install `sf` from source (or otherwise your install fails but you don't understand what is going on) try again by explicitly installing the binary, using ```r install.packages("sf", type = "binary") ``` The remainder of this section is for those who understand what source installs mean, and imply. Perhaps the easiest way of an install from source is to first install `gdal` using Homebrew. Recent versions of Homebrew include a full-featured up-to-date [gdal formula](https://github.com/Homebrew/homebrew-core/blob/master/Formula/g/gdal.rb), which installs `proj` and `gdal` at the same time: ``` brew install pkg-config brew install gdal ``` Once gdal is installed, you may be able to install `sf` package from source in R. With the current version of `proj` on homebrew, installation requires additional configuration: ```r install.packages("sf", type = "source", configure.args = "--with-proj-lib=$(brew --prefix)/lib/") ``` Or the development version: ```r library(remotes) install_github("r-spatial/sf", configure.args = "--with-proj-lib=$(brew --prefix)/lib/") ``` Alternatively, [these instructions](https://stat.ethz.ch/pipermail/r-sig-mac/2017-June/012429.html) explain how to install gdal using kyngchaos frameworks. For Mac OS 11 Big Sur source install instruction, see [here](https://github.com/r-spatial/sf/issues/1536#issuecomment-727342736) ### Linux For Unix-alikes, GDAL (>= 2.0.1), GEOS (>= 3.4.0) and PROJ (>= 4.8.0) are required. #### Ubuntu Dependencies for recent versions of Ubuntu (18.04 and later) are available in the official repositories; you can install them with: ```sh sudo apt -y update && apt install -y libudunits2-dev libgdal-dev libgeos-dev libproj-dev libsqlite3-dev ``` However, to get more up-to-date versions of dependencies such as GDAL, GEOS and PROJ we recommend adding the [ubuntugis-unstable](http://ppa.launchpad.net/ubuntugis/ubuntugis-unstable/ubuntu/) PPA to the package repositories and installing them as follows: ```sh sudo add-apt-repository ppa:ubuntugis/ubuntugis-unstable sudo apt update sudo apt install libudunits2-dev libgdal-dev libgeos-dev libproj-dev libsqlite3-dev ``` Adding this PPA is required for installing `sf` on older versions of Ubuntu (e.g. Xenial). Another option, for advanced users, is to install dependencies from source; see e.g. an older [Travis](https://github.com/r-spatial/sf/blob/593ee48b34001fe3b383ea73ea57063ecf690732/.travis.yml) config file for hints. #### Fedora The following command installs all required dependencies: ```sh sudo dnf install gdal-devel proj-devel geos-devel sqlite-devel udunits2-devel ``` #### Arch Get gdal, proj, geos and podofo from the main repos, and udunits from the AUR: ``` pacman -S gdal proj geos arrow podofo yay/pacaur/yaourt/whatever -S udunits ``` #### `renv` or `conda` There are several reports that `sf` fails to install as a source package when R is used with `renv`, or when R is installed in a `conda` environment. If you experience this, please only raise an issue here if the problem persists without `renv` or `conda`, and otherwise * try to sort this out with the `renv` developers or the `conda` maintainers, or * try to use binary installs of the `sf` package, e.g. from [r2u](https://github.com/eddelbuettel/r2u), or the Posit package manager #### Other To install on Debian, the [rocker geospatial](https://github.com/rocker-org/geospatial) Dockerfiles may be helpful. Ubuntu Dockerfiles are found [here](https://github.com/r-spatial/sf/tree/main/inst/docker). ### Support for (Geo)Parquet and Arrow `sf` links to GDAL, but does not control how GDAL was configured and built. Not every GDAL installation has built-in support for GeoParquet or Arrow. Please see [this issue](https://github.com/r-spatial/sf/issues/2585), or configure and compile GDAL with Parquet support e.g. using [this Dockerfile](https://github.com/r-spatial/sf/tree/main/inst/docker/parquet). ### Multiple GDAL, GEOS and/or PROJ versions on your system If you use dynamic linking (installation from source) and have multiple versions of these libraries installed (e.g. one from ubuntugis-unstable, another installed from source in `/usr/local/lib`) then this will in general not work, even when setting `LD_LIBRARY_PATH` manually. See [here](https://github.com/r-spatial/sf/issues/844) for the reason why. ### lwgeom Functions and methods that require `liblwgeom`, including ellipsoidal (not spherical or Euclidean) metrics (area, distances), are provided by and used from [lwgeom](https://github.com/r-spatial/lwgeom), which is also on [CRAN](https://cran.r-project.org/package=lwgeom). ## Contributing * Contributions of all sorts are most welcome, issues and pull requests are the preferred ways of sharing them. * When contributing pull requests, please adhere to the package style (in package code use `=` rather than `<-`; don't change indentation; tab stops of 4 spaces are preferred). * This project is released with a [Contributor Code of Conduct](CONDUCT.md). By participating in this project, you agree to abide by its terms. ## How to cite Package `sf` can be cited as: * Edzer Pebesma, 2018. Simple Features for R: Standardized Support for Spatial Vector Data. The R Journal [10:1, 439-446.](https://journal.r-project.org/archive/2018/RJ-2018-009/index.html) * Pebesma, E.; Bivand, R. (2023). [Spatial Data Science: With Applications in R](https://r-spatial.org/book/) (1st ed.). 314 pages. [Chapman and Hall/CRC](https://doi.org/10.1201/9780429459016). ## Acknowledgment This project gratefully acknowledges financial [support](https://www.r-consortium.org/projects) from the ================================================ FILE: _pkgdown.yml ================================================ url: https://r-spatial.github.io/sf/ template: bootstrap: 5 navbar: structure: left: [reference, articles, book, news] right: [search, github] components: book: text: Book href: https://r-spatial.org/book/ ================================================ FILE: cleanup ================================================ #!/bin/sh rm -fr src/Makevars config.log config.status autom4te.cache src/*.o src/*.so rm -fr vignette/nc* rm -fr proj_conf_test* rm -fr Rplots.pdf */Rplots.pdf ================================================ FILE: codecov.yml ================================================ comment: false ignore: - "inst/include/sf_RcppExports.h" - "sf/R/stars.R" - "sf/R/gdal_utils.R" - "sf/src/raster2sf.cpp" - "sf/src/gdal_utils.cpp" - "sf/src/stars.cpp" coverage: status: patch: default: target: 0 threshold: 100 project: default: target: 70 threshold: 100 ================================================ FILE: configure ================================================ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.71. # # # Copyright (C) 1992-1996, 1998-2017, 2020-2021 Free Software Foundation, # Inc. # # # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh as_nop=: if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else $as_nop case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi # Reset variables that may have inherited troublesome values from # the environment. # IFS needs to be set, to space, tab, and newline, in precisely that order. # (If _AS_PATH_WALK were called with IFS unset, it would have the # side effect of setting IFS to empty, thus disabling word splitting.) # Quoting is to prevent editors from complaining about space-tab. as_nl=' ' export as_nl IFS=" "" $as_nl" PS1='$ ' PS2='> ' PS4='+ ' # Ensure predictable behavior from utilities with locale-dependent output. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # We cannot yet rely on "unset" to work, but we need these variables # to be unset--not just set to an empty or harmless value--now, to # avoid bugs in old shells (e.g. pre-3.0 UWIN ksh). This construct # also avoids known problems related to "unset" and subshell syntax # in other old shells (e.g. bash 2.01 and pdksh 5.2.14). for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH do eval test \${$as_var+y} \ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : done # Ensure that fds 0, 1, and 2 are open. if (exec 3>&0) 2>/dev/null; then :; else exec 0&1) 2>/dev/null; then :; else exec 1>/dev/null; fi if (exec 3>&2) ; then :; else exec 2>/dev/null; fi # The user is always right. if ${PATH_SEPARATOR+false} :; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # Find who we are. Look in the path if we contain no directory separator. as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac test -r "$as_dir$0" && as_myself=$as_dir$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 exit 1 fi # Use a proper internal environment variable to ensure we don't fall # into an infinite loop, continuously re-executing ourselves. if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then _as_can_reexec=no; export _as_can_reexec; # We cannot yet assume a decent shell, so we have to provide a # neutralization value for shells without unset; and this also # works around shells that cannot unset nonexistent variables. # Preserve -v and -x to the replacement shell. BASH_ENV=/dev/null ENV=/dev/null (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV case $- in # (((( *v*x* | *x*v* ) as_opts=-vx ;; *v* ) as_opts=-v ;; *x* ) as_opts=-x ;; * ) as_opts= ;; esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail # out after a failed `exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi # We don't want this to propagate to other subprocesses. { _as_can_reexec=; unset _as_can_reexec;} if test "x$CONFIG_SHELL" = x; then as_bourne_compatible="as_nop=: if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which # is contrary to our usage. Disable this feature. alias -g '\${1+\"\$@\"}'='\"\$@\"' setopt NO_GLOB_SUBST else \$as_nop case \`(set -o) 2>/dev/null\` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi " as_required="as_fn_return () { (exit \$1); } as_fn_success () { as_fn_return 0; } as_fn_failure () { as_fn_return 1; } as_fn_ret_success () { return 0; } as_fn_ret_failure () { return 1; } exitcode=0 as_fn_success || { exitcode=1; echo as_fn_success failed.; } as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } if ( set x; as_fn_ret_success y && test x = \"\$1\" ) then : else \$as_nop exitcode=1; echo positional parameters were not saved. fi test x\$exitcode = x0 || exit 1 blah=\$(echo \$(echo blah)) test x\"\$blah\" = xblah || exit 1 test -x / || exit 1" as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1" if (eval "$as_required") 2>/dev/null then : as_have_required=yes else $as_nop as_have_required=no fi if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null then : else $as_nop as_save_IFS=$IFS; IFS=$PATH_SEPARATOR as_found=false for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac as_found=: case $as_dir in #( /*) for as_base in sh bash ksh sh5; do # Try only shells that exist, to save several forks. as_shell=$as_dir$as_base if { test -f "$as_shell" || test -f "$as_shell.exe"; } && as_run=a "$as_shell" -c "$as_bourne_compatible""$as_required" 2>/dev/null then : CONFIG_SHELL=$as_shell as_have_required=yes if as_run=a "$as_shell" -c "$as_bourne_compatible""$as_suggested" 2>/dev/null then : break 2 fi fi done;; esac as_found=false done IFS=$as_save_IFS if $as_found then : else $as_nop if { test -f "$SHELL" || test -f "$SHELL.exe"; } && as_run=a "$SHELL" -c "$as_bourne_compatible""$as_required" 2>/dev/null then : CONFIG_SHELL=$SHELL as_have_required=yes fi fi if test "x$CONFIG_SHELL" != x then : export CONFIG_SHELL # We cannot yet assume a decent shell, so we have to provide a # neutralization value for shells without unset; and this also # works around shells that cannot unset nonexistent variables. # Preserve -v and -x to the replacement shell. BASH_ENV=/dev/null ENV=/dev/null (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV case $- in # (((( *v*x* | *x*v* ) as_opts=-vx ;; *v* ) as_opts=-v ;; *x* ) as_opts=-x ;; * ) as_opts= ;; esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail # out after a failed `exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi if test x$as_have_required = xno then : printf "%s\n" "$0: This script requires a shell more modern than all" printf "%s\n" "$0: the shells that I found on your system." if test ${ZSH_VERSION+y} ; then printf "%s\n" "$0: In particular, zsh $ZSH_VERSION has bugs and should" printf "%s\n" "$0: be upgraded to zsh 4.3.4 or later." else printf "%s\n" "$0: Please tell bug-autoconf@gnu.org about your system, $0: including any error possibly output before this $0: message. Then install a modern shell, or manually run $0: the script under such a shell if you do have one." fi exit 1 fi fi fi SHELL=${CONFIG_SHELL-/bin/sh} export SHELL # Unset more variables known to interfere with behavior of common tools. CLICOLOR_FORCE= GREP_OPTIONS= unset CLICOLOR_FORCE GREP_OPTIONS ## --------------------- ## ## M4sh Shell Functions. ## ## --------------------- ## # as_fn_unset VAR # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exit STATUS # ----------------- # Exit the shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exit () { set +e as_fn_set_status $1 exit $1 } # as_fn_exit # as_fn_nop # --------- # Do nothing but, unlike ":", preserve the value of $?. as_fn_nop () { return $? } as_nop=as_fn_nop # as_fn_mkdir_p # ------------- # Create "$as_dir" as a directory, including parents if necessary. as_fn_mkdir_p () { case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" } # as_fn_mkdir_p # as_fn_executable_p FILE # ----------------------- # Test if FILE is an executable regular file. as_fn_executable_p () { test -f "$1" && test -x "$1" } # as_fn_executable_p # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null then : eval 'as_fn_append () { eval $1+=\$2 }' else $as_nop as_fn_append () { eval $1=\$$1\$2 } fi # as_fn_append # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # global $as_val. Take advantage of shells that can avoid forks. The arguments # must be portable across $(()) and expr. if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null then : eval 'as_fn_arith () { as_val=$(( $* )) }' else $as_nop as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` } fi # as_fn_arith # as_fn_nop # --------- # Do nothing but, unlike ":", preserve the value of $?. as_fn_nop () { return $? } as_nop=as_fn_nop # as_fn_error STATUS ERROR [LINENO LOG_FD] # ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the # script with STATUS, using 1 if that was 0. as_fn_error () { as_status=$1; test $as_status -eq 0 && as_status=1 if test "$4"; then as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi printf "%s\n" "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits as_lineno_1=$LINENO as_lineno_1a=$LINENO as_lineno_2=$LINENO as_lineno_2a=$LINENO eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { printf "%s\n" "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } # If we had to re-execute with $CONFIG_SHELL, we're ensured to have # already done that, so ensure we don't try to do so again and fall # in an infinite loop. This has already happened in practice. _as_can_reexec=no; export _as_can_reexec # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } # Determine whether it's possible to make 'echo' print without a newline. # These variables are no longer used directly by Autoconf, but are AC_SUBSTed # for compatibility with existing Makefiles. ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac # For backward compatibility with old third-party macros, we provide # the shell variables $as_echo and $as_echo_n. New code should use # AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively. as_echo='printf %s\n' as_echo_n='printf %s' rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null fi if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -pR' fi else as_ln_s='cp -pR' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p='mkdir -p "$as_dir"' else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_test_x='test -x' as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" test -n "$DJDIR" || exec 7<&0 &1 # Name of the host. # hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` # # Initializations. # ac_default_prefix=/usr/local ac_clean_files= ac_config_libobj_dir=. LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= # Identity of this package. PACKAGE_NAME='' PACKAGE_TARNAME='' PACKAGE_VERSION='' PACKAGE_STRING='' PACKAGE_BUGREPORT='' PACKAGE_URL='' ac_unique_file="src/wkb.cpp" # Factoring default headers for most tests. ac_includes_default="\ #include #ifdef HAVE_STDIO_H # include #endif #ifdef HAVE_STDLIB_H # include #endif #ifdef HAVE_STRING_H # include #endif #ifdef HAVE_INTTYPES_H # include #endif #ifdef HAVE_STDINT_H # include #endif #ifdef HAVE_STRINGS_H # include #endif #ifdef HAVE_SYS_TYPES_H # include #endif #ifdef HAVE_SYS_STAT_H # include #endif #ifdef HAVE_UNISTD_H # include #endif" ac_header_c_list= ac_subst_vars='LTLIBOBJS LIBOBJS GEOS_CONFIG PROJ_LIBS PROJ_CPPFLAGS SQLITE3_LIBS OBJEXT EXEEXT ac_ct_CC CPPFLAGS LDFLAGS CFLAGS CC PKG_LIBS PKG_CPPFLAGS GDAL_CONFIG target_alias host_alias build_alias LIBS ECHO_T ECHO_N ECHO_C DEFS mandir localedir libdir psdir pdfdir dvidir htmldir infodir docdir oldincludedir includedir runstatedir localstatedir sharedstatedir sysconfdir datadir datarootdir libexecdir sbindir bindir program_transform_name prefix exec_prefix PACKAGE_URL PACKAGE_BUGREPORT PACKAGE_STRING PACKAGE_VERSION PACKAGE_TARNAME PACKAGE_NAME PATH_SEPARATOR SHELL' ac_subst_files='' ac_user_opts=' enable_option_checking with_gdal_config with_data_copy with_proj_data with_sqlite3_lib with_proj_include with_proj_api with_proj_lib with_proj_share with_geos_config ' ac_precious_vars='build_alias host_alias target_alias CC CFLAGS LDFLAGS LIBS CPPFLAGS' # Initialize some variables set by options. ac_init_help= ac_init_version=false ac_unrecognized_opts= ac_unrecognized_sep= # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. # (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' runstatedir='${localstatedir}/run' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE}' infodir='${datarootdir}/info' htmldir='${docdir}' dvidir='${docdir}' pdfdir='${docdir}' psdir='${docdir}' libdir='${exec_prefix}/lib' localedir='${datarootdir}/locale' mandir='${datarootdir}/man' ac_prev= ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval $ac_prev=\$ac_option ac_prev= continue fi case $ac_option in *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *=) ac_optarg= ;; *) ac_optarg=yes ;; esac case $ac_dashdash$ac_option in --) ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=*) datadir=$ac_optarg ;; -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ | --dataroo | --dataro | --datar) ac_prev=datarootdir ;; -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid feature name: \`$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "enable_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval enable_$ac_useropt=no ;; -docdir | --docdir | --docdi | --doc | --do) ac_prev=docdir ;; -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) docdir=$ac_optarg ;; -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) ac_prev=dvidir ;; -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid feature name: \`$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "enable_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval enable_$ac_useropt=\$ac_optarg ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) ac_prev=htmldir ;; -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ | --ht=*) htmldir=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localedir | --localedir | --localedi | --localed | --locale) ac_prev=localedir ;; -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) localedir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst | --locals) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) ac_prev=pdfdir ;; -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) pdfdir=$ac_optarg ;; -psdir | --psdir | --psdi | --psd | --ps) ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -runstatedir | --runstatedir | --runstatedi | --runstated \ | --runstate | --runstat | --runsta | --runst | --runs \ | --run | --ru | --r) ac_prev=runstatedir ;; -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ | --run=* | --ru=* | --r=*) runstatedir=$ac_optarg ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid package name: \`$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "with_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval with_$ac_useropt=\$ac_optarg ;; -without-* | --without-*) ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid package name: \`$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "with_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval with_$ac_useropt=no ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) as_fn_error $? "unrecognized option: \`$ac_option' Try \`$0 --help' for more information" ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. case $ac_envvar in #( '' | [0-9]* | *[!_$as_cr_alnum]* ) as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; esac eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. printf "%s\n" "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && printf "%s\n" "$as_me: WARNING: invalid host type: $ac_option" >&2 : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` as_fn_error $? "missing argument to $ac_option" fi if test -n "$ac_unrecognized_opts"; then case $enable_option_checking in no) ;; fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; *) printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; esac fi # Check all directory arguments for consistency. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ libdir localedir mandir runstatedir do eval ac_val=\$$ac_var # Remove trailing slashes. case $ac_val in */ ) ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` eval $ac_var=\$ac_val;; esac # Be sure to have absolute directory names. case $ac_val in [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || as_fn_error $? "working directory cannot be determined" test "X$ac_ls_di" = "X$ac_pwd_ls_di" || as_fn_error $? "pwd does not report name of working directory" # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$as_myself" || $as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_myself" : 'X\(//\)[^/]' \| \ X"$as_myself" : 'X\(//\)$' \| \ X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$as_myself" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` srcdir=$ac_confdir if test ! -r "$srcdir/$ac_unique_file"; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" fi ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" ac_abs_confdir=`( cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" pwd)` # When building in place, set srcdir=. if test "$ac_abs_confdir" = "$ac_pwd"; then srcdir=. fi # Remove unnecessary trailing slashes from srcdir. # Double slashes in file names in object file debugging info # mess up M-x gdb in Emacs. case $srcdir in */) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; esac for ac_var in $ac_precious_vars; do eval ac_env_${ac_var}_set=\${${ac_var}+set} eval ac_env_${ac_var}_value=\$${ac_var} eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} eval ac_cv_env_${ac_var}_value=\$${ac_var} done # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF \`configure' configures this package to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking ...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] --docdir=DIR documentation root [DATAROOTDIR/doc/PACKAGE] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF _ACEOF fi if test -n "$ac_init_help"; then cat <<\_ACEOF Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-gdal-config=GDAL_CONFIG the location of gdal-config --with-data-copy=yes/no local copy of data directories in package, default no --with-proj-data=DIR location of PROJ data directory --with-sqlite3-lib=LIB_PATH the location of sqlite3 libraries --with-proj-include=DIR location of proj header files --with-proj-api=yes/no use the deprecated proj_api.h even when PROJ 6 is available; default no --with-proj-lib=LIB_PATH the location of proj libraries --with-proj-share=SHARE_PATH the location of proj metadata files --with-geos-config=GEOS_CONFIG the location of geos-config Some influential environment variables: CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory LIBS libraries to pass to the linker, e.g. -l CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if you have headers in a nonstandard directory Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to the package provider. _ACEOF ac_status=$? fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d "$ac_dir" || { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } # Check for configure.gnu first; this name is used for a wrapper for # Metaconfig's "Configure" on case-insensitive file systems. if test -f "$ac_srcdir/configure.gnu"; then echo && $SHELL "$ac_srcdir/configure.gnu" --help=recursive elif test -f "$ac_srcdir/configure"; then echo && $SHELL "$ac_srcdir/configure" --help=recursive else printf "%s\n" "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi || ac_status=$? cd "$ac_pwd" || { ac_status=$?; break; } done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF configure generated by GNU Autoconf 2.71 Copyright (C) 2021 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi ## ------------------------ ## ## Autoconf initialization. ## ## ------------------------ ## # ac_fn_c_try_compile LINENO # -------------------------- # Try to compile conftest.$ac_ext, and return whether this succeeded. ac_fn_c_try_compile () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack rm -f conftest.$ac_objext conftest.beam if { { ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_compile") 2>conftest.err ac_status=$? if test -s conftest.err; then grep -v '^ *+' conftest.err >conftest.er1 cat conftest.er1 >&5 mv -f conftest.er1 conftest.err fi printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext then : ac_retval=0 else $as_nop printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 fi eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_compile # ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES # ------------------------------------------------------- # Tests whether HEADER exists and can be compiled using the include files in # INCLUDES, setting the cache variable VAR accordingly. ac_fn_c_check_header_compile () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 printf %s "checking for $2... " >&6; } if eval test \${$3+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $4 #include <$2> _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "$3=yes" else $as_nop eval "$3=no" fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext fi eval ac_res=\$$3 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 printf "%s\n" "$ac_res" >&6; } eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_header_compile # ac_fn_c_try_link LINENO # ----------------------- # Try to link conftest.$ac_ext, and return whether this succeeded. ac_fn_c_try_link () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack rm -f conftest.$ac_objext conftest.beam conftest$ac_exeext if { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link") 2>conftest.err ac_status=$? if test -s conftest.err; then grep -v '^ *+' conftest.err >conftest.er1 cat conftest.er1 >&5 mv -f conftest.er1 conftest.err fi printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest$ac_exeext && { test "$cross_compiling" = yes || test -x conftest$ac_exeext } then : ac_retval=0 else $as_nop printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 fi # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would # interfere with the next link command; also delete a directory that is # left behind by Apple's compiler. We do this before executing the actions. rm -rf conftest.dSYM conftest_ipa8_conftest.oo eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_link ac_configure_args_raw= for ac_arg do case $ac_arg in *\'*) ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac as_fn_append ac_configure_args_raw " '$ac_arg'" done case $ac_configure_args_raw in *$as_nl*) ac_safe_unquote= ;; *) ac_unsafe_z='|&;<>()$`\\"*?[ '' ' # This string ends in space, tab. ac_unsafe_a="$ac_unsafe_z#~" ac_safe_unquote="s/ '\\([^$ac_unsafe_a][^$ac_unsafe_z]*\\)'/ \\1/g" ac_configure_args_raw=` printf "%s\n" "$ac_configure_args_raw" | sed "$ac_safe_unquote"`;; esac cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by $as_me, which was generated by GNU Autoconf 2.71. Invocation command line was $ $0$ac_configure_args_raw _ACEOF exec 5>>config.log { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` /usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac printf "%s\n" "PATH: $as_dir" done IFS=$as_save_IFS } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; 2) as_fn_append ac_configure_args1 " '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi as_fn_append ac_configure_args " '$ac_arg'" ;; esac done done { ac_configure_args0=; unset ac_configure_args0;} { ac_configure_args1=; unset ac_configure_args1;} # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Sanitize IFS. IFS=" "" $as_nl" # Save into config.log some information that might help in debugging. { echo printf "%s\n" "## ---------------- ## ## Cache variables. ## ## ---------------- ##" echo # The following way of writing the cache mishandles newlines in values, ( for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( *) { eval $ac_var=; unset $ac_var;} ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( *${as_nl}ac_space=\ *) sed -n \ "s/'\''/'\''\\\\'\'''\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" ;; #( *) sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo printf "%s\n" "## ----------------- ## ## Output variables. ## ## ----------------- ##" echo for ac_var in $ac_subst_vars do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac printf "%s\n" "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then printf "%s\n" "## ------------------- ## ## File substitutions. ## ## ------------------- ##" echo for ac_var in $ac_subst_files do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac printf "%s\n" "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then printf "%s\n" "## ----------- ## ## confdefs.h. ## ## ----------- ##" echo cat confdefs.h echo fi test "$ac_signal" != 0 && printf "%s\n" "$as_me: caught signal $ac_signal" printf "%s\n" "$as_me: exit $exit_status" } >&5 rm -f core *.core core.conftest.* && rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -f -r conftest* confdefs.h printf "%s\n" "/* confdefs.h */" > confdefs.h # Predefined preprocessor variables. printf "%s\n" "#define PACKAGE_NAME \"$PACKAGE_NAME\"" >>confdefs.h printf "%s\n" "#define PACKAGE_TARNAME \"$PACKAGE_TARNAME\"" >>confdefs.h printf "%s\n" "#define PACKAGE_VERSION \"$PACKAGE_VERSION\"" >>confdefs.h printf "%s\n" "#define PACKAGE_STRING \"$PACKAGE_STRING\"" >>confdefs.h printf "%s\n" "#define PACKAGE_BUGREPORT \"$PACKAGE_BUGREPORT\"" >>confdefs.h printf "%s\n" "#define PACKAGE_URL \"$PACKAGE_URL\"" >>confdefs.h # Let the site file select an alternate cache file if it wants to. # Prefer an explicitly selected file to automatically selected ones. if test -n "$CONFIG_SITE"; then ac_site_files="$CONFIG_SITE" elif test "x$prefix" != xNONE; then ac_site_files="$prefix/share/config.site $prefix/etc/config.site" else ac_site_files="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi for ac_site_file in $ac_site_files do case $ac_site_file in #( */*) : ;; #( *) : ac_site_file=./$ac_site_file ;; esac if test -f "$ac_site_file" && test -r "$ac_site_file"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 printf "%s\n" "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" \ || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "failed to load site script $ac_site_file See \`config.log' for more details" "$LINENO" 5; } fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special files # actually), so we avoid doing that. DJGPP emulates it as a regular file. if test /dev/null != "$cache_file" && test -f "$cache_file"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 printf "%s\n" "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . "$cache_file";; *) . "./$cache_file";; esac fi else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 printf "%s\n" "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Test code for whether the C compiler supports C89 (global declarations) ac_c_conftest_c89_globals=' /* Does the compiler advertise C89 conformance? Do not test the value of __STDC__, because some compilers set it to 0 while being otherwise adequately conformant. */ #if !defined __STDC__ # error "Compiler does not advertise C89 conformance" #endif #include #include struct stat; /* Most of the following tests are stolen from RCS 5.7 src/conf.sh. */ struct buf { int x; }; struct buf * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not \xHH hex character constants. These do not provoke an error unfortunately, instead are silently treated as an "x". The following induces an error, until -std is added to get proper ANSI mode. Curiously \x00 != x always comes out true, for an array size at least. It is necessary to write \x00 == 0 to get something that is true only with -std. */ int osf4_cc_array ['\''\x00'\'' == 0 ? 1 : -1]; /* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters inside strings and character constants. */ #define FOO(x) '\''x'\'' int xlc6_cc_array[FOO(a) == '\''x'\'' ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, int *(*)(struct buf *, struct stat *, int), int, int);' # Test code for whether the C compiler supports C89 (body of main). ac_c_conftest_c89_main=' ok |= (argc == 0 || f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]); ' # Test code for whether the C compiler supports C99 (global declarations) ac_c_conftest_c99_globals=' // Does the compiler advertise C99 conformance? #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L # error "Compiler does not advertise C99 conformance" #endif #include extern int puts (const char *); extern int printf (const char *, ...); extern int dprintf (int, const char *, ...); extern void *malloc (size_t); // Check varargs macros. These examples are taken from C99 6.10.3.5. // dprintf is used instead of fprintf to avoid needing to declare // FILE and stderr. #define debug(...) dprintf (2, __VA_ARGS__) #define showlist(...) puts (#__VA_ARGS__) #define report(test,...) ((test) ? puts (#test) : printf (__VA_ARGS__)) static void test_varargs_macros (void) { int x = 1234; int y = 5678; debug ("Flag"); debug ("X = %d\n", x); showlist (The first, second, and third items.); report (x>y, "x is %d but y is %d", x, y); } // Check long long types. #define BIG64 18446744073709551615ull #define BIG32 4294967295ul #define BIG_OK (BIG64 / BIG32 == 4294967297ull && BIG64 % BIG32 == 0) #if !BIG_OK #error "your preprocessor is broken" #endif #if BIG_OK #else #error "your preprocessor is broken" #endif static long long int bignum = -9223372036854775807LL; static unsigned long long int ubignum = BIG64; struct incomplete_array { int datasize; double data[]; }; struct named_init { int number; const wchar_t *name; double average; }; typedef const char *ccp; static inline int test_restrict (ccp restrict text) { // See if C++-style comments work. // Iterate through items via the restricted pointer. // Also check for declarations in for loops. for (unsigned int i = 0; *(text+i) != '\''\0'\''; ++i) continue; return 0; } // Check varargs and va_copy. static bool test_varargs (const char *format, ...) { va_list args; va_start (args, format); va_list args_copy; va_copy (args_copy, args); const char *str = ""; int number = 0; float fnumber = 0; while (*format) { switch (*format++) { case '\''s'\'': // string str = va_arg (args_copy, const char *); break; case '\''d'\'': // int number = va_arg (args_copy, int); break; case '\''f'\'': // float fnumber = va_arg (args_copy, double); break; default: break; } } va_end (args_copy); va_end (args); return *str && number && fnumber; } ' # Test code for whether the C compiler supports C99 (body of main). ac_c_conftest_c99_main=' // Check bool. _Bool success = false; success |= (argc != 0); // Check restrict. if (test_restrict ("String literal") == 0) success = true; char *restrict newvar = "Another string"; // Check varargs. success &= test_varargs ("s, d'\'' f .", "string", 65, 34.234); test_varargs_macros (); // Check flexible array members. struct incomplete_array *ia = malloc (sizeof (struct incomplete_array) + (sizeof (double) * 10)); ia->datasize = 10; for (int i = 0; i < ia->datasize; ++i) ia->data[i] = i * 1.234; // Check named initializers. struct named_init ni = { .number = 34, .name = L"Test wide string", .average = 543.34343, }; ni.number = 58; int dynamic_array[ni.number]; dynamic_array[0] = argv[0][0]; dynamic_array[ni.number - 1] = 543; // work around unused variable warnings ok |= (!success || bignum == 0LL || ubignum == 0uLL || newvar[0] == '\''x'\'' || dynamic_array[ni.number - 1] != 543); ' # Test code for whether the C compiler supports C11 (global declarations) ac_c_conftest_c11_globals=' // Does the compiler advertise C11 conformance? #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112L # error "Compiler does not advertise C11 conformance" #endif // Check _Alignas. char _Alignas (double) aligned_as_double; char _Alignas (0) no_special_alignment; extern char aligned_as_int; char _Alignas (0) _Alignas (int) aligned_as_int; // Check _Alignof. enum { int_alignment = _Alignof (int), int_array_alignment = _Alignof (int[100]), char_alignment = _Alignof (char) }; _Static_assert (0 < -_Alignof (int), "_Alignof is signed"); // Check _Noreturn. int _Noreturn does_not_return (void) { for (;;) continue; } // Check _Static_assert. struct test_static_assert { int x; _Static_assert (sizeof (int) <= sizeof (long int), "_Static_assert does not work in struct"); long int y; }; // Check UTF-8 literals. #define u8 syntax error! char const utf8_literal[] = u8"happens to be ASCII" "another string"; // Check duplicate typedefs. typedef long *long_ptr; typedef long int *long_ptr; typedef long_ptr long_ptr; // Anonymous structures and unions -- taken from C11 6.7.2.1 Example 1. struct anonymous { union { struct { int i; int j; }; struct { int k; long int l; } w; }; int m; } v1; ' # Test code for whether the C compiler supports C11 (body of main). ac_c_conftest_c11_main=' _Static_assert ((offsetof (struct anonymous, i) == offsetof (struct anonymous, w.k)), "Anonymous union alignment botch"); v1.i = 2; v1.w.k = 5; ok |= v1.i != 5; ' # Test code for whether the C compiler supports C11 (complete). ac_c_conftest_c11_program="${ac_c_conftest_c89_globals} ${ac_c_conftest_c99_globals} ${ac_c_conftest_c11_globals} int main (int argc, char **argv) { int ok = 0; ${ac_c_conftest_c89_main} ${ac_c_conftest_c99_main} ${ac_c_conftest_c11_main} return ok; } " # Test code for whether the C compiler supports C99 (complete). ac_c_conftest_c99_program="${ac_c_conftest_c89_globals} ${ac_c_conftest_c99_globals} int main (int argc, char **argv) { int ok = 0; ${ac_c_conftest_c89_main} ${ac_c_conftest_c99_main} return ok; } " # Test code for whether the C compiler supports C89 (complete). ac_c_conftest_c89_program="${ac_c_conftest_c89_globals} int main (int argc, char **argv) { int ok = 0; ${ac_c_conftest_c89_main} return ok; } " as_fn_append ac_header_c_list " stdio.h stdio_h HAVE_STDIO_H" as_fn_append ac_header_c_list " stdlib.h stdlib_h HAVE_STDLIB_H" as_fn_append ac_header_c_list " string.h string_h HAVE_STRING_H" as_fn_append ac_header_c_list " inttypes.h inttypes_h HAVE_INTTYPES_H" as_fn_append ac_header_c_list " stdint.h stdint_h HAVE_STDINT_H" as_fn_append ac_header_c_list " strings.h strings_h HAVE_STRINGS_H" as_fn_append ac_header_c_list " sys/stat.h sys_stat_h HAVE_SYS_STAT_H" as_fn_append ac_header_c_list " sys/types.h sys_types_h HAVE_SYS_TYPES_H" as_fn_append ac_header_c_list " unistd.h unistd_h HAVE_UNISTD_H" # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val=\$ac_cv_env_${ac_var}_value eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 printf "%s\n" "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 printf "%s\n" "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then # differences in whitespace do not lead to failure. ac_old_val_w=`echo x $ac_old_val` ac_new_val_w=`echo x $ac_new_val` if test "$ac_old_val_w" != "$ac_new_val_w"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 printf "%s\n" "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} ac_cache_corrupted=: else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 printf "%s\n" "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} eval $ac_var=\$ac_old_val fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 printf "%s\n" "$as_me: former value: \`$ac_old_val'" >&2;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 printf "%s\n" "$as_me: current value: \`$ac_new_val'" >&2;} fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *\'*) ac_arg=$ac_var=`printf "%s\n" "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) as_fn_append ac_configure_args " '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 printf "%s\n" "$as_me: error: changes in the environment can compromise the build" >&2;} as_fn_error $? "run \`${MAKE-make} distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 fi ## -------------------- ## ## Main body of script. ## ## -------------------- ## ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu : ${R_HOME=`R RHOME`} if test -z "${R_HOME}"; then echo "could not determine R_HOME" exit 1 fi RBIN="${R_HOME}/bin/R" # https://github.com/r-spatial/sf/issues/1054: # RVER=`"${RBIN}" --version | head -1 | cut -f3 -d" "` RSCRIPT="${R_HOME}/bin/Rscript" RVER=`"${RSCRIPT}" -e 'writeLines(paste(sep=".", base::version$major, base::version$minor))'` RVER_MAJOR=`echo ${RVER} | cut -f1 -d"."` RVER_MINOR=`echo ${RVER} | cut -f2 -d"."` RVER_PATCH=`echo ${RVER} | cut -f3 -d"."` #if test [$RVER_MAJOR = "development"]; then CXX=`"${RBIN}" CMD config CXX` #else # if test [$RVER_MAJOR -lt 3] -o [$RVER_MAJOR -eq 3 -a $RVER_MINOR -lt 3]; then # AC_MSG_ERROR([sf is not compatible with R versions before 3.3.0]) # else # CXX=`"${RBIN}" CMD config CXX` # fi #fi # pick all flags for testing from R : ${CC=`"${RBIN}" CMD config CC`} : ${CFLAGS=`"${RBIN}" CMD config CFLAGS`} : ${CPPFLAGS=`"${RBIN}" CMD config CPPFLAGS`} : ${CXXFLAGS=`"${RBIN}" CMD config CXXFLAGS`} : ${LDFLAGS=`"${RBIN}" CMD config LDFLAGS`} # AC_SUBST([CC],["clang"]) # AC_SUBST([CXX],["clang++"]) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: CC: ${CC}" >&5 printf "%s\n" "$as_me: CC: ${CC}" >&6;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: CXX: ${CXX}" >&5 printf "%s\n" "$as_me: CXX: ${CXX}" >&6;} # AC_MSG_NOTICE([${PACKAGE_NAME}: ${PACKAGE_VERSION}]) GENERIC_INSTALL_MESSAGE=" *** Installing this package from source requires the prior *** installation of external software, see for details *** https://r-spatial.github.io/sf/#installing" #GDAL GDAL_CONFIG="gdal-config" GDAL_CONFIG_SET="no" # Check whether --with-gdal-config was given. if test ${with_gdal_config+y} then : withval=$with_gdal_config; gdal_config=$withval fi if test -n "$gdal_config" ; then GDAL_CONFIG_SET="yes" GDAL_CONFIG="${gdal_config}" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: gdal-config set to $GDAL_CONFIG" >&5 printf "%s\n" "$as_me: gdal-config set to $GDAL_CONFIG" >&6;} fi if test "$GDAL_CONFIG_SET" = "no" ; then # Extract the first word of ""$GDAL_CONFIG"", so it can be a program name with args. set dummy "$GDAL_CONFIG"; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_path_GDAL_CONFIG+y} then : printf %s "(cached) " >&6 else $as_nop case $GDAL_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_GDAL_CONFIG="$GDAL_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_path_GDAL_CONFIG="$as_dir$ac_word$ac_exec_ext" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_path_GDAL_CONFIG" && ac_cv_path_GDAL_CONFIG=""no"" ;; esac fi GDAL_CONFIG=$ac_cv_path_GDAL_CONFIG if test -n "$GDAL_CONFIG"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $GDAL_CONFIG" >&5 printf "%s\n" "$GDAL_CONFIG" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi if test "$GDAL_CONFIG" = "no" ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } as_fn_error $? "gdal-config not found or not executable. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking gdal-config exists" >&5 printf %s "checking gdal-config exists... " >&6; } if test -r "${GDAL_CONFIG}"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } as_fn_error $? "gdal-config not found - configure argument error. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking gdal-config executable" >&5 printf %s "checking gdal-config executable... " >&6; } if test -x "${GDAL_CONFIG}"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } as_fn_error $? "gdal-config not executable. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking gdal-config usability" >&5 printf %s "checking gdal-config usability... " >&6; } if test `${GDAL_CONFIG} --version`; then GDAL_CPPFLAGS=`${GDAL_CONFIG} --cflags` GDAL_VERSION=`${GDAL_CONFIG} --version` GDAL_LIBS=`${GDAL_CONFIG} --libs` GDAL_DEP_LIBS=`${GDAL_CONFIG} --dep-libs` GDAL_DATADIR=`${GDAL_CONFIG} --datadir` { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else as_fn_error $? "gdal-config not found. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: GDAL: ${GDAL_VERSION}" >&5 printf "%s\n" "$as_me: GDAL: ${GDAL_VERSION}" >&6;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking GDAL version >= 2.0.1" >&5 printf %s "checking GDAL version >= 2.0.1... " >&6; } GDAL_MAJ_VER=`echo $GDAL_VERSION | cut -d "." -f1` GDAL_MIN_VER=`echo $GDAL_VERSION | cut -d "." -f2` GDAL_PATCH_VER=`echo $GDAL_VERSION | cut -d "." -f3` if test ${GDAL_MAJ_VER} -lt 2 ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } as_fn_error $? "sf is not compatible with GDAL versions below 2.0.1" "$LINENO" 5 else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi #if test [${GDAL_MAJ_VER} -eq 3] -a [${GDAL_MIN_VER} -eq 6] -a [${GDAL_PATCH_VER} -eq 0] ; then if test "${GDAL_VERSION}" = "3.6.0" ; then as_fn_error $? "GDAL version 3.6.0 has been withdrawn, please update GDAL" "$LINENO" 5 fi INLIBS="${LIBS}" INCPPFLAGS="${CPPFLAGS}" INPKG_CPPFLAGS="${PKG_CPPFLAGS}" INPKG_LIBS="${PKG_LIBS}" PKG_CPPFLAGS="${INPKG_CPPFLAGS} ${GDAL_CPPFLAGS}" PKG_LIBS="${INPKG_LIBS} ${GDAL_LIBS}" # honor PKG_xx overrides # for CPPFLAGS we will superfluously double R's flags # since we'll set PKG_CPPFLAGS with this, but that shouldn't hurt CPPFLAGS="${INCPPFLAGS} ${PKG_CPPFLAGS}" gdalok=yes ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}gcc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="gcc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 printf "%s\n" "$ac_ct_CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}cc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then if test "$as_dir$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir$ac_word${1+' '}$@" fi fi fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl.exe do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl.exe do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="$ac_prog" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 printf "%s\n" "$ac_ct_CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi test -n "$ac_ct_CC" && break done if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}clang", so it can be a program name with args. set dummy ${ac_tool_prefix}clang; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}clang" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "clang", so it can be a program name with args. set dummy clang; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 else $as_nop if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="clang" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 printf "%s\n" "$ac_ct_CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi fi test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "no acceptable C compiler found in \$PATH See \`config.log' for more details" "$LINENO" 5; } # Provide some information about the compiler. printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 set X $ac_compile ac_compiler=$2 for ac_option in --version -v -V -qversion -version; do { { ac_try="$ac_compiler $ac_option >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_compiler $ac_option >&5") 2>conftest.err ac_status=$? if test -s conftest.err; then sed '10a\ ... rest of stderr output deleted ... 10q' conftest.err >conftest.er1 cat conftest.er1 >&5 fi rm -f conftest.er1 conftest.err printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } done cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 printf %s "checking whether the C compiler works... " >&6; } ac_link_default=`printf "%s\n" "$ac_link" | sed 's/ -o *conftest[^ ]*//'` # The possible output files: ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" ac_rmfiles= for ac_file in $ac_files do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; * ) ac_rmfiles="$ac_rmfiles $ac_file";; esac done rm -f $ac_rmfiles if { { ac_try="$ac_link_default" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link_default") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. # So ignore a value of `no', otherwise this would lead to `EXEEXT = no' # in a Makefile. We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf. for ac_file in $ac_files '' do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) if test ${ac_cv_exeext+y} && test "$ac_cv_exeext" != no; then :; else ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` fi # We set ac_cv_exeext here because the later test for it is not # safe: cross compilers may not add the suffix if given an `-o' # argument, so we may need to know it at that point already. # Even if this section looks crufty: it has the advantage of # actually working. break;; * ) break;; esac done test "$ac_cv_exeext" = no && ac_cv_exeext= else $as_nop ac_file='' fi if test -z "$ac_file" then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error 77 "C compiler cannot create executables See \`config.log' for more details" "$LINENO" 5; } else $as_nop { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 printf %s "checking for C compiler default output file name... " >&6; } { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 printf "%s\n" "$ac_file" >&6; } ac_exeext=$ac_cv_exeext rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 printf %s "checking for suffix of executables... " >&6; } if { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` break;; * ) break;; esac done else $as_nop { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of executables: cannot compile and link See \`config.log' for more details" "$LINENO" 5; } fi rm -f conftest conftest$ac_cv_exeext { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 printf "%s\n" "$ac_cv_exeext" >&6; } rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include int main (void) { FILE *f = fopen ("conftest.out", "w"); return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF ac_clean_files="$ac_clean_files conftest.out" # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 printf %s "checking whether we are cross compiling... " >&6; } if test "$cross_compiling" != yes; then { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } if { ac_try='./conftest$ac_cv_exeext' { { case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_try") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error 77 "cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details" "$LINENO" 5; } fi fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 printf "%s\n" "$cross_compiling" >&6; } rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out ac_clean_files=$ac_clean_files_save { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 printf %s "checking for suffix of object files... " >&6; } if test ${ac_cv_objext+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { { ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_compile") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : for ac_file in conftest.o conftest.obj conftest.*; do test -f "$ac_file" || continue; case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else $as_nop printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of object files: cannot compile See \`config.log' for more details" "$LINENO" 5; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 printf "%s\n" "$ac_cv_objext" >&6; } OBJEXT=$ac_cv_objext ac_objext=$OBJEXT { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the compiler supports GNU C" >&5 printf %s "checking whether the compiler supports GNU C... " >&6; } if test ${ac_cv_c_compiler_gnu+y} then : printf %s "(cached) " >&6 else $as_nop cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_compiler_gnu=yes else $as_nop ac_compiler_gnu=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 printf "%s\n" "$ac_cv_c_compiler_gnu" >&6; } ac_compiler_gnu=$ac_cv_c_compiler_gnu if test $ac_compiler_gnu = yes; then GCC=yes else GCC= fi ac_test_CFLAGS=${CFLAGS+y} ac_save_CFLAGS=$CFLAGS { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 printf %s "checking whether $CC accepts -g... " >&6; } if test ${ac_cv_prog_cc_g+y} then : printf %s "(cached) " >&6 else $as_nop ac_save_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes ac_cv_prog_cc_g=no CFLAGS="-g" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_g=yes else $as_nop CFLAGS="" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : else $as_nop ac_c_werror_flag=$ac_save_c_werror_flag CFLAGS="-g" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_g=yes fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ac_c_werror_flag=$ac_save_c_werror_flag fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 printf "%s\n" "$ac_cv_prog_cc_g" >&6; } if test $ac_test_CFLAGS; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi ac_prog_cc_stdc=no if test x$ac_prog_cc_stdc = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C11 features" >&5 printf %s "checking for $CC option to enable C11 features... " >&6; } if test ${ac_cv_prog_cc_c11+y} then : printf %s "(cached) " >&6 else $as_nop ac_cv_prog_cc_c11=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_c_conftest_c11_program _ACEOF for ac_arg in '' -std=gnu11 do CC="$ac_save_CC $ac_arg" if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_c11=$ac_arg fi rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c11" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC fi if test "x$ac_cv_prog_cc_c11" = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } else $as_nop if test "x$ac_cv_prog_cc_c11" = x then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } else $as_nop { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 printf "%s\n" "$ac_cv_prog_cc_c11" >&6; } CC="$CC $ac_cv_prog_cc_c11" fi ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11 ac_prog_cc_stdc=c11 fi fi if test x$ac_prog_cc_stdc = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C99 features" >&5 printf %s "checking for $CC option to enable C99 features... " >&6; } if test ${ac_cv_prog_cc_c99+y} then : printf %s "(cached) " >&6 else $as_nop ac_cv_prog_cc_c99=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_c_conftest_c99_program _ACEOF for ac_arg in '' -std=gnu99 -std=c99 -c99 -qlanglvl=extc1x -qlanglvl=extc99 -AC99 -D_STDC_C99= do CC="$ac_save_CC $ac_arg" if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_c99=$ac_arg fi rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c99" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC fi if test "x$ac_cv_prog_cc_c99" = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } else $as_nop if test "x$ac_cv_prog_cc_c99" = x then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } else $as_nop { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 printf "%s\n" "$ac_cv_prog_cc_c99" >&6; } CC="$CC $ac_cv_prog_cc_c99" fi ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 ac_prog_cc_stdc=c99 fi fi if test x$ac_prog_cc_stdc = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C89 features" >&5 printf %s "checking for $CC option to enable C89 features... " >&6; } if test ${ac_cv_prog_cc_c89+y} then : printf %s "(cached) " >&6 else $as_nop ac_cv_prog_cc_c89=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_c_conftest_c89_program _ACEOF for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_c89=$ac_arg fi rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c89" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC fi if test "x$ac_cv_prog_cc_c89" = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } else $as_nop if test "x$ac_cv_prog_cc_c89" = x then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } else $as_nop { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 printf "%s\n" "$ac_cv_prog_cc_c89" >&6; } CC="$CC $ac_cv_prog_cc_c89" fi ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 ac_prog_cc_stdc=c89 fi fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu ac_header= ac_cache= for ac_item in $ac_header_c_list do if test $ac_cache; then ac_fn_c_check_header_compile "$LINENO" $ac_header ac_cv_header_$ac_cache "$ac_includes_default" if eval test \"x\$ac_cv_header_$ac_cache\" = xyes; then printf "%s\n" "#define $ac_item 1" >> confdefs.h fi ac_header= ac_cache= elif test $ac_header; then ac_cache=$ac_item else ac_header=$ac_item fi done if test $ac_cv_header_stdlib_h = yes && test $ac_cv_header_string_h = yes then : printf "%s\n" "#define STDC_HEADERS 1" >>confdefs.h fi for ac_header in gdal.h do : ac_fn_c_check_header_compile "$LINENO" "gdal.h" "ac_cv_header_gdal_h" "$ac_includes_default" if test "x$ac_cv_header_gdal_h" = xyes then : printf "%s\n" "#define HAVE_GDAL_H 1" >>confdefs.h else $as_nop gdalok=no fi done if test "${gdalok}" = no; then as_fn_error $? "gdal.h not found in given locations. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi NEED_DEPS=no LIBS="${INLIBS} ${PKG_LIBS}" cat > gdal_test.cpp <<_EOCONF #include #ifdef __cplusplus extern "C" { #endif int main(void) { GDALAllRegister(); } #ifdef __cplusplus } #endif _EOCONF { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking GDAL: linking with --libs only" >&5 printf %s "checking GDAL: linking with --libs only... " >&6; } ${CXX} ${CPPFLAGS} -o gdal_test gdal_test.cpp ${LIBS} 2> errors.txt if test `echo $?` -ne 0 ; then gdalok=no { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi if test "${gdalok}" = no; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking GDAL: linking with --libs and --dep-libs" >&5 printf %s "checking GDAL: linking with --libs and --dep-libs... " >&6; } LIBS="${LIBS} ${GDAL_DEP_LIBS}" gdalok=yes ${CXX} ${CPPFLAGS} -o gdal_test gdal_test.cpp ${LIBS} 2>> errors.txt if test `echo $?` -ne 0 ; then gdalok=no fi if test "${gdalok}" = yes; then NEED_DEPS=yes { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test "${gdalok}" = no; then cat errors.txt { printf "%s\n" "$as_me:${as_lineno-$LINENO}: Install failure: compilation and/or linkage problems." >&5 printf "%s\n" "$as_me: Install failure: compilation and/or linkage problems." >&6;} as_fn_error $? "GDALAllRegister not found in libgdal. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi rm -f gdal_test errors.txt gdal_test.cpp GDAL_GE_250="no" GDAL_MAJ_VER=`echo $GDAL_VERSION | cut -d "." -f1` GDAL_MOD_VER=`echo $GDAL_VERSION | cut -d "." -f2` if test "${GDAL_MAJ_VER}" = 2 ; then if test "${GDAL_MOD_VER}" -ge 5 ; then GDAL_GE_250="yes" fi else if test "${GDAL_MAJ_VER}" -ge 3 ; then GDAL_GE_250="yes" fi fi GDAL_DATA_TEST_FILE="${GDAL_DATADIR}/pcs.csv" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking GDAL: ${GDAL_DATADIR}/pcs.csv readable" >&5 printf %s "checking GDAL: ${GDAL_DATADIR}/pcs.csv readable... " >&6; } if test -r "${GDAL_DATA_TEST_FILE}" ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } if test "${GDAL_GE_250}" = "no" ; then as_fn_error $? "pcs.csv not found in GDAL data directory." "$LINENO" 5 fi fi # Optional local copy of GDAL datadir and PROJ_LIB data_copy=no if test "${PROJ_GDAL_DATA_COPY}" ; then data_copy=yes { printf "%s\n" "$as_me:${as_lineno-$LINENO}: PROJ_GDAL_DATA_COPY used." >&5 printf "%s\n" "$as_me: PROJ_GDAL_DATA_COPY used." >&6;} else # Check whether --with-data-copy was given. if test ${with_data_copy+y} then : withval=$with_data_copy; data_copy=$withval fi fi if test "${data_copy}" = "yes" ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: Copy data for:" >&5 printf "%s\n" "$as_me: Copy data for:" >&6;} proj_lib0="${PROJ_LIB}" # Check whether --with-proj-data was given. if test ${with_proj_data+y} then : withval=$with_proj_data; proj_lib1=$withval fi if test -n "${proj_lib0}" ; then proj_lib="${proj_lib0}" else proj_lib="${proj_lib1}" fi if test -n "${proj_lib}" ; then if test -d "${proj_lib}" ; then cp -r "${proj_lib}" "${R_PACKAGE_DIR}" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: PROJ: ${proj_lib}" >&5 printf "%s\n" "$as_me: PROJ: ${proj_lib}" >&6;} else as_fn_error $? "PROJ data files not found; set environment variable PROJ_LIB=DIR or --with-proj-data=DIR." "$LINENO" 5 fi else as_fn_error $? "PROJ data files not found; set environment variable PROJ_LIB=DIR or --with-proj-data=DIR." "$LINENO" 5 fi if test -d "${GDAL_DATADIR}" ; then cp -r "${GDAL_DATADIR}" "${R_PACKAGE_DIR}" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: GDAL: ${GDAL_DATADIR}" >&5 printf "%s\n" "$as_me: GDAL: ${GDAL_DATADIR}" >&6;} else as_fn_error $? "GDAL data files not found." "$LINENO" 5 fi fi # # test whether PROJ is available to gdal: # gdal_has_proj=no cat > gdal_proj.cpp <<_EOCONF #include #include #include int main(int argc, char *argv[]) { OGRSpatialReference *dest = new OGRSpatialReference; OGRSpatialReference *src = new OGRSpatialReference; src->importFromEPSG(4326); dest->importFromEPSG(3857); OGRCoordinateTransformation *ct = OGRCreateCoordinateTransformation(src, dest); return(ct == NULL); // signals PROJ is not available through gdal } _EOCONF { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking GDAL: checking whether PROJ is available for linking:" >&5 printf %s "checking GDAL: checking whether PROJ is available for linking:... " >&6; } ${CXX} ${CPPFLAGS} -o gdal_proj gdal_proj.cpp ${LIBS} 2> errors.txt if test `echo $?` -ne 0 ; then gdal_has_proj=no { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } else gdal_has_proj=yes { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi if test "${gdal_has_proj}" = no; then cat errors.txt { printf "%s\n" "$as_me:${as_lineno-$LINENO}: Install failure: compilation and/or linkage problems." >&5 printf "%s\n" "$as_me: Install failure: compilation and/or linkage problems." >&6;} as_fn_error $? "cannot link projection code" "$LINENO" 5 fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking GDAL: checking whether PROJ is available for running:" >&5 printf %s "checking GDAL: checking whether PROJ is available for running:... " >&6; } if test "x$cross_compiling" = "xyes"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: cross compiling" >&5 printf "%s\n" "cross compiling" >&6; } else ./gdal_proj if test `echo $?` -ne 0 ; then gdal_has_proj=no { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } else gdal_has_proj=yes { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi if test "${gdal_has_proj}" = no; then as_fn_error $? "OGRCoordinateTransformation() does not return a coord.trans: PROJ not available?" "$LINENO" 5 fi fi rm -fr errors.txt gdal_proj.cpp gdal_proj { printf "%s\n" "$as_me:${as_lineno-$LINENO}: GDAL: ${GDAL_VERSION}" >&5 printf "%s\n" "$as_me: GDAL: ${GDAL_VERSION}" >&6;} # sqlite3 # Check whether --with-sqlite3-lib was given. if test ${with_sqlite3_lib+y} then : withval=$with_sqlite3_lib; sqlite3_lib_path=$withval fi if test -n "$sqlite3_lib_path" ; then SQLITE3_LIBS="-L${sqlite3_lib_path}" fi # # PROJ # PROJ_CONFIG="pkg-config proj" if `$PROJ_CONFIG --exists` ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: pkg-config proj exists, will use it" >&5 printf "%s\n" "$as_me: pkg-config proj exists, will use it" >&6;} proj_config_ok=yes else proj_config_ok=no fi # Check whether --with-proj-include was given. if test ${with_proj_include+y} then : withval=$with_proj_include; proj_include_path=$withval fi if test -n "$proj_include_path" ; then PROJ_CPPFLAGS="-I${proj_include_path}" else if test "${proj_config_ok}" = yes; then PROJ_INCLUDE_PATH=`${PROJ_CONFIG} --cflags` PROJ_CPPFLAGS="${PROJ_INCLUDE_PATH}" fi fi # honor PKG_xx overrides # for CPPFLAGS we will superfluously double R's flags # since we'll set PKG_CPPFLAGS with this, but that shouldn't hurt # Check whether --with-proj-api was given. if test ${with_proj_api+y} then : withval=$with_proj_api; proj_api=$withval fi PROJ6="no" PROJH="no" if test "${proj_config_ok}" = yes; then PROJ_VERSION=`${PROJ_CONFIG} --modversion` PROJV1=`echo "${PROJ_VERSION}" | cut -c 1` if test "${PROJV1}" -ge 6; then PROJ6="yes" PROJ_CPPFLAGS="${PROJ_CPPFLAGS} -DHAVE_PROJ_H" if test "${proj_api}" = yes; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: using proj_api.h even with PROJ 5/6" >&5 printf "%s\n" "$as_me: using proj_api.h even with PROJ 5/6" >&6;} PROJ_CPPFLAGS="${PROJ_CPPFLAGS} -DACCEPT_USE_OF_DEPRECATED_PROJ_API_H" else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: using proj.h." >&5 printf "%s\n" "$as_me: using proj.h." >&6;} PROJH="yes" fi fi else if test "${PROJH}" = no ; then PROJH=yes for ac_header in proj.h do : ac_fn_c_check_header_compile "$LINENO" "proj.h" "ac_cv_header_proj_h" "$ac_includes_default" if test "x$ac_cv_header_proj_h" = xyes then : printf "%s\n" "#define HAVE_PROJ_H 1" >>confdefs.h else $as_nop PROJH=no fi done if test "${PROJH}" = yes; then PROJ6="yes" PROJ_CPPFLAGS="${PROJ_CPPFLAGS} -DHAVE_PROJ_H" fi fi fi CPPFLAGS="${INCPPFLAGS} ${PKG_CPPFLAGS} ${PROJ_CPPFLAGS}" if test "${PROJH}" = no then proj4ok=yes for ac_header in proj_api.h do : ac_fn_c_check_header_compile "$LINENO" "proj_api.h" "ac_cv_header_proj_api_h" "$ac_includes_default" if test "x$ac_cv_header_proj_api_h" = xyes then : printf "%s\n" "#define HAVE_PROJ_API_H 1" >>confdefs.h else $as_nop proj4ok=no fi done if test "${proj4ok}" = no; then as_fn_error $? "proj_api.h not found in standard or given locations." "$LINENO" 5 fi fi # dnl ditto for a library path # Check whether --with-proj-lib was given. if test ${with_proj_lib+y} then : withval=$with_proj_lib; proj_lib_path=$withval fi if test -n "$proj_lib_path" ; then PROJ_LIBS="-L${proj_lib_path} ${INPKG_LIBS} -lproj" else if test "${proj_config_ok}" = yes; then if test `uname` = "Darwin"; then PROJ_LIB_PATH=`${PROJ_CONFIG} --libs --static` else PROJ_LIB_PATH=`${PROJ_CONFIG} --libs` fi PROJ_LIBS="${PROJ_LIB_PATH} ${INPKG_LIBS}" proj_version=`${PROJ_CONFIG} --modversion` { printf "%s\n" "$as_me:${as_lineno-$LINENO}: PROJ: ${proj_version}" >&5 printf "%s\n" "$as_me: PROJ: ${proj_version}" >&6;} else PROJ_LIBS="${PKG_LIBS} -lproj" fi fi LIBS="${PROJ_LIBS} ${INLIBS} ${PKG_LIBS}" if test "${PROJH}" = no; then proj4ok=yes { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for pj_init_plus in -lproj" >&5 printf %s "checking for pj_init_plus in -lproj... " >&6; } if test ${ac_cv_lib_proj_pj_init_plus+y} then : printf %s "(cached) " >&6 else $as_nop ac_check_lib_save_LIBS=$LIBS LIBS="-lproj $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ char pj_init_plus (); int main (void) { return pj_init_plus (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_proj_pj_init_plus=yes else $as_nop ac_cv_lib_proj_pj_init_plus=no fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_proj_pj_init_plus" >&5 printf "%s\n" "$ac_cv_lib_proj_pj_init_plus" >&6; } if test "x$ac_cv_lib_proj_pj_init_plus" = xyes then : printf "%s\n" "#define HAVE_LIBPROJ 1" >>confdefs.h LIBS="-lproj $LIBS" else $as_nop proj4ok=no fi if test "${proj4ok}" = no; then as_fn_error $? "libproj not found in standard or given locations. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi cat > proj_conf_test.c <<_EOCONF #include #include #include int main(void) { printf("%d\n", PJ_VERSION); exit(0); } _EOCONF else cat > proj_conf_test.cpp <<_EOCONF #include #include #include int main(void) { proj_context_create(); exit(0); } _EOCONF #AC_CHECK_LIB(proj,proj_context_create,,proj6ok=no) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking PROJ: checking whether PROJ and sqlite3 are available for linking:" >&5 printf %s "checking PROJ: checking whether PROJ and sqlite3 are available for linking:... " >&6; } ${CXX} ${CPPFLAGS} -o proj_conf_test proj_conf_test.cpp ${LIBS} $SQLITE3_LIBS -lsqlite3 2> errors.txt if test `echo $?` -ne 0 ; then proj6ok=no { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } else proj6ok=yes { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi if test "${proj6ok}" = no; then as_fn_error $? "libproj or sqlite3 not found in standard or given locations. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi cat > proj_conf_test.c <<_EOCONF #include #include #include int main(void) { printf("%d.%d.%d\n", PROJ_VERSION_MAJOR, PROJ_VERSION_MINOR, PROJ_VERSION_PATCH); exit(0); } _EOCONF fi #AC_MSG_NOTICE([PKG_LIBS: ${PKG_LIBS}]) ${CC} ${CFLAGS} -o proj_conf_test proj_conf_test.c ${PROJ_LIBS} proj_version=`./proj_conf_test` # Check whether --with-proj-share was given. if test ${with_proj_share+y} then : withval=$with_proj_share; proj_share_path=$withval fi if test -n "$proj_share_path" ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: PROJ_LIB: ${proj_share_path}" >&5 printf "%s\n" "$as_me: PROJ_LIB: ${proj_share_path}" >&6;} fi if test ${PROJ6} = "no"; then cat > proj_conf_test.c <<_EOCONF #include #include #if PJ_VERSION <= 480 FILE *pj_open_lib(projCtx, const char *, const char *); #endif int main(void) { #if PJ_VERSION <= 480 FILE *fp; #else PAFile fp; #endif projCtx ctx; ctx = pj_get_default_ctx(); fp = pj_open_lib(ctx, "epsg", "rb"); if (fp == NULL) exit(1); #if PJ_VERSION <= 480 fclose(fp); #else pj_ctx_fclose(ctx, fp); #endif exit(0); } _EOCONF ${CC} ${CFLAGS} -o proj_conf_test proj_conf_test.c ${PROJ_LIBS} if test -n "$proj_share_path" ; then PROJ_LIB="${proj_share_path}" ./proj_conf_test proj_share=`echo $?` else ./proj_conf_test proj_share=`echo $?` fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking PROJ: epsg found and readable" >&5 printf %s "checking PROJ: epsg found and readable... " >&6; } if test ${proj_share} -eq 1 ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } STOP="stop" else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi rm -f proj_conf_test.c proj_conf_test if test "$STOP" = "stop" ; then echo "Error: proj/epsg not found" echo "Either install missing proj support files, for example" echo "the proj-nad and proj-epsg RPMs on systems using RPMs," echo "or if installed but not autodetected, set PROJ_LIB to the" echo "correct path, and if need be use the --with-proj-share=" echo "configure argument." exit 1 fi else # proj >= 6 if test "${PROJH}" = no; then cat > proj_conf_test.c <<_EOCONF #include #include int main(void) { PAFile fp; projCtx ctx; ctx = pj_get_default_ctx(); fp = pj_open_lib(ctx, "proj.db", "rb"); if (fp == NULL) exit(1); pj_ctx_fclose(ctx, fp); exit(0); } _EOCONF ${CC} ${CFLAGS} -o proj_conf_test proj_conf_test.c ${PROJ_LIBS} if test -n "$proj_share_path" ; then PROJ_LIB="${proj_share_path}" ./proj_conf_test proj_share=`echo $?` else ./proj_conf_test proj_share=`echo $?` fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking PROJ: proj.db found and readable" >&5 printf %s "checking PROJ: proj.db found and readable... " >&6; } if test ${proj_share} -eq 1 ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } STOP="stop" else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi rm -f proj_conf_test.c proj_conf_test if test "$STOP" = "stop" ; then echo "Error: proj/proj.db not found" echo "Either install missing proj support files, set PROJ_LIB to the" echo "correct path, and if need be use the --with-proj-share=" echo "configure argument." exit 1 fi cat > proj_conf_test.c <<_EOCONF #include #include #if PJ_VERSION <= 480 FILE *pj_open_lib(projCtx, const char *, const char *); #endif int main(void) { #if PJ_VERSION <= 480 FILE *fp; #else PAFile fp; #endif projCtx ctx; ctx = pj_get_default_ctx(); fp = pj_open_lib(ctx, "conus", "rb"); if (fp == NULL) exit(1); #if PJ_VERSION <= 480 fclose(fp); #else pj_ctx_fclose(ctx, fp); #endif exit(0); } _EOCONF ${CC} ${CFLAGS} -o proj_conf_test proj_conf_test.c ${PROJ_LIBS} if test -n "$proj_share_path" ; then PROJ_LIB="${proj_share_path}" ./proj_conf_test proj_share=`echo $?` else ./proj_conf_test proj_share=`echo $?` fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking PROJ: conus found and readable" >&5 printf %s "checking PROJ: conus found and readable... " >&6; } if test ${proj_share} -eq 1 ; then WARN="warn" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi rm -f proj_conf_test.c proj_conf_test if test "$WARN" = "warn" ; then echo "Note: proj/conus not found" echo "No support available in PROJ4 for NAD grid datum transformations" echo "If required, consider re-installing from source with the contents" echo "of proj-datumgrid-1..zip from http://download.osgeo.org/proj/ in nad/." fi fi # PROJH = no fi # proj >= 6 # # GEOS: # GEOS_CONFIG="geos-config" GEOS_CONFIG_SET="no" # Check whether --with-geos-config was given. if test ${with_geos_config+y} then : withval=$with_geos_config; geos_config=$withval fi if test -n "$geos_config" ; then GEOS_CONFIG_SET="yes" GEOS_CONFIG="${geos_config}" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: geos-config set to $GEOS_CONFIG" >&5 printf "%s\n" "$as_me: geos-config set to $GEOS_CONFIG" >&6;} fi if test "$GEOS_CONFIG_SET" = "no" ; then # Extract the first word of ""$GEOS_CONFIG"", so it can be a program name with args. set dummy "$GEOS_CONFIG"; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_path_GEOS_CONFIG+y} then : printf %s "(cached) " >&6 else $as_nop case $GEOS_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_GEOS_CONFIG="$GEOS_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_path_GEOS_CONFIG="$as_dir$ac_word$ac_exec_ext" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_path_GEOS_CONFIG" && ac_cv_path_GEOS_CONFIG=""no"" ;; esac fi GEOS_CONFIG=$ac_cv_path_GEOS_CONFIG if test -n "$GEOS_CONFIG"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $GEOS_CONFIG" >&5 printf "%s\n" "$GEOS_CONFIG" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi if test "$GEOS_CONFIG" = "no" ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } as_fn_error $? "geos-config not found or not executable. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking geos-config exists" >&5 printf %s "checking geos-config exists... " >&6; } if test -r "${GEOS_CONFIG}"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } as_fn_error $? "geos-config not found - configure argument error. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking geos-config executable" >&5 printf %s "checking geos-config executable... " >&6; } if test -x "${GEOS_CONFIG}"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } as_fn_error $? "geos-config not executable. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking geos-config usability" >&5 printf %s "checking geos-config usability... " >&6; } if test `${GEOS_CONFIG} --version` then GEOS_CLIBS="`${GEOS_CONFIG} --clibs`" #GEOS_DEP_CLIBS=`geos-config --static-clibs` -- this gives -m instead of -lm, which breaks clang # fixed in 3.7.0 at https://github.com/libgeos/libgeos/pull/73#issuecomment-262208677 GEOS_DEP_CLIBS=`${GEOS_CONFIG} --static-clibs | sed 's/-m/-lm/g'` GEOS_CPPFLAGS=`${GEOS_CONFIG} --cflags` { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } as_fn_error $? "${GEOS_CONFIG} not usable" "$LINENO" 5 fi GEOS_VERSION=`${GEOS_CONFIG} --version` { printf "%s\n" "$as_me:${as_lineno-$LINENO}: GEOS: ${GEOS_VERSION}" >&5 printf "%s\n" "$as_me: GEOS: ${GEOS_VERSION}" >&6;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking GEOS version >= 3.4.0" >&5 printf %s "checking GEOS version >= 3.4.0... " >&6; } # GDAL 2.0.1 requires GEOS 3.1.0 GEOS_VER_DOT=`echo $GEOS_VERSION | tr -d ".[:alpha:]"` if test ${GEOS_VER_DOT} -lt 340 ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } as_fn_error $? "upgrade GEOS to 3.4.0 or later" "$LINENO" 5 else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi PKG_CPPFLAGS="${INPKG_CPPFLAGS} ${PROJ_CPPFLAGS} ${GDAL_CPPFLAGS} ${GEOS_CPPFLAGS}" PKG_LIBS="${INPKG_LIBS} ${GDAL_LIBS}" if test "${NEED_DEPS}" = yes; then PKG_LIBS="${PKG_LIBS} ${GDAL_DEP_LIBS}" fi # honor PKG_xx overrides # for CPPFLAGS we will superfluously double R's flags # since we'll set PKG_CPPFLAGS with this, but that shouldn't hurt CPPFLAGS="${CPPFLAGS} ${PKG_CPPFLAGS}" LIBS="${LIBS} ${PKG_LIBS}" geosok=yes for ac_header in geos_c.h do : ac_fn_c_check_header_compile "$LINENO" "geos_c.h" "ac_cv_header_geos_c_h" "$ac_includes_default" if test "x$ac_cv_header_geos_c_h" = xyes then : printf "%s\n" "#define HAVE_GEOS_C_H 1" >>confdefs.h else $as_nop geosok=no fi done if test "${geosok}" = no; then as_fn_error $? "geos_c.h not found in given locations. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi cat > geos_test.cpp <<_EOCONF #include #ifdef __cplusplus extern "C" { #endif static void __errorHandler(const char *fmt, ...) { return; } static void __warningHandler(const char *fmt, ...) { return; } int main(void) { GEOSContextHandle_t r = initGEOS_r((GEOSMessageHandler) __warningHandler, (GEOSMessageHandler) __errorHandler); finishGEOS_r(r); } #ifdef __cplusplus } #endif _EOCONF #echo "${CXX} ${CPPFLAGS} -o geos_test geos_test.cpp ${LIBS}" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking geos: linking with ${GEOS_CLIBS}" >&5 printf %s "checking geos: linking with ${GEOS_CLIBS}... " >&6; } ${CXX} ${CPPFLAGS} -o geos_test geos_test.cpp ${GEOS_CLIBS} 2> errors.txt if test `echo $?` -ne 0 ; then geosok=no { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } else PKG_LIBS="${PKG_LIBS} ${GEOS_CLIBS}" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi if test "${geosok}" = no; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking geos: linking with ${GEOS_DEP_CLIBS}" >&5 printf %s "checking geos: linking with ${GEOS_DEP_CLIBS}... " >&6; } ${CXX} ${CPPFLAGS} -o geos_test geos_test.cpp ${GEOS_DEP_CLIBS} 2> errors.txt if test `echo $?` -ne 0 ; then geosok=no { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } cat errors.txt { printf "%s\n" "$as_me:${as_lineno-$LINENO}: Install failure: compilation and/or linkage problems." >&5 printf "%s\n" "$as_me: Install failure: compilation and/or linkage problems." >&6;} as_fn_error $? "initGEOS_r not found in libgeos_c. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 else PKG_LIBS="${PKG_LIBS} ${GEOS_DEP_CLIBS}" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi fi rm -f geos_test errors.txt geos_test.cpp # # add PROJ_LIBS # PKG_LIBS="${PROJ_LIBS} ${PKG_LIBS}" # # concluding substitution # { printf "%s\n" "$as_me:${as_lineno-$LINENO}: Package CPP flags: ${PKG_CPPFLAGS}" >&5 printf "%s\n" "$as_me: Package CPP flags: ${PKG_CPPFLAGS}" >&6;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: Package LIBS: ${PKG_LIBS}" >&5 printf "%s\n" "$as_me: Package LIBS: ${PKG_LIBS}" >&6;} ac_config_files="$ac_config_files src/Makevars" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, we kill variables containing newlines. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. ( for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( *) { eval $ac_var=; unset $ac_var;} ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space=' '; set) 2>&1` in #( *${as_nl}ac_space=\ *) # `set' does not quote correctly, so add quotes: double-quote # substitution turns \\\\ into \\, and sed turns \\ into \. sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; #( *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) | sed ' /^ac_cv_env_/b end t clear :clear s/^\([^=]*\)=\(.*[{}].*\)$/test ${\1+y} || &/ t end s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then if test "x$cache_file" != "x/dev/null"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 printf "%s\n" "$as_me: updating cache $cache_file" >&6;} if test ! -f "$cache_file" || test -h "$cache_file"; then cat confcache >"$cache_file" else case $cache_file in #( */* | ?:*) mv -f confcache "$cache_file"$$ && mv -f "$cache_file"$$ "$cache_file" ;; #( *) mv -f confcache "$cache_file" ;; esac fi fi else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 printf "%s\n" "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. # # If the first sed substitution is executed (which looks for macros that # take arguments), then branch to the quote section. Otherwise, # look for a macro that doesn't take arguments. ac_script=' :mline /\\$/{ N s,\\\n,, b mline } t clear :clear s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g t quote s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g t quote b any :quote s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g s/\[/\\&/g s/\]/\\&/g s/\$/$$/g H :any ${ g s/^\n// s/\n/ /g p } ' DEFS=`sed -n "$ac_script" confdefs.h` ac_libobjs= ac_ltlibobjs= U= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' ac_i=`printf "%s\n" "$ac_i" | sed "$ac_script"` # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR # will be set to the directory where LIBOBJS objects are built. as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : "${CONFIG_STATUS=./config.status}" ac_write_fail=0 ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 printf "%s\n" "$as_me: creating $CONFIG_STATUS" >&6;} as_write_fail=0 cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} export SHELL _ASEOF cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh as_nop=: if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else $as_nop case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi # Reset variables that may have inherited troublesome values from # the environment. # IFS needs to be set, to space, tab, and newline, in precisely that order. # (If _AS_PATH_WALK were called with IFS unset, it would have the # side effect of setting IFS to empty, thus disabling word splitting.) # Quoting is to prevent editors from complaining about space-tab. as_nl=' ' export as_nl IFS=" "" $as_nl" PS1='$ ' PS2='> ' PS4='+ ' # Ensure predictable behavior from utilities with locale-dependent output. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # We cannot yet rely on "unset" to work, but we need these variables # to be unset--not just set to an empty or harmless value--now, to # avoid bugs in old shells (e.g. pre-3.0 UWIN ksh). This construct # also avoids known problems related to "unset" and subshell syntax # in other old shells (e.g. bash 2.01 and pdksh 5.2.14). for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH do eval test \${$as_var+y} \ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : done # Ensure that fds 0, 1, and 2 are open. if (exec 3>&0) 2>/dev/null; then :; else exec 0&1) 2>/dev/null; then :; else exec 1>/dev/null; fi if (exec 3>&2) ; then :; else exec 2>/dev/null; fi # The user is always right. if ${PATH_SEPARATOR+false} :; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # Find who we are. Look in the path if we contain no directory separator. as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac test -r "$as_dir$0" && as_myself=$as_dir$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 exit 1 fi # as_fn_error STATUS ERROR [LINENO LOG_FD] # ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the # script with STATUS, using 1 if that was 0. as_fn_error () { as_status=$1; test $as_status -eq 0 && as_status=1 if test "$4"; then as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi printf "%s\n" "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exit STATUS # ----------------- # Exit the shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exit () { set +e as_fn_set_status $1 exit $1 } # as_fn_exit # as_fn_unset VAR # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null then : eval 'as_fn_append () { eval $1+=\$2 }' else $as_nop as_fn_append () { eval $1=\$$1\$2 } fi # as_fn_append # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # global $as_val. Take advantage of shells that can avoid forks. The arguments # must be portable across $(()) and expr. if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null then : eval 'as_fn_arith () { as_val=$(( $* )) }' else $as_nop as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` } fi # as_fn_arith if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # Determine whether it's possible to make 'echo' print without a newline. # These variables are no longer used directly by Autoconf, but are AC_SUBSTed # for compatibility with existing Makefiles. ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac # For backward compatibility with old third-party macros, we provide # the shell variables $as_echo and $as_echo_n. New code should use # AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively. as_echo='printf %s\n' as_echo_n='printf %s' rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null fi if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -pR' fi else as_ln_s='cp -pR' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null # as_fn_mkdir_p # ------------- # Create "$as_dir" as a directory, including parents if necessary. as_fn_mkdir_p () { case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" } # as_fn_mkdir_p if mkdir -p . 2>/dev/null; then as_mkdir_p='mkdir -p "$as_dir"' else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # as_fn_executable_p FILE # ----------------------- # Test if FILE is an executable regular file. as_fn_executable_p () { test -f "$1" && test -x "$1" } # as_fn_executable_p as_test_x='test -x' as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 6>&1 ## ----------------------------------- ## ## Main body of $CONFIG_STATUS script. ## ## ----------------------------------- ## _ASEOF test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by $as_me, which was generated by GNU Autoconf 2.71. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ on `(hostname || uname -n) 2>/dev/null | sed 1q` " _ACEOF case $ac_config_files in *" "*) set x $ac_config_files; shift; ac_config_files=$*;; esac cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 # Files that config.status was made for. config_files="$ac_config_files" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ac_cs_usage="\ \`$as_me' instantiates files and other configuration actions from templates according to the current configuration. Unless the files and actions are specified as TAGs, all are instantiated by default. Usage: $0 [OPTION]... [TAG]... -h, --help print this help, then exit -V, --version print version number and configuration settings, then exit --config print configuration, then exit -q, --quiet, --silent do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE Configuration files: $config_files Report bugs to the package provider." _ACEOF ac_cs_config=`printf "%s\n" "$ac_configure_args" | sed "$ac_safe_unquote"` ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\''/g"` cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ config.status configured by $0, generated by GNU Autoconf 2.71, with options \\"\$ac_cs_config\\" Copyright (C) 2021 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." ac_pwd='$ac_pwd' srcdir='$srcdir' test -n "\$AWK" || AWK=awk _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # The default lists apply if the user does not specify any file. ac_need_defaults=: while test $# != 0 do case $1 in --*=?*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; --*=) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg= ac_shift=: ;; *) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) printf "%s\n" "$ac_cs_version"; exit ;; --config | --confi | --conf | --con | --co | --c ) printf "%s\n" "$ac_cs_config"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift case $ac_optarg in *\'*) ac_optarg=`printf "%s\n" "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; '') as_fn_error $? "missing file argument" ;; esac as_fn_append CONFIG_FILES " '$ac_optarg'" ac_need_defaults=false;; --he | --h | --help | --hel | -h ) printf "%s\n" "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) as_fn_error $? "unrecognized option: \`$1' Try \`$0 --help' for more information." ;; *) as_fn_append ac_config_targets " $1" ac_need_defaults=false ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 if \$ac_cs_recheck; then set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion shift \printf "%s\n" "running CONFIG_SHELL=$SHELL \$*" >&6 CONFIG_SHELL='$SHELL' export CONFIG_SHELL exec "\$@" fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX printf "%s\n" "$ac_log" } >&5 _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Handling of arguments. for ac_config_target in $ac_config_targets do case $ac_config_target in "src/Makevars") CONFIG_FILES="$CONFIG_FILES src/Makevars" ;; *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test ${CONFIG_FILES+y} || CONFIG_FILES=$config_files fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: # after its creation but before its name has been assigned to `$tmp'. $debug || { tmp= ac_tmp= trap 'exit_status=$? : "${ac_tmp:=$tmp}" { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status ' 0 trap 'as_fn_exit 1' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") } || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 ac_tmp=$tmp # Set up the scripts for CONFIG_FILES section. # No need to generate them if there are no CONFIG_FILES. # This happens for instance with `./config.status config.h'. if test -n "$CONFIG_FILES"; then ac_cr=`echo X | tr X '\015'` # On cygwin, bash can eat \r inside `` if the user requested igncr. # But we know of no other shell where ac_cr would be empty at this # point, so we can use a bashism as a fallback. if test "x$ac_cr" = x; then eval ac_cr=\$\'\\r\' fi ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then ac_cs_awk_cr='\\r' else ac_cs_awk_cr=$ac_cr fi echo 'BEGIN {' >"$ac_tmp/subs1.awk" && _ACEOF { echo "cat >conf$$subs.awk <<_ACEOF" && echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && echo "_ACEOF" } >conf$$subs.sh || as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` ac_delim='%!_!# ' for ac_last_try in false false false false false :; do . ./conf$$subs.sh || as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` if test $ac_delim_n = $ac_delim_num; then break elif $ac_last_try; then as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi done rm -f conf$$subs.sh cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && _ACEOF sed -n ' h s/^/S["/; s/!.*/"]=/ p g s/^[^!]*!// :repl t repl s/'"$ac_delim"'$// t delim :nl h s/\(.\{148\}\)..*/\1/ t more1 s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ p n b repl :more1 s/["\\]/\\&/g; s/^/"/; s/$/"\\/ p g s/.\{148\}// t nl :delim h s/\(.\{148\}\)..*/\1/ t more2 s/["\\]/\\&/g; s/^/"/; s/$/"/ p b :more2 s/["\\]/\\&/g; s/^/"/; s/$/"\\/ p g s/.\{148\}// t delim ' >$CONFIG_STATUS || ac_write_fail=1 rm -f conf$$subs.awk cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACAWK cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && for (key in S) S_is_set[key] = 1 FS = "" } { line = $ 0 nfields = split(line, field, "@") substed = 0 len = length(field[1]) for (i = 2; i < nfields; i++) { key = field[i] keylen = length(key) if (S_is_set[key]) { value = S[key] line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) len += length(value) + length(field[++i]) substed = 1 } else len += 1 + keylen } print line } _ACAWK _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" else cat fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 _ACEOF # VPATH may cause trouble with some makes, so we remove sole $(srcdir), # ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ h s/// s/^/:/ s/[ ]*$/:/ s/:\$(srcdir):/:/g s/:\${srcdir}:/:/g s/:@srcdir@:/:/g s/^:*// s/:*$// x s/\(=[ ]*\).*/\1/ G s/\n// s/^[^=]*=[ ]*$// }' fi cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 fi # test -n "$CONFIG_FILES" eval set X " :F $CONFIG_FILES " shift for ac_tag do case $ac_tag in :[FHLC]) ac_mode=$ac_tag; continue;; esac case $ac_mode$ac_tag in :[FHL]*:*);; :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac ac_save_IFS=$IFS IFS=: set x $ac_tag IFS=$ac_save_IFS shift ac_file=$1 shift case $ac_mode in :L) ac_source=$1;; :[FH]) ac_file_inputs= for ac_f do case $ac_f in -) ac_f="$ac_tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain `:'. test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; esac case $ac_f in *\'*) ac_f=`printf "%s\n" "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac as_fn_append ac_file_inputs " '$ac_f'" done # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input='Generated from '` printf "%s\n" "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' `' by configure.' if test x"$ac_file" != x-; then configure_input="$ac_file. $configure_input" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 printf "%s\n" "$as_me: creating $ac_file" >&6;} fi # Neutralize special characters interpreted by sed in replacement strings. case $configure_input in #( *\&* | *\|* | *\\* ) ac_sed_conf_input=`printf "%s\n" "$configure_input" | sed 's/[\\\\&|]/\\\\&/g'`;; #( *) ac_sed_conf_input=$configure_input;; esac case $ac_tag in *:-:* | *:-) cat >"$ac_tmp/stdin" \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; esac ;; esac ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` as_dir="$ac_dir"; as_fn_mkdir_p ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix case $ac_mode in :F) # # CONFIG_FILE # _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # If the template does not know about datarootdir, expand it. # FIXME: This hack should be removed a few years after 2.60. ac_datarootdir_hack=; ac_datarootdir_seen= ac_sed_dataroot=' /datarootdir/ { p q } /@datadir@/p /@docdir@/p /@infodir@/p /@localedir@/p /@mandir@/p' case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in *datarootdir*) ac_datarootdir_seen=yes;; *@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 printf "%s\n" "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_datarootdir_hack=' s&@datadir@&$datadir&g s&@docdir@&$docdir&g s&@infodir@&$infodir&g s&@localedir@&$localedir&g s&@mandir@&$mandir&g s&\\\${datarootdir}&$datarootdir&g' ;; esac _ACEOF # Neutralize VPATH when `$srcdir' = `.'. # Shell code in configure.ac might set extrasub. # FIXME: do we really want to maintain this feature? cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_sed_extra="$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s|@configure_input@|$ac_sed_conf_input|;t t s&@top_builddir@&$ac_top_builddir_sub&;t t s&@top_build_prefix@&$ac_top_build_prefix&;t t s&@srcdir@&$ac_srcdir&;t t s&@abs_srcdir@&$ac_abs_srcdir&;t t s&@top_srcdir@&$ac_top_srcdir&;t t s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t s&@builddir@&$ac_builddir&;t t s&@abs_builddir@&$ac_abs_builddir&;t t s&@abs_top_builddir@&$ac_abs_top_builddir&;t t $ac_datarootdir_hack " eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ "$ac_tmp/out"`; test -z "$ac_out"; } && { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined" >&5 printf "%s\n" "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined" >&2;} rm -f "$ac_tmp/stdin" case $ac_file in -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; esac \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; esac done # for ac_tag as_fn_exit 0 _ACEOF ac_clean_files=$ac_clean_files_save test $ac_write_fail = 0 || as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || as_fn_exit 1 fi if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} fi ================================================ FILE: configure.ac ================================================ dnl Process this file with autoconf to produce a configure script. dnl GDAL stuff largely copied from rgdal, (c) Roger Bivand AC_INIT AC_CONFIG_SRCDIR([src/wkb.cpp]) : ${R_HOME=`R RHOME`} if test -z "${R_HOME}"; then echo "could not determine R_HOME" exit 1 fi RBIN="${R_HOME}/bin/R" # https://github.com/r-spatial/sf/issues/1054: # RVER=`"${RBIN}" --version | head -1 | cut -f3 -d" "` RSCRIPT="${R_HOME}/bin/Rscript" RVER=`"${RSCRIPT}" -e 'writeLines(paste(sep=".", base::version$major, base::version$minor))'` RVER_MAJOR=`echo ${RVER} | cut -f1 -d"."` RVER_MINOR=`echo ${RVER} | cut -f2 -d"."` RVER_PATCH=`echo ${RVER} | cut -f3 -d"."` #if test [$RVER_MAJOR = "development"]; then CXX=`"${RBIN}" CMD config CXX` #else # if test [$RVER_MAJOR -lt 3] -o [$RVER_MAJOR -eq 3 -a $RVER_MINOR -lt 3]; then # AC_MSG_ERROR([sf is not compatible with R versions before 3.3.0]) # else # CXX=`"${RBIN}" CMD config CXX` # fi #fi # pick all flags for testing from R : ${CC=`"${RBIN}" CMD config CC`} : ${CFLAGS=`"${RBIN}" CMD config CFLAGS`} : ${CPPFLAGS=`"${RBIN}" CMD config CPPFLAGS`} : ${CXXFLAGS=`"${RBIN}" CMD config CXXFLAGS`} : ${LDFLAGS=`"${RBIN}" CMD config LDFLAGS`} # AC_SUBST([CC],["clang"]) # AC_SUBST([CXX],["clang++"]) AC_MSG_NOTICE([CC: ${CC}]) AC_MSG_NOTICE([CXX: ${CXX}]) # AC_MSG_NOTICE([${PACKAGE_NAME}: ${PACKAGE_VERSION}]) GENERIC_INSTALL_MESSAGE=" *** Installing this package from source requires the prior *** installation of external software, see for details *** https://r-spatial.github.io/sf/#installing" #GDAL GDAL_CONFIG="gdal-config" GDAL_CONFIG_SET="no" AC_ARG_WITH([gdal-config], AS_HELP_STRING([--with-gdal-config=GDAL_CONFIG],[the location of gdal-config]), [gdal_config=$withval]) if test [ -n "$gdal_config" ] ; then GDAL_CONFIG_SET="yes" AC_SUBST([GDAL_CONFIG],["${gdal_config}"]) AC_MSG_NOTICE(gdal-config set to $GDAL_CONFIG) fi if test ["$GDAL_CONFIG_SET" = "no"] ; then AC_PATH_PROG([GDAL_CONFIG], ["$GDAL_CONFIG"],["no"]) if test ["$GDAL_CONFIG" = "no"] ; then AC_MSG_RESULT(no) AC_MSG_ERROR([gdal-config not found or not executable. ${GENERIC_INSTALL_MESSAGE}]) fi else AC_MSG_CHECKING(gdal-config exists) if test -r "${GDAL_CONFIG}"; then AC_MSG_RESULT(yes) else AC_MSG_RESULT(no) AC_MSG_ERROR([gdal-config not found - configure argument error. ${GENERIC_INSTALL_MESSAGE}]) fi AC_MSG_CHECKING(gdal-config executable) if test -x "${GDAL_CONFIG}"; then AC_MSG_RESULT(yes) else AC_MSG_RESULT(no) AC_MSG_ERROR([gdal-config not executable. ${GENERIC_INSTALL_MESSAGE}]) fi fi AC_MSG_CHECKING(gdal-config usability) if test `${GDAL_CONFIG} --version`; then GDAL_CPPFLAGS=`${GDAL_CONFIG} --cflags` GDAL_VERSION=`${GDAL_CONFIG} --version` GDAL_LIBS=`${GDAL_CONFIG} --libs` GDAL_DEP_LIBS=`${GDAL_CONFIG} --dep-libs` GDAL_DATADIR=`${GDAL_CONFIG} --datadir` AC_MSG_RESULT(yes) else AC_MSG_ERROR([gdal-config not found. ${GENERIC_INSTALL_MESSAGE}]) fi AC_MSG_NOTICE([GDAL: ${GDAL_VERSION}]) AC_MSG_CHECKING([GDAL version >= 2.0.1]) GDAL_MAJ_VER=`echo $GDAL_VERSION | cut -d "." -f1` GDAL_MIN_VER=`echo $GDAL_VERSION | cut -d "." -f2` GDAL_PATCH_VER=`echo $GDAL_VERSION | cut -d "." -f3` if test ${GDAL_MAJ_VER} -lt 2 ; then AC_MSG_RESULT(no) AC_MSG_ERROR([sf is not compatible with GDAL versions below 2.0.1]) else AC_MSG_RESULT(yes) fi #if test [${GDAL_MAJ_VER} -eq 3] -a [${GDAL_MIN_VER} -eq 6] -a [${GDAL_PATCH_VER} -eq 0] ; then if test "${GDAL_VERSION}" = "3.6.0" ; then AC_MSG_ERROR([GDAL version 3.6.0 has been withdrawn, please update GDAL]) fi INLIBS="${LIBS}" INCPPFLAGS="${CPPFLAGS}" INPKG_CPPFLAGS="${PKG_CPPFLAGS}" INPKG_LIBS="${PKG_LIBS}" AC_SUBST([PKG_CPPFLAGS], ["${INPKG_CPPFLAGS} ${GDAL_CPPFLAGS}"]) AC_SUBST([PKG_LIBS], ["${INPKG_LIBS} ${GDAL_LIBS}"]) # honor PKG_xx overrides # for CPPFLAGS we will superfluously double R's flags # since we'll set PKG_CPPFLAGS with this, but that shouldn't hurt CPPFLAGS="${INCPPFLAGS} ${PKG_CPPFLAGS}" gdalok=yes AC_CHECK_HEADERS(gdal.h,,gdalok=no) if test "${gdalok}" = no; then AC_MSG_ERROR([gdal.h not found in given locations. ${GENERIC_INSTALL_MESSAGE}]) fi NEED_DEPS=no LIBS="${INLIBS} ${PKG_LIBS}" [cat > gdal_test.cpp <<_EOCONF #include #ifdef __cplusplus extern "C" { #endif int main(void) { GDALAllRegister(); } #ifdef __cplusplus } #endif _EOCONF] AC_MSG_CHECKING(GDAL: linking with --libs only) ${CXX} ${CPPFLAGS} -o gdal_test gdal_test.cpp ${LIBS} 2> errors.txt if test `echo $?` -ne 0 ; then gdalok=no AC_MSG_RESULT(no) else AC_MSG_RESULT(yes) fi if test "${gdalok}" = no; then AC_MSG_CHECKING(GDAL: linking with --libs and --dep-libs) LIBS="${LIBS} ${GDAL_DEP_LIBS}" gdalok=yes ${CXX} ${CPPFLAGS} -o gdal_test gdal_test.cpp ${LIBS} 2>> errors.txt if test `echo $?` -ne 0 ; then gdalok=no fi if test "${gdalok}" = yes; then NEED_DEPS=yes AC_MSG_RESULT(yes) else AC_MSG_RESULT(no) fi fi if test "${gdalok}" = no; then cat errors.txt AC_MSG_NOTICE([Install failure: compilation and/or linkage problems.]) AC_MSG_ERROR([GDALAllRegister not found in libgdal. ${GENERIC_INSTALL_MESSAGE}]) fi rm -f gdal_test errors.txt gdal_test.cpp GDAL_GE_250="no" GDAL_MAJ_VER=`echo $GDAL_VERSION | cut -d "." -f1` GDAL_MOD_VER=`echo $GDAL_VERSION | cut -d "." -f2` if test "${GDAL_MAJ_VER}" = 2 ; then if test "${GDAL_MOD_VER}" -ge 5 ; then GDAL_GE_250="yes" fi else if test "${GDAL_MAJ_VER}" -ge 3 ; then GDAL_GE_250="yes" fi fi GDAL_DATA_TEST_FILE="${GDAL_DATADIR}/pcs.csv" AC_MSG_CHECKING(GDAL: ${GDAL_DATADIR}/pcs.csv readable) if test -r "${GDAL_DATA_TEST_FILE}" ; then AC_MSG_RESULT(yes) else AC_MSG_RESULT(no) if test "${GDAL_GE_250}" = "no" ; then AC_MSG_ERROR([pcs.csv not found in GDAL data directory.]) fi fi # Optional local copy of GDAL datadir and PROJ_LIB data_copy=no if test "${PROJ_GDAL_DATA_COPY}" ; then data_copy=yes AC_MSG_NOTICE([PROJ_GDAL_DATA_COPY used.]) else AC_ARG_WITH([data-copy], AS_HELP_STRING([--with-data-copy=yes/no],[local copy of data directories in package, default no]), [data_copy=$withval]) fi if test "${data_copy}" = "yes" ; then AC_MSG_NOTICE([Copy data for:]) proj_lib0="${PROJ_LIB}" AC_ARG_WITH([proj-data], AS_HELP_STRING([--with-proj-data=DIR],[location of PROJ data directory]), [proj_lib1=$withval]) if test -n "${proj_lib0}" ; then proj_lib="${proj_lib0}" else proj_lib="${proj_lib1}" fi if test -n "${proj_lib}" ; then if test -d "${proj_lib}" ; then cp -r "${proj_lib}" "${R_PACKAGE_DIR}" AC_MSG_NOTICE([ PROJ: ${proj_lib}]) else AC_MSG_ERROR([PROJ data files not found; set environment variable PROJ_LIB=DIR or --with-proj-data=DIR.]) fi else AC_MSG_ERROR([PROJ data files not found; set environment variable PROJ_LIB=DIR or --with-proj-data=DIR.]) fi if test -d "${GDAL_DATADIR}" ; then cp -r "${GDAL_DATADIR}" "${R_PACKAGE_DIR}" AC_MSG_NOTICE([ GDAL: ${GDAL_DATADIR}]) else AC_MSG_ERROR([GDAL data files not found.]) fi fi # # test whether PROJ is available to gdal: # gdal_has_proj=no [cat > gdal_proj.cpp <<_EOCONF #include #include #include int main(int argc, char *argv[]) { OGRSpatialReference *dest = new OGRSpatialReference; OGRSpatialReference *src = new OGRSpatialReference; src->importFromEPSG(4326); dest->importFromEPSG(3857); OGRCoordinateTransformation *ct = OGRCreateCoordinateTransformation(src, dest); return(ct == NULL); // signals PROJ is not available through gdal } _EOCONF] AC_MSG_CHECKING(GDAL: checking whether PROJ is available for linking:) ${CXX} ${CPPFLAGS} -o gdal_proj gdal_proj.cpp ${LIBS} 2> errors.txt if test `echo $?` -ne 0 ; then gdal_has_proj=no AC_MSG_RESULT(no) else gdal_has_proj=yes AC_MSG_RESULT(yes) fi if test "${gdal_has_proj}" = no; then cat errors.txt AC_MSG_NOTICE([Install failure: compilation and/or linkage problems.]) AC_MSG_ERROR([cannot link projection code]) fi AC_MSG_CHECKING(GDAL: checking whether PROJ is available for running:) if test "x$cross_compiling" = "xyes"; then AC_MSG_RESULT(cross compiling, assuming yes) else ./gdal_proj if test `echo $?` -ne 0 ; then gdal_has_proj=no AC_MSG_RESULT(no) else gdal_has_proj=yes AC_MSG_RESULT(yes) fi if test "${gdal_has_proj}" = no; then AC_MSG_ERROR([OGRCoordinateTransformation() does not return a coord.trans: PROJ not available?]) fi fi rm -fr errors.txt gdal_proj.cpp gdal_proj AC_MSG_NOTICE([GDAL: ${GDAL_VERSION}]) # sqlite3 AC_ARG_WITH([sqlite3-lib], AS_HELP_STRING([--with-sqlite3-lib=LIB_PATH],[the location of sqlite3 libraries]), [sqlite3_lib_path=$withval]) if test [ -n "$sqlite3_lib_path" ] ; then AC_SUBST([SQLITE3_LIBS], ["-L${sqlite3_lib_path}"]) fi # # PROJ # PROJ_CONFIG="pkg-config proj" if `$PROJ_CONFIG --exists` ; then AC_MSG_NOTICE([pkg-config proj exists, will use it]) proj_config_ok=yes else proj_config_ok=no fi AC_ARG_WITH([proj-include], AS_HELP_STRING([--with-proj-include=DIR],[location of proj header files]), [proj_include_path=$withval]) if test [ -n "$proj_include_path" ] ; then AC_SUBST([PROJ_CPPFLAGS],["-I${proj_include_path}"]) else if test "${proj_config_ok}" = yes; then PROJ_INCLUDE_PATH=`${PROJ_CONFIG} --cflags` AC_SUBST([PROJ_CPPFLAGS],["${PROJ_INCLUDE_PATH}"]) fi fi # honor PKG_xx overrides # for CPPFLAGS we will superfluously double R's flags # since we'll set PKG_CPPFLAGS with this, but that shouldn't hurt AC_ARG_WITH([proj-api], AS_HELP_STRING([--with-proj-api=yes/no],[use the deprecated proj_api.h even when PROJ 6 is available; default no]), [proj_api=$withval]) PROJ6="no" PROJH="no" if test "${proj_config_ok}" = yes; then PROJ_VERSION=`${PROJ_CONFIG} --modversion` PROJV1=`echo "${PROJ_VERSION}" | cut -c 1` if test "${PROJV1}" -ge 6; then PROJ6="yes" PROJ_CPPFLAGS="${PROJ_CPPFLAGS} -DHAVE_PROJ_H" if test "${proj_api}" = yes; then AC_MSG_NOTICE([using proj_api.h even with PROJ 5/6]) PROJ_CPPFLAGS="${PROJ_CPPFLAGS} -DACCEPT_USE_OF_DEPRECATED_PROJ_API_H" else AC_MSG_NOTICE([using proj.h.]) PROJH="yes" fi fi else if test "${PROJH}" = no ; then PROJH=yes AC_CHECK_HEADERS(proj.h,,PROJH=no) if test "${PROJH}" = yes; then PROJ6="yes" PROJ_CPPFLAGS="${PROJ_CPPFLAGS} -DHAVE_PROJ_H" fi fi fi CPPFLAGS="${INCPPFLAGS} ${PKG_CPPFLAGS} ${PROJ_CPPFLAGS}" if test "${PROJH}" = no then proj4ok=yes AC_CHECK_HEADERS(proj_api.h,,proj4ok=no) if test "${proj4ok}" = no; then AC_MSG_ERROR([proj_api.h not found in standard or given locations.]) fi fi # dnl ditto for a library path AC_ARG_WITH([proj-lib], AS_HELP_STRING([--with-proj-lib=LIB_PATH],[the location of proj libraries]), [proj_lib_path=$withval]) if test [ -n "$proj_lib_path" ] ; then AC_SUBST([PROJ_LIBS], ["-L${proj_lib_path} ${INPKG_LIBS} -lproj"]) else if test "${proj_config_ok}" = yes; then if test `uname` = "Darwin"; then PROJ_LIB_PATH=`${PROJ_CONFIG} --libs --static` else PROJ_LIB_PATH=`${PROJ_CONFIG} --libs` fi AC_SUBST([PROJ_LIBS], ["${PROJ_LIB_PATH} ${INPKG_LIBS}"]) proj_version=`${PROJ_CONFIG} --modversion` AC_MSG_NOTICE([PROJ: ${proj_version}]) else PROJ_LIBS="${PKG_LIBS} -lproj" fi fi LIBS="${PROJ_LIBS} ${INLIBS} ${PKG_LIBS}" if test "${PROJH}" = no; then proj4ok=yes AC_CHECK_LIB(proj,pj_init_plus,,proj4ok=no) if test "${proj4ok}" = no; then AC_MSG_ERROR([libproj not found in standard or given locations. ${GENERIC_INSTALL_MESSAGE}]) fi [cat > proj_conf_test.c <<_EOCONF #include #include #include int main(void) { printf("%d\n", PJ_VERSION); exit(0); } _EOCONF] else [cat > proj_conf_test.cpp <<_EOCONF #include #include #include int main(void) { proj_context_create(); exit(0); } _EOCONF] #AC_CHECK_LIB(proj,proj_context_create,,proj6ok=no) AC_MSG_CHECKING(PROJ: checking whether PROJ and sqlite3 are available for linking:) ${CXX} ${CPPFLAGS} -o proj_conf_test proj_conf_test.cpp ${LIBS} $SQLITE3_LIBS -lsqlite3 2> errors.txt if test `echo $?` -ne 0 ; then proj6ok=no AC_MSG_RESULT(no) else proj6ok=yes AC_MSG_RESULT(yes) fi if test "${proj6ok}" = no; then AC_MSG_ERROR([libproj or sqlite3 not found in standard or given locations. ${GENERIC_INSTALL_MESSAGE}]) fi [cat > proj_conf_test.c <<_EOCONF #include #include #include int main(void) { printf("%d.%d.%d\n", PROJ_VERSION_MAJOR, PROJ_VERSION_MINOR, PROJ_VERSION_PATCH); exit(0); } _EOCONF] fi #AC_MSG_NOTICE([PKG_LIBS: ${PKG_LIBS}]) ${CC} ${CFLAGS} -o proj_conf_test proj_conf_test.c ${PROJ_LIBS} proj_version=`./proj_conf_test` AC_ARG_WITH([proj-share], AS_HELP_STRING([--with-proj-share=SHARE_PATH],[the location of proj metadata files]), [proj_share_path=$withval]) if test [ -n "$proj_share_path" ] ; then AC_MSG_NOTICE([PROJ_LIB: ${proj_share_path}]) fi if test ${PROJ6} = "no"; then [cat > proj_conf_test.c <<_EOCONF #include #include #if PJ_VERSION <= 480 FILE *pj_open_lib(projCtx, const char *, const char *); #endif int main(void) { #if PJ_VERSION <= 480 FILE *fp; #else PAFile fp; #endif projCtx ctx; ctx = pj_get_default_ctx(); fp = pj_open_lib(ctx, "epsg", "rb"); if (fp == NULL) exit(1); #if PJ_VERSION <= 480 fclose(fp); #else pj_ctx_fclose(ctx, fp); #endif exit(0); } _EOCONF] ${CC} ${CFLAGS} -o proj_conf_test proj_conf_test.c ${PROJ_LIBS} if test [ -n "$proj_share_path" ] ; then PROJ_LIB="${proj_share_path}" ./proj_conf_test proj_share=`echo $?` else ./proj_conf_test proj_share=`echo $?` fi AC_MSG_CHECKING(PROJ: epsg found and readable) if test ${proj_share} -eq 1 ; then AC_MSG_RESULT(no) STOP="stop" else AC_MSG_RESULT(yes) fi rm -f proj_conf_test.c proj_conf_test if test "$STOP" = "stop" ; then echo "Error: proj/epsg not found" echo "Either install missing proj support files, for example" echo "the proj-nad and proj-epsg RPMs on systems using RPMs," echo "or if installed but not autodetected, set PROJ_LIB to the" echo "correct path, and if need be use the --with-proj-share=" echo "configure argument." exit 1 fi else # proj >= 6 if test "${PROJH}" = no; then [cat > proj_conf_test.c <<_EOCONF #include #include int main(void) { PAFile fp; projCtx ctx; ctx = pj_get_default_ctx(); fp = pj_open_lib(ctx, "proj.db", "rb"); if (fp == NULL) exit(1); pj_ctx_fclose(ctx, fp); exit(0); } _EOCONF] ${CC} ${CFLAGS} -o proj_conf_test proj_conf_test.c ${PROJ_LIBS} if test [ -n "$proj_share_path" ] ; then PROJ_LIB="${proj_share_path}" ./proj_conf_test proj_share=`echo $?` else ./proj_conf_test proj_share=`echo $?` fi AC_MSG_CHECKING(PROJ: proj.db found and readable) if test ${proj_share} -eq 1 ; then AC_MSG_RESULT(no) STOP="stop" else AC_MSG_RESULT(yes) fi rm -f proj_conf_test.c proj_conf_test if test "$STOP" = "stop" ; then echo "Error: proj/proj.db not found" echo "Either install missing proj support files, set PROJ_LIB to the" echo "correct path, and if need be use the --with-proj-share=" echo "configure argument." exit 1 fi [cat > proj_conf_test.c <<_EOCONF #include #include #if PJ_VERSION <= 480 FILE *pj_open_lib(projCtx, const char *, const char *); #endif int main(void) { #if PJ_VERSION <= 480 FILE *fp; #else PAFile fp; #endif projCtx ctx; ctx = pj_get_default_ctx(); fp = pj_open_lib(ctx, "conus", "rb"); if (fp == NULL) exit(1); #if PJ_VERSION <= 480 fclose(fp); #else pj_ctx_fclose(ctx, fp); #endif exit(0); } _EOCONF] ${CC} ${CFLAGS} -o proj_conf_test proj_conf_test.c ${PROJ_LIBS} if test [ -n "$proj_share_path" ] ; then PROJ_LIB="${proj_share_path}" ./proj_conf_test proj_share=`echo $?` else ./proj_conf_test proj_share=`echo $?` fi AC_MSG_CHECKING(PROJ: conus found and readable) if test ${proj_share} -eq 1 ; then WARN="warn" AC_MSG_RESULT(no) else AC_MSG_RESULT(yes) fi rm -f proj_conf_test.c proj_conf_test if test "$WARN" = "warn" ; then echo "Note: proj/conus not found" echo "No support available in PROJ4 for NAD grid datum transformations" echo "If required, consider re-installing from source with the contents" echo "of proj-datumgrid-1..zip from http://download.osgeo.org/proj/ in nad/." fi fi # PROJH = no fi # proj >= 6 # # GEOS: # GEOS_CONFIG="geos-config" GEOS_CONFIG_SET="no" AC_ARG_WITH([geos-config], AS_HELP_STRING([--with-geos-config=GEOS_CONFIG],[the location of geos-config]), [geos_config=$withval]) if test [ -n "$geos_config" ] ; then GEOS_CONFIG_SET="yes" AC_SUBST([GEOS_CONFIG],["${geos_config}"]) AC_MSG_NOTICE(geos-config set to $GEOS_CONFIG) fi if test ["$GEOS_CONFIG_SET" = "no"] ; then AC_PATH_PROG([GEOS_CONFIG], ["$GEOS_CONFIG"],["no"]) if test ["$GEOS_CONFIG" = "no"] ; then AC_MSG_RESULT(no) AC_MSG_ERROR([geos-config not found or not executable. ${GENERIC_INSTALL_MESSAGE}]) fi else AC_MSG_CHECKING(geos-config exists) if test -r "${GEOS_CONFIG}"; then AC_MSG_RESULT(yes) else AC_MSG_RESULT(no) AC_MSG_ERROR([geos-config not found - configure argument error. ${GENERIC_INSTALL_MESSAGE}]) fi AC_MSG_CHECKING(geos-config executable) if test -x "${GEOS_CONFIG}"; then AC_MSG_RESULT(yes) else AC_MSG_RESULT(no) AC_MSG_ERROR([geos-config not executable. ${GENERIC_INSTALL_MESSAGE}]) fi fi AC_MSG_CHECKING(geos-config usability) if test `${GEOS_CONFIG} --version` then GEOS_CLIBS="`${GEOS_CONFIG} --clibs`" #GEOS_DEP_CLIBS=`geos-config --static-clibs` -- this gives -m instead of -lm, which breaks clang # fixed in 3.7.0 at https://github.com/libgeos/libgeos/pull/73#issuecomment-262208677 GEOS_DEP_CLIBS=`${GEOS_CONFIG} --static-clibs | sed 's/-m/-lm/g'` GEOS_CPPFLAGS=`${GEOS_CONFIG} --cflags` AC_MSG_RESULT(yes) else AC_MSG_RESULT(no) AC_MSG_ERROR([${GEOS_CONFIG} not usable]) fi GEOS_VERSION=`${GEOS_CONFIG} --version` AC_MSG_NOTICE([GEOS: ${GEOS_VERSION}]) AC_MSG_CHECKING([GEOS version >= 3.4.0]) # GDAL 2.0.1 requires GEOS 3.1.0 GEOS_VER_DOT=`echo $GEOS_VERSION | tr -d ".[[:alpha:]]"` if test ${GEOS_VER_DOT} -lt 340 ; then AC_MSG_RESULT(no) AC_MSG_ERROR([upgrade GEOS to 3.4.0 or later]) else AC_MSG_RESULT(yes) fi AC_SUBST([PKG_CPPFLAGS], ["${INPKG_CPPFLAGS} ${PROJ_CPPFLAGS} ${GDAL_CPPFLAGS} ${GEOS_CPPFLAGS}"]) AC_SUBST([PKG_LIBS], ["${INPKG_LIBS} ${GDAL_LIBS}"]) if test "${NEED_DEPS}" = yes; then AC_SUBST([PKG_LIBS], ["${PKG_LIBS} ${GDAL_DEP_LIBS}"]) fi # honor PKG_xx overrides # for CPPFLAGS we will superfluously double R's flags # since we'll set PKG_CPPFLAGS with this, but that shouldn't hurt CPPFLAGS="${CPPFLAGS} ${PKG_CPPFLAGS}" LIBS="${LIBS} ${PKG_LIBS}" geosok=yes AC_CHECK_HEADERS(geos_c.h,,geosok=no) if test "${geosok}" = no; then AC_MSG_ERROR([geos_c.h not found in given locations. ${GENERIC_INSTALL_MESSAGE}]) fi [cat > geos_test.cpp <<_EOCONF #include #ifdef __cplusplus extern "C" { #endif static void __errorHandler(const char *fmt, ...) { return; } static void __warningHandler(const char *fmt, ...) { return; } int main(void) { GEOSContextHandle_t r = initGEOS_r((GEOSMessageHandler) __warningHandler, (GEOSMessageHandler) __errorHandler); finishGEOS_r(r); } #ifdef __cplusplus } #endif _EOCONF] #echo "${CXX} ${CPPFLAGS} -o geos_test geos_test.cpp ${LIBS}" AC_MSG_CHECKING(geos: linking with ${GEOS_CLIBS}) ${CXX} ${CPPFLAGS} -o geos_test geos_test.cpp ${GEOS_CLIBS} 2> errors.txt if test `echo $?` -ne 0 ; then geosok=no AC_MSG_RESULT(no) else AC_SUBST([PKG_LIBS], ["${PKG_LIBS} ${GEOS_CLIBS}"]) AC_MSG_RESULT(yes) fi if test "${geosok}" = no; then AC_MSG_CHECKING(geos: linking with ${GEOS_DEP_CLIBS}) ${CXX} ${CPPFLAGS} -o geos_test geos_test.cpp ${GEOS_DEP_CLIBS} 2> errors.txt if test `echo $?` -ne 0 ; then geosok=no AC_MSG_RESULT(no) cat errors.txt AC_MSG_NOTICE([Install failure: compilation and/or linkage problems.]) AC_MSG_ERROR([initGEOS_r not found in libgeos_c. ${GENERIC_INSTALL_MESSAGE}]) else AC_SUBST([PKG_LIBS], ["${PKG_LIBS} ${GEOS_DEP_CLIBS}"]) AC_MSG_RESULT(yes) fi fi rm -f geos_test errors.txt geos_test.cpp # # add PROJ_LIBS # AC_SUBST([PKG_LIBS], ["${PROJ_LIBS} ${PKG_LIBS}"]) # # concluding substitution # AC_MSG_NOTICE([Package CPP flags: ${PKG_CPPFLAGS}]) AC_MSG_NOTICE([Package LIBS: ${PKG_LIBS}]) AC_CONFIG_FILES(src/Makevars) AC_OUTPUT ================================================ FILE: demo/00Index ================================================ affine demo script for affine transformations basic simple feature test script ggplot shows use of geom_sf meuse_sf create meuse simple feature table from data.frame nc load (read) North Carolina sids data set from a geopackage file twitter twitter globe demo ================================================ FILE: demo/affine.R ================================================ library(sf) a = 0.95 b = 0.8 ang = 3 * pi / 180 rot = function(a) matrix(c(cos(a), sin(a), -sin(a), cos(a)), 2, 2) n = 12 drift = c(.12, .07) outer = rbind(c(-1,-1), c(1, -1), c(1, 1), c(-1, 1), c(-1, -1)) hole = a * outer[5:1,] # only shift: p = st_sfc(lapply(0:n, function(i) { st_polygon(list(outer, hole)) * rot(0) * b^i + drift * i * b ^ i } )) plot(p, col = grey(0:n/n), border = 0) # shift + rotate: p = st_sfc(lapply(0:n, function(i) { st_polygon(list(outer, hole)) * rot(i * ang) * b ^ i + drift * i * b ^ i } )) p plot(p, col = grey(0:n/n), border = 0) g = st_geometrycollection(p) plot(g) mp = st_multipolygon(p) opar = par(mfrow = c(2,2), mar = rep(0,4)) plot(mp * rot(10)) plot(mp * rot(20)) plot(mp * rot(30)) plot(mp * rot(40)) par(opar) ================================================ FILE: demo/basic.R ================================================ ## ----error=TRUE---------------------------------------------------------- library(sf) (p1 = st_point(c(1,2))) class(p1) st_bbox(p1) (p2 = st_point(c(1,2,3))) class(p2) (p3 = st_point(c(1,2,3), "XYM")) (p4 = st_point(c(1,2,3,4))) attr(try(st_point(1)), "condition") # Error: attr(try(st_point(1:5)), "condition") # Error: ## ----error=TRUE---------------------------------------------------------- pts = matrix(1:10, , 2) (mp1 = st_multipoint(pts)) pts = matrix(1:15, , 3) (mp2 = st_multipoint(pts)) (mp3 = st_multipoint(pts, "XYM")) pts = matrix(1:20, , 4) (mp4 = st_multipoint(pts)) attr(try(st_multipoint(1)), "condition") # Error: attr(try(st_multipoint(1:5)), "condition") # Error: st_bbox(mp1) ## ----error=TRUE---------------------------------------------------------- pts = matrix(1:10, , 2) (ls1 = st_linestring(pts)) pts = matrix(1:15, , 3) (ls2 = st_linestring(pts)) (ls3 = st_linestring(pts, "XYM")) pts = matrix(1:20, , 4) (ls4 = st_linestring(pts)) attr(try(st_linestring(pts[1,])), "condition") # Error: attr(try(st_linestring(matrix(1:10, 2))), "condition")# Error: st_bbox(ls1) ## ----error=TRUE---------------------------------------------------------- outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) pts = list(outer, hole1, hole2) (ml1 = st_multilinestring(pts)) pts3 = lapply(pts, function(x) cbind(x, 0)) (ml2 = st_multilinestring(pts3)) (ml3 = st_multilinestring(pts3, "XYM")) pts4 = lapply(pts3, function(x) cbind(x, 0)) (ml4 = st_multilinestring(pts4)) st_bbox(ml1) ## ----error=TRUE---------------------------------------------------------- outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) outer hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) pts = list(outer, hole1, hole2) (pl1 = st_polygon(pts)) pts3 = lapply(pts, function(x) cbind(x, 0)) (pl2 = st_polygon(pts3)) (pl3 = st_polygon(pts3, "XYM")) pts4 = lapply(pts3, function(x) cbind(x, 0)) (pl4 = st_polygon(pts4)) st_bbox(pl1) ## ----error=TRUE---------------------------------------------------------- outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) outer hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) pol1 = list(outer, hole1, hole2) pol2 = list(outer + 12, hole1 + 12) pol3 = list(outer + 24) mp = list(pol1,pol2,pol3) (mp1 = st_multipolygon(mp)) pts3 = lapply(mp, function(x) lapply(x, function(y) cbind(y, 0))) (mp2 = st_multipolygon(pts3)) (mp3 = st_multipolygon(pts3, "XYM")) pts4 = lapply(mp2, function(x) lapply(x, function(y) cbind(y, 0))) (mp4 = st_multipolygon(pts4)) st_bbox(mp1) ## ----error=TRUE---------------------------------------------------------- outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) outer hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) pol1 = list(outer, hole1, hole2) pol2 = list(outer + 12, hole1 + 12) pol3 = list(outer + 24) mp = list(pol1,pol2,pol3) mp1 = st_multipolygon(mp) (gc = st_geometrycollection(list(p1, ls1, pl1, mp1))) st_bbox(gc) attr(try(st_geometrycollection(list(mp3, pl1))), "condition") # Error: ================================================ FILE: demo/ggplot.R ================================================ library(sf) nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) # single map: library(ggplot2) ggplot(nc) + geom_sf(aes(fill = SID79)) # multiple plot with facet_grid: library(dplyr) library(tidyr) nc$row = 1:100 nc.g <- nc %>% select(SID74, SID79, row) %>% gather(VAR, SID, -row, -geometry) ggplot(nc.g) + geom_sf(aes(fill = SID)) + facet_grid(. ~ VAR) ggplot(nc.g) + geom_sf(aes(fill = SID)) + facet_grid(VAR ~ .) ================================================ FILE: demo/meuse_sf.R ================================================ data(meuse, package = "sp") # load data.frame from sp library(sf) meuse_sf = st_as_sf(meuse, coords = c("x", "y"), crs = 28992) meuse_sf[1:5,] summary(meuse_sf[1:5,]) ================================================ FILE: demo/nc.R ================================================ ## this object was created as follows: library(sf) # nc = st_read(system.file("shapes/", package="maptools"), "sids") # st_crs(nc) = 4267 # "+proj=longlat +ellps=clrk66" or "+proj=longlat +datum=NAD27" # print(nc, n = 3) # st_write(nc, "nc.gpkg", "nc.gpkg", driver = "GPKG") # description of the dataset, see vignette in package spdep: # https://cran.r-project.org/web/packages/spdep/vignettes/sids.pdf datasource = { if ("GPKG" %in% st_drivers()$name) system.file("gpkg/nc.gpkg", package="sf") else system.file("shape/nc.shp", package="sf") } agr = c(AREA = "aggregate", PERIMETER = "aggregate", CNTY_ = "identity", CNTY_ID = "identity", NAME = "identity", FIPS = "identity", FIPSNO = "identity", CRESS_ID = "identity", BIR74 = "aggregate", SID74 = "aggregate", NWBIR74 = "aggregate", BIR79 = "aggregate", SID79 = "aggregate", NWBIR79 = "aggregate") nc = st_read(datasource, agr = agr, quiet = TRUE) ================================================ FILE: demo/twitter.R ================================================ # see https://gist.github.com/edzer/9c5c24434ffcaf42917796a98c4dd9a6 library(sf) data(wrld_simpl, package = "maptools") w <- st_as_sf(wrld_simpl) w = st_make_valid(w) st_crs(w) = st_crs(4326) set.seed(131) w$f = factor(sample(1:12, nrow(w), replace = TRUE)) # all points long l, lat p for which cos(c) = 0; l0 = lon0, p0 = lat0 # cos(c) = sin(p0)*sin(p) + cos(p0)*cos(p)*cos(l-l0) = 0 # sin(p0)*sin(p) = - cos(p0)*cos(p)*cos(l-l0) # sin(p)/cos(p) = -cos(p0)*cos(l-l0)/sin(p0) # tan(p) = -cos(l-l0)/tan(p0) # p = atan(-cos(l-l0)/tan(p0)) # vary l, compute corresponding p; # all gc's have all longitudes, except when the poles are part of it; # in that case, lat0 == p0 = 0 and p is always pi/2 circ = function(l = c(-180:180), lon0 = 0, lat0 = 30) { deg2rad = pi / 180 lat = atan(-cos((l - lon0) * deg2rad)/tan(lat0 * deg2rad)) / deg2rad xy = if (lat0 == 0) { l1 = lon0 - 90 l2 = lon0 + 90 rbind(c(l1,-90), c(l2,-90), c(l2,0), c(l2,90), c(l1,90), c(l1,0), c(l1,-90)) } else if (lat0 > 0) { xy = cbind(lon = l, lat = lat) rbind(c(-180,90),xy,c(180,90),c(-180,90)) } else { xy = cbind(lon = l, lat = lat)[length(l):1,] rbind(c(180,-90), xy, c(-180,-90),c(180,-90)) } st_sfc(st_polygon(list(xy)), crs = st_crs(4326)) # TODO: break at dateline, guarantee within -180,180 } m = st_make_grid() m = st_segmentize(m, 4e5) #library(animation) #saveGIF( #for (i in 0:100) { # par(mar = rep(0,4)) # lat=30+(i/2) # lon=-10-(i/2) # print(c(i,lon,lat)) # p4s=paste0("+proj=ortho +lat_0=", lat, " +lon_0=", lon) # plot(st_transform(m, st_crs(p4s), check = TRUE), col = 'lightblue', border = 'grey') # crc = circ(lat0 = lat, lon0 = lon) # w0 = suppressWarnings(st_intersection(w, crc)) # w0 = st_cast(w0, "MULTIPOLYGON") # plot(st_transform(w0["f"], st_crs(p4s), check = TRUE), add = TRUE) #} #, interval = 0.05, clean = FALSE) ================================================ FILE: inst/CITATION ================================================ citHeader("To cite package sf in publications, please use:") bibentry(bibtype = "Book", author= "Edzer Pebesma and Roger Bivand", title = "{Spatial Data Science: With applications in R}", year = 2023, publisher = "{Chapman and Hall/CRC}", url = "https://r-spatial.org/book/", doi = "10.1201/9780429459016", textVersion = "Pebesma, E., & Bivand, R. (2023). Spatial Data Science: With Applications in R. Chapman and Hall/CRC. https://doi.org/10.1201/9780429459016" ) bibentry(bibtype = "Article", author = "Edzer Pebesma", title = "{Simple Features for R: Standardized Support for Spatial Vector Data}", year = 2018, journal = "{The R Journal}", doi = "10.32614/RJ-2018-009", url = "https://doi.org/10.32614/RJ-2018-009", pages = "439--446", volume = 10, number = 1, textVersion = "Pebesma, E., 2018. Simple Features for R: Standardized Support for Spatial Vector Data. The R Journal 10 (1), 439-446, https://doi.org/10.32614/RJ-2018-009" ) ================================================ FILE: inst/csv/pt.csv ================================================ Id,Int64,Int32,WKT 1,0,33,POINT(0 1) 2,4294967297,44,POINT(44 55) 3,,,POINT(0 0) ================================================ FILE: inst/docker/README.md ================================================ # Build and check sf against r-release and r-devel See [here](https://github.com/rocker-org/geospatial) for general docker files building R with a significant number of spatial extension packages and external dependencies, based on [rocker](https://github.com/rocker-org/rocker) and debian. To allows building `sf` in alternative environments with all external system requirements (udunits, proj, gdal, geos, lwgeom), this directory has subdirectories with Docker files: * [base](base): for installing R-release with all system dependencies required by `sf`, * [devel](devel): for building R-devel from source (downloaded from svn, without X11) on top of that. * [gdal](gdal): for testing with newer/newst gdal/geos/proj versions * [custom](custom): for testing with libraries (gdal, geos, proj.4) installed in custom, non-standard directories * [lowest](lowest): for checking sf against the lowest required PROJ, GDAL and GEOS versions * [fedora](fedora): for checking sf against the fedora/clang platform * [cran](cran): using the debian setup used by several of the CRAN linux servers Except for the cran image, all images are built on ubuntu:16.04 (xenial). They use [ubuntugis-unstable](https://launchpad.net/~ubuntugis/+archive/ubuntu/ubuntugis-unstable) for GIS package system dependencies. ## run check under R release In directory `base`, type docker build . -t sf this will build a docker image of approx. 3.8 Gb size, called `sf`. It will also install package `sf` with its dependencies from CRAN, and run a check on the github sources. Run a container from this image interactively with docker run -ti sf If you want to run it while mounting the current working directory (`pwd`) to `/pkg` inside the container, and want to remove the container after you exit, use: docker run -v `pwd`:/pkg --rm -ti sf ## build R-devel, check with R-devel _After_ you built docker image `sf` above, on top of that you can install r-devel; it counts up to 4 Gb. Build it by executing the following command in the `devel` directory: docker build . -t sf_devel Run a container from this image interactively with docker run -ti sf_devel to start R-devel in the container, use the `Rdevel` command. Building the image checks sf from github. If you want to run R with `gdb` in a container, use e.g. docker run --cap-add=SYS_PTRACE --security-opt seccomp=unconfined -ti gdal3 ## with custom gdal, geos and proj installs ================================================ FILE: inst/docker/alma/Dockerfile ================================================ # # Do not edit: NOW CONTINUED IN # https://github.com/Open-EO/openeo-udf-python-to-r/tree/main/docker # ARG SPARK_VERSION ARG PYTHON_PACKAGE FROM almalinux:8.5 ARG SPARK_VERSION ARG PYTHON_PACKAGE COPY vito.repo /etc/yum.repos.d/vito.repo WORKDIR /opt/spark/work-dir RUN adduser -u 18585 -d /opt/spark/work-dir spark && \ chown 18585:18585 /opt/spark/work-dir RUN yum install -y epel-release RUN yum install -y dnf --enablerepo=powertools spark-bin-${SPARK_VERSION} RUN yum install -y --enablerepo=powertools \ gdal-3.4.0 \ gdal-devel-3.4.0 \ python38-gdal-3.4.0 \ gdal-libs-3.4.0 \ unzip \ java-11-openjdk-headless \ krb5-workstation \ krb5-libs \ sssd-client \ ipa-client \ nss \ orfeo-toolbox-py38 \ procps-ng \ ${PYTHON_PACKAGE} \ python38-pytz \ python38-Cython \ fftw-libs-double \ fftw-libs-single \ openeo-vito-aux-data \ tinyxml \ compat-libgfortran-48-4.8.5-36.1.el8.x86_64 && \ ln -s /usr/lib64/libgdal.so.30 /usr/lib64/libgdal.so.26 && \ ln -s /usr/lib64/libgdal.so.30 /usr/lib64/libgdal.so.27 && \ pip3 install --upgrade pip setuptools && \ rm -r /root/.cache && \ yum clean all && \ rm -rf /var/cache/yum/* ENV SPARK_HOME /usr/local/spark ENV JAVA_HOME /usr/lib/jvm/jre ENV PYSPARK_PYTHON=python3 ENV HADOOP_HOME=/usr/hdp/current/hadoop-client ENV HADOOP_CONF_DIR=/etc/hadoop/conf ENV YARN_CONF_DIR=/etc/hadoop/conf ENV ACCUMULO_CLIENT_CONF_PATH=client.conf ENV OTB_HOME=/usr ENV OTB_APPLICATION_PATH=/usr/lib/otb/applications # EP: install R, system requirements of R-spatial packages, and R package stars RUN yum install -y dnf --enablerepo=powertools R-core-devel RUN yum install -y dnf --enablerepo=powertools \ udunits2-devel \ openssl-devel \ sqlite-devel \ geos-devel \ proj-devel \ libcurl-devel \ git RUN R -e 'install.packages(c("stars", "jsonlite", "curl", "lubridate"), repos = "https://cloud.r-project.org")' RUN pip3 install rpy2 xarray requests dask # original: USER 18585 # EP: install UDF test script and run it: RUN git clone https://github.com/Open-EO/openeo-udf-python-to-r.git RUN (cd openeo-udf-python-to-r; python3 test.py) ================================================ FILE: inst/docker/alma/README.md ================================================ VITO openEO backend image; build this docker container with ``` docker build . -t alma --build-arg SPARK_VERSION=3.2.0 --build-arg PYTHON_PACKAGE=python38-devel ``` ================================================ FILE: inst/docker/alma/build_command ================================================ docker build . -t alma --build-arg SPARK_VERSION=3.2.0 --build-arg PYTHON_PACKAGE=python38-devel ================================================ FILE: inst/docker/alma/vito.repo ================================================ [vito-public-alma] name=vito-yum-centos-public baseurl=https://artifactory.vgt.vito.be/vito-yum-almalinux8-public/ gpgcheck=0 [vito-public] name=vito-yum-centos-public baseurl=https://artifactory.vgt.vito.be/vito-yum-centos8-public/ gpgcheck=0 ================================================ FILE: inst/docker/arrow/Dockerfile ================================================ FROM ubuntu:22.04 # minimal docker file to get sf running on ubunty 22.04 image, # compiling geos/proj/gdal from source, using cmake MAINTAINER "edzerpebesma" edzer.pebesma@uni-muenster.de RUN apt-get update && apt-get install -y software-properties-common dirmngr RUN add-apt-repository ppa:ubuntugis/ubuntugis-unstable RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E298A3A825C0D65DFD57CBB651716619E084DAB9 # add the R 4.0 repo from CRAN -- adjust 'focal' to 'groovy' or 'bionic' as needed RUN add-apt-repository "deb https://cloud.r-project.org/bin/linux/ubuntu $(lsb_release -cs)-cran40/" RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E084DAB9 RUN apt-get update RUN apt-get upgrade -y RUN export DEBIAN_FRONTEND=noninteractive; apt-get -y update \ && apt-get install -y \ gdb \ git \ libcairo2-dev \ libcurl4-openssl-dev \ libexpat1-dev \ libpq-dev \ libsqlite3-dev \ libudunits2-dev \ libblosc-dev \ make \ pandoc \ qpdf \ r-base-dev \ sqlite3 \ subversion \ valgrind \ vim \ tk-dev \ wget \ cmake \ libtiff5-dev \ libjq-dev \ libprotobuf-dev \ libxml2-dev \ libprotobuf-dev \ protobuf-compiler \ unixodbc-dev \ libssh2-1-dev \ libgit2-dev \ libnetcdf-dev \ locales \ locales-all \ libssl-dev \ libhdf4-alt-dev \ libtiff-dev \ devscripts ENV LC_ALL en_US.UTF-8 ENV LANG en_US.UTF-8 ENV LANGUAGE en_US.UTF-8 # add arrow/parquet: # RUN apt install -y -V ca-certificates lsb-release wget # done RUN wget https://apache.jfrog.io/artifactory/arrow/$(lsb_release --id --short | tr 'A-Z' 'a-z')/apache-arrow-apt-source-latest-$(lsb_release --codename --short).deb RUN apt install -y -V ./apache-arrow-apt-source-latest-$(lsb_release --codename --short).deb RUN apt update RUN apt install -y -V libarrow-dev # For C++ RUN apt install -y -V libarrow-glib-dev # For GLib (C) RUN apt install -y -V libarrow-dataset-dev # For Apache Arrow Dataset C++ RUN apt install -y -V libarrow-dataset-glib-dev # For Apache Arrow Dataset GLib (C) RUN apt install -y -V libarrow-flight-dev # For Apache Arrow Flight C++ RUN apt install -y -V libarrow-flight-glib-dev # For Apache Arrow Flight GLib (C) # Notes for Plasma related packages: # * You need to enable "non-free" component on Debian GNU/Linux # * You need to enable "multiverse" component on Ubuntu # * You can use Plasma related packages only on amd64 RUN apt install -y -V libplasma-dev # For Plasma C++ RUN apt install -y -V libplasma-glib-dev # For Plasma GLib (C) RUN apt install -y -V libgandiva-dev # For Gandiva C++ RUN apt install -y -V libgandiva-glib-dev # For Gandiva GLib (C) RUN apt install -y -V libparquet-dev # For Apache Parquet C++ RUN apt install -y -V libparquet-glib-dev # For Apache Parquet GLib (C) RUN locale-gen en_US.UTF-8 ENV LD_LIBRARY_PATH=/usr/local/lib:$LD_LIBRARY_PATH # GEOS: ENV GEOS_VERSION 3.11.0 RUN wget -q http://download.osgeo.org/geos/geos-${GEOS_VERSION}.tar.bz2 \ && bzip2 -d geos-*bz2 \ && tar xf geos*tar \ && cd geos* \ && mkdir build \ && cd build \ && cmake .. \ && make \ && make install \ && cd ../.. \ && ldconfig #RUN git clone --depth 1 https://github.com/OSGeo/PROJ.git # https://download.osgeo.org/proj/proj-9.0.0RC1.tar.gz ENV PROJ_VERSION 9.0.1 RUN wget -q http://download.osgeo.org/proj/proj-${PROJ_VERSION}.tar.gz RUN tar zxvf proj-${PROJ_VERSION}.tar.gz RUN cd proj* \ && ls -l \ && mkdir build \ && cd build \ && cmake .. \ && make \ && make install \ && cd ../.. \ && ldconfig # GDAL: ENV GDAL_VERSION 3.5.1 ENV GDAL_VERSION_NAME 3.5.1 RUN wget -q http://download.osgeo.org/gdal/${GDAL_VERSION}/gdal-${GDAL_VERSION_NAME}.tar.gz \ && tar -xf gdal-${GDAL_VERSION_NAME}.tar.gz \ && cd gdal* \ && mkdir build \ && cd ./build \ && cmake -DCMAKE_BUILD_TYPE=Release .. \ && make \ && make install \ && ldconfig RUN Rscript -e 'install.packages(c("sp", "rgeos", "rgdal", "RPostgreSQL", "RSQLite", "testthat", "knitr", "tidyr", "geosphere", "maptools", "maps", "microbenchmark", "raster", "dplyr", "tibble", "units", "DBI", "covr", "protolite", "tmap", "mapview", "odbc", "pool", "rmarkdown", "RPostgres","spatstat", "stars", "XML", "tmaptools", "tmap", "terra", "PCICt", "RNetCDF", "future.apply", "ggforce", "ggthemes", "gstat", "ncmeta", "pbapply", "plm", "spacetime", "xts", "zoo", "tidync", "ncdfgeom", "cubelyr", "clue", "rmarkdown", "classInt", "mapview", "tmap", "exactextractr"))' RUN git clone --depth 10 https://github.com/r-spatial/sf.git RUN git clone --depth 10 https://github.com/r-spatial/lwgeom.git RUN git clone --depth 10 https://github.com/r-spatial/stars.git #RUN git config --global user.email "edzer.pebesma@uni-muenster.de" RUN R CMD build --no-build-vignettes --no-manual lwgeom RUN R CMD build --no-build-vignettes --no-manual sf # RUN pkg-config proj --modversion RUN R CMD INSTALL sf RUN R CMD INSTALL lwgeom RUN R CMD INSTALL stars #RUN R CMD build --no-build-vignettes --no-manual sf #RUN R CMD check --no-build-vignettes --no-manual --as-cran sf_*.tar.gz #RUN R CMD check --no-build-vignettes --no-manual --as-cran lwgeom_*.tar.gz #RUN Rscript -e 'install.packages("starsdata", repos="http://gis-bigdata.uni-muenster.de/pebesma/")' #RUN R CMD build --no-manual stars #RUN _R_CHECK_FORCE_SUGGESTS_=false R CMD check --no-build-vignettes --no-manual --as-cran stars_*.tar.gz ================================================ FILE: inst/docker/base/Dockerfile ================================================ FROM ubuntu:16.04 # minimal docker file to get sp and sf running on ubunty 16.04 image, # using gdal/geos/proj from ppa:ubuntugis/ubuntugis-unstable MAINTAINER "edzerpebesma" edzer.pebesma@uni-muenster.de RUN apt-get update && apt-get install -y software-properties-common RUN add-apt-repository ppa:ubuntugis/ubuntugis-unstable RUN echo "deb http://cran.rstudio.com/bin/linux/ubuntu xenial/ " >> /etc/apt/sources.list RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E084DAB9 RUN apt-get update RUN apt-get upgrade -y RUN export DEBIAN_FRONTEND=noninteractive; apt-get -y update \ && apt-get install -y \ libcurl4-openssl-dev \ qpdf \ pandoc \ make \ wget \ git \ libgdal-dev \ libgeos-dev \ libproj-dev \ liblwgeom-dev \ libudunits2-dev \ postgis \ r-base-dev RUN apt-get install -y texinfo \ texlive-base \ texlive-extra-utils \ texlive-fonts-extra \ texlive-fonts-recommended \ texlive-generic-recommended \ texlive-latex-base \ texlive-latex-extra \ texlive-latex-recommended # stuff for the tmaptools/rmapshaper/geojsonio etc stack: RUN apt-get install -y libv8-3.14-dev libprotobuf-dev protobuf-compiler libcairo2-dev RUN add-apt-repository -y ppa:opencpu/jq RUN apt-get update RUN apt-get install -y libjq-dev RUN Rscript -e 'install.packages(c("sf", "lwgeom", "covr", "raster"), dependencies = TRUE, repos = "https://cloud.r-project.org")' RUN git clone https://github.com/r-spatial/sf.git RUN R CMD build --no-build-vignettes sf RUN R CMD INSTALL sf_*tar.gz RUN apt-get install -y pandoc pandoc-citeproc RUN R CMD check --as-cran sf_*tar.gz CMD ["/bin/bash"] ================================================ FILE: inst/docker/bionic/Dockerfile ================================================ FROM ubuntu:18.04 # minimal docker file to get sp and sf running on ubunty 16.04 image, # using gdal/geos/proj from ppa:ubuntugis/ubuntugis-unstable MAINTAINER "edzerpebesma" edzer.pebesma@uni-muenster.de RUN apt-get update && apt-get install -y software-properties-common #RUN add-apt-repository ppa:ubuntugis/ubuntugis-unstable #RUN echo "deb http://cran.rstudio.com/bin/linux/ubuntu bionic/ " >> /etc/apt/sources.list RUN echo "deb http://cran.rstudio.com/bin/linux/ubuntu bionic-cran35/ " >> /etc/apt/sources.list #RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E084DAB9 RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E298A3A825C0D65DFD57CBB651716619E084DAB9 RUN apt-get update RUN apt-get upgrade -y RUN export DEBIAN_FRONTEND=noninteractive; apt-get -y update \ && apt-get install -y \ libcurl4-openssl-dev \ qpdf \ pandoc \ make \ wget \ git \ libgdal-dev \ libgeos-dev \ libproj-dev \ liblwgeom-dev \ libudunits2-dev \ postgis \ r-base-dev # stuff for the tmaptools/rmapshaper/geojsonio etc stack: RUN apt-get install -y libv8-3.14-dev libprotobuf-dev protobuf-compiler libcairo2-dev #RUN add-apt-repository -y ppa:opencpu/jq #RUN apt-get update RUN apt-get install -y libjq-dev RUN Rscript -e 'install.packages(c("sf", "lwgeom", "covr", "raster"), dependencies = TRUE, repos = "https://cloud.r-project.org")' RUN git clone https://github.com/r-spatial/sf.git RUN R CMD build --no-build-vignettes sf RUN R CMD INSTALL sf_*tar.gz RUN apt-get install -y pandoc pandoc-citeproc #RUN R CMD check --as-cran sf_*tar.gz CMD ["/bin/bash"] ================================================ FILE: inst/docker/cran/Dockerfile ================================================ FROM debian:testing # minimal docker file to get sp and sf running on ubunty 16.04 image, # using gdal/geos/proj from ppa:ubuntugis/ubuntugis-unstable MAINTAINER "edzerpebesma" edzer.pebesma@uni-muenster.de RUN apt-get update RUN export DEBIAN_FRONTEND=noninteractive; apt-get -y update \ && apt-get install -y \ ca-certificates \ gnupg2 RUN echo "deb https://statmath.wu.ac.at/AASC/debian testing main non-free" >> /etc/apt/sources.list RUN echo "deb http://ftp.de.debian.org/debian unstable main contrib non-free" >> /etc/apt/sources.list RUN echo 'APT::Default-Release "testing";' >> /etc/apt/apt.conf RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys 2302BCB1 RUN apt-get update RUN apt-get upgrade -y RUN export DEBIAN_FRONTEND=noninteractive; apt-get install -y libv8-dev pdftk RUN apt-get -y clean RUN apt-get -y autoclean RUN apt-get install -y kdelibs-bin kdelibs5-dev RUN export DEBIAN_FRONTEND=noninteractive; apt-get install -y \ rcheckserver ### From here on: spatial R stack RUN export DEBIAN_FRONTEND=noninteractive; apt-get install -y git RUN Rscript -e 'install.packages(c("sp","rgeos","rgdal","RPostgreSQL","RSQLite","testthat","knitr","tidyr","geosphere","maptools","maps","microbenchmark", "raster", "dplyr", "tibble", "units", "DBI", "covr", "protolite", "tmap", "mapview", "pool", "odbc"), repos = "https://cloud.r-project.org")' RUN Rscript -e 'install.packages("sf", dependencies = TRUE, repos = "https://cloud.r-project.org")' #RUN svn checkout svn://scm.r-forge.r-project.org/svnroot/rgdal/ # or: # svn checkout svn+ssh://edzer@scm.r-forge.r-project.org/svnroot/rgdal/ #RUN R CMD build rgdal/pkg --no-build-vignettes #RUN R CMD INSTALL rgdal_*.tar.gz RUN ls RUN git clone --depth 1 https://github.com/r-spatial/sf.git RUN R CMD build sf RUN R CMD INSTALL sf_*gz #RUN apt-get install -y unixodbc-dev #RUN Rscript -e 'install.packages(c("lwgeom", "tmap", "pool", "odbc", "mapview"), repos = "https://cloud.r-project.org")' #RUN R CMD check --no-build-vignettes --no-manual --as-cran --run-dontrun sf_*tar.gz RUN R CMD check --as-cran sf_*tar.gz CMD ["/bin/bash"] ================================================ FILE: inst/docker/custom/Dockerfile ================================================ FROM ubuntu:18.04 # minimal docker file to get sf running on an ubunty 16.04 image, # installing gdal, geos and proj.4 from source in a non-standard location MAINTAINER "edzerpebesma" edzer.pebesma@uni-muenster.de RUN apt-get update && apt-get install -y software-properties-common RUN add-apt-repository ppa:ubuntugis/ubuntugis-unstable RUN echo "deb http://cran.rstudio.com/bin/linux/ubuntu bionic-cran35/ " >> /etc/apt/sources.list RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E298A3A825C0D65DFD57CBB651716619E084DAB9 RUN apt-get update RUN apt-get upgrade -y RUN export DEBIAN_FRONTEND=noninteractive; apt-get -y update \ && apt-get install -y \ libcurl4-openssl-dev \ libsqlite3-dev \ sqlite3 \ qpdf \ pandoc \ make \ wget \ git \ cmake \ libudunits2-dev \ libtiff5-dev \ pkg-config \ r-base-dev RUN cd \ && mkdir /opt/proj /opt/share \ && wget http://download.osgeo.org/proj/proj-7.0.0.tar.gz \ && tar zxvf proj-7.0.0.tar.gz \ && cd proj-7.0.0 \ && ./configure --prefix=/opt/proj --datadir=/opt/share \ && make \ && make install install-am RUN cd \ && wget http://download.osgeo.org/gdal/3.0.4/gdal-3.0.4.tar.gz \ && tar zxvf gdal-3.0.4.tar.gz \ && cd gdal-3.0.4 \ && mkdir /opt/gdal \ && ./configure --prefix=/opt/gdal --with-proj=/opt/proj \ && make \ && make install RUN mkdir /opt/geos \ && cd \ && wget http://download.osgeo.org/geos/geos-3.8.1.tar.bz2 \ && bunzip2 -c geos-3.8.1.tar.bz2 | tar xvf - \ && cd geos-3.8.1 \ && mkdir build \ && cd build \ && cmake -DCMAKE_INSTALL_PREFIX:PATH=/opt/geos .. \ && make \ && make install RUN R -e 'install.packages(c("Rcpp", "DBI", "units", "magrittr", "classInt"), repos = "https://cran.uni-muenster.de")' #RUN cd /usr/share \ # && mkdir proj \ # && cd proj \ # && wget https://download.osgeo.org/proj/proj-datumgrid-1.7.zip \ # && unzip proj*zip RUN git clone --depth=1 https://github.com/r-spatial/sf.git RUN cd / \ && R CMD build sf --no-build-vignettes # RUN PKG_CONFIG_PATH=/opt/proj/lib/pkgconfig PROJ_DATA=/opt/proj/share/proj GDAL_DATA=/opt/gdal/share/gdal/ LD_LIBRARY_PATH=/opt/gdal/lib:/opt/geos/lib:/opt/proj/lib R CMD INSTALL --configure-args='--with-gdal-config=/opt/gdal/bin/gdal-config --with-proj-include=/opt/proj/include --with-proj-lib=/opt/proj/lib --with-proj-share=/opt/proj/share/proj --with-proj-api=no --with-geos-config=/opt/geos/bin/geos-config' sf_*.tar.gz \ # LD_LIBRARY_PATH=/opt/gdal/lib:/opt/geos/lib:/opt/proj/lib RUN export LD_LIBRARY_PATH=/opt/gdal/lib:/opt/geos/lib:/opt/proj/lib RUN LD_LIBRARY_PATH=/opt/gdal/lib:/opt/geos/lib:/opt/proj/lib \ PKG_CONFIG_PATH=/opt/proj/lib/pkgconfig \ PROJ_DATA=/opt/proj/share/proj \ GDAL_DATA=/opt/gdal/share/gdal/ \ R CMD INSTALL --configure-args='--with-gdal-config=/opt/gdal/bin/gdal-config \ --with-proj-include=/opt/proj/include --with-proj-lib=/opt/proj/lib \ --with-geos-config=/opt/geos/bin/geos-config' sf_*.tar.gz RUN LD_LIBRARY_PATH=/opt/gdal/lib:/opt/geos/lib:/opt/proj/lib R -e 'library(sf)' RUN git clone --depth=1 https://github.com/r-spatial/lwgeom.git RUN R CMD build --no-build-vignettes lwgeom RUN PKG_CONFIG_PATH=/opt/proj/lib/pkgconfig \ LD_LIBRARY_PATH=/opt/gdal/lib:/opt/geos/lib:/opt/proj/lib R CMD INSTALL --configure-args='--with-proj-include=/opt/proj/include --with-proj-lib=/opt/proj/lib --with-geos-config=/opt/geos/bin/geos-config' lwgeom_*.tar.gz RUN PKG_CONFIG_PATH=/opt/proj/lib/pkgconfig LD_LIBRARY_PATH=/opt/gdal/lib:/opt/geos/lib:/opt/proj/lib PROJ_DATA=/opt/proj/share/proj GDAL_DATA=/opt/gdal/share/gdal/ R CMD INSTALL --configure-args='--with-proj-include=/opt/proj/include --with-proj-lib=/opt/proj/lib --with-geos-config=/opt/geos/bin/geos-config' lwgeom_*.tar.gz \ RUN LD_LIBRARY_PATH=/opt/gdal/lib:/opt/geos/lib:/opt/proj/lib R -e 'library(lwgeom)' RUN git clone --depth=1 https://github.com/r-spatial/stars.git RUN R CMD build --no-build-vignettes stars RUN R -e 'install.packages(c("abind", "rlang"))' RUN LD_LIBRARY_PATH=/opt/gdal/lib:/opt/geos/lib:/opt/proj/lib R CMD INSTALL stars_*.tar.gz RUN LD_LIBRARY_PATH=/opt/gdal/lib:/opt/geos/lib:/opt/proj/lib R -e 'library(stars)' CMD ["/bin/bash"] ================================================ FILE: inst/docker/devel/Dockerfile ================================================ FROM ubuntu:24.04 # minimal docker file to get sp and sf running on ubunty 16.04 image, # using gdal/geos/proj from ppa:ubuntugis/ubuntugis-unstable # MAINTAINER "edzerpebesma" edzer.pebesma@uni-muenster.de # update indices RUN apt-get update -qq # install two helper packages we need RUN apt-get install -y --no-install-recommends software-properties-common dirmngr # add the signing key (by Michael Rutter) for these repos # To verify key, run gpg --show-keys /etc/apt/trusted.gpg.d/cran_ubuntu_key.asc # Fingerprint: E298A3A825C0D65DFD57CBB651716619E084DAB9 RUN export DEBIAN_FRONTEND=noninteractive; apt-get install -y wget RUN wget -qO- https://cloud.r-project.org/bin/linux/ubuntu/marutter_pubkey.asc | tee -a /etc/apt/trusted.gpg.d/cran_ubuntu_key.asc # add the R 4.0 repo from CRAN -- adjust 'focal' to 'groovy' or 'bionic' as needed RUN add-apt-repository "deb https://cloud.r-project.org/bin/linux/ubuntu $(lsb_release -cs)-cran40/" RUN apt-get update RUN apt-get upgrade -y RUN export DEBIAN_FRONTEND=noninteractive; apt-get -y update \ && apt-get install -y \ libcurl4-openssl-dev \ qpdf \ pandoc \ make \ wget \ git \ libgdal-dev \ libgeos-dev \ libproj-dev \ libudunits2-dev RUN export DEBIAN_FRONTEND=noninteractive; apt-get install -y \ texinfo \ texlive-base \ texlive-extra-utils \ texlive-fonts-extra \ texlive-fonts-recommended \ texlive-latex-base \ texlive-latex-extra \ texlive-latex-recommended # texlive-generic-recommended \ # stuff for the tmaptools/rmapshaper/geojsonio etc stack: RUN apt-get install -y libv8-dev libprotobuf-dev protobuf-compiler libcairo2-dev pandoc # pandoc-citeproc #RUN add-apt-repository -y ppa:opencpu/jq #RUN apt-get update RUN apt-get install -y libjq-dev ## Check out & build R-devel: RUN apt-get install -y subversion RUN cd /tmp && svn co https://svn.r-project.org/R/trunk R-devel RUN apt-get install -y rsync RUN /tmp/R-devel/tools/rsync-recommended ## Build and install according the standard 'recipe' I emailed/posted years ago RUN apt-get install -y libreadline-dev libbz2-dev #RUN apt-get install -y gfortran RUN apt-get install -y r-base-dev RUN cd /tmp/R-devel \ && R_PAPERSIZE=letter \ R_BATCHSAVE="--no-save --no-restore" \ R_BROWSER=xdg-open \ PAGER=/usr/bin/pager \ PERL=/usr/bin/perl \ R_UNZIPCMD=/usr/bin/unzip \ R_ZIPCMD=/usr/bin/zip \ R_PRINTCMD=/usr/bin/lpr \ LIBnn=lib \ AWK=/usr/bin/awk \ CFLAGS=$(R CMD config CFLAGS) \ CXXFLAGS=$(R CMD config CXXFLAGS) \ ./configure --enable-R-shlib \ --without-blas \ --without-lapack \ --with-readline \ --with-recommended-packages \ --program-suffix=dev \ --with-x=no \ && make \ && make install \ && rm -rf /tmp/R-devel ## Set default CRAN repo RUN echo 'options(repos = c(CRAN = "https://cran.rstudio.com/"), download.file.method = "libcurl")' >> /usr/local/lib/R/etc/Rprofile.site RUN Rscript -e 'install.packages(c("sf", "lwgeom", "covr", "raster"), dependencies = TRUE, repos = "https://cloud.r-project.org")' RUN rm -fr sf RUN git clone https://github.com/r-spatial/sf.git # RUN R CMD build sf #ENV PROJ_VERSION 5.0.1 #ENV LD_LIBRARY_PATH=/usr/local/lib:$LD_LIBRARY_PATH #RUN wget http://download.osgeo.org/proj/proj-${PROJ_VERSION}.tar.gz \ # && tar zxf proj-*tar.gz \ # && cd proj* \ # && ./configure \ # && make \ # && make install \ # && cd .. \ # && ldconfig RUN apt-get install -y cmake RUN Rscript -e 'install.packages(c("s2"), dependencies = FALSE, repos = "https://cloud.r-project.org")' #RUN Rscript -e 'install.packages(c("RPostgres"), dependencies = FALSE, repos = "https://cloud.r-project.org")' RUN cd sf && git pull RUN R CMD build --no-build-vignettes sf RUN R CMD INSTALL sf_*tar.gz RUN Rscript -e 'install.packages(c("lwgeom"), dependencies = FALSE, repos = "https://cloud.r-project.org")' # RUN Rscript -e 'install.packages(c("RPostgreSQL"), dependencies = FALSE, repos = "https://cloud.r-project.org")' RUN _R_CHECK_FORCE_SUGGESTS_=false PROJ_LIB=/usr/share/proj R CMD check --as-cran sf_*tar.gz RUN wget https://cran.r-project.org/src/contrib/gstat_2.1-6.tar.gz RUN Rscript -e 'install.packages(c("stars", "sftime"), dependencies = FALSE, repos = "https://cloud.r-project.org")' RUN Rscript -e 'install.packages(c("mapdata"), repos = "https://cloud.r-project.org")' RUN _R_CHECK_FORCE_SUGGESTS_=false R CMD check gstat*gz CMD ["/bin/bash"] ================================================ FILE: inst/docker/fedora/Dockerfile ================================================ FROM fedora:latest MAINTAINER "edzerpebesma" edzer.pebesma@uni-muenster.de RUN yum install -y gdal-devel geos-devel udunits2-devel proj-devel # RUN yum install -y proj-devel proj-epsg proj-nad RUN yum install -y pandoc RUN yum install -y readline-devel curl-devel wget clang vim git autoconf sqlite-devel RUN yum install -y R-devel # needed by R packages: RUN yum install -y libxml2-devel openssl-devel cairo-devel postgresql-devel unixODBC-devel libuv-devel # install R-devel from source, with clang: RUN wget https://stat.ethz.ch/R/daily/R-devel.tar.gz RUN tar zxvf R-devel.tar.gz # Get https://www.stats.ox.ac.uk/pub/bdr/Rconfig/r-devel-linux-x86_64-fedora-clang into ./config.site: RUN echo $'CC=clang \n\ OBJC=clang \n\ CXX=clang++ \n\ FC=gfortran \n\ F77=gfortran \n\ CFLAGS="-g -O3 -Wall -pedantic -mtune=native" \n\ FFLAGS="-g -O2 -mtune=native -Wall -pedantic" \n\ FCFLAGS="-g -O2 -mtune=native -Wall -pedantic" \n\ CXXFLAGS="-g -O3 -Wall -pedantic -mtune=native -frtti" \n\ CPPFLAGS="-I/usr/local/clang/include -I/usr/local/include" \n\ JAVA_HOME=/usr/lib/jvm/jre-11 \n\ LDFLAGS="-L/usr/local/clang/lib64 -L/usr/local/lib64"' > R-devel/config.site RUN (cd R-devel; ./configure --with-x=no --enable-R-shlib --without-lapack; make clean; make; make install) RUN /usr/local/bin/Rscript -e 'install.packages(c("XML", "Rcpp", "units", "DBI", "classInt", "magrittr", "lwgeom", "tibble", "knitr", "sp", "maps", "markdown", "testthat", "maptools", "dplyr", "rgeos", "rgdal", "tidyr", "stars", "rmarkdown", "covr", "ggplot2", "mapview", "microbenchmark", "odbc", "pool", "raster", "rmarkdown", "RPostgres", "RPostgreSQL", "RSQLite", "spatstat", "tmap"), repos = "https://cloud.r-project.org")' RUN yum install -y abseil-cpp-devel RUN /usr/local/bin/Rscript -e 'install.packages(c("s2", "sf"), repos = "https://cloud.r-project.org")' # get CRAN version of sf/lwgeom: RUN cd .. #RUN wget https://cran.r-project.org/src/contrib/lwgeom_0.2-2.tar.gz RUN /usr/local/bin/R -e 'install.packages("remotes", repos = "https://cloud.r-project.org"); remotes::install_github("r-spatial/lwgeom")' RUN /usr/local/bin/R -e 'install.packages(c("stars", "tmap"), repos = "https://cloud.r-project.org")' #RUN /usr/local/bin/R CMD check --as-cran sf_0.8-1.tar.gz RUN rm -fr lwgeom RUN git clone --depth 1 https://github.com/r-spatial/lwgeom.git RUN R CMD build lwgeom RUN /usr/local/bin/Rscript -e 'install.packages(c("geosphere"), repos = "https://cloud.r-project.org")' #RUN yum install -y xorg-x11-apps # RUN yum install -y xorg-x11-server-Xvfb # RUN yum /usr/bin/Xvfb :99 -screen 0 1280x1024x24 & # RUN /usr/local/bin/Rscript -e 'install.packages(c("Cairo"), repos = "https://cloud.r-project.org")' RUN wget https://cran.r-project.org/src/contrib/gstat_2.1-5.tar.gz RUN /usr/local/bin/Rscript -e 'install.packages(c("zoo", "sftime", "spacetime", "FNN"), repos = "https://cloud.r-project.org")' RUN /usr/local/bin/Rscript -e 'install.packages(c("mapdata"), repos = "https://cloud.r-project.org")' RUN _R_CHECK_FORCE_SUGGESTS_=false /usr/local/bin/R CMD check --no-build-vignettes --no-build-manuals gstat_2.1-5.tar.gz CMD ["/bin/bash"] ================================================ FILE: inst/docker/gdal/Dockerfile ================================================ FROM ubuntu:24.04 # minimal docker file to get sp and sf running on ubunty 16.04 image, # using gdal/geos/proj from ppa:ubuntugis/ubuntugis-unstable MAINTAINER "edzerpebesma" edzer.pebesma@uni-muenster.de RUN apt-get update && apt-get install -y software-properties-common dirmngr RUN add-apt-repository ppa:ubuntugis/ubuntugis-unstable RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E298A3A825C0D65DFD57CBB651716619E084DAB9 # add the R 4.0 repo from CRAN -- adjust 'focal' to 'groovy' or 'bionic' as needed RUN add-apt-repository "deb https://cloud.r-project.org/bin/linux/ubuntu $(lsb_release -cs)-cran40/" RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E084DAB9 RUN apt-get update RUN apt-get upgrade -y RUN export DEBIAN_FRONTEND=noninteractive; apt-get -y update \ && apt-get install -y \ devscripts \ gdb \ git \ libcairo2-dev \ libcurl4-openssl-dev \ libexpat1-dev \ libpq-dev \ libblosc-dev \ libsqlite3-dev \ libudunits2-dev \ make \ pandoc \ qpdf \ r-base-dev \ sqlite3 \ subversion \ valgrind \ vim \ tk-dev \ wget #libv8-3.14-dev \ RUN apt-get update && apt-get install -y --fix-missing \ libjq-dev \ libprotobuf-dev \ libxml2-dev \ libprotobuf-dev \ protobuf-compiler \ unixodbc-dev \ libssh2-1-dev \ libgit2-dev \ libnetcdf-dev \ locales \ libssl-dev \ libtiff-dev \ cmake \ libtiff5-dev \ libopenjp2-7-dev \ libharfbuzz-dev \ libharfbuzz-dev \ libfribidi-dev RUN locale-gen en_US.UTF-8 ENV LANG en_US.UTF-8 ENV LANGUAGE en_US:en ENV LC_ALL en_US.UTF-8 #ENV PROJ_VERSION=7.1.0 ENV LD_LIBRARY_PATH=/usr/local/lib:$LD_LIBRARY_PATH # GEOS: ENV GEOS_VERSION 3.14.1 RUN wget -q http://download.osgeo.org/geos/geos-${GEOS_VERSION}.tar.bz2 \ && bzip2 -d geos-*bz2 \ && tar xf geos*tar \ && cd geos* \ && mkdir build \ && cd build \ && cmake .. \ && make \ && make install \ && cd ../.. \ && ldconfig # PROJ ENV PROJ_VERSION 9.7.1 RUN wget -q http://download.osgeo.org/proj/proj-${PROJ_VERSION}.tar.gz RUN tar zxvf proj-${PROJ_VERSION}.tar.gz RUN cd proj* \ && ls -l \ && mkdir build \ && cd build \ && cmake .. \ && make \ && make install \ && cd ../.. \ && ldconfig # GDAL: ENV GDAL_VERSION 3.13.0 ENV GDAL_VERSION_NAME 3.13.0beta1 RUN wget -q http://download.osgeo.org/gdal/${GDAL_VERSION}/gdal-${GDAL_VERSION_NAME}.tar.gz \ && tar -xf gdal-${GDAL_VERSION_NAME}.tar.gz \ && cd gdal* \ && mkdir build \ && cd ./build \ && cmake -DCMAKE_BUILD_TYPE=Release .. \ && make \ && make install \ && ldconfig RUN Rscript -e 'install.packages(c("sp", "RPostgreSQL", "RSQLite", "testthat", "knitr", "tidyr", "geosphere", "maps", "microbenchmark", "raster", "dplyr", "tibble", "units", "DBI", "covr", "protolite", "tmap", "mapview", "odbc", "pool", "rmarkdown", "RPostgres","spatstat", "stars", "XML", "tmaptools", "tmap", "terra", "PCICt", "RNetCDF", "future.apply", "ggforce", "ggthemes", "gstat", "ncmeta", "pbapply", "plm", "spacetime", "xts", "zoo", "tidync", "ncdfgeom", "cubelyr", "clue", "classInt", "mapdata", "ncdfgeom", "exactextractr", "randomForest", "nanoarrow", "tmap", "spatstat", "spatstat.linnet", "viridis", "CFtime", "tinytest", "lwgeom", "stars"))' # sf: RUN git clone --depth 10 https://github.com/r-spatial/sf.git RUN (cd sf; git pull) RUN R CMD build --no-build-vignettes --no-manual sf RUN R CMD INSTALL sf_*.tar.gz RUN R CMD check --no-build-vignettes --no-manual --as-cran sf_*.tar.gz # lwgeom: #RUN git clone --depth 10 https://github.com/r-spatial/lwgeom.git #RUN R CMD build --no-build-vignettes --no-manual lwgeom #RUN R CMD INSTALL lwgeom_*.tar.gz #RUN R CMD check --no-build-vignettes --no-manual --as-cran lwgeom_*.tar.gz # stars: #RUN git clone --depth 10 https://github.com/r-spatial/stars.git #RUN R CMD build --no-manual stars #RUN R CMD INSTALL stars_*.tar.gz #RUN Rscript -e 'options(timeout=1200); install.packages("starsdata", repos="http://cran.uni-muenster.de/pebesma/")' #RUN _R_CHECK_FORCE_SUGGESTS_=false R CMD check --no-build-vignettes --no-manual --as-cran stars_*.tar.gz # #RUN export DEBIAN_FRONTEND=noninteractive; apt-get install -y --fix-missing libmagick++-dev #RUN Rscript -e 'install.packages("animation")' # terra: #RUN wget -q https://cran.r-project.org/src/contrib/terra_1.8-80.tar.gz #RUN R CMD check --no-manual terra_1.8-80.tar.gz #RUN wget -q https://cran.r-project.org/src/contrib/vapour_0.12.0.tar.gz #RUN R -e 'install.packages(c("markdown", "spelling"))' #RUN R CMD INSTALL vapour*gz #RUN R CMD check --no-manual vapour*gz #RUN R -e 'install.packages(c("gt"))' #RUN wget -q https://cran.r-project.org/src/contrib/gdalraster_2.2.1.tar.gz #RUN R -e 'install.packages(c("RcppInt64"))' #RUN R CMD INSTALL gdalraster*gz #RUN R CMD check --no-manual gdalraster*gz ================================================ FILE: inst/docker/gdal304/Dockerfile ================================================ FROM ubuntu:22.04 # minimal docker file to get sp and sf running on ubunty 16.04 image, # using gdal/geos/proj from ppa:ubuntugis/ubuntugis-unstable MAINTAINER "edzerpebesma" edzer.pebesma@uni-muenster.de RUN apt-get update && apt-get install -y software-properties-common dirmngr RUN add-apt-repository ppa:ubuntugis/ubuntugis-unstable RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E298A3A825C0D65DFD57CBB651716619E084DAB9 # add the R 4.0 repo from CRAN -- adjust 'focal' to 'groovy' or 'bionic' as needed RUN add-apt-repository "deb https://cloud.r-project.org/bin/linux/ubuntu $(lsb_release -cs)-cran40/" RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E084DAB9 RUN apt-get update RUN apt-get upgrade -y RUN export DEBIAN_FRONTEND=noninteractive; apt-get -y update \ && apt-get install -y \ gdb \ git \ libcairo2-dev \ libcurl4-openssl-dev \ libexpat1-dev \ libpq-dev \ libsqlite3-dev \ libudunits2-dev \ make \ pandoc \ qpdf \ r-base-dev \ sqlite3 \ subversion \ valgrind \ vim \ tk-dev \ wget #libv8-3.14-dev \ RUN apt-get install -y \ libjq-dev \ libprotobuf-dev \ libxml2-dev \ libprotobuf-dev \ protobuf-compiler \ unixodbc-dev \ libssh2-1-dev \ libgit2-dev \ libnetcdf-dev \ locales \ libssl-dev \ libtiff-dev RUN locale-gen en_US.UTF-8 #ENV PROJ_VERSION=7.1.0 ENV LD_LIBRARY_PATH=/usr/local/lib:$LD_LIBRARY_PATH RUN export DEBIAN_FRONTEND=noninteractive; apt-get -y update \ && apt-get install -y \ cmake \ libtiff5-dev # GEOS: ENV GEOS_VERSION 3.8.0 RUN wget -q http://download.osgeo.org/geos/geos-${GEOS_VERSION}.tar.bz2 \ && bzip2 -d geos-*bz2 \ && tar xf geos*tar \ && cd geos* \ && mkdir build \ && cd build \ && cmake .. \ && make \ && make install \ && cd ../.. \ && ldconfig #RUN git clone --depth 1 https://github.com/OSGeo/PROJ.git # https://download.osgeo.org/proj/proj-9.0.0RC1.tar.gz ENV PROJ_VERSION 6.3.1 RUN wget -q http://download.osgeo.org/proj/proj-${PROJ_VERSION}.tar.gz RUN tar zxvf proj-${PROJ_VERSION}.tar.gz RUN cd proj* \ && ls -l \ && mkdir build \ && cd build \ && cmake .. \ && make \ && make install \ && cd ../.. \ && ldconfig # install proj-data: #RUN cd /usr/local/share/proj \ # && wget http://download.osgeo.org/proj/proj-data-1.1RC1.zip \ # && unzip -o proj-data*zip \ # && rm proj-data*zip \ # && cd - # GDAL: ENV GDAL_VERSION 3.0.4 ENV GDAL_VERSION_NAME 3.0.4 RUN wget -q http://download.osgeo.org/gdal/${GDAL_VERSION}/gdal-${GDAL_VERSION_NAME}.tar.gz \ && tar -xf gdal-${GDAL_VERSION_NAME}.tar.gz \ && cd gdal* \ && ./configure --disable-driver-cad \ && make \ && make install RUN R -e 'install.packages(c("remotes", "Rcpp", "s2", "e1071", "classInt", "units", "magrittr", "DBI"))' RUN echo "OK223" RUN R -e 'remotes::install_github("r-spatial/sf")' RUN R -e 'library(sf)' RUN Rscript -e 'install.packages(c("sp", "rgeos", "rgdal", "RPostgreSQL", "RSQLite", "testthat", "knitr", "tidyr", "geosphere", "maptools", "maps", "microbenchmark", "raster", "dplyr", "tibble", "units", "DBI", "covr", "protolite", "tmap", "mapview", "odbc", "pool", "rmarkdown", "RPostgres","spatstat", "stars", "XML", "tmaptools", "tmap", "terra", "PCICt", "RNetCDF", "future.apply", "ggforce", "ggthemes", "gstat", "ncmeta", "pbapply", "plm", "spacetime", "xts", "zoo", "tidync", "ncdfgeom", "cubelyr", "clue", "classInt"))' RUN git clone --depth 10 https://github.com/r-spatial/sf.git RUN git clone --depth 10 https://github.com/r-spatial/lwgeom.git RUN git clone --depth 10 https://github.com/r-spatial/stars.git #RUN git config --global user.email "edzer.pebesma@uni-muenster.de" RUN R CMD build --no-build-vignettes --no-manual lwgeom RUN R CMD build --no-build-vignettes --no-manual sf # RUN pkg-config proj --modversion RUN R CMD INSTALL sf RUN R CMD INSTALL lwgeom RUN R CMD INSTALL stars RUN Rscript -e 'install.packages(c("mapview", "tmap"))' RUN Rscript -e 'install.packages(c("spatstat", "spatstat.linnet"))' RUN R CMD build --no-build-vignettes --no-manual sf RUN R CMD check --no-build-vignettes --no-manual --as-cran sf_*.tar.gz RUN R CMD check --no-build-vignettes --no-manual --as-cran lwgeom_*.tar.gz #RUN Rscript -e 'install.packages("starsdata", repos="http://gis-bigdata.uni-muenster.de/pebesma/")' RUN R CMD build --no-manual stars RUN Rscript -e 'install.packages(c("ncdfgeom"))' RUN _R_CHECK_FORCE_SUGGESTS_=false R CMD check --no-build-vignettes --no-manual --as-cran stars_*.tar.gz ================================================ FILE: inst/docker/geos/Dockerfile ================================================ FROM ubuntu:18.04 # minimal docker file to get sp and sf running on ubunty 16.04 image, # using gdal/geos/proj from ppa:ubuntugis/ubuntugis-unstable MAINTAINER "edzerpebesma" edzer.pebesma@uni-muenster.de RUN apt-get update && apt-get install -y software-properties-common RUN add-apt-repository ppa:ubuntugis/ubuntugis-unstable RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E298A3A825C0D65DFD57CBB651716619E084DAB9 RUN echo "deb https://cloud.r-project.org/bin/linux/ubuntu bionic-cran40/" >> /etc/apt/sources.list RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E084DAB9 RUN apt-get update RUN apt-get upgrade -y RUN export DEBIAN_FRONTEND=noninteractive; apt-get -y update \ && apt-get install -y \ gdb \ git \ libcairo2-dev \ libcurl4-openssl-dev \ libexpat1-dev \ libpq-dev \ libsqlite3-dev \ libudunits2-dev \ make \ pandoc \ qpdf \ r-base-dev \ sqlite3 \ subversion \ valgrind \ vim \ tk-dev \ wget RUN apt-get install -y \ libv8-3.14-dev \ libjq-dev \ libprotobuf-dev \ libxml2-dev \ libprotobuf-dev \ protobuf-compiler \ unixodbc-dev \ libssh2-1-dev \ libgit2-dev \ libnetcdf-dev \ locales \ libssl-dev \ libtiff-dev RUN locale-gen en_US.UTF-8 ENV PROJ_VERSION=7.1.0 ENV LD_LIBRARY_PATH=/usr/local/lib:$LD_LIBRARY_PATH RUN export DEBIAN_FRONTEND=noninteractive; apt-get -y update \ && apt-get install -y \ cmake \ libtiff5-dev RUN export DEBIAN_FRONTEND=noninteractive; apt-get -y update \ && apt-get install -y autoconf RUN git clone --depth 1 https://github.com/libgeos/geos.git RUN (cd geos; git pull) RUN cd geos \ && mkdir build \ && cd build \ && cmake .. \ && make \ && make install #RUN git clone --depth 1 https://github.com/OSGeo/PROJ.git RUN wget http://download.osgeo.org/proj/proj-8.0.0.tar.gz RUN tar zxvf proj-8.0.0.tar.gz RUN cd proj-8.0.0 \ && ls -l \ && mkdir build \ && cd build \ && cmake .. \ && make \ && make install \ && cd ../.. \ && ldconfig # install proj-data: #RUN cd /usr/local/share/proj \ # && wget http://download.osgeo.org/proj/proj-data-1.1RC1.zip \ # && unzip -o proj-data*zip \ # && rm proj-data*zip \ # && cd - # GDAL: # https://download.osgeo.org/gdal/3.1.0/gdal-3.1.0rc2.tar.gz ENV GDAL_VERSION 3.3.0 ENV GDAL_VERSION_NAME 3.3.0rc1 RUN wget http://download.osgeo.org/gdal/${GDAL_VERSION}/gdal-${GDAL_VERSION_NAME}.tar.gz \ && tar -xf gdal-${GDAL_VERSION_NAME}.tar.gz \ && cd gdal* \ && ./configure \ && make \ && make install \ && cd .. \ && ldconfig # RUN svn checkout svn://scm.r-forge.r-project.org/svnroot/rgdal/ # RUN R CMD build rgdal/pkg --no-build-vignettes # RUN R CMD INSTALL rgdal_*.tar.gz RUN Rscript -e 'install.packages(c("sp", "rgeos", "rgdal", "RPostgreSQL", "RSQLite", "testthat", "knitr", "tidyr", "geosphere", "maptools", "maps", "microbenchmark", "raster", "dplyr", "tibble", "units", "DBI", "covr", "protolite", "tmap", "mapview", "odbc", "pool", "rmarkdown", "RPostgres","spatstat", "stars"))' RUN git clone --depth 10 https://github.com/r-spatial/sf.git RUN git clone --depth 10 https://github.com/r-spatial/lwgeom.git RUN git clone --depth 10 https://github.com/r-spatial/stars.git #RUN git config --global user.email "edzer.pebesma@uni-muenster.de" RUN R CMD build --no-build-vignettes --no-manual lwgeom RUN (cd sf; git pull) RUN R CMD build --no-build-vignettes --no-manual sf # RUN pkg-config proj --modversion RUN R CMD INSTALL sf RUN R CMD INSTALL lwgeom RUN R CMD build --no-build-vignettes --no-manual stars RUN R CMD INSTALL stars #RUN svn checkout svn://scm.r-forge.r-project.org/svnroot/rgdal/ # or: # svn checkout svn+ssh://edzer@scm.r-forge.r-project.org/svnroot/rgdal/ #RUN R CMD build rgdal/pkg --no-build-vignettes #RUN R CMD INSTALL rgdal_*.tar.gz #RUN R CMD check --no-vignettes --no-manual rgdal_*.tar.gz #RUN Rscript -e 'install.packages(c("stars", "tmap"), repos = "https://cloud.r-project.org")' RUN Rscript -e 'install.packages("rgdal", repos="http://R-Forge.R-project.org")' # after rgdal: RUN Rscript -e 'install.packages(c("XML"))' RUN Rscript -e 'install.packages(c("tmaptools", "tmap", "mapview", "s2", "terra"))' RUN Rscript -e 'install.packages("rgeos", repos="http://R-Forge.R-project.org")' RUN echo RUN (cd sf; git pull) RUN R CMD build --no-build-vignettes --no-manual sf RUN R CMD check --no-manual --as-cran sf_*.tar.gz #RUN R CMD check --no-build-vignettes --no-manual --as-cran lwgeom_*.tar.gz #RUN Rscript -e 'install.packages("starsdata", repos="http://gis-bigdata.uni-muenster.de/pebesma/")' #RUN Rscript -e 'install.packages(c("PCICt", "RNetCDF", "future.apply", "ggforce", "ggthemes", "gstat", "ncmeta", "pbapply", "plm", "spacetime", "xts", "zoo"))' #RUN Rscript -e 'install.packages(c("tidync", "ncdfgeom", "cubelyr"))' #RUN echo echo #RUN (cd stars; git pull) #RUN R CMD build --no-manual stars #RUN _R_CHECK_FORCE_SUGGESTS_=false R CMD check --no-build-vignettes --no-manual --as-cran stars_*.tar.gz ================================================ FILE: inst/docker/lowest/Dockerfile ================================================ FROM rocker/r-ver # minimal docker file to get sf running on an ubunty 16.04 image, # installing gdal, geos and proj.4 from source in a non-standard location MAINTAINER "edzerpebesma" edzer.pebesma@uni-muenster.de RUN apt-get update #RUN apt-get -y remove libgdal-dev gdal-bin libgeos-dev libproj-dev \ # libgeos-3.8.0 libgdal20 libproj15 proj-data RUN apt-get update && apt-get install -y software-properties-common wget #RUN add-apt-repository ppa:ubuntugis/ubuntugis-unstable #RUN echo "deb http://cran.rstudio.com/bin/linux/ubuntu xenial/ " >> /etc/apt/sources.list #RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E084DAB9 #RUN apt-get update #RUN apt-get upgrade -y #RUN export DEBIAN_FRONTEND=noninteractive; apt-get -y update \ # && apt-get install -y \ # libcurl4-openssl-dev \ # qpdf \ # pandoc \ # pandoc-citeproc \ # make \ # wget \ # git \ # subversion \ # libudunits2-dev \ # libsqlite3-dev \ # libexpat1-dev \ # libprotobuf-dev \ # libv8-3.14-dev \ # libcairo2-dev \ # protobuf-compiler \ # libxml2-dev \ # libpq-dev \ # libssh2-1-dev \ # unixodbc-dev \ # r-base-dev # #RUN export DEBIAN_FRONTEND=noninteractive; \ # add-apt-repository -y ppa:opencpu/jq; \ # apt-get update; \ # apt-get install -y \ # libjq-dev RUN cd \ && wget http://download.osgeo.org/proj/proj-4.8.0.tar.gz \ && tar zxvf proj-4.8.0.tar.gz \ && cd proj-4.8.0/ \ && ./configure \ && make \ && make install # for now, rgdal needs: RUN export DEBIAN_FRONTEND=noninteractive; apt-get -y update \ && apt-get install -y \ libcurl4-openssl-dev \ qpdf \ pandoc \ pandoc-citeproc \ make \ wget \ git \ subversion \ libudunits2-dev \ libsqlite3-dev \ libexpat1-dev \ libprotobuf-dev \ libcairo2-dev \ protobuf-compiler \ libxml2-dev \ libpq-dev \ libssh2-1-dev \ unixodbc-dev \ libjq-dev #RUN export DEBIAN_FRONTEND=noninteractive; \ # add-apt-repository -y ppa:opencpu/jq; \ # apt-get update; \ # apt-get install -y \ # libjq-dev RUN cd \ && wget http://download.osgeo.org/gdal/2.2.3/gdal-2.2.3.tar.gz \ && tar zxvf gdal-2.2.3.tar.gz \ && cd gdal-2.2.3 \ && ./configure \ && make \ && make install RUN cd \ && wget http://download.osgeo.org/geos/geos-3.6.0.tar.bz2 \ && bunzip2 geos-3.6.0.tar.bz2 \ && tar xvf geos-3.6.0.tar \ && cd geos-3.6.0 \ && ./configure \ && make \ && make install RUN ldconfig RUN svn checkout svn://scm.r-forge.r-project.org/svnroot/rgdal/ RUN R CMD build rgdal/pkg --no-build-vignettes RUN R -e 'install.packages(c("sp"))' RUN R CMD INSTALL rgdal_*.tar.gz RUN R -e 'install.packages("remotes")' RUN echo "ok" #RUN R -e 'install.packages("sf")' RUN R -e 'install.packages(c("Rcpp", "s2", "e1071", "classInt", "units", "magrittr", "DBI"))' RUN ls RUN echo "xxyyzz" RUN R -e 'remotes::install_github("r-spatial/sf")' RUN R -e 'library(sf)' # no rgdal: RUN R -e 'install.packages(c("Rcpp", "DBI", "units", "magrittr", "lwgeom", "maps", "rgeos", "sp", "raster", "spatstat", "tmap", "maptools", "RSQLite", "tibble", "pillar", "rlang", "dplyr", "tidyr", "RPostgres", "tidyselect", "ggplot2", "mapview", "testthat", "knitr", "covr", "microbenchmark", "rmarkdown", "RPostgreSQL", "devtools", "odbc", "pool"))' RUN R -e 'library(sf)' RUN git clone https://github.com/r-spatial/sf.git RUN R CMD build sf RUN apt-get install -y libssl-dev RUN R -e 'install.packages(c("covr", "stars"))' RUN ls RUN (cd sf; git pull) RUN R CMD build sf RUN R CMD check --no-manual sf_*.tar.gz CMD ["/bin/bash"] ================================================ FILE: inst/docker/parquet/Dockerfile ================================================ FROM ubuntu:22.04 # minimal docker file to get sp and sf running on ubunty 16.04 image, # using gdal/geos/proj from ppa:ubuntugis/ubuntugis-unstable MAINTAINER "edzerpebesma" edzer.pebesma@uni-muenster.de RUN apt-get update && apt-get install -y software-properties-common dirmngr RUN add-apt-repository ppa:ubuntugis/ubuntugis-unstable RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E298A3A825C0D65DFD57CBB651716619E084DAB9 # add the R 4.0 repo from CRAN -- adjust 'focal' to 'groovy' or 'bionic' as needed RUN add-apt-repository "deb https://cloud.r-project.org/bin/linux/ubuntu $(lsb_release -cs)-cran40/" RUN apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E084DAB9 RUN apt-get update RUN apt-get upgrade -y RUN export DEBIAN_FRONTEND=noninteractive; apt-get -y update \ && apt-get install -y \ devscripts \ gdb \ git \ libcairo2-dev \ libcurl4-openssl-dev \ libexpat1-dev \ libpq-dev \ libsqlite3-dev \ libudunits2-dev \ make \ pandoc \ qpdf \ r-base-dev \ sqlite3 \ subversion \ valgrind \ vim \ tk-dev \ wget #libv8-3.14-dev \ RUN apt-get update && apt-get install -y --fix-missing \ libjq-dev \ libprotobuf-dev \ libxml2-dev \ libprotobuf-dev \ protobuf-compiler \ unixodbc-dev \ libssh2-1-dev \ libgit2-dev \ libnetcdf-dev \ locales \ libssl-dev \ libtiff-dev \ cmake \ libtiff5-dev \ libopenjp2-7-dev RUN locale-gen en_US.UTF-8 #ENV PROJ_VERSION=7.1.0 ENV LD_LIBRARY_PATH=/usr/local/lib:$LD_LIBRARY_PATH # GEOS: ENV GEOS_VERSION 3.14.0 RUN wget -q http://download.osgeo.org/geos/geos-${GEOS_VERSION}.tar.bz2 \ && bzip2 -d geos-*bz2 \ && tar xf geos*tar \ && cd geos* \ && mkdir build \ && cd build \ && cmake .. \ && make \ && make install \ && cd ../.. \ && ldconfig #RUN git clone --depth 1 https://github.com/OSGeo/PROJ.git # https://download.osgeo.org/proj/proj-9.0.0RC1.tar.gz ENV PROJ_VERSION 9.7.1 RUN wget -q http://download.osgeo.org/proj/proj-${PROJ_VERSION}.tar.gz RUN tar zxvf proj-${PROJ_VERSION}.tar.gz RUN cd proj* \ && ls -l \ && mkdir build \ && cd build \ && cmake .. \ && make \ && make install \ && cd ../.. \ && ldconfig # install proj-data: #RUN cd /usr/local/share/proj \ # && wget http://download.osgeo.org/proj/proj-data-1.1RC1.zip \ # && unzip -o proj-data*zip \ # && rm proj-data*zip \ # && cd - # FROM https://arrow.apache.org/install/ ; probably only a subset is needed: RUN apt update RUN apt install -y -V ca-certificates lsb-release wget RUN wget https://apache.jfrog.io/artifactory/arrow/$(lsb_release --id --short | tr 'A-Z' 'a-z')/apache-arrow-apt-source-latest-$(lsb_release --codename --short).deb RUN apt install -y -V ./apache-arrow-apt-source-latest-$(lsb_release --codename --short).deb RUN apt update RUN apt install -y -V libarrow-dev # For C++ RUN apt install -y -V libarrow-glib-dev # For GLib (C) RUN apt install -y -V libarrow-dataset-dev # For Apache Arrow Dataset C++ RUN apt install -y -V libarrow-dataset-glib-dev # For Apache Arrow Dataset GLib (C) RUN apt install -y -V libparquet-dev # For Apache Parquet C++ RUN apt install -y -V libparquet-glib-dev # For Apache Parquet GLib (C) # GDAL: ENV GDAL_VERSION 3.12.2 ENV GDAL_VERSION_NAME 3.12.2 RUN wget -q http://download.osgeo.org/gdal/${GDAL_VERSION}/gdal-${GDAL_VERSION_NAME}.tar.gz \ && tar -xf gdal-${GDAL_VERSION_NAME}.tar.gz \ && cd gdal* \ && mkdir build \ && cd ./build \ && cmake -DCMAKE_BUILD_TYPE=Release .. \ && make \ && make install \ && ldconfig RUN gdalinfo --formats RUN Rscript -e 'install.packages(c("sf"))' RUN Rscript -e 'sf::st_drivers("vector", "Arrow")' RUN Rscript -e 'sf::st_drivers("vector", "Parquet")' ================================================ FILE: inst/gml/fmi_test.gml ================================================ 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 100965 Raasepori Jussarö -16000041 2757 Raasepori Raasepori Jussarö 59.82076 23.57309 2014-01-01T00:00:00Z 3.3 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 100967 Salo Kiikala lentokenttä -16000126 2777 Salo Salo Kiikala lentokenttä 60.46415 23.64976 2014-01-01T00:00:00Z 2.6 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 100968 Vantaa Helsinki-Vantaan lentoasema -16000063 2974 Vantaa Vantaa Helsinki-Vantaan lentoasema 60.32670 24.95675 2014-01-01T00:00:00Z 3.1 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 100969 Inkoo Bågaskär -16000158 2984 Inkoo Inkoo Bågaskär 59.93114 24.01408 2014-01-01T00:00:00Z 3.3 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 100971 Helsinki Kaisaniemi -16000150 2978 Helsinki Helsinki Kaisaniemi 60.17523 24.94459 2014-01-01T00:00:00Z 3.6 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 100974 Lohja Porla -16000023 2706 Lohja Lohja Porla 60.24446 24.04951 2014-01-01T00:00:00Z 3.4 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 100976 Vihti Maasoja -16000165 2758 Vihti Vihti Maasoja 60.41875 24.39862 2014-01-01T00:00:00Z 3.4 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 100996 Helsinki Harmaja -16000153 2795 Helsinki Helsinki Harmaja 60.10512 24.97539 2014-01-01T00:00:00Z 3.3 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 100997 Kirkkonummi Mäkiluoto -16000119 2794 Kirkkonummi Kirkkonummi Mäkiluoto 59.92014 24.34934 2014-01-01T00:00:00Z 3.4 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 101003 Helsinki Helsingin majakka -16000134 2989 Helsinki Helsinki Helsingin majakka 59.94898 24.92631 2014-01-01T00:00:00Z 3.0 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 101004 Helsinki Kumpula -16000138 2998 Helsinki Helsinki Kumpula 60.20307 24.96131 2014-01-01T00:00:00Z 3.2 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 101005 Espoo Sepänkylä -16000137 2703 Espoo Espoo Sepänkylä 60.20761 24.74152 2014-01-01T00:00:00Z 3.2 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 101007 Helsinki Rautatientori -16011680 2934 Helsinki Helsinki Rautatientori 60.17169 24.94460 2014-01-01T00:00:00Z 3.7 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 101022 Porvoo Kalbådagrund -16000007 2987 Porvoo Porvoo Kalbådagrund 59.98518 25.59855 2014-01-01T00:00:00Z 2.7 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 101023 Porvoo Emäsalo -16000110 2991 Porvoo Porvoo Emäsalo 60.20382 25.62546 2014-01-01T00:00:00Z 2.9 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 101028 Porvoo Harabacka -16000142 2759 Porvoo Porvoo Harabacka 60.39172 25.60730 2014-01-01T00:00:00Z 3.1 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 101039 Loviisa Orrengrund -16000050 2992 Loviisa Loviisa Orrengrund 60.27488 26.44457 2014-01-01T00:00:00Z 3.0 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 101128 Somero Salkola -16011860 2949 Somero Somero Salkola 60.64668 23.80559 2014-01-01T00:00:00Z 2.4 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 101130 Hyvinkää Hyvinkäänkylä -16000152 2829 Hyvinkää Hyvinkää Hyvinkäänkylä 60.59589 24.80300 2014-01-01T00:00:00Z 3.2 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 101149 Nurmijärvi Röykkä -16000151 2983 Nurmijärvi Nurmijärvi Röykkä 60.50878 24.65373 2014-01-01T00:00:00Z 2.8 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 151028 Helsinki Vuosaari satama -16011877 5720 Helsinki Helsinki Vuosaari satama 60.20867 25.19590 2014-01-01T00:00:00Z 3.3 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z 2014-01-01T00:00:00Z atmosphere 874863 Espoo Tapiola -874863 2985 Espoo Espoo Tapiola 60.17802 24.78732 2014-01-01T00:00:00Z 3.4 ================================================ FILE: inst/include/sf.h ================================================ // Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #ifndef RCPP_sf_H_GEN_ #define RCPP_sf_H_GEN_ #include "sf_RcppExports.h" #endif // RCPP_sf_H_GEN_ ================================================ FILE: inst/include/sf_RcppExports.h ================================================ // Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #ifndef RCPP_sf_RCPPEXPORTS_H_GEN_ #define RCPP_sf_RCPPEXPORTS_H_GEN_ #include namespace sf { using namespace Rcpp; namespace { void validateSignature(const char* sig) { Rcpp::Function require = Rcpp::Environment::base_env()["require"]; require("sf", Rcpp::Named("quietly") = true); typedef int(*Ptr_validate)(const char*); static Ptr_validate p_validate = (Ptr_validate) R_GetCCallable("sf", "_sf_RcppExport_validate"); if (!p_validate(sig)) { throw Rcpp::function_not_exported( "C++ function with signature '" + std::string(sig) + "' not found in sf"); } } } inline Rcpp::List CPL_read_wkb(Rcpp::List wkb_list, bool EWKB = false, bool spatialite = false) { typedef SEXP(*Ptr_CPL_read_wkb)(SEXP,SEXP,SEXP); static Ptr_CPL_read_wkb p_CPL_read_wkb = NULL; if (p_CPL_read_wkb == NULL) { validateSignature("Rcpp::List(*CPL_read_wkb)(Rcpp::List,bool,bool)"); p_CPL_read_wkb = (Ptr_CPL_read_wkb)R_GetCCallable("sf", "_sf_CPL_read_wkb"); } RObject rcpp_result_gen; { rcpp_result_gen = p_CPL_read_wkb(Shield(Rcpp::wrap(wkb_list)), Shield(Rcpp::wrap(EWKB)), Shield(Rcpp::wrap(spatialite))); } if (rcpp_result_gen.inherits("interrupted-error")) throw Rcpp::internal::InterruptedException(); if (Rcpp::internal::isLongjumpSentinel(rcpp_result_gen)) throw Rcpp::LongjumpException(rcpp_result_gen); if (rcpp_result_gen.inherits("try-error")) throw Rcpp::exception(Rcpp::as(rcpp_result_gen).c_str()); return Rcpp::as(rcpp_result_gen); } inline Rcpp::List CPL_write_wkb(Rcpp::List sfc, bool EWKB = false) { typedef SEXP(*Ptr_CPL_write_wkb)(SEXP,SEXP); static Ptr_CPL_write_wkb p_CPL_write_wkb = NULL; if (p_CPL_write_wkb == NULL) { validateSignature("Rcpp::List(*CPL_write_wkb)(Rcpp::List,bool)"); p_CPL_write_wkb = (Ptr_CPL_write_wkb)R_GetCCallable("sf", "_sf_CPL_write_wkb"); } RObject rcpp_result_gen; { rcpp_result_gen = p_CPL_write_wkb(Shield(Rcpp::wrap(sfc)), Shield(Rcpp::wrap(EWKB))); } if (rcpp_result_gen.inherits("interrupted-error")) throw Rcpp::internal::InterruptedException(); if (Rcpp::internal::isLongjumpSentinel(rcpp_result_gen)) throw Rcpp::LongjumpException(rcpp_result_gen); if (rcpp_result_gen.inherits("try-error")) throw Rcpp::exception(Rcpp::as(rcpp_result_gen).c_str()); return Rcpp::as(rcpp_result_gen); } } #endif // RCPP_sf_RCPPEXPORTS_H_GEN_ ================================================ FILE: inst/nc/zarr.py ================================================ # from https://zarr.readthedocs.io/en/v1.1.0/tutorial.html import zarr z = zarr.zeros((100, 100), chunks=(50, 50), dtype='i4') z[:] = 1 #zarr.core.Array((10000, 10000), int32, chunks=(1000, 1000), order=C) # compression: blosc; compression_opts: {'clevel': 5, 'cname': 'lz4', 'shuffle': 1} # nbytes: 381.5M; nbytes_stored: 313; ratio: 1277955.3; initialized: 0/100 # store: builtins.dict # Example: persist in-memory zarr array `z` to disk #from zarr import DirectoryStore, open as zopen from zarr import DirectoryStore, open as zopen store = DirectoryStore('ones.zarr') # directory on disk dst = zopen(store, mode='w', shape=z.shape, chunks=z.chunks, dtype=z.dtype, compressor=getattr(z, "compressor", None), order=getattr(z, "order", "C")) dst[:] = z[:] # copy data dst.attrs.update(z.attrs) # copy metadata (if any) # reopen later: z_on_disk = zopen(store, mode='r') z_on_disk ================================================ FILE: inst/osm/overpass.osm ================================================ The data included in this document is from www.openstreetmap.org. The data is made available under ODbL. ================================================ FILE: inst/shape/olinda1.prj ================================================ GEOGCS["GRS 1980(IUGG, 1980)",DATUM["D_unknown",SPHEROID["GRS80",6378137,298.257222101]],PRIMEM["Greenwich",0],UNIT["Degree",0.017453292519943295]] ================================================ FILE: man/Ops.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/arith.R \name{Ops} \alias{Ops} \alias{Ops.sfg} \alias{Ops.sfc} \title{Arithmetic operators for simple feature geometries} \usage{ \method{Ops}{sfg}(e1, e2) \method{Ops}{sfc}(e1, e2) } \arguments{ \item{e1}{object of class \code{sfg} or \code{sfc}} \item{e2}{numeric, or object of class \code{sfg}; in case \code{e1} is of class \code{sfc} also an object of class \code{sfc} is allowed} } \value{ object of class \code{sfg} } \description{ Arithmetic operators for simple feature geometries } \details{ in case \code{e2} is numeric, +, -, *, /, \%\% and \%/\% add, subtract, multiply, divide, modulo, or integer-divide by \code{e2}. In case \code{e2} is an n x n matrix, * matrix-multiplies and / multiplies by its inverse. If \code{e2} is an \code{sfg} object, |, /, & and \%/\% result in the geometric union, difference, intersection and symmetric difference respectively, and \code{==} and \code{!=} return geometric (in)equality, using \link{st_equals}. If \code{e2} is an \code{sfg} or \code{sfc} object, for operations \code{+} and \code{-} it has to have \code{POINT} geometries. If \code{e1} is of class \code{sfc}, and \code{e2} is a length 2 numeric, then it is considered a two-dimensional point (and if needed repeated as such) only for operations \code{+} and \code{-}, in other cases the individual numbers are repeated; see commented examples. It has been reported (https://github.com/r-spatial/sf/issues/2067) that certain ATLAS versions result in invalid polygons, where the final point in a ring is no longer equal to the first point. In that case, setting the precisions with \link{st_set_precision} may help. } \examples{ st_point(c(1,2,3)) + 4 st_point(c(1,2,3)) * 3 + 4 m = matrix(0, 2, 2) diag(m) = c(1, 3) # affine: st_point(c(1,2)) * m + c(2,5) # world in 0-360 range: if (require(maps, quietly = TRUE)) { w = st_as_sf(map('world', plot = FALSE, fill = TRUE)) w2 = (st_geometry(w) + c(360,90)) \%\% c(360) - c(0,90) w3 = st_wrap_dateline(st_set_crs(w2 - c(180,0), 4326)) + c(180,0) plot(st_set_crs(w3, 4326), axes = TRUE) } (mp <- st_point(c(1,2)) + st_point(c(3,4))) # MULTIPOINT (1 2, 3 4) mp - st_point(c(3,4)) # POINT (1 2) opar = par(mfrow = c(2,2), mar = c(0, 0, 1, 0)) a = st_buffer(st_point(c(0,0)), 2) b = a + c(2, 0) p = function(m) { plot(c(a,b)); plot(eval(parse(text=m)), col=grey(.9), add = TRUE); title(m) } o = lapply(c('a | b', 'a / b', 'a & b', 'a \%/\% b'), p) par(opar) sfc = st_sfc(st_point(0:1), st_point(2:3)) sfc + c(2,3) # added to EACH geometry sfc * c(2,3) # first geometry multiplied by 2, second by 3 nc = st_transform(st_read(system.file("gpkg/nc.gpkg", package="sf")), 32119) # nc state plane, m b = st_buffer(st_centroid(st_union(nc)), units::set_units(50, km)) # shoot a hole in nc: plot(st_geometry(nc) / b, col = grey(.9)) } ================================================ FILE: man/aggregate.sf.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/aggregate.R \name{aggregate.sf} \alias{aggregate.sf} \alias{aggregate} \title{aggregate an \code{sf} object} \usage{ \method{aggregate}{sf}( x, by, FUN, ..., do_union = TRUE, simplify = TRUE, join = st_intersects ) } \arguments{ \item{x}{object of class \link{sf}} \item{by}{either a list of grouping vectors with length equal to \code{nrow(x)} (see \link[stats]{aggregate}), or an object of class \code{sf} or \code{sfc} with geometries that are used to generate groupings, using the binary predicate specified by the argument \code{join}} \item{FUN}{function passed on to \link[stats]{aggregate}, in case \code{ids} was specified and attributes need to be grouped} \item{...}{arguments passed on to \code{FUN}} \item{do_union}{logical; should grouped geometries be unioned using \link{st_union}? See details.} \item{simplify}{logical; see \link[stats]{aggregate}} \item{join}{logical spatial predicate function to use if \code{by} is a simple features object or geometry; see \link{st_join}} } \value{ an \code{sf} object with aggregated attributes and geometries; additional grouping variables having the names of \code{names(ids)} or are named \code{Group.i} for \code{ids[[i]]}; see \link[stats]{aggregate}. } \description{ aggregate an \code{sf} object, possibly union-ing geometries } \details{ In case \code{do_union} is \code{FALSE}, \code{aggregate} will simply combine geometries using \link{c.sfg}. When polygons sharing a boundary are combined, this leads to geometries that are invalid; see \url{https://github.com/r-spatial/sf/issues/681}. } \note{ Does not work using the formula notation involving \code{~} defined in \link[stats]{aggregate}. } \examples{ m1 = cbind(c(0, 0, 1, 0), c(0, 1, 1, 0)) m2 = cbind(c(0, 1, 1, 0), c(0, 0, 1, 0)) pol = st_sfc(st_polygon(list(m1)), st_polygon(list(m2))) set.seed(1985) d = data.frame(matrix(runif(15), ncol = 3)) p = st_as_sf(x = d, coords = 1:2) plot(pol) plot(p, add = TRUE) (p_ag1 = aggregate(p, pol, mean)) plot(p_ag1) # geometry same as pol # works when x overlaps multiple objects in 'by': p_buff = st_buffer(p, 0.2) plot(p_buff, add = TRUE) (p_ag2 = aggregate(p_buff, pol, mean)) # increased mean of second # with non-matching features m3 = cbind(c(0, 0, -0.1, 0), c(0, 0.1, 0.1, 0)) pol = st_sfc(st_polygon(list(m3)), st_polygon(list(m1)), st_polygon(list(m2))) (p_ag3 = aggregate(p, pol, mean)) plot(p_ag3) # In case we need to pass an argument to the join function: (p_ag4 = aggregate(p, pol, mean, join = function(x, y) st_is_within_distance(x, y, dist = 0.3))) } ================================================ FILE: man/bind.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/bind.R \name{bind} \alias{bind} \alias{rbind.sf} \alias{cbind.sf} \alias{st_bind_cols} \title{Bind rows (features) of sf objects} \usage{ \method{rbind}{sf}(..., deparse.level = 1) \method{cbind}{sf}(..., deparse.level = 1, sf_column_name = NULL) st_bind_cols(...) } \arguments{ \item{...}{objects to bind; note that for the rbind and cbind methods, all objects have to be of class \code{sf}; see \link{dotsMethods}} \item{deparse.level}{integer; see \link{rbind}} \item{sf_column_name}{character; specifies active geometry; passed on to \link{st_sf}} } \value{ \code{cbind} called with multiple \code{sf} objects warns about multiple geometry columns present when the geometry column to use is not specified by using argument \code{sf_column_name}; see also \link{st_sf}. } \description{ Bind rows (features) of sf objects Bind columns (variables) of sf objects } \details{ both \code{rbind} and \code{cbind} have non-standard method dispatch (see \link[base]{cbind}): the \code{rbind} or \code{cbind} method for \code{sf} objects is only called when all arguments to be binded are of class \code{sf}. If you need to \code{cbind} e.g. a \code{data.frame} to an \code{sf}, use \link{data.frame} directly and use \link{st_sf} on its result, or use \link[dplyr:bind]{bind_cols}; see examples. \code{st_bind_cols} is deprecated; use \code{cbind} instead. } \examples{ crs = st_crs(3857) a = st_sf(a=1, geom = st_sfc(st_point(0:1)), crs = crs) b = st_sf(a=1, geom = st_sfc(st_linestring(matrix(1:4,2))), crs = crs) c = st_sf(a=4, geom = st_sfc(st_multilinestring(list(matrix(1:4,2)))), crs = crs) rbind(a,b,c) rbind(a,b) rbind(a,b) rbind(b,c) cbind(a,b,c) # warns if (require(dplyr, quietly = TRUE)) dplyr::bind_cols(a,b) c = st_sf(a=4, geomc = st_sfc(st_multilinestring(list(matrix(1:4,2)))), crs = crs) cbind(a,b,c, sf_column_name = "geomc") df = data.frame(x=3) st_sf(data.frame(c, df)) if (require(dplyr, quietly = TRUE)) dplyr::bind_cols(c, df) } ================================================ FILE: man/coerce-methods.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/sp.R \name{as} \alias{as} \alias{Spatial} \alias{sf-method} \alias{coerce} \alias{sfc-method} \alias{Spatial-method} \alias{as_Spatial} \alias{crs} \alias{CRS-method} \title{Methods to coerce simple features to \verb{Spatial*} and \code{Spatial*DataFrame} objects} \usage{ as_Spatial(from, cast = TRUE, IDs = paste0("ID", seq_along(from))) } \arguments{ \item{from}{object of class \code{sf}, \code{sfc_POINT}, \code{sfc_MULTIPOINT}, \code{sfc_LINESTRING}, \code{sfc_MULTILINESTRING}, \code{sfc_POLYGON}, or \code{sfc_MULTIPOLYGON}.} \item{cast}{logical; if \code{TRUE}, \code{\link[=st_cast]{st_cast()}} \code{from} before converting, so that e.g. \code{GEOMETRY} objects with a mix of \code{POLYGON} and \code{MULTIPOLYGON} are cast to \code{MULTIPOLYGON}.} \item{IDs}{character vector with IDs for the \verb{Spatial*} geometries} } \value{ geometry-only object deriving from \code{Spatial}, of the appropriate class } \description{ \code{\link[=as_Spatial]{as_Spatial()}} allows to convert \code{sf} and \code{sfc} to \code{Spatial*DataFrame} and \verb{Spatial*} for \code{sp} compatibility. You can also use \code{as(x, "Spatial")} To transform \code{sp} objects to \code{sf} and \code{sfc} with \code{as(x, "sf")}. } \details{ Package \code{sp} supports three dimensions for \code{POINT} and \code{MULTIPOINT} (\verb{SpatialPoint*}). Other geometries must be two-dimensional (\code{XY}). Dimensions can be dropped using \code{\link[=st_zm]{st_zm()}} with \code{what = "M"} or \code{what = "ZM"}. For converting simple features (i.e., \code{sf} objects) to their \code{Spatial} counterpart, use \code{as(obj, "Spatial")} } \examples{ nc <- st_read(system.file("shape/nc.shp", package="sf")) if (require(sp, quietly = TRUE)) { # convert to SpatialPolygonsDataFrame spdf <- as_Spatial(nc) # identical to spdf <- as(nc, "Spatial") # convert to SpatialPolygons as(st_geometry(nc), "Spatial") # back to sf as(spdf, "sf") } } ================================================ FILE: man/dbDataType.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/db.R \name{dbDataType,PostgreSQLConnection,sf-method} \alias{dbDataType,PostgreSQLConnection,sf-method} \alias{dbDataType,DBIObject,sf-method} \title{Determine database type for R vector} \usage{ \S4method{dbDataType}{PostgreSQLConnection,sf}(dbObj, obj) \S4method{dbDataType}{DBIObject,sf}(dbObj, obj) } \arguments{ \item{dbObj}{DBIObject driver or connection.} \item{obj}{Object to convert} } \description{ Determine database type for R vector Determine database type for R vector } ================================================ FILE: man/dbWriteTable.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/db.R \name{dbWriteTable,PostgreSQLConnection,character,sf-method} \alias{dbWriteTable,PostgreSQLConnection,character,sf-method} \alias{dbWriteTable,DBIObject,character,sf-method} \title{Write \code{sf} object to Database} \usage{ \S4method{dbWriteTable}{PostgreSQLConnection,character,sf}( conn, name, value, ..., row.names = FALSE, overwrite = FALSE, append = FALSE, field.types = NULL, binary = TRUE ) \S4method{dbWriteTable}{DBIObject,character,sf}( conn, name, value, ..., row.names = FALSE, overwrite = FALSE, append = FALSE, field.types = NULL, binary = TRUE ) } \arguments{ \item{conn}{DBIObject} \item{name}{ character vector of names (table names, fields, keywords). } \item{value}{ a data.frame. } \item{...}{ placeholder for future use. } \item{row.names}{Add a \code{row.name} column, or a vector of length \code{nrow(obj)} containing row.names; default \code{FALSE}.} \item{overwrite}{Will try to \code{drop} table before writing; default \code{FALSE}.} \item{append}{Append rows to existing table; default \code{FALSE}.} \item{field.types}{default \code{NULL}. Allows to override type conversion from R to PostgreSQL. See \code{dbDataType()} for details.} \item{binary}{Send geometries serialized as Well-Known Binary (WKB); if \code{FALSE}, uses Well-Known Text (WKT). Defaults to \code{TRUE} (WKB).} } \description{ Write \code{sf} object to Database Write \code{sf} object to Database } ================================================ FILE: man/db_drivers.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/read.R \docType{data} \name{db_drivers} \alias{db_drivers} \title{Drivers for which update should be \code{TRUE} by default} \usage{ db_drivers } \description{ Drivers for which update should be \code{TRUE} by default } ================================================ FILE: man/dot-stop_geos.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-transformers.R \name{.stop_geos} \alias{.stop_geos} \title{Internal functions} \usage{ .stop_geos(msg) } \arguments{ \item{msg}{error message} } \description{ Internal functions } \keyword{internal} ================================================ FILE: man/extension_map.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/read.R \docType{data} \name{extension_map} \alias{extension_map} \title{Map extension to driver} \usage{ extension_map } \description{ Map extension to driver } ================================================ FILE: man/gdal.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/stars.R \name{gdal} \alias{gdal} \alias{gdal_read} \alias{gdal_write} \alias{gdal_inv_geotransform} \alias{gdal_crs} \alias{gdal_metadata} \alias{gdal_subdatasets} \alias{gdal_polygonize} \alias{gdal_rasterize} \alias{gdal_extract} \alias{gdal_read_mdim} \alias{gdal_write_mdim} \alias{gdal_create} \title{functions to interact with gdal not meant to be called directly by users (but e.g. by stars::read_stars)} \usage{ gdal_read( x, ..., options = character(0), driver = character(0), read_data = TRUE, NA_value = NA_real_, RasterIO_parameters = list() ) gdal_write( x, ..., file, driver = "GTiff", options = character(0), type = "Float32", NA_value = NA_real_, geotransform, update = FALSE, scale_offset = c(1, 0) ) gdal_inv_geotransform(gt) gdal_crs(file, options = character(0)) gdal_metadata( file, domain_item = character(0), options = character(0), parse = TRUE ) gdal_subdatasets(file, options = character(0), name = TRUE) gdal_polygonize( x, mask = NULL, file = tempfile(), driver = "GTiff", use_integer = TRUE, geotransform, breaks = classInt::classIntervals(na.omit(as.vector(x[[1]])))$brks, use_contours = FALSE, contour_lines = FALSE, connect8 = FALSE, ... ) gdal_rasterize(sf, x, gt, file, driver = "GTiff", options = character()) gdal_extract( f, pts, resampling = c("nearest", "bilinear", "cubic", "cubicspline") ) gdal_read_mdim( file, array_name = character(0), options = character(0), offset = integer(0), count = integer(0), step = integer(0), proxy = FALSE, debug = FALSE ) gdal_write_mdim( file, driver, dimx, cdl, wkt, xy, ..., root_group_options = character(0), options = character(0), as_float = TRUE ) gdal_create(f, nxy, values, crs, xlim, ylim) } \arguments{ \item{x}{character vector, possibly of length larger than 1 when more than one raster is read} \item{...}{ignored} \item{options}{character; driver specific options regarding reading or creating the dataset} \item{driver}{character; driver short name; when empty vector, driver is auto-detected.} \item{read_data}{logical; if \code{FALSE}, only the imagery metadata is returned} \item{NA_value}{(double) non-NA value to use for missing values; if \code{NA}, when writing missing values are not specially flagged in output dataset, when reading the default (dataset) missing values are used (if present / set).} \item{RasterIO_parameters}{list with named parameters to GDAL's RasterIO; see the stars::read_stars documentation.} \item{file}{file name} \item{type}{gdal write type} \item{geotransform}{length 6 numeric vector with GDAL geotransform parameters.} \item{update}{logical; \code{TRUE} if in an existing raster file pixel values shall be updated.} \item{scale_offset}{length 2 numeric; contains scale and offset values} \item{gt}{double vector of length 6} \item{domain_item}{character vector of length 0, 1 (with domain), or 2 (with domain and item); use \code{""} for the default domain, use \code{NA_character_} to query the domain names.} \item{parse}{logical; should metadata be parsed into a named list (\code{TRUE}) or returned as character data?} \item{name}{logical; retrieve name of subdataset? If \code{FALSE}, retrieve description} \item{mask}{stars object with NA mask (0 where NA), or NULL} \item{use_integer}{boolean; if \code{TRUE}, raster values are read as (and rounded to) unsigned 32-bit integers values; if \code{FALSE} they are read as 32-bit floating points numbers. The former is supposedly faster.} \item{breaks}{numeric vector with break values for contour polygons (or lines)} \item{use_contours}{logical;} \item{contour_lines}{logical;} \item{connect8}{logical; if \code{TRUE} use 8 connection algorithm, rather than 4} \item{sf}{object of class \code{sf}} \item{f}{character; file name} \item{pts}{points matrix} \item{resampling}{character; resampling method; for method cubic or cubicspline, \code{stars_proxy} objects should be used and GDAL should have version >= 3.10.0} \item{array_name}{array name} \item{offset}{offset (pixels)} \item{count}{number of pixels to read} \item{step}{step size (pixels)} \item{proxy}{logical; return proxy object?} \item{debug}{logical; print debug messages?} \item{dimx}{integer named vector with dimensions of object} \item{cdl}{list with variables, each having a named dim attribute} \item{wkt}{character; WKT of crs} \item{xy}{character; names of the spatial x and y dimension} \item{root_group_options}{character; driver specific options regarding the creation of the root group} \item{as_float}{logical; when \code{TRUE} write 4-byte floating point numbers, when \code{FALSE} write 8-byte doubles.} \item{nxy}{integer vector of length 2} \item{values}{fill value} \item{crs}{object of class \code{crs}} \item{xlim}{numeric} \item{ylim}{numeric} } \value{ object of class \code{crs}, see \link{st_crs}. named list with metadata items \code{gdal_subdatasets} returns a zero-length list if \code{file} does not have subdatasets, and else a named list with subdatasets. } \description{ functions to interact with gdal not meant to be called directly by users (but e.g. by stars::read_stars) } \details{ These functions are exported for the single purpose of being used by package stars, they are not meant to be used directly and may change or disappear without prior notice or deprecation warnings. gdal_inv_geotransform returns the inverse geotransform gdal_crs reads coordinate reference system from GDAL data set get_metadata gets metadata of a raster layer gdal_subdatasets returns the subdatasets of a gdal dataset } \examples{ \dontrun{ f = system.file("tif/L7_ETMs.tif", package="stars") f = system.file("nc/avhrr-only-v2.19810901.nc", package = "stars") gdal_metadata(f) gdal_metadata(f, NA_character_) try(gdal_metadata(f, "wrongDomain")) gdal_metadata(f, c("", "AREA_OR_POINT")) } } \keyword{internal} ================================================ FILE: man/gdal_addo.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/stars.R \name{gdal_addo} \alias{gdal_addo} \title{Add or remove overviews to/from a raster image} \usage{ gdal_addo( file, overviews = c(2, 4, 8, 16), method = "NEAREST", layers = integer(0), options = character(0), config_options = character(0), clean = FALSE, read_only = FALSE ) } \arguments{ \item{file}{character; file name} \item{overviews}{integer; overview levels} \item{method}{character; method to create overview; one of: nearest, average, rms, gauss, cubic, cubicspline, lanczos, average_mp, average_magphase, mode} \item{layers}{integer; layers to create overviews for (default: all)} \item{options}{character; dataset opening options} \item{config_options}{named character vector with GDAL config options, like \code{c(option1=value1, option2=value2)}} \item{clean}{logical; if \code{TRUE} only remove overviews, do not add} \item{read_only}{logical; if \code{TRUE}, add overviews to another file with extension \code{.ovr} added to \code{file}} } \value{ \code{TRUE}, invisibly, on success } \description{ add or remove overviews to/from a raster image } \seealso{ \link{gdal_utils} for access to other gdal utilities that have a C API } ================================================ FILE: man/gdal_compressors.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/stars.R \name{gdal_compressors} \alias{gdal_compressors} \title{List GDAL compressors and decompressors} \usage{ gdal_compressors() } \value{ named list with two character vectors, containing compressors and decompressors } \description{ List GDAL compressors and decompressors } ================================================ FILE: man/gdal_utils.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/gdal_utils.R \name{gdal_utils} \alias{gdal_utils} \title{Native interface to gdal utils} \usage{ gdal_utils( util = "info", source, destination, options = character(0), quiet = !(util \%in\% c("info", "gdalinfo", "ogrinfo", "vectorinfo", "mdiminfo")) || ("-multi" \%in\% options), processing = character(0), colorfilename = character(0), config_options = character(0), read_only = FALSE ) } \arguments{ \item{util}{character; one of \code{info}, \code{warp}, \code{rasterize}, \code{translate}, \code{vectortranslate} (for ogr2ogr), \code{buildvrt}, \code{demprocessing}, \code{nearblack}, \code{grid}, \code{mdiminfo} and \code{mdimtranslate} (the last two requiring GDAL 3.1), \code{ogrinfo} (requiring GDAL 3.7), \code{footprint} (requiring GDAL 3.8)} \item{source}{character; name of input layer(s); for \code{warp}, \code{buidvrt} or \code{mdimtranslate} this can be more than one} \item{destination}{character; name of output layer} \item{options}{character; options for the utility} \item{quiet}{logical; if \code{TRUE}, suppress printing the output for \code{info} and \code{mdiminfo}, and suppress printing progress} \item{processing}{character; processing options for \code{demprocessing}} \item{colorfilename}{character; name of color file for \code{demprocessing} (mandatory if \code{processing="color-relief"})} \item{config_options}{named character vector with GDAL config options, like \code{c(option1=value1, option2=value2)}} \item{read_only}{logical; only for \code{ogrinfo}: if \code{TRUE}, source is opened in read-only mode} } \value{ \code{info} returns a character vector with the raster metadata; all other utils return (invisibly) a logical indicating success (i.e., \code{TRUE}); in case of failure, an error is raised. } \description{ Native interface to gdal utils } \examples{ if (compareVersion(sf_extSoftVersion()["GDAL"], "2.1.0") == 1) { # info utils can be used to list information about a raster # dataset. More info: https://gdal.org/programs/gdalinfo.html in_file <- system.file("tif/geomatrix.tif", package = "sf") gdal_utils("info", in_file, options = c("-mm", "-proj4")) # vectortranslate utils can be used to convert simple features data between # file formats. More info: https://gdal.org/programs/ogr2ogr.html in_file <- system.file("shape/storms_xyz.shp", package="sf") out_file <- paste0(tempfile(), ".gpkg") gdal_utils( util = "vectortranslate", source = in_file, destination = out_file, # output format must be specified for GDAL < 2.3 options = c("-f", "GPKG") ) # The parameters can be specified as c("name") or c("name", "value"). The # vectortranslate utils can perform also various operations during the # conversion process. For example, we can reproject the features during the # translation. gdal_utils( util = "vectortranslate", source = in_file, destination = out_file, options = c( "-f", "GPKG", # output file format for GDAL < 2.3 "-s_srs", "EPSG:4326", # input file SRS "-t_srs", "EPSG:2264", # output file SRS "-overwrite" ) ) st_read(out_file) # The parameter s_srs had to be specified because, in this case, the in_file # has no associated SRS. st_read(in_file) } } \seealso{ \link{gdal_addo} for adding overlays to a raster file; \link{st_layers} to query geometry type(s) and crs from layers in a (vector) data source } ================================================ FILE: man/geos_binary_ops.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-transformers.R \name{geos_binary_ops} \alias{geos_binary_ops} \alias{st_intersection} \alias{st_intersection.sfc} \alias{st_intersection.sf} \alias{st_difference} \alias{st_difference.sfc} \alias{st_sym_difference} \alias{st_snap} \title{Geometric operations on pairs of simple feature geometry sets} \usage{ st_intersection(x, y, ..., by_element = FALSE) \method{st_intersection}{sfc}(x, y, ...) \method{st_intersection}{sf}(x, y, ...) st_difference(x, y, ...) \method{st_difference}{sfc}(x, y, ...) st_sym_difference(x, y, ...) st_snap(x, y, tolerance) } \arguments{ \item{x}{object of class \code{sf}, \code{sfc} or \code{sfg}} \item{y}{object of class \code{sf}, \code{sfc} or \code{sfg}} \item{...}{arguments passed on to \link[s2]{s2_options}} \item{by_element}{logical; if \code{TRUE}, return pair-wise computed geometries, rather than set-wise; can be used for all binary operations} \item{tolerance}{tolerance values used for \code{st_snap}; numeric value or object of class \code{units}; may have tolerance values for each feature in \code{x}} } \value{ The intersection, difference or symmetric difference between two sets of geometries. The returned object has the same class as that of the first argument (\code{x}) with the non-empty geometries resulting from applying the operation to all geometry pairs in \code{x} and \code{y}. In case \code{x} is of class \code{sf}, the matching attributes of the original object(s) are added. The \code{sfc} geometry list-column returned carries an attribute \code{idx}, which is an \code{n}-by-2 matrix with every row the index of the corresponding entries of \code{x} and \code{y}, respectively. } \description{ Perform geometric set operations with simple feature geometry collections } \details{ When using GEOS and not using s2, a spatial index is built on argument \code{x}; see \url{https://r-spatial.org/r/2017/06/22/spatial-index.html}. The reference for the STR tree algorithm is: Leutenegger, Scott T., Mario A. Lopez, and Jeffrey Edgington. "STR: A simple and efficient algorithm for R-tree packing." Data Engineering, 1997. Proceedings. 13th international conference on. IEEE, 1997. For the pdf, search Google Scholar. When called with missing \code{y}, the \code{sfc} method for \code{st_intersection} returns all non-empty intersections of the geometries of \code{x}; an attribute \code{idx} contains a list-column with the indexes of contributing geometries. when called with a missing \code{y}, the \code{sf} method for \code{st_intersection} returns an \code{sf} object with attributes taken from the contributing feature with lowest index; two fields are added: \code{n.overlaps} with the number of overlapping features in \code{x}, and a list-column \code{origins} with indexes of all overlapping features. When \code{st_difference} is called with a single argument, overlapping areas are erased from geometries that are indexed at greater numbers in the argument to \code{x}; geometries that are empty or contained fully inside geometries with higher priority are removed entirely. The \code{st_difference.sfc} method with a single argument returns an object with an \code{"idx"} attribute with the original index for returned geometries. \code{st_snap} snaps the vertices and segments of a geometry to another geometry's vertices. If \code{y} contains more than one geometry, its geometries are merged into a collection before snapping to that collection. (from the GEOS docs:) "A snap distance tolerance is used to control where snapping is performed. Snapping one geometry to another can improve robustness for overlay operations by eliminating nearly-coincident edges (which cause problems during noding and intersection calculation). Too much snapping can result in invalid topology being created, so the number and location of snapped vertices is decided using heuristics to determine when it is safe to snap. This can result in some potential snaps being omitted, however." } \note{ To find whether pairs of simple feature geometries intersect, use the function \code{\link{st_intersects}} instead of \code{st_intersection}. When using GEOS and not using s2 polygons contain their boundary. When using s2 this is determined by the \code{model} defaults of \link[s2]{s2_options}, which can be overridden via the ... argument, e.g. \code{model = "closed"} to force DE-9IM compliant behaviour of polygons (and reproduce GEOS results). } \examples{ set.seed(131) library(sf) m = rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0)) p = st_polygon(list(m)) n = 100 l = vector("list", n) for (i in 1:n) l[[i]] = p + 10 * runif(2) s = st_sfc(l) plot(s, col = sf.colors(categorical = TRUE, alpha = .5)) title("overlapping squares") d = st_difference(s) # sequential differences: s1, s2-s1, s3-s2-s1, ... plot(d, col = sf.colors(categorical = TRUE, alpha = .5)) title("non-overlapping differences") i = st_intersection(s) # all intersections plot(i, col = sf.colors(categorical = TRUE, alpha = .5)) title("non-overlapping intersections") summary(lengths(st_overlaps(s, s))) # includes self-counts! summary(lengths(st_overlaps(d, d))) summary(lengths(st_overlaps(i, i))) sf = st_sf(s) i = st_intersection(sf) # all intersections plot(i["n.overlaps"]) summary(i$n.overlaps - lengths(i$origins)) # A helper function that erases all of y from x: st_erase = function(x, y) st_difference(x, st_union(st_combine(y))) poly = st_polygon(list(cbind(c(0, 0, 1, 1, 0), c(0, 1, 1, 0, 0)))) lines = st_multilinestring(list( cbind(c(0, 1), c(1, 1.05)), cbind(c(0, 1), c(0, -.05)), cbind(c(1, .95, 1), c(1.05, .5, -.05)) )) snapped = st_snap(poly, lines, tolerance=.1) plot(snapped, col='red') plot(poly, border='green', add=TRUE) plot(lines, lwd=2, col='blue', add=TRUE) } \seealso{ \link{st_union} for the union of simple features collections; \link{intersect} and \link{setdiff} for the base R set operations. } ================================================ FILE: man/geos_binary_pred.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-predicates.R \name{geos_binary_pred} \alias{geos_binary_pred} \alias{st_intersects} \alias{st_disjoint} \alias{st_touches} \alias{st_crosses} \alias{st_within} \alias{st_contains} \alias{st_contains_properly} \alias{st_overlaps} \alias{st_equals} \alias{st_covers} \alias{st_covered_by} \alias{st_equals_exact} \alias{st_is_within_distance} \title{Geometric binary predicates on pairs of simple feature geometry sets} \usage{ st_intersects(x, y, sparse = TRUE, ..., by_element = FALSE) st_disjoint(x, y = x, sparse = TRUE, prepared = TRUE, ...) st_touches(x, y, sparse = TRUE, prepared = TRUE, ...) st_crosses(x, y, sparse = TRUE, prepared = TRUE, ...) st_within(x, y, sparse = TRUE, prepared = TRUE, ...) st_contains(x, y, sparse = TRUE, prepared = TRUE, ..., model = "open") st_contains_properly(x, y, sparse = TRUE, prepared = TRUE, ...) st_overlaps(x, y, sparse = TRUE, prepared = TRUE, ...) st_equals( x, y, sparse = TRUE, prepared = FALSE, ..., retain_unique = FALSE, remove_self = FALSE ) st_covers(x, y, sparse = TRUE, prepared = TRUE, ..., model = "closed") st_covered_by(x, y = x, sparse = TRUE, prepared = TRUE, ..., model = "closed") st_equals_exact(x, y, par, sparse = TRUE, prepared = FALSE, ...) st_is_within_distance(x, y = x, dist, sparse = TRUE, ..., remove_self = FALSE) } \arguments{ \item{x}{object of class \code{sf}, \code{sfc} or \code{sfg}} \item{y}{object of class \code{sf}, \code{sfc} or \code{sfg}; if missing, \code{x} is used} \item{sparse}{logical; should a sparse index list be returned (\code{TRUE}) or a dense logical matrix? See below.} \item{...}{ Arguments passed on to \code{\link[s2:s2_options]{s2::s2_options}} \describe{ \item{\code{snap}}{Use \code{s2_snap_identity()}, \code{s2_snap_distance()}, \code{s2_snap_level()}, or \code{s2_snap_precision()} to specify how or if coordinate rounding should occur.} \item{\code{snap_radius}}{As opposed to the snap function, which specifies the maximum distance a vertex should move, the snap radius (in radians) sets the minimum distance between vertices of the output that don't cause vertices to move more than the distance specified by the snap function. This can be used to simplify the result of a boolean operation. Use -1 to specify that any minimum distance is acceptable.} \item{\code{duplicate_edges}}{Use \code{TRUE} to keep duplicate edges (e.g., duplicate points).} \item{\code{edge_type}}{One of 'directed' (default) or 'undirected'.} \item{\code{validate}}{Use \code{TRUE} to validate the result from the builder.} \item{\code{polyline_type}}{One of 'path' (default) or 'walk'. If 'walk', polylines that backtrack are preserved.} \item{\code{polyline_sibling_pairs}}{One of 'discard' (default) or 'keep'.} \item{\code{simplify_edge_chains}}{Use \code{TRUE} to remove vertices that are within \code{snap_radius} of the original vertex.} \item{\code{split_crossing_edges}}{Use \code{TRUE} to split crossing polyline edges when creating geometries.} \item{\code{idempotent}}{Use \code{FALSE} to apply snap even if snapping is not necessary to satisfy vertex constraints.} \item{\code{dimensions}}{A combination of 'point', 'polyline', and/or 'polygon' that can used to constrain the output of \code{\link[s2:s2_rebuild]{s2_rebuild()}} or a boolean operation.} \item{\code{level}}{A value from 0 to 30 corresponding to the cell level at which snapping should occur.} \item{\code{precision}}{A number by which coordinates should be multiplied before being rounded. Rounded to the nearest exponent of 10.} \item{\code{distance}}{A distance (in radians) denoting the maximum distance a vertex should move in the snapping process.} }} \item{by_element}{logical; if \code{TRUE}, return logical vector with x-y pair-wise predicate values} \item{prepared}{logical; prepare geometry for \code{x}, before looping over \code{y}? See Details.} \item{model}{character; polygon/polyline model; one of "open", "semi-open" or "closed"; see Details.} \item{retain_unique}{logical; if \code{TRUE} (and \code{y} is missing) return only indexes of points larger than the current index; this can be used to select unique geometries, see examples. This argument can be used for all geometry predicates; see also \link{distinct.sf} to find records where geometries AND attributes are distinct.} \item{remove_self}{logical; if \code{TRUE} (and \code{y} is missing) return only indexes of geometries different from the current index; this can be used to omit self-intersections; see examples. This argument can be used for all geometry predicates} \item{par}{numeric; parameter used for "equals_exact" (margin);} \item{dist}{distance threshold; geometry indexes with distances smaller or equal to this value are returned; numeric value or units value having distance units.} } \value{ If \code{sparse=FALSE}, \code{st_predicate} (with \code{predicate} e.g. "intersects") returns a dense logical matrix with element \code{i,j} equal to \code{TRUE} when \code{predicate(x[i], y[j])} (e.g., when geometry of feature i and j intersect); if \code{sparse=TRUE}, an object of class \code{\link{sgbp}} is returned, which is a sparse list representation of the same matrix, with list element \code{i} an integer vector with all indices \code{j} for which \code{predicate(x[i],y[j])} is \code{TRUE} (and hence a zero-length integer vector if none of them is \code{TRUE}). From the dense matrix, one can find out if one or more elements intersect by \code{apply(mat, 1, any)}, and from the sparse list by \code{lengths(lst) > 0}, see examples below. If \code{by_element=TRUE}, return a vector of pair-wise predicate values. } \description{ Geometric binary predicates on pairs of simple feature geometry sets } \details{ If \code{prepared} is \code{TRUE}, and \code{x} contains POINT geometries and \code{y} contains polygons, then the polygon geometries are prepared, rather than the points. For most predicates, a spatial index is built on argument \code{x}; see \url{https://r-spatial.org/r/2017/06/22/spatial-index.html}. Specifically, \code{st_intersects}, \code{st_disjoint}, \code{st_touches} \code{st_crosses}, \code{st_within}, \code{st_contains}, \code{st_contains_properly}, \code{st_overlaps}, \code{st_equals}, \code{st_covers} and \code{st_covered_by} all build spatial indexes for more efficient geometry calculations. \code{st_relate}, \code{st_equals_exact}, and do not; \code{st_is_within_distance} uses a spatial index for geographic coordinates when \code{sf_use_s2()} is true. If \code{y} is missing, \code{st_predicate(x, x)} is effectively called, and a square matrix is returned with diagonal elements \code{st_predicate(x[i], x[i])}. Sparse geometry binary predicate (\code{\link{sgbp}}) lists have the following attributes: \code{region.id} with the \code{row.names} of \code{x} (if any, else \code{1:n}), \code{ncol} with the number of features in \code{y}, and \code{predicate} with the name of the predicate used. for \code{model}, see https://github.com/r-spatial/s2/issues/32 \code{st_contains_properly(A,B)} is true if A intersects B's interior, but not its edges or exterior; A contains A, but A does not properly contain A. See also \link{st_relate} and \url{https://en.wikipedia.org/wiki/DE-9IM} for a more detailed description of the underlying algorithms. \code{st_equals_exact} returns true for two geometries of the same type and their vertices corresponding by index are equal up to a specified tolerance. } \note{ For intersection on pairs of simple feature geometries, use the function \code{\link{st_intersection}} instead of \code{st_intersects}. } \examples{ pts = st_sfc(st_point(c(.5,.5)), st_point(c(1.5, 1.5)), st_point(c(2.5, 2.5))) pol = st_polygon(list(rbind(c(0,0), c(2,0), c(2,2), c(0,2), c(0,0)))) (lst = st_intersects(pts, pol)) (mat = st_intersects(pts, pol, sparse = FALSE)) # which points fall inside a polygon? apply(mat, 1, any) lengths(lst) > 0 # which points fall inside the first polygon? st_intersects(pol, pts)[[1]] # remove duplicate geometries: p1 = st_point(0:1) p2 = st_point(2:1) p = st_sf(a = letters[1:8], geom = st_sfc(p1, p1, p2, p1, p1, p2, p2, p1)) st_equals(p) st_equals(p, remove_self = TRUE) (u = st_equals(p, retain_unique = TRUE)) # retain the records with unique geometries: p[-unlist(u),] } ================================================ FILE: man/geos_combine.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-transformers.R \name{geos_combine} \alias{geos_combine} \alias{st_combine} \alias{st_union} \title{Combine or union feature geometries} \usage{ st_combine(x) st_union(x, y, ..., by_feature = FALSE, is_coverage = FALSE) } \arguments{ \item{x}{object of class \code{sf}, \code{sfc} or \code{sfg}} \item{y}{object of class \code{sf}, \code{sfc} or \code{sfg} (optional)} \item{...}{ignored} \item{by_feature}{logical; if \code{TRUE}, union each feature if \code{y} is missing or else each pair of features; if \code{FALSE} return a single feature that is the geometric union of the set of features in \code{x} if \code{y} is missing, or else the unions of each of the elements of the Cartesian product of both sets} \item{is_coverage}{logical; if \code{TRUE}, use an optimized algorithm for features that form a polygonal coverage (have no overlaps)} } \value{ \code{st_combine} returns a single, combined geometry, with no resolved boundaries; returned geometries may well be invalid. If \code{y} is missing, \code{st_union(x)} returns a single geometry with resolved boundaries, else the geometries for all unioned pairs of \code{x[i]} and \code{y[j]}. } \description{ Combine several feature geometries into one, without unioning or resolving internal boundaries } \details{ \code{st_combine} combines geometries without resolving borders, using \link{c.sfg} (analogous to \link[base]{c} for ordinary vectors). If \code{st_union} is called with a single argument, \code{x}, (with \code{y} missing) and \code{by_feature} is \code{FALSE} all geometries are unioned together and an \code{sfg} or single-geometry \code{sfc} object is returned. If \code{by_feature} is \code{TRUE} each feature geometry is unioned individually. This can for instance be used to resolve internal boundaries after polygons were combined using \code{st_combine}. If \code{y} is provided, all elements of \code{x} and \code{y} are unioned, pairwise if \code{by_feature} is TRUE, or else as the Cartesian product of both sets. Unioning a set of overlapping polygons has the effect of merging the areas (i.e. the same effect as iteratively unioning all individual polygons together). Unioning a set of LineStrings has the effect of fully noding and dissolving the input linework. In this context "fully noded" means that there will be a node or endpoint in the output for every endpoint or line segment crossing in the input. "Dissolved" means that any duplicate (e.g. coincident) line segments or portions of line segments will be reduced to a single line segment in the output. Unioning a set of Points has the effect of merging all identical points (producing a set with no duplicates). } \examples{ nc = st_read(system.file("shape/nc.shp", package="sf")) st_combine(nc) plot(st_union(nc)) } \seealso{ \link{st_intersection}, \link{st_difference}, \link{st_sym_difference} } ================================================ FILE: man/geos_measures.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-measures.R \name{geos_measures} \alias{geos_measures} \alias{st_area} \alias{st_area.sfc} \alias{st_length} \alias{st_perimeter} \alias{st_distance} \title{Compute geometric measurements} \usage{ st_area(x, ...) \method{st_area}{sfc}(x, ...) st_length(x, ...) st_perimeter(x, ...) st_distance( x, y, ..., dist_fun, by_element = FALSE, which = ifelse(isTRUE(st_is_longlat(x)), "Great Circle", "Euclidean"), par = 0, tolerance = 0 ) } \arguments{ \item{x}{object of class \code{sf}, \code{sfc} or \code{sfg}} \item{...}{passed on to \link[s2]{s2_distance}, \link[s2]{s2_distance_matrix}, or \link[s2]{s2_perimeter}} \item{y}{object of class \code{sf}, \code{sfc} or \code{sfg}, defaults to \code{x}} \item{dist_fun}{deprecated} \item{by_element}{logical; if \code{TRUE}, return a vector with distance between the first elements of \code{x} and \code{y}, the second, etc; an error is raised if \code{x} and \code{y} are not the same length. If \code{FALSE}, return the dense matrix with all pairwise distances.} \item{which}{character; for Cartesian coordinates only: one of \code{Euclidean}, \code{Hausdorff} or \code{Frechet}; for geodetic coordinates, great circle distances are computed; see details} \item{par}{for \code{which} equal to \code{Hausdorff} or \code{Frechet}, optionally use a value between 0 and 1 to densify the geometry} \item{tolerance}{ignored if \code{st_is_longlat(x)} is \code{FALSE}; otherwise, if set to a positive value, the first distance smaller than \code{tolerance} will be returned, and true distance may be smaller; this may speed up computation. In meters, or a \code{units} object convertible to meters.} } \value{ If the coordinate reference system of \code{x} was set, these functions return values with unit of measurement; see \link[units]{set_units}. st_area returns the area of each feature geometry, computed in the coordinate reference system used. In case \code{x} has geodetic coordinates (unprojected), then if \code{sf_use_s2()} is \code{FALSE} \link[lwgeom:geod]{st_geod_area} is used for area calculation, if it is \code{TRUE} then \link[s2:s2_is_collection]{s2_area} is used: the former assumes an ellipsoidal shape, the latter a spherical shape of the Earth. In case of projected data, areas are computed in flat space. The argument \code{...} can be used to specify \code{radius} to \link[s2:s2_is_collection]{s2_area}, to modify the Earth radius. st_length returns the length of a \code{LINESTRING} or \code{MULTILINESTRING} geometry, using the coordinate reference system. \code{POINT}, \code{MULTIPOINT}, \code{POLYGON} or \code{MULTIPOLYGON} geometries return zero. If coordinates are geodetic (i.e., long/lat), great circle calculations are carried out on a sphere (if \code{sf_use_s2()} is \code{TRUE}), or a geodesic line is computed on an ellipsoid (if \code{sf_use_s2()} is \code{FALSE}). For all other non-geodetic, projected coordinate systems, length calculations are planar, Euclidean distance calculations in the units of the coordinate system. If \code{by_element} is \code{FALSE} \code{st_distance} returns a dense numeric matrix of dimension length(x) by length(y); otherwise it returns a numeric vector the same length as \code{x} and \code{y} with an error raised if the lengths of \code{x} and \code{y} are unequal. Distances involving empty geometries are \code{NA}. } \description{ Compute Euclidean or great circle distance between pairs of geometries; compute, the area or the length of a set of geometries. } \details{ great circle distance calculations use by default spherical distances (\link[s2]{s2_distance} or \link[s2]{s2_distance_matrix}); if \code{sf_use_s2()} is \code{FALSE}, ellipsoidal distances are computed using \link[lwgeom]{st_geod_distance} which uses function \code{geod_inverse} from GeographicLib (part of PROJ); see Karney, Charles FF, 2013, Algorithms for geodesics, Journal of Geodesy 87(1), 43--55 } \examples{ b0 = st_polygon(list(rbind(c(-1,-1), c(1,-1), c(1,1), c(-1,1), c(-1,-1)))) b1 = b0 + 2 b2 = b0 + c(-0.2, 2) x = st_sfc(b0, b1, b2) st_area(x) line = st_sfc(st_linestring(rbind(c(30,30), c(40,40))), crs = 4326) st_length(line) outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) poly = st_polygon(list(outer, hole1, hole2)) mpoly = st_multipolygon(list( list(outer, hole1, hole2), list(outer + 12, hole1 + 12) )) st_length(st_sfc(poly, mpoly)) if (requireNamespace("lwgeom", quietly = TRUE)) { st_perimeter(poly) st_perimeter(mpoly) } p = st_sfc(st_point(c(0,0)), st_point(c(0,1)), st_point(c(0,2))) st_distance(p, p) st_distance(p, p, by_element = TRUE) } \seealso{ \link{st_dimension}, \link{st_cast} to convert geometry types } ================================================ FILE: man/geos_query.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-measures.R, R/geom-predicates.R \name{geos_query} \alias{geos_query} \alias{st_dimension} \alias{st_is_simple} \alias{st_is_empty} \title{Dimension, simplicity, validity or is_empty queries on simple feature geometries} \usage{ st_dimension(x, NA_if_empty = TRUE) st_is_simple(x) st_is_empty(x) } \arguments{ \item{x}{object of class \code{sf}, \code{sfc} or \code{sfg}} \item{NA_if_empty}{logical; if TRUE, return NA for empty geometries} } \value{ st_dimension returns a numeric vector with 0 for points, 1 for lines, 2 for surfaces, and, if \code{NA_if_empty} is \code{TRUE}, \code{NA} for empty geometries. st_is_simple returns a logical vector, indicating for each geometry whether it is simple (e.g., not self-intersecting) st_is_empty returns for each geometry whether it is empty } \description{ Dimension, simplicity, validity or is_empty queries on simple feature geometries } \examples{ x = st_sfc( st_point(0:1), st_linestring(rbind(c(0,0),c(1,1))), st_polygon(list(rbind(c(0,0),c(1,0),c(0,1),c(0,0)))), st_multipoint(), st_linestring(), st_geometrycollection()) st_dimension(x) st_dimension(x, FALSE) ls = st_linestring(rbind(c(0,0), c(1,1), c(1,0), c(0,1))) st_is_simple(st_sfc(ls, st_point(c(0,0)))) ls = st_linestring(rbind(c(0,0), c(1,1), c(1,0), c(0,1))) st_is_empty(st_sfc(ls, st_point(), st_linestring())) } ================================================ FILE: man/geos_unary.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-transformers.R \name{geos_unary} \alias{geos_unary} \alias{st_buffer} \alias{st_boundary} \alias{st_convex_hull} \alias{st_concave_hull} \alias{st_simplify} \alias{st_triangulate} \alias{st_triangulate_constrained} \alias{st_inscribed_circle} \alias{st_minimum_rotated_rectangle} \alias{st_minimum_bounding_circle} \alias{st_voronoi} \alias{st_polygonize} \alias{st_line_merge} \alias{st_centroid} \alias{st_point_on_surface} \alias{st_reverse} \alias{st_node} \alias{st_segmentize} \alias{st_exterior_ring} \title{Geometric unary operations on simple feature geometry sets} \usage{ st_buffer( x, dist, nQuadSegs = 30, endCapStyle = "ROUND", joinStyle = "ROUND", mitreLimit = 1, singleSide = FALSE, ... ) st_boundary(x) st_convex_hull(x) st_concave_hull(x, ratio, ..., allow_holes) st_simplify(x, preserveTopology, dTolerance = 0) st_triangulate(x, dTolerance = 0, bOnlyEdges = FALSE) st_triangulate_constrained(x) st_inscribed_circle(x, dTolerance, ...) st_minimum_rotated_rectangle(x, ...) st_minimum_bounding_circle(x, ...) st_voronoi( x, envelope, dTolerance = 0, bOnlyEdges = FALSE, point_order = FALSE ) st_polygonize(x) st_line_merge(x, ..., directed = FALSE) st_centroid(x, ..., of_largest_polygon = FALSE) st_point_on_surface(x) st_reverse(x) st_node(x) st_segmentize(x, dfMaxLength, ...) st_exterior_ring(x, ...) } \arguments{ \item{x}{object of class \code{sfg}, \code{sfc} or \code{sf}} \item{dist}{numeric or object of class \code{units}; buffer distance(s) for all, or for each of the elements in \code{x}. In case \code{x} has geodetic coordinates (lon/lat) and \code{sf_use_s2()} is \code{TRUE}, a numeric \code{dist} is taken as distance in meters and a \code{units} object in \code{dist} is converted to meters. In case \code{x} has geodetic coordinates (lon/lat) and \code{sf_use_s2()} is \code{FALSE}, a numeric \code{dist} is taken as degrees, and a \code{units} object in \code{dist} is converted to \code{arc_degree} (and warnings are issued). In case \code{x} does not have geodetic coordinates (projected) then numeric \code{dist} is assumed to have the units of the coordinates, and a \code{units} \code{dist} is converted to those if \code{st_crs(x)} is not \code{NA}.} \item{nQuadSegs}{integer; number of segments per quadrant (fourth of a circle), for all or per-feature; see details} \item{endCapStyle}{character; style of line ends, one of 'ROUND', 'FLAT', 'SQUARE'; see details} \item{joinStyle}{character; style of line joins, one of 'ROUND', 'MITRE', 'BEVEL'; see details} \item{mitreLimit}{numeric; limit of extension for a join if \code{joinStyle} 'MITRE' is used (default 1.0, minimum 0.0); see details} \item{singleSide}{logical; if \code{TRUE}, single-sided buffers are returned for linear geometries, in which case negative \code{dist} values give buffers on the right-hand side, positive on the left; see details} \item{...}{in \code{st_buffer} passed on to \code{\link[s2:s2_buffer_cells]{s2::s2_buffer_cells()}}, otherwise ignored} \item{ratio}{numeric; fraction convex: 1 returns the convex hulls, 0 maximally concave hulls} \item{allow_holes}{logical; if \code{TRUE}, the resulting concave hull may have holes} \item{preserveTopology}{logical; carry out topology preserving simplification? May be specified for each, or for all feature geometries. Note that topology is preserved only for single feature geometries, not for sets of them. If not specified (i.e. the default), then it is internally set equal to \code{FALSE} when the input data is specified with projected coordinates or \code{sf_use_s2()} returns \code{FALSE}. Ignored in all the other cases (with a warning when set equal to \code{FALSE}) since the function implicitly calls \code{s2::s2_simplify} which always preserve topological relationships (per single feature).} \item{dTolerance}{numeric; tolerance parameter, specified for all or for each feature geometry. If you run \code{st_simplify}, the input data is specified with long-lat coordinates and \code{sf_use_s2()} returns \code{TRUE}, then the value of \code{dTolerance} must be specified in meters.} \item{bOnlyEdges}{logical; if \code{TRUE}, return lines, else return polygons} \item{envelope}{object of class \code{sfc} or \code{sfg} containing a \code{POLYGON} with the envelope for a voronoi diagram; this only takes effect when it is larger than the default envelope, chosen when \code{envelope} is an empty polygon} \item{point_order}{logical; preserve point order if TRUE and GEOS version >= 3.12; overrides bOnlyEdges} \item{directed}{logical; if \code{TRUE}, lines with opposite directions will not be merged} \item{of_largest_polygon}{logical; for \code{st_centroid}: if \code{TRUE}, return centroid of the largest (sub)polygon of a \code{MULTIPOLYGON} rather than of the whole \code{MULTIPOLYGON}} \item{dfMaxLength}{maximum length of a line segment. If \code{x} has geographical coordinates (long/lat), \code{dfMaxLength} is either a numeric expressed in meter, or an object of class \code{units} with length units \code{rad} or \code{degree}; segmentation in the long/lat case takes place along the great circle, using \link[lwgeom:geod]{st_geod_segmentize}.} } \value{ an object of the same class of \code{x}, with manipulated geometry. } \description{ Geometric unary operations on simple feature geometries. These are all generics, with methods for \code{sfg}, \code{sfc} and \code{sf} objects, returning an object of the same class. All operations work on a per-feature basis, ignoring all other features. } \details{ \code{st_buffer} computes a buffer around this geometry/each geometry. Depending on the spatial coordinate system, a different engine (GEOS or S2) can be used, which have different function arguments. The \code{nQuadSegs}, \code{endCapsStyle}, \code{joinStyle}, \code{mitreLimit} and \code{singleSide} parameters only work if the GEOS engine is used (i.e. projected coordinates or when \code{sf_use_s2()} is set to \code{FALSE}). See \href{https://postgis.net/docs/ST_Buffer.html}{postgis.net/docs/ST_Buffer.html} for details. The \code{max_cells} and \code{min_level} parameters (\code{\link[s2:s2_buffer_cells]{s2::s2_buffer_cells()}}) work with the S2 engine (i.e. geographic coordinates) and can be used to change the buffer shape (e.g. smoothing). The S2 engine returns a polygon \emph{around} a number of S2 cells that contain the buffer, and hence will always have an area larger than the true buffer, depending on \code{max_cells}, and will be non-smooth when sufficiently zoomed in. The GEOS engine will return line segments between points on the circle, and so will always be \emph{smaller} than the true buffer, and be smooth, depending on the number of segments \code{nQuadSegs}. A negative \code{dist} value for geodetic coordinates using S2 does not give a proper (geodetic) buffer. \code{st_boundary} returns the boundary of a geometry \code{st_convex_hull} creates the convex hull of a set of points \code{st_concave_hull} creates the concave hull of a geometry \code{st_simplify} simplifies lines by removing vertices. \code{st_triangulate} triangulates set of points (not constrained). \code{st_triangulate} requires GEOS version 3.4 or above \code{st_triangulate_constrained} returns the constrained delaunay triangulation of polygons; requires GEOS version 3.10 or above \code{st_inscribed_circle} returns the maximum inscribed circle for polygon geometries. For \code{st_inscribed_circle}, if \code{nQuadSegs} is 0 a 2-point LINESTRING is returned with the center point and a boundary point of every circle, otherwise a circle (buffer) is returned where \code{nQuadSegs} controls the number of points per quadrant to approximate the circle. \code{st_inscribed_circle} requires GEOS version 3.9 or above \code{st_minimum_rotated_rectangle} returns the minimum rotated rectangular POLYGON which encloses the input geometry. The rectangle has width equal to the minimum diameter, and a longer length. If the convex hill of the input is degenerate (a line or point) a linestring or point is returned. \code{st_minimum_bounding_circle} returns a geometry which represents the "minimum bounding circle", the smallest circle that contains the input. \code{st_voronoi} creates voronoi tessellation. \code{st_voronoi} requires GEOS version 3.5 or above \code{st_polygonize} creates a polygon from lines that form a closed ring. In case of \code{st_polygonize}, \code{x} must be an object of class \code{LINESTRING} or \code{MULTILINESTRING}, or an \code{sfc} geometry list-column object containing these \code{st_line_merge} merges lines. In case of \code{st_line_merge}, \code{x} must be an object of class \code{MULTILINESTRING}, or an \code{sfc} geometry list-column object containing these \code{st_centroid} gives the centroid of a geometry \code{st_point_on_surface} returns a point guaranteed to be on the (multi)surface. \code{st_reverse} reverses the nodes in a line \code{st_node} adds nodes to linear geometries at intersections without a node, and only works on individual linear geometries \code{st_segmentize} adds points to straight lines \code{st_exterior_ring} returns the exterior rings of polygons, removing all holes. } \examples{ ## st_buffer, style options (taken from rgeos gBuffer) l1 = st_as_sfc("LINESTRING(0 0,1 5,4 5,5 2,8 2,9 4,4 6.5)") op = par(mfrow=c(2,3)) plot(st_buffer(l1, dist = 1, endCapStyle="ROUND"), reset = FALSE, main = "endCapStyle: ROUND") plot(l1,col='blue',add=TRUE) plot(st_buffer(l1, dist = 1, endCapStyle="FLAT"), reset = FALSE, main = "endCapStyle: FLAT") plot(l1,col='blue',add=TRUE) plot(st_buffer(l1, dist = 1, endCapStyle="SQUARE"), reset = FALSE, main = "endCapStyle: SQUARE") plot(l1,col='blue',add=TRUE) plot(st_buffer(l1, dist = 1, nQuadSegs=1), reset = FALSE, main = "nQuadSegs: 1") plot(l1,col='blue',add=TRUE) plot(st_buffer(l1, dist = 1, nQuadSegs=2), reset = FALSE, main = "nQuadSegs: 2") plot(l1,col='blue',add=TRUE) plot(st_buffer(l1, dist = 1, nQuadSegs= 5), reset = FALSE, main = "nQuadSegs: 5") plot(l1,col='blue',add=TRUE) par(op) l2 = st_as_sfc("LINESTRING(0 0,1 5,3 2)") op = par(mfrow = c(2, 3)) plot(st_buffer(l2, dist = 1, joinStyle="ROUND"), reset = FALSE, main = "joinStyle: ROUND") plot(l2, col = 'blue', add = TRUE) plot(st_buffer(l2, dist = 1, joinStyle="MITRE"), reset = FALSE, main = "joinStyle: MITRE") plot(l2, col= 'blue', add = TRUE) plot(st_buffer(l2, dist = 1, joinStyle="BEVEL"), reset = FALSE, main = "joinStyle: BEVEL") plot(l2, col= 'blue', add=TRUE) plot(st_buffer(l2, dist = 1, joinStyle="MITRE" , mitreLimit=0.5), reset = FALSE, main = "mitreLimit: 0.5") plot(l2, col = 'blue', add = TRUE) plot(st_buffer(l2, dist = 1, joinStyle="MITRE",mitreLimit=1), reset = FALSE, main = "mitreLimit: 1") plot(l2, col = 'blue', add = TRUE) plot(st_buffer(l2, dist = 1, joinStyle="MITRE",mitreLimit=3), reset = FALSE, main = "mitreLimit: 3") plot(l2, col = 'blue', add = TRUE) par(op) # compare approximation errors depending on S2 or GEOS backend: # geographic coordinates, uses S2: x = st_buffer(st_as_sf(data.frame(lon=0,lat=0), coords=c("lon","lat"),crs='OGC:CRS84'), units::as_units(1,"km")) y = units::set_units(st_area(x), "km^2") # error: postive, default maxcells = 1000 (units::drop_units(y)-pi)/pi x = st_buffer(st_as_sf(data.frame(lon=0,lat=0), coords=c("lon","lat"),crs='OGC:CRS84'), units::as_units(1,"km"), max_cells=1e5) y = units::set_units(st_area(x), "km^2") # error: positive but smaller: (units::drop_units(y)-pi)/pi # no CRS set: assumes Cartesian (projected) coordinates x = st_buffer(st_as_sf(data.frame(lon=0,lat=0), coords=c("lon","lat")), 1) y = st_area(x) # error: negative, nQuadSegs default at 30 ((y)-pi)/pi x = st_buffer(st_as_sf(data.frame(lon=0,lat=0), coords=c("lon","lat")), 1, nQuadSegs = 100) y = st_area(x) # error: negative but smaller: ((y)-pi)/pi nc = st_read(system.file("shape/nc.shp", package="sf")) nc_g = st_geometry(nc) plot(st_convex_hull(nc_g)) plot(nc_g, border = grey(.5), add = TRUE) pt = st_combine(st_sfc(st_point(c(0,80)), st_point(c(120,80)), st_point(c(240,80)))) st_convex_hull(pt) # R2 st_convex_hull(st_set_crs(pt, 'OGC:CRS84')) # S2 set.seed(131) if (compareVersion(sf_extSoftVersion()[["GEOS"]], "3.11.0") > -1) { pts = cbind(runif(100), runif(100)) m = st_multipoint(pts) co = sf:::st_concave_hull(m, 0.3) coh = sf:::st_concave_hull(m, 0.3, allow_holes = TRUE) plot(co, col = 'grey') plot(coh, add = TRUE, border = 'red') plot(m, add = TRUE) } # st_simplify examples: op = par(mfrow = c(2, 3), mar = rep(0, 4)) plot(nc_g[1]) plot(st_simplify(nc_g[1], dTolerance = 1e3)) # 1000m plot(st_simplify(nc_g[1], dTolerance = 5e3)) # 5000m nc_g_planar = st_transform(nc_g, 2264) # planar coordinates, US foot plot(nc_g_planar[1]) plot(st_simplify(nc_g_planar[1], dTolerance = 1e3)) # 1000 foot plot(st_simplify(nc_g_planar[1], dTolerance = 5e3)) # 5000 foot par(op) if (compareVersion(sf_extSoftVersion()[["GEOS"]], "3.10.0") > -1) { pts = rbind(c(0,0), c(1,0), c(1,1), c(.5,.5), c(0,1), c(0,0)) po = st_polygon(list(pts)) co = st_triangulate_constrained(po) tr = st_triangulate(po) plot(po, col = NA, border = 'grey', lwd = 15) plot(tr, border = 'green', col = NA, lwd = 5, add = TRUE) plot(co, border = 'red', col = 'NA', add = TRUE) } if (compareVersion(sf_extSoftVersion()[["GEOS"]], "3.9.0") > -1) { nc_t = st_transform(nc, 'EPSG:2264') x = st_inscribed_circle(st_geometry(nc_t)) plot(st_geometry(nc_t), asp = 1, col = grey(.9)) plot(x, add = TRUE, col = '#ff9999') } set.seed(1) x = st_multipoint(matrix(runif(10),,2)) box = st_polygon(list(rbind(c(0,0),c(1,0),c(1,1),c(0,1),c(0,0)))) if (compareVersion(sf_extSoftVersion()[["GEOS"]], "3.5.0") > -1) { v = st_sfc(st_voronoi(x, st_sfc(box))) plot(v, col = 0, border = 1, axes = TRUE) plot(box, add = TRUE, col = 0, border = 1) # a larger box is returned, as documented plot(x, add = TRUE, col = 'red', cex=2, pch=16) plot(st_intersection(st_cast(v), box)) # clip to smaller box plot(x, add = TRUE, col = 'red', cex=2, pch=16) # matching Voronoi polygons to data points: # https://github.com/r-spatial/sf/issues/1030 # generate 50 random unif points: n = 100 pts = st_as_sf(data.frame(matrix(runif(n), , 2), id = 1:(n/2)), coords = c("X1", "X2")) # compute Voronoi polygons: pols = st_collection_extract(st_voronoi(do.call(c, st_geometry(pts)))) # match them to points: pts_pol = st_intersects(pts, pols) pts$pols = pols[unlist(pts_pol)] # re-order if (isTRUE(try(compareVersion(sf_extSoftVersion()["GEOS"], "3.12.0") > -1, silent = TRUE))) { pols_po = st_collection_extract(st_voronoi(do.call(c, st_geometry(pts)), point_order = TRUE)) # GEOS >= 3.12 can preserve order of inputs pts_pol_po = st_intersects(pts, pols_po) print(all(unlist(pts_pol_po) == 1:(n/2))) } plot(pts["id"], pch = 16) # ID is color plot(st_set_geometry(pts, "pols")["id"], xlim = c(0,1), ylim = c(0,1), reset = FALSE) plot(st_geometry(pts), add = TRUE) layout(matrix(1)) # reset plot layout } mls = st_multilinestring(list(matrix(c(0,0,0,1,1,1,0,0),,2,byrow=TRUE))) st_polygonize(st_sfc(mls)) mls = st_multilinestring(list(rbind(c(0,0), c(1,1)), rbind(c(2,0), c(1,1)))) st_line_merge(st_sfc(mls)) plot(nc_g, axes = TRUE) plot(st_centroid(nc_g), add = TRUE, pch = 3, col = 'red') mp = st_combine(st_buffer(st_sfc(lapply(1:3, function(x) st_point(c(x,x)))), 0.2 * 1:3)) plot(mp) plot(st_centroid(mp), add = TRUE, col = 'red') # centroid of combined geometry plot(st_centroid(mp, of_largest_polygon = TRUE), add = TRUE, col = 'blue', pch = 3) plot(nc_g, axes = TRUE) plot(st_point_on_surface(nc_g), add = TRUE, pch = 3, col = 'red') if (compareVersion(sf_extSoftVersion()[["GEOS"]], "3.7.0") > -1) { st_reverse(st_linestring(rbind(c(1,1), c(2,2), c(3,3)))) } (l = st_linestring(rbind(c(0,0), c(1,1), c(0,1), c(1,0), c(0,0)))) st_polygonize(st_node(l)) st_node(st_multilinestring(list(rbind(c(0,0), c(1,1), c(0,1), c(1,0), c(0,0))))) sf = st_sf(a=1, geom=st_sfc(st_linestring(rbind(c(0,0),c(1,1)))), crs = 4326) if (require(lwgeom, quietly = TRUE)) { seg = st_segmentize(sf, units::set_units(100, km)) seg = st_segmentize(sf, units::set_units(0.01, rad)) nrow(seg$geom[[1]]) } } \seealso{ \link[grDevices]{chull} for a more efficient algorithm for calculating the convex hull } ================================================ FILE: man/interpolate_aw.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/aggregate.R \name{interpolate_aw} \alias{interpolate_aw} \alias{st_interpolate_aw} \alias{st_interpolate_aw.sf} \title{Area-weighted interpolation or dasymetric mapping of polygon data} \usage{ st_interpolate_aw(x, to, extensive, ...) \method{st_interpolate_aw}{sf}( x, to, extensive, ..., keep_NA = FALSE, na.rm = FALSE, include_non_intersected = FALSE, weights = character(0) ) } \arguments{ \item{x}{object of class \code{sf}, for which we want to aggregate attributes} \item{to}{object of class \code{sf} or \code{sfc}, with the target geometries} \item{extensive}{logical; if TRUE, the attribute variables are assumed to be spatially extensive (like population) and the sum is preserved, otherwise, spatially intensive (like population density) and the mean is preserved.} \item{...}{ignored} \item{keep_NA}{logical; if \code{TRUE}, return all features in \code{to}, if \code{FALSE} return only those with non-NA values (but with \code{row.names} the index corresponding to the feature in \code{to})} \item{na.rm}{logical; if \code{TRUE} remove features with \code{NA} attributes from \code{x} before interpolating} \item{include_non_intersected}{logical; for the case when \code{extensive=FALSE}, when set to \code{TRUE} divide by the target areas (including non-intersected areas), when \code{FALSE} divide by the sum of the source areas.} \item{weights}{character; name of column in \code{to} that indicates (extensive) weights, to be used instead of areas, for redistributing attributes in \code{x}; currently only works for \code{extensive=TRUE}.} } \description{ Area-weighted interpolation or dasymetric mapping of polygon data } \details{ if \code{extensive} is \code{TRUE} and \code{na.rm} is set to \code{TRUE}, geometries with \code{NA} are effectively treated as having zero attribute values. Dasymetric mapping is obtained when \code{weights} are specified. } \examples{ # example Area-weighted interpolation: nc = st_read(system.file("shape/nc.shp", package="sf")) g = st_make_grid(nc, n = c(10, 5)) a1 = st_interpolate_aw(nc["BIR74"], g, extensive = FALSE) sum(a1$BIR74) / sum(nc$BIR74) # not close to one: property is assumed spatially intensive a2 = st_interpolate_aw(nc["BIR74"], g, extensive = TRUE) # verify mass preservation (pycnophylactic) property: sum(a2$BIR74) / sum(nc$BIR74) a1$intensive = a1$BIR74 a1$extensive = a2$BIR74 \donttest{plot(a1[c("intensive", "extensive")], key.pos = 4)} # example Dasymetric mapping: # load nr of addresses per 10 km grid cell, to proxy population -> birth density: grd.addr = system.file("gpkg/grd_addr.gpkg", package="sf") |> read_sf() xgrd.addr = grd.addr # copy for plotting xgrd.addr$ones[grd.addr$ones==0] = 1 # so that logz shows finite values \donttest{plot(xgrd.addr, logz=TRUE, main = "nr of addresses per cell") # log scale} nc = st_transform(nc, st_crs(grd.addr)) # avoid "assumes attributes are constant or uniform over areas" warnings: st_agr(nc) = c(BIR74 = "constant", BIR79 = "constant") st_agr(grd.addr) = c(ones = "constant") # dasymetric mapping bir.grd = st_interpolate_aw(nc[c("BIR74","BIR79")], extensive = TRUE, grd.addr, weights = "ones") xbir.grd = bir.grd # copy for plotting xbir.grd$BIR74[xbir.grd$BIR74 == 0] = 1 # so that logz shows finite values \donttest{plot(xbir.grd["BIR74"], logz = TRUE, main = "redistributed birth counts, 1974-")} # verify sums: apply(as.data.frame(bir.grd)[1:2], 2, sum) apply(as.data.frame(nc)[c("BIR74", "BIR79")], 2, sum) # compare county-wise: st_agr(bir.grd) = c(BIR74 = "constant") aw = st_interpolate_aw(bir.grd["BIR74"], st_geometry(nc), extensive = TRUE) plot(nc$BIR74, aw$BIR74, log = 'xy', xlab = 'county-value', ylab = 'area-w interpolated') abline(0,1) } ================================================ FILE: man/is_driver_available.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/read.R \name{is_driver_available} \alias{is_driver_available} \title{Check if driver is available} \usage{ is_driver_available(drv, drivers = st_drivers()) } \arguments{ \item{drv}{character. Name of driver} \item{drivers}{data.frame. Table containing driver names and support. Default is from \code{\link{st_drivers}}} } \description{ Search through the driver table if driver is listed } ================================================ FILE: man/is_driver_can.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/read.R \name{is_driver_can} \alias{is_driver_can} \title{Check if a driver can perform an action} \usage{ is_driver_can(drv, drivers = st_drivers(), operation = "write") } \arguments{ \item{drv}{character. Name of driver} \item{drivers}{data.frame. Table containing driver names and support. Default is from \code{\link{st_drivers}}} \item{operation}{character. What action to check} } \description{ Search through the driver table to match a driver name with an action (e.g. \code{"write"}) and check if the action is supported. } ================================================ FILE: man/is_geometry_column.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/db.R \name{is_geometry_column} \alias{is_geometry_column} \title{Check if the columns could be of a coercable type for sf} \usage{ is_geometry_column(con, x, classes = "") } \arguments{ \item{con}{database connection} \item{x}{inherits data.frame} \item{classes}{classes inherited} } \description{ Check if the columns could be of a coercable type for sf } ================================================ FILE: man/merge.sf.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/sf.R \name{merge.sf} \alias{merge.sf} \title{merge method for sf and data.frame object} \usage{ \method{merge}{sf}(x, y, ...) } \arguments{ \item{x}{object of class \code{sf}} \item{y}{object of class \code{data.frame}} \item{...}{arguments passed on to \code{merge.data.frame}} } \description{ merge method for sf and data.frame object } \examples{ a = data.frame(a = 1:3, b = 5:7) st_geometry(a) = st_sfc(st_point(c(0,0)), st_point(c(1,1)), st_point(c(2,2))) b = data.frame(x = c("a", "b", "c"), b = c(2,5,6)) merge(a, b) merge(a, b, all = TRUE) } ================================================ FILE: man/nc.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/datasets.R \docType{data} \name{nc} \alias{nc} \title{North Carolina SIDS data} \format{ A \code{sf} object } \description{ Sudden Infant Death Syndrome (SIDS) sample data for North Carolina counties, two time periods (1974-78 and 1979-84). The details of the columns can be found in a \href{https://r-spatial.github.io/spdep/articles/sids.html}{spdep package vignette}. Please note that, though this is basically the same as \code{nc.sids} dataset in spData package, \code{nc} only contains a subset of variables. The differences are also discussed on the vignette. } \examples{ \donttest{ nc <- st_read(system.file("shape/nc.shp", package="sf")) } } \seealso{ \url{https://r-spatial.github.io/spdep/articles/sids.html} } ================================================ FILE: man/plot.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.R \name{plot} \alias{plot} \alias{plot.sf} \alias{get_key_pos} \alias{plot.sfc_POINT} \alias{plot.sfc_MULTIPOINT} \alias{plot.sfc_LINESTRING} \alias{plot.sfc_CIRCULARSTRING} \alias{plot.sfc_MULTILINESTRING} \alias{plot.sfc_POLYGON} \alias{plot.sfc_MULTIPOLYGON} \alias{plot.sfc_GEOMETRYCOLLECTION} \alias{plot.sfc_GEOMETRY} \alias{plot.sfg} \alias{plot_sf} \alias{sf.colors} \alias{text.sf} \alias{text.sfc} \alias{points.sf} \alias{points.sfc} \title{plot sf object} \usage{ \method{plot}{sf}( x, y, ..., main, pal = NULL, nbreaks = 10, breaks = "pretty", max.plot = getOption("sf_max.plot", default = 9), key.pos = get_key_pos(x, ...), key.length = 0.618, key.width = kw_dflt(x, key.pos), reset = TRUE, logz = FALSE, extent = x, xlim = st_bbox(extent)[c(1, 3)], ylim = st_bbox(extent)[c(2, 4)], compact = FALSE ) get_key_pos(x, ...) \method{plot}{sfc_POINT}( x, y, ..., pch = 1, cex = 1, col = 1, bg = 0, lwd = 1, lty = 1, type = "p", add = FALSE ) \method{plot}{sfc_MULTIPOINT}( x, y, ..., pch = 1, cex = 1, col = 1, bg = 0, lwd = 1, lty = 1, type = "p", add = FALSE ) \method{plot}{sfc_LINESTRING}(x, y, ..., lty = 1, lwd = 1, col = 1, pch = 1, type = "l", add = FALSE) \method{plot}{sfc_CIRCULARSTRING}(x, y, ...) \method{plot}{sfc_MULTILINESTRING}(x, y, ..., lty = 1, lwd = 1, col = 1, pch = 1, type = "l", add = FALSE) \method{plot}{sfc_POLYGON}( x, y, ..., lty = 1, lwd = 1, col = NA, cex = 1, pch = NA, border = 1, add = FALSE, rule = "evenodd", xpd = par("xpd") ) \method{plot}{sfc_MULTIPOLYGON}( x, y, ..., lty = 1, lwd = 1, col = NA, border = 1, add = FALSE, rule = "evenodd", xpd = par("xpd") ) \method{plot}{sfc_GEOMETRYCOLLECTION}( x, y, ..., pch = 1, cex = 1, bg = 0, lty = 1, lwd = 1, col = 1, border = 1, add = FALSE ) \method{plot}{sfc_GEOMETRY}( x, y, ..., pch = 1, cex = 1, bg = 0, lty = 1, lwd = 1, col = ifelse(st_dimension(x) == 2, NA, 1), border = 1, add = FALSE ) \method{plot}{sfg}(x, ...) plot_sf( x, xlim = NULL, ylim = NULL, asp = NA, axes = FALSE, bgc = par("bg"), ..., xaxs, yaxs, lab, setParUsrBB = FALSE, bgMap = NULL, expandBB = c(0, 0, 0, 0), graticule = NA_crs_, col_graticule = "grey", border, extent = x ) sf.colors(n = 10, cutoff.tails = c(0.35, 0.2), alpha = 1, categorical = FALSE) \method{text}{sf}(x, labels = row.names(x), ...) \method{text}{sfc}(x, labels = seq_along(x), ..., of_largest_polygon = FALSE) \method{points}{sf}(x, ...) \method{points}{sfc}(x, ..., of_largest_polygon = FALSE) } \arguments{ \item{x}{object of class sf} \item{y}{ignored} \item{...}{further specifications, see \link{plot_sf} and \link{plot} and details.} \item{main}{title for plot (\code{NULL} to remove)} \item{pal}{palette function, similar to \link{rainbow}, or palette values; if omitted, \code{sf.colors} is used} \item{nbreaks}{number of colors breaks (ignored for \code{factor} or \code{character} variables)} \item{breaks}{either a numeric vector with the actual breaks, or a name of a method accepted by the \code{style} argument of \link[classInt]{classIntervals}} \item{max.plot}{integer; lower boundary to maximum number of attributes to plot; the default value (9) can be overridden by setting the global option \code{sf_max.plot}, e.g. \code{options(sf_max.plot=2)}} \item{key.pos}{numeric; side to plot a color key: 1 bottom, 2 left, 3 top, 4 right; set to \code{NULL} to omit key completely, 0 to only not plot the key, or -1 to select automatically. If multiple columns are plotted in a single function call by default no key is plotted and every submap is stretched individually; if a key is requested (and \code{col} is missing) all maps are colored according to a single key. Auto select depends on plot size, map aspect, and, if set, parameter \code{asp}. If it has lenght 2, the second value, ranging from 0 to 1, determines where the key is placed in the available space (default: 0.5, center).} \item{key.length}{amount of space reserved for the key along its axis, length of the scale bar} \item{key.width}{amount of space reserved for the key (incl. labels), thickness/width of the scale bar} \item{reset}{logical; if \code{FALSE}, keep the plot in a mode that allows adding further map elements; if \code{TRUE} restore original mode after plotting \code{sf} objects with attributes; see details.} \item{logz}{logical; if \code{TRUE}, use log10-scale for the attribute variable. In that case, \code{breaks} and \code{at} need to be given as log10-values; see examples.} \item{extent}{object with an \code{st_bbox} method to define plot extent; defaults to \code{x}} \item{xlim}{see \link{plot.window}} \item{ylim}{see \link{plot.window}} \item{compact}{logical; compact sub-plots over plotting space?} \item{pch}{plotting symbol} \item{cex}{symbol size} \item{col}{color for plotting features; if \code{length(col)} does not equal 1 or \code{nrow(x)}, a warning is emitted that colors will be recycled. Specifying \code{col} suppresses plotting the legend key.} \item{bg}{symbol background color} \item{lwd}{line width} \item{lty}{line type} \item{type}{plot type: 'p' for points, 'l' for lines, 'b' for both} \item{add}{logical; add to current plot? Note that when using \code{add=TRUE}, you may have to set \code{reset=FALSE} in the first plot command.} \item{border}{color of polygon border(s); using \code{NA} hides them} \item{rule}{see \link[graphics]{polypath}; for \code{winding}, exterior ring direction should be opposite that of the holes; with \code{evenodd}, plotting is robust against misspecified ring directions} \item{xpd}{see \link[graphics]{par}; sets polygon clipping strategy; only implemented for POLYGON and MULTIPOLYGON} \item{asp}{see below, and see \link{par}} \item{axes}{logical; should axes be plotted? (default FALSE)} \item{bgc}{background color} \item{xaxs}{see \link{par}} \item{yaxs}{see \link{par}} \item{lab}{see \link{par}} \item{setParUsrBB}{default FALSE; set the \code{par} \dQuote{usr} bounding box; see below} \item{bgMap}{object of class \code{ggmap}, or returned by function \code{RgoogleMaps::GetMap}} \item{expandBB}{numeric; fractional values to expand the bounding box with, in each direction (bottom, left, top, right)} \item{graticule}{logical, or object of class \code{crs} (e.g., \code{st_crs('OGC:CRS84')} for a WGS84 graticule), or object created by \link{st_graticule}} \item{col_graticule}{color to used for the graticule (if present)} \item{n}{integer; number of colors} \item{cutoff.tails}{numeric, in \verb{[0,0.5]} start and end values} \item{alpha}{numeric, in \verb{[0,1]}, transparency} \item{categorical}{logical; do we want colors for a categorical variable? (see details)} \item{labels}{character, text to draw (one per row of input)} \item{of_largest_polygon}{logical, passed on to \link{st_centroid}} } \description{ plot one or more attributes of an sf object on a map Plot sf object } \details{ \code{plot.sf} maximally plots \code{max.plot} maps with colors following from attribute columns, one map per attribute. It uses \code{sf.colors} for default colors. For more control over placement of individual maps, set parameter \code{mfrow} with \link{par} prior to plotting, and plot single maps one by one; note that this only works in combination with setting parameters \code{key.pos=NULL} (no legend) and \code{reset=FALSE}. \code{plot.sfc} plots the geometry, additional parameters can be passed on to control color, lines or symbols. When setting \code{reset} to \code{FALSE}, the original device parameters are lost, and the device must be reset using \code{dev.off()} in order to reset it. parameter \code{at} can be set to specify where labels are placed along the key; see examples. parameter \code{mar} can be set in \code{...} to override default margins. The features are plotted in the order as they apppear in the sf object. See examples for when a different plotting order is wanted. \code{plot_sf} sets up the plotting area, axes, graticule, or webmap background; it is called by all \code{plot} methods before anything is drawn. The argument \code{setParUsrBB} may be used to pass the logical value \code{TRUE} to functions within \code{plot.Spatial}. When set to \code{TRUE}, par(\dQuote{usr}) will be overwritten with \code{c(xlim, ylim)}, which defaults to the bounding box of the spatial object. This is only needed in the particular context of graphic output to a specified device with given width and height, to be matched to the spatial object, when using par(\dQuote{xaxs}) and par(\dQuote{yaxs}) in addition to \code{par(mar=c(0,0,0,0))}. The default aspect for map plots is 1; if however data are not projected (coordinates are long/lat), the aspect is by default set to 1/cos(My * pi/180) with My the y coordinate of the middle of the map (the mean of \code{ylim}, which defaults to the y range of bounding box). This implies an \href{https://en.wikipedia.org/wiki/Equirectangular_projection}{Equirectangular projection}. non-categorical colors from \code{sf.colors} were taken from \link[sp]{bpy.colors}, with modified \code{cutoff.tails} defaults If categorical is \code{TRUE}, default colors are from \url{https://colorbrewer2.org/} (if n < 9, Set2, else Set3). \code{text.sf} adds text to an existing base graphic. Text is placed at the centroid of each feature in \code{x}. Provide POINT features for further control of placement. \code{points.sf} adds point symbols to an existing base graphic. If points of text are not shown correctly, try setting argument \code{reset} to \code{FALSE} in the \code{plot()} call. } \examples{ nc = st_read(system.file("gpkg/nc.gpkg", package="sf"), quiet = TRUE) # plot single attribute, auto-legend: plot(nc["SID74"]) # plot multiple: plot(nc[c("SID74", "SID79")]) # better use ggplot2::geom_sf to facet and get a single legend! # adding to a plot of an sf object only works when using reset=FALSE in the first plot: plot(nc["SID74"], reset = FALSE) plot(st_centroid(st_geometry(nc)), add = TRUE) # log10 z-scale: plot(nc["SID74"], logz = TRUE, breaks = c(0,.5,1,1.5,2), at = c(0,.5,1,1.5,2)) # and we need to reset the plotting device after that, e.g. by layout(1) # when plotting only geometries, the reset=FALSE is not needed: plot(st_geometry(nc)) plot(st_geometry(nc)[1], col = 'red', add = TRUE) # add a custom legend to an arbitray plot: layout(matrix(1:2, ncol = 2), widths = c(1, lcm(2))) plot(1) .image_scale(1:10, col = sf.colors(9), key.length = lcm(8), key.pos = 4, at = 1:10) # manipulate plotting order, plot largest polygons first: p = st_polygon(list(rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0)))) x = st_sf(a=1:4, st_sfc(p, p * 2, p * 3, p * 4)) # plot(x, col=2:5) only shows the largest polygon! plot(x[order(st_area(x), decreasing = TRUE),], col = 2:5) # plot largest polygons first sf.colors(10) text(nc, labels = substring(nc$NAME,1,1)) } ================================================ FILE: man/prefix_map.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/read.R \docType{data} \name{prefix_map} \alias{prefix_map} \title{Map prefix to driver} \usage{ prefix_map } \description{ Map prefix to driver } ================================================ FILE: man/proj_tools.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/proj.R \name{proj_tools} \alias{proj_tools} \alias{sf_proj_search_paths} \alias{sf_proj_network} \alias{sf_proj_pipelines} \title{Manage PROJ settings} \usage{ sf_proj_search_paths(paths = character(0), with_proj = NA) sf_proj_network(enable = FALSE, url = character(0)) sf_proj_pipelines( source_crs, target_crs, authority = character(0), AOI = numeric(0), Use = "NONE", grid_availability = "USED", desired_accuracy = -1, strict_containment = FALSE, axis_order_authority_compliant = st_axis_order() ) } \arguments{ \item{paths}{the search path to be set; omit if paths need to be queried} \item{with_proj}{logical; if \code{NA} set for both GDAL and PROJ, otherwise set either for PROJ (\code{TRUE}) or GDAL (\code{FALSE})} \item{enable}{logical; set this to enable (\code{TRUE}) or disable (\code{FALSE}) the proj network search facility} \item{url}{character; use this to specify and override the default proj network CDN} \item{source_crs, target_crs}{object of class \code{crs} or character} \item{authority}{character; constrain output pipelines to those of authority} \item{AOI}{length four numeric; desired area of interest for the resulting coordinate transformations (west, south, east, north, in degrees). For an area of interest crossing the anti-meridian, west will be greater than east.} \item{Use}{one of "NONE", "BOTH", "INTERSECTION", "SMALLEST", indicating how AOI's of source_crs and target_crs are being used} \item{grid_availability}{character; one of "USED" (Grid availability is only used for sorting results. Operations where some grids are missing will be sorted last), "DISCARD" (Completely discard an operation if a required grid is missing) , "IGNORED" (Ignore grid availability at all. Results will be presented as if all grids were available.), or "AVAILABLE" (Results will be presented as if grids known to PROJ (that is registered in the grid_alternatives table of its database) were available. Used typically when networking is enabled.)} \item{desired_accuracy}{numeric; only return pipelines with at least this accuracy} \item{strict_containment}{logical; default \code{FALSE}; permit partial matching of the area of interest; if \code{TRUE} strictly contain the area of interest. The area of interest is either as given in AOI, or as implied by the source/target coordinate reference systems} \item{axis_order_authority_compliant}{logical; if \code{FALSE} always choose ‘x’ or longitude for the first axis; if TRUE, follow the axis orders given by the coordinate reference systems when constructing the for the first axis; if \code{FALSE}, follow the axis orders given by} } \value{ \code{sf_proj_search_paths()} returns the search path (possibly after setting it) \code{sf_proj_network} when called without arguments returns a logical indicating whether network search of datum grids is enabled, when called with arguments it returns a character vector with the URL of the CDN used (or specified with \code{url}). \code{sf_proj_pipelines()} returns a table with candidate coordinate transformation pipelines along with their accuracy; \code{NA} accuracy indicates ballpark accuracy. } \description{ Query or manage PROJ search path and network settings } ================================================ FILE: man/rawToHex.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/wkb.R \name{rawToHex} \alias{rawToHex} \title{Convert raw vector(s) into hexadecimal character string(s)} \usage{ rawToHex(x) } \arguments{ \item{x}{raw vector, or list with raw vectors} } \description{ Convert raw vector(s) into hexadecimal character string(s) } ================================================ FILE: man/s2.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/s2.R \name{s2} \alias{s2} \alias{sf_use_s2} \alias{st_as_s2} \alias{st_as_s2.sf} \alias{st_as_s2.sfc} \title{functions for spherical geometry, using s2 package} \usage{ sf_use_s2(use_s2) st_as_s2(x, ...) \method{st_as_s2}{sf}(x, ...) \method{st_as_s2}{sfc}( x, ..., oriented = getOption("s2_oriented", FALSE) || isTRUE(attr(x, "oriented")), rebuild = FALSE ) } \arguments{ \item{use_s2}{logical; if \code{TRUE}, use the s2 spherical geometry package for geographical coordinate operations} \item{x}{object of class \code{sf}, \code{sfc} or \code{sfg}} \item{...}{passed on} \item{oriented}{logical; if \code{FALSE}, polygons that cover more than half of the globe are inverted; if \code{TRUE}, no reversal takes place and it is assumed that the inside of the polygon is to the left of the polygon's path.} \item{rebuild}{logical; call \link[s2]{s2_rebuild} on the geometry (think of this as a \code{st_make_valid} on the sphere)} } \value{ \code{sf_use_s2} returns the value of this variable before (re)setting it, invisibly if \code{use_s2} is not missing. } \description{ functions for spherical geometry, using the s2 package based on the google s2geometry.io library } \details{ \code{st_as_s2} converts an \code{sf} POLYGON object into a form readable by \code{s2}. } \examples{ m = rbind(c(-1,-1), c(1,-1), c(1,1), c(-1,1), c(-1,-1)) m1 = rbind(c(-1,-1), c(1,-1), c(1,1), c(-1,1), c(-1,0), c(-1,-1)) m0 = m[5:1,] mp = st_multipolygon(list( list(m, 0.8 * m0, 0.01 * m1 + 0.9), list(0.7* m, 0.6*m0), list(0.5 * m0), list(m+2), list(m+4,(.9*m0)+4) )) sf = st_sfc(mp, mp, crs = 'EPSG:4326') s2 = st_as_s2(sf) } ================================================ FILE: man/sf-defunct.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/defunct.R \name{sf-defunct} \alias{sf-defunct} \alias{st_read_db} \alias{st_write_db} \title{Deprecated functions in \code{sf}} \usage{ st_read_db( conn = NULL, table = NULL, query = NULL, geom_column = NULL, EWKB = TRUE, ... ) st_write_db( conn = NULL, obj, table = deparse(substitute(obj)), ..., drop = FALSE, append = FALSE ) } \arguments{ \item{conn}{open database connection} \item{table}{table name} \item{query}{SQL query to select records; see details} \item{geom_column}{deprecated. Geometry column name} \item{EWKB}{logical; is the WKB of type EWKB? if missing, defaults to \code{TRUE}} \item{...}{parameter(s) passed on to \link{st_as_sf}} } \description{ These functions are provided for compatibility with older version of \code{sf}. They will eventually be completely removed. \itemize{ \item Use \code{\link[=st_read]{st_read()}} instead of \code{st_read_db()}. \item Use \code{\link[=st_write]{st_write()}} instead_of \code{st_write_db()} } } \details{ The \code{geom_column} argument is deprecated. The function will automatically find the \code{geometry} type columns. For the \code{RPostgreSQL} drivers it will try to cast all the character columns, which can be long for very wide tables. } \keyword{internal} ================================================ FILE: man/sf-package.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/sf-package.R \docType{package} \name{sf-package} \alias{sf-package} \title{sf: Simple Features for R} \description{ \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} Support for simple feature access, a standardized way to encode and analyze spatial vector data. Binds to 'GDAL' \doi{10.5281/zenodo.5884351} for reading and writing data, to 'GEOS' \doi{10.5281/zenodo.11396894} for geometrical operations, and to 'PROJ' \doi{10.5281/zenodo.5884394} for projection conversions and datum transformations. Uses by default the 's2' package for geometry operations on geodetic (long/lat degree) coordinates. } \references{ Pebesma, E. and Bivand, R. (2023). Spatial Data Science: With Applications in R. Chapman and Hall/CRC. \doi{10.1201/9780429459016} which is also found freely online at \url{https://r-spatial.org/book/} Pebesma, E., 2018. Simple Features for R: Standardized Support for Spatial Vector Data. The R Journal 10 (1), 439-446, \doi{10.32614/RJ-2018-009} (open access) } \seealso{ Useful links: \itemize{ \item \url{https://r-spatial.github.io/sf/} \item \url{https://github.com/r-spatial/sf} \item Report bugs at \url{https://github.com/r-spatial/sf/issues} } } \author{ \strong{Maintainer}: Edzer Pebesma \email{edzer.pebesma@uni-muenster.de} (\href{https://orcid.org/0000-0001-8049-7069}{ORCID}) Authors: \itemize{ \item Edzer Pebesma \email{edzer.pebesma@uni-muenster.de} (\href{https://orcid.org/0000-0001-8049-7069}{ORCID}) } Other contributors: \itemize{ \item Roger Bivand (\href{https://orcid.org/0000-0003-2392-6140}{ORCID}) [contributor] \item Etienne Racine [contributor] \item Michael Sumner [contributor] \item Ian Cook [contributor] \item Tim Keitt [contributor] \item Robin Lovelace [contributor] \item Hadley Wickham [contributor] \item Jeroen Ooms (\href{https://orcid.org/0000-0002-4035-0289}{ORCID}) [contributor] \item Kirill Müller [contributor] \item Thomas Lin Pedersen [contributor] \item Dan Baston [contributor] \item Dewey Dunnington (\href{https://orcid.org/0000-0002-9415-4582}{ORCID}) [contributor] \item Alexandre Courtiol (\href{https://orcid.org/0000-0003-0637-2959}{ORCID}) [contributor] } } \keyword{internal} ================================================ FILE: man/sf.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/sf.R \name{sf} \alias{sf} \alias{st_sf} \alias{[.sf} \alias{print.sf} \title{Create sf object} \usage{ st_sf( ..., agr = NA_agr_, row.names, stringsAsFactors = sf_stringsAsFactors(), crs, precision, sf_column_name = NULL, check_ring_dir = FALSE, sfc_last = TRUE ) \method{[}{sf}(x, i, j, ..., drop = FALSE, op = st_intersects) \method{print}{sf}(x, ..., n = getOption("sf_max_print", default = 10)) } \arguments{ \item{...}{column elements to be binded into an \code{sf} object or a single \code{list} or \code{data.frame} with such columns; at least one of these columns shall be a geometry list-column of class \code{sfc} or be a list-column that can be converted into an \code{sfc} by \link{st_as_sfc}.} \item{agr}{character vector; see details below.} \item{row.names}{row.names for the created \code{sf} object} \item{stringsAsFactors}{logical; see \link{st_read}} \item{crs}{coordinate reference system, something suitable as input to \link{st_crs}} \item{precision}{numeric; see \link{st_as_binary}} \item{sf_column_name}{character; name of the active list-column with simple feature geometries; in case there is more than one and \code{sf_column_name} is \code{NULL}, the first one is taken.} \item{check_ring_dir}{see \link{st_read}} \item{sfc_last}{logical; if \code{TRUE}, \code{sfc} columns are always put last, otherwise column order is left unmodified.} \item{x}{object of class \code{sf}} \item{i}{record selection, see \link{[.data.frame}, or a \code{sf} object to work with the \code{op} argument} \item{j}{variable selection, see \link{[.data.frame}} \item{drop}{logical, default \code{FALSE}; if \code{TRUE} drop the geometry column and return a \code{data.frame}, else make the geometry sticky and return a \code{sf} object.} \item{op}{function; geometrical binary predicate function to apply when \code{i} is a simple feature object} \item{n}{maximum number of features to print; can be set globally by \code{options(sf_max_print=...)}} } \description{ Create sf, which extends data.frame-like objects with a simple feature list column. To convert a data frame object to \code{sf}, use \code{\link[=st_as_sf]{st_as_sf()}} } \details{ \code{agr}, attribute-geometry-relationship, specifies for each non-geometry attribute column how it relates to the geometry, and can have one of following values: "constant", "aggregate", "identity". "constant" is used for attributes that are constant throughout the geometry (e.g. land use), "aggregate" where the attribute is an aggregate value over the geometry (e.g. population density or population count), "identity" when the attributes uniquely identifies the geometry of particular "thing", such as a building ID or a city name. The default value, \code{NA_agr_}, implies we don't know. When a single value is provided to \code{agr}, it is cascaded across all input columns; otherwise, a named vector like \code{c(feature1='constant', ...)} will set \code{agr} value to \code{'constant'} for the input column named \code{feature1}. See \code{demo(nc)} for a worked example of this. When confronted with a data.frame-like object, \code{st_sf} will try to find a geometry column of class \code{sfc}, and otherwise try to convert list-columns when available into a geometry column, using \link{st_as_sfc}. \code{[.sf} will return a \code{data.frame} or vector if the geometry column (of class \code{sfc}) is dropped (\code{drop=TRUE}), an \code{sfc} object if only the geometry column is selected, and otherwise return an \code{sf} object; see also \link{[.data.frame}; for \code{[.sf} \code{...} arguments are passed to \code{op}. } \examples{ g = st_sfc(st_point(1:2)) st_sf(a=3,g) st_sf(g, a=3) st_sf(a=3, st_sfc(st_point(1:2))) # better to name it! # create empty structure with preallocated empty geometries: nrows <- 10 geometry = st_sfc(lapply(1:nrows, function(x) st_geometrycollection())) df <- st_sf(id = 1:nrows, geometry = geometry) g = st_sfc(st_point(1:2), st_point(3:4)) s = st_sf(a=3:4, g) s[1,] class(s[1,]) s[,1] class(s[,1]) s[,2] class(s[,2]) g = st_sf(a=2:3, g) pol = st_sfc(st_polygon(list(cbind(c(0,3,3,0,0),c(0,0,3,3,0))))) h = st_sf(r = 5, pol) g[h,] h[g,] } ================================================ FILE: man/sf_extSoftVersion.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/init.R \name{sf_extSoftVersion} \alias{sf_extSoftVersion} \title{Provide the external dependencies versions of the libraries linked to sf} \usage{ sf_extSoftVersion() } \description{ Provide the external dependencies versions of the libraries linked to sf } ================================================ FILE: man/sf_project.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/init.R, R/proj.R \name{sf_project} \alias{sf_project} \alias{sf_add_proj_units} \title{directly transform a set of coordinates} \usage{ sf_add_proj_units() sf_project( from = character(0), to = character(0), pts, keep = FALSE, warn = TRUE, authority_compliant = st_axis_order() ) } \arguments{ \item{from}{character description of source CRS, or object of class \code{crs}, or pipeline describing a transformation} \item{to}{character description of target CRS, or object of class \code{crs}} \item{pts}{two-, three- or four-column numeric matrix, or object that can be coerced into a matrix; columns 3 and 4 contain z and t values.} \item{keep}{logical value controlling the handling of unprojectable points. If \code{keep} is \code{TRUE}, then such points will yield \code{Inf} or \code{-Inf} in the return value; otherwise an error is reported and nothing is returned.} \item{warn}{logical; if \code{TRUE}, warn when non-finite values are generated} \item{authority_compliant}{logical; \code{TRUE} means handle axis order authority compliant (e.g. EPSG:4326 implying x=lat, y=lon), \code{FALSE} means use visualisation order (i.e. always x=lon, y=lat)} } \value{ two-column numeric matrix with transformed/converted coordinates, returning invalid values as \code{Inf} } \description{ directly transform a set of coordinates } \details{ \code{sf_add_proj_units} loads the PROJ units \code{link}, \code{us_in}, \code{ind_yd}, \code{ind_ft}, and \code{ind_ch} into the udunits database, and returns \code{TRUE} invisibly on success. } \examples{ sf_add_proj_units() } ================================================ FILE: man/sfc.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/sfc.R \name{sfc} \alias{sfc} \alias{st_sfc} \alias{sfc_POINT} \alias{sfc_LINESTRING} \alias{sfc_POLYGON} \alias{sfc_MULTIPOINT} \alias{sfc_MULTILINESTRING} \alias{sfc_MULTIPOLYGON} \alias{sfc_GEOMETRYCOLLECTION} \alias{[.sfc} \title{Create simple feature geometry list column} \usage{ st_sfc( ..., crs = NA_crs_, precision = 0, check_ring_dir = FALSE, dim, recompute_bbox = FALSE, oriented = NA, fall_back_class = c("sfc_GEOMETRY", "sfc") ) \method{[}{sfc}(x, i, j, ..., op = st_intersects) } \arguments{ \item{...}{input: zero or more simple feature geometries (objects of class \code{sfg}), or a single list of such objects; \code{NULL} values will get replaced by empty geometries.} \item{crs}{coordinate reference system: integer with the EPSG code, or character with proj4string} \item{precision}{numeric; see \link{st_as_binary}} \item{check_ring_dir}{see \link{st_read}} \item{dim}{character; if this function is called without valid geometries, this argument may carry the right dimension to set empty geometries} \item{recompute_bbox}{logical; use \code{TRUE} to force recomputation of the bounding box} \item{oriented}{logical; if \code{TRUE}, the ring is oriented such that left of the edges is inside the polygon; this is needed for convering polygons larger than half the globe to s2} \item{fall_back_class}{character; class for return object when no geometries are provided as input} \item{x}{object of class \code{sfc}} \item{i}{record selection. Might also be an \code{sfc}/\code{sf} object to work with the \code{op} argument} \item{j}{ignored if \code{op} is specified} \item{op}{function, geometrical binary predicate function to apply when \code{i} is a \code{sf}/\code{sfc} object. Additional arguments can be specified using \code{...}, see examples.} } \value{ an object of class \code{sfc}, which is a classed list-column with simple feature geometries. } \description{ Create simple feature geometry list column, set class, and add coordinate reference system and precision. For data.frame alternatives see \code{\link[=st_sf]{st_sf()}}. To convert a foreign object to \code{sfc}, see \code{\link[=st_as_sfc]{st_as_sfc()}} } \details{ A simple feature geometry list-column is a list of class \code{c("stc_TYPE", "sfc")} which most often contains objects of identical type; in case of a mix of types or an empty set, \code{TYPE} is set to the superclass \code{GEOMETRY}. if \code{x} has a \code{dim} attribute (i.e. is an \code{array} or \code{matrix}) then \code{op} cannot be used. } \examples{ pt1 = st_point(c(0,1)) pt2 = st_point(c(1,1)) (sfc = st_sfc(pt1, pt2)) sfc[sfc[1], op = st_is_within_distance, dist = 0.5] d = st_sf(data.frame(a=1:2, geom=sfc)) } ================================================ FILE: man/sgbp.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/sgbp.R \name{sgbp} \alias{sgbp} \alias{print.sgbp} \alias{t.sgbp} \alias{as.matrix.sgbp} \alias{dim.sgbp} \alias{Ops.sgbp} \alias{as.data.frame.sgbp} \title{Methods for dealing with sparse geometry binary predicate lists} \usage{ \method{print}{sgbp}(x, ..., n = 10, max_nb = 10) \method{t}{sgbp}(x) \method{as.matrix}{sgbp}(x, ...) \method{dim}{sgbp}(x) \method{Ops}{sgbp}(e1, e2) \method{as.data.frame}{sgbp}(x, ...) } \arguments{ \item{x}{object of class \code{sgbp}} \item{...}{ignored} \item{n}{integer; maximum number of items to print} \item{max_nb}{integer; maximum number of neighbours to print for each item} \item{e1}{object of class \code{sgbp}} \item{e2}{object of class \code{sgbp}} } \description{ Methods for dealing with sparse geometry binary predicate lists } \details{ \code{sgbp} are sparse matrices, stored as a list with integer vectors holding the ordered \code{TRUE} indices of each row. This means that for a dense, \eqn{m \times n}{m x n} matrix \code{Q} and a list \code{L}, if \code{Q[i,j]} is \code{TRUE} then \eqn{j} is an element of \code{L[[i]]}. Reversed: when \eqn{k} is the value of \code{L[[i]][j]}, then \code{Q[i,k]} is \code{TRUE}. \code{==} compares only the dimension and index values, not the attributes of two \code{sgbp} object; use \code{identical} to check for equality of everything. } ================================================ FILE: man/st.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/sfg.R \name{st} \alias{st} \alias{st_point} \alias{st_multipoint} \alias{st_linestring} \alias{st_polygon} \alias{st_multilinestring} \alias{st_multipolygon} \alias{st_geometrycollection} \alias{print.sfg} \alias{head.sfg} \alias{format.sfg} \alias{c.sfg} \alias{as.matrix.sfg} \title{Create simple feature from a numeric vector, matrix or list} \usage{ st_point(x = c(NA_real_, NA_real_), dim = "XYZ") st_multipoint(x = matrix(numeric(0), 0, 2), dim = "XYZ") st_linestring(x = matrix(numeric(0), 0, 2), dim = "XYZ") st_polygon(x = list(), dim = if (length(x)) "XYZ" else "XY") st_multilinestring(x = list(), dim = if (length(x)) "XYZ" else "XY") st_multipolygon(x = list(), dim = if (length(x)) "XYZ" else "XY") st_geometrycollection(x = list(), dims = "XY") \method{print}{sfg}(x, ..., width = 0) \method{head}{sfg}(x, n = 10L, ...) \method{format}{sfg}(x, ..., width = 30) \method{c}{sfg}(..., recursive = FALSE, flatten = TRUE) \method{as.matrix}{sfg}(x, ...) } \arguments{ \item{x}{for \code{st_point}, numeric vector (or one-row-matrix) of length 2, 3 or 4; for \code{st_linestring} and \code{st_multipoint}, numeric matrix with points in rows; for \code{st_polygon} and \code{st_multilinestring}, list with numeric matrices with points in rows; for \code{st_multipolygon}, list of lists with numeric matrices; for \code{st_geometrycollection} list with (non-geometrycollection) simple feature geometry (sfg) objects; see examples below} \item{dim}{character, indicating dimensions: "XY", "XYZ", "XYM", or "XYZM"; only really needed for three-dimensional points (which can be either XYZ or XYM) or empty geometries; see details} \item{dims}{character; specify dimensionality in case of an empty (NULL) geometrycollection, in which case \code{x} is the empty \code{list()}.} \item{...}{objects to be pasted together into a single simple feature} \item{width}{integer; number of characters to be printed (max 30; 0 means print everything)} \item{n}{integer; number of elements to be selected} \item{recursive}{logical; ignored} \item{flatten}{logical; if \code{TRUE}, try to simplify results; if \code{FALSE}, return geometrycollection containing all objects} } \value{ object of the same nature as \code{x}, but with appropriate class attribute set as.matrix returns the set of points that form a geometry as a single matrix, where each point is a row; use \code{unlist(x, recursive = FALSE)} to get sets of matrices. } \description{ Create simple feature from a numeric vector, matrix or list } \details{ "XYZ" refers to coordinates where the third dimension represents altitude, "XYM" refers to three-dimensional coordinates where the third dimension refers to something else ("M" for measure); checking of the sanity of \code{x} may be only partial. When \code{flatten=TRUE}, this method may merge points into a multipoint structure, and may not preserve order, and hence cannot be reverted. When given fish, it returns fish soup. } \examples{ (p1 = st_point(c(1,2))) class(p1) st_bbox(p1) (p2 = st_point(c(1,2,3))) class(p2) (p3 = st_point(c(1,2,3), "XYM")) pts = matrix(1:10, , 2) (mp1 = st_multipoint(pts)) pts = matrix(1:15, , 3) (mp2 = st_multipoint(pts)) (mp3 = st_multipoint(pts, "XYM")) pts = matrix(1:20, , 4) (mp4 = st_multipoint(pts)) pts = matrix(1:10, , 2) (ls1 = st_linestring(pts)) pts = matrix(1:15, , 3) (ls2 = st_linestring(pts)) (ls3 = st_linestring(pts, "XYM")) pts = matrix(1:20, , 4) (ls4 = st_linestring(pts)) outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) pts = list(outer, hole1, hole2) (ml1 = st_multilinestring(pts)) pts3 = lapply(pts, function(x) cbind(x, 0)) (ml2 = st_multilinestring(pts3)) (ml3 = st_multilinestring(pts3, "XYM")) pts4 = lapply(pts3, function(x) cbind(x, 0)) (ml4 = st_multilinestring(pts4)) outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) pts = list(outer, hole1, hole2) (pl1 = st_polygon(pts)) pts3 = lapply(pts, function(x) cbind(x, 0)) (pl2 = st_polygon(pts3)) (pl3 = st_polygon(pts3, "XYM")) pts4 = lapply(pts3, function(x) cbind(x, 0)) (pl4 = st_polygon(pts4)) pol1 = list(outer, hole1, hole2) pol2 = list(outer + 12, hole1 + 12) pol3 = list(outer + 24) mp = list(pol1,pol2,pol3) (mp1 = st_multipolygon(mp)) pts3 = lapply(mp, function(x) lapply(x, function(y) cbind(y, 0))) (mp2 = st_multipolygon(pts3)) (mp3 = st_multipolygon(pts3, "XYM")) pts4 = lapply(mp2, function(x) lapply(x, function(y) cbind(y, 0))) (mp4 = st_multipolygon(pts4)) (gc = st_geometrycollection(list(p1, ls1, pl1, mp1))) st_geometrycollection() # empty geometry c(st_point(1:2), st_point(5:6)) c(st_point(1:2), st_multipoint(matrix(5:8,2))) c(st_multipoint(matrix(1:4,2)), st_multipoint(matrix(5:8,2))) c(st_linestring(matrix(1:6,3)), st_linestring(matrix(11:16,3))) c(st_multilinestring(list(matrix(1:6,3))), st_multilinestring(list(matrix(11:16,3)))) pl = list(rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0))) c(st_polygon(pl), st_polygon(pl)) c(st_polygon(pl), st_multipolygon(list(pl))) c(st_linestring(matrix(1:6,3)), st_point(1:2)) c(st_geometrycollection(list(st_point(1:2), st_linestring(matrix(1:6,3)))), st_geometrycollection(list(st_multilinestring(list(matrix(11:16,3)))))) c(st_geometrycollection(list(st_point(1:2), st_linestring(matrix(1:6,3)))), st_multilinestring(list(matrix(11:16,3))), st_point(5:6), st_geometrycollection(list(st_point(10:11)))) } ================================================ FILE: man/st_agr.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/agr.R \name{st_agr} \alias{st_agr} \alias{NA_agr_} \alias{st_agr<-} \alias{st_set_agr} \title{get or set relation_to_geometry attribute of an \code{sf} object} \usage{ NA_agr_ st_agr(x, ...) st_agr(x) <- value st_set_agr(x, value) } \arguments{ \item{x}{object of class \code{sf}} \item{...}{ignored} \item{value}{character, or factor with appropriate levels; if named, names should correspond to the non-geometry list-column columns of \code{x}} } \description{ get or set relation_to_geometry attribute of an \code{sf} object } \details{ \code{NA_agr_} is the \code{agr} object with a missing value. } ================================================ FILE: man/st_as_binary.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/wkb.R \name{st_as_binary} \alias{st_as_binary} \alias{st_as_binary.sfc} \alias{st_as_binary.sfg} \title{Convert sfc object to an WKB object} \usage{ st_as_binary(x, ...) \method{st_as_binary}{sfc}( x, ..., EWKB = FALSE, endian = .Platform$endian, pureR = FALSE, precision = attr(x, "precision"), hex = FALSE ) \method{st_as_binary}{sfg}( x, ..., endian = .Platform$endian, EWKB = FALSE, pureR = FALSE, hex = FALSE, srid = 0 ) } \arguments{ \item{x}{object to convert} \item{...}{ignored} \item{EWKB}{logical; use EWKB (PostGIS), or (default) ISO-WKB?} \item{endian}{character; either "big" or "little"; default: use that of platform} \item{pureR}{logical; use pure R solution, or C++?} \item{precision}{numeric; if zero, do not modify; to reduce precision: negative values convert to float (4-byte real); positive values convert to round(x*precision)/precision. See details.} \item{hex}{logical; return as (unclassed) hexadecimal encoded character vector?} \item{srid}{integer; override srid (can be used when the srid is unavailable locally).} } \description{ Convert sfc object to an WKB object } \details{ \code{st_as_binary} is called on sfc objects on their way to the GDAL or GEOS libraries, and hence does rounding (if requested) on the fly before e.g. computing spatial predicates like \link{st_intersects}. The examples show a round-trip of an \code{sfc} to and from binary. For the precision model used, see also \url{https://locationtech.github.io/jts/javadoc/org/locationtech/jts/geom/PrecisionModel.html}. There, it is written that: ``... to specify 3 decimal places of precision, use a scale factor of 1000. To specify -3 decimal places of precision (i.e. rounding to the nearest 1000), use a scale factor of 0.001.''. Note that ALL coordinates, so also Z or M values (if present) are affected. } \examples{ # examples of setting precision: st_point(c(1/3, 1/6)) |> st_sfc(precision = 1000) |> st_as_binary() |> st_as_sfc() st_point(c(1/3, 1/6)) |> st_sfc(precision = 100) |> st_as_binary() |> st_as_sfc() st_point(1e6 * c(1/3, 1/6)) |> st_sfc(precision = 0.01) |> st_as_binary() |> st_as_sfc() st_point(1e6 * c(1/3, 1/6)) |> st_sfc(precision = 0.001) |> st_as_binary() |> st_as_sfc() } ================================================ FILE: man/st_as_grob.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/grid.R \name{st_as_grob} \alias{st_as_grob} \title{Convert sf* object to a grob} \usage{ st_as_grob(x, ...) } \arguments{ \item{x}{object to be converted into an object class \code{grob}} \item{...}{passed on to the xxxGrob function, e.g. \code{gp = gpar(col = 'red')}} } \description{ Convert sf* object to an grid graphics object (grob) } ================================================ FILE: man/st_as_sf.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/sf.R, R/sp.R, R/maps.R, R/spatstat.R, R/s2.R \name{st_as_sf} \alias{st_as_sf} \alias{st_as_sf.data.frame} \alias{st_as_sf.sf} \alias{st_as_sf.sfc} \alias{st_as_sf.Spatial} \alias{st_as_sf.map} \alias{st_as_sf.ppp} \alias{st_as_sf.psp} \alias{st_as_sf.lpp} \alias{st_as_sf.s2_geography} \title{Convert foreign object to an sf object} \usage{ st_as_sf(x, ...) \method{st_as_sf}{data.frame}( x, ..., agr = NA_agr_, coords, wkt, dim = "XYZ", remove = TRUE, na.fail = TRUE, sf_column_name = NULL ) \method{st_as_sf}{sf}(x, ...) \method{st_as_sf}{sfc}(x, ...) \method{st_as_sf}{Spatial}(x, ...) \method{st_as_sf}{map}(x, ..., fill = TRUE, group = TRUE) \method{st_as_sf}{ppp}(x, ...) \method{st_as_sf}{psp}(x, ...) \method{st_as_sf}{lpp}(x, ...) \method{st_as_sf}{s2_geography}(x, ..., crs = st_crs(4326)) } \arguments{ \item{x}{object to be converted into an object class \code{sf}} \item{...}{passed on to \link{st_sf}, might included named arguments \code{crs} or \code{precision}} \item{agr}{character vector; see details section of \link{st_sf}} \item{coords}{in case of point data: names or numbers of the numeric columns holding coordinates} \item{wkt}{name or number of the character column that holds WKT encoded geometries} \item{dim}{specify what 3- or 4-dimensional points reflect: passed on to \link{st_point} (only when argument coords is given)} \item{remove}{logical; when coords or wkt is given, remove these columns from data.frame?} \item{na.fail}{logical; if \code{TRUE}, raise an error if coordinates contain missing values} \item{sf_column_name}{character; name of the active list-column with simple feature geometries; in case there is more than one and \code{sf_column_name} is \code{NULL}, the first one is taken.} \item{fill}{logical; the value for \code{fill} that was used in the call to \link[maps]{map}.} \item{group}{logical; if \code{TRUE}, group id labels from \link[maps]{map} by their prefix before \code{:}} \item{crs}{coordinate reference system to be assigned; object of class \code{crs}} } \description{ Convert foreign object to an sf object } \details{ setting argument \code{wkt} annihilates the use of argument \code{coords}. If \code{x} contains a column called "geometry", \code{coords} will result in overwriting of this column by the \link{sfc} geometry list-column. Setting \code{wkt} will replace this column with the geometry list-column, unless \code{remove} is \code{FALSE}. If \code{coords} has length 4, and \code{dim} is not \code{XYZM}, the four columns are taken as the xmin, ymin, xmax, ymax corner coordinates of a rectangle, and polygons are returned. } \examples{ pt1 = st_point(c(0,1)) pt2 = st_point(c(1,1)) st_sfc(pt1, pt2) d = data.frame(a = 1:2) d$geom = st_sfc(pt1, pt2) df = st_as_sf(d) d$geom = c("POINT(0 0)", "POINT(0 1)") df = st_as_sf(d, wkt = "geom") d$geom2 = st_sfc(pt1, pt2) st_as_sf(d) # should warn if (require(sp, quietly = TRUE)) { data(meuse, package = "sp") meuse_sf = st_as_sf(meuse, coords = c("x", "y"), crs = 28992, agr = "constant") meuse_sf[1:3,] summary(meuse_sf) } if (require(sp, quietly = TRUE)) { x = rbind(c(-1,-1), c(1,-1), c(1,1), c(-1,1), c(-1,-1)) x1 = 0.1 * x + 0.1 x2 = 0.1 * x + 0.4 x3 = 0.1 * x + 0.7 y = x + 3 y1 = x1 + 3 y3 = x3 + 3 m = matrix(c(3, 0), 5, 2, byrow = TRUE) z = x + m z1 = x1 + m z2 = x2 + m z3 = x3 + m p1 = Polygons(list( Polygon(x[5:1,]), Polygon(x2), Polygon(x3), Polygon(y[5:1,]), Polygon(y1), Polygon(x1), Polygon(y3)), "ID1") p2 = Polygons(list( Polygon(z[5:1,]), Polygon(z2), Polygon(z3), Polygon(z1)), "ID2") r = SpatialPolygons(list(p1,p2)) a = suppressWarnings(st_as_sf(r)) summary(a) demo(meuse, ask = FALSE, echo = FALSE) summary(st_as_sf(meuse)) summary(st_as_sf(meuse.grid)) summary(st_as_sf(meuse.area)) summary(st_as_sf(meuse.riv)) summary(st_as_sf(as(meuse.riv, "SpatialLines"))) pol.grd = as(meuse.grid, "SpatialPolygonsDataFrame") # summary(st_as_sf(pol.grd)) # summary(st_as_sf(as(pol.grd, "SpatialLinesDataFrame"))) } if (require(spatstat.geom)) { g = st_as_sf(gorillas) # select only the points: g[st_is(g, "POINT"),] } if (require(spatstat.linnet)) { data(chicago) plot(st_as_sf(chicago)["label"]) plot(st_as_sf(chicago)[-1,"label"]) } } ================================================ FILE: man/st_as_sfc.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/db.R, R/sfc.R, R/wkb.R, R/wkt.R, R/sp.R, % R/maps.R, R/s2.R \name{st_as_sfc} \alias{st_as_sfc} \alias{st_as_sfc.pq_geometry} \alias{st_as_sfc.list} \alias{st_as_sfc.blob} \alias{st_as_sfc.bbox} \alias{st_as_sfc.WKB} \alias{st_as_sfc.raw} \alias{st_as_sfc.character} \alias{st_as_sfc.factor} \alias{st_as_sfc.SpatialPoints} \alias{st_as_sfc.SpatialPixels} \alias{st_as_sfc.SpatialMultiPoints} \alias{st_as_sfc.SpatialLines} \alias{st_as_sfc.SpatialPolygons} \alias{st_as_sfc.map} \alias{st_as_sfc.s2_geography} \title{Convert foreign geometry object to an sfc object} \usage{ \method{st_as_sfc}{pq_geometry}( x, ..., EWKB = TRUE, spatialite = FALSE, pureR = FALSE, crs = NA_crs_ ) \method{st_as_sfc}{list}(x, ..., crs = NA_crs_) \method{st_as_sfc}{blob}(x, ...) \method{st_as_sfc}{bbox}(x, ...) \method{st_as_sfc}{WKB}( x, ..., EWKB = FALSE, spatialite = FALSE, pureR = FALSE, crs = NA_crs_ ) \method{st_as_sfc}{raw}(x, ...) \method{st_as_sfc}{character}(x, crs = NA_integer_, ..., GeoJSON = FALSE) \method{st_as_sfc}{factor}(x, ...) st_as_sfc(x, ...) \method{st_as_sfc}{SpatialPoints}(x, ..., precision = 0) \method{st_as_sfc}{SpatialPixels}(x, ..., precision = 0) \method{st_as_sfc}{SpatialMultiPoints}(x, ..., precision = 0) \method{st_as_sfc}{SpatialLines}(x, ..., precision = 0, forceMulti = FALSE) \method{st_as_sfc}{SpatialPolygons}(x, ..., precision = 0, forceMulti = FALSE) \method{st_as_sfc}{map}(x, ...) \method{st_as_sfc}{s2_geography}( x, ..., crs = st_crs(4326), endian = match(.Platform$endian, c("big", "little")) - 1L ) } \arguments{ \item{x}{object to convert} \item{...}{further arguments} \item{EWKB}{logical; if \code{TRUE}, parse as EWKB (extended WKB; PostGIS: ST_AsEWKB), otherwise as ISO WKB (PostGIS: ST_AsBinary)} \item{spatialite}{logical; if \code{TRUE}, WKB is assumed to be in the spatialite dialect, see \url{https://www.gaia-gis.it/gaia-sins/BLOB-Geometry.html}; this is only supported in native endian-ness (i.e., files written on system with the same endian-ness as that on which it is being read).} \item{pureR}{logical; if \code{TRUE}, use only R code, if \code{FALSE}, use compiled (C++) code; use \code{TRUE} when the endian-ness of the binary differs from the host machine (\code{.Platform$endian}).} \item{crs}{coordinate reference system to be assigned; object of class \code{crs}} \item{GeoJSON}{logical; if \code{TRUE}, try to read geometries from GeoJSON text strings geometry, see \code{\link[=st_crs]{st_crs()}}} \item{precision}{precision value; see \link{st_as_binary}} \item{forceMulti}{logical; if \code{TRUE}, force coercion into \code{MULTIPOLYGON} or \code{MULTILINE} objects, else autodetect} \item{endian}{integer; 0 or 1: defaults to the endian of the native machine} } \description{ Convert foreign geometry object to an sfc object } \details{ When converting from WKB, the object \code{x} is either a character vector such as typically obtained from PostGIS (either with leading "0x" or without), or a list with raw vectors representing the features in binary (raw) form. If \code{x} is a character vector, it should be a vector containing \href{https://www.ogc.org/standards/wkt-crs/}{well-known-text}, or Postgis EWKT or GeoJSON representations of a single geometry for each vector element. If \code{x} is a \code{factor}, it is converted to \code{character}. } \examples{ wkb = structure(list("01010000204071000000000000801A064100000000AC5C1441"), class = "WKB") st_as_sfc(wkb, EWKB = TRUE) wkb = structure(list("0x01010000204071000000000000801A064100000000AC5C1441"), class = "WKB") st_as_sfc(wkb, EWKB = TRUE) st_as_sfc(st_as_binary(st_sfc(st_point(0:1)))[[1]], crs = 4326) st_as_sfc("SRID=3978;LINESTRING(1663106 -105415,1664320 -104617)") } ================================================ FILE: man/st_as_text.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/crs.R, R/wkt.R \name{st_as_text} \alias{st_as_text} \alias{st_as_text.crs} \alias{st_as_text.sfg} \alias{st_as_text.sfc} \title{Return Well-known Text representation of simple feature geometry or coordinate reference system} \usage{ \method{st_as_text}{crs}(x, ..., projjson = FALSE, pretty = FALSE) st_as_text(x, ...) \method{st_as_text}{sfg}(x, ...) \method{st_as_text}{sfc}(x, ..., EWKT = FALSE) } \arguments{ \item{x}{object of class \code{sfg}, \code{sfc} or \code{crs}} \item{...}{modifiers; in particular \code{digits} can be passed to control the number of digits used} \item{projjson}{logical; if TRUE, return projjson form (requires GDAL 3.1 and PROJ 6.2), else return well-known-text form} \item{pretty}{logical; if TRUE, print human-readable well-known-text representation of a coordinate reference system} \item{EWKT}{logical; if TRUE, print SRID=xxx; before the WKT string if \code{epsg} is available} } \description{ Return Well-known Text representation of simple feature geometry or coordinate reference system } \details{ The returned WKT representation of simple feature geometry conforms to the \href{https://en.wikipedia.org/wiki/Simple_Features}{simple features access} specification and extensions (known as EWKT, supported by PostGIS and other simple features implementations for addition of a SRID to a WKT string). } \note{ To improve conversion performance, the lwgeom package can be used (it must be installed beforehand) and set the \code{Sys.setenv("LWGEOM_WKT" = "true")} environment variable. This will also result in faster printing of complex geometries. Note that the representation as WKT is different from the sf package and may cause reproducibility problems. An alternative solution is to use the \code{\link[lwgeom:st_astext]{lwgeom::st_astext()}} or \code{\link[wk:as_wkt]{wk::as_wkt()}} functions. } \examples{ st_as_text(st_point(1:2)) st_as_text(st_sfc(st_point(c(-90,40)), crs = 4326), EWKT = TRUE) } ================================================ FILE: man/st_bbox.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/bbox.R \name{st_bbox} \alias{st_bbox} \alias{is.na.bbox} \alias{st_bbox.POINT} \alias{st_bbox.MULTIPOINT} \alias{st_bbox.LINESTRING} \alias{st_bbox.POLYGON} \alias{st_bbox.MULTILINESTRING} \alias{st_bbox.MULTIPOLYGON} \alias{st_bbox.GEOMETRYCOLLECTION} \alias{st_bbox.MULTISURFACE} \alias{st_bbox.MULTICURVE} \alias{st_bbox.CURVEPOLYGON} \alias{st_bbox.COMPOUNDCURVE} \alias{st_bbox.POLYHEDRALSURFACE} \alias{st_bbox.TIN} \alias{st_bbox.TRIANGLE} \alias{st_bbox.CIRCULARSTRING} \alias{st_bbox.sfc} \alias{st_bbox.sf} \alias{st_bbox.Spatial} \alias{st_bbox.Raster} \alias{st_bbox.Extent} \alias{st_bbox.numeric} \alias{NA_bbox_} \alias{FULL_bbox_} \alias{format.bbox} \title{Return bounding of a simple feature or simple feature set} \usage{ \method{is.na}{bbox}(x) st_bbox(obj, ...) \method{st_bbox}{POINT}(obj, ...) \method{st_bbox}{MULTIPOINT}(obj, ...) \method{st_bbox}{LINESTRING}(obj, ...) \method{st_bbox}{POLYGON}(obj, ...) \method{st_bbox}{MULTILINESTRING}(obj, ...) \method{st_bbox}{MULTIPOLYGON}(obj, ...) \method{st_bbox}{GEOMETRYCOLLECTION}(obj, ...) \method{st_bbox}{MULTISURFACE}(obj, ...) \method{st_bbox}{MULTICURVE}(obj, ...) \method{st_bbox}{CURVEPOLYGON}(obj, ...) \method{st_bbox}{COMPOUNDCURVE}(obj, ...) \method{st_bbox}{POLYHEDRALSURFACE}(obj, ...) \method{st_bbox}{TIN}(obj, ...) \method{st_bbox}{TRIANGLE}(obj, ...) \method{st_bbox}{CIRCULARSTRING}(obj, ...) \method{st_bbox}{sfc}(obj, ...) \method{st_bbox}{sf}(obj, ...) \method{st_bbox}{Spatial}(obj, ...) \method{st_bbox}{Raster}(obj, ...) \method{st_bbox}{Extent}(obj, ..., crs = NA_crs_) \method{st_bbox}{numeric}(obj, ..., crs = NA_crs_) NA_bbox_ FULL_bbox_ \method{format}{bbox}(x, ...) } \arguments{ \item{x}{object of class \code{bbox}} \item{obj}{object to compute the bounding box from} \item{...}{for format.bbox, passed on to \link[base]{format} to format individual numbers} \item{crs}{object of class \code{crs}, or argument to \link{st_crs}, specifying the CRS of this bounding box.} } \value{ a numeric vector of length four, with \code{xmin}, \code{ymin}, \code{xmax} and \code{ymax} values; if \code{obj} is of class \code{sf}, \code{sfc}, \code{Spatial} or \code{Raster}, the object returned has a class \code{bbox}, an attribute \code{crs} and a method to print the bbox and an \code{st_crs} method to retrieve the coordinate reference system corresponding to \code{obj} (and hence the bounding box). \link{st_as_sfc} has a methods for \code{bbox} objects to generate a polygon around the four bounding box points. } \description{ Return bounding of a simple feature or simple feature set } \details{ \code{NA_bbox_} represents the missing value for a \code{bbox} object \code{NA_bbox_} represents the missing value for a \code{bbox} object } \examples{ a = st_sf(a = 1:2, geom = st_sfc(st_point(0:1), st_point(1:2)), crs = 4326) st_bbox(a) st_as_sfc(st_bbox(a)) st_bbox(c(xmin = 16.1, xmax = 16.6, ymax = 48.6, ymin = 47.9), crs = st_crs(4326)) } ================================================ FILE: man/st_break_antimeridian.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/break_antimeridian.R \name{st_break_antimeridian} \alias{st_break_antimeridian} \alias{st_break_antimeridian.sf} \alias{st_break_antimeridian.sfc} \title{Break antimeridian for plotting not centred on Greenwich} \usage{ st_break_antimeridian(x, lon_0 = 0, tol = 1e-04, ...) \method{st_break_antimeridian}{sf}(x, lon_0 = 0, tol = 1e-04, ...) \method{st_break_antimeridian}{sfc}(x, lon_0 = 0, tol = 1e-04, ...) } \arguments{ \item{x}{object of class \code{sf} or \code{sfc}} \item{lon_0}{target central longitude (degrees)} \item{tol}{half of break width (degrees, default 0.0001)} \item{...}{ignored here} } \description{ Longitudes can be broken at the antimeridian of a target central longitude to permit plotting of (usually world) line or polygon objects centred on the chosen central longitude. The method may only be used with non-projected, geographical coordinates and linestring or polygon objects. s2 is turned off internally to permit the use of a rectangular bounding box. If the input geometries go outside \verb{[-180, 180]} degrees longitude, the protruding geometries will also be split using the same \code{tol=} values; in this case empty geometries will be dropped first. } \examples{ \donttest{ if (require("maps", quietly=TRUE)) { opar = par(mfrow=c(3, 2)) wld = st_as_sf(map(fill=FALSE, interior=FALSE, plot=FALSE), fill=FALSE) for (lon_0 in c(-170, -90, -10, 10, 90, 170)) { br = st_break_antimeridian(wld, lon_0 = lon_0) tr = st_transform(br, paste0("+proj=natearth +lon_0=", lon_0)) plot(st_geometry(tr), main=lon_0) } par(opar) } } } ================================================ FILE: man/st_cast.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/cast_sfg.R, R/cast_sfc.R \name{st_cast} \alias{st_cast} \alias{st_cast.MULTIPOLYGON} \alias{st_cast.MULTILINESTRING} \alias{st_cast.MULTIPOINT} \alias{st_cast.POLYGON} \alias{st_cast.LINESTRING} \alias{st_cast.POINT} \alias{st_cast.GEOMETRYCOLLECTION} \alias{st_cast.CIRCULARSTRING} \alias{st_cast.MULTISURFACE} \alias{st_cast.COMPOUNDCURVE} \alias{st_cast.MULTICURVE} \alias{st_cast.CURVE} \alias{st_cast.sfc} \alias{st_cast.sf} \alias{st_cast.sfc_CIRCULARSTRING} \title{Cast geometry to another type: either simplify, or cast explicitly} \usage{ \method{st_cast}{MULTIPOLYGON}(x, to, ...) \method{st_cast}{MULTILINESTRING}(x, to, ...) \method{st_cast}{MULTIPOINT}(x, to, ...) \method{st_cast}{POLYGON}(x, to, ...) \method{st_cast}{LINESTRING}(x, to, ...) \method{st_cast}{POINT}(x, to, ...) \method{st_cast}{GEOMETRYCOLLECTION}(x, to, ...) \method{st_cast}{CIRCULARSTRING}(x, to, ...) \method{st_cast}{MULTISURFACE}(x, to, ...) \method{st_cast}{COMPOUNDCURVE}(x, to, ...) \method{st_cast}{MULTICURVE}(x, to, ...) \method{st_cast}{CURVE}(x, to, ...) st_cast(x, to, ...) \method{st_cast}{sfc}(x, to, ..., ids = seq_along(x), group_or_split = TRUE) \method{st_cast}{sf}(x, to, ..., warn = TRUE, do_split = TRUE) \method{st_cast}{sfc_CIRCULARSTRING}(x, to, ...) } \arguments{ \item{x}{object of class \code{sfg}, \code{sfc} or \code{sf}} \item{to}{character; target type, if missing, simplification is tried; when \code{x} is of type \code{sfg} (i.e., a single geometry) then \code{to} needs to be specified.} \item{...}{ignored} \item{ids}{integer vector, denoting how geometries should be grouped (default: no grouping)} \item{group_or_split}{logical; if TRUE, group or split geometries; if FALSE, carry out a 1-1 per-geometry conversion.} \item{warn}{logical; if \code{TRUE}, warn if attributes are assigned to sub-geometries} \item{do_split}{logical; if \code{TRUE}, allow splitting of geometries in sub-geometries} } \value{ object of class \code{to} if successful, or unmodified object if unsuccessful. If information gets lost while type casting, a warning is raised. In case \code{to} is missing, \code{st_cast.sfc} will coerce combinations of "POINT" and "MULTIPOINT", "LINESTRING" and "MULTILINESTRING", "POLYGON" and "MULTIPOLYGON" into their "MULTI..." form, or in case all geometries are "GEOMETRYCOLLECTION" will return a list of all the contents of the "GEOMETRYCOLLECTION" objects, or else do nothing. In case \code{to} is specified, if \code{to} is "GEOMETRY", geometries are not converted, else, \code{st_cast} will try to coerce all elements into \code{to}; \code{ids} may be specified to group e.g. "POINT" objects into a "MULTIPOINT", if not specified no grouping takes place. If e.g. a "sfc_MULTIPOINT" is cast to a "sfc_POINT", the objects are split, so no information gets lost, unless \code{group_or_split} is \code{FALSE}. } \description{ Cast geometry to another type: either simplify, or cast explicitly } \details{ When converting a GEOMETRYCOLLECTION to COMPOUNDCURVE, MULTISURFACE or CURVEPOLYGON, the user is responsible for the validity of the resulting object: no checks are being carried out by the software. When converting mixed, GEOMETRY sets, it may help to first convert to the MULTI-type, see examples the \code{st_cast} method for \code{sf} objects can only split geometries, e.g. cast \code{MULTIPOINT} into multiple \code{POINT} features. In case of splitting, attributes are repeated and a warning is issued when non-constant attributes are assigned to sub-geometries. To merge feature geometries and attribute values, use \link[sf:aggregate.sf]{aggregate} or \link[sf:tidyverse]{summarise}. } \examples{ # example(st_read) nc = st_read(system.file("shape/nc.shp", package="sf")) mpl <- st_geometry(nc)[[4]] #st_cast(x) ## error 'argument "to" is missing, with no default' cast_all <- function(xg) { lapply(c("MULTIPOLYGON", "MULTILINESTRING", "MULTIPOINT", "POLYGON", "LINESTRING", "POINT"), function(x) st_cast(xg, x)) } st_sfc(cast_all(mpl)) ## no closing coordinates should remain for multipoint any(duplicated(unclass(st_cast(mpl, "MULTIPOINT")))) ## should be FALSE ## number of duplicated coordinates in the linestrings should equal the number of polygon rings ## (... in this case, won't always be true) sum(duplicated(do.call(rbind, unclass(st_cast(mpl, "MULTILINESTRING")))) ) == sum(unlist(lapply(mpl, length))) ## should be TRUE p1 <- structure(c(0, 1, 3, 2, 1, 0, 0, 0, 2, 4, 4, 0), .Dim = c(6L, 2L)) p2 <- structure(c(1, 1, 2, 1, 1, 2, 2, 1), .Dim = c(4L, 2L)) st_polygon(list(p1, p2)) mls <- st_cast(st_geometry(nc)[[4]], "MULTILINESTRING") st_sfc(cast_all(mls)) mpt <- st_cast(st_geometry(nc)[[4]], "MULTIPOINT") st_sfc(cast_all(mpt)) pl <- st_cast(st_geometry(nc)[[4]], "POLYGON") st_sfc(cast_all(pl)) ls <- st_cast(st_geometry(nc)[[4]], "LINESTRING") st_sfc(cast_all(ls)) pt <- st_cast(st_geometry(nc)[[4]], "POINT") ## st_sfc(cast_all(pt)) ## Error: cannot create MULTIPOLYGON from POINT st_sfc(lapply(c("POINT", "MULTIPOINT"), function(x) st_cast(pt, x))) s = st_multipoint(rbind(c(1,0))) st_cast(s, "POINT") # https://github.com/r-spatial/sf/issues/1930: pt1 <- st_point(c(0,1)) pt23 <- st_multipoint(matrix(c(1,2,3,4), ncol = 2, byrow = TRUE)) d <- st_sf(geom = st_sfc(pt1, pt23)) st_cast(d, "POINT") # will not convert the entire MULTIPOINT, and warns st_cast(d, "MULTIPOINT") |> st_cast("POINT") } ================================================ FILE: man/st_cast_sfc_default.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/cast_sfc.R \name{st_cast_sfc_default} \alias{st_cast_sfc_default} \title{Coerce geometry to MULTI* geometry} \usage{ st_cast_sfc_default(x) } \arguments{ \item{x}{list of geometries or simple features} } \description{ Mixes of POINTS and MULTIPOINTS, LINESTRING and MULTILINESTRING, POLYGON and MULTIPOLYGON are returned as MULTIPOINTS, MULTILINESTRING and MULTIPOLYGONS respectively } \details{ Geometries that are already MULTI* are left unchanged. Features that can't be cast to a single MULTI* geometry are return as a GEOMETRYCOLLECTION } ================================================ FILE: man/st_collection_extract.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/collection_extract.R \name{st_collection_extract} \alias{st_collection_extract} \alias{st_collection_extract.sfg} \alias{st_collection_extract.sfc} \alias{st_collection_extract.sf} \title{Given an object with geometries of type \code{GEOMETRY} or \code{GEOMETRYCOLLECTION}, return an object consisting only of elements of the specified type.} \usage{ st_collection_extract( x, type = c("POLYGON", "POINT", "LINESTRING"), warn = FALSE ) \method{st_collection_extract}{sfg}( x, type = c("POLYGON", "POINT", "LINESTRING"), warn = FALSE ) \method{st_collection_extract}{sfc}( x, type = c("POLYGON", "POINT", "LINESTRING"), warn = FALSE ) \method{st_collection_extract}{sf}( x, type = c("POLYGON", "POINT", "LINESTRING"), warn = FALSE ) } \arguments{ \item{x}{an object of class \code{sf}, \code{sfc} or \code{sfg} that has mixed geometry (\code{GEOMETRY} or \code{GEOMETRYCOLLECTION}).} \item{type}{character; one of "POLYGON", "POINT", "LINESTRING"} \item{warn}{logical; if \code{TRUE}, warn if attributes are assigned to sub-geometries when casting (see \code{\link{st_cast}})} } \value{ An object having the same class as \code{x}, with geometries consisting only of elements of the specified type. For \code{sfg} objects, an \code{sfg} object is returned if there is only one geometry of the specified type, otherwise the geometries are combined into an \code{sfc} object of the relevant type. If any subgeometries in the input are MULTI, then all of the subgeometries in the output will be MULTI. } \description{ Similar to ST_CollectionExtract in PostGIS. If there are no sub-geometries of the specified type, an empty geometry is returned. } \examples{ pt <- st_point(c(1, 0)) ls <- st_linestring(matrix(c(4, 3, 0, 0), ncol = 2)) poly1 <- st_polygon(list(matrix(c(5.5, 7, 7, 6, 5.5, 0, 0, -0.5, -0.5, 0), ncol = 2))) poly2 <- st_polygon(list(matrix(c(6.6, 8, 8, 7, 6.6, 1, 1, 1.5, 1.5, 1), ncol = 2))) multipoly <- st_multipolygon(list(poly1, poly2)) i <- st_geometrycollection(list(pt, ls, poly1, poly2)) j <- st_geometrycollection(list(pt, ls, poly1, poly2, multipoly)) st_collection_extract(i, "POLYGON") st_collection_extract(i, "POINT") st_collection_extract(i, "LINESTRING") ## A GEOMETRYCOLLECTION aa <- rbind(st_sf(a=1, geom = st_sfc(i)), st_sf(a=2, geom = st_sfc(j))) ## With sf objects st_collection_extract(aa, "POLYGON") st_collection_extract(aa, "LINESTRING") st_collection_extract(aa, "POINT") ## With sfc objects st_collection_extract(st_geometry(aa), "POLYGON") st_collection_extract(st_geometry(aa), "LINESTRING") st_collection_extract(st_geometry(aa), "POINT") ## A GEOMETRY of single types bb <- rbind( st_sf(a = 1, geom = st_sfc(pt)), st_sf(a = 2, geom = st_sfc(ls)), st_sf(a = 3, geom = st_sfc(poly1)), st_sf(a = 4, geom = st_sfc(multipoly)) ) st_collection_extract(bb, "POLYGON") ## A GEOMETRY of mixed single types and GEOMETRYCOLLECTIONS cc <- rbind(aa, bb) st_collection_extract(cc, "POLYGON") } ================================================ FILE: man/st_coordinates.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/sfc.R \name{st_coordinates} \alias{st_coordinates} \title{retrieve coordinates in matrix form} \usage{ st_coordinates(x, ...) } \arguments{ \item{x}{object of class sf, sfc or sfg} \item{...}{ignored} } \value{ matrix with coordinates (X, Y, possibly Z and/or M) in rows, possibly followed by integer indicators \code{L1},...,\code{L3} that point out to which structure the coordinate belongs; for \code{POINT} this is absent (each coordinate is a feature), for \code{LINESTRING} \code{L1} refers to the feature, for \code{MULTILINESTRING} \code{L1} refers to the part and \code{L2} to the simple feature, for \code{POLYGON} \code{L1} refers to the main ring or holes and \code{L2} to the simple feature, for \code{MULTIPOLYGON} \code{L1} refers to the main ring or holes, \code{L2} to the ring id in the \code{MULTIPOLYGON}, and \code{L3} to the simple feature. For \code{POLYGONS}, \code{L1} can be used to identify exterior rings and inner holes. The exterior ring is when \code{L1} is equal to 1. Interior rings are identified when \code{L1} is greater than 1. \code{L2} can be used to differentiate between the feature. Whereas for \code{MULTIPOLYGON}, \code{L3} refers to the \code{MULTIPOLYGON} feature and \code{L2} refers to the component \code{POLYGON}. } \description{ retrieve coordinates in matrix form } ================================================ FILE: man/st_crop.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/crop.R \name{st_crop} \alias{st_crop} \alias{st_crop.sfc} \alias{st_crop.sf} \title{crop an sf object to a specific rectangle} \usage{ st_crop(x, y, ...) \method{st_crop}{sfc}(x, y, ..., xmin, ymin, xmax, ymax) \method{st_crop}{sf}(x, y, ...) } \arguments{ \item{x}{object of class \code{sf} or \code{sfc}} \item{y}{numeric vector with named elements \code{xmin}, \code{ymin}, \code{xmax} and \code{ymax}, or object of class \code{bbox}, or object for which there is an \link{st_bbox} method to convert it to a \code{bbox} object} \item{...}{ignored} \item{xmin}{minimum x extent of cropping area} \item{ymin}{minimum y extent of cropping area} \item{xmax}{maximum x extent of cropping area} \item{ymax}{maximum y extent of cropping area} } \description{ crop an sf object to a specific rectangle } \details{ setting arguments \code{xmin}, \code{ymin}, \code{xmax} and \code{ymax} implies that argument \code{y} gets ignored. } \examples{ box = c(xmin = 0, ymin = 0, xmax = 1, ymax = 1) pol = st_sfc(st_buffer(st_point(c(.5, .5)), .6)) pol_sf = st_sf(a=1, geom=pol) plot(st_crop(pol, box)) plot(st_crop(pol_sf, st_bbox(box))) # alternative: plot(st_crop(pol, xmin = 0, ymin = 0, xmax = 1, ymax = 1)) } ================================================ FILE: man/st_crs.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/crs.R \name{st_crs} \alias{st_crs} \alias{st_crs.sf} \alias{st_crs.numeric} \alias{st_crs.character} \alias{st_crs.sfc} \alias{st_crs.bbox} \alias{st_crs.CRS} \alias{st_crs.crs} \alias{st_crs<-} \alias{st_crs<-.sf} \alias{st_crs<-.sfc} \alias{st_set_crs} \alias{NA_crs_} \alias{is.na.crs} \alias{$.crs} \alias{format.crs} \alias{st_axis_order} \title{Retrieve coordinate reference system from object} \usage{ st_crs(x, ...) \method{st_crs}{sf}(x, ...) \method{st_crs}{numeric}(x, ...) \method{st_crs}{character}(x, ...) \method{st_crs}{sfc}(x, ..., parameters = FALSE) \method{st_crs}{bbox}(x, ...) \method{st_crs}{CRS}(x, ...) \method{st_crs}{crs}(x, ...) st_crs(x) <- value \method{st_crs}{sf}(x) <- value \method{st_crs}{sfc}(x) <- value st_set_crs(x, value) NA_crs_ \method{is.na}{crs}(x) \method{$}{crs}(x, name) \method{format}{crs}(x, ...) st_axis_order(authority_compliant = logical(0)) } \arguments{ \item{x}{numeric, character, or object of class \link{sf} or \link{sfc}} \item{...}{ignored} \item{parameters}{logical; \code{FALSE} by default; only for the \code{st_crs.sfc()} method: if \code{TRUE} return a classed list of coordinate reference system parameters, with named elements \code{SemiMajor}, \code{InvFlattening}, \code{units_gdal}, \code{IsVertical}, \code{WktPretty}, \code{Wkt}, \code{Name}, \code{proj4string}, \code{epsg}, \code{yx}, \code{ProjJson}, \code{WKT1_ESRI}, \code{srid} (in authority:code form), \code{axes} (a data.frame with columns \code{name} and \code{orientation}), \code{gcs_crs} with the WKT of the base geographic coordinate system, \code{ud_unit}. The list has class \code{crs_parameters}.} \item{value}{one of (i) character: a string accepted by GDAL, (ii) integer, a valid EPSG value (numeric), or (iii) an object of class \code{crs}.} \item{name}{element name} \item{authority_compliant}{logical; specify whether axis order should be handled compliant to the authority; if omitted, the current value is printed.} } \value{ If \code{x} is numeric, return \code{crs} object for EPSG:\code{x}; if \code{x} is character, return \code{crs} object for \code{x}; if \code{x} is of class \code{sf} or \code{sfc}, return its \code{crs} object. Object of class \code{crs}, which is a list with elements \code{input} (length-1 character) and \code{wkt} (length-1 character). Elements may be \code{NA} valued; if all elements are \code{NA} the CRS is missing valued, and coordinates are assumed to relate to an arbitrary Cartesian coordinate system. \code{st_axis_order} returns the (logical) current value if called without argument, or (invisibly) the previous value if it is being set. } \description{ Retrieve coordinate reference system from sf or sfc object Set or replace retrieve coordinate reference system from object } \details{ The *crs functions create, get, set or replace the \code{crs} attribute of a simple feature geometry list-column. This attribute is of class \code{crs}, and is a list consisting of \code{input} (user input, e.g. "EPSG:4326" or "WGS84" or a proj4string), and \code{wkt}, an automatically generated wkt2 representation of the crs. If \code{x} is identical to the wkt2 representation, and the CRS has a name, this name is used for the \code{input} field. Comparison of two objects of class \code{crs} uses the GDAL function \code{OGRSpatialReference::IsSame}. In case a coordinate reference system is replaced, no transformation takes place and a warning is raised to stress this. \code{NA_crs_} is the \code{crs} object with missing values for \code{input} and \code{wkt}. the \code{$} method for \code{crs} objects retrieves named elements using the GDAL interface; named elements include \code{SemiMajor}, \code{SemiMinor}, \code{InvFlattening}, \code{IsGeographic}, \code{units_gdal}, \code{IsVertical}, \code{WktPretty}, \code{Wkt}, \code{Name}, \code{proj4string}, \code{epsg}, \code{yx}, \code{ud_unit}, and \code{axes} (this may be subject to changes in future GDAL versions). Note that not all valid CRS have a corresponding \code{proj4string}. \code{ud_unit} returns a valid \link[units]{units} object or \code{NULL} if units are missing. format.crs returns NA if the crs is missing valued, or else the name of a crs if it is different from "unknown", or else the user input if it was set, or else its "proj4string" representation; \code{st_axis_order} can be used to get and set the axis order: \code{TRUE} indicates axes order according to the authority (e.g. EPSG:4326 defining coordinates to be latitude,longitude pairs), \code{FALSE} indicates the usual GIS (display) order (longitude,latitude). This can be useful when data are read, or have to be written, with coordinates in authority compliant order. The return value is the current state of this (\code{FALSE}, by default). } \examples{ sfc = st_sfc(st_point(c(0,0)), st_point(c(1,1))) sf = st_sf(a = 1:2, geom = sfc) st_crs(sf) = 4326 st_geometry(sf) sfc = st_sfc(st_point(c(0,0)), st_point(c(1,1))) st_crs(sfc) = 4326 sfc sfc = st_sfc(st_point(c(0,0)), st_point(c(1,1))) sfc |> st_set_crs(4326) |> st_transform(3857) st_crs("EPSG:3857")$input st_crs(3857)$proj4string pt = st_sfc(st_point(c(0, 60)), crs = 4326) # st_axis_order() only has effect in GDAL >= 2.5.0: st_axis_order() # query default: FALSE means interpret pt as (longitude latitude) st_transform(pt, 3857)[[1]] old_value = FALSE if (compareVersion(sf_extSoftVersion()["GDAL"], "2.5.0") >= 0) (old_value = st_axis_order(TRUE)) # now interpret pt as (latitude longitude), as EPSG:4326 prescribes: st_axis_order() # query current value st_transform(pt, 3857)[[1]] st_axis_order(old_value) # set back to old value } ================================================ FILE: man/st_drivers.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/read.R \name{st_drivers} \alias{st_drivers} \title{Get GDAL drivers} \usage{ st_drivers(what = "vector", regex) } \arguments{ \item{what}{character: \code{"vector"} or \code{"raster"}, anything else will return all drivers.} \item{regex}{character; regular expression to filter the \code{name} and \code{long_name} fields on} } \value{ A \code{data.frame} with driver metadata. } \description{ Get a list of the available GDAL drivers } \details{ The drivers available will depend on the installation of GDAL/OGR, and can vary; the \code{st_drivers()} function shows all the drivers that are readable, and which may be written. The field \code{vsi} refers to the driver's capability to read/create datasets through the VSI*L API. \href{https://gdal.org/en/latest/drivers/vector/index.html}{See GDAL website for additional details on driver support} } \examples{ # The following driver lists depend on the GDAL setup and platform used: st_drivers() st_drivers("raster", "GeoT") } ================================================ FILE: man/st_geometry.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/sfc.R, R/sf.R \name{st_geometry} \alias{st_geometry} \alias{st_geometry.sfc} \alias{st_geometry.sf} \alias{st_geometry.sfg} \alias{st_geometry<-} \alias{st_set_geometry} \alias{st_drop_geometry} \alias{st_drop_geometry.sf} \alias{st_drop_geometry.default} \title{Get, set, replace or rename geometry from an sf object} \usage{ \method{st_geometry}{sfc}(obj, ...) st_geometry(obj, ...) \method{st_geometry}{sf}(obj, ...) \method{st_geometry}{sfc}(obj, ...) \method{st_geometry}{sfg}(obj, ...) st_geometry(x) <- value st_set_geometry(x, value) st_drop_geometry(x, ...) \method{st_drop_geometry}{sf}(x, ...) \method{st_drop_geometry}{default}(x, ...) } \arguments{ \item{obj}{object of class \code{sf} or \code{sfc}} \item{...}{ignored} \item{x}{object of class \code{data.frame} or \code{sf}} \item{value}{object of class \code{sfc}, or \code{character} to set, replace, or rename the geometry of \code{x}} } \value{ st_geometry returns an object of class \link{sfc}, a list-column with geometries \code{st_geometry} returns an object of class \link{sfc}. Assigning geometry to a \code{data.frame} creates an \link{sf} object, assigning it to an \link{sf} object replaces the geometry list-column. } \description{ Get, set, replace or rename geometry from an sf object } \details{ when applied to a \code{data.frame} and when \code{value} is an object of class \code{sfc}, \code{st_set_geometry} and \code{st_geometry<-} will first check for the existence of an attribute \code{sf_column} and overwrite that, or else look for list-columns of class \code{sfc} and overwrite the first of that, or else write the geometry list-column to a column named \code{geometry}. In case \code{value} is character and \code{x} is of class \code{sf}, the "active" geometry column is set to \code{x[[value]]}. the replacement function applied to \code{sf} objects will overwrite the geometry list-column, if \code{value} is \code{NULL}, it will remove it and coerce \code{x} to a \code{data.frame}. if \code{x} is of class \code{sf}, \code{st_drop_geometry} drops the geometry of its argument, and reclasses it accordingly; otherwise it returns \code{x} unmodified. } \examples{ df = data.frame(a = 1:2) sfc = st_sfc(st_point(c(3,4)), st_point(c(10,11))) st_geometry(sfc) st_geometry(df) <- sfc class(df) st_geometry(df) st_geometry(df) <- sfc # replaces st_geometry(df) <- NULL # remove geometry, coerce to data.frame sf <- st_set_geometry(df, sfc) # set geometry, return sf st_set_geometry(sf, NULL) # remove geometry, coerce to data.frame } ================================================ FILE: man/st_geometry_type.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/sfc.R \name{st_geometry_type} \alias{st_geometry_type} \title{Return geometry type of an object} \usage{ st_geometry_type(x, by_geometry = TRUE) } \arguments{ \item{x}{object of class \link{sf} or \link{sfc}} \item{by_geometry}{logical; if \code{TRUE}, return geometry type of each geometry, else return geometry type of the set} } \value{ a factor with the geometry type of each simple feature geometry in \code{x}, or that of the whole set } \description{ Return geometry type of an object, as a factor } ================================================ FILE: man/st_graticule.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/graticule.R \name{st_graticule} \alias{st_graticule} \title{Compute graticules and their parameters} \usage{ st_graticule( x = c(-180, -90, 180, 90), crs = st_crs(x), datum = st_crs("OGC:CRS84"), ..., lon = NULL, lat = NULL, ndiscr = 100, margin = 0.001 ) } \arguments{ \item{x}{object of class \code{sf}, \code{sfc} or \code{sfg} or numeric vector with bounding box given as (minx, miny, maxx, maxy).} \item{crs}{object of class \code{crs}, with the display coordinate reference system} \item{datum}{either an object of class \code{crs} with the coordinate reference system for the graticules, or \code{NULL} in which case a grid in the coordinate system of \code{x} is drawn, or \code{NA}, in which case an empty \code{sf} object is returned. If missing and \code{x} has a crs with a datum, the geographic coordinate system (datum) of \code{x} is taken.} \item{...}{ignored} \item{lon}{numeric; values in degrees East for the meridians, associated with \code{datum}} \item{lat}{numeric; values in degrees North for the parallels, associated with \code{datum}} \item{ndiscr}{integer; number of points to discretize a parallel or meridian} \item{margin}{numeric; small number to trim a longlat bounding box that touches or crosses +/-180 long or +/-90 latitude.} } \value{ an object of class \code{sf} with additional attributes describing the type (E: meridian, N: parallel) degree value, label, start and end coordinates and angle; see example. } \description{ Compute graticules and their parameters } \section{Use of graticules}{ In cartographic visualization, the use of graticules is not advised, unless the graphical output will be used for measurement or navigation, or the direction of North is important for the interpretation of the content, or the content is intended to display distortions and artifacts created by projection. Unnecessary use of graticules only adds visual clutter but little relevant information. Use of coastlines, administrative boundaries or place names permits most viewers of the output to orient themselves better than a graticule. } \examples{ library(sf) if (require(maps, quietly = TRUE)) { usa = st_as_sf(map('usa', plot = FALSE, fill = TRUE)) laea = st_crs("+proj=laea +lat_0=30 +lon_0=-95") # Lambert equal area usa <- st_transform(usa, laea) bb = st_bbox(usa) bbox = st_linestring(rbind(c( bb[1],bb[2]),c( bb[3],bb[2]), c( bb[3],bb[4]),c( bb[1],bb[4]),c( bb[1],bb[2]))) g = st_graticule(usa) plot(usa, xlim = 1.2 * c(-2450853.4, 2186391.9), reset = FALSE) plot(g[1], add = TRUE, col = 'grey') plot(bbox, add = TRUE) points(g$x_start, g$y_start, col = 'red') points(g$x_end, g$y_end, col = 'blue') invisible(lapply(seq_len(nrow(g)), function(i) { if (g$type[i] == "N" && g$x_start[i] - min(g$x_start) < 1000) text(g$x_start[i], g$y_start[i], labels = parse(text = g$degree_label[i]), srt = g$angle_start[i], pos = 2, cex = .7) if (g$type[i] == "E" && g$y_start[i] - min(g$y_start) < 1000) text(g$x_start[i], g$y_start[i], labels = parse(text = g$degree_label[i]), srt = g$angle_start[i] - 90, pos = 1, cex = .7) if (g$type[i] == "N" && g$x_end[i] - max(g$x_end) > -1000) text(g$x_end[i], g$y_end[i], labels = parse(text = g$degree_label[i]), srt = g$angle_end[i], pos = 4, cex = .7) if (g$type[i] == "E" && g$y_end[i] - max(g$y_end) > -1000) text(g$x_end[i], g$y_end[i], labels = parse(text = g$degree_label[i]), srt = g$angle_end[i] - 90, pos = 3, cex = .7) })) plot(usa, graticule = st_crs(4326), axes = TRUE, lon = seq(-60,-130,by=-10)) } } ================================================ FILE: man/st_is.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/cast_sfc.R \name{st_is} \alias{st_is} \title{test equality between the geometry type and a class or set of classes} \usage{ st_is(x, type) } \arguments{ \item{x}{object of class \code{sf}, \code{sfc} or \code{sfg}} \item{type}{character; class, or set of classes, to test against} } \description{ test equality between the geometry type and a class or set of classes } \examples{ st_is(st_point(0:1), "POINT") sfc = st_sfc(st_point(0:1), st_linestring(matrix(1:6,,2))) st_is(sfc, "POINT") st_is(sfc, "POLYGON") st_is(sfc, "LINESTRING") st_is(st_sf(a = 1:2, sfc), "LINESTRING") st_is(sfc, c("POINT", "LINESTRING")) } ================================================ FILE: man/st_is_full.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/sfc.R \name{st_is_full} \alias{st_is_full} \alias{st_is_full.sfg} \alias{st_is_full.sfc} \alias{st_is_full.sf} \alias{st_is_full.bbox} \title{predicate whether a geometry is equal to a POLYGON FULL} \usage{ st_is_full(x, ...) \method{st_is_full}{sfg}(x, ..., is_longlat = NULL) \method{st_is_full}{sfc}(x, ...) \method{st_is_full}{sf}(x, ...) \method{st_is_full}{bbox}(x, ...) } \arguments{ \item{x}{object of class \code{sfg}, \code{sfc} or \code{sf}} \item{...}{ignored, except when it contains a \code{crs} argument to inform unspecified \code{is_longlat}} \item{is_longlat}{logical; output of \link{st_is_longlat} of the parent \code{sfc} object} } \value{ logical, indicating whether geometries are POLYGON FULL (a spherical polygon covering the entire sphere) } \description{ predicate whether a geometry is equal to a POLYGON FULL } ================================================ FILE: man/st_is_longlat.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/crs.R \name{st_is_longlat} \alias{st_is_longlat} \title{Assert whether simple feature coordinates are longlat degrees} \usage{ st_is_longlat(x) } \arguments{ \item{x}{object of class \link{sf} or \link{sfc}, or otherwise an object of a class that has an \link{st_crs} method returning a \code{crs} object} } \value{ \code{TRUE} if \code{x} has geographic coordinates, \code{FALSE} if it has projected coordinates, or \code{NA} if \code{is.na(st_crs(x))}. } \description{ Assert whether simple feature coordinates are longlat degrees } ================================================ FILE: man/st_jitter.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/jitter.R \name{st_jitter} \alias{st_jitter} \title{jitter geometries} \usage{ st_jitter(x, amount, factor = 0.002) } \arguments{ \item{x}{object of class \code{sf} or \code{sfc}} \item{amount}{numeric; amount of jittering applied; if missing, the amount is set to factor * the bounding box diagonal; units of coordinates.} \item{factor}{numeric; fractional amount of jittering to be applied} } \description{ jitter geometries } \details{ jitters coordinates with an amount such that \code{runif(1, -amount, amount)} is added to the coordinates. x- and y-coordinates are jittered independently but all coordinates of a single geometry are jittered with the same amount, meaning that the geometry shape does not change. For longlat data, a latitude correction is made such that jittering in East and North directions are identical in distance in the center of the bounding box of \code{x}. } \examples{ nc = st_read(system.file("gpkg/nc.gpkg", package="sf")) pts = st_centroid(st_geometry(nc)) plot(pts) plot(st_jitter(pts, .05), add = TRUE, col = 'red') plot(st_geometry(nc)) plot(st_jitter(st_geometry(nc), factor = .01), add = TRUE, col = '#ff8888') } ================================================ FILE: man/st_join.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/join.R \name{st_join} \alias{st_join} \alias{st_join.sf} \alias{st_filter} \alias{st_filter.sf} \title{spatial join, spatial filter} \usage{ st_join(x, y, join, ...) \method{st_join}{sf}( x, y, join = st_intersects, ..., suffix = c(".x", ".y"), left = TRUE, largest = FALSE ) st_filter(x, y, ...) \method{st_filter}{sf}(x, y, ..., .predicate = st_intersects) } \arguments{ \item{x}{object of class \code{sf}} \item{y}{object of class \code{sf}} \item{join}{geometry predicate function with the same profile as \link{st_intersects}; see details} \item{...}{for \code{st_join}: arguments passed on to the \code{join} function or to \code{st_intersection} when \code{largest} is \code{TRUE}; for \code{st_filter} arguments passed on to the \code{.predicate} function, e.g. \code{prepared}, or a pattern for \link{st_relate}} \item{suffix}{length 2 character vector; see \link[base]{merge}} \item{left}{logical; if \code{TRUE} return the left join, otherwise an inner join; see details. see also \link[dplyr:mutate-joins]{left_join}} \item{largest}{logical; if \code{TRUE}, return \code{x} features augmented with the fields of \code{y} that have the largest overlap with each of the features of \code{x}; see https://github.com/r-spatial/sf/issues/578} \item{.predicate}{geometry predicate function with the same profile as \link{st_intersects}; see details} } \value{ an object of class \code{sf}, joined based on geometry } \description{ spatial join, spatial filter } \details{ alternative values for argument \code{join} are: \itemize{ \item \link{st_contains_properly}, \item \link{st_contains}, \item \link{st_covered_by}, \item \link{st_covers}, \item \link{st_crosses}, \item \link{st_disjoint}, \item \link{st_equals_exact}, \item \link{st_equals}, \item \link{st_is_within_distance}, \item \link{st_nearest_feature}, \item \link{st_overlaps}, \item \link{st_touches}, \item \link{st_within}, \item \link{st_relate} (which will require \code{pattern} to be set), \item or any user-defined function of the same profile as the above } A left join returns all records of the \code{x} object with \code{y} fields for non-matched records filled with \code{NA} values; an inner join returns only records that spatially match. To replicate the results of \code{st_within(x, y)} you will need to use \code{st_join(x, y, join = "st_within", left = FALSE)}. } \examples{ a = st_sf(a = 1:3, geom = st_sfc(st_point(c(1,1)), st_point(c(2,2)), st_point(c(3,3)))) b = st_sf(a = 11:14, geom = st_sfc(st_point(c(10,10)), st_point(c(2,2)), st_point(c(2,2)), st_point(c(3,3)))) st_join(a, b) st_join(a, b, left = FALSE) # two ways to aggregate y's attribute values outcome over x's geometries: j = st_join(a, b) aggregate(j, list(j$a.x), mean) if (require(dplyr, quietly = TRUE)) { st_join(a, b) |> group_by(a.x) |> summarise(mean(a.y)) } # example of largest = TRUE: nc <- st_transform(st_read(system.file("shape/nc.shp", package="sf")), 2264) gr = st_sf( label = apply(expand.grid(1:10, LETTERS[10:1])[,2:1], 1, paste0, collapse = " "), geom = st_make_grid(st_as_sfc(st_bbox(nc)))) gr$col = sf.colors(10, categorical = TRUE, alpha = .3) # cut, to check, NA's work out: gr = gr[-(1:30),] nc_j <- st_join(nc, gr, largest = TRUE) # the two datasets: opar = par(mfrow = c(2,1), mar = rep(0,4)) plot(st_geometry(nc_j)) plot(st_geometry(gr), add = TRUE, col = gr$col) text(st_coordinates(st_centroid(gr)), labels = gr$label) # the joined dataset: plot(st_geometry(nc_j), border = 'black', col = nc_j$col) text(st_coordinates(st_centroid(nc_j)), labels = nc_j$label, cex = .8) plot(st_geometry(gr), border = 'green', add = TRUE) par(opar) # st_filter keeps the geometries in x where .predicate(x,y) returns any match in y for x st_filter(a, b) # for an anti-join, use the union of y st_filter(a, st_union(b), .predicate = st_disjoint) } ================================================ FILE: man/st_layers.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/read.R \name{st_layers} \alias{st_layers} \title{Return properties of layers in a datasource} \usage{ st_layers(dsn, options = character(0), do_count = FALSE) } \arguments{ \item{dsn}{data source name (interpretation varies by driver - for some drivers, \code{dsn} is a file name, but may also be a folder, or contain the name and access credentials of a database)} \item{options}{character; driver dependent dataset open options, multiple options supported.} \item{do_count}{logical; if TRUE, count the features by reading them, even if their count is not reported by the driver} } \value{ list object of class \code{sf_layers} with elements \describe{ \item{name}{name of the layer} \item{geomtype}{list with for each layer the geometry types} \item{features}{number of features (if reported; see \code{do_count})} \item{fields}{number of fields} \item{crs}{list with for each layer the \code{crs} object} } } \description{ Return properties of layers in a datasource } ================================================ FILE: man/st_line_project_point.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-measures.R, R/geom-transformers.R \name{st_line_project_point} \alias{st_line_project_point} \alias{st_line_project} \alias{st_line_interpolate} \title{Project point on linestring, interpolate along a linestring} \usage{ st_line_project(line, point, normalized = FALSE) st_line_interpolate(line, dist, normalized = FALSE) } \arguments{ \item{line}{object of class \code{sfc} with \code{LINESTRING} geometry} \item{point}{object of class \code{sfc} with \code{POINT} geometry} \item{normalized}{logical; if \code{TRUE}, use or return distance normalised to 0-1} \item{dist}{numeric or units, vector with distance value(s), in units of the coordinates} } \value{ \code{st_line_project} returns the distance(s) of point(s) along line(s), when projected on the line(s) \code{st_line_interpolate} returns the point(s) at dist(s), when measured along (interpolated on) the line(s) } \description{ Project point on linestring, interpolate along a linestring } \details{ arguments \code{line}, \code{point} and \code{dist} are recycled to common length when needed } \examples{ st_line_project(st_as_sfc("LINESTRING (0 0, 10 10)"), st_as_sfc(c("POINT (0 0)", "POINT (5 5)"))) st_line_project(st_as_sfc("LINESTRING (0 0, 10 10)"), st_as_sfc("POINT (5 5)"), TRUE) st_line_interpolate(st_as_sfc("LINESTRING (0 0, 1 1)"), 1) st_line_interpolate(st_as_sfc("LINESTRING (0 0, 1 1)"), 1, TRUE) # https://github.com/r-spatial/sf/issues/2542; use for geographic coordinates: l1 <- st_as_sfc("LINESTRING (10.1 50.1, 10.2 50.2)", crs = 'OGC:CRS84') dists = units::set_units(seq(0, sqrt(2)/10, length.out = 5), degrees) st_line_interpolate(l1, dists) } ================================================ FILE: man/st_line_sample.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-transformers.R \name{st_line_sample} \alias{st_line_sample} \title{Sample points on a linear geometry} \usage{ st_line_sample(x, n, density, type = "regular", sample = NULL) } \arguments{ \item{x}{object of class \code{sf}, \code{sfc} or \code{sfg}} \item{n}{integer; number of points to choose per geometry; if missing, n will be computed as \code{round(density * st_length(geom))}.} \item{density}{numeric; density (points per distance unit) of the sampling, possibly a vector of length equal to the number of features (otherwise recycled); \code{density} may be of class \code{units}.} \item{type}{character; indicate the sampling type, either "regular" or "random"} \item{sample}{numeric; a vector of numbers between 0 and 1 indicating the points to sample - if defined sample overrules n, density and type.} } \description{ Sample points on a linear geometry } \examples{ ls = st_sfc(st_linestring(rbind(c(0,0),c(0,1))), st_linestring(rbind(c(0,0),c(10,0)))) st_line_sample(ls, density = 1) ls = st_sfc(st_linestring(rbind(c(0,0),c(0,1))), st_linestring(rbind(c(0,0),c(.1,0))), crs = 4326) try(st_line_sample(ls, density = 1/1000)) # error st_line_sample(st_transform(ls, 3857), n = 5) # five points for each line st_line_sample(st_transform(ls, 3857), n = c(1, 3)) # one and three points st_line_sample(st_transform(ls, 3857), density = 1/1000) # one per km st_line_sample(st_transform(ls, 3857), density = c(1/1000, 1/10000)) # one per km, one per 10 km st_line_sample(st_transform(ls, 3857), density = units::set_units(1, 1/km)) # one per km # five equidistant points including start and end: st_line_sample(st_transform(ls, 3857), sample = c(0, 0.25, 0.5, 0.75, 1)) } ================================================ FILE: man/st_m_range.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/m_range.R \name{st_m_range} \alias{st_m_range} \alias{is.na.m_range} \alias{st_m_range.POINT} \alias{st_m_range.MULTIPOINT} \alias{st_m_range.LINESTRING} \alias{st_m_range.POLYGON} \alias{st_m_range.MULTILINESTRING} \alias{st_m_range.MULTIPOLYGON} \alias{st_m_range.GEOMETRYCOLLECTION} \alias{st_m_range.MULTISURFACE} \alias{st_m_range.MULTICURVE} \alias{st_m_range.CURVEPOLYGON} \alias{st_m_range.COMPOUNDCURVE} \alias{st_m_range.POLYHEDRALSURFACE} \alias{st_m_range.TIN} \alias{st_m_range.TRIANGLE} \alias{st_m_range.CIRCULARSTRING} \alias{st_m_range.sfc} \alias{st_m_range.sf} \alias{st_m_range.numeric} \alias{NA_m_range_} \title{Return 'm' range of a simple feature or simple feature set} \usage{ \method{is.na}{m_range}(x) st_m_range(obj, ...) \method{st_m_range}{POINT}(obj, ...) \method{st_m_range}{MULTIPOINT}(obj, ...) \method{st_m_range}{LINESTRING}(obj, ...) \method{st_m_range}{POLYGON}(obj, ...) \method{st_m_range}{MULTILINESTRING}(obj, ...) \method{st_m_range}{MULTIPOLYGON}(obj, ...) \method{st_m_range}{GEOMETRYCOLLECTION}(obj, ...) \method{st_m_range}{MULTISURFACE}(obj, ...) \method{st_m_range}{MULTICURVE}(obj, ...) \method{st_m_range}{CURVEPOLYGON}(obj, ...) \method{st_m_range}{COMPOUNDCURVE}(obj, ...) \method{st_m_range}{POLYHEDRALSURFACE}(obj, ...) \method{st_m_range}{TIN}(obj, ...) \method{st_m_range}{TRIANGLE}(obj, ...) \method{st_m_range}{CIRCULARSTRING}(obj, ...) \method{st_m_range}{sfc}(obj, ...) \method{st_m_range}{sf}(obj, ...) \method{st_m_range}{numeric}(obj, ..., crs = NA_crs_) NA_m_range_ } \arguments{ \item{x}{object of class \code{m_range}} \item{obj}{object to compute the m range from} \item{...}{ignored} \item{crs}{object of class \code{crs}, or argument to \link{st_crs}, specifying the CRS of this bounding box.} } \value{ a numeric vector of length two, with \code{mmin} and \code{mmax} values; if \code{obj} is of class \code{sf} or \code{sfc} the object if \code{obj} is of class \code{sf} or \code{sfc} the object returned has a class \code{m_range} } \description{ Return 'm' range of a simple feature or simple feature set } \details{ \code{NA_m_range_} represents the missing value for a \code{m_range} object } \examples{ a = st_sf(a = 1:2, geom = st_sfc(st_point(0:3), st_point(1:4)), crs = 4326) st_m_range(a) st_m_range(c(mmin = 16.1, mmax = 16.6), crs = st_crs(4326)) } ================================================ FILE: man/st_make_grid.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/make_grid.R \name{st_make_grid} \alias{st_make_grid} \title{Create a regular tesselation over the bounding box of an sf or sfc object} \usage{ st_make_grid( x, cellsize = c(diff(st_bbox(x)[c(1, 3)]), diff(st_bbox(x)[c(2, 4)]))/n, offset = st_bbox(x)[c("xmin", "ymin")], n = c(10, 10), crs = if (missing(x)) NA_crs_ else st_crs(x), what = "polygons", square = TRUE, flat_topped = FALSE ) } \arguments{ \item{x}{object of class \link{sf} or \link{sfc}} \item{cellsize}{numeric of length 1 or 2 with target cellsize: for square or rectangular cells the width and height, for hexagonal cells the distance between opposite edges (edge length is cellsize/sqrt(3)). A length units object can be passed, or an area unit object with area size of the square or hexagonal cell.} \item{offset}{numeric of length 2; lower left corner coordinates (x, y) of the grid} \item{n}{integer of length 1 or 2, number of grid cells in x and y direction (columns, rows)} \item{crs}{object of class \code{crs}; coordinate reference system of the target grid in case argument \code{x} is missing, if \code{x} is not missing, its crs is inherited.} \item{what}{character; one of: \code{"polygons"}, \code{"corners"}, or \code{"centers"}} \item{square}{logical; if \code{FALSE}, create hexagonal grid} \item{flat_topped}{logical; if \code{TRUE} generate flat topped hexagons, else generate pointy topped} } \value{ Object of class \code{sfc} (simple feature geometry list column) with, depending on \code{what} and \code{square}, square or hexagonal polygons, corner points of these polygons, or center points of these polygons. } \description{ Create a square or hexagonal grid covering the bounding box of the geometry of an sf or sfc object } \examples{ plot(st_make_grid(what = "centers"), axes = TRUE) plot(st_make_grid(what = "corners"), add = TRUE, col = 'green', pch=3) sfc = st_sfc(st_polygon(list(rbind(c(0,0), c(1,0), c(1,1), c(0,0))))) plot(st_make_grid(sfc, cellsize = .1, square = FALSE)) plot(sfc, add = TRUE) # non-default offset: plot(st_make_grid(sfc, cellsize = .1, square = FALSE, offset = c(0, .05 / (sqrt(3)/2)))) plot(sfc, add = TRUE) nc = st_read(system.file("shape/nc.shp", package="sf")) g = st_make_grid(nc) plot(g) plot(st_geometry(nc), add = TRUE) # g[nc] selects cells that intersect with nc: plot(g[nc], col = '#ff000088', add = TRUE) } ================================================ FILE: man/st_nearest_feature.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nearest.R \name{st_nearest_feature} \alias{st_nearest_feature} \title{get index of nearest feature} \usage{ st_nearest_feature( x, y, ..., check_crs = TRUE, longlat = isTRUE(st_is_longlat(x)) ) } \arguments{ \item{x}{object of class \code{sfg}, \code{sfc} or \code{sf}} \item{y}{object of class \code{sfg}, \code{sfc} or \code{sf}; if missing, features in \code{x} will be compared to all remaining features in \code{x}.} \item{...}{ignored} \item{check_crs}{logical; should \code{x} and \code{y} be checked for CRS equality?} \item{longlat}{logical; does \code{x} have ellipsoidal coordinates?} } \value{ for each feature (geometry) in \code{x} the index of the nearest feature (geometry) in set \code{y}, or in the remaining set of \code{x} if \code{y} is missing; empty geometries result in \code{NA} indexes } \description{ get index of nearest feature } \examples{ ls1 = st_linestring(rbind(c(0,0), c(1,0))) ls2 = st_linestring(rbind(c(0,0.1), c(1,0.1))) ls3 = st_linestring(rbind(c(0,1), c(1,1))) (l = st_sfc(ls1, ls2, ls3)) p1 = st_point(c(0.1, -0.1)) p2 = st_point(c(0.1, 0.11)) p3 = st_point(c(0.1, 0.09)) p4 = st_point(c(0.1, 0.9)) (p = st_sfc(p1, p2, p3, p4)) try(st_nearest_feature(p, l)) try(st_nearest_points(p, l[st_nearest_feature(p,l)], pairwise = TRUE)) r = sqrt(2)/10 b1 = st_buffer(st_point(c(.1,.1)), r) b2 = st_buffer(st_point(c(.9,.9)), r) b3 = st_buffer(st_point(c(.9,.1)), r) circles = st_sfc(b1, b2, b3) plot(circles, col = NA, border = 2:4) pts = st_sfc(st_point(c(.3,.1)), st_point(c(.6,.2)), st_point(c(.6,.6)), st_point(c(.4,.8))) plot(pts, add = TRUE, col = 1) # draw points to nearest circle: nearest = try(st_nearest_feature(pts, circles)) if (inherits(nearest, "try-error")) # GEOS 3.6.1 not available nearest = c(1, 3, 2, 2) ls = st_nearest_points(pts, circles[nearest], pairwise = TRUE) plot(ls, col = 5:8, add = TRUE) # compute distance between pairs of nearest features: st_distance(pts, circles[nearest], by_element = TRUE) } \seealso{ \link{st_nearest_points} for finding the nearest points for pairs of feature geometries } ================================================ FILE: man/st_nearest_points.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/nearest.R \name{st_nearest_points} \alias{st_nearest_points} \alias{st_nearest_points.sfc} \alias{st_nearest_points.sfg} \alias{st_nearest_points.sf} \title{get nearest points between pairs of geometries} \usage{ st_nearest_points(x, y, ..., by_element = FALSE) \method{st_nearest_points}{sfc}(x, y, ..., pairwise = by_element, by_element = FALSE) \method{st_nearest_points}{sfg}(x, y, ...) \method{st_nearest_points}{sf}(x, y, ...) } \arguments{ \item{x}{object of class \code{sfg}, \code{sfc} or \code{sf}} \item{y}{object of class \code{sfg}, \code{sfc} or \code{sf}; needs to have the same number of geometries of \code{x} when \code{by_element=TRUE}} \item{...}{ignored} \item{by_element}{logical; if \code{FALSE} (default) return nearest points between all possible pairs, if \code{TRUE}, return nearest points between row-wise x-y pairs.} \item{pairwise}{logical; deprecated in favour of \code{by_element}} } \value{ an \link{sfc} object with all two-point \code{LINESTRING} geometries of point pairs from the first to the second geometry, of length x * y if \code{by_element=FALSE} (with y cycling fastest), or lf length \code{length(x)} when \code{by_element=TRUE}. See examples for ideas how to convert these to \code{POINT} geometries. } \description{ get nearest points between pairs of geometries } \details{ in case \code{x} lies inside \code{y}, when using S2, the end points are on polygon boundaries, when using GEOS the end point are identical to \code{x}. } \examples{ r = sqrt(2)/10 pt1 = st_point(c(.1,.1)) pt2 = st_point(c(.9,.9)) pt3 = st_point(c(.9,.1)) b1 = st_buffer(pt1, r) b2 = st_buffer(pt2, r) b3 = st_buffer(pt3, r) (ls0 = st_nearest_points(b1, b2)) # sfg (ls = st_nearest_points(st_sfc(b1), st_sfc(b2, b3))) # sfc plot(b1, xlim = c(-.2,1.2), ylim = c(-.2,1.2), col = NA, border = 'green') plot(st_sfc(b2, b3), add = TRUE, col = NA, border = 'blue') plot(ls, add = TRUE, col = 'red') nc = st_read(system.file("gpkg/nc.gpkg", package="sf")) plot(st_geometry(nc)) ls = st_nearest_points(nc[1,], nc) plot(ls, col = 'red', add = TRUE) pts = st_cast(ls, "POINT") # gives all start & end points # starting, "from" points, corresponding to x: plot(pts[seq(1, 200, 2)], add = TRUE, col = 'blue') # ending, "to" points, corresponding to y: plot(pts[seq(2, 200, 2)], add = TRUE, col = 'green') } \seealso{ \link{st_nearest_feature} for finding the nearest feature } ================================================ FILE: man/st_normalize.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/normalize.R \name{st_normalize} \alias{st_normalize} \title{Normalize simple features} \usage{ st_normalize(x, domain = st_bbox(x), ...) } \arguments{ \item{x}{object of class sf, sfc or sfg} \item{domain}{The domain \code{x} should be normalized from as a length 4 vector of the form \code{c(xmin, ymin, xmax, ymax)}. Defaults to the bounding box of \code{x}} \item{...}{ignored} } \description{ \code{st_normalize} transforms the coordinates in the input feature to fall between 0 and 1. By default the current domain is set to the bounding box of the input, but other domains can be used as well } \examples{ p1 = st_point(c(7,52)) st_normalize(p1, domain = c(0, 0, 10, 100)) p2 = st_point(c(-30,20)) sfc = st_sfc(p1, p2, crs = 4326) sfc sfc_norm <- st_normalize(sfc) st_bbox(sfc_norm) } ================================================ FILE: man/st_precision.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/sfc.R \name{st_precision} \alias{st_precision} \alias{st_set_precision} \alias{st_precision<-} \title{Get precision} \usage{ st_precision(x) st_set_precision(x, precision) st_precision(x) <- value } \arguments{ \item{x}{object of class \code{sfc} or \code{sf}} \item{precision}{numeric, or object of class \code{units} with distance units (but see details); see \link{st_as_binary} for how to do this.} \item{value}{precision value} } \description{ Get precision Set precision } \details{ If \code{precision} is a \code{units} object, the object on which we set precision must have a coordinate reference system with compatible distance units. Setting a \code{precision} has no direct effect on coordinates of geometries, but merely set an attribute tag to an \code{sfc} object. The effect takes place in \link{st_as_binary} or, more precise, in the C++ function \code{CPL_write_wkb}, where simple feature geometries are being serialized to well-known-binary (WKB). This happens always when routines are called in GEOS library (geometrical operations or predicates), for writing geometries using \link{st_write} or \link{write_sf}, \code{st_make_valid} in package \code{lwgeom}; also \link{aggregate} and \link{summarise} by default union geometries, which calls a GEOS library function. Routines in these libraries receive rounded coordinates, and possibly return results based on them. \link{st_as_binary} contains an example of a roundtrip of \code{sfc} geometries through WKB, in order to see the rounding happening to R data. The reason to support precision is that geometrical operations in GEOS or liblwgeom may work better at reduced precision. For writing data from R to external resources it is harder to think of a good reason to limiting precision. } \examples{ x <- st_sfc(st_point(c(pi, pi))) st_precision(x) st_precision(x) <- 0.01 st_precision(x) } \seealso{ \link{st_as_binary} for an explanation of what setting precision does, and the examples therein. } ================================================ FILE: man/st_read.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/read.R, R/db.R \name{st_read} \alias{st_read} \alias{st_read.character} \alias{read_sf} \alias{st_read.DBIObject} \title{Read simple features or layers from file or database} \usage{ st_read(dsn, layer, ...) \method{st_read}{character}( dsn, layer, ..., query = NA, options = NULL, quiet = FALSE, geometry_column = 1L, type = 0, promote_to_multi = TRUE, stringsAsFactors = sf_stringsAsFactors(), int64_as_string = FALSE, check_ring_dir = FALSE, fid_column_name = character(0), drivers = character(0), wkt_filter = character(0), optional = FALSE, use_stream = default_st_read_use_stream() ) read_sf(..., quiet = TRUE, stringsAsFactors = FALSE, as_tibble = TRUE) \method{st_read}{DBIObject}( dsn = NULL, layer = NULL, query = NULL, EWKB = TRUE, quiet = TRUE, as_tibble = FALSE, geometry_column = NULL, ... ) } \arguments{ \item{dsn}{data source name (interpretation varies by driver - for some drivers, \code{dsn} is a file name, but may also be a folder, or contain the name and access credentials of a database); in case of GeoJSON, \code{dsn} may be the character string holding the geojson data. It can also be an open database connection.} \item{layer}{layer name (varies by driver, may be a file name without extension); in case \code{layer} is missing, \code{st_read} will read the first layer of \code{dsn}, give a warning and (unless \code{quiet = TRUE}) print a message when there are multiple layers, or give an error if there are no layers in \code{dsn}. If \code{dsn} is a database connection, then \code{layer} can be a table name or a database identifier (see \code{\link[DBI]{Id}}). It is also possible to omit \code{layer} and rather use the \code{query} argument.} \item{...}{parameter(s) passed on to \link{st_as_sf}} \item{query}{SQL query to select records; see details} \item{options}{character; driver dependent dataset open options, multiple options supported. For possible values, see the "Open options" section of the GDAL documentation of the corresponding driver, and \url{https://github.com/r-spatial/sf/issues/1157} for an example.} \item{quiet}{logical; suppress info on name, driver, size and spatial reference, or signaling no or multiple layers} \item{geometry_column}{integer or character; in case of multiple geometry fields, which one to take?} \item{type}{integer; ISO number of desired simple feature type; see details. If left zero, and \code{promote_to_multi} is \code{TRUE}, in case of mixed feature geometry types, conversion to the highest numeric type value found will be attempted. A vector with different values for each geometry column can be given.} \item{promote_to_multi}{logical; in case of a mix of Point and MultiPoint, or of LineString and MultiLineString, or of Polygon and MultiPolygon, convert all to the Multi variety; defaults to \code{TRUE}} \item{stringsAsFactors}{logical; should character vectors be converted to factors? Default for \code{read_sf} or R version >= 4.1.0 is \code{FALSE}, for \code{st_read} and R version < 4.1.0 equal to \code{default.stringsAsFactors()}} \item{int64_as_string}{logical; if \code{TRUE}, Int64 attributes are returned as string; if \code{FALSE}, they are returned as double and a warning is given when precision is lost (i.e., values are larger than 2^53).} \item{check_ring_dir}{logical; if \code{TRUE}, polygon ring directions are checked and if necessary corrected (when seen from above: exterior ring counter clockwise, holes clockwise)} \item{fid_column_name}{character; name of column to write feature IDs to; defaults to not doing this} \item{drivers}{character; limited set of driver short names to be tried (default: try all)} \item{wkt_filter}{character; WKT representation of a spatial filter (may be used as bounding box, selecting overlapping geometries); see examples} \item{optional}{logical; passed to \link[base]{as.data.frame}; always \code{TRUE} when \code{as_tibble} is \code{TRUE}} \item{use_stream}{Use \code{TRUE} to use the experimental columnar interface introduced in GDAL 3.6.} \item{as_tibble}{logical; should the returned table be of class tibble or data.frame?} \item{EWKB}{logical; is the WKB of type EWKB? if missing, defaults to \code{TRUE}} } \value{ object of class \link{sf} when a layer was successfully read; in case argument \code{layer} is missing and data source \code{dsn} does not contain a single layer, an object of class \code{sf_layers} is returned with the layer names, each with their geometry type(s). Note that the number of layers may also be zero. } \description{ Read simple features from file or database, or retrieve layer names and their geometry type(s) Read PostGIS table directly through DBI and RPostgreSQL interface, converting Well-Know Binary geometries to sfc } \details{ for \code{geometry_column}, see also \url{https://gdal.org/en/latest/development/rfc/rfc41_multiple_geometry_fields.html} for values for \code{type} see \url{https://en.wikipedia.org/wiki/Well-known_text_representation_of_geometry#Well-known_binary}, but note that not every target value may lead to successful conversion. The typical conversion from POLYGON (3) to MULTIPOLYGON (6) should work; the other way around (type=3), secondary rings from MULTIPOLYGONS may be dropped without warnings. \code{promote_to_multi} is handled on a per-geometry column basis; \code{type} may be specified for each geometry column. Note that stray files in data source directories (such as \code{*.dbf}) may lead to spurious errors that accompanying \code{*.shp} are missing. In case of problems reading shapefiles from USB drives on OSX, please see \url{https://github.com/r-spatial/sf/issues/252}. Reading shapefiles (or other data sources) directly from zip files can be done by prepending the path with \code{/vsizip/}. This is part of the GDAL Virtual File Systems interface that also supports .gz, curl, and other operations, including chaining; see \url{https://gdal.org/en/latest/user/virtual_file_systems.html} for a complete description and examples. For \code{query} with a character \code{dsn} the query text is handed to 'ExecuteSQL' on the GDAL/OGR data set and will result in the creation of a new layer (and \code{layer} is ignored). See 'OGRSQL' \url{https://gdal.org/en/latest/user/ogr_sql_dialect.html} for details. Please note that the 'FID' special field is driver-dependent, and may be either 0-based (e.g. ESRI Shapefile), 1-based (e.g. MapInfo) or arbitrary (e.g. OSM). Other features of OGRSQL are also likely to be driver dependent. The available layer names may be obtained with \link{st_layers}. Care will be required to properly escape the use of some layer names. \code{read_sf} and \code{write_sf} are aliases for \code{st_read} and \code{st_write}, respectively, with some modified default arguments. \code{read_sf} and \code{write_sf} are quiet by default: they do not print information about the data source. \code{read_sf} returns an sf-tibble rather than an sf-data.frame. \code{write_sf} delete layers by default: it overwrites existing files without asking or warning. if \code{table} is not given but \code{query} is, the spatial reference system (crs) of the table queried is only available in case it has been stored into each geometry record (e.g., by PostGIS, when using EWKB) The function will automatically find the \code{geometry} type columns for drivers that support it. For the other drivers, it will try to cast all the character columns, which can be slow for very wide tables. } \note{ The use of \code{system.file} in examples make sure that examples run regardless where R is installed: typical users will not use \code{system.file} but give the file name directly, either with full path or relative to the current working directory (see \link{getwd}). "Shapefiles" consist of several files with the same basename that reside in the same directory, only one of them having extension \code{.shp}. } \examples{ nc = st_read(system.file("shape/nc.shp", package="sf")) summary(nc) # note that AREA was computed using Euclidian area on lon/lat degrees ## only three fields by select clause ## only two features by where clause nc_sql = st_read(system.file("shape/nc.shp", package="sf"), query = "SELECT NAME, SID74, FIPS FROM \"nc\" WHERE BIR74 > 20000") \dontrun{ library(sp) example(meuse, ask = FALSE, echo = FALSE) try(st_write(st_as_sf(meuse), "PG:dbname=postgis", "meuse", layer_options = "OVERWRITE=true")) try(st_meuse <- st_read("PG:dbname=postgis", "meuse")) if (exists("st_meuse")) summary(st_meuse) } \dontrun{ ## note that we need special escaping of layer within single quotes (nc.gpkg) ## and that geom needs to be included in the select, otherwise we don't detect it layer <- st_layers(system.file("gpkg/nc.gpkg", package = "sf"))$name[1] nc_gpkg_sql = st_read(system.file("gpkg/nc.gpkg", package = "sf"), query = sprintf("SELECT NAME, SID74, FIPS, geom FROM \"\%s\" WHERE BIR74 > 20000", layer)) } # spatial filter, as wkt: wkt = st_as_text(st_geometry(nc[1,])) # filter by (bbox overlaps of) first feature geometry: st_read(system.file("gpkg/nc.gpkg", package="sf"), wkt_filter = wkt) # read geojson from string: geojson_txt <- paste("{\"type\":\"MultiPoint\",\"coordinates\":", "[[3.2,4],[3,4.6],[3.8,4.4],[3.5,3.8],[3.4,3.6],[3.9,4.5]]}") x = st_read(geojson_txt) x \dontrun{ library(RPostgreSQL) try(conn <- dbConnect(PostgreSQL(), dbname = "postgis")) if (exists("conn") && !inherits(conn, "try-error")) { x = st_read(conn, "meuse", query = "select * from meuse limit 3;") x = st_read(conn, table = "public.meuse") print(st_crs(x)) # SRID resolved by the database, not by GDAL! dbDisconnect(conn) } } } \seealso{ \link{st_layers}, \link{st_drivers} } ================================================ FILE: man/st_relate.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-predicates.R \name{st_relate} \alias{st_relate} \title{Compute DE9-IM relation between pairs of geometries, or match it to a given pattern} \usage{ st_relate(x, y, pattern = NA_character_, sparse = !is.na(pattern), ...) } \arguments{ \item{x}{object of class \code{sf}, \code{sfc} or \code{sfg}} \item{y}{object of class \code{sf}, \code{sfc} or \code{sfg}} \item{pattern}{character; define the pattern to match to, see details.} \item{sparse}{logical; should a sparse matrix be returned (\code{TRUE}) or a dense matrix?} \item{...}{may be used to specify \code{by_element=TRUE} to return a vector with element-wise relations or matches} } \value{ In case \code{pattern} is not given, \code{st_relate} returns a dense \code{character} matrix; element \verb{[i,j]} has nine characters, referring to the DE9-IM relationship between \code{x[i]} and \code{y[j]}, encoded as IxIy,IxBy,IxEy,BxIy,BxBy,BxEy,ExIy,ExBy,ExEy where I refers to interior, B to boundary, and E to exterior, and e.g. BxIy the dimensionality of the intersection of the the boundary of \code{x[i]} and the interior of \code{y[j]}, which is one of: 0, 1, 2, or F; digits denoting dimensionality of intersection, F denoting no intersection. When \code{pattern} is given, a dense logical matrix or sparse index list returned with matches to the given pattern; see \link{st_intersects} for a description of the returned matrix or list. See also \url{https://en.wikipedia.org/wiki/DE-9IM} for further explanation. } \description{ Compute DE9-IM relation between pairs of geometries, or match it to a given pattern } \examples{ p1 = st_point(c(0,0)) p2 = st_point(c(2,2)) pol1 = st_polygon(list(rbind(c(0,0),c(1,0),c(1,1),c(0,1),c(0,0)))) - 0.5 pol2 = pol1 + 1 pol3 = pol1 + 2 st_relate(st_sfc(p1, p2), st_sfc(pol1, pol2, pol3)) sfc = st_sfc(st_point(c(0,0)), st_point(c(3,3))) grd = st_make_grid(sfc, n = c(3,3)) st_intersects(grd) st_relate(grd, pattern = "****1****") # sides, not corners, internals st_relate(grd, pattern = "****0****") # only corners touch st_rook = function(a, b = a) st_relate(a, b, pattern = "F***1****") st_rook(grd) # queen neighbours, see \url{https://github.com/r-spatial/sf/issues/234#issuecomment-300511129} st_queen <- function(a, b = a) st_relate(a, b, pattern = "F***T****") } ================================================ FILE: man/st_sample.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/sample.R \name{st_sample} \alias{st_sample} \alias{st_sample.sf} \alias{st_sample.sfc} \alias{st_sample.sfg} \alias{st_sample.bbox} \title{sample points on or in (sets of) spatial features} \usage{ st_sample(x, size, ...) \method{st_sample}{sf}(x, size, ...) \method{st_sample}{sfc}( x, size, ..., type = "random", exact = TRUE, warn_if_not_integer = TRUE, by_polygon = FALSE, progress = FALSE, force = FALSE ) \method{st_sample}{sfg}(x, size, ...) \method{st_sample}{bbox}( x, size, ..., great_circles = FALSE, segments = units::set_units(2, "degree", mode = "standard") ) } \arguments{ \item{x}{object of class \code{sf} or \code{sfc}} \item{size}{sample size(s) requested; either total size, or a numeric vector with sample sizes for each feature geometry. When sampling polygons, the returned sampling size may differ from the requested size, as the bounding box is sampled, and sampled points intersecting the polygon are returned.} \item{...}{passed on to \link[base]{sample} for \code{multipoint} sampling, or to \code{spatstat} functions for spatstat sampling types (see details)} \item{type}{character; indicates the spatial sampling type; one of \code{random}, \code{hexagonal} (triangular really), \code{regular}, \code{Fibonacci}, or one of the \code{spatstat} methods such as \code{Thomas} for calling \code{spatstat.random::rThomas} (see Details).} \item{exact}{logical; should the length of output be exactly} \item{warn_if_not_integer}{logical; if \code{FALSE} then no warning is emitted if \code{size} is not an integer} \item{by_polygon}{logical; for \code{MULTIPOLYGON} geometries, should the effort be split by \code{POLYGON}? See https://github.com/r-spatial/sf/issues/1480 the same as specified by \code{size}? \code{TRUE} by default. Only applies to polygons, and when \code{type = "random"}.} \item{progress}{logical; if \code{TRUE} show progress bar (only if \code{size} is a vector).} \item{force}{logical; if \code{TRUE} continue when the sampled bounding box area is more than 1e4 times the area of interest, else (default) stop with an error. If this error is not justified, try setting \code{oriented=TRUE}, see details.} \item{great_circles}{logical; if \code{TRUE}, great circle arcs are used to connect the bounding box vertices, if \code{FALSE} parallels (graticules)} \item{segments}{units, or numeric (degrees); segment sizes for segmenting a bounding box polygon if \code{great_circles} is \code{FALSE}} } \value{ an \code{sfc} object containing the sampled \code{POINT} geometries } \description{ Sample points on or in (sets of) spatial features. By default, returns a pre-specified number of points that is equal to \code{size} (if \code{type = "random"} and \code{exact = TRUE}) or an approximation of \code{size} otherwise. \code{spatstat} methods are interfaced and do not use the \code{size} argument, see examples. } \details{ The function is vectorised: it samples \code{size} points across all geometries in the object if \code{size} is a single number, or the specified number of points in each feature if \code{size} is a vector of integers equal in length to the geometry of \code{x}. if \code{x} has dimension 2 (polygons) and geographical coordinates (long/lat), uniform random sampling on the sphere is applied, see e.g. \url{https://mathworld.wolfram.com/SpherePointPicking.html}. For \code{regular} or \code{hexagonal} sampling of polygons, the resulting size is only an approximation. As parameter called \code{offset} can be passed to control ("fix") regular or hexagonal sampling: for polygons a length 2 numeric vector (by default: a random point from \code{st_bbox(x)}); for lines use a number like \code{runif(1)}. Fibonacci sampling see: Alvaro Gonzalez, 2010. Measurement of Areas on a Sphere Using Fibonacci and Latitude-Longitude Lattices. Mathematical Geosciences 42(1), p. 49-64 For regular sampling on the sphere, see also \code{geosphere::regularCoordinates}. Sampling methods from package \code{spatstat} are interfaced (see examples), and need their own parameters to be set. For instance, to use \code{spatstat.random::rThomas()}, set \code{type = "Thomas"}. For sampling polygons one can specify \code{oriented=TRUE} to make sure that polygons larger than half the globe are not reverted, e.g. when specifying a polygon from a bounding box of a global dataset. The \code{st_sample} method for \code{bbox} does this by default. } \examples{ nc = st_read(system.file("shape/nc.shp", package="sf")) p1 = st_sample(nc[1:3, ], 6) p2 = st_sample(nc[1:3, ], 1:3) plot(st_geometry(nc)[1:3]) plot(p1, add = TRUE) plot(p2, add = TRUE, pch = 2) x = st_sfc(st_polygon(list(rbind(c(0,0),c(90,0),c(90,90),c(0,90),c(0,0)))), crs = st_crs(4326)) plot(x, axes = TRUE, graticule = TRUE) if (compareVersion(sf_extSoftVersion()["proj.4"], "4.9.0") >= 0) plot(p <- st_sample(x, 1000), add = TRUE) if (require(lwgeom, quietly = TRUE)) { # for st_segmentize() x2 = st_transform(st_segmentize(x, 1e4), st_crs("+proj=ortho +lat_0=30 +lon_0=45")) g = st_transform(st_graticule(), st_crs("+proj=ortho +lat_0=30 +lon_0=45")) plot(x2, graticule = g) if (compareVersion(sf_extSoftVersion()["proj.4"], "4.9.0") >= 0) { p2 = st_transform(p, st_crs("+proj=ortho +lat_0=30 +lon_0=45")) plot(p2, add = TRUE) } } x = st_sfc(st_polygon(list(rbind(c(0,0),c(90,0),c(90,10),c(0,90),c(0,0))))) # NOT long/lat: plot(x) p_exact = st_sample(x, 1000, exact = TRUE) p_not_exact = st_sample(x, 1000, exact = FALSE) length(p_exact); length(p_not_exact) plot(st_sample(x, 1000), add = TRUE) x = st_sfc(st_polygon(list(rbind(c(-180,-90),c(180,-90),c(180,90),c(-180,90),c(-180,-90)))), crs=st_crs(4326)) # FIXME: #if (compareVersion(sf_extSoftVersion()["proj.4"], "4.9.0") >= 0) { # p = st_sample(x, 1000) # st_sample(p, 3) #} # hexagonal: sfc = st_sfc(st_polygon(list(rbind(c(0,0), c(1,0), c(1,1), c(0,0))))) plot(sfc) h = st_sample(sfc, 100, type = "hexagonal") h1 = st_sample(sfc, 100, type = "hexagonal") plot(h, add = TRUE) plot(h1, col = 'red', add = TRUE) c(length(h), length(h1)) # approximate! pt = st_multipoint(matrix(1:20,,2)) ls = st_sfc(st_linestring(rbind(c(0,0),c(0,1))), st_linestring(rbind(c(0,0),c(.1,0))), st_linestring(rbind(c(0,1),c(.1,1))), st_linestring(rbind(c(2,2),c(2,2.00001)))) st_sample(ls, 80) plot(st_sample(ls, 80)) # spatstat example: if (require(spatstat.random)) { x <- sf::st_sfc(sf::st_polygon(list(rbind(c(0, 0), c(10, 0), c(10, 10), c(0, 0))))) # for spatstat.random::rThomas(), set type = "Thomas": pts <- st_sample(x, kappa = 1, mu = 10, scale = 0.1, type = "Thomas") } bbox = st_bbox( c(xmin = 0, xmax = 40, ymax = 70, ymin = 60), crs = st_crs('OGC:CRS84') ) set.seed(13531) s1 = st_sample(bbox, 400) st_bbox(s1) # within bbox s2 = st_sample(bbox, 400, great_circles = TRUE) st_bbox(s2) # outside bbox } ================================================ FILE: man/st_shift_longitude.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/shift_longitude.R \name{st_shift_longitude} \alias{st_shift_longitude} \alias{st_shift_longitude.sfc} \alias{st_shift_longitude.sf} \title{Shift or re-center geographical coordinates for a Pacific view} \usage{ st_shift_longitude(x) \method{st_shift_longitude}{sfc}(x, ...) \method{st_shift_longitude}{sf}(x, ...) } \arguments{ \item{x}{object of class \code{sf} or \code{sfc}} \item{...}{ignored} } \description{ All longitudes < 0 are added to 360, to avoid for instance parts of Alaska being represented on the far left and right of a plot because they have values straddling 180 degrees. In general, using a projected coordinate reference system is to be preferred, but this method permits a geographical coordinate reference system to be used. This is the sf equivalent of \link[sp:recenter]{recenter} in the sp package and \code{ST_ShiftLongitude} in PostGIS. } \examples{ ## sfc pt1 = st_point(c(-170, 50)) pt2 = st_point(c(170, 50)) (sfc = st_sfc(pt1, pt2)) sfc = st_set_crs(sfc, 4326) st_shift_longitude(sfc) ## sf d = st_as_sf(data.frame(id = 1:2, geometry = sfc)) st_shift_longitude(d) } ================================================ FILE: man/st_transform.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/transform.R, R/proj.R \name{st_transform} \alias{st_transform} \alias{st_can_transform} \alias{st_transform.sfc} \alias{st_transform.sf} \alias{st_transform.sfg} \alias{st_transform.bbox} \alias{st_wrap_dateline} \alias{st_wrap_dateline.sfc} \alias{st_wrap_dateline.sf} \alias{st_wrap_dateline.sfg} \alias{sf_proj_info} \title{Transform or convert coordinates of simple feature} \usage{ st_can_transform(src, dst) st_transform(x, crs, ...) \method{st_transform}{sfc}( x, crs = st_crs(x), ..., aoi = numeric(0), pipeline = character(0), reverse = FALSE, desired_accuracy = -1, allow_ballpark = TRUE, partial = TRUE, check = FALSE ) \method{st_transform}{sf}(x, crs = st_crs(x), ...) \method{st_transform}{sfg}(x, crs = st_crs(x), ...) \method{st_transform}{bbox}(x, crs, ..., densify = 21) st_wrap_dateline(x, options, quiet) \method{st_wrap_dateline}{sfc}(x, options = "WRAPDATELINE=YES", quiet = TRUE) \method{st_wrap_dateline}{sf}(x, options = "WRAPDATELINE=YES", quiet = TRUE) \method{st_wrap_dateline}{sfg}(x, options = "WRAPDATELINE=YES", quiet = TRUE) sf_proj_info(type = "proj", path) } \arguments{ \item{src}{source crs} \item{dst}{destination crs} \item{x}{object of class sf, sfc or sfg} \item{crs}{target coordinate reference system: object of class \code{crs}, or input string for \link{st_crs}} \item{...}{ignored} \item{aoi}{area of interest, in degrees: WestLongitude, SouthLatitude, EastLongitude, NorthLatitude} \item{pipeline}{character; coordinate operation pipeline, for overriding the default operation} \item{reverse}{boolean; has only an effect when \code{pipeline} is defined: if \code{TRUE}, the inverse operation of the pipeline is applied} \item{desired_accuracy}{numeric; Only coordinate operations that offer an accuracy of at least the one specified will be considered; a negative value disables this feature (requires GDAL >= 3.3)} \item{allow_ballpark}{logical; are ballpark (low accuracy) transformations allowed? (requires GDAL >= 3.3)} \item{partial}{logical; allow for partial projection, if not all points of a geometry can be projected (corresponds to setting environment variable \code{OGR_ENABLE_PARTIAL_REPROJECTION} to \code{TRUE})} \item{check}{logical; if \code{TRUE}, perform a sanity check on resulting polygons} \item{densify}{integer, number of points for discretizing lines between bounding box corner points; see Details} \item{options}{character; should have "WRAPDATELINE=YES" to function; another parameter that is used is "DATELINEOFFSET=10" (where 10 is the default value)} \item{quiet}{logical; print options after they have been parsed?} \item{type}{character; one of \code{have_datum_files}, \code{proj}, \code{ellps}, \code{datum}, \code{units}, \code{path}, or \code{prime_meridians}; see Details.} \item{path}{character; PROJ search path to be set} } \description{ Transform or convert coordinates of simple feature } \details{ \code{st_can_transform} returns a boolean indicating whether coordinates with CRS src can be transformed into CRS dst Transforms coordinates of object to new projection. Features that cannot be transformed are returned as empty geometries. Transforms using the \code{pipeline=} argument may fail if there is ambiguity in the axis order of the specified coordinate reference system; if you need the traditional GIS order, use \code{"OGC:CRS84"}, not \code{"EPSG:4326"}. Extra care is needed with the ESRI Shapefile format, because WKT1 does not store axis order unambiguously. The \code{st_transform} method for \code{sfg} objects assumes that the CRS of the object is available as an attribute of that name. the method for \code{bbox} objects densifies lines for geographic coordinates along Cartesian lines, not great circle arcs For a discussion of using \code{options}, see \url{https://github.com/r-spatial/sf/issues/280} and \url{https://github.com/r-spatial/sf/issues/1983} \code{sf_proj_info} lists the available projections, ellipses, datums, units, or data search path of the PROJ library when \code{type} is equal to proj, ellps, datum, units or path; when \code{type} equals \code{have_datum_files} a boolean is returned indicating whether datum files are installed and accessible (checking for \code{conus}). \code{path} returns the \code{PROJ_INFO.searchpath} field directly, as a single string with path separaters (\code{:} or \verb{;}). for PROJ >= 6, \code{sf_proj_info} does not provide option \code{type = "datums"}. PROJ < 6 does not provide the option \code{type = "prime_meridians"}. for PROJ >= 7.1.0, the "units" query of \code{sf_proj_info} returns the \code{to_meter} variable as numeric, previous versions return a character vector containing a numeric expression. } \examples{ p1 = st_point(c(7,52)) p2 = st_point(c(-30,20)) sfc = st_sfc(p1, p2, crs = 4326) sfc st_transform(sfc, 3857) st_transform(st_sf(a=2:1, geom=sfc), "EPSG:3857") if (compareVersion(sf_extSoftVersion()["GDAL"], "3.0.0") >= 0) { st_transform(sfc, pipeline = "+proj=pipeline +step +proj=axisswap +order=2,1") # reverse axes st_transform(sfc, pipeline = "+proj=pipeline +step +proj=axisswap +order=2,1", reverse = TRUE) # also reverse axes } nc = st_read(system.file("shape/nc.shp", package="sf")) st_area(nc[1,]) # area from long/lat st_area(st_transform(nc[1,], 32119)) # NC state plane, m st_area(st_transform(nc[1,], 2264)) # NC state plane, US foot library(units) set_units(st_area(st_transform(nc[1,], 2264)), m^2) st_transform(structure(p1, proj4string = "EPSG:4326"), "EPSG:3857") st_wrap_dateline(st_sfc(st_linestring(rbind(c(-179,0),c(179,0))), crs = 4326)) sf_proj_info("datum") } \seealso{ \link[lwgeom]{st_transform_proj}, part of package lwgeom. \link{sf_project} projects a matrix of coordinates, bypassing GDAL altogether \link{st_break_antimeridian} } ================================================ FILE: man/st_viewport.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/grid.R \name{st_viewport} \alias{st_viewport} \title{Create viewport from sf, sfc or sfg object} \usage{ st_viewport(x, ..., bbox = st_bbox(x), asp) } \arguments{ \item{x}{object of class sf, sfc or sfg object} \item{...}{parameters passed on to \link[grid]{viewport}} \item{bbox}{the bounding box used for aspect ratio} \item{asp}{numeric; target aspect ratio (y/x), see Details} } \value{ The output of the call to \link[grid]{viewport} } \description{ Create viewport from sf, sfc or sfg object } \details{ parameters \code{width}, \code{height}, \code{xscale} and \code{yscale} are set such that aspect ratio is honoured and plot size is maximized in the current viewport; others can be passed as \code{...} If \code{asp} is missing, it is taken as 1, except when \code{isTRUE(st_is_longlat(x))}, in which case it is set to \code{1.0 /cos(y)}, with \code{y} the middle of the latitude bounding box. } \examples{ library(grid) nc = st_read(system.file("shape/nc.shp", package="sf")) grid.newpage() pushViewport(viewport(width = 0.8, height = 0.8)) pushViewport(st_viewport(nc)) invisible(lapply(st_geometry(nc), function(x) grid.draw(st_as_grob(x, gp = gpar(fill = 'red'))))) } ================================================ FILE: man/st_write.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/read.R \name{st_write} \alias{st_write} \alias{st_write.sfc} \alias{st_write.sf} \alias{st_write.data.frame} \alias{write_sf} \alias{st_delete} \title{Write simple features object to file or database} \usage{ st_write(obj, dsn, layer, ...) \method{st_write}{sfc}(obj, dsn, layer, ...) \method{st_write}{sf}( obj, dsn, layer = NULL, ..., driver = guess_driver_can_write(dsn), dataset_options = NULL, layer_options = NULL, quiet = FALSE, factorsAsCharacter = TRUE, append = NA, delete_dsn = FALSE, delete_layer = !is.na(append) && !append, fid_column_name = NULL, config_options = character(0) ) \method{st_write}{data.frame}(obj, dsn, layer = NULL, ...) write_sf(..., quiet = TRUE, append = FALSE, delete_layer = !append) st_delete( dsn, layer = character(0), driver = guess_driver_can_write(dsn), quiet = FALSE ) } \arguments{ \item{obj}{object of class \code{sf} or \code{sfc}} \item{dsn}{data source name. Interpretation varies by driver: can be a filename, a folder, a database name, or a Database Connection (we officially test support for \code{\link[RPostgres:Postgres]{RPostgres::Postgres()}} connections).} \item{layer}{layer name. Varies by driver, may be a file name without extension; for database connection, it is the name of the table. If layer is missing, the \code{basename} of \code{dsn} is taken.} \item{...}{other arguments passed to \link[DBI]{dbWriteTable} when \code{dsn} is a Database Connection} \item{driver}{character; name of driver to be used; if missing and \code{dsn} is not a Database Connection, a driver name is guessed from \code{dsn}; \code{st_drivers()} returns the drivers that are available with their properties; links to full driver documentation are found at \url{https://gdal.org/en/latest/drivers/vector/index.html}} \item{dataset_options}{character; driver dependent dataset creation options; multiple options supported.} \item{layer_options}{character; driver dependent layer creation options; multiple options supported.} \item{quiet}{logical; suppress info on name, driver, size and spatial reference} \item{factorsAsCharacter}{logical; convert \code{factor} levels to character strings (\code{TRUE}, default), otherwise into numbers when factorsAsCharacter is \code{FALSE}. For database connections, \code{factorsAsCharacter} is always \code{TRUE}.} \item{append}{logical; should we append to an existing layer, or replace it? if \code{TRUE} append, if \code{FALSE} replace. The default for \code{st_write} is \code{NA} which raises an error if the layer exists. The default for \code{write_sf} is \code{FALSE}, which overwrites any existing data. See also next two arguments for more control on overwrite behavior.} \item{delete_dsn}{logical; delete data source \code{dsn} before attempting to write?} \item{delete_layer}{logical; delete layer \code{layer} before attempting to write? The default for \code{st_write} is \code{FALSE} which raises an error if the layer exists. The default for \code{write_sf} is \code{TRUE}.} \item{fid_column_name}{character, name of column with feature IDs; if specified, this column is no longer written as feature attribute.} \item{config_options}{character, named vector with GDAL config options} } \value{ \code{obj}, invisibly } \description{ Write simple features object to file or database } \details{ Columns (variables) of a class not supported are dropped with a warning. When updating an existing layer, records are appended to it if the updating object has the right variable names and types. If names don't match an error is raised. If types don't match, behaviour is undefined: GDAL may raise warnings or errors or fail silently. When deleting layers or data sources is not successful, no error is emitted. \code{delete_dsn} and \code{delete_layer} should be handled with care; the former may erase complete directories or databases. \code{st_delete()} deletes layer(s) in a data source, or a data source if layers are omitted; it returns \code{TRUE} on success, \code{FALSE} on failure, invisibly. } \examples{ nc = st_read(system.file("shape/nc.shp", package="sf")) st_write(nc, paste0(tempdir(), "/", "nc.shp")) st_write(nc, paste0(tempdir(), "/", "nc.shp"), delete_layer = TRUE) # overwrites if (require(sp, quietly = TRUE)) { data(meuse, package = "sp") # loads data.frame from sp meuse_sf = st_as_sf(meuse, coords = c("x", "y"), crs = 28992) # writes X and Y as columns: st_write(meuse_sf, paste0(tempdir(), "/", "meuse.csv"), layer_options = "GEOMETRY=AS_XY") st_write(meuse_sf, paste0(tempdir(), "/", "meuse.csv"), layer_options = "GEOMETRY=AS_WKT", delete_dsn=TRUE) # overwrites \dontrun{ library(sp) example(meuse, ask = FALSE, echo = FALSE) try(st_write(st_as_sf(meuse), "PG:dbname=postgis", "meuse_sf", layer_options = c("OVERWRITE=yes", "LAUNDER=true"))) demo(nc, ask = FALSE) try(st_write(nc, "PG:dbname=postgis", "sids", layer_options = "OVERWRITE=true")) } } } \seealso{ \link{st_drivers}, \link[DBI]{dbWriteTable} } ================================================ FILE: man/st_z_range.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/z_range.R \name{st_z_range} \alias{st_z_range} \alias{is.na.z_range} \alias{st_z_range.POINT} \alias{st_z_range.MULTIPOINT} \alias{st_z_range.LINESTRING} \alias{st_z_range.POLYGON} \alias{st_z_range.MULTILINESTRING} \alias{st_z_range.MULTIPOLYGON} \alias{st_z_range.GEOMETRYCOLLECTION} \alias{st_z_range.MULTISURFACE} \alias{st_z_range.MULTICURVE} \alias{st_z_range.CURVEPOLYGON} \alias{st_z_range.COMPOUNDCURVE} \alias{st_z_range.POLYHEDRALSURFACE} \alias{st_z_range.TIN} \alias{st_z_range.TRIANGLE} \alias{st_z_range.CIRCULARSTRING} \alias{st_z_range.sfc} \alias{st_z_range.sf} \alias{st_z_range.numeric} \alias{NA_z_range_} \title{Return 'z' range of a simple feature or simple feature set} \usage{ \method{is.na}{z_range}(x) st_z_range(obj, ...) \method{st_z_range}{POINT}(obj, ...) \method{st_z_range}{MULTIPOINT}(obj, ...) \method{st_z_range}{LINESTRING}(obj, ...) \method{st_z_range}{POLYGON}(obj, ...) \method{st_z_range}{MULTILINESTRING}(obj, ...) \method{st_z_range}{MULTIPOLYGON}(obj, ...) \method{st_z_range}{GEOMETRYCOLLECTION}(obj, ...) \method{st_z_range}{MULTISURFACE}(obj, ...) \method{st_z_range}{MULTICURVE}(obj, ...) \method{st_z_range}{CURVEPOLYGON}(obj, ...) \method{st_z_range}{COMPOUNDCURVE}(obj, ...) \method{st_z_range}{POLYHEDRALSURFACE}(obj, ...) \method{st_z_range}{TIN}(obj, ...) \method{st_z_range}{TRIANGLE}(obj, ...) \method{st_z_range}{CIRCULARSTRING}(obj, ...) \method{st_z_range}{sfc}(obj, ...) \method{st_z_range}{sf}(obj, ...) \method{st_z_range}{numeric}(obj, ..., crs = NA_crs_) NA_z_range_ } \arguments{ \item{x}{object of class \code{z_range}} \item{obj}{object to compute the z range from} \item{...}{ignored} \item{crs}{object of class \code{crs}, or argument to \link{st_crs}, specifying the CRS of this bounding box.} } \value{ a numeric vector of length two, with \code{zmin} and \code{zmax} values; if \code{obj} is of class \code{sf} or \code{sfc} the object returned has a class \code{z_range} } \description{ Return 'z' range of a simple feature or simple feature set } \details{ \code{NA_z_range_} represents the missing value for a \code{z_range} object } \examples{ a = st_sf(a = 1:2, geom = st_sfc(st_point(0:2), st_point(1:3)), crs = 4326) st_z_range(a) st_z_range(c(zmin = 16.1, zmax = 16.6), crs = st_crs(4326)) } ================================================ FILE: man/st_zm.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/sfc.R \name{st_zm} \alias{st_zm} \title{Drop or add Z and/or M dimensions from feature geometries} \usage{ st_zm(x, ..., drop = TRUE, what = "ZM") } \arguments{ \item{x}{object of class \code{sfg}, \code{sfc} or \code{sf}} \item{...}{ignored} \item{drop}{logical; drop, or (\code{FALSE}) add?} \item{what}{character which dimensions to drop or add} } \description{ Drop Z and/or M dimensions from feature geometries, resetting classes appropriately } \details{ Only combinations \code{drop=TRUE}, \code{what = "ZM"}, and \code{drop=FALSE}, \code{what="Z"} are supported so far. In the latter case, \code{x} should have \code{XY} geometry, and zero values are added for the \code{Z} dimension. } \examples{ st_zm(st_linestring(matrix(1:32,8))) x = st_sfc(st_linestring(matrix(1:32,8)), st_linestring(matrix(1:8,2))) st_zm(x) a = st_sf(a = 1:2, geom=x) st_zm(a) } ================================================ FILE: man/stars.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.R \name{stars} \alias{stars} \alias{.get_layout} \alias{.degAxis} \alias{.image_scale} \alias{.image_scale_factor} \title{functions only exported to be used internally by stars} \usage{ .get_layout(bb, n, total_size, key.pos, key.width, mfrow = NULL, main = NULL) .degAxis(side, at, labels, ..., lon, lat, ndiscr, reset) .image_scale( z, col, breaks = NULL, key.pos, add.axis = TRUE, at = NULL, ..., axes = FALSE, key.length, logz = FALSE, lab = "", cex.axis = par("cex.axis") ) .image_scale_factor( z, col, key.pos, add.axis = TRUE, ..., axes = FALSE, key.width, key.length, cex.axis = par("cex.axis") ) } \arguments{ \item{bb}{ignore} \item{n}{ignore} \item{total_size}{ignore} \item{key.pos}{ignore} \item{key.width}{ignore} \item{mfrow}{length-2 integer vector with number of rows, columns} \item{main}{main or sub title} \item{side}{ignore} \item{at}{ignore} \item{labels}{ignore} \item{...}{ignore} \item{lon}{ignore} \item{lat}{ignore} \item{ndiscr}{ignore} \item{reset}{ignore} \item{z}{ignore} \item{col}{ignore} \item{breaks}{ignore} \item{add.axis}{ignore} \item{axes}{ignore} \item{key.length}{ignore} \item{logz}{ignore} \item{lab}{ignore} \item{cex.axis}{see \link{par}} } \description{ functions only exported to be used internally by stars } \keyword{internal} ================================================ FILE: man/summary.sfc.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/sfc.R \name{summary.sfc} \alias{summary.sfc} \title{Summarize simple feature column} \usage{ \method{summary}{sfc}(object, ..., maxsum = 7L, maxp4s = 10L) } \arguments{ \item{object}{object of class \code{sfc}} \item{...}{ignored} \item{maxsum}{maximum number of classes to summarize the simple feature column to} \item{maxp4s}{maximum number of characters to print from the PROJ string} } \description{ Summarize simple feature column } ================================================ FILE: man/tibble.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/tidyverse.R \name{tibble} \alias{tibble} \alias{type_sum.sfc} \alias{obj_sum.sfc} \alias{pillar_shaft.sfc} \title{Summarize simple feature type for tibble} \usage{ type_sum.sfc(x, ...) obj_sum.sfc(x) pillar_shaft.sfc(x, ...) } \arguments{ \item{x}{object of class \code{sfc}} \item{...}{ignored} } \description{ Summarize simple feature type / item for tibble } \details{ see \link[pillar]{type_sum} } ================================================ FILE: man/tidyverse.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/tidyverse.R, R/join.R \name{tidyverse} \alias{tidyverse} \alias{filter.sf} \alias{arrange.sf} \alias{group_by.sf} \alias{ungroup.sf} \alias{rowwise.sf} \alias{mutate.sf} \alias{transmute.sf} \alias{select.sf} \alias{rename.sf} \alias{rename_with.sf} \alias{slice.sf} \alias{summarise.sf} \alias{summarise} \alias{count.sf} \alias{distinct.sf} \alias{gather.sf} \alias{pivot_longer.sf} \alias{pivot_wider.sf} \alias{spread.sf} \alias{sample_n.sf} \alias{sample_frac.sf} \alias{group_split.sf} \alias{nest.sf} \alias{separate.sf} \alias{separate_rows.sf} \alias{unite.sf} \alias{unnest.sf} \alias{drop_na.sf} \alias{inner_join.sf} \alias{left_join.sf} \alias{right_join.sf} \alias{full_join.sf} \alias{semi_join.sf} \alias{anti_join.sf} \title{Tidyverse methods for sf objects} \usage{ filter.sf(.data, ..., .dots) arrange.sf(.data, ..., .dots) group_by.sf(.data, ..., add = FALSE) ungroup.sf(x, ...) rowwise.sf(x, ...) mutate.sf(.data, ..., .dots) transmute.sf(.data, ..., .dots) select.sf(.data, ...) rename.sf(.data, ...) rename_with.sf(.data, .fn, .cols, ...) slice.sf(.data, ..., .dots) summarise.sf(.data, ..., .dots, do_union = TRUE, is_coverage = FALSE) count.sf(x, ..., wt = NULL, sort = FALSE, name = "n", .drop_geometry = FALSE) distinct.sf(.data, ..., .keep_all = FALSE, exact = FALSE, par = 0) gather.sf( data, key, value, ..., na.rm = FALSE, convert = FALSE, factor_key = FALSE ) pivot_longer.sf( data, cols, names_to = "name", names_prefix = NULL, names_sep = NULL, names_pattern = NULL, names_ptypes = NULL, names_transform = NULL, names_repair = "check_unique", values_to = "value", values_drop_na = FALSE, values_ptypes = NULL, values_transform = NULL, ... ) pivot_wider.sf( data, ..., id_cols = NULL, id_expand = FALSE, names_from = name, names_prefix = "", names_sep = "_", names_glue = NULL, names_sort = FALSE, names_vary = "fastest", names_expand = FALSE, names_repair = "check_unique", values_from = value, values_fill = NULL, values_fn = NULL, unused_fn = NULL ) spread.sf( data, key, value, fill = NA, convert = FALSE, drop = TRUE, sep = NULL ) sample_n.sf(tbl, size, replace = FALSE, weight = NULL, .env = parent.frame()) sample_frac.sf( tbl, size = 1, replace = FALSE, weight = NULL, .env = parent.frame() ) group_split.sf(.tbl, ..., .keep = TRUE) nest.sf(.data, ...) separate.sf( data, col, into, sep = "[^[:alnum:]]+", remove = TRUE, convert = FALSE, extra = "warn", fill = "warn", ... ) separate_rows.sf(data, ..., sep = "[^[:alnum:]]+", convert = FALSE) unite.sf(data, col, ..., sep = "_", remove = TRUE) unnest.sf(data, ..., .preserve = NULL) drop_na.sf(x, ...) inner_join.sf(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) left_join.sf(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) right_join.sf(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) full_join.sf(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) semi_join.sf(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) anti_join.sf(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) } \arguments{ \item{.data}{data object of class \link{sf}} \item{...}{other arguments} \item{.dots}{see corresponding function in package \code{dplyr}} \item{add}{see corresponding function in dplyr} \item{x, y}{A pair of data frames, data frame extensions (e.g. a tibble), or lazy data frames (e.g. from dbplyr or dtplyr). See \emph{Methods}, below, for more details.} \item{.fn, .cols}{see original docs} \item{do_union}{logical; in case \code{summary} does not create a geometry column, should geometries be created by unioning using \link{st_union}, or simply by combining using \link{st_combine}? Using \link{st_union} resolves internal boundaries, but in case of unioning points, this will likely change the order of the points; see Details.} \item{is_coverage}{logical; if \code{do_union} is \code{TRUE}, use an optimized algorithm for features that form a polygonal coverage (have no overlaps)} \item{wt}{see original function docs} \item{sort}{see original function docs} \item{name}{see original function docs} \item{.drop_geometry}{logical; if \code{TRUE}, remove geometry column before computing counts} \item{.keep_all}{see corresponding function in dplyr} \item{exact}{logical; if \code{TRUE} use \link{st_equals_exact} for geometry comparisons} \item{par}{numeric; passed on to \link{st_equals_exact}} \item{data}{see original function docs} \item{key}{see original function docs} \item{value}{see original function docs} \item{na.rm}{see original function docs} \item{convert}{see \link[tidyr]{separate_rows}} \item{factor_key}{see original function docs} \item{cols}{see original function docs} \item{names_to, names_pattern, names_ptypes, names_transform}{see \code{\link[tidyr:pivot_longer]{tidyr::pivot_longer()}}} \item{names_prefix, names_sep, names_repair}{see original function docs.} \item{values_to, values_drop_na, values_ptypes, values_transform}{See \code{\link[tidyr:pivot_longer]{tidyr::pivot_longer()}}} \item{id_cols, id_expand, names_from, names_sort, names_glue, names_vary, names_expand}{see \code{\link[tidyr:pivot_wider]{tidyr::pivot_wider()}}} \item{values_from, values_fill, values_fn, unused_fn}{see \code{\link[tidyr:pivot_wider]{tidyr::pivot_wider()}}} \item{fill}{see original function docs} \item{drop}{see original function docs} \item{sep}{see \link[tidyr]{separate_rows}} \item{tbl}{see original function docs} \item{size}{see original function docs} \item{replace}{see original function docs} \item{weight}{see original function docs} \item{.env}{see original function docs} \item{.tbl}{see original function docs} \item{.keep}{see original function docs} \item{col}{see \link[tidyr]{separate}} \item{into}{see \link[tidyr]{separate}} \item{remove}{see \link[tidyr]{separate}} \item{extra}{see \link[tidyr]{separate}} \item{.preserve}{see \link[tidyr:nest]{unnest}} \item{by}{A join specification created with \code{\link[dplyr:join_by]{join_by()}}, or a character vector of variables to join by. If \code{NULL}, the default, \verb{*_join()} will perform a natural join, using all variables in common across \code{x} and \code{y}. A message lists the variables so that you can check they're correct; suppress the message by supplying \code{by} explicitly. To join on different variables between \code{x} and \code{y}, use a \code{\link[dplyr:join_by]{join_by()}} specification. For example, \code{join_by(a == b)} will match \code{x$a} to \code{y$b}. To join by multiple variables, use a \code{\link[dplyr:join_by]{join_by()}} specification with multiple expressions. For example, \code{join_by(a == b, c == d)} will match \code{x$a} to \code{y$b} and \code{x$c} to \code{y$d}. If the column names are the same between \code{x} and \code{y}, you can shorten this by listing only the variable names, like \code{join_by(a, c)}. \code{\link[dplyr:join_by]{join_by()}} can also be used to perform inequality, rolling, and overlap joins. See the documentation at \link[dplyr:join_by]{?join_by} for details on these types of joins. For simple equality joins, you can alternatively specify a character vector of variable names to join by. For example, \code{by = c("a", "b")} joins \code{x$a} to \code{y$a} and \code{x$b} to \code{y$b}. If variable names differ between \code{x} and \code{y}, use a named character vector like \code{by = c("x_a" = "y_a", "x_b" = "y_b")}. To perform a cross-join, generating all combinations of \code{x} and \code{y}, see \code{\link[dplyr:cross_join]{cross_join()}}.} \item{copy}{If \code{x} and \code{y} are not from the same data source, and \code{copy} is \code{TRUE}, then \code{y} will be copied into the same src as \code{x}. This allows you to join tables across srcs, but it is a potentially expensive operation so you must opt into it.} \item{suffix}{If there are non-joined duplicate variables in \code{x} and \code{y}, these suffixes will be added to the output to disambiguate them. Should be a character vector of length 2.} } \value{ an object of class \link{sf} } \description{ Tidyverse methods for sf objects. Geometries are sticky, use \link{as.data.frame} to let \code{dplyr}'s own methods drop them. Use these methods after loading the tidyverse package with the generic (or after loading package tidyverse). } \details{ \code{select} keeps the geometry regardless whether it is selected or not; to deselect it, first pipe through \code{as.data.frame} to let dplyr's own \code{select} drop it. In case one or more of the arguments (expressions) in the \code{summarise} call creates a geometry list-column, the first of these will be the (active) geometry of the returned object. If this is not the case, a geometry column is created, depending on the value of \code{do_union}. In case \code{do_union} is \code{FALSE}, \code{summarise} will simply combine geometries using \link{c.sfg}. When polygons sharing a boundary are combined, this leads to geometries that are invalid; see for instance \url{https://github.com/r-spatial/sf/issues/681}. The functions \code{count} and \code{tally} drop all geometries. For counting geometries use \code{summarise(.data, n = n(), .by = "geometry")}. \code{distinct} gives distinct records for which all attributes and geometries are distinct; \link{st_equals} is used to find out which geometries are distinct. \code{nest} assumes that a simple feature geometry list-column was among the columns that were nested. } \examples{ if (require(dplyr, quietly = TRUE)) { nc = read_sf(system.file("shape/nc.shp", package="sf")) nc |> filter(AREA > .1) |> plot() # plot 10 smallest counties in grey: st_geometry(nc) |> plot() nc |> select(AREA) |> arrange(AREA) |> slice(1:10) |> plot(add = TRUE, col = 'grey') title("the ten counties with smallest area") nc2 <- nc |> mutate(area10 = AREA/10) nc |> slice(1:2) } # plot 10 smallest counties in grey: if (require(dplyr, quietly = TRUE)) { st_geometry(nc) |> plot() nc |> select(AREA) |> arrange(AREA) |> slice(1:10) |> plot(add = TRUE, col = 'grey') title("the ten counties with smallest area") } if (require(dplyr, quietly = TRUE)) { nc$area_cl = cut(nc$AREA, c(0, .1, .12, .15, .25)) nc |> group_by(area_cl) |> class() } if (require(dplyr, quietly = TRUE)) { nc2 <- nc |> mutate(area10 = AREA/10) } if (require(dplyr, quietly = TRUE)) { nc |> transmute(AREA = AREA/10) |> class() } if (require(dplyr, quietly = TRUE)) { nc |> select(SID74, SID79) |> names() nc |> select(SID74, SID79) |> class() } if (require(dplyr, quietly = TRUE)) { nc2 <- nc |> rename(area = AREA) } if (require(dplyr, quietly = TRUE)) { nc |> slice(1:2) } if (require(dplyr, quietly = TRUE)) { nc$area_cl = cut(nc$AREA, c(0, .1, .12, .15, .25)) nc.g <- nc |> group_by(area_cl) nc.g |> summarise(mean(AREA)) nc.g |> summarise(mean(AREA)) |> plot(col = grey(3:6 / 7)) nc |> as.data.frame() |> summarise(mean(AREA)) # counting geometries (after duplicating each row): nc.dupl <- nc[rep(seq_along(nc), each = 2), ] nc.dupl |> summarise(n = n(), .by = "geometry") } if (require(dplyr, quietly = TRUE)) { nc$area_cl <- cut(nc$AREA, c(0, .1, .12, .15, .25)) nc |> count(area_cl, .drop_geometry = TRUE) } if (require(dplyr, quietly = TRUE)) { nc[c(1:100, 1:10), ] |> distinct() |> nrow() } if (require(tidyr, quietly = TRUE) && require(dplyr, quietly = TRUE) && "geometry" \%in\% names(nc)) { nc |> select(SID74, SID79) |> gather("VAR", "SID", -geometry) |> summary() } if (require(tidyr, quietly = TRUE) && require(dplyr, quietly = TRUE) && "geometry" \%in\% names(nc)) { nc$row = 1:100 # needed for spread to work nc |> select(SID74, SID79, geometry, row) |> gather("VAR", "SID", -geometry, -row) |> spread(VAR, SID) |> head() } if (require(tidyr, quietly = TRUE) && require(dplyr, quietly = TRUE)) { storms.sf = st_as_sf(storms, coords = c("long", "lat"), crs = 4326) x <- storms.sf |> group_by(name, year) |> nest() trs = lapply(x$data, function(tr) st_cast(st_combine(tr), "LINESTRING")[[1]]) |> st_sfc(crs = 4326) trs.sf = st_sf(x[,1:2], trs) plot(trs.sf["year"], axes = TRUE) } } ================================================ FILE: man/transform.sf.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/sf.R \name{transform.sf} \alias{transform.sf} \title{transform method for sf objects} \usage{ \method{transform}{sf}(`_data`, ...) } \arguments{ \item{_data}{object of class \code{sf}} \item{...}{Further arguments of the form \code{new_variable = expression}} } \description{ Can be used to create or modify attribute variables; for transforming geometries see \link{st_transform}, and all other functions starting with \code{st_}. } \examples{ a = data.frame(x1 = 1:3, x2 = 5:7) st_geometry(a) = st_sfc(st_point(c(0,0)), st_point(c(1,1)), st_point(c(2,2))) transform(a, x1_sq = x1^2) transform(a, x1_x2 = x1*x2) } ================================================ FILE: man/valid.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/valid.R \name{valid} \alias{valid} \alias{st_is_valid} \alias{st_is_valid.sfc} \alias{st_is_valid.sf} \alias{st_is_valid.sfg} \alias{st_make_valid} \alias{st_make_valid.sfg} \alias{st_make_valid.sfc} \title{Check validity or make an invalid geometry valid} \usage{ st_is_valid(x, ...) \method{st_is_valid}{sfc}(x, ..., NA_on_exception = TRUE, reason = FALSE) \method{st_is_valid}{sf}(x, ...) \method{st_is_valid}{sfg}(x, ...) st_make_valid(x, ...) \method{st_make_valid}{sfg}(x, ...) \method{st_make_valid}{sfc}( x, ..., oriented = FALSE, s2_options = s2::s2_options(snap = s2::s2_snap_precision(1e+07), ...), geos_method = "valid_structure", geos_keep_collapsed = TRUE ) } \arguments{ \item{x}{object of class \code{sfg}, \code{sfc} or \code{sf}} \item{...}{passed on to \link[s2]{s2_options}} \item{NA_on_exception}{logical; if TRUE, for polygons that would otherwise raise a GEOS error (exception, e.g. for a POLYGON having more than zero but less than 4 points, or a LINESTRING having one point) return an \code{NA} rather than raising an error, and suppress warning messages (e.g. about self-intersection); if FALSE, regular GEOS errors and warnings will be emitted.} \item{reason}{logical; if \code{TRUE}, return a character with, for each geometry, the reason for invalidity, \code{NA} on exception, or \code{"Valid Geometry"} otherwise.} \item{oriented}{logical; only relevant if \code{st_is_longlat(x)} is \code{TRUE}; see \link{s2}} \item{s2_options}{only relevant if \code{st_is_longlat(x)} is \code{TRUE}; options for \link[s2]{s2_rebuild}, see \link[s2]{s2_options} and Details.} \item{geos_method}{character; either "valid_linework" (Original method, combines all rings into a set of noded lines and then extracts valid polygons from that linework) or "valid_structure" (Structured method, first makes all rings valid then merges shells and subtracts holes from shells to generate valid result. Assumes that holes and shells are correctly categorized.) (requires GEOS >= 3.10.1)} \item{geos_keep_collapsed}{logical; When this parameter is not set to \code{FALSE}, the "valid_structure" method will keep any component that has collapsed into a lower dimensionality. For example, a ring collapsing to a line, or a line collapsing to a point (requires GEOS >= 3.10.1)} } \value{ \code{st_is_valid} returns a logical vector indicating for each geometries of \code{x} whether it is valid. \code{st_make_valid} returns an object with a topologically valid geometry. Object of the same class as \code{x} } \description{ Checks whether a geometry is valid, or makes an invalid geometry valid } \details{ For projected geometries, \code{st_make_valid} uses the \code{lwgeom_makevalid} method also used by the PostGIS command \code{ST_makevalid} if the GEOS version linked to is smaller than 3.8.0, and otherwise the version shipped in GEOS; for geometries having ellipsoidal coordinates \code{s2::s2_rebuild} is being used. if \code{s2_options} is not specified and \code{x} has a non-zero precision set, then this precision value will be used as the value in \code{s2_snap_precision}, passed on to \code{s2_options}, rather than the 1e7 default. } \examples{ p1 = st_as_sfc("POLYGON((0 0, 0 10, 10 0, 10 10, 0 0))") st_is_valid(p1) st_is_valid(st_sfc(st_point(0:1), p1[[1]]), reason = TRUE) library(sf) x = st_sfc(st_polygon(list(rbind(c(0,0),c(0.5,0),c(0.5,0.5),c(0.5,0),c(1,0),c(1,1),c(0,1),c(0,0))))) suppressWarnings(st_is_valid(x)) y = st_make_valid(x) st_is_valid(y) y |> st_cast() } ================================================ FILE: sf.Rproj ================================================ Version: 1.0 RestoreWorkspace: No SaveWorkspace: No AlwaysSaveHistory: Default EnableCodeIndexing: Yes UseSpacesForTab: No NumSpacesForTab: 4 Encoding: UTF-8 RnwWeave: knitr LaTeX: XeLaTeX AutoAppendNewline: Yes BuildType: Package PackageUseDevtools: Yes PackageInstallArgs: --no-multiarch --with-keep.source PackageRoxygenize: rd,collate,namespace SpellingDictionary: en_US ================================================ FILE: src/Makevars.in ================================================ PKG_CPPFLAGS=@PKG_CPPFLAGS@ PKG_LIBS=@PKG_LIBS@ ================================================ FILE: src/Makevars.ucrt ================================================ PKG_CPPFLAGS = \ -DHAVE_PROJ_H ifeq (,$(shell pkg-config --version 2>/dev/null)) LIBSHARPYUV = $(or $(and $(wildcard $(R_TOOLS_SOFT)/lib/libsharpyuv.a),-lsharpyuv),) PKG_LIBS = \ -fopenmp -lgdal -larmadillo -lopenblas -lgfortran -lquadmath -lpq -lpgcommon -lpgport -lodbc32 -lodbccp32 -lblosc -lkea -lhdf5_cpp -lhdf5 -lpoppler -llcms2 -lfreetype -lharfbuzz -lfreetype -llz4 -lpcre2-8 -lxml2 -lopenjp2 -lnetcdf -lmysqlclient -lspatialite -lgeos_c -lgeos -lminizip -lgeos -ljson-c -lgta -lfreexl -lexpat -lssl -lpsapi -lgif -lmfhdf -lhdf5_hl -lcrypto -lportablexdr -ldf -lhdf5 -lsz -lpng16 -lpng -lpoppler -llcms2 -lfreetype -lharfbuzz -lfreetype -llz4 -lpcre2-8 -lpcre -lcurl -lbcrypt -lrtmp -lssl -lssh2 -lidn2 -lunistring -liconv -lgcrypt -lcrypto -lgpg-error -lws2_32 -ltiff -llzma -ljpeg -lz -lcfitsio -lzstd -lwebpdecoder -lwebp $(LIBSHARPYUV) -lsbml-static -lgeotiff -lproj -lsqlite3 -lbz2 -lcrypt32 -lwldap32 -lsecur32 else PKG_LIBS = $(shell pkg-config --libs gdal geos proj) endif all: clean winlibs winlibs: cp -r "$(R_TOOLS_SOFT)/share/gdal" ../inst/ cp -r "$(R_TOOLS_SOFT)/share/proj" ../inst/ clean: rm -f $(SHLIB) $(OBJECTS) .PHONY: all winlibs clean ================================================ FILE: src/Makevars.win ================================================ VERSION = 3.4.1 RWINLIB = ../windows/gdal3-$(VERSION) TARGET = lib$(subst gcc,,$(COMPILED_BY))$(R_ARCH) PKG_CPPFLAGS =\ -I$(RWINLIB)/include \ -DHAVE_PROJ_H PKG_LIBS = \ -L$(RWINLIB)/$(TARGET) \ -L$(RWINLIB)/lib$(R_ARCH) \ -lgdal -lsqlite3 -lspatialite -lproj -lgeos_c -lgeos \ -ljson-c -lnetcdf -lmariadbclient -lpq -lpgport -lpgcommon \ -lwebp -lcurl -lssh2 -lssl \ -lhdf5_hl -lhdf5 -lexpat -lfreexl -lcfitsio \ -lmfhdf -lhdf -lxdr -lpcre \ -lopenjp2 -ljasper -lpng -ljpeg -ltiff -lgeotiff -lgif -lxml2 -llzma -lz -lzstd \ -lodbc32 -lodbccp32 -liconv -lpsapi -lwldap32 -lsecur32 -lgdi32 -lnormaliz \ -lcrypto -lcrypt32 -lws2_32 -lshlwapi -lbcrypt all: clean winlibs winlibs: mkdir -p ../inst "${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" --vanilla "../tools/winlibs.R" $(VERSION) cp -r "$(RWINLIB)/share/gdal" ../inst/ cp -r "$(RWINLIB)/share/proj" ../inst/ clean: rm -f $(SHLIB) $(OBJECTS) .PHONY: all winlibs clean ================================================ FILE: src/RcppExports.cpp ================================================ // Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include "../inst/include/sf.h" #include #include #include using namespace Rcpp; #ifdef RCPP_USE_GLOBAL_ROSTREAM Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); #endif // CPL_get_bbox Rcpp::NumericVector CPL_get_bbox(Rcpp::List sf, int depth); RcppExport SEXP _sf_CPL_get_bbox(SEXP sfSEXP, SEXP depthSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sf(sfSEXP); Rcpp::traits::input_parameter< int >::type depth(depthSEXP); rcpp_result_gen = Rcpp::wrap(CPL_get_bbox(sf, depth)); return rcpp_result_gen; END_RCPP } // CPL_gdal_init void CPL_gdal_init(); RcppExport SEXP _sf_CPL_gdal_init() { BEGIN_RCPP CPL_gdal_init(); return R_NilValue; END_RCPP } // CPL_gdal_cleanup_all void CPL_gdal_cleanup_all(); RcppExport SEXP _sf_CPL_gdal_cleanup_all() { BEGIN_RCPP CPL_gdal_cleanup_all(); return R_NilValue; END_RCPP } // CPL_gdal_version const char* CPL_gdal_version(const char* what); RcppExport SEXP _sf_CPL_gdal_version(SEXP whatSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< const char* >::type what(whatSEXP); rcpp_result_gen = Rcpp::wrap(CPL_gdal_version(what)); return rcpp_result_gen; END_RCPP } // CPL_crs_parameters Rcpp::List CPL_crs_parameters(Rcpp::List crs); RcppExport SEXP _sf_CPL_crs_parameters(SEXP crsSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type crs(crsSEXP); rcpp_result_gen = Rcpp::wrap(CPL_crs_parameters(crs)); return rcpp_result_gen; END_RCPP } // CPL_crs_equivalent Rcpp::LogicalVector CPL_crs_equivalent(Rcpp::List crs1, Rcpp::List crs2); RcppExport SEXP _sf_CPL_crs_equivalent(SEXP crs1SEXP, SEXP crs2SEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type crs1(crs1SEXP); Rcpp::traits::input_parameter< Rcpp::List >::type crs2(crs2SEXP); rcpp_result_gen = Rcpp::wrap(CPL_crs_equivalent(crs1, crs2)); return rcpp_result_gen; END_RCPP } // CPL_crs_from_input Rcpp::List CPL_crs_from_input(Rcpp::CharacterVector input); RcppExport SEXP _sf_CPL_crs_from_input(SEXP inputSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type input(inputSEXP); rcpp_result_gen = Rcpp::wrap(CPL_crs_from_input(input)); return rcpp_result_gen; END_RCPP } // CPL_roundtrip Rcpp::List CPL_roundtrip(Rcpp::List sfc); RcppExport SEXP _sf_CPL_roundtrip(SEXP sfcSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); rcpp_result_gen = Rcpp::wrap(CPL_roundtrip(sfc)); return rcpp_result_gen; END_RCPP } // CPL_circularstring_to_linestring Rcpp::List CPL_circularstring_to_linestring(Rcpp::List sfc); RcppExport SEXP _sf_CPL_circularstring_to_linestring(SEXP sfcSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); rcpp_result_gen = Rcpp::wrap(CPL_circularstring_to_linestring(sfc)); return rcpp_result_gen; END_RCPP } // CPL_multisurface_to_multipolygon Rcpp::List CPL_multisurface_to_multipolygon(Rcpp::List sfc); RcppExport SEXP _sf_CPL_multisurface_to_multipolygon(SEXP sfcSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); rcpp_result_gen = Rcpp::wrap(CPL_multisurface_to_multipolygon(sfc)); return rcpp_result_gen; END_RCPP } // CPL_compoundcurve_to_linear Rcpp::List CPL_compoundcurve_to_linear(Rcpp::List sfc); RcppExport SEXP _sf_CPL_compoundcurve_to_linear(SEXP sfcSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); rcpp_result_gen = Rcpp::wrap(CPL_compoundcurve_to_linear(sfc)); return rcpp_result_gen; END_RCPP } // CPL_curve_to_linestring Rcpp::List CPL_curve_to_linestring(Rcpp::List sfc); RcppExport SEXP _sf_CPL_curve_to_linestring(SEXP sfcSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); rcpp_result_gen = Rcpp::wrap(CPL_curve_to_linestring(sfc)); return rcpp_result_gen; END_RCPP } // CPL_can_transform Rcpp::LogicalVector CPL_can_transform(Rcpp::List src, Rcpp::List dst); RcppExport SEXP _sf_CPL_can_transform(SEXP srcSEXP, SEXP dstSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type src(srcSEXP); Rcpp::traits::input_parameter< Rcpp::List >::type dst(dstSEXP); rcpp_result_gen = Rcpp::wrap(CPL_can_transform(src, dst)); return rcpp_result_gen; END_RCPP } // CPL_transform Rcpp::List CPL_transform(Rcpp::List sfc, Rcpp::List crs, Rcpp::NumericVector AOI, Rcpp::CharacterVector pipeline, bool reverse, double desired_accuracy, bool allow_ballpark); RcppExport SEXP _sf_CPL_transform(SEXP sfcSEXP, SEXP crsSEXP, SEXP AOISEXP, SEXP pipelineSEXP, SEXP reverseSEXP, SEXP desired_accuracySEXP, SEXP allow_ballparkSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); Rcpp::traits::input_parameter< Rcpp::List >::type crs(crsSEXP); Rcpp::traits::input_parameter< Rcpp::NumericVector >::type AOI(AOISEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type pipeline(pipelineSEXP); Rcpp::traits::input_parameter< bool >::type reverse(reverseSEXP); Rcpp::traits::input_parameter< double >::type desired_accuracy(desired_accuracySEXP); Rcpp::traits::input_parameter< bool >::type allow_ballpark(allow_ballparkSEXP); rcpp_result_gen = Rcpp::wrap(CPL_transform(sfc, crs, AOI, pipeline, reverse, desired_accuracy, allow_ballpark)); return rcpp_result_gen; END_RCPP } // CPL_transform_bounds Rcpp::NumericVector CPL_transform_bounds(Rcpp::NumericVector bb, Rcpp::List crs_dst, int densify_pts); RcppExport SEXP _sf_CPL_transform_bounds(SEXP bbSEXP, SEXP crs_dstSEXP, SEXP densify_ptsSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::NumericVector >::type bb(bbSEXP); Rcpp::traits::input_parameter< Rcpp::List >::type crs_dst(crs_dstSEXP); Rcpp::traits::input_parameter< int >::type densify_pts(densify_ptsSEXP); rcpp_result_gen = Rcpp::wrap(CPL_transform_bounds(bb, crs_dst, densify_pts)); return rcpp_result_gen; END_RCPP } // CPL_wrap_dateline Rcpp::List CPL_wrap_dateline(Rcpp::List sfc, Rcpp::CharacterVector opt, bool quiet); RcppExport SEXP _sf_CPL_wrap_dateline(SEXP sfcSEXP, SEXP optSEXP, SEXP quietSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type opt(optSEXP); Rcpp::traits::input_parameter< bool >::type quiet(quietSEXP); rcpp_result_gen = Rcpp::wrap(CPL_wrap_dateline(sfc, opt, quiet)); return rcpp_result_gen; END_RCPP } // CPL_get_gdal_drivers Rcpp::List CPL_get_gdal_drivers(int dummy); RcppExport SEXP _sf_CPL_get_gdal_drivers(SEXP dummySEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< int >::type dummy(dummySEXP); rcpp_result_gen = Rcpp::wrap(CPL_get_gdal_drivers(dummy)); return rcpp_result_gen; END_RCPP } // CPL_sfc_from_wkt Rcpp::List CPL_sfc_from_wkt(Rcpp::CharacterVector wkt); RcppExport SEXP _sf_CPL_sfc_from_wkt(SEXP wktSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type wkt(wktSEXP); rcpp_result_gen = Rcpp::wrap(CPL_sfc_from_wkt(wkt)); return rcpp_result_gen; END_RCPP } // CPL_gdal_with_geos Rcpp::LogicalVector CPL_gdal_with_geos(); RcppExport SEXP _sf_CPL_gdal_with_geos() { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; rcpp_result_gen = Rcpp::wrap(CPL_gdal_with_geos()); return rcpp_result_gen; END_RCPP } // CPL_axis_order_authority_compliant Rcpp::LogicalVector CPL_axis_order_authority_compliant(Rcpp::LogicalVector authority_compliant); RcppExport SEXP _sf_CPL_axis_order_authority_compliant(SEXP authority_compliantSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::LogicalVector >::type authority_compliant(authority_compliantSEXP); rcpp_result_gen = Rcpp::wrap(CPL_axis_order_authority_compliant(authority_compliant)); return rcpp_result_gen; END_RCPP } // CPL_compressors Rcpp::List CPL_compressors(); RcppExport SEXP _sf_CPL_compressors() { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; rcpp_result_gen = Rcpp::wrap(CPL_compressors()); return rcpp_result_gen; END_RCPP } // CPL_area Rcpp::NumericVector CPL_area(Rcpp::List sfc); RcppExport SEXP _sf_CPL_area(SEXP sfcSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); rcpp_result_gen = Rcpp::wrap(CPL_area(sfc)); return rcpp_result_gen; END_RCPP } // CPL_gdal_dimension Rcpp::IntegerVector CPL_gdal_dimension(Rcpp::List sfc, bool NA_if_empty); RcppExport SEXP _sf_CPL_gdal_dimension(SEXP sfcSEXP, SEXP NA_if_emptySEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); Rcpp::traits::input_parameter< bool >::type NA_if_empty(NA_if_emptySEXP); rcpp_result_gen = Rcpp::wrap(CPL_gdal_dimension(sfc, NA_if_empty)); return rcpp_result_gen; END_RCPP } // CPL_length Rcpp::NumericVector CPL_length(Rcpp::List sfc); RcppExport SEXP _sf_CPL_length(SEXP sfcSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); rcpp_result_gen = Rcpp::wrap(CPL_length(sfc)); return rcpp_result_gen; END_RCPP } // CPL_gdal_segmentize Rcpp::List CPL_gdal_segmentize(Rcpp::List sfc, double dfMaxLength); RcppExport SEXP _sf_CPL_gdal_segmentize(SEXP sfcSEXP, SEXP dfMaxLengthSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); Rcpp::traits::input_parameter< double >::type dfMaxLength(dfMaxLengthSEXP); rcpp_result_gen = Rcpp::wrap(CPL_gdal_segmentize(sfc, dfMaxLength)); return rcpp_result_gen; END_RCPP } // CPL_gdal_linestring_sample Rcpp::List CPL_gdal_linestring_sample(Rcpp::List sfc, Rcpp::List distLst); RcppExport SEXP _sf_CPL_gdal_linestring_sample(SEXP sfcSEXP, SEXP distLstSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); Rcpp::traits::input_parameter< Rcpp::List >::type distLst(distLstSEXP); rcpp_result_gen = Rcpp::wrap(CPL_gdal_linestring_sample(sfc, distLst)); return rcpp_result_gen; END_RCPP } // CPL_get_layers Rcpp::List CPL_get_layers(Rcpp::CharacterVector datasource, Rcpp::CharacterVector options, bool do_count); RcppExport SEXP _sf_CPL_get_layers(SEXP datasourceSEXP, SEXP optionsSEXP, SEXP do_countSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type datasource(datasourceSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< bool >::type do_count(do_countSEXP); rcpp_result_gen = Rcpp::wrap(CPL_get_layers(datasource, options, do_count)); return rcpp_result_gen; END_RCPP } // CPL_read_ogr Rcpp::List CPL_read_ogr(Rcpp::CharacterVector datasource, Rcpp::CharacterVector layer, Rcpp::CharacterVector query, Rcpp::CharacterVector options, bool quiet, Rcpp::NumericVector toTypeUser, Rcpp::CharacterVector fid_column_name, Rcpp::CharacterVector drivers, Rcpp::CharacterVector wkt_filter, bool promote_to_multi, bool int64_as_string, bool dsn_exists, bool dsn_isdb, int width); RcppExport SEXP _sf_CPL_read_ogr(SEXP datasourceSEXP, SEXP layerSEXP, SEXP querySEXP, SEXP optionsSEXP, SEXP quietSEXP, SEXP toTypeUserSEXP, SEXP fid_column_nameSEXP, SEXP driversSEXP, SEXP wkt_filterSEXP, SEXP promote_to_multiSEXP, SEXP int64_as_stringSEXP, SEXP dsn_existsSEXP, SEXP dsn_isdbSEXP, SEXP widthSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type datasource(datasourceSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type layer(layerSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type query(querySEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< bool >::type quiet(quietSEXP); Rcpp::traits::input_parameter< Rcpp::NumericVector >::type toTypeUser(toTypeUserSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type fid_column_name(fid_column_nameSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type drivers(driversSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type wkt_filter(wkt_filterSEXP); Rcpp::traits::input_parameter< bool >::type promote_to_multi(promote_to_multiSEXP); Rcpp::traits::input_parameter< bool >::type int64_as_string(int64_as_stringSEXP); Rcpp::traits::input_parameter< bool >::type dsn_exists(dsn_existsSEXP); Rcpp::traits::input_parameter< bool >::type dsn_isdb(dsn_isdbSEXP); Rcpp::traits::input_parameter< int >::type width(widthSEXP); rcpp_result_gen = Rcpp::wrap(CPL_read_ogr(datasource, layer, query, options, quiet, toTypeUser, fid_column_name, drivers, wkt_filter, promote_to_multi, int64_as_string, dsn_exists, dsn_isdb, width)); return rcpp_result_gen; END_RCPP } // CPL_read_gdal_stream Rcpp::List CPL_read_gdal_stream(Rcpp::RObject stream_xptr, Rcpp::CharacterVector datasource, Rcpp::CharacterVector layer, Rcpp::CharacterVector query, Rcpp::CharacterVector options, bool quiet, Rcpp::CharacterVector drivers, Rcpp::CharacterVector wkt_filter, bool dsn_exists, bool dsn_isdb, Rcpp::CharacterVector fid_column, int width); RcppExport SEXP _sf_CPL_read_gdal_stream(SEXP stream_xptrSEXP, SEXP datasourceSEXP, SEXP layerSEXP, SEXP querySEXP, SEXP optionsSEXP, SEXP quietSEXP, SEXP driversSEXP, SEXP wkt_filterSEXP, SEXP dsn_existsSEXP, SEXP dsn_isdbSEXP, SEXP fid_columnSEXP, SEXP widthSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::RObject >::type stream_xptr(stream_xptrSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type datasource(datasourceSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type layer(layerSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type query(querySEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< bool >::type quiet(quietSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type drivers(driversSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type wkt_filter(wkt_filterSEXP); Rcpp::traits::input_parameter< bool >::type dsn_exists(dsn_existsSEXP); Rcpp::traits::input_parameter< bool >::type dsn_isdb(dsn_isdbSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type fid_column(fid_columnSEXP); Rcpp::traits::input_parameter< int >::type width(widthSEXP); rcpp_result_gen = Rcpp::wrap(CPL_read_gdal_stream(stream_xptr, datasource, layer, query, options, quiet, drivers, wkt_filter, dsn_exists, dsn_isdb, fid_column, width)); return rcpp_result_gen; END_RCPP } // CPL_gdalinfo Rcpp::CharacterVector CPL_gdalinfo(Rcpp::CharacterVector obj, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co); RcppExport SEXP _sf_CPL_gdalinfo(SEXP objSEXP, SEXP optionsSEXP, SEXP ooSEXP, SEXP coSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type obj(objSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type oo(ooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type co(coSEXP); rcpp_result_gen = Rcpp::wrap(CPL_gdalinfo(obj, options, oo, co)); return rcpp_result_gen; END_RCPP } // CPL_ogrinfo Rcpp::CharacterVector CPL_ogrinfo(Rcpp::CharacterVector obj, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co, bool read_only); RcppExport SEXP _sf_CPL_ogrinfo(SEXP objSEXP, SEXP optionsSEXP, SEXP ooSEXP, SEXP coSEXP, SEXP read_onlySEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type obj(objSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type oo(ooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type co(coSEXP); Rcpp::traits::input_parameter< bool >::type read_only(read_onlySEXP); rcpp_result_gen = Rcpp::wrap(CPL_ogrinfo(obj, options, oo, co, read_only)); return rcpp_result_gen; END_RCPP } // CPL_gdaladdo Rcpp::LogicalVector CPL_gdaladdo(Rcpp::CharacterVector obj, Rcpp::CharacterVector method, Rcpp::IntegerVector overviews, Rcpp::IntegerVector bands, Rcpp::CharacterVector oo, Rcpp::CharacterVector co, bool clean, bool read_only); RcppExport SEXP _sf_CPL_gdaladdo(SEXP objSEXP, SEXP methodSEXP, SEXP overviewsSEXP, SEXP bandsSEXP, SEXP ooSEXP, SEXP coSEXP, SEXP cleanSEXP, SEXP read_onlySEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type obj(objSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type method(methodSEXP); Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type overviews(overviewsSEXP); Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type bands(bandsSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type oo(ooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type co(coSEXP); Rcpp::traits::input_parameter< bool >::type clean(cleanSEXP); Rcpp::traits::input_parameter< bool >::type read_only(read_onlySEXP); rcpp_result_gen = Rcpp::wrap(CPL_gdaladdo(obj, method, overviews, bands, oo, co, clean, read_only)); return rcpp_result_gen; END_RCPP } // CPL_gdalwarp Rcpp::LogicalVector CPL_gdalwarp(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector doo, Rcpp::CharacterVector co, bool quiet, bool overwrite); RcppExport SEXP _sf_CPL_gdalwarp(SEXP srcSEXP, SEXP dstSEXP, SEXP optionsSEXP, SEXP ooSEXP, SEXP dooSEXP, SEXP coSEXP, SEXP quietSEXP, SEXP overwriteSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type src(srcSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type dst(dstSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type oo(ooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type doo(dooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type co(coSEXP); Rcpp::traits::input_parameter< bool >::type quiet(quietSEXP); Rcpp::traits::input_parameter< bool >::type overwrite(overwriteSEXP); rcpp_result_gen = Rcpp::wrap(CPL_gdalwarp(src, dst, options, oo, doo, co, quiet, overwrite)); return rcpp_result_gen; END_RCPP } // CPL_gdalrasterize Rcpp::LogicalVector CPL_gdalrasterize(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector doo, Rcpp::CharacterVector co, bool overwrite, bool quiet); RcppExport SEXP _sf_CPL_gdalrasterize(SEXP srcSEXP, SEXP dstSEXP, SEXP optionsSEXP, SEXP ooSEXP, SEXP dooSEXP, SEXP coSEXP, SEXP overwriteSEXP, SEXP quietSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type src(srcSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type dst(dstSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type oo(ooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type doo(dooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type co(coSEXP); Rcpp::traits::input_parameter< bool >::type overwrite(overwriteSEXP); Rcpp::traits::input_parameter< bool >::type quiet(quietSEXP); rcpp_result_gen = Rcpp::wrap(CPL_gdalrasterize(src, dst, options, oo, doo, co, overwrite, quiet)); return rcpp_result_gen; END_RCPP } // CPL_gdaltranslate Rcpp::LogicalVector CPL_gdaltranslate(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co, bool quiet); RcppExport SEXP _sf_CPL_gdaltranslate(SEXP srcSEXP, SEXP dstSEXP, SEXP optionsSEXP, SEXP ooSEXP, SEXP coSEXP, SEXP quietSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type src(srcSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type dst(dstSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type oo(ooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type co(coSEXP); Rcpp::traits::input_parameter< bool >::type quiet(quietSEXP); rcpp_result_gen = Rcpp::wrap(CPL_gdaltranslate(src, dst, options, oo, co, quiet)); return rcpp_result_gen; END_RCPP } // CPL_gdalfootprint Rcpp::LogicalVector CPL_gdalfootprint(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co, bool quiet); RcppExport SEXP _sf_CPL_gdalfootprint(SEXP srcSEXP, SEXP dstSEXP, SEXP optionsSEXP, SEXP ooSEXP, SEXP coSEXP, SEXP quietSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type src(srcSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type dst(dstSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type oo(ooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type co(coSEXP); Rcpp::traits::input_parameter< bool >::type quiet(quietSEXP); rcpp_result_gen = Rcpp::wrap(CPL_gdalfootprint(src, dst, options, oo, co, quiet)); return rcpp_result_gen; END_RCPP } // CPL_gdalvectortranslate Rcpp::LogicalVector CPL_gdalvectortranslate(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector doo, Rcpp::CharacterVector co, bool quiet); RcppExport SEXP _sf_CPL_gdalvectortranslate(SEXP srcSEXP, SEXP dstSEXP, SEXP optionsSEXP, SEXP ooSEXP, SEXP dooSEXP, SEXP coSEXP, SEXP quietSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type src(srcSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type dst(dstSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type oo(ooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type doo(dooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type co(coSEXP); Rcpp::traits::input_parameter< bool >::type quiet(quietSEXP); rcpp_result_gen = Rcpp::wrap(CPL_gdalvectortranslate(src, dst, options, oo, doo, co, quiet)); return rcpp_result_gen; END_RCPP } // CPL_gdalbuildvrt Rcpp::LogicalVector CPL_gdalbuildvrt(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co, bool quiet); RcppExport SEXP _sf_CPL_gdalbuildvrt(SEXP srcSEXP, SEXP dstSEXP, SEXP optionsSEXP, SEXP ooSEXP, SEXP coSEXP, SEXP quietSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type src(srcSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type dst(dstSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type oo(ooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type co(coSEXP); Rcpp::traits::input_parameter< bool >::type quiet(quietSEXP); rcpp_result_gen = Rcpp::wrap(CPL_gdalbuildvrt(src, dst, options, oo, co, quiet)); return rcpp_result_gen; END_RCPP } // CPL_gdaldemprocessing Rcpp::LogicalVector CPL_gdaldemprocessing(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector processing, Rcpp::CharacterVector colorfilename, Rcpp::CharacterVector oo, Rcpp::CharacterVector co, bool quiet); RcppExport SEXP _sf_CPL_gdaldemprocessing(SEXP srcSEXP, SEXP dstSEXP, SEXP optionsSEXP, SEXP processingSEXP, SEXP colorfilenameSEXP, SEXP ooSEXP, SEXP coSEXP, SEXP quietSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type src(srcSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type dst(dstSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type processing(processingSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type colorfilename(colorfilenameSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type oo(ooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type co(coSEXP); Rcpp::traits::input_parameter< bool >::type quiet(quietSEXP); rcpp_result_gen = Rcpp::wrap(CPL_gdaldemprocessing(src, dst, options, processing, colorfilename, oo, co, quiet)); return rcpp_result_gen; END_RCPP } // CPL_gdalnearblack Rcpp::LogicalVector CPL_gdalnearblack(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector doo, Rcpp::CharacterVector co, bool quiet); RcppExport SEXP _sf_CPL_gdalnearblack(SEXP srcSEXP, SEXP dstSEXP, SEXP optionsSEXP, SEXP ooSEXP, SEXP dooSEXP, SEXP coSEXP, SEXP quietSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type src(srcSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type dst(dstSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type oo(ooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type doo(dooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type co(coSEXP); Rcpp::traits::input_parameter< bool >::type quiet(quietSEXP); rcpp_result_gen = Rcpp::wrap(CPL_gdalnearblack(src, dst, options, oo, doo, co, quiet)); return rcpp_result_gen; END_RCPP } // CPL_gdalgrid Rcpp::LogicalVector CPL_gdalgrid(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co, bool quiet); RcppExport SEXP _sf_CPL_gdalgrid(SEXP srcSEXP, SEXP dstSEXP, SEXP optionsSEXP, SEXP ooSEXP, SEXP coSEXP, SEXP quietSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type src(srcSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type dst(dstSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type oo(ooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type co(coSEXP); Rcpp::traits::input_parameter< bool >::type quiet(quietSEXP); rcpp_result_gen = Rcpp::wrap(CPL_gdalgrid(src, dst, options, oo, co, quiet)); return rcpp_result_gen; END_RCPP } // CPL_gdalmdiminfo Rcpp::CharacterVector CPL_gdalmdiminfo(Rcpp::CharacterVector obj, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co); RcppExport SEXP _sf_CPL_gdalmdiminfo(SEXP objSEXP, SEXP optionsSEXP, SEXP ooSEXP, SEXP coSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type obj(objSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type oo(ooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type co(coSEXP); rcpp_result_gen = Rcpp::wrap(CPL_gdalmdiminfo(obj, options, oo, co)); return rcpp_result_gen; END_RCPP } // CPL_gdalmdimtranslate Rcpp::LogicalVector CPL_gdalmdimtranslate(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co, bool quiet); RcppExport SEXP _sf_CPL_gdalmdimtranslate(SEXP srcSEXP, SEXP dstSEXP, SEXP optionsSEXP, SEXP ooSEXP, SEXP coSEXP, SEXP quietSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type src(srcSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type dst(dstSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type oo(ooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type co(coSEXP); Rcpp::traits::input_parameter< bool >::type quiet(quietSEXP); rcpp_result_gen = Rcpp::wrap(CPL_gdalmdimtranslate(src, dst, options, oo, co, quiet)); return rcpp_result_gen; END_RCPP } // CPL_gdal_warper Rcpp::LogicalVector CPL_gdal_warper(Rcpp::CharacterVector infile, Rcpp::CharacterVector outfile, Rcpp::IntegerVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector doo, Rcpp::CharacterVector co, bool quiet); RcppExport SEXP _sf_CPL_gdal_warper(SEXP infileSEXP, SEXP outfileSEXP, SEXP optionsSEXP, SEXP ooSEXP, SEXP dooSEXP, SEXP coSEXP, SEXP quietSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type infile(infileSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type outfile(outfileSEXP); Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type oo(ooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type doo(dooSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type co(coSEXP); Rcpp::traits::input_parameter< bool >::type quiet(quietSEXP); rcpp_result_gen = Rcpp::wrap(CPL_gdal_warper(infile, outfile, options, oo, doo, co, quiet)); return rcpp_result_gen; END_RCPP } // CPL_write_ogr int CPL_write_ogr(Rcpp::List obj, Rcpp::CharacterVector dsn, Rcpp::CharacterVector layer, Rcpp::CharacterVector driver, Rcpp::CharacterVector dco, Rcpp::CharacterVector lco, Rcpp::List geom, Rcpp::CharacterVector dim, Rcpp::CharacterVector fids, Rcpp::CharacterVector ConfigOptions, bool quiet, Rcpp::LogicalVector append, bool delete_dsn, bool delete_layer, bool write_geometries, int width); RcppExport SEXP _sf_CPL_write_ogr(SEXP objSEXP, SEXP dsnSEXP, SEXP layerSEXP, SEXP driverSEXP, SEXP dcoSEXP, SEXP lcoSEXP, SEXP geomSEXP, SEXP dimSEXP, SEXP fidsSEXP, SEXP ConfigOptionsSEXP, SEXP quietSEXP, SEXP appendSEXP, SEXP delete_dsnSEXP, SEXP delete_layerSEXP, SEXP write_geometriesSEXP, SEXP widthSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type obj(objSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type dsn(dsnSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type layer(layerSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type driver(driverSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type dco(dcoSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type lco(lcoSEXP); Rcpp::traits::input_parameter< Rcpp::List >::type geom(geomSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type dim(dimSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type fids(fidsSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type ConfigOptions(ConfigOptionsSEXP); Rcpp::traits::input_parameter< bool >::type quiet(quietSEXP); Rcpp::traits::input_parameter< Rcpp::LogicalVector >::type append(appendSEXP); Rcpp::traits::input_parameter< bool >::type delete_dsn(delete_dsnSEXP); Rcpp::traits::input_parameter< bool >::type delete_layer(delete_layerSEXP); Rcpp::traits::input_parameter< bool >::type write_geometries(write_geometriesSEXP); Rcpp::traits::input_parameter< int >::type width(widthSEXP); rcpp_result_gen = Rcpp::wrap(CPL_write_ogr(obj, dsn, layer, driver, dco, lco, geom, dim, fids, ConfigOptions, quiet, append, delete_dsn, delete_layer, write_geometries, width)); return rcpp_result_gen; END_RCPP } // CPL_delete_ogr int CPL_delete_ogr(Rcpp::CharacterVector dsn, Rcpp::CharacterVector layer, Rcpp::CharacterVector driver, bool quiet); RcppExport SEXP _sf_CPL_delete_ogr(SEXP dsnSEXP, SEXP layerSEXP, SEXP driverSEXP, SEXP quietSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type dsn(dsnSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type layer(layerSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type driver(driverSEXP); Rcpp::traits::input_parameter< bool >::type quiet(quietSEXP); rcpp_result_gen = Rcpp::wrap(CPL_delete_ogr(dsn, layer, driver, quiet)); return rcpp_result_gen; END_RCPP } // CPL_geos_binop Rcpp::List CPL_geos_binop(Rcpp::List sfc0, Rcpp::List sfc1, std::string op, double par, std::string pattern, bool prepared); RcppExport SEXP _sf_CPL_geos_binop(SEXP sfc0SEXP, SEXP sfc1SEXP, SEXP opSEXP, SEXP parSEXP, SEXP patternSEXP, SEXP preparedSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc0(sfc0SEXP); Rcpp::traits::input_parameter< Rcpp::List >::type sfc1(sfc1SEXP); Rcpp::traits::input_parameter< std::string >::type op(opSEXP); Rcpp::traits::input_parameter< double >::type par(parSEXP); Rcpp::traits::input_parameter< std::string >::type pattern(patternSEXP); Rcpp::traits::input_parameter< bool >::type prepared(preparedSEXP); rcpp_result_gen = Rcpp::wrap(CPL_geos_binop(sfc0, sfc1, op, par, pattern, prepared)); return rcpp_result_gen; END_RCPP } // CPL_geos_binop_by_element Rcpp::List CPL_geos_binop_by_element(Rcpp::List sfc0, Rcpp::List sfc1, std::string op, double par, std::string pattern, bool prepared); RcppExport SEXP _sf_CPL_geos_binop_by_element(SEXP sfc0SEXP, SEXP sfc1SEXP, SEXP opSEXP, SEXP parSEXP, SEXP patternSEXP, SEXP preparedSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc0(sfc0SEXP); Rcpp::traits::input_parameter< Rcpp::List >::type sfc1(sfc1SEXP); Rcpp::traits::input_parameter< std::string >::type op(opSEXP); Rcpp::traits::input_parameter< double >::type par(parSEXP); Rcpp::traits::input_parameter< std::string >::type pattern(patternSEXP); Rcpp::traits::input_parameter< bool >::type prepared(preparedSEXP); rcpp_result_gen = Rcpp::wrap(CPL_geos_binop_by_element(sfc0, sfc1, op, par, pattern, prepared)); return rcpp_result_gen; END_RCPP } // CPL_geos_is_valid_reason Rcpp::CharacterVector CPL_geos_is_valid_reason(Rcpp::List sfc); RcppExport SEXP _sf_CPL_geos_is_valid_reason(SEXP sfcSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); rcpp_result_gen = Rcpp::wrap(CPL_geos_is_valid_reason(sfc)); return rcpp_result_gen; END_RCPP } // CPL_geos_make_valid Rcpp::List CPL_geos_make_valid(Rcpp::List sfc, std::string method, bool keep_collapsed); RcppExport SEXP _sf_CPL_geos_make_valid(SEXP sfcSEXP, SEXP methodSEXP, SEXP keep_collapsedSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); Rcpp::traits::input_parameter< std::string >::type method(methodSEXP); Rcpp::traits::input_parameter< bool >::type keep_collapsed(keep_collapsedSEXP); rcpp_result_gen = Rcpp::wrap(CPL_geos_make_valid(sfc, method, keep_collapsed)); return rcpp_result_gen; END_RCPP } // CPL_geos_is_valid Rcpp::LogicalVector CPL_geos_is_valid(Rcpp::List sfc, bool NA_on_exception); RcppExport SEXP _sf_CPL_geos_is_valid(SEXP sfcSEXP, SEXP NA_on_exceptionSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); Rcpp::traits::input_parameter< bool >::type NA_on_exception(NA_on_exceptionSEXP); rcpp_result_gen = Rcpp::wrap(CPL_geos_is_valid(sfc, NA_on_exception)); return rcpp_result_gen; END_RCPP } // CPL_geos_is_simple Rcpp::LogicalVector CPL_geos_is_simple(Rcpp::List sfc); RcppExport SEXP _sf_CPL_geos_is_simple(SEXP sfcSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); rcpp_result_gen = Rcpp::wrap(CPL_geos_is_simple(sfc)); return rcpp_result_gen; END_RCPP } // CPL_geos_is_empty Rcpp::LogicalVector CPL_geos_is_empty(Rcpp::List sfc); RcppExport SEXP _sf_CPL_geos_is_empty(SEXP sfcSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); rcpp_result_gen = Rcpp::wrap(CPL_geos_is_empty(sfc)); return rcpp_result_gen; END_RCPP } // CPL_geos_normalize Rcpp::List CPL_geos_normalize(Rcpp::List sfc); RcppExport SEXP _sf_CPL_geos_normalize(SEXP sfcSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); rcpp_result_gen = Rcpp::wrap(CPL_geos_normalize(sfc)); return rcpp_result_gen; END_RCPP } // CPL_geos_union Rcpp::List CPL_geos_union(Rcpp::List sfc, bool by_feature, bool is_coverage); RcppExport SEXP _sf_CPL_geos_union(SEXP sfcSEXP, SEXP by_featureSEXP, SEXP is_coverageSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); Rcpp::traits::input_parameter< bool >::type by_feature(by_featureSEXP); Rcpp::traits::input_parameter< bool >::type is_coverage(is_coverageSEXP); rcpp_result_gen = Rcpp::wrap(CPL_geos_union(sfc, by_feature, is_coverage)); return rcpp_result_gen; END_RCPP } // CPL_geos_snap Rcpp::List CPL_geos_snap(Rcpp::List sfc0, Rcpp::List sfc1, Rcpp::NumericVector tolerance); RcppExport SEXP _sf_CPL_geos_snap(SEXP sfc0SEXP, SEXP sfc1SEXP, SEXP toleranceSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc0(sfc0SEXP); Rcpp::traits::input_parameter< Rcpp::List >::type sfc1(sfc1SEXP); Rcpp::traits::input_parameter< Rcpp::NumericVector >::type tolerance(toleranceSEXP); rcpp_result_gen = Rcpp::wrap(CPL_geos_snap(sfc0, sfc1, tolerance)); return rcpp_result_gen; END_RCPP } // CPL_geos_op Rcpp::List CPL_geos_op(std::string op, Rcpp::List sfc, Rcpp::NumericVector bufferDist, Rcpp::IntegerVector nQuadSegs, Rcpp::NumericVector dTolerance, Rcpp::LogicalVector preserveTopology, int bOnlyEdges, Rcpp::IntegerVector endCapStyle, Rcpp::IntegerVector joinStyle, Rcpp::NumericVector mitreLimit, Rcpp::LogicalVector singleside); RcppExport SEXP _sf_CPL_geos_op(SEXP opSEXP, SEXP sfcSEXP, SEXP bufferDistSEXP, SEXP nQuadSegsSEXP, SEXP dToleranceSEXP, SEXP preserveTopologySEXP, SEXP bOnlyEdgesSEXP, SEXP endCapStyleSEXP, SEXP joinStyleSEXP, SEXP mitreLimitSEXP, SEXP singlesideSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< std::string >::type op(opSEXP); Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); Rcpp::traits::input_parameter< Rcpp::NumericVector >::type bufferDist(bufferDistSEXP); Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type nQuadSegs(nQuadSegsSEXP); Rcpp::traits::input_parameter< Rcpp::NumericVector >::type dTolerance(dToleranceSEXP); Rcpp::traits::input_parameter< Rcpp::LogicalVector >::type preserveTopology(preserveTopologySEXP); Rcpp::traits::input_parameter< int >::type bOnlyEdges(bOnlyEdgesSEXP); Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type endCapStyle(endCapStyleSEXP); Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type joinStyle(joinStyleSEXP); Rcpp::traits::input_parameter< Rcpp::NumericVector >::type mitreLimit(mitreLimitSEXP); Rcpp::traits::input_parameter< Rcpp::LogicalVector >::type singleside(singlesideSEXP); rcpp_result_gen = Rcpp::wrap(CPL_geos_op(op, sfc, bufferDist, nQuadSegs, dTolerance, preserveTopology, bOnlyEdges, endCapStyle, joinStyle, mitreLimit, singleside)); return rcpp_result_gen; END_RCPP } // CPL_geos_voronoi Rcpp::List CPL_geos_voronoi(Rcpp::List sfc, Rcpp::List env, double dTolerance, int bOnlyEdges); RcppExport SEXP _sf_CPL_geos_voronoi(SEXP sfcSEXP, SEXP envSEXP, SEXP dToleranceSEXP, SEXP bOnlyEdgesSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); Rcpp::traits::input_parameter< Rcpp::List >::type env(envSEXP); Rcpp::traits::input_parameter< double >::type dTolerance(dToleranceSEXP); Rcpp::traits::input_parameter< int >::type bOnlyEdges(bOnlyEdgesSEXP); rcpp_result_gen = Rcpp::wrap(CPL_geos_voronoi(sfc, env, dTolerance, bOnlyEdges)); return rcpp_result_gen; END_RCPP } // CPL_geos_op2 Rcpp::List CPL_geos_op2(std::string op, Rcpp::List sfcx, Rcpp::List sfcy); RcppExport SEXP _sf_CPL_geos_op2(SEXP opSEXP, SEXP sfcxSEXP, SEXP sfcySEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< std::string >::type op(opSEXP); Rcpp::traits::input_parameter< Rcpp::List >::type sfcx(sfcxSEXP); Rcpp::traits::input_parameter< Rcpp::List >::type sfcy(sfcySEXP); rcpp_result_gen = Rcpp::wrap(CPL_geos_op2(op, sfcx, sfcy)); return rcpp_result_gen; END_RCPP } // CPL_geos_dist_by_element Rcpp::NumericVector CPL_geos_dist_by_element(Rcpp::List sfc0, Rcpp::List sfc1, std::string which, double par); RcppExport SEXP _sf_CPL_geos_dist_by_element(SEXP sfc0SEXP, SEXP sfc1SEXP, SEXP whichSEXP, SEXP parSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc0(sfc0SEXP); Rcpp::traits::input_parameter< Rcpp::List >::type sfc1(sfc1SEXP); Rcpp::traits::input_parameter< std::string >::type which(whichSEXP); Rcpp::traits::input_parameter< double >::type par(parSEXP); rcpp_result_gen = Rcpp::wrap(CPL_geos_dist_by_element(sfc0, sfc1, which, par)); return rcpp_result_gen; END_RCPP } // CPL_geos_version std::string CPL_geos_version(bool runtime, bool capi); RcppExport SEXP _sf_CPL_geos_version(SEXP runtimeSEXP, SEXP capiSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< bool >::type runtime(runtimeSEXP); Rcpp::traits::input_parameter< bool >::type capi(capiSEXP); rcpp_result_gen = Rcpp::wrap(CPL_geos_version(runtime, capi)); return rcpp_result_gen; END_RCPP } // CPL_geos_op2_by_element Rcpp::List CPL_geos_op2_by_element(std::string op, Rcpp::List sfcx, Rcpp::List sfcy); RcppExport SEXP _sf_CPL_geos_op2_by_element(SEXP opSEXP, SEXP sfcxSEXP, SEXP sfcySEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< std::string >::type op(opSEXP); Rcpp::traits::input_parameter< Rcpp::List >::type sfcx(sfcxSEXP); Rcpp::traits::input_parameter< Rcpp::List >::type sfcy(sfcySEXP); rcpp_result_gen = Rcpp::wrap(CPL_geos_op2_by_element(op, sfcx, sfcy)); return rcpp_result_gen; END_RCPP } // CPL_geos_dist Rcpp::NumericMatrix CPL_geos_dist(Rcpp::List sfc0, Rcpp::List sfc1, Rcpp::CharacterVector which, double par); RcppExport SEXP _sf_CPL_geos_dist(SEXP sfc0SEXP, SEXP sfc1SEXP, SEXP whichSEXP, SEXP parSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc0(sfc0SEXP); Rcpp::traits::input_parameter< Rcpp::List >::type sfc1(sfc1SEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type which(whichSEXP); Rcpp::traits::input_parameter< double >::type par(parSEXP); rcpp_result_gen = Rcpp::wrap(CPL_geos_dist(sfc0, sfc1, which, par)); return rcpp_result_gen; END_RCPP } // CPL_geos_nearest_feature Rcpp::IntegerVector CPL_geos_nearest_feature(Rcpp::List sfc0, Rcpp::List sfc1); RcppExport SEXP _sf_CPL_geos_nearest_feature(SEXP sfc0SEXP, SEXP sfc1SEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc0(sfc0SEXP); Rcpp::traits::input_parameter< Rcpp::List >::type sfc1(sfc1SEXP); rcpp_result_gen = Rcpp::wrap(CPL_geos_nearest_feature(sfc0, sfc1)); return rcpp_result_gen; END_RCPP } // CPL_geos_nearest_points Rcpp::List CPL_geos_nearest_points(Rcpp::List sfc0, Rcpp::List sfc1, bool pairwise); RcppExport SEXP _sf_CPL_geos_nearest_points(SEXP sfc0SEXP, SEXP sfc1SEXP, SEXP pairwiseSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc0(sfc0SEXP); Rcpp::traits::input_parameter< Rcpp::List >::type sfc1(sfc1SEXP); Rcpp::traits::input_parameter< bool >::type pairwise(pairwiseSEXP); rcpp_result_gen = Rcpp::wrap(CPL_geos_nearest_points(sfc0, sfc1, pairwise)); return rcpp_result_gen; END_RCPP } // CPL_transpose_sparse_incidence Rcpp::List CPL_transpose_sparse_incidence(Rcpp::List m, int n); RcppExport SEXP _sf_CPL_transpose_sparse_incidence(SEXP mSEXP, SEXP nSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type m(mSEXP); Rcpp::traits::input_parameter< int >::type n(nSEXP); rcpp_result_gen = Rcpp::wrap(CPL_transpose_sparse_incidence(m, n)); return rcpp_result_gen; END_RCPP } // CPL_nary_difference Rcpp::List CPL_nary_difference(Rcpp::List sfc); RcppExport SEXP _sf_CPL_nary_difference(SEXP sfcSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); rcpp_result_gen = Rcpp::wrap(CPL_nary_difference(sfc)); return rcpp_result_gen; END_RCPP } // CPL_nary_intersection Rcpp::List CPL_nary_intersection(Rcpp::List sfc); RcppExport SEXP _sf_CPL_nary_intersection(SEXP sfcSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); rcpp_result_gen = Rcpp::wrap(CPL_nary_intersection(sfc)); return rcpp_result_gen; END_RCPP } // CPL_line_project Rcpp::NumericVector CPL_line_project(Rcpp::List lines, Rcpp::List points, bool normalized); RcppExport SEXP _sf_CPL_line_project(SEXP linesSEXP, SEXP pointsSEXP, SEXP normalizedSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type lines(linesSEXP); Rcpp::traits::input_parameter< Rcpp::List >::type points(pointsSEXP); Rcpp::traits::input_parameter< bool >::type normalized(normalizedSEXP); rcpp_result_gen = Rcpp::wrap(CPL_line_project(lines, points, normalized)); return rcpp_result_gen; END_RCPP } // CPL_line_interpolate Rcpp::List CPL_line_interpolate(Rcpp::List lines, Rcpp::NumericVector dists, bool normalized); RcppExport SEXP _sf_CPL_line_interpolate(SEXP linesSEXP, SEXP distsSEXP, SEXP normalizedSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type lines(linesSEXP); Rcpp::traits::input_parameter< Rcpp::NumericVector >::type dists(distsSEXP); Rcpp::traits::input_parameter< bool >::type normalized(normalizedSEXP); rcpp_result_gen = Rcpp::wrap(CPL_line_interpolate(lines, dists, normalized)); return rcpp_result_gen; END_RCPP } // CPL_hex_to_raw Rcpp::List CPL_hex_to_raw(Rcpp::CharacterVector cx); RcppExport SEXP _sf_CPL_hex_to_raw(SEXP cxSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type cx(cxSEXP); rcpp_result_gen = Rcpp::wrap(CPL_hex_to_raw(cx)); return rcpp_result_gen; END_RCPP } // CPL_raw_to_hex Rcpp::CharacterVector CPL_raw_to_hex(Rcpp::RawVector raw); RcppExport SEXP _sf_CPL_raw_to_hex(SEXP rawSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::RawVector >::type raw(rawSEXP); rcpp_result_gen = Rcpp::wrap(CPL_raw_to_hex(raw)); return rcpp_result_gen; END_RCPP } // CPL_read_mdim List CPL_read_mdim(CharacterVector file, CharacterVector array_names, CharacterVector oo, IntegerVector offset, IntegerVector count, IntegerVector step, bool proxy, bool debug); RcppExport SEXP _sf_CPL_read_mdim(SEXP fileSEXP, SEXP array_namesSEXP, SEXP ooSEXP, SEXP offsetSEXP, SEXP countSEXP, SEXP stepSEXP, SEXP proxySEXP, SEXP debugSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< CharacterVector >::type file(fileSEXP); Rcpp::traits::input_parameter< CharacterVector >::type array_names(array_namesSEXP); Rcpp::traits::input_parameter< CharacterVector >::type oo(ooSEXP); Rcpp::traits::input_parameter< IntegerVector >::type offset(offsetSEXP); Rcpp::traits::input_parameter< IntegerVector >::type count(countSEXP); Rcpp::traits::input_parameter< IntegerVector >::type step(stepSEXP); Rcpp::traits::input_parameter< bool >::type proxy(proxySEXP); Rcpp::traits::input_parameter< bool >::type debug(debugSEXP); rcpp_result_gen = Rcpp::wrap(CPL_read_mdim(file, array_names, oo, offset, count, step, proxy, debug)); return rcpp_result_gen; END_RCPP } // CPL_write_mdim List CPL_write_mdim(CharacterVector name, CharacterVector driver, IntegerVector dimensions, List variables, CharacterVector wkt, CharacterVector xy, CharacterVector RootGroupOptions, CharacterVector CreationOptions, bool as_float); RcppExport SEXP _sf_CPL_write_mdim(SEXP nameSEXP, SEXP driverSEXP, SEXP dimensionsSEXP, SEXP variablesSEXP, SEXP wktSEXP, SEXP xySEXP, SEXP RootGroupOptionsSEXP, SEXP CreationOptionsSEXP, SEXP as_floatSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< CharacterVector >::type name(nameSEXP); Rcpp::traits::input_parameter< CharacterVector >::type driver(driverSEXP); Rcpp::traits::input_parameter< IntegerVector >::type dimensions(dimensionsSEXP); Rcpp::traits::input_parameter< List >::type variables(variablesSEXP); Rcpp::traits::input_parameter< CharacterVector >::type wkt(wktSEXP); Rcpp::traits::input_parameter< CharacterVector >::type xy(xySEXP); Rcpp::traits::input_parameter< CharacterVector >::type RootGroupOptions(RootGroupOptionsSEXP); Rcpp::traits::input_parameter< CharacterVector >::type CreationOptions(CreationOptionsSEXP); Rcpp::traits::input_parameter< bool >::type as_float(as_floatSEXP); rcpp_result_gen = Rcpp::wrap(CPL_write_mdim(name, driver, dimensions, variables, wkt, xy, RootGroupOptions, CreationOptions, as_float)); return rcpp_result_gen; END_RCPP } // opp_sfc SEXP opp_sfc(SEXP geom, SEXP value, SEXP mult, SEXP crs); RcppExport SEXP _sf_opp_sfc(SEXP geomSEXP, SEXP valueSEXP, SEXP multSEXP, SEXP crsSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< SEXP >::type geom(geomSEXP); Rcpp::traits::input_parameter< SEXP >::type value(valueSEXP); Rcpp::traits::input_parameter< SEXP >::type mult(multSEXP); Rcpp::traits::input_parameter< SEXP >::type crs(crsSEXP); rcpp_result_gen = Rcpp::wrap(opp_sfc(geom, value, mult, crs)); return rcpp_result_gen; END_RCPP } // normalize_sfc SEXP normalize_sfc(SEXP geom, SEXP min, SEXP range, SEXP crs); RcppExport SEXP _sf_normalize_sfc(SEXP geomSEXP, SEXP minSEXP, SEXP rangeSEXP, SEXP crsSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< SEXP >::type geom(geomSEXP); Rcpp::traits::input_parameter< SEXP >::type min(minSEXP); Rcpp::traits::input_parameter< SEXP >::type range(rangeSEXP); Rcpp::traits::input_parameter< SEXP >::type crs(crsSEXP); rcpp_result_gen = Rcpp::wrap(normalize_sfc(geom, min, range, crs)); return rcpp_result_gen; END_RCPP } // CPL_polygonize Rcpp::List CPL_polygonize(Rcpp::CharacterVector raster, Rcpp::CharacterVector mask_name, Rcpp::CharacterVector raster_driver, Rcpp::CharacterVector vector_driver, Rcpp::CharacterVector vector_dsn, Rcpp::CharacterVector options, Rcpp::IntegerVector iPixValField, Rcpp::CharacterVector contour_options, bool use_contours, bool use_integer); RcppExport SEXP _sf_CPL_polygonize(SEXP rasterSEXP, SEXP mask_nameSEXP, SEXP raster_driverSEXP, SEXP vector_driverSEXP, SEXP vector_dsnSEXP, SEXP optionsSEXP, SEXP iPixValFieldSEXP, SEXP contour_optionsSEXP, SEXP use_contoursSEXP, SEXP use_integerSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type raster(rasterSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type mask_name(mask_nameSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type raster_driver(raster_driverSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type vector_driver(vector_driverSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type vector_dsn(vector_dsnSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type iPixValField(iPixValFieldSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type contour_options(contour_optionsSEXP); Rcpp::traits::input_parameter< bool >::type use_contours(use_contoursSEXP); Rcpp::traits::input_parameter< bool >::type use_integer(use_integerSEXP); rcpp_result_gen = Rcpp::wrap(CPL_polygonize(raster, mask_name, raster_driver, vector_driver, vector_dsn, options, iPixValField, contour_options, use_contours, use_integer)); return rcpp_result_gen; END_RCPP } // CPL_rasterize Rcpp::List CPL_rasterize(Rcpp::CharacterVector raster, Rcpp::CharacterVector raster_driver, Rcpp::List sfc, Rcpp::NumericVector values, Rcpp::CharacterVector options, Rcpp::NumericVector NA_value); RcppExport SEXP _sf_CPL_rasterize(SEXP rasterSEXP, SEXP raster_driverSEXP, SEXP sfcSEXP, SEXP valuesSEXP, SEXP optionsSEXP, SEXP NA_valueSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type raster(rasterSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type raster_driver(raster_driverSEXP); Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); Rcpp::traits::input_parameter< Rcpp::NumericVector >::type values(valuesSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< Rcpp::NumericVector >::type NA_value(NA_valueSEXP); rcpp_result_gen = Rcpp::wrap(CPL_rasterize(raster, raster_driver, sfc, values, options, NA_value)); return rcpp_result_gen; END_RCPP } // CPL_proj_h Rcpp::LogicalVector CPL_proj_h(bool b); RcppExport SEXP _sf_CPL_proj_h(SEXP bSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< bool >::type b(bSEXP); rcpp_result_gen = Rcpp::wrap(CPL_proj_h(b)); return rcpp_result_gen; END_RCPP } // CPL_get_pipelines Rcpp::DataFrame CPL_get_pipelines(Rcpp::CharacterVector crs, Rcpp::CharacterVector authority, Rcpp::NumericVector AOI, Rcpp::CharacterVector Use, Rcpp::CharacterVector grid_availability, double accuracy, bool strict_containment, bool axis_order_auth_compl); RcppExport SEXP _sf_CPL_get_pipelines(SEXP crsSEXP, SEXP authoritySEXP, SEXP AOISEXP, SEXP UseSEXP, SEXP grid_availabilitySEXP, SEXP accuracySEXP, SEXP strict_containmentSEXP, SEXP axis_order_auth_complSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type crs(crsSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type authority(authoritySEXP); Rcpp::traits::input_parameter< Rcpp::NumericVector >::type AOI(AOISEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type Use(UseSEXP); Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type grid_availability(grid_availabilitySEXP); Rcpp::traits::input_parameter< double >::type accuracy(accuracySEXP); Rcpp::traits::input_parameter< bool >::type strict_containment(strict_containmentSEXP); Rcpp::traits::input_parameter< bool >::type axis_order_auth_compl(axis_order_auth_complSEXP); rcpp_result_gen = Rcpp::wrap(CPL_get_pipelines(crs, authority, AOI, Use, grid_availability, accuracy, strict_containment, axis_order_auth_compl)); return rcpp_result_gen; END_RCPP } // CPL_get_data_dir Rcpp::CharacterVector CPL_get_data_dir(bool from_proj); RcppExport SEXP _sf_CPL_get_data_dir(SEXP from_projSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< bool >::type from_proj(from_projSEXP); rcpp_result_gen = Rcpp::wrap(CPL_get_data_dir(from_proj)); return rcpp_result_gen; END_RCPP } // CPL_is_network_enabled Rcpp::LogicalVector CPL_is_network_enabled(bool b); RcppExport SEXP _sf_CPL_is_network_enabled(SEXP bSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< bool >::type b(bSEXP); rcpp_result_gen = Rcpp::wrap(CPL_is_network_enabled(b)); return rcpp_result_gen; END_RCPP } // CPL_enable_network Rcpp::CharacterVector CPL_enable_network(Rcpp::CharacterVector url, bool enable); RcppExport SEXP _sf_CPL_enable_network(SEXP urlSEXP, SEXP enableSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type url(urlSEXP); Rcpp::traits::input_parameter< bool >::type enable(enableSEXP); rcpp_result_gen = Rcpp::wrap(CPL_enable_network(url, enable)); return rcpp_result_gen; END_RCPP } // CPL_set_data_dir Rcpp::LogicalVector CPL_set_data_dir(Rcpp::CharacterVector data_dir, bool with_proj); RcppExport SEXP _sf_CPL_set_data_dir(SEXP data_dirSEXP, SEXP with_projSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type data_dir(data_dirSEXP); Rcpp::traits::input_parameter< bool >::type with_proj(with_projSEXP); rcpp_result_gen = Rcpp::wrap(CPL_set_data_dir(data_dir, with_proj)); return rcpp_result_gen; END_RCPP } // CPL_use_proj4_init_rules Rcpp::LogicalVector CPL_use_proj4_init_rules(Rcpp::IntegerVector v); RcppExport SEXP _sf_CPL_use_proj4_init_rules(SEXP vSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type v(vSEXP); rcpp_result_gen = Rcpp::wrap(CPL_use_proj4_init_rules(v)); return rcpp_result_gen; END_RCPP } // CPL_proj_version std::string CPL_proj_version(bool b); RcppExport SEXP _sf_CPL_proj_version(SEXP bSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< bool >::type b(bSEXP); rcpp_result_gen = Rcpp::wrap(CPL_proj_version(b)); return rcpp_result_gen; END_RCPP } // CPL_proj_is_valid Rcpp::List CPL_proj_is_valid(std::string proj4string); RcppExport SEXP _sf_CPL_proj_is_valid(SEXP proj4stringSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< std::string >::type proj4string(proj4stringSEXP); rcpp_result_gen = Rcpp::wrap(CPL_proj_is_valid(proj4string)); return rcpp_result_gen; END_RCPP } // CPL_have_datum_files bool CPL_have_datum_files(SEXP foo); RcppExport SEXP _sf_CPL_have_datum_files(SEXP fooSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< SEXP >::type foo(fooSEXP); rcpp_result_gen = Rcpp::wrap(CPL_have_datum_files(foo)); return rcpp_result_gen; END_RCPP } // CPL_proj_direct Rcpp::NumericMatrix CPL_proj_direct(Rcpp::CharacterVector from_to, Rcpp::NumericMatrix pts, bool keep, bool warn, bool authority_compliant); RcppExport SEXP _sf_CPL_proj_direct(SEXP from_toSEXP, SEXP ptsSEXP, SEXP keepSEXP, SEXP warnSEXP, SEXP authority_compliantSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type from_to(from_toSEXP); Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type pts(ptsSEXP); Rcpp::traits::input_parameter< bool >::type keep(keepSEXP); Rcpp::traits::input_parameter< bool >::type warn(warnSEXP); Rcpp::traits::input_parameter< bool >::type authority_compliant(authority_compliantSEXP); rcpp_result_gen = Rcpp::wrap(CPL_proj_direct(from_to, pts, keep, warn, authority_compliant)); return rcpp_result_gen; END_RCPP } // CPL_proj_info Rcpp::List CPL_proj_info(int type); RcppExport SEXP _sf_CPL_proj_info(SEXP typeSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< int >::type type(typeSEXP); rcpp_result_gen = Rcpp::wrap(CPL_proj_info(type)); return rcpp_result_gen; END_RCPP } // CPL_xy2sfc List CPL_xy2sfc(NumericMatrix cc, IntegerVector dim, bool to_points, IntegerVector which, bool cc_has_NAs); RcppExport SEXP _sf_CPL_xy2sfc(SEXP ccSEXP, SEXP dimSEXP, SEXP to_pointsSEXP, SEXP whichSEXP, SEXP cc_has_NAsSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< NumericMatrix >::type cc(ccSEXP); Rcpp::traits::input_parameter< IntegerVector >::type dim(dimSEXP); Rcpp::traits::input_parameter< bool >::type to_points(to_pointsSEXP); Rcpp::traits::input_parameter< IntegerVector >::type which(whichSEXP); Rcpp::traits::input_parameter< bool >::type cc_has_NAs(cc_has_NAsSEXP); rcpp_result_gen = Rcpp::wrap(CPL_xy2sfc(cc, dim, to_points, which, cc_has_NAs)); return rcpp_result_gen; END_RCPP } // sfc_is_null LogicalVector sfc_is_null(List sfc); RcppExport SEXP _sf_sfc_is_null(SEXP sfcSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< List >::type sfc(sfcSEXP); rcpp_result_gen = Rcpp::wrap(sfc_is_null(sfc)); return rcpp_result_gen; END_RCPP } // sfc_unique_sfg_dims_and_types List sfc_unique_sfg_dims_and_types(List sfc); RcppExport SEXP _sf_sfc_unique_sfg_dims_and_types(SEXP sfcSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< List >::type sfc(sfcSEXP); rcpp_result_gen = Rcpp::wrap(sfc_unique_sfg_dims_and_types(sfc)); return rcpp_result_gen; END_RCPP } // sfc_is_empty LogicalVector sfc_is_empty(List sfc); RcppExport SEXP _sf_sfc_is_empty(SEXP sfcSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< List >::type sfc(sfcSEXP); rcpp_result_gen = Rcpp::wrap(sfc_is_empty(sfc)); return rcpp_result_gen; END_RCPP } // sfc_is_full LogicalVector sfc_is_full(List sfc); RcppExport SEXP _sf_sfc_is_full(SEXP sfcSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< List >::type sfc(sfcSEXP); rcpp_result_gen = Rcpp::wrap(sfc_is_full(sfc)); return rcpp_result_gen; END_RCPP } // points_cpp List points_cpp(NumericMatrix pts, CharacterVector gdim); RcppExport SEXP _sf_points_cpp(SEXP ptsSEXP, SEXP gdimSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< NumericMatrix >::type pts(ptsSEXP); Rcpp::traits::input_parameter< CharacterVector >::type gdim(gdimSEXP); rcpp_result_gen = Rcpp::wrap(points_cpp(pts, gdim)); return rcpp_result_gen; END_RCPP } // CPL_signed_area double CPL_signed_area(NumericMatrix pts); RcppExport SEXP _sf_CPL_signed_area(SEXP ptsSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< NumericMatrix >::type pts(ptsSEXP); rcpp_result_gen = Rcpp::wrap(CPL_signed_area(pts)); return rcpp_result_gen; END_RCPP } // CPL_get_metadata CharacterVector CPL_get_metadata(CharacterVector obj, CharacterVector domain_item, CharacterVector options); RcppExport SEXP _sf_CPL_get_metadata(SEXP objSEXP, SEXP domain_itemSEXP, SEXP optionsSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< CharacterVector >::type obj(objSEXP); Rcpp::traits::input_parameter< CharacterVector >::type domain_item(domain_itemSEXP); Rcpp::traits::input_parameter< CharacterVector >::type options(optionsSEXP); rcpp_result_gen = Rcpp::wrap(CPL_get_metadata(obj, domain_item, options)); return rcpp_result_gen; END_RCPP } // CPL_get_crs List CPL_get_crs(CharacterVector obj, CharacterVector options); RcppExport SEXP _sf_CPL_get_crs(SEXP objSEXP, SEXP optionsSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< CharacterVector >::type obj(objSEXP); Rcpp::traits::input_parameter< CharacterVector >::type options(optionsSEXP); rcpp_result_gen = Rcpp::wrap(CPL_get_crs(obj, options)); return rcpp_result_gen; END_RCPP } // CPL_inv_geotransform NumericVector CPL_inv_geotransform(NumericVector gt_r); RcppExport SEXP _sf_CPL_inv_geotransform(SEXP gt_rSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< NumericVector >::type gt_r(gt_rSEXP); rcpp_result_gen = Rcpp::wrap(CPL_inv_geotransform(gt_r)); return rcpp_result_gen; END_RCPP } // CPL_read_gdal List CPL_read_gdal(CharacterVector fname, CharacterVector options, CharacterVector driver, bool read_data, NumericVector NA_value, List RasterIO_parameters, double max_cells); RcppExport SEXP _sf_CPL_read_gdal(SEXP fnameSEXP, SEXP optionsSEXP, SEXP driverSEXP, SEXP read_dataSEXP, SEXP NA_valueSEXP, SEXP RasterIO_parametersSEXP, SEXP max_cellsSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< CharacterVector >::type fname(fnameSEXP); Rcpp::traits::input_parameter< CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< CharacterVector >::type driver(driverSEXP); Rcpp::traits::input_parameter< bool >::type read_data(read_dataSEXP); Rcpp::traits::input_parameter< NumericVector >::type NA_value(NA_valueSEXP); Rcpp::traits::input_parameter< List >::type RasterIO_parameters(RasterIO_parametersSEXP); Rcpp::traits::input_parameter< double >::type max_cells(max_cellsSEXP); rcpp_result_gen = Rcpp::wrap(CPL_read_gdal(fname, options, driver, read_data, NA_value, RasterIO_parameters, max_cells)); return rcpp_result_gen; END_RCPP } // CPL_write_gdal void CPL_write_gdal(NumericMatrix x, CharacterVector fname, CharacterVector driver, CharacterVector options, CharacterVector Type, IntegerVector dims, IntegerVector from, NumericVector gt, CharacterVector p4s, NumericVector na_val, NumericVector scale_offset, bool create, bool only_create); RcppExport SEXP _sf_CPL_write_gdal(SEXP xSEXP, SEXP fnameSEXP, SEXP driverSEXP, SEXP optionsSEXP, SEXP TypeSEXP, SEXP dimsSEXP, SEXP fromSEXP, SEXP gtSEXP, SEXP p4sSEXP, SEXP na_valSEXP, SEXP scale_offsetSEXP, SEXP createSEXP, SEXP only_createSEXP) { BEGIN_RCPP Rcpp::traits::input_parameter< NumericMatrix >::type x(xSEXP); Rcpp::traits::input_parameter< CharacterVector >::type fname(fnameSEXP); Rcpp::traits::input_parameter< CharacterVector >::type driver(driverSEXP); Rcpp::traits::input_parameter< CharacterVector >::type options(optionsSEXP); Rcpp::traits::input_parameter< CharacterVector >::type Type(TypeSEXP); Rcpp::traits::input_parameter< IntegerVector >::type dims(dimsSEXP); Rcpp::traits::input_parameter< IntegerVector >::type from(fromSEXP); Rcpp::traits::input_parameter< NumericVector >::type gt(gtSEXP); Rcpp::traits::input_parameter< CharacterVector >::type p4s(p4sSEXP); Rcpp::traits::input_parameter< NumericVector >::type na_val(na_valSEXP); Rcpp::traits::input_parameter< NumericVector >::type scale_offset(scale_offsetSEXP); Rcpp::traits::input_parameter< bool >::type create(createSEXP); Rcpp::traits::input_parameter< bool >::type only_create(only_createSEXP); CPL_write_gdal(x, fname, driver, options, Type, dims, from, gt, p4s, na_val, scale_offset, create, only_create); return R_NilValue; END_RCPP } // CPL_extract NumericMatrix CPL_extract(CharacterVector input, NumericMatrix xy, CharacterVector interpolate); RcppExport SEXP _sf_CPL_extract(SEXP inputSEXP, SEXP xySEXP, SEXP interpolateSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< CharacterVector >::type input(inputSEXP); Rcpp::traits::input_parameter< NumericMatrix >::type xy(xySEXP); Rcpp::traits::input_parameter< CharacterVector >::type interpolate(interpolateSEXP); rcpp_result_gen = Rcpp::wrap(CPL_extract(input, xy, interpolate)); return rcpp_result_gen; END_RCPP } // CPL_create void CPL_create(CharacterVector file, IntegerVector nxy, NumericVector value, CharacterVector wkt, NumericVector xlim, NumericVector ylim); RcppExport SEXP _sf_CPL_create(SEXP fileSEXP, SEXP nxySEXP, SEXP valueSEXP, SEXP wktSEXP, SEXP xlimSEXP, SEXP ylimSEXP) { BEGIN_RCPP Rcpp::traits::input_parameter< CharacterVector >::type file(fileSEXP); Rcpp::traits::input_parameter< IntegerVector >::type nxy(nxySEXP); Rcpp::traits::input_parameter< NumericVector >::type value(valueSEXP); Rcpp::traits::input_parameter< CharacterVector >::type wkt(wktSEXP); Rcpp::traits::input_parameter< NumericVector >::type xlim(xlimSEXP); Rcpp::traits::input_parameter< NumericVector >::type ylim(ylimSEXP); CPL_create(file, nxy, value, wkt, xlim, ylim); return R_NilValue; END_RCPP } // CPL_read_wkb Rcpp::List CPL_read_wkb(Rcpp::List wkb_list, bool EWKB, bool spatialite); static SEXP _sf_CPL_read_wkb_try(SEXP wkb_listSEXP, SEXP EWKBSEXP, SEXP spatialiteSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type wkb_list(wkb_listSEXP); Rcpp::traits::input_parameter< bool >::type EWKB(EWKBSEXP); Rcpp::traits::input_parameter< bool >::type spatialite(spatialiteSEXP); rcpp_result_gen = Rcpp::wrap(CPL_read_wkb(wkb_list, EWKB, spatialite)); return rcpp_result_gen; END_RCPP_RETURN_ERROR } RcppExport SEXP _sf_CPL_read_wkb(SEXP wkb_listSEXP, SEXP EWKBSEXP, SEXP spatialiteSEXP) { SEXP rcpp_result_gen; { rcpp_result_gen = PROTECT(_sf_CPL_read_wkb_try(wkb_listSEXP, EWKBSEXP, spatialiteSEXP)); } Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error"); if (rcpp_isInterrupt_gen) { UNPROTECT(1); Rf_onintr(); } bool rcpp_isLongjump_gen = Rcpp::internal::isLongjumpSentinel(rcpp_result_gen); if (rcpp_isLongjump_gen) { Rcpp::internal::resumeJump(rcpp_result_gen); } Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error"); if (rcpp_isError_gen) { SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen); UNPROTECT(1); (Rf_error)("%s", CHAR(rcpp_msgSEXP_gen)); } UNPROTECT(1); return rcpp_result_gen; } // CPL_write_wkb Rcpp::List CPL_write_wkb(Rcpp::List sfc, bool EWKB); static SEXP _sf_CPL_write_wkb_try(SEXP sfcSEXP, SEXP EWKBSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sfc(sfcSEXP); Rcpp::traits::input_parameter< bool >::type EWKB(EWKBSEXP); rcpp_result_gen = Rcpp::wrap(CPL_write_wkb(sfc, EWKB)); return rcpp_result_gen; END_RCPP_RETURN_ERROR } RcppExport SEXP _sf_CPL_write_wkb(SEXP sfcSEXP, SEXP EWKBSEXP) { SEXP rcpp_result_gen; { rcpp_result_gen = PROTECT(_sf_CPL_write_wkb_try(sfcSEXP, EWKBSEXP)); } Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error"); if (rcpp_isInterrupt_gen) { UNPROTECT(1); Rf_onintr(); } bool rcpp_isLongjump_gen = Rcpp::internal::isLongjumpSentinel(rcpp_result_gen); if (rcpp_isLongjump_gen) { Rcpp::internal::resumeJump(rcpp_result_gen); } Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error"); if (rcpp_isError_gen) { SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen); UNPROTECT(1); (Rf_error)("%s", CHAR(rcpp_msgSEXP_gen)); } UNPROTECT(1); return rcpp_result_gen; } // CPL_get_z_range Rcpp::NumericVector CPL_get_z_range(Rcpp::List sf, int depth); RcppExport SEXP _sf_CPL_get_z_range(SEXP sfSEXP, SEXP depthSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sf(sfSEXP); Rcpp::traits::input_parameter< int >::type depth(depthSEXP); rcpp_result_gen = Rcpp::wrap(CPL_get_z_range(sf, depth)); return rcpp_result_gen; END_RCPP } // CPL_get_m_range Rcpp::NumericVector CPL_get_m_range(Rcpp::List sf, int depth); RcppExport SEXP _sf_CPL_get_m_range(SEXP sfSEXP, SEXP depthSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Rcpp::List >::type sf(sfSEXP); Rcpp::traits::input_parameter< int >::type depth(depthSEXP); rcpp_result_gen = Rcpp::wrap(CPL_get_m_range(sf, depth)); return rcpp_result_gen; END_RCPP } // validate (ensure exported C++ functions exist before calling them) static int _sf_RcppExport_validate(const char* sig) { static std::set signatures; if (signatures.empty()) { signatures.insert("Rcpp::List(*CPL_read_wkb)(Rcpp::List,bool,bool)"); signatures.insert("Rcpp::List(*CPL_write_wkb)(Rcpp::List,bool)"); } return signatures.find(sig) != signatures.end(); } // registerCCallable (register entry points for exported C++ functions) RcppExport SEXP _sf_RcppExport_registerCCallable() { R_RegisterCCallable("sf", "_sf_CPL_read_wkb", (DL_FUNC)_sf_CPL_read_wkb_try); R_RegisterCCallable("sf", "_sf_CPL_write_wkb", (DL_FUNC)_sf_CPL_write_wkb_try); R_RegisterCCallable("sf", "_sf_RcppExport_validate", (DL_FUNC)_sf_RcppExport_validate); return R_NilValue; } static const R_CallMethodDef CallEntries[] = { {"_sf_CPL_get_bbox", (DL_FUNC) &_sf_CPL_get_bbox, 2}, {"_sf_CPL_gdal_init", (DL_FUNC) &_sf_CPL_gdal_init, 0}, {"_sf_CPL_gdal_cleanup_all", (DL_FUNC) &_sf_CPL_gdal_cleanup_all, 0}, {"_sf_CPL_gdal_version", (DL_FUNC) &_sf_CPL_gdal_version, 1}, {"_sf_CPL_crs_parameters", (DL_FUNC) &_sf_CPL_crs_parameters, 1}, {"_sf_CPL_crs_equivalent", (DL_FUNC) &_sf_CPL_crs_equivalent, 2}, {"_sf_CPL_crs_from_input", (DL_FUNC) &_sf_CPL_crs_from_input, 1}, {"_sf_CPL_roundtrip", (DL_FUNC) &_sf_CPL_roundtrip, 1}, {"_sf_CPL_circularstring_to_linestring", (DL_FUNC) &_sf_CPL_circularstring_to_linestring, 1}, {"_sf_CPL_multisurface_to_multipolygon", (DL_FUNC) &_sf_CPL_multisurface_to_multipolygon, 1}, {"_sf_CPL_compoundcurve_to_linear", (DL_FUNC) &_sf_CPL_compoundcurve_to_linear, 1}, {"_sf_CPL_curve_to_linestring", (DL_FUNC) &_sf_CPL_curve_to_linestring, 1}, {"_sf_CPL_can_transform", (DL_FUNC) &_sf_CPL_can_transform, 2}, {"_sf_CPL_transform", (DL_FUNC) &_sf_CPL_transform, 7}, {"_sf_CPL_transform_bounds", (DL_FUNC) &_sf_CPL_transform_bounds, 3}, {"_sf_CPL_wrap_dateline", (DL_FUNC) &_sf_CPL_wrap_dateline, 3}, {"_sf_CPL_get_gdal_drivers", (DL_FUNC) &_sf_CPL_get_gdal_drivers, 1}, {"_sf_CPL_sfc_from_wkt", (DL_FUNC) &_sf_CPL_sfc_from_wkt, 1}, {"_sf_CPL_gdal_with_geos", (DL_FUNC) &_sf_CPL_gdal_with_geos, 0}, {"_sf_CPL_axis_order_authority_compliant", (DL_FUNC) &_sf_CPL_axis_order_authority_compliant, 1}, {"_sf_CPL_compressors", (DL_FUNC) &_sf_CPL_compressors, 0}, {"_sf_CPL_area", (DL_FUNC) &_sf_CPL_area, 1}, {"_sf_CPL_gdal_dimension", (DL_FUNC) &_sf_CPL_gdal_dimension, 2}, {"_sf_CPL_length", (DL_FUNC) &_sf_CPL_length, 1}, {"_sf_CPL_gdal_segmentize", (DL_FUNC) &_sf_CPL_gdal_segmentize, 2}, {"_sf_CPL_gdal_linestring_sample", (DL_FUNC) &_sf_CPL_gdal_linestring_sample, 2}, {"_sf_CPL_get_layers", (DL_FUNC) &_sf_CPL_get_layers, 3}, {"_sf_CPL_read_ogr", (DL_FUNC) &_sf_CPL_read_ogr, 14}, {"_sf_CPL_read_gdal_stream", (DL_FUNC) &_sf_CPL_read_gdal_stream, 12}, {"_sf_CPL_gdalinfo", (DL_FUNC) &_sf_CPL_gdalinfo, 4}, {"_sf_CPL_ogrinfo", (DL_FUNC) &_sf_CPL_ogrinfo, 5}, {"_sf_CPL_gdaladdo", (DL_FUNC) &_sf_CPL_gdaladdo, 8}, {"_sf_CPL_gdalwarp", (DL_FUNC) &_sf_CPL_gdalwarp, 8}, {"_sf_CPL_gdalrasterize", (DL_FUNC) &_sf_CPL_gdalrasterize, 8}, {"_sf_CPL_gdaltranslate", (DL_FUNC) &_sf_CPL_gdaltranslate, 6}, {"_sf_CPL_gdalfootprint", (DL_FUNC) &_sf_CPL_gdalfootprint, 6}, {"_sf_CPL_gdalvectortranslate", (DL_FUNC) &_sf_CPL_gdalvectortranslate, 7}, {"_sf_CPL_gdalbuildvrt", (DL_FUNC) &_sf_CPL_gdalbuildvrt, 6}, {"_sf_CPL_gdaldemprocessing", (DL_FUNC) &_sf_CPL_gdaldemprocessing, 8}, {"_sf_CPL_gdalnearblack", (DL_FUNC) &_sf_CPL_gdalnearblack, 7}, {"_sf_CPL_gdalgrid", (DL_FUNC) &_sf_CPL_gdalgrid, 6}, {"_sf_CPL_gdalmdiminfo", (DL_FUNC) &_sf_CPL_gdalmdiminfo, 4}, {"_sf_CPL_gdalmdimtranslate", (DL_FUNC) &_sf_CPL_gdalmdimtranslate, 6}, {"_sf_CPL_gdal_warper", (DL_FUNC) &_sf_CPL_gdal_warper, 7}, {"_sf_CPL_write_ogr", (DL_FUNC) &_sf_CPL_write_ogr, 16}, {"_sf_CPL_delete_ogr", (DL_FUNC) &_sf_CPL_delete_ogr, 4}, {"_sf_CPL_geos_binop", (DL_FUNC) &_sf_CPL_geos_binop, 6}, {"_sf_CPL_geos_binop_by_element", (DL_FUNC) &_sf_CPL_geos_binop_by_element, 6}, {"_sf_CPL_geos_is_valid_reason", (DL_FUNC) &_sf_CPL_geos_is_valid_reason, 1}, {"_sf_CPL_geos_make_valid", (DL_FUNC) &_sf_CPL_geos_make_valid, 3}, {"_sf_CPL_geos_is_valid", (DL_FUNC) &_sf_CPL_geos_is_valid, 2}, {"_sf_CPL_geos_is_simple", (DL_FUNC) &_sf_CPL_geos_is_simple, 1}, {"_sf_CPL_geos_is_empty", (DL_FUNC) &_sf_CPL_geos_is_empty, 1}, {"_sf_CPL_geos_normalize", (DL_FUNC) &_sf_CPL_geos_normalize, 1}, {"_sf_CPL_geos_union", (DL_FUNC) &_sf_CPL_geos_union, 3}, {"_sf_CPL_geos_snap", (DL_FUNC) &_sf_CPL_geos_snap, 3}, {"_sf_CPL_geos_op", (DL_FUNC) &_sf_CPL_geos_op, 11}, {"_sf_CPL_geos_voronoi", (DL_FUNC) &_sf_CPL_geos_voronoi, 4}, {"_sf_CPL_geos_op2", (DL_FUNC) &_sf_CPL_geos_op2, 3}, {"_sf_CPL_geos_dist_by_element", (DL_FUNC) &_sf_CPL_geos_dist_by_element, 4}, {"_sf_CPL_geos_version", (DL_FUNC) &_sf_CPL_geos_version, 2}, {"_sf_CPL_geos_op2_by_element", (DL_FUNC) &_sf_CPL_geos_op2_by_element, 3}, {"_sf_CPL_geos_dist", (DL_FUNC) &_sf_CPL_geos_dist, 4}, {"_sf_CPL_geos_nearest_feature", (DL_FUNC) &_sf_CPL_geos_nearest_feature, 2}, {"_sf_CPL_geos_nearest_points", (DL_FUNC) &_sf_CPL_geos_nearest_points, 3}, {"_sf_CPL_transpose_sparse_incidence", (DL_FUNC) &_sf_CPL_transpose_sparse_incidence, 2}, {"_sf_CPL_nary_difference", (DL_FUNC) &_sf_CPL_nary_difference, 1}, {"_sf_CPL_nary_intersection", (DL_FUNC) &_sf_CPL_nary_intersection, 1}, {"_sf_CPL_line_project", (DL_FUNC) &_sf_CPL_line_project, 3}, {"_sf_CPL_line_interpolate", (DL_FUNC) &_sf_CPL_line_interpolate, 3}, {"_sf_CPL_hex_to_raw", (DL_FUNC) &_sf_CPL_hex_to_raw, 1}, {"_sf_CPL_raw_to_hex", (DL_FUNC) &_sf_CPL_raw_to_hex, 1}, {"_sf_CPL_read_mdim", (DL_FUNC) &_sf_CPL_read_mdim, 8}, {"_sf_CPL_write_mdim", (DL_FUNC) &_sf_CPL_write_mdim, 9}, {"_sf_opp_sfc", (DL_FUNC) &_sf_opp_sfc, 4}, {"_sf_normalize_sfc", (DL_FUNC) &_sf_normalize_sfc, 4}, {"_sf_CPL_polygonize", (DL_FUNC) &_sf_CPL_polygonize, 10}, {"_sf_CPL_rasterize", (DL_FUNC) &_sf_CPL_rasterize, 6}, {"_sf_CPL_proj_h", (DL_FUNC) &_sf_CPL_proj_h, 1}, {"_sf_CPL_get_pipelines", (DL_FUNC) &_sf_CPL_get_pipelines, 8}, {"_sf_CPL_get_data_dir", (DL_FUNC) &_sf_CPL_get_data_dir, 1}, {"_sf_CPL_is_network_enabled", (DL_FUNC) &_sf_CPL_is_network_enabled, 1}, {"_sf_CPL_enable_network", (DL_FUNC) &_sf_CPL_enable_network, 2}, {"_sf_CPL_set_data_dir", (DL_FUNC) &_sf_CPL_set_data_dir, 2}, {"_sf_CPL_use_proj4_init_rules", (DL_FUNC) &_sf_CPL_use_proj4_init_rules, 1}, {"_sf_CPL_proj_version", (DL_FUNC) &_sf_CPL_proj_version, 1}, {"_sf_CPL_proj_is_valid", (DL_FUNC) &_sf_CPL_proj_is_valid, 1}, {"_sf_CPL_have_datum_files", (DL_FUNC) &_sf_CPL_have_datum_files, 1}, {"_sf_CPL_proj_direct", (DL_FUNC) &_sf_CPL_proj_direct, 5}, {"_sf_CPL_proj_info", (DL_FUNC) &_sf_CPL_proj_info, 1}, {"_sf_CPL_xy2sfc", (DL_FUNC) &_sf_CPL_xy2sfc, 5}, {"_sf_sfc_is_null", (DL_FUNC) &_sf_sfc_is_null, 1}, {"_sf_sfc_unique_sfg_dims_and_types", (DL_FUNC) &_sf_sfc_unique_sfg_dims_and_types, 1}, {"_sf_sfc_is_empty", (DL_FUNC) &_sf_sfc_is_empty, 1}, {"_sf_sfc_is_full", (DL_FUNC) &_sf_sfc_is_full, 1}, {"_sf_points_cpp", (DL_FUNC) &_sf_points_cpp, 2}, {"_sf_CPL_signed_area", (DL_FUNC) &_sf_CPL_signed_area, 1}, {"_sf_CPL_get_metadata", (DL_FUNC) &_sf_CPL_get_metadata, 3}, {"_sf_CPL_get_crs", (DL_FUNC) &_sf_CPL_get_crs, 2}, {"_sf_CPL_inv_geotransform", (DL_FUNC) &_sf_CPL_inv_geotransform, 1}, {"_sf_CPL_read_gdal", (DL_FUNC) &_sf_CPL_read_gdal, 7}, {"_sf_CPL_write_gdal", (DL_FUNC) &_sf_CPL_write_gdal, 13}, {"_sf_CPL_extract", (DL_FUNC) &_sf_CPL_extract, 3}, {"_sf_CPL_create", (DL_FUNC) &_sf_CPL_create, 6}, {"_sf_CPL_read_wkb", (DL_FUNC) &_sf_CPL_read_wkb, 3}, {"_sf_CPL_write_wkb", (DL_FUNC) &_sf_CPL_write_wkb, 2}, {"_sf_CPL_get_z_range", (DL_FUNC) &_sf_CPL_get_z_range, 2}, {"_sf_CPL_get_m_range", (DL_FUNC) &_sf_CPL_get_m_range, 2}, {"_sf_RcppExport_registerCCallable", (DL_FUNC) &_sf_RcppExport_registerCCallable, 0}, {NULL, NULL, 0} }; RcppExport void R_init_sf(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } ================================================ FILE: src/bbox.cpp ================================================ #include #include "bbox.h" // [[Rcpp::export(rng=false)]] Rcpp::NumericVector CPL_get_bbox(Rcpp::List sf, int depth = 0) { Rcpp::NumericVector bb(4); bb[0] = bb[1] = bb[2] = bb[3] = NA_REAL; auto n = sf.size(); switch(depth) { case 0: // points: for (decltype(n) i = 0; i < n; i++) { Rcpp::NumericVector pt = sf[i]; if (i == 0) { bb[0] = bb[2] = pt[0]; bb[1] = bb[3] = pt[1]; } else { bb[0] = std::min(pt[0],bb[0]); bb[1] = std::min(pt[1],bb[1]); bb[2] = std::max(pt[0],bb[2]); bb[3] = std::max(pt[1],bb[3]); } } break; case 1: { // list of matrices: bool initialised = false; for (decltype(n) i = 0; i < n; i++) { Rcpp::NumericMatrix m = sf[i]; auto rows = m.nrow(); if (rows > 0) { // non-empty: if (! initialised) { // initialize: bb[0] = bb[2] = m(0,0); bb[1] = bb[3] = m(0,1); initialised = true; } for (decltype(rows) j = 0; j < rows; j++) { bb[0] = std::min(m(j,0),bb[0]); bb[1] = std::min(m(j,1),bb[1]); bb[2] = std::max(m(j,0),bb[2]); bb[3] = std::max(m(j,1),bb[3]); } } } } break; default: // recursive list for (decltype(n) i = 0; i < n; i++) { Rcpp::NumericVector bbi = CPL_get_bbox(sf[i], depth - 1); // recurse if (! Rcpp::NumericVector::is_na(bbi[0])) { if (i == 0) { bb[0] = bbi[0]; bb[1] = bbi[1]; bb[2] = bbi[2]; bb[3] = bbi[3]; } else { bb[0] = std::min(bbi[0],bb[0]); bb[1] = std::min(bbi[1],bb[1]); bb[2] = std::max(bbi[2],bb[2]); bb[3] = std::max(bbi[3],bb[3]); } } } break; } return bb; } ================================================ FILE: src/bbox.h ================================================ #ifndef SF_BBOX_H_ #define SF_BBOX_H_ Rcpp::NumericVector CPL_get_bbox(Rcpp::List sf, int depth); #endif // SF_BBOX_H_ ================================================ FILE: src/gdal.cpp ================================================ #include #include #include #include // GDALDriver #include #include #include #include #include #include #if GDAL_VERSION_NUM >= 3040000 #include #endif #include // atoi #include #include #include "gdal.h" #include "wkb.h" #include "gdal_sf_pkg.h" // global variable: bool axis_order_authority_compliant = false; // // Returns errors to R // Note only case 4 actually returns immediately // Lower error codes are recoverable // static void __err_handler(CPLErr eErrClass, int err_no, const char *msg) { switch ( eErrClass ) { case 0: break; // #nocov case 1: case 2: Rf_warning("GDAL Message %d: %s\n", err_no, msg); // #nocov break; // #nocov case 3: Rf_warning("GDAL Error %d: %s\n", err_no, msg); break; case 4: Rf_warning("GDAL Error %d: %s\n", err_no, msg); // #nocov Rcpp::stop("Unrecoverable GDAL error\n"); // #nocov break; default: Rf_warning("Received invalid error class %d (errno %d: %s)\n", eErrClass, err_no, msg); // #nocov break; // #nocov } return; } // #nocov start static void __err_silent(CPLErr eErrClass, int err_no, const char *msg) { return; } // #nocov end void set_error_handler(void) { CPLSetErrorHandler((CPLErrorHandler)__err_handler); } void unset_error_handler(void) { CPLSetErrorHandler((CPLErrorHandler)__err_silent); } // [[Rcpp::export(rng=false)]] void CPL_gdal_init() { CPLSetErrorHandler((CPLErrorHandler)__err_handler); CPLSetConfigOption("GDAL_NETCDF_REPORT_EXTRA_DIM_VALUES", "YES"); GDALAllRegister(); OGRRegisterAll(); } // #nocov start // [[Rcpp::export(rng=false)]] void CPL_gdal_cleanup_all() { OGRCleanupAll(); OSRCleanup(); } // #nocov end // [[Rcpp::export(rng=false)]] const char* CPL_gdal_version(const char* what = "RELEASE_NAME") { return GDALVersionInfo(what); } void handle_error(OGRErr err) { if (err != OGRERR_NONE) { switch (err) { case OGRERR_NOT_ENOUGH_DATA: Rcpp::Rcout << "OGR: Not enough data " << std::endl; // #nocov break; // #nocov case OGRERR_UNSUPPORTED_GEOMETRY_TYPE: Rcpp::Rcout << "OGR: Unsupported geometry type" << std::endl; break; case OGRERR_CORRUPT_DATA: Rcpp::Rcout << "OGR: Corrupt data" << std::endl; // #nocov break; // #nocov case OGRERR_FAILURE: Rcpp::Rcout << "OGR: index invalid?" << std::endl; // #nocov break; // #nocov default: Rcpp::Rcout << "Error code: " << err << std::endl; // #nocov } Rcpp::stop("OGR error"); } } void set_config_options(Rcpp::CharacterVector ConfigOptions) { if (ConfigOptions.size()) { if (ConfigOptions.attr("names") == R_NilValue) Rcpp::stop("config_options should be a character vector with names, as in c(key=\"value\")"); Rcpp::CharacterVector names = ConfigOptions.attr("names"); for (int i = 0; i < ConfigOptions.size(); i++) CPLSetConfigOption(names[i], ConfigOptions[i]); } } void unset_config_options(Rcpp::CharacterVector ConfigOptions) { if (ConfigOptions.size()) { Rcpp::CharacterVector names = ConfigOptions.attr("names"); for (int i = 0; i < ConfigOptions.size(); i++) CPLSetConfigOption(names[i], NULL); } } Rcpp::CharacterVector wkt_from_spatial_reference(const OGRSpatialReference *srs) { // FIXME: add options? char *cp; #if GDAL_VERSION_NUM >= 3000000 const char *options[3] = { "MULTILINE=YES", "FORMAT=WKT2", NULL }; OGRErr err = srs->exportToWkt(&cp, options); #else OGRErr err = srs->exportToPrettyWkt(&cp); #endif if (err != OGRERR_NONE) Rcpp::stop("OGR error: cannot export to WKT"); // #nocov Rcpp::CharacterVector out(cp); CPLFree(cp); return out; } Rcpp::List fix_old_style(Rcpp::List crs) { if (crs.attr("names") == R_NilValue) Rcpp::stop("invalid crs object: no names"); Rcpp::CharacterVector n = crs.attr("names"); if (n.length() != 2) Rcpp::stop("invalid crs object: wrong length"); if (n[0] == "epsg") { // create new: // #nocov start Rcpp::List ret(2); ret[0] = NA_STRING; ret[1] = NA_STRING; Rcpp::CharacterVector proj4string = crs(1); if (! Rcpp::CharacterVector::is_na(proj4string[0])) { ret[0] = proj4string[0]; // copy to $input OGRSpatialReference *srs = new OGRSpatialReference; srs = handle_axis_order(srs); handle_error(srs->SetFromUserInput((const char *) proj4string(0))); ret[1] = wkt_from_spatial_reference(srs); // copy to $wkt delete srs; } Rcpp::CharacterVector names(2); names(0) = "input"; names(1) = "wkt"; ret.attr("names") = names; ret.attr("class") = "crs"; crs = ret; // #nocov end } return crs; } OGRSpatialReference *OGRSrs_from_crs(Rcpp::List crs) { // fix old-style crs: crs = fix_old_style(crs); OGRSpatialReference *dest = NULL; Rcpp::CharacterVector wkt = crs[1]; if (! Rcpp::CharacterVector::is_na(wkt[0])) { dest = new OGRSpatialReference; dest = handle_axis_order(dest); char *cp = wkt[0]; #if GDAL_VERSION_NUM < 2030000 handle_error(dest->importFromWkt(&cp)); #else handle_error(dest->importFromWkt((const char *) cp)); #endif } return dest; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_crs_parameters(Rcpp::List crs) { char *cp = NULL; unset_error_handler(); OGRSpatialReference *srs = OGRSrs_from_crs(crs); if (srs == NULL) Rcpp::stop("crs not found"); // #nocov int n = 18; Rcpp::List out(n); Rcpp::CharacterVector names(n); out(0) = Rcpp::NumericVector::create(srs->GetSemiMajor()); names(0) = "SemiMajor"; out(1) = Rcpp::NumericVector::create(srs->GetSemiMinor()); names(1) = "SemiMinor"; Rcpp::NumericVector InvFlattening(1); OGRErr Err; srs->GetInvFlattening(&Err); if (Err == OGRERR_FAILURE) InvFlattening(0) = NA_REAL; // #nocov else InvFlattening(0) = srs->GetInvFlattening(NULL); // for +ellps=sphere, still zero :-( out(2) = InvFlattening; names(2) = "InvFlattening"; out(3) = Rcpp::LogicalVector::create((bool) srs->IsGeographic()); names(3) = "IsGeographic"; #if GDAL_VERSION_NUM > 2030000 const char *unit; #else char *unit; #endif if (srs->IsGeographic()) srs->GetAngularUnits(&unit); else srs->GetLinearUnits(&unit); if (unit == NULL || strncmp(unit, "unknown", 8) == 0) out(4) = Rcpp::CharacterVector::create(NA_STRING); else out(4) = Rcpp::CharacterVector::create(unit); names(4) = "units_gdal"; out(5) = Rcpp::LogicalVector::create(srs->IsVertical()); names(5) = "IsVertical"; // wkt pretty: if (srs->exportToPrettyWkt(&cp) == OGRERR_NONE) { out(6) = Rcpp::CharacterVector::create(cp); CPLFree(cp); } else out(6) = ""; names(6) = "WktPretty"; // wkt: if (srs->exportToWkt(&cp) == OGRERR_NONE) { out(7) = Rcpp::CharacterVector::create(cp); CPLFree(cp); } else out(7) = ""; names(7) = "Wkt"; #if GDAL_VERSION_NUM >= 3000000 out(8) = Rcpp::CharacterVector::create(srs->GetName()); #else out(8) = Rcpp::CharacterVector::create("unknown"); #endif names(8) = "Name"; // proj4string if (srs->exportToProj4(&cp) == OGRERR_NONE) { out(9) = Rcpp::CharacterVector::create(cp); CPLFree(cp); } else out(9) = Rcpp::CharacterVector::create(NA_STRING); // #nocov names(9) = "proj4string"; // epsg if (srs->GetAuthorityCode(NULL) != NULL && strcmp(srs->GetAuthorityName(NULL), "EPSG") == 0) out(10) = Rcpp::IntegerVector::create(atoi(srs->GetAuthorityCode(NULL))); else out(10) = Rcpp::IntegerVector::create(NA_INTEGER); names(10) = "epsg"; bool yx = srs->EPSGTreatsAsLatLong() || srs->EPSGTreatsAsNorthingEasting(); out(11) = Rcpp::LogicalVector(yx); names(11) = "yx"; // ProjJson: #if GDAL_VERSION_NUM > 3010000 if (srs->exportToPROJJSON(&cp, NULL) == OGRERR_NONE) { out(12) = Rcpp::CharacterVector::create(cp); CPLFree(cp); } else out(12) = NA_STRING; #else out(12) = NA_STRING; #endif names(12) = "ProjJson"; // WKT1_ESRI #if GDAL_VERSION_NUM >= 3000000 const char *options[3] = { "MULTILINE=YES", "FORMAT=WKT1_ESRI", NULL }; if (srs->exportToWkt(&cp, options) != OGRERR_NONE) out(13) = Rcpp::CharacterVector::create(NA_STRING); // FIXME: CPLFree() in this case? else { out(13) = Rcpp::CharacterVector::create(cp); CPLFree(cp); } #else out(13) = ""; #endif names(13) = "WKT1_ESRI"; // srid if (srs->GetAuthorityName(NULL) != NULL && srs->GetAuthorityCode(NULL) != NULL) { char str[101]; snprintf(str, (size_t) 100, "%s:%s", srs->GetAuthorityName(NULL), srs->GetAuthorityCode(NULL)); Rcpp::CharacterVector v = str; out(14) = v; } else out(14) = Rcpp::CharacterVector::create(NA_STRING); names(14) = "srid"; // axes, 15: #if GDAL_VERSION_NUM > 3000000 int ac = srs->GetAxesCount(); #else int ac = 0; #endif Rcpp::CharacterVector nms(ac); Rcpp::IntegerVector orientation(ac); for (int i = 0; i < ac; i++) { OGRAxisOrientation peOrientation; const char *ret = srs->GetAxis(srs->IsGeographic() ? "GEOGCS" : "PROJCS", i, &peOrientation); if (ret != NULL) { nms[i] = ret; orientation[i] = (int) peOrientation; } else { nms[i] = NA_STRING; orientation[i] = NA_INTEGER; } } Rcpp::DataFrame axes_df = Rcpp::DataFrame::create( Rcpp::_["name"] = nms, Rcpp::_["orientation"] = orientation); out(15) = axes_df; names(15) = "axes"; // base GEOGCRS: https://github.com/r-spatial/sf/issues/2524 OGRSpatialReference *base_srs = new OGRSpatialReference; if (base_srs->CopyGeogCSFrom(srs) == OGRERR_NONE) { if (base_srs->exportToWkt(&cp) == OGRERR_NONE) { out(16) = Rcpp::CharacterVector::create(cp); CPLFree(cp); } else out(16) = Rcpp::CharacterVector::create(NA_STRING); } else out(16) = Rcpp::CharacterVector::create(NA_STRING); names(16) = "gcs_crs"; out(17) = Rcpp::LogicalVector::create((bool) base_srs->IsGeocentric()); names(17) = "is_geocentric"; delete base_srs; set_error_handler(); delete srs; out.attr("names") = names; out.attr("class") = "crs_parameters"; return out; } int srid_from_crs(Rcpp::List crs) { const char *cp; int ret_val = NA_INTEGER; unset_error_handler(); OGRSpatialReference *ref = OGRSrs_from_crs(crs); if (ref && ref->AutoIdentifyEPSG() == OGRERR_NONE && (cp = ref->GetAuthorityCode(NULL)) != NULL) { ret_val = atoi(cp); } if (ref != NULL) ref->Release(); set_error_handler(); return(ret_val); } // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_crs_equivalent(Rcpp::List crs1, Rcpp::List crs2) { OGRSpatialReference *srs1 = OGRSrs_from_crs(crs1); OGRSpatialReference *srs2 = OGRSrs_from_crs(crs2); if (srs1 == NULL && srs2 == NULL) // #nocov start return Rcpp::LogicalVector::create(true); if (srs1 == NULL) { delete srs2; return Rcpp::LogicalVector::create(false); } if (srs2 == NULL) { delete srs1; return Rcpp::LogicalVector::create(false); } // #nocov end #if GDAL_VERSION_NUM >= 3000000 const char *options[3] = { NULL, NULL, NULL }; if (axis_order_authority_compliant) { options[0] = "IGNORE_DATA_AXIS_TO_SRS_AXIS_MAPPING=NO"; options[1] = "CRITERION=STRICT"; } else options[0] = "IGNORE_DATA_AXIS_TO_SRS_AXIS_MAPPING=YES"; bool b = (bool) srs1->IsSame(srs2, options); #else bool b = (bool) srs1->IsSame(srs2); #endif delete srs1; delete srs2; return Rcpp::LogicalVector::create(b); } std::vector ogr_from_sfc(Rcpp::List sfc, OGRSpatialReference **sref) { Rcpp::List wkblst = CPL_write_wkb(sfc, false); std::vector g(sfc.length()); OGRSpatialReference *local_srs = OGRSrs_from_crs(sfc.attr("crs")); for (int i = 0; i < wkblst.length(); i++) { Rcpp::RawVector r = wkblst[i]; OGRErr err = OGRGeometryFactory::createFromWkb(&(r[0]), local_srs, &(g[i]), r.length(), wkbVariantIso); if (err != OGRERR_NONE) { if (g[i] != NULL) // release: #nocov OGRGeometryFactory::destroyGeometry(g[i]); // #nocov if (local_srs != NULL) // #nocov start local_srs->Release(); handle_error(err); // #nocov end } } if (sref != NULL) *sref = local_srs; // return and release later, or else if (local_srs != NULL) local_srs->Release(); // release now return g; } std::vector create_options(Rcpp::CharacterVector lco, bool quiet) { if (lco.size() == 0) quiet = true; // nothing to report if (! quiet) Rcpp::Rcout << "options: "; // #nocov std::vector ret(lco.size() + 1); for (int i = 0; i < lco.size(); i++) { ret[i] = (char *) (lco[i]); if (! quiet) Rcpp::Rcout << ret[i] << " "; // #nocov } ret[lco.size()] = NULL; if (! quiet) Rcpp::Rcout << std::endl; // #nocov return ret; } // convert NULL-terminated array of strings to Rcpp::CharacterVector Rcpp::CharacterVector charpp2CV(CSLConstList cp) { int n = 0; while (cp && cp[n] != NULL) n++; // count Rcpp::CharacterVector ret(n); for (int i = 0; i < n; i++) ret(i) = cp[i]; return ret; } Rcpp::List create_crs(const OGRSpatialReference *ref, bool set_input) { Rcpp::List crs(2); if (ref == NULL) { crs(0) = Rcpp::CharacterVector::create(NA_STRING); crs(1) = Rcpp::CharacterVector::create(NA_STRING); } else { if (set_input) { #if GDAL_VERSION_NUM >= 3000000 crs(0) = Rcpp::CharacterVector::create(ref->GetName()); #else const char *cp; OGRSpatialReference ref_cp = *ref; if (ref_cp.AutoIdentifyEPSG() == OGRERR_NONE && // ->AutoIdentifyEPSG() breaks if "this" is const (cp = ref_cp.GetAuthorityCode(NULL)) != NULL) crs(0) = cp; else crs(0) = Rcpp::CharacterVector::create(NA_STRING); #endif } crs(1) = wkt_from_spatial_reference(ref); } Rcpp::CharacterVector nms(2); nms(0) = "input"; nms(1) = "wkt"; crs.attr("names") = nms; crs.attr("class") = "crs"; return crs; } Rcpp::List sfc_from_ogr(std::vector g, bool destroy = false) { OGRwkbGeometryType type = wkbGeometryCollection; Rcpp::List lst(g.size()); Rcpp::List crs = create_crs(g.size() && g[0] != NULL ? g[0]->getSpatialReference() : NULL); for (size_t i = 0; i < g.size(); i++) { if (g[i] == NULL) g[i] = OGRGeometryFactory::createGeometry(type); // #nocov else type = g[i]->getGeometryType(); Rcpp::RawVector raw(g[i]->WkbSize()); handle_error(g[i]->exportToWkb(wkbNDR, &(raw[0]), wkbVariantIso)); lst[i] = raw; if (destroy) OGRGeometryFactory::destroyGeometry(g[i]); } Rcpp::List ret = CPL_read_wkb(lst, false, false); ret.attr("crs") = crs; ret.attr("class") = "sfc"; return ret; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_crs_from_input(Rcpp::CharacterVector input) { OGRSpatialReference *ref = new OGRSpatialReference; handle_axis_order(ref); Rcpp::List crs; // const char *options[3] = {"ALLOW_NETWORK_ACCESS=YES", "ALLOW_FILE_ACCESS=YES", NULL}; -> defaults if (ref->SetFromUserInput(input[0]) == OGRERR_NONE) { crs = create_crs(ref, false); crs(0) = input; } else crs = create_crs(NULL); delete ref; return crs; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_roundtrip(Rcpp::List sfc) { // for debug purposes std::vector g = ogr_from_sfc(sfc, NULL); for (size_t i = 0; i < g.size(); i++) { char *out; g[i]->exportToWkt(&out); Rcpp::Rcout << out << std::endl; CPLFree(out); } return sfc_from_ogr(g, true); // destroys g; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_circularstring_to_linestring(Rcpp::List sfc) { // need to pass more parameters? std::vector g = ogr_from_sfc(sfc, NULL); std::vector out(g.size()); for (size_t i = 0; i < g.size(); i++) { OGRCircularString *cs = (OGRCircularString *) g[i]; out[i] = cs->CurveToLine(); OGRGeometryFactory::destroyGeometry(g[i]); } return sfc_from_ogr(out, true); // destroys out; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_multisurface_to_multipolygon(Rcpp::List sfc) { // need to pass more parameters? std::vector g = ogr_from_sfc(sfc, NULL); std::vector out(g.size()); for (size_t i = 0; i < g.size(); i++) { OGRMultiSurface *cs = (OGRMultiSurface *) g[i]; if (cs->hasCurveGeometry(true)) { out[i] = cs->getLinearGeometry(); OGRGeometryFactory::destroyGeometry(g[i]); } else out[i] = cs->CastToMultiPolygon(cs); // consumes cs #nocov if (out[i] == NULL) Rcpp::stop("CPL_multisurface_to_multipolygon: NULL returned - non-polygonal surface?"); // #nocov } return sfc_from_ogr(out, true); // destroys out; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_compoundcurve_to_linear(Rcpp::List sfc) { // need to pass more parameters? std::vector g = ogr_from_sfc(sfc, NULL); std::vector out(g.size()); for (size_t i = 0; i < g.size(); i++) { OGRCompoundCurve *cs = (OGRCompoundCurve *) g[i]; out[i] = cs->getLinearGeometry(); OGRGeometryFactory::destroyGeometry(g[i]); } return sfc_from_ogr(out, true); // destroys out; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_curve_to_linestring(Rcpp::List sfc) { // need to pass more parameters? #nocov start std::vector g = ogr_from_sfc(sfc, NULL); std::vector out(g.size()); for (size_t i = 0; i < g.size(); i++) { OGRCurve *cs = (OGRCurve *) g[i]; out[i] = cs->CastToLineString(cs); } return sfc_from_ogr(out, true); // destroys out; } // #nocov end // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_can_transform(Rcpp::List src, Rcpp::List dst) { if (src.size() != 2 || dst.size() != 2) return false; Rcpp::CharacterVector src_cv = src[0]; Rcpp::CharacterVector dst_cv = dst[0]; if (Rcpp::CharacterVector::is_na(src_cv[0]) || Rcpp::CharacterVector::is_na(dst_cv[0])) return false; OGRSpatialReference *srs_src = OGRSrs_from_crs(src); OGRSpatialReference *srs_dst = OGRSrs_from_crs(dst); unset_error_handler(); OGRCoordinateTransformation *ct = OGRCreateCoordinateTransformation(srs_src, srs_dst); set_error_handler(); delete srs_src; delete srs_dst; if (ct) { ct->DestroyCT(ct); return true; } else return false; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_transform(Rcpp::List sfc, Rcpp::List crs, Rcpp::NumericVector AOI, Rcpp::CharacterVector pipeline, bool reverse = false, double desired_accuracy = -1.0, bool allow_ballpark = true) { // transform geometries: std::vector g = ogr_from_sfc(sfc, NULL); if (g.empty()) return sfc_from_ogr(g, true); // destroys g OGRSpatialReference *dest = NULL; // if pipeline was not set, import crs to dest: if (pipeline.size() == 0 && !(dest = OGRSrs_from_crs(crs))) Rcpp::stop("crs not found: is it missing?"); // #nocov #if GDAL_VERSION_NUM >= 3000000 // OGRCoordinateTransformationOptions *options = new OGRCoordinateTransformationOptions; OGRCoordinateTransformationOptions options; if (pipeline.size() && !options.SetCoordinateOperation(pipeline[0], reverse)) Rcpp::stop("pipeline value not accepted"); if (AOI.size() == 4 && !options.SetAreaOfInterest(AOI[0], AOI[1], AOI[2], AOI[3])) Rcpp::stop("values for area of interest not accepted"); #if GDAL_VERSION_NUM >= 3030000 options.SetDesiredAccuracy(desired_accuracy); options.SetBallparkAllowed(allow_ballpark); #endif // unset_error_handler(); // FIXME: is this always a good idea? OGRCoordinateTransformation *ct = OGRCreateCoordinateTransformation(g[0]->getSpatialReference(), dest, options); // set_error_handler(); #else if (pipeline.size() || AOI.size()) Rcpp::stop("pipeline or area of interest require GDAL >= 3"); // #nocov OGRCoordinateTransformation *ct = OGRCreateCoordinateTransformation(g[0]->getSpatialReference(), dest); #endif if (ct == NULL) { if (dest) dest->Release(); // #nocov start sfc_from_ogr(g, true); // to destroy g Rcpp::stop("OGRCreateCoordinateTransformation(): transformation not available"); // #nocov end } for (size_t i = 0; i < g.size(); i++) { CPLPushErrorHandler(CPLQuietErrorHandler); OGRErr err = 0; if (! g[i]->IsEmpty()) err = g[i]->transform(ct); CPLPopErrorHandler(); if (err == 1 || err == 6) { OGRwkbGeometryType geomType = g[i]->getGeometryType(); OGRGeometryFactory::destroyGeometry(g[i]); g[i] = OGRGeometryFactory::createGeometry(geomType); // return empty geometry of this type } else handle_error(err); } Rcpp::List ret = sfc_from_ogr(g, true); // destroys g; // how to return the target CRS when only a transformation pipeline is provided? Not by: // ret.attr("crs") = create_crs(ct->GetTargetCS(), true); // // According to the discussion at https://github.com/r-spatial/sf/issues/2439, this is // not a solvable issue in general. See the same link for a possible workaround and // a more general solution that uses PROJ. ct->DestroyCT(ct); if (dest) dest->Release(); return ret; } // [[Rcpp::export(rng=false)]] Rcpp::NumericVector CPL_transform_bounds(Rcpp::NumericVector bb, Rcpp::List crs_dst, int densify_pts = 21) { Rcpp::NumericVector ret(4); ret[0] = 0.0; ret[1] = 0.0; ret[2] = 0.0; ret[3] = 0.0; Rcpp::CharacterVector names(4); names(0) = "xmin"; names(1) = "ymin"; names(2) = "xmax"; names(3) = "ymax"; ret.attr("names") = names; #if GDAL_VERSION_NUM >= 3040000 if (bb.size() != 4) Rcpp::stop("bb should have length 4"); Rcpp::List crs_src = bb.attr("crs"); OGRSpatialReference *src = OGRSrs_from_crs(crs_src); OGRSpatialReference *dst = OGRSrs_from_crs(crs_dst); if (src == NULL) Rcpp::stop("crs_src not found: is it missing?"); // #nocov if (dst == NULL) Rcpp::stop("crs_dst not found: is it missing?"); // #nocov OGRCoordinateTransformation *ct = OGRCreateCoordinateTransformation(src, dst); if (ct == NULL) { dst->Release(); // #nocov start src->Release(); Rcpp::stop("transform_bounds(): transformation not available"); // #nocov end } double xmin, ymin, xmax, ymax; int success = ct->TransformBounds(bb[0], bb[1], bb[2], bb[3], &xmin, &ymin, &xmax, &ymax, densify_pts); if (!success) Rcpp::stop("transform_bounds(): failures encountered"); // #nocov ret[0] = xmin; ret[1] = ymin; ret[2] = xmax; ret[3] = ymax; ct->DestroyCT(ct); dst->Release(); src->Release(); #else Rcpp::stop("transform_bounds() requires GDAL >= 3.4"); #endif return ret; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_wrap_dateline(Rcpp::List sfc, Rcpp::CharacterVector opt, bool quiet = true) { std::vector options = create_options(opt, quiet); std::vector g = ogr_from_sfc(sfc, NULL); std::vector ret(g.size()); for (size_t i = 0; i < g.size(); i++) { ret[i] = OGRGeometryFactory::transformWithOptions(g[i], NULL, options.data()); OGRGeometryFactory::destroyGeometry(g[i]); } return sfc_from_ogr(ret, true); // destroys ret; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_get_gdal_drivers(int dummy) { int ndr = GetGDALDriverManager()->GetDriverCount(); Rcpp::CharacterVector name(ndr); Rcpp::CharacterVector long_name(ndr); Rcpp::LogicalVector create(ndr); Rcpp::LogicalVector copy(ndr); Rcpp::LogicalVector vattr(ndr); Rcpp::LogicalVector rattr(ndr); Rcpp::LogicalVector vsi_attr(ndr); for (int i = 0; i < ndr; i++) { GDALDriver *pDriver = GetGDALDriverManager()->GetDriver(i); name(i) = GDALGetDriverShortName( pDriver ); long_name(i) = GDALGetDriverLongName( pDriver ); create(i) = (pDriver->GetMetadataItem(GDAL_DCAP_CREATE) != NULL); copy(i) = (pDriver->GetMetadataItem(GDAL_DCAP_CREATECOPY) != NULL); vattr(i) = (pDriver->GetMetadataItem(GDAL_DCAP_VECTOR) != NULL); rattr(i) = (pDriver->GetMetadataItem(GDAL_DCAP_RASTER) != NULL); vsi_attr(i) = (pDriver->GetMetadataItem(GDAL_DCAP_VIRTUALIO) != NULL); } return Rcpp::DataFrame::create( Rcpp::Named("name") = name, Rcpp::Named("long_name") = long_name, Rcpp::Named("write") = create, Rcpp::Named("copy") = copy, Rcpp::Named("is_raster") = rattr, Rcpp::Named("is_vector") = vattr, Rcpp::Named("vsi") = vsi_attr); } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_sfc_from_wkt(Rcpp::CharacterVector wkt) { std::vector g(wkt.size()); OGRGeometryFactory f; for (int i = 0; i < wkt.size(); i++) { char *wkt_str = wkt(i); #if GDAL_VERSION_NUM < 2030000 handle_error(f.createFromWkt(&wkt_str, NULL, &(g[i]))); #else handle_error(f.createFromWkt( (const char*) wkt_str, NULL, &(g[i]))); #endif } return sfc_from_ogr(g, true); } // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_gdal_with_geos() { bool withGEOS = OGRGeometryFactory::haveGEOS(); return Rcpp::LogicalVector::create(withGEOS); } // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_axis_order_authority_compliant(Rcpp::LogicalVector authority_compliant) { if (authority_compliant.size() > 1) Rcpp::stop("argument authority_compliant should have length 0 or 1"); // #nocov #if GDAL_VERSION_NUM < 2050000 if (authority_compliant.size() == 1 && authority_compliant[0]) Rcpp::stop("For setting axis order compliancy, GDAL >= 2.5.0 is required"); // #nocov #endif bool old_value = axis_order_authority_compliant; if (authority_compliant.size() == 1) axis_order_authority_compliant = authority_compliant[0]; return Rcpp::LogicalVector::create(old_value); } OGRSpatialReference *handle_axis_order(OGRSpatialReference *sr) { #if GDAL_VERSION_NUM >= 2050000 if (sr != NULL) { if (!axis_order_authority_compliant) sr->SetAxisMappingStrategy(OAMS_TRADITIONAL_GIS_ORDER); else sr->SetAxisMappingStrategy(OAMS_AUTHORITY_COMPLIANT); } #endif return sr; } Rcpp::CharacterVector to_cv(char **cpp) { Rcpp::CharacterVector cv; for (int i = 0; cpp[i] != NULL; i++) cv.push_back(cpp[i]); CSLDestroy(cpp); return cv; } #if GDAL_VERSION_NUM >= 3040000 // [[Rcpp::export(rng=false)]] Rcpp::List CPL_compressors() { Rcpp::CharacterVector compressors = to_cv(CPLGetCompressors()); Rcpp::CharacterVector decompressors = to_cv(CPLGetDecompressors()); return Rcpp::List::create( Rcpp::_["compressors"] = compressors, Rcpp::_["decompressors"] = decompressors ); } #else Rcpp::List CPL_compressors() { Rcpp::stop("CPL_compressors() requires GDAL >= 3.4\n"); return Rcpp::List::create(); } #endif ================================================ FILE: src/gdal.h ================================================ #ifndef SF_GDAL_H_ #define SF_GDAL_H_ void set_error_handler(void); void unset_error_handler(void); OGRSpatialReference *handle_axis_order(OGRSpatialReference *sr); Rcpp::List create_crs(const OGRSpatialReference *ref, bool set_input); Rcpp::CharacterVector wkt_from_spatial_reference(const OGRSpatialReference *srs); int srid_from_crs(Rcpp::List crs); void set_config_options(Rcpp::CharacterVector ConfigOptions); void unset_config_options(Rcpp::CharacterVector ConfigOptions); #endif // SF_GDAL_H_ ================================================ FILE: src/gdal_geom.cpp ================================================ #include #include #include #include "gdal_sf_pkg.h" // [[Rcpp::export(rng=false)]] Rcpp::NumericVector CPL_area(Rcpp::List sfc) { std::vector g = ogr_from_sfc(sfc, NULL); Rcpp::NumericVector out(sfc.length()); for (size_t i = 0; i < g.size(); i++) { if (g[i]->getDimension() == 2) { OGRwkbGeometryType gt = OGR_GT_Flatten(g[i]->getGeometryType()); if (OGR_GT_IsSubClassOf(gt, wkbGeometryCollection)) { // will match OGRMultiPolygon, OGRMultiSurface and OGRGeometryCollection OGRGeometryCollection *gc = (OGRGeometryCollection *) g[i]; out[i] = gc->get_Area(); } else if (OGR_GT_IsSurface(gt)) { OGRSurface *surf = (OGRSurface *) g[i]; out[i] = surf->get_Area(); } else { out[i] = 0.0; // not supposed to happen, but who knows... } } else out[i] = 0.0; OGRGeometryFactory::destroyGeometry(g[i]); } return out; } // [[Rcpp::export(rng=false)]] Rcpp::IntegerVector CPL_gdal_dimension(Rcpp::List sfc, bool NA_if_empty = true) { std::vector g = ogr_from_sfc(sfc, NULL); Rcpp::IntegerVector out(sfc.length()); for (size_t i = 0; i < g.size(); i++) { if (NA_if_empty && g[i]->IsEmpty()) out[i] = NA_INTEGER; else out[i] = g[i]->getDimension(); OGRGeometryFactory f; f.destroyGeometry(g[i]); } return out; } // [[Rcpp::export(rng=false)]] Rcpp::NumericVector CPL_length(Rcpp::List sfc) { std::vector g = ogr_from_sfc(sfc, NULL); Rcpp::NumericVector out(sfc.length()); for (size_t i = 0; i < g.size(); i++) { OGRwkbGeometryType gt = OGR_GT_Flatten(g[i]->getGeometryType()); switch (gt) { case wkbPoint: case wkbMultiPoint: case wkbPolygon: case wkbMultiPolygon: out[i] = 0.0; break; case wkbLineString: case wkbCircularString: case wkbCompoundCurve: case wkbCurve: { OGRCurve *a = (OGRCurve *) g[i]; out[i] = a->get_Length(); } break; default: { if (OGR_GT_IsSubClassOf(gt, wkbGeometryCollection)) { OGRGeometryCollection *a = (OGRGeometryCollection *) g[i]; out[i] = a->get_Length(); } else { out[i] = 0.0; } } } OGRGeometryFactory f; f.destroyGeometry(g[i]); } return out; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_gdal_segmentize(Rcpp::List sfc, double dfMaxLength = 0.0) { if (dfMaxLength <= 0.0) Rcpp::stop("argument dfMaxLength should be positive\n"); std::vector g = ogr_from_sfc(sfc, NULL); for (size_t i = 0; i < g.size(); i++) g[i]->segmentize(dfMaxLength); Rcpp::List ret = sfc_from_ogr(g, true); ret.attr("crs") = sfc.attr("crs"); return ret; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_gdal_linestring_sample(Rcpp::List sfc, Rcpp::List distLst) { if (sfc.size() != distLst.size()) Rcpp::stop("sfc and dist should have equal length"); // #nocov std::vector g = ogr_from_sfc(sfc, NULL); std::vector out(g.size()); for (size_t i = 0; i < g.size(); i++) { if (wkbFlatten(g[i]->getGeometryType()) != wkbLineString) Rcpp::stop("CPL_gdal_linestring_sample only available for LINESTRING"); // #nocov OGRGeometryCollection *gc = new OGRGeometryCollection; Rcpp::NumericVector dists = distLst[i]; for (int j = 0; j < dists.size(); j++) { OGRPoint *poPoint = new OGRPoint; ((OGRLineString *) g[i])->Value(dists[j], poPoint); gc->addGeometryDirectly(poPoint); } out[i] = OGRGeometryFactory::forceToMultiPoint(gc); } Rcpp::List ret = sfc_from_ogr(g, true); // releases g ret = sfc_from_ogr(out, true); // releases out ret.attr("crs") = sfc.attr("crs"); return ret; } ================================================ FILE: src/gdal_read.cpp ================================================ #include #include #include #define RCPP_DEFAULT_INCLUDE_CALL false #include "Rcpp.h" #include "gdal_sf_pkg.h" #include "gdal_read.h" Rcpp::List allocate_out_list(OGRFeatureDefn *poFDefn, int n_features, bool int64_as_string, Rcpp::CharacterVector fid_column) { if (fid_column.size() > 1) Rcpp::stop("FID column name should be a length 1 character vector"); // #nocov int n = poFDefn->GetFieldCount() + poFDefn->GetGeomFieldCount() + fid_column.size(); Rcpp::List out(n); Rcpp::CharacterVector names(n); for (int i = 0; i < poFDefn->GetFieldCount(); i++) { OGRFieldDefn *poFieldDefn = poFDefn->GetFieldDefn(i); switch (poFieldDefn->GetType()) { case OFTInteger: { if (poFieldDefn->GetSubType() == OFSTBoolean) out[i] = Rcpp::LogicalVector(n_features); else out[i] = Rcpp::IntegerVector(n_features); } break; case OFTDate: { Rcpp::NumericVector ret(n_features); ret.attr("class") = "Date"; out[i] = ret; } break; case OFTDateTime: { Rcpp::NumericVector ret(n_features); Rcpp::CharacterVector cls(2); cls(0) = "POSIXct"; cls(1) = "POSIXt"; ret.attr("class") = cls; out[i] = ret; } break; case OFTInteger64: // fall through: converts Int64 -> double if (int64_as_string) out[i] = Rcpp::CharacterVector(n_features); else out[i] = Rcpp::NumericVector(n_features); break; case OFTReal: out[i] = Rcpp::NumericVector(n_features); break; case OFTStringList: case OFTRealList: case OFTIntegerList: case OFTInteger64List: case OFTBinary: out[i] = Rcpp::List(n_features); break; case OFTString: default: out[i] = Rcpp::CharacterVector(n_features); break; } names[i] = poFieldDefn->GetNameRef(); } if (fid_column.size()) names[ poFDefn->GetFieldCount() ] = fid_column[0]; for (int i = 0; i < poFDefn->GetGeomFieldCount(); i++) { // get the geometry fields: OGRGeomFieldDefn *poGFDefn = poFDefn->GetGeomFieldDefn(i); if (poGFDefn == NULL) Rcpp::stop("GeomFieldDefn error"); // #nocov std::string geom = "geometry"; const char *geom_name = poGFDefn->GetNameRef(); if (*geom_name == '\0') { if (i > 0) names[i + poFDefn->GetFieldCount() + fid_column.size()] = geom + std::to_string(i); // c++11; #nocov else names[i + poFDefn->GetFieldCount() + fid_column.size()] = geom; } else names[i + poFDefn->GetFieldCount() + fid_column.size()] = geom_name; out[i + poFDefn->GetFieldCount() + fid_column.size()] = Rcpp::List(n_features); // ? } out.attr("names") = names; return out; } OGRwkbGeometryType to_multi_what(std::vector gv) { bool points = false, multipoints = false, lines = false, multilines = false, polygons = false, multipolygons = false; for (unsigned int i = 0; i < gv.size(); i++) { // drop Z and M: if (gv[i] == NULL) break; OGRwkbGeometryType gt = OGR_GT_SetModifier(gv[i]->getGeometryType(), 0, 0); switch(gt) { case wkbPoint: points = true; break; case wkbMultiPoint: multipoints = true; break; case wkbLineString: lines = true; break; case wkbMultiLineString: multilines = true; break; case wkbPolygon: polygons = true; break; case wkbMultiPolygon: multipolygons = true; break; default: return wkbUnknown; // #nocov } } int sum = points + multipoints + lines + multilines + polygons + multipolygons; if (sum == 2) { if (points && multipoints) return wkbMultiPoint; if (lines && multilines) return wkbMultiLineString; if (polygons && multipolygons) return wkbMultiPolygon; } // another mix or single type: return wkbUnknown; } size_t count_features(OGRLayer *poLayer) { size_t n = 0; OGRFeature *poFeature; while((poFeature = poLayer->GetNextFeature()) != NULL) { n++; delete poFeature; if (n == INT_MAX) Rcpp::stop("Cannot read layer with more than MAX_INT features"); // #nocov } poLayer->ResetReading (); return n; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_get_layers(Rcpp::CharacterVector datasource, Rcpp::CharacterVector options, bool do_count = false) { if (datasource.size() != 1) Rcpp::stop("argument datasource should have length 1.\n"); // #nocov std::vector open_options = create_options(options, false); GDALDataset *poDS; poDS = (GDALDataset *) GDALOpenEx(datasource[0], GDAL_OF_VECTOR | GDAL_OF_READONLY, NULL, open_options.data(), NULL); if (poDS == NULL) { Rcpp::Rcout << "Cannot open data source " << datasource[0] << std::endl; Rcpp::stop("Open failed.\n"); } // template from ogrinfo.cpp: Rcpp::CharacterVector names(poDS->GetLayerCount()); Rcpp::List geomtype(poDS->GetLayerCount()); Rcpp::NumericVector field_count(poDS->GetLayerCount()); Rcpp::NumericVector feature_count(poDS->GetLayerCount()); Rcpp::List layer_crs(poDS->GetLayerCount()); for(int iLayer = 0; iLayer < poDS->GetLayerCount(); iLayer++) { OGRLayer *poLayer = poDS->GetLayer(iLayer); layer_crs[iLayer] = create_crs(poLayer->GetSpatialRef()); names(iLayer) = poLayer->GetName(); int nGeomFieldCount = poLayer->GetLayerDefn()->GetGeomFieldCount(); if (nGeomFieldCount == 0) { Rcpp::CharacterVector fieldtp(1); // #nocov start ; though tested in #334 fieldtp(0) = NA_STRING; geomtype(iLayer) = fieldtp; // #nocov end } else { Rcpp::CharacterVector fieldtp(nGeomFieldCount); if( nGeomFieldCount > 1 ) { for(int iGeom = 0; iGeom < nGeomFieldCount; iGeom ++ ) { OGRGeomFieldDefn* poGFldDefn = poLayer->GetLayerDefn()->GetGeomFieldDefn(iGeom); fieldtp(iGeom) = OGRGeometryTypeToName(poGFldDefn->GetType()); } } else if (poLayer->GetGeomType() != wkbUnknown) fieldtp(0) = OGRGeometryTypeToName(poLayer->GetGeomType()); geomtype(iLayer) = fieldtp; } OGRFeatureDefn *poFDefn = poLayer->GetLayerDefn(); field_count(iLayer) = poFDefn->GetFieldCount(); feature_count(iLayer) = poLayer->GetFeatureCount(); if (feature_count(iLayer) < 0 && do_count) feature_count(iLayer) = count_features(poLayer); } Rcpp::List ret = Rcpp::List::create( Rcpp::_["name"] = names, Rcpp::_["geomtype"] = geomtype, Rcpp::_["driver"] = poDS->GetDriverName(), Rcpp::_["features"] = feature_count, Rcpp::_["fields"] = field_count, Rcpp::_["crs"] = layer_crs); GDALClose(poDS); // close & destroys data source return ret; } Rcpp::List sf_from_ogrlayer(OGRLayer *poLayer, bool quiet, bool int64_as_string, Rcpp::NumericVector toTypeUser, Rcpp::CharacterVector fid_column, bool promote_to_multi = true, int nfeatures = -1) { OGRFeatureDefn *poFDefn = poLayer->GetLayerDefn(); size_t n = 0; if (nfeatures == -1) { double n_d = (double) poLayer->GetFeatureCount(); if (n_d > INT_MAX) Rcpp::stop("Cannot read layer with more than MAX_INT features"); // #nocov if (n_d < 0) n_d = (double) count_features(poLayer); n = (size_t) n_d; // what is List's max length? } else n = nfeatures; std::vector poFeatureV(n); // full archive Rcpp::CharacterVector fids(n); std::vector poGeometryV(n * poFDefn->GetGeomFieldCount()); // cycles column wise: 2nd el is 1st geometry, 2nd feature Rcpp::List out = allocate_out_list(poFDefn, n, int64_as_string, fid_column); // read all features: poLayer->ResetReading(); size_t i = 0; // feature counter double dbl_max_int64 = pow(2.0, 53); bool warn_int64 = false, has_null_geometries = false; OGRFeature *poFeature; while ((poFeature = poLayer->GetNextFeature()) != NULL) { if (i > (n - 1)) { Rcpp::warning("more features available than GetFeatureCount() reported: some records may be failing"); break; } // getFID: fids[i] = std::to_string(poFeature->GetFID()); // feature attribute fields: for (int iField = 0; iField < poFDefn->GetFieldCount(); iField++ ) { OGRFieldDefn *poFieldDefn = poFDefn->GetFieldDefn( iField ); #if GDAL_VERSION_NUM >= 2020000 int not_NA = poFeature->IsFieldSetAndNotNull(iField); #else int not_NA = poFeature->IsFieldSet(iField); #endif switch(poFieldDefn->GetType()) { case OFTInteger: { if (poFieldDefn->GetSubType() == OFSTBoolean) { Rcpp::LogicalVector lv; lv = out[iField]; if (not_NA) { if (poFeature->GetFieldAsInteger(iField)) lv[i] = true; else lv[i] = false; } else lv[i] = NA_LOGICAL; } else { Rcpp::IntegerVector iv; iv = out[iField]; if (not_NA) iv[i] = poFeature->GetFieldAsInteger(iField); else iv[i] = NA_INTEGER; } } break; case OFTInteger64: { if (int64_as_string) { Rcpp::CharacterVector cv; cv = out[iField]; if (not_NA) cv[i] = poFeature->GetFieldAsString(iField); else cv[i] = NA_STRING; } else { Rcpp::NumericVector nv; nv = out[iField]; if (not_NA) nv[i] = (double) poFeature->GetFieldAsInteger64(iField); else nv[i] = NA_REAL; // OR: poFeature->GetFieldAsString(iField); if (nv[i] > dbl_max_int64) warn_int64 = true; } } break; case OFTDateTime: case OFTDate: { int Year, Month, Day, Hour, Minute, TZFlag; float Second; const char *tzone = ""; poFeature->GetFieldAsDateTime(iField, &Year, &Month, &Day, &Hour, &Minute, &Second, &TZFlag); if (TZFlag == 100) tzone = "UTC"; // POSIXlt: sec min hour mday mon year wday yday isdst ... Rcpp::List dtlst = Rcpp::List::create( Rcpp::_["sec"] = (double) Second, Rcpp::_["min"] = (int) Minute, Rcpp::_["hour"] = (int) Hour, Rcpp::_["mday"] = (int) Day, Rcpp::_["mon"] = (int) Month - 1, Rcpp::_["year"] = (int) Year - 1900, Rcpp::_["wday"] = NA_INTEGER, Rcpp::_["yday"] = NA_INTEGER, Rcpp::_["isdst"] = NA_INTEGER, Rcpp::_["zone"] = tzone, Rcpp::_["gmtoff"] = NA_INTEGER); if (TZFlag == 100) dtlst.attr("tzone") = "UTC"; dtlst.attr("class") = "POSIXlt"; Rcpp::NumericVector nv; nv = out[iField]; if (! not_NA) { nv[i] = NA_REAL; break; } if (poFieldDefn->GetType() == OFTDateTime) { Rcpp::Function as_POSIXct_POSIXlt("as.POSIXct.POSIXlt"); Rcpp::NumericVector ret = as_POSIXct_POSIXlt(dtlst); // R help me! nv[i] = ret[0]; } else { Rcpp::Function as_Date_POSIXlt("as.Date.POSIXlt"); Rcpp::NumericVector ret = as_Date_POSIXlt(dtlst); // R help me! nv[i] = ret[0]; } break; } break; case OFTReal: { Rcpp::NumericVector nv; nv = out[iField]; if (not_NA) nv[i] = (double) poFeature->GetFieldAsDouble(iField); else nv[i] = NA_REAL; } break; case OFTStringList: { Rcpp::List lv; lv = out[iField]; char **sl = poFeature->GetFieldAsStringList(iField); Rcpp::CharacterVector cv(CSLCount(sl)); for (int j = 0; j < cv.size(); j++) cv[j] = sl[j]; lv[i] = cv; } break; case OFTRealList: { // for all *List types, NA is handled by zero-length lists Rcpp::List lv; // #nocov start lv = out[iField]; int n; const double *dl = poFeature->GetFieldAsDoubleList(iField, &n); Rcpp::NumericVector nv(n); for (int j = 0; j < nv.size(); j++) nv[j] = dl[j]; lv[i] = nv; } break; // #nocov end case OFTIntegerList: { Rcpp::List lv; lv = out[iField]; int n; const int *il = poFeature->GetFieldAsIntegerList(iField, &n); Rcpp::IntegerVector iv(n); for (int j = 0; j < iv.size(); j++) iv[j] = il[j]; lv[i] = iv; } break; case OFTInteger64List: { Rcpp::List lv; lv = out[iField]; int n; const GIntBig *int64list = poFeature->GetFieldAsInteger64List(iField, &n); if (int64_as_string) { Rcpp::CharacterVector cv(n); for (int j = 0; j < cv.size(); j++) { std::stringstream stream; stream << int64list[j]; cv[j] = stream.str(); } lv[i] = cv; } else { Rcpp::NumericVector nv(n); for (int j = 0; j < nv.size(); j++) { nv[j] = (double) int64list[j]; if (nv[j] > dbl_max_int64) warn_int64 = true; // #nocov } lv[i] = nv; } } break; case OFTBinary: { Rcpp::List lv; lv = out[iField]; int n; const GByte *bl = poFeature->GetFieldAsBinary(iField, &n); Rcpp::RawVector rv(n); for (int j = 0; j < rv.size(); j++) rv[j] = bl[j]; lv[i] = rv; } break; default: // break through: anything else to be converted to string? case OFTString: { Rcpp::CharacterVector cv; cv = out[iField]; if (not_NA) cv[i] = poFeature->GetFieldAsString(iField); else cv[i] = NA_STRING; } break; } } // feature geometry: for (int iGeom = 0; iGeom < poFDefn->GetGeomFieldCount(); iGeom++ ) { poGeometryV[i + n * iGeom] = poFeature->GetGeomFieldRef(iGeom); if (poGeometryV[i + n * iGeom] == NULL) has_null_geometries = true; } poFeatureV[i] = poFeature; i++; } // all read... if (i < n) { // re-read with preset n: see https://github.com/r-spatial/sf/issues/2248 Rcpp::Rcout << "Re-reading with feature count reset from " << n << " to " << i << std::endl; return sf_from_ogrlayer(poLayer, quiet, int64_as_string, toTypeUser, fid_column, promote_to_multi, i); } else { // add feature IDs if needed: if (fid_column.size()) out[ poFDefn->GetFieldCount() ] = fids; std::vector to_be_freed; for (int iGeom = 0; iGeom < poFDefn->GetGeomFieldCount(); iGeom++ ) { std::vector poGeom(n); for (i = 0; i < n; i++) poGeom[i] = poGeometryV[i + n * iGeom]; OGRwkbGeometryType toType = wkbUnknown, toTypeU = wkbUnknown; if (toTypeUser.size() == poFDefn->GetGeomFieldCount()) toTypeU = (OGRwkbGeometryType) toTypeUser[iGeom]; else toTypeU = (OGRwkbGeometryType) toTypeUser[0]; if (promote_to_multi && toTypeU == wkbUnknown) toType = to_multi_what(poGeom); else toType = toTypeU; if (toType != 0) { // coerce to toType: // OGRGeomFieldDefn *poGFDefn = poFDefn->GetGeomFieldDefn(i); for (i = 0; i < poFeatureV.size(); i++) { OGRGeometry *geom = poFeatureV[i]->StealGeometry(iGeom); // transfer ownership if (geom == NULL) geom = OGRGeometryFactory::createGeometry((OGRwkbGeometryType) toType); // #nocov else if ((geom = #if GDAL_VERSION_NUM >= 3130000 OGRGeometryFactory::forceTo(std::unique_ptr(geom), (OGRwkbGeometryType) toType, NULL).release() #else OGRGeometryFactory::forceTo(geom, (OGRwkbGeometryType) toType, NULL) #endif ) == NULL) Rcpp::stop("OGRGeometryFactory::forceTo returned NULL"); // #nocov handle_error(poFeatureV[i]->SetGeomFieldDirectly(iGeom, geom)); poGeom[i] = poFeatureV[i]->GetGeomFieldRef(iGeom); if (poGeom[i] == NULL) Rcpp::stop("GetGeomFieldRef returned NULL"); // #nocov } } else if (has_null_geometries) { if (! quiet) Rcpp::Rcout << "replacing null geometries with empty geometries" << std::endl; // #nocov // replace null's with empty: OGRwkbGeometryType gt = wkbGeometryCollection; for (i = 0; i < poGeom.size(); i++) { if (poGeom[i] != NULL) { gt = poGeom[i]->getGeometryType(); // first non-NULL break; } } for (i = 0; i < poGeom.size(); i++) { if (poGeom[i] == NULL) { poGeom[i] = OGRGeometryFactory::createGeometry(gt); if (poGeom[i] == NULL) Rcpp::stop("createGeometry returned NULL"); // #nocov else to_be_freed.push_back(poGeom[i]); } } } if (! quiet && toTypeU != 0 && n > 0) Rcpp::Rcout << "converted into: " << poGeom[0]->getGeometryName() << std::endl; // #nocov // convert to R: Rcpp::List sfc = sfc_from_ogr(poGeom, false); // don't destroy OGRGeomFieldDefn *fdfn = poFDefn->GetGeomFieldDefn(iGeom); sfc.attr("crs") = create_crs(fdfn->GetSpatialRef()); // overwrite: see #449 for the reason why out[iGeom + poFDefn->GetFieldCount() + fid_column.size()] = sfc; } if (warn_int64) Rcpp::Rcout << "Integer64 values larger than " << dbl_max_int64 << " lost significance after conversion to double;" << std::endl << "use argument int64_as_string = TRUE to import them lossless, as character" << std::endl; // clean up: for (i = 0; i < n; i++) OGRFeature::DestroyFeature(poFeatureV[i]); for (i = 0; i < to_be_freed.size(); i++) OGRGeometryFactory::destroyGeometry(to_be_freed[i]); return out; } } static void finalize_dataset_xptr(SEXP dataset_xptr) { GDALDataset *poDS = (GDALDataset*)R_ExternalPtrAddr(dataset_xptr); if (poDS != nullptr) { GDALClose(poDS); } } Rcpp::List CPL_ogr_layer_setup(Rcpp::CharacterVector datasource, Rcpp::CharacterVector layer, Rcpp::CharacterVector query, Rcpp::CharacterVector options, bool quiet, Rcpp::CharacterVector drivers, Rcpp::CharacterVector wkt_filter, bool dsn_exists, bool dsn_isdb, int width) { // adapted from the OGR tutorial @ www.gdal.org std::vector open_options = create_options(options, quiet); std::vector drivers_v = create_options(drivers, quiet); GDALDataset *poDS; poDS = (GDALDataset *) GDALOpenEx( datasource[0], GDAL_OF_VECTOR | GDAL_OF_READONLY, drivers.size() ? drivers_v.data() : NULL, open_options.data(), NULL ); if( poDS == NULL ) { // could not open dsn if( dsn_isdb ) { Rcpp::stop("Cannot open %s; Check connection parameters.", datasource); } if( dsn_exists ) { Rcpp::stop("Cannot open %s; %s %s", datasource, "The source could be corrupt or not supported.", "See `st_drivers()` for a list of supported formats."); } Rcpp::stop("Cannot open %s; The file doesn't seem to exist.", datasource); } // Will close the dataset if some early return/exception prevents GDALClose() from being // called/allows the result to be accessed by the caller. Rcpp::RObject dataset_xptr = R_MakeExternalPtr(poDS, R_NilValue, R_NilValue); R_RegisterCFinalizer(dataset_xptr, &finalize_dataset_xptr); if (layer.size() == 0 && Rcpp::CharacterVector::is_na(query[0])) { // no layer specified switch (poDS->GetLayerCount()) { case 0: { // error: Rcpp::stop("No layers in datasource."); } case 1: { // silent: OGRLayer *poLayer = poDS->GetLayer(0); layer = Rcpp::CharacterVector::create(poLayer->GetName()); break; } default: { // select first layer: message + warning: OGRLayer *poLayer = poDS->GetLayer(0); layer = Rcpp::CharacterVector::create(poLayer->GetName()); if (! quiet) { // #nocov start Rcpp::Rcout << "Multiple layers are present in data source " << datasource[0] << ", "; Rcpp::Rcout << "reading layer `" << layer[0] << "'." << std::endl; Rcpp::Rcout << "Use `st_layers' to list all layer names and their type in a data source." << std::endl; Rcpp::Rcout << "Set the `layer' argument in `st_read' to read a particular layer." << std::endl; } // #nocov end Rcpp::Function warning("warning"); warning("automatically selected the first layer in a data source containing more than one."); } } } OGRLayer *poLayer; if (! Rcpp::CharacterVector::is_na(query[0])) { poLayer = poDS->ExecuteSQL(query[0], NULL, NULL); if (poLayer == NULL) Rcpp::stop("Query execution failed, cannot open layer.\n"); // #nocov if (layer.size()) Rcpp::warning("argument layer is ignored when query is specified\n"); // #nocov } else poLayer = poDS->GetLayerByName(layer[0]); if (poLayer == NULL) { Rcpp::Rcout << "Cannot open layer " << layer[0] << std::endl; Rcpp::stop("Opening layer failed.\n"); } // set spatial filter? if (wkt_filter.size()) { char *wkt = wkt_filter[0]; OGRGeometry *new_geom; #if GDAL_VERSION_NUM < 2030000 OGRErr err = OGRGeometryFactory::createFromWkt(&wkt, poLayer->GetSpatialRef(), &new_geom); #else OGRErr err = OGRGeometryFactory::createFromWkt((const char *) wkt, poLayer->GetSpatialRef(), &new_geom); #endif if (err != OGRERR_NONE) { Rcpp::Rcout << "Cannot create geometry from: " << wkt_filter[0] << std::endl; Rcpp::stop("wkt parse error.\n"); } poLayer->SetSpatialFilter(new_geom); OGRGeometryFactory::destroyGeometry(new_geom); } if (! quiet) { if (! Rcpp::CharacterVector::is_na(query[0])) Rcpp::Rcout << "Reading query `" << query[0] << "'" << std::endl << "from data source "; else Rcpp::Rcout << "Reading layer `" << layer[0] << "' from data source "; // if (LENGTH(datasource[0]) > (width - (34 + LENGTH(layer[0])))) Rcpp::String ds(datasource(0)); if (layer.size()) { Rcpp::String la(layer(0)); if (strlen(ds.get_cstring()) > (width - (34 + strlen(la.get_cstring())))) Rcpp::Rcout << std::endl << " "; } Rcpp::Rcout << "`" << datasource[0] << "' "; if (((int) strlen(ds.get_cstring())) > (width - 25)) Rcpp::Rcout << std::endl << " "; Rcpp::Rcout << "using driver `" << poDS->GetDriverName() << "'" << std::endl; // #nocov } // Keeps the dataset external pointer alive as long as the layer external pointer is alive Rcpp::RObject layer_xptr = R_MakeExternalPtr(poLayer, R_NilValue, dataset_xptr); return Rcpp::List::create(dataset_xptr, layer_xptr); } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_read_ogr(Rcpp::CharacterVector datasource, Rcpp::CharacterVector layer, Rcpp::CharacterVector query, Rcpp::CharacterVector options, bool quiet, Rcpp::NumericVector toTypeUser, Rcpp::CharacterVector fid_column_name, Rcpp::CharacterVector drivers, Rcpp::CharacterVector wkt_filter, bool promote_to_multi = true, bool int64_as_string = false, bool dsn_exists = true, bool dsn_isdb = false, int width = 80) { Rcpp::List prep = CPL_ogr_layer_setup(datasource, layer, query, options, quiet, drivers, wkt_filter, dsn_exists, dsn_isdb, width); OGRDataSource* poDS = (OGRDataSource*)(R_ExternalPtrAddr(prep[0])); OGRLayer* poLayer = (OGRLayer*)R_ExternalPtrAddr(prep[1]); Rcpp::List out = sf_from_ogrlayer(poLayer, quiet, int64_as_string, toTypeUser, fid_column_name, promote_to_multi, -1); // clean up if SQL was used https://www.gdal.org/classGDALDataset.html#ab2c2b105b8f76a279e6a53b9b4a182e0 if (! Rcpp::CharacterVector::is_na(query[0])) poDS->ReleaseResultSet(poLayer); GDALClose(poDS); R_SetExternalPtrAddr(prep[0], nullptr); return out; } ================================================ FILE: src/gdal_read.h ================================================ #ifndef SF_GDAL_READ_H_ #define SF_GDAL_READ_H_ Rcpp::List sf_from_ogrlayer(OGRLayer *poLayer, bool quiet, bool int64_as_string, Rcpp::NumericVector toTypeUser, Rcpp::CharacterVector fid_column, bool promote_to_multi, int nfeatures); Rcpp::List CPL_ogr_layer_setup(Rcpp::CharacterVector datasource, Rcpp::CharacterVector layer, Rcpp::CharacterVector query, Rcpp::CharacterVector options, bool quiet, Rcpp::CharacterVector drivers, Rcpp::CharacterVector wkt_filter, bool dsn_exists, bool dsn_isdb, int width); Rcpp::List CPL_read_gdal(Rcpp::CharacterVector fname, Rcpp::CharacterVector options, Rcpp::CharacterVector driver, bool read_data, Rcpp::NumericVector NA_value, Rcpp::List RasterIO_parameters); #endif // SF_GDAL_READ_H_ ================================================ FILE: src/gdal_read_stream.cpp ================================================ #include #define RCPP_DEFAULT_INCLUDE_CALL false #include "Rcpp.h" #if GDAL_VERSION_NUM >= GDAL_COMPUTE_VERSION(3,6,0) #include #include "gdal_read.h" class GDALStreamWrapper { public: static void Make(struct ArrowArrayStream* stream, Rcpp::List shelter, struct ArrowArrayStream* stream_out) { stream_out->get_schema = &get_schema_wrap; stream_out->get_next = &get_next_wrap; stream_out->get_last_error = &get_last_error_wrap; stream_out->release = &release_wrap; stream_out->private_data = new GDALStreamWrapper(stream, shelter); } ~GDALStreamWrapper() { stream_.release(&stream_); GDALDataset* poDS = (GDALDataset*)R_ExternalPtrAddr(shelter_[0]); GDALClose(poDS); R_SetExternalPtrAddr(shelter_[0], nullptr); } private: // The parent stream as returned from GDAL struct ArrowArrayStream stream_; Rcpp::List shelter_; GDALStreamWrapper(struct ArrowArrayStream* stream, Rcpp::List shelter): shelter_(shelter) { memcpy(&stream_, stream, sizeof(struct ArrowArrayStream)); stream->release = nullptr; } int get_schema(struct ArrowSchema* out) { return stream_.get_schema(&stream_, out); } int get_next(struct ArrowArray* out) { return stream_.get_next(&stream_, out); } const char* get_last_error() { return stream_.get_last_error(&stream_); } static int get_schema_wrap(struct ArrowArrayStream* stream, struct ArrowSchema* out) { return reinterpret_cast(stream->private_data)->get_schema(out); } static int get_next_wrap(struct ArrowArrayStream* stream, struct ArrowArray* out) { return reinterpret_cast(stream->private_data)->get_next(out); } static const char* get_last_error_wrap(struct ArrowArrayStream* stream) { return reinterpret_cast(stream->private_data)->get_last_error(); } static void release_wrap(struct ArrowArrayStream* stream) { delete reinterpret_cast(stream->private_data); stream->release = nullptr; } }; #endif // [[Rcpp::export(rng=false)]] Rcpp::List CPL_read_gdal_stream( Rcpp::RObject stream_xptr, Rcpp::CharacterVector datasource, Rcpp::CharacterVector layer, Rcpp::CharacterVector query, Rcpp::CharacterVector options, bool quiet, Rcpp::CharacterVector drivers, Rcpp::CharacterVector wkt_filter, bool dsn_exists, bool dsn_isdb, Rcpp::CharacterVector fid_column, int width) { #if GDAL_VERSION_NUM >= GDAL_COMPUTE_VERSION(3,6,0) const char* array_stream_options[] = {"INCLUDE_FID=NO", nullptr}; if (fid_column.size() == 1) { array_stream_options[0] = "INCLUDE_FID=YES"; } Rcpp::List prep = CPL_ogr_layer_setup(datasource, layer, query, options, quiet, drivers, wkt_filter, dsn_exists, dsn_isdb, width); OGRLayer* poLayer = (OGRLayer*)R_ExternalPtrAddr(prep[1]); auto stream_out = reinterpret_cast( R_ExternalPtrAddr(stream_xptr)); OGRFeatureDefn* poFDefn = poLayer->GetLayerDefn(); Rcpp::CharacterVector geom_field_name(poFDefn->GetGeomFieldCount()); Rcpp::CharacterVector geom_field_crs(poFDefn->GetGeomFieldCount()); for (int i = 0; i < poFDefn->GetGeomFieldCount(); i++) { OGRGeomFieldDefn* poGFDefn = poFDefn->GetGeomFieldDefn(i); if (poGFDefn == nullptr) { Rcpp::stop("GeomFieldDefn error"); // #nocov } const char* name = poGFDefn->GetNameRef(); if (strlen(name) == 0) { name = "geometry"; } const OGRSpatialReference* crs = poGFDefn->GetSpatialRef(); Rcpp::String wkt_str = NA_STRING; if (crs != nullptr) { char* wkt_out; crs->exportToWkt(&wkt_out); wkt_str = wkt_out; CPLFree(wkt_out); } geom_field_name[i] = name; geom_field_crs[i] = wkt_str; } struct ArrowArrayStream stream_temp; if (!poLayer->GetArrowStream(&stream_temp, array_stream_options)) { Rcpp::stop("Failed to open ArrayStream from Layer"); } GDALStreamWrapper::Make(&stream_temp, prep, stream_out); // The reported feature count is incorrect if there is a query double num_features; if (query.size() == 0) { num_features = (double) poLayer->GetFeatureCount(false); } else { num_features = -1; } return Rcpp::List::create( geom_field_name, geom_field_crs, Rcpp::NumericVector::create(num_features)); #else Rcpp::stop("read_stream() requires GDAL >= 3.6"); #endif } ================================================ FILE: src/gdal_sf_pkg.h ================================================ #ifndef SF_GDAL_SF_PKG_H_ #define SF_GDAL_SF_PKG_H_ #ifndef NO_GDAL_CPP_HEADERS Rcpp::CharacterVector p4s_from_spatial_reference(OGRSpatialReference *ref); Rcpp::List sfc_from_ogr(std::vector, bool destroy); std::vector ogr_from_sfc(Rcpp::List sfc, OGRSpatialReference **sref); Rcpp::List create_crs(const OGRSpatialReference *ref, bool set_input = true); #endif void handle_error(OGRErr err); std::vector create_options(Rcpp::CharacterVector lco, bool quiet = true); Rcpp::CharacterVector charpp2CV(CSLConstList cp); #endif // SF_GDAL_SF_PKG_H_ ================================================ FILE: src/gdal_utils.cpp ================================================ #include "cpl_port.h" #include "cpl_conv.h" // CPLFree() #include "gdal_version.h" #include "gdalwarper.h" #include #include #include "Rcpp.h" #include "gdal.h" // local #define NO_GDAL_CPP_HEADERS #include "gdal_sf_pkg.h" /* modified from GDALTermProgress: */ int CPL_STDCALL GDALRProgress( double dfComplete, CPL_UNUSED const char * pszMessage, CPL_UNUSED void * pProgressArg ) { const int nThisTick = std::min(40, std::max(0, static_cast(dfComplete * 40.0) )); // Have we started a new progress run? static int nLastTick = -1; if( nThisTick < nLastTick && nLastTick >= 39 ) nLastTick = -1; if( nThisTick <= nLastTick ) return TRUE; while( nThisTick > nLastTick ) { ++nLastTick; if( nLastTick % 4 == 0 ) Rprintf("%d", (nLastTick / 4) * 10 ); else Rprintf("." ); } if( nThisTick == 40 ) Rprintf(" - done.\n" ); return TRUE; } #if GDAL_VERSION_NUM >= 2010000 # include "gdal_utils.h" // requires >= 2.1 // [[Rcpp::export(rng=false)]] Rcpp::CharacterVector CPL_gdalinfo(Rcpp::CharacterVector obj, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co) { set_config_options(co); std::vector options_char = create_options(options, true); std::vector oo_char = create_options(oo, true); // open options GDALInfoOptions* opt = GDALInfoOptionsNew(options_char.data(), NULL); GDALDatasetH ds = NULL; if (obj.size()) ds = GDALOpenEx((const char *) obj[0], GA_ReadOnly, NULL, oo_char.data(), NULL); char *ret_val = GDALInfo(ds, opt); if (ret_val == NULL) return Rcpp::CharacterVector::create(); Rcpp::CharacterVector ret = ret_val; // copies CPLFree(ret_val); GDALInfoOptionsFree(opt); if (ds) GDALClose(ds); unset_config_options(co); return ret; } // [[Rcpp::export(rng=false)]] Rcpp::CharacterVector CPL_ogrinfo(Rcpp::CharacterVector obj, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co, bool read_only = false) { set_config_options(co); std::vector options_char = create_options(options, true); std::vector oo_char = create_options(oo, true); // open options GDALDatasetH ds = NULL; #if GDAL_VERSION_NUM >= 3070000 if (obj.size()) ds = GDALOpenEx((const char *) obj[0], read_only ? GA_ReadOnly : GA_Update, NULL, oo_char.data(), NULL); GDALVectorInfoOptions* opt = GDALVectorInfoOptionsNew(options_char.data(), NULL); char *ret_val = GDALVectorInfo(ds, opt); if (ret_val == NULL) return Rcpp::CharacterVector::create(); Rcpp::CharacterVector ret = ret_val; // copies CPLFree(ret_val); GDALVectorInfoOptionsFree(opt); #else Rcpp::CharacterVector ret; Rcpp::stop("ogrinfo util requires GDAL >= 3.7.0"); #endif if (ds) GDALClose(ds); unset_config_options(co); return ret; } // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_gdaladdo(Rcpp::CharacterVector obj, Rcpp::CharacterVector method, Rcpp::IntegerVector overviews, Rcpp::IntegerVector bands, Rcpp::CharacterVector oo, Rcpp::CharacterVector co, bool clean = false, bool read_only = false) { set_config_options(co); /* std::vector options_char = create_options(options, true); GDALInfoOptions* opt = GDALInfoOptionsNew(options_char.data(), NULL); */ std::vector oo_char = create_options(oo, true); // open options GDALDatasetH ds; if ((ds = GDALOpenEx((const char *) obj[0], GDAL_OF_RASTER | (read_only ? GA_ReadOnly : GA_Update), NULL, oo_char.data(), NULL)) == NULL) Rcpp::stop(read_only ? "cannot open file for reading" : "cannot open file for writing"); if (clean) { // remove overviews: if (GDALBuildOverviews(ds, method[0], 0, nullptr, 0, nullptr, GDALRProgress, nullptr) != CE_None) { GDALClose(ds); Rcpp::stop("error while cleaning overviews"); } } else { // build overviews: if (GDALBuildOverviews(ds, method[0], overviews.size(), overviews.size() ? &(overviews[0]) : NULL, bands.size(), bands.size() ? &(bands[0]) : NULL, GDALRProgress, NULL) != CE_None) { GDALClose(ds); Rcpp::stop("error while building overviews"); } } GDALClose(ds); unset_config_options(co); return true; } // #nocov start // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_gdalwarp(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector doo, Rcpp::CharacterVector co, bool quiet = true, bool overwrite = false) { int err = 0; set_config_options(co); std::vector oo_char = create_options(oo, true); // open options std::vector src_pt(src.size()); for (int i = 0; i < src.size(); i++) src_pt[i] = GDALOpenEx((const char *) src[i], GA_ReadOnly, NULL, oo_char.data(), NULL); std::vector doo_char = create_options(doo, true); // open options GDALDatasetH dst_ds = GDALOpenEx((const char *) dst[0], GDAL_OF_RASTER | GA_Update, NULL, doo_char.data(), NULL); std::vector options_char = create_options(options, true); GDALWarpAppOptions* opt = GDALWarpAppOptionsNew(options_char.data(), NULL); if (opt == NULL) Rcpp::stop("warp: options error"); if (! quiet) { GDALWarpAppOptionsSetProgress(opt, GDALRProgress, NULL); #if GDAL_VERSION_NUM >= 2030000 GDALWarpAppOptionsSetQuiet(opt, 0); #endif } if (overwrite && dst_ds != NULL) { GDALClose(dst_ds); dst_ds = NULL; } GDALDatasetH result = GDALWarp(dst_ds == NULL ? (const char *) dst[0] : NULL, dst_ds, src.size(), src_pt.data(), opt, &err); GDALWarpAppOptionsFree(opt); for (int i = 0; i < src.size(); i++) if (src_pt[i] != NULL) GDALClose(src_pt[i]); if (result != NULL) GDALClose(result); unset_config_options(co); return result == NULL || err; } // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_gdalrasterize(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector doo, Rcpp::CharacterVector co, bool overwrite = false, bool quiet = true) { set_config_options(co); int err = 0; std::vector options_char = create_options(options, true); std::vector oo_char = create_options(oo, true); // open options GDALRasterizeOptions* opt = GDALRasterizeOptionsNew(options_char.data(), NULL); if (opt == NULL) Rcpp::stop("rasterize: options error"); if (! quiet) GDALRasterizeOptionsSetProgress(opt, GDALRProgress, NULL); GDALDatasetH src_pt = GDALOpenEx((const char *) src[0], GDAL_OF_VECTOR | GA_ReadOnly, NULL, oo_char.data(), NULL); if (src_pt == NULL) Rcpp::stop("source dataset not found"); unset_error_handler(); GDALDatasetH dst_pt = NULL; if (! overwrite) { std::vector doo_char = create_options(doo, true); // open options dst_pt = GDALOpenEx((const char *) dst[0], GDAL_OF_RASTER | GA_Update, NULL, doo_char.data(), NULL); } set_error_handler(); GDALDatasetH result = GDALRasterize(dst_pt == NULL ? (const char *) dst[0] : NULL, dst_pt, src_pt, opt, &err); GDALRasterizeOptionsFree(opt); if (src_pt != NULL) GDALClose(src_pt); if (result != NULL) GDALClose(result); unset_config_options(co); return result == NULL || err; } // #nocov end // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_gdaltranslate(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co, bool quiet = true) { set_config_options(co); int err = 0; std::vector options_char = create_options(options, true); std::vector oo_char = create_options(oo, true); GDALTranslateOptions* opt = GDALTranslateOptionsNew(options_char.data(), NULL); if (opt == NULL) Rcpp::stop("translate: options error"); if (! quiet) GDALTranslateOptionsSetProgress(opt, GDALRProgress, NULL); GDALDatasetH src_pt = GDALOpenEx((const char *) src[0], GDAL_OF_RASTER | GA_ReadOnly, NULL, oo_char.data(), NULL); if (src_pt == NULL) return 1; // #nocov GDALDatasetH result = GDALTranslate((const char *) dst[0], src_pt, opt, &err); GDALTranslateOptionsFree(opt); // see https://github.com/r-spatial/sf/issues/1352: if (result != NULL) GDALClose(result); if (src_pt != NULL) GDALClose(src_pt); unset_config_options(co); return result == NULL || err; } // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_gdalfootprint(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co, bool quiet = true) { #if GDAL_VERSION_NUM < 3080000 Rcpp::stop("footprint util requires GDAL >= 3.8.0"); #else int err = 0; set_config_options(co); std::vector options_char = create_options(options, true); std::vector oo_char = create_options(oo, true); GDALFootprintOptions* opt = GDALFootprintOptionsNew(options_char.data(), NULL); if (opt == NULL) Rcpp::stop("footprint: options error"); if (! quiet) GDALFootprintOptionsSetProgress(opt, GDALRProgress, NULL); GDALDatasetH src_pt = GDALOpenEx((const char *) src[0], GDAL_OF_RASTER | GA_ReadOnly, NULL, oo_char.data(), NULL); if (src_pt == NULL) return 1; // #nocov GDALDatasetH result = GDALFootprint((const char *) dst[0], NULL,src_pt, opt, &err); GDALFootprintOptionsFree(opt); // see https://github.com/r-spatial/sf/issues/1352: if (result != NULL) GDALClose(result); if (src_pt != NULL) GDALClose(src_pt); unset_config_options(co); return result == NULL || err; #endif } // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_gdalvectortranslate(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector doo, Rcpp::CharacterVector co, bool quiet = true) { set_config_options(co); int err = 0; std::vector options_char = create_options(options, true); GDALVectorTranslateOptions* opt = GDALVectorTranslateOptionsNew(options_char.data(), NULL); if (opt == NULL) Rcpp::stop("vectortranslate: options error"); if (! quiet) GDALVectorTranslateOptionsSetProgress(opt, GDALRProgress, NULL); std::vector oo_char = create_options(oo, true); // open options GDALDatasetH src_pt = GDALOpenEx((const char *) src[0], GDAL_OF_VECTOR | GA_ReadOnly, NULL, oo_char.data(), NULL); if (src_pt == NULL) return 1; // #nocov std::vector doo_char = create_options(doo, true); // open options unset_error_handler(); GDALDatasetH dst_pt = GDALOpenEx((const char *) dst[0], GDAL_OF_VECTOR | GA_Update, NULL, doo_char.data(), NULL); set_error_handler(); GDALDatasetH result = GDALVectorTranslate(dst_pt == NULL ? (const char *) dst[0] : NULL, dst_pt, 1, &src_pt, opt, &err); GDALVectorTranslateOptionsFree(opt); GDALClose(src_pt); if (result != NULL) GDALClose(result); unset_config_options(co); return result == NULL || err; } // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_gdalbuildvrt(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co, bool quiet = true) { set_config_options(co); int err = 0; std::vector options_char = create_options(options, true); GDALBuildVRTOptions* opt = GDALBuildVRTOptionsNew(options_char.data(), NULL); if (opt == NULL) Rcpp::stop("buildvrt: options error"); if (! quiet) GDALBuildVRTOptionsSetProgress(opt, GDALRProgress, NULL); GDALDatasetH result = NULL; if (oo.size()) { // to understand why we don't always take this path, read: // https://github.com/r-spatial/sf/issues/1336 std::vector oo_char = create_options(oo, true); // open options std::vector srcpt(src.size()); for (int i = 0; i < src.size(); i++) { srcpt[i] = GDALOpenEx((const char *) src[i], GDAL_OF_RASTER | GA_ReadOnly, NULL, oo_char.data(), NULL); if (srcpt[i] == NULL) Rcpp::stop("cannot open source dataset"); } result = GDALBuildVRT((const char *) dst[0], src.size(), srcpt.data(), NULL, opt, &err); for (int i = 0; i < src.size(); i++) GDALClose(srcpt[i]); } else { std::vector srcpt(src.size()); for (int i = 0; i < src.size(); i++) srcpt[i] = (const char *) src[i]; result = GDALBuildVRT((const char *) dst[0], src.size(), NULL, srcpt.data(), opt, &err); } GDALBuildVRTOptionsFree(opt); if (result != NULL) GDALClose(result); unset_config_options(co); return result == NULL || err; } // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_gdaldemprocessing(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector processing, Rcpp::CharacterVector colorfilename, Rcpp::CharacterVector oo, Rcpp::CharacterVector co, bool quiet = true) { int err = 0; set_config_options(co); std::vector options_char = create_options(options, true); std::vector oo_char = create_options(oo, true); // open options GDALDEMProcessingOptions* opt = GDALDEMProcessingOptionsNew(options_char.data(), NULL); if (opt == NULL) Rcpp::stop("demprocessing: options error"); if (! quiet) GDALDEMProcessingOptionsSetProgress(opt, GDALRProgress, NULL); GDALDatasetH src_pt = GDALOpenEx((const char *) src[0], GDAL_OF_RASTER | GA_ReadOnly, NULL, oo_char.data(), NULL); if (src_pt == NULL) Rcpp::stop("cannot open source dataset"); // #nocov GDALDatasetH result = GDALDEMProcessing((const char *) dst[0], src_pt, processing.size() == 0 ? NULL : (const char *) processing[0], colorfilename.size() == 0 ? NULL : (const char *) colorfilename[0], opt, &err); GDALDEMProcessingOptionsFree(opt); if (result != NULL) GDALClose(result); if (src_pt != NULL) GDALClose(src_pt); unset_config_options(co); return result == NULL || err; } // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_gdalnearblack(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector doo, Rcpp::CharacterVector co, bool quiet = true) { set_config_options(co); int err = 0; std::vector options_char = create_options(options, true); std::vector oo_char = create_options(oo, true); // open options std::vector doo_char = create_options(doo, true); // open options GDALNearblackOptions* opt = GDALNearblackOptionsNew(options_char.data(), NULL); if (opt == NULL) Rcpp::stop("nearblack: options error"); if (! quiet) GDALNearblackOptionsSetProgress(opt, GDALRProgress, NULL); // GDALDatasetH src_pt = GDALOpen((const char *) src[0], GA_ReadOnly); GDALDatasetH src_pt = GDALOpenEx((const char *) src[0], GDAL_OF_RASTER | GA_ReadOnly, NULL, oo_char.data(), NULL); GDALDatasetH dst_pt = GDALOpenEx((const char *) dst[0], GDAL_OF_RASTER | GA_Update, NULL, doo_char.data(), NULL); GDALDatasetH result = GDALNearblack(dst_pt == NULL ? (const char *) dst[0] : NULL, dst_pt, src_pt, opt, &err); GDALNearblackOptionsFree(opt); if (src_pt != NULL) GDALClose(src_pt); if (result != NULL) GDALClose(result); unset_config_options(co); return result == NULL || err; } // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_gdalgrid(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co, bool quiet = true) { set_config_options(co); int err = 0; std::vector options_char = create_options(options, true); std::vector oo_char = create_options(oo, true); // open options GDALGridOptions* opt = GDALGridOptionsNew(options_char.data(), NULL); if (opt == NULL) Rcpp::stop("grid: options error"); if (! quiet) GDALGridOptionsSetProgress(opt, GDALRProgress, NULL); GDALDatasetH src_pt = GDALOpenEx((const char *) src[0], GDAL_OF_ALL | GA_ReadOnly, NULL, oo_char.data(), NULL); GDALDatasetH result = GDALGrid((const char *) dst[0], src_pt, opt, &err); GDALGridOptionsFree(opt); if (src_pt != NULL) GDALClose(src_pt); if (result != NULL) GDALClose(result); unset_config_options(co); return result == NULL || err; } // gdal >= 3.1: mdim utils: #if GDAL_VERSION_NUM >= 3010000 // [[Rcpp::export(rng=false)]] Rcpp::CharacterVector CPL_gdalmdiminfo(Rcpp::CharacterVector obj, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co) { set_config_options(co); std::vector oo_char = create_options(oo, true); GDALDatasetH ds = GDALOpenEx((const char *) obj[0], GDAL_OF_MULTIDIM_RASTER | GDAL_OF_VERBOSE_ERROR , NULL, oo_char.data(), NULL); if (ds == NULL) { Rcpp::Rcout << "failed to open " << obj[0] << std::endl; Rcpp::stop("cannot open data source"); } std::vector options_char = create_options(options, true); GDALMultiDimInfoOptions* opt = GDALMultiDimInfoOptionsNew(options_char.data(), NULL); char *ret_val = GDALMultiDimInfo(ds, opt); GDALMultiDimInfoOptionsFree(opt); GDALClose(ds); if (ret_val == NULL) Rcpp::stop("GDALMultiDimInfo returned NULL"); Rcpp::CharacterVector ret(1); ret[0] = ret_val; CPLFree(ret_val); unset_config_options(co); return ret; } // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_gdalmdimtranslate(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co, bool quiet = true) { set_config_options(co); int err = 0; std::vector options_char = create_options(options, true); std::vector oo_char = create_options(oo, true); GDALMultiDimTranslateOptions* opt = GDALMultiDimTranslateOptionsNew(options_char.data(), NULL); if (opt == NULL) Rcpp::stop("mdimtranslate: options error"); if (! quiet) GDALMultiDimTranslateOptionsSetProgress(opt, GDALRProgress, NULL); std::vector srcpt(src.size()); for (int i = 0; i < src.size(); i++) { srcpt[i] = GDALOpenEx((const char *) src[i], GDAL_OF_RASTER | GDAL_OF_MULTIDIM_RASTER | GDAL_OF_VERBOSE_ERROR, NULL, oo_char.data(), NULL); if (srcpt[i] == NULL) { Rcpp::Rcout << "dataset: " << src[i] << ": " << std::endl; Rcpp::stop("Cannot open source dataset"); } } GDALDatasetH result = GDALMultiDimTranslate((const char *) dst[0], NULL, srcpt.size(), srcpt.data(), opt, &err); GDALMultiDimTranslateOptionsFree(opt); if (result != NULL) GDALClose(result); else Rcpp::stop("failed to open destination data set"); for (int i = 0; i < src.size(); i++) GDALClose(srcpt[i]); unset_config_options(co); return result == NULL || err; } #else Rcpp::CharacterVector CPL_gdalmdiminfo(Rcpp::CharacterVector obj, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co) { Rcpp::stop("GDAL version >= 3.1 required for mdiminfo"); } Rcpp::LogicalVector CPL_gdalmdimtranslate(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co, bool quiet = true) { Rcpp::stop("GDAL version >= 3.1 required for mdimtranslate"); } #endif #else #include "Rcpp.h" Rcpp::CharacterVector CPL_gdalinfo(Rcpp::CharacterVector obj, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co) { Rcpp::stop("GDAL version >= 2.1 required for gdal_utils"); } Rcpp::LogicalVector CPL_gdalwarp(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector doo, Rcpp::CharacterVector co) { Rcpp::stop("GDAL version >= 2.1 required for gdal_utils"); } Rcpp::LogicalVector CPL_gdalrasterize(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector doo, Rcpp::CharacterVector co, bool overwrite = false) { Rcpp::stop("GDAL version >= 2.1 required for gdal_utils"); } Rcpp::LogicalVector CPL_gdaltranslate(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co) { Rcpp::stop("GDAL version >= 2.1 required for gdal_utils"); } Rcpp::LogicalVector CPL_gdalvectortranslate(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector doo, Rcpp::CharacterVector co) { Rcpp::stop("GDAL version >= 2.1 required for gdal_utils"); } Rcpp::LogicalVector CPL_gdalbuildvrt(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co) { Rcpp::stop("GDAL version >= 2.1 required for gdal_utils"); } Rcpp::LogicalVector CPL_gdaldemprocessing(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector processing, Rcpp::CharacterVector colorfilename, Rcpp::CharacterVector oo, Rcpp::CharacterVector co) { Rcpp::stop("GDAL version >= 2.1 required for gdal_utils"); } Rcpp::LogicalVector CPL_gdalnearblack(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector doo, Rcpp::CharacterVector co) { Rcpp::stop("GDAL version >= 2.1 required for gdal_utils"); } Rcpp::LogicalVector CPL_gdalgrid(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co) { Rcpp::stop("GDAL version >= 2.1 required for gdal_utils"); } Rcpp::CharacterVector CPL_gdalmdiminfo(Rcpp::CharacterVector obj, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co) { Rcpp::stop("GDAL version >= 3.1 required for mdiminfo"); } Rcpp::LogicalVector CPL_gdalmdimtranslate(Rcpp::CharacterVector src, Rcpp::CharacterVector dst, Rcpp::CharacterVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector co) { Rcpp::stop("GDAL version >= 3.1 required for mdimtranslate"); } #endif // #nocov start // https://gdal.org/tutorials/warp_tut.html // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_gdal_warper(Rcpp::CharacterVector infile, Rcpp::CharacterVector outfile, Rcpp::IntegerVector options, Rcpp::CharacterVector oo, Rcpp::CharacterVector doo, Rcpp::CharacterVector co, bool quiet = true) { set_config_options(co); std::vector oo_char = create_options(oo, true); // open options GDALDatasetH hSrcDS, hDstDS; // Open input and output files. GDALAllRegister(); hSrcDS = GDALOpenEx( infile[0], GA_ReadOnly, NULL, oo_char.data(), NULL ); if (hSrcDS == NULL) Rcpp::stop("input file not found"); std::vector doo_char = create_options(doo, true); // open options hDstDS = GDALOpenEx(outfile[0], GA_Update, NULL, doo_char.data(), NULL); if (hDstDS == NULL) Rcpp::stop("could not open output file for writing"); // Setup warp options. GDALWarpOptions *psWarpOptions = GDALCreateWarpOptions(); psWarpOptions->hSrcDS = hSrcDS; psWarpOptions->hDstDS = hDstDS; if (GDALGetRasterCount(hSrcDS) != GDALGetRasterCount(hDstDS)) Rcpp::stop("warper: source and destination must have the same number of bands"); psWarpOptions->nBandCount = GDALGetRasterCount(hSrcDS); psWarpOptions->panSrcBands = (int *) CPLMalloc(sizeof(int) * psWarpOptions->nBandCount ); psWarpOptions->panDstBands = (int *) CPLMalloc(sizeof(int) * psWarpOptions->nBandCount ); for (int i = 0; i < psWarpOptions->nBandCount; i++) { psWarpOptions->panSrcBands[i] = i + 1; psWarpOptions->panDstBands[i] = i + 1; } psWarpOptions->padfSrcNoDataReal = (double *) CPLMalloc(sizeof(double) * GDALGetRasterCount(hSrcDS)); psWarpOptions->padfDstNoDataReal = (double *) CPLMalloc(sizeof(double) * GDALGetRasterCount(hSrcDS)); GDALRasterBandH poBand; int success; double d = 0xffffffff; for (int i = 0; i < GDALGetRasterCount(hSrcDS); i++) { poBand = GDALGetRasterBand(hSrcDS, i + 1); GDALGetRasterNoDataValue(poBand, &success); if (success) { psWarpOptions->padfSrcNoDataReal[i] = GDALGetRasterNoDataValue(poBand, &success); // Rcpp::Rcout << "1: " << GDALGetRasterNoDataValue(poBand, &success) << std::endl; } else memcpy(&(psWarpOptions->padfSrcNoDataReal[i]), &d, sizeof(double)); poBand = GDALGetRasterBand(hDstDS, i + 1); GDALGetRasterNoDataValue(poBand, &success); if (success) { psWarpOptions->padfDstNoDataReal[i] = GDALGetRasterNoDataValue(poBand, &success); // Rcpp::Rcout << "2: " << GDALGetRasterNoDataValue(poBand, &success) << std::endl; } else // NaN: memcpy(&(psWarpOptions->padfDstNoDataReal[i]), &d, sizeof(double)); } if (quiet) psWarpOptions->pfnProgress = GDALDummyProgress; else psWarpOptions->pfnProgress = GDALRProgress; // 0...10...20...30...40...50...60...70...80...90...100 - done. // Establish reprojection transformer. if (options.size() == 1) psWarpOptions->eResampleAlg = (GDALResampleAlg) options[0]; psWarpOptions->pTransformerArg = GDALCreateGenImgProjTransformer( hSrcDS, GDALGetProjectionRef(hSrcDS), hDstDS, GDALGetProjectionRef(hDstDS), FALSE, 0.0, 1 ); psWarpOptions->pfnTransformer = GDALGenImgProjTransform; // Initialize and execute the warp operation. GDALWarpOperation oOperation; oOperation.Initialize( psWarpOptions ); oOperation.ChunkAndWarpImage( 0, 0, GDALGetRasterXSize( hDstDS ), GDALGetRasterYSize( hDstDS ) ); GDALDestroyGenImgProjTransformer( psWarpOptions->pTransformerArg ); GDALDestroyWarpOptions( psWarpOptions ); if (hDstDS) GDALClose( hDstDS ); if (hSrcDS) GDALClose( hSrcDS ); unset_config_options(co); return false; } // #nocov end ================================================ FILE: src/gdal_write.cpp ================================================ #include #include "Rcpp.h" #include "ogrsf_frmts.h" #include "wkb.h" #include "gdal.h" #include "gdal_sf_pkg.h" std::vector SetupFields(OGRLayer *poLayer, Rcpp::List obj, bool update_layer) { std::vector ret(obj.size()); Rcpp::CharacterVector cls = obj.attr("colclasses"); Rcpp::CharacterVector nm = obj.attr("names"); for (int i = 0; i < obj.size(); i++) { if (strcmp(cls[i], "character") == 0) ret[i] = OFTString; else if (strcmp(cls[i], "integer") == 0 || strcmp(cls[i], "logical") == 0) ret[i] = OFTInteger; else if (strcmp(cls[i], "numeric") == 0) ret[i] = OFTReal; else if (strcmp(cls[i], "Date") == 0) ret[i] = OFTDate; else if (strcmp(cls[i], "POSIXct") == 0) ret[i] = OFTDateTime; else if (strcmp(cls[i], "list") == 0) // list with raw vectors; #1721 ret[i] = OFTBinary; else { // #nocov start Rcpp::Rcout << "Field " << nm[i] << " of type " << cls[i] << " not supported." << std::endl; Rcpp::stop("Layer creation failed.\n"); } // #nocov end if (poLayer->FindFieldIndex(nm[i], TRUE) == -1) { // not already present: OGRFieldDefn oField(nm[i], ret[i]); if (strcmp(cls[i], "logical") == 0) oField.SetSubType(OFSTBoolean); if (!update_layer && poLayer->CreateField(&oField) != OGRERR_NONE) { // #nocov start Rcpp::Rcout << "Creating field " << nm[i] << " failed." << std::endl; Rcpp::stop("Layer creation failed.\n"); } // #nocov end } else { // otherwise, one could check the type? // some type conversion, e.g. int -> char seems to be done by GDAL, see #2202 } } return ret; } // this is like an unlist -> dbl, but only does the first 6; if we'd do unlist on the POSIXlt // object, we'd get a character vector... Rcpp::NumericVector get_dbl6(Rcpp::List in) { Rcpp::NumericVector ret(6); for (int i = 0; i < 6; i++) { Rcpp::NumericVector x = in(i); ret(i) = x(0); } return ret; } void SetNull(OGRFeature *poFeature, size_t field) { #if GDAL_VERSION_NUM >= 2020000 poFeature->SetFieldNull(field); #else poFeature->UnsetField(field); #endif } std::vector GetFieldIndex(OGRLayer *poLayer, Rcpp::List obj) { std::vector ret(obj.size()); Rcpp::CharacterVector nm = obj.attr("names"); for (int i = 0; i < obj.size(); i++) { ret[i] = poLayer->FindFieldIndex(nm[i], TRUE); if (ret[i] == -1) { Rcpp::Rcout << "Unknown field name `" << nm[i] << "': updating a layer with improper field name(s)?" << std::endl; Rcpp::stop("Write error\n"); } } return ret; } void SetFields(OGRFeature *poFeature, std::vector tp, Rcpp::List obj, size_t i, std::vector fld) { for (size_t j = 0; j < tp.size(); j++) { if (j >= (size_t) poFeature->GetFieldCount()) Rcpp::stop("Field count reached: duplicate names present?\n"); // #nocov switch (tp[j]) { case OFTString: { Rcpp::CharacterVector cv; cv = obj[j]; if (! Rcpp::CharacterVector::is_na(cv[i])) poFeature->SetField(fld[j], (const char *) cv[i]); else SetNull(poFeature, fld[j]); } break; case OFTInteger: { const OGRFieldDefn *def = poFeature->GetFieldDefnRef(j); if (def->GetSubType() == OFSTBoolean) { Rcpp::LogicalVector lv; lv = obj[j]; if (! Rcpp::LogicalVector::is_na(lv[i])) poFeature->SetField(fld[j], (int) lv[i]); else SetNull(poFeature, fld[j]); // #nocov } else { // integer: Rcpp::IntegerVector iv; iv = obj[j]; if (! Rcpp::IntegerVector::is_na(iv[i])) poFeature->SetField(fld[j], (int) iv[i]); else SetNull(poFeature, fld[j]); // #nocov } } break; case OFTReal: { Rcpp::NumericVector nv; nv = obj[j]; if (! Rcpp::NumericVector::is_na(nv[i])) poFeature->SetField(fld[j], (double) nv[i]); else SetNull(poFeature, fld[j]); } break; case OFTDate: { Rcpp::NumericVector nv; nv = obj[j]; if (Rcpp::NumericVector::is_na(nv[i])) { SetNull(poFeature, fld[j]); break; } Rcpp::NumericVector nv0(1); nv0[0] = nv[i]; nv0.attr("class") = "Date"; Rcpp::Function as_POSIXlt_Date("as.POSIXlt.Date"); Rcpp::NumericVector ret = get_dbl6(as_POSIXlt_Date(nv0)); poFeature->SetField(fld[j], 1900 + (int) ret[5], (int) ret[4] + 1, (int) ret[3]); } break; case OFTDateTime: { Rcpp::NumericVector nv; nv = obj[j]; if (Rcpp::NumericVector::is_na(nv[i])) { SetNull(poFeature, fld[j]); break; } Rcpp::NumericVector nv0(1); nv0[0] = nv[i]; nv0.attr("tzone") = "UTC"; Rcpp::Function as_POSIXlt_POSIXct("as.POSIXlt.POSIXct"); Rcpp::NumericVector rd = get_dbl6(as_POSIXlt_POSIXct(nv0)); // use R poFeature->SetField(fld[j], 1900 + (int) rd[5], (int) rd[4] + 1, // #nocov start (int) rd[3], (int) rd[2], (int) rd[1], (float) rd[0], 100); // nTZFlag: 0=unkown, 1=local, 100=GMT; #nocov end } break; case OFTBinary: #if GDAL_VERSION_NUM > 3000000 { Rcpp::List lv; lv = obj[j]; Rcpp::RawVector rv; rv = lv(0); if (rv.size() == 0) SetNull(poFeature, fld[j]); // #nocov else { const void *ptr = &(rv[0]); int size = rv.size(); poFeature->SetField(fld[j], size, ptr); } } break; #endif default: // we should never get here! // #nocov start Rcpp::Rcout << "field with unsupported type ignored" << std::endl; Rcpp::stop("Layer creation failed.\n"); break; // #nocov end } } } // [[Rcpp::export(rng=false)]] int CPL_write_ogr(Rcpp::List obj, Rcpp::CharacterVector dsn, Rcpp::CharacterVector layer, Rcpp::CharacterVector driver, Rcpp::CharacterVector dco, Rcpp::CharacterVector lco, Rcpp::List geom, Rcpp::CharacterVector dim, Rcpp::CharacterVector fids, Rcpp::CharacterVector ConfigOptions, bool quiet, Rcpp::LogicalVector append, bool delete_dsn = false, bool delete_layer = false, bool write_geometries = true, int width = 80) { // init: set_config_options(ConfigOptions); if (driver.size() != 1 || dsn.size() != 1 || layer.size() != 1) Rcpp::stop("argument dsn, layer or driver not of length 1.\n"); /* GDALAllRegister(); -- has been done during .onLoad() */ // get driver: GDALDriver *poDriver = GetGDALDriverManager()->GetDriverByName(driver[0]); if (poDriver == NULL) { Rcpp::Rcout << "driver `" << driver[0] << "' not available." << std::endl; Rcpp::stop("Driver not available.\n"); } // delete data source: if (delete_dsn) { if (poDriver->Delete(dsn[0]) != CE_None) { if (! quiet) Rcpp::Rcout << "Deleting source `" << dsn[0] << "' failed" << std::endl; } else if (! quiet) Rcpp::Rcout << "Deleting source `" << dsn[0] << "' using driver `" << driver[0] << "'" << std::endl; } std::vector options = create_options(dco, quiet); std::vector drivers = create_options(driver, true); // data set: GDALDataset *poDS; // delete layer: if (delete_layer && (poDS = (GDALDataset *) GDALOpenEx(dsn[0], GDAL_OF_VECTOR | GDAL_OF_UPDATE, drivers.data(), options.data(), NULL)) != NULL) { // don't complain if the layer is not present // find & delete layer: bool deleted = false; for (int iLayer = 0; iLayer < poDS->GetLayerCount(); iLayer++) { OGRLayer *poLayer = poDS->GetLayer(iLayer); if (poLayer != NULL && EQUAL(poLayer->GetName(), layer[0])) { OGRErr err = poDS->DeleteLayer(iLayer); if (! quiet) { if (err == OGRERR_UNSUPPORTED_OPERATION) Rcpp::Rcout << "Deleting layer not supported by driver `" << driver[0] << "'" // #nocov << std::endl; // #nocov else { Rcpp::Rcout << "Deleting layer `" << layer[0] << "' using driver `" << driver[0] << "'" << std::endl; } } deleted = (err == OGRERR_NONE); break; } } if (! deleted && ! quiet) Rcpp::Rcout << "Deleting layer `" << layer[0] << "' failed" << std::endl; GDALClose(poDS); } // append to ds: if (append[0] == TRUE) { // and not NA_LOGICAL: poDS = (GDALDataset *) GDALOpenEx(dsn[0], GDAL_OF_VECTOR | GDAL_OF_UPDATE, drivers.data(), options.data(), NULL); if (poDS == NULL) { if ((poDS = (GDALDataset *) GDALOpenEx(dsn[0], GDAL_OF_VECTOR | GDAL_OF_READONLY, NULL, options.data(), NULL)) != NULL) { // exists read-only: GDALClose(poDS); Rcpp::Rcout << "Cannot append to " << dsn[0] << ": do you have write permission?" << std::endl; Rcpp::stop("Cannot append to existing dataset.\n"); } else { // doesn't exist: create if ((poDS = poDriver->Create(dsn[0], 0, 0, 0, GDT_Unknown, options.data())) == NULL) { Rcpp::Rcout << "Creating dataset " << dsn[0] << " failed." << std::endl; Rcpp::stop("Creation failed.\n"); } } } if (! quiet) Rcpp::Rcout << "Updating layer `" << layer[0] << "' to data source `" << dsn[0] << "' using driver `" << driver[0] << "'" << std::endl; } else { // add to existing ds or create new ds: // when append == NA, raise error when it already exists: if (!delete_dsn && !delete_layer && append[0] == NA_LOGICAL && (poDS = (GDALDataset *) GDALOpenEx(dsn[0], GDAL_OF_VECTOR | GDAL_OF_READONLY, NULL, options.data(), NULL)) != NULL && poDS->GetLayerByName(layer[0]) != NULL) { GDALClose(poDS); Rcpp::Rcout << "Layer " << layer[0] << " in dataset " << dsn[0] << " already exists:\n" << "use either append=TRUE to append to layer or append=FALSE to overwrite layer" << std::endl; Rcpp::stop("Dataset already exists.\n"); } if (delete_dsn || (poDS = (GDALDataset *) GDALOpenEx(dsn[0], GDAL_OF_VECTOR | GDAL_OF_UPDATE, drivers.data(), options.data(), NULL)) == NULL) { // if dsn does not exist, then create: if ((poDS = poDriver->Create(dsn[0], 0, 0, 0, GDT_Unknown, options.data())) == NULL) { Rcpp::Rcout << "Creating dataset " << dsn[0] << " failed." << std::endl; Rcpp::stop("Creation failed.\n"); } } if (! quiet) { Rcpp::Rcout << "Writing layer `" << layer[0] << "' to data source "; if (LENGTH(dsn[0]) > width - (44 + LENGTH(layer[0]) + LENGTH(driver[0]))) Rcpp::Rcout << std::endl << " "; Rcpp::Rcout << "`" << dsn[0] << "' using driver `" << driver[0] << "'" << std::endl; } } // can & do transaction? bool can_do_transaction = (poDS->TestCapability(ODsCTransactions) == TRUE); // can? bool transaction = false; if (can_do_transaction) { // try to start transaction: unset_error_handler(); transaction = (poDS->StartTransaction() == OGRERR_NONE); // do? set_error_handler(); if (! transaction) { // failed: #nocov start GDALClose(poDS); return 1; // transaction failed! } // #nocov end } // read geometries: OGRSpatialReference *sref = NULL; std::vector geomv; OGRwkbGeometryType wkbType; if (! write_geometries) { // write an aspatial table, see #1345 wkbType = wkbNone; for (int i = 0; i < geom.size(); i++) geomv.push_back(NULL); } else { Rcpp::CharacterVector clsv = geom.attr("class"); wkbType = (OGRwkbGeometryType) make_type(clsv[0], dim[0], false, NULL, 0); geomv = ogr_from_sfc(geom, &sref); sref = handle_axis_order(sref); } // create layer: options = create_options(lco, quiet); OGRLayer *poLayer = NULL; bool update_layer = false; if ((poLayer = poDS->GetLayerByName(layer[0])) != NULL) { if (!quiet) Rcpp::Rcout << "Updating existing layer " << layer[0] << std::endl; update_layer = true; } else poLayer = poDS->CreateLayer(layer[0], sref, wkbType, options.data()); if (sref != NULL) sref->Release(); if (poLayer == NULL) { Rcpp::Rcout << "Creating or updating layer " << layer[0] << " failed." << std::endl; GDALClose(poDS); Rcpp::stop("Write error.\n"); } // write feature attribute fields & geometries: std::vector fieldTypes = SetupFields(poLayer, obj, update_layer); if (! quiet) { Rcpp::Rcout << "Writing " << geomv.size() << " features with " << fieldTypes.size() << " fields"; if (write_geometries) Rcpp::Rcout << " and geometry type " << OGRGeometryTypeToName(wkbType); else Rcpp::Rcout << " without geometries"; Rcpp::Rcout << "." << std::endl; } std::vector fieldIndex = GetFieldIndex(poLayer, obj); for (size_t i = 0; i < geomv.size(); i++) { // create all features & add to layer: OGRFeature *poFeature = OGRFeature::CreateFeature(poLayer->GetLayerDefn()); SetFields(poFeature, fieldTypes, obj, i, fieldIndex); if (write_geometries) poFeature->SetGeometryDirectly(geomv[i]); if (fids.size() > (int) i) poFeature->SetFID(std::stoll(Rcpp::as(fids[i]), NULL, 10)); if (poLayer->CreateFeature(poFeature) != OGRERR_NONE) { Rcpp::Rcout << "Failed to create feature " << i << " in " << layer[0] << std::endl; // delete layer when failing to create feature OGRErr err = poDS->DeleteLayer(0); GDALClose(poDS); if (err != OGRERR_NONE) { // #nocov start if (err == OGRERR_UNSUPPORTED_OPERATION) Rcpp::Rcout << "Deleting layer not supported by driver `" << driver[0] << "'" << std::endl; else if (! transaction) Rcpp::Rcout << "Deleting layer `" << layer[0] << "' failed" << std::endl; } // #nocov end OGRFeature::DestroyFeature(poFeature); if (transaction) { unset_config_options(ConfigOptions); return 1; // try once more, writing to tmp file and copy #nocov } else Rcpp::stop("Feature creation failed.\n"); } OGRFeature::DestroyFeature(poFeature); // deletes geom[i] as well } if (transaction && poDS->CommitTransaction() != OGRERR_NONE) { // #nocov start poDS->RollbackTransaction(); GDALClose(poDS); Rcpp::stop("CommitTransaction() failed.\n"); } // #nocov end GDALClose(poDS); unset_config_options(ConfigOptions); return 0; // all O.K. } // delete a data source, or one or more layers within a data source // [[Rcpp::export(rng=false)]] int CPL_delete_ogr(Rcpp::CharacterVector dsn, Rcpp::CharacterVector layer, Rcpp::CharacterVector driver, bool quiet = true) { // init: if (driver.size() != 1 || dsn.size() != 1) Rcpp::stop("argument dsn or driver not of length 1.\n"); /* GDALAllRegister(); -- has been done during .onLoad() */ // get driver: GDALDriver *poDriver = GetGDALDriverManager()->GetDriverByName(driver[0]); if (poDriver == NULL) { Rcpp::Rcout << "driver `" << driver[0] << "' not available." << std::endl; Rcpp::stop("Driver not available.\n"); } // delete data source: if (layer.size() == 0) { if (poDriver->Delete(dsn[0]) != CE_None) Rcpp::Rcout << "Deleting source `" << dsn[0] << "' failed" << std::endl; else if (! quiet) Rcpp::Rcout << "Deleting source `" << dsn[0] << "' using driver `" << driver[0] << "'" << std::endl; return 0; } // delete layer(s): // data set: GDALDataset *poDS = (GDALDataset *) GDALOpenEx(dsn[0], GDAL_OF_VECTOR | GDAL_OF_UPDATE, NULL, NULL, NULL); if (poDS == NULL) { Rcpp::Rcout << "Data source `" << dsn[0] << "' not found" << std::endl; return 1; } bool can_do_transaction = (poDS->TestCapability(ODsCTransactions) == TRUE); // can? bool transaction = false; if (can_do_transaction) { // try to start transaction: unset_error_handler(); transaction = (poDS->StartTransaction() == OGRERR_NONE); // do? set_error_handler(); if (! transaction) { // failed: #nocov start GDALClose(poDS); Rcpp::Rcout << "On data source `" << dsn[0] << "' cannot start transaction" << std::endl; return 1; // transaction failed! } // #nocov end } for (int i = 0; i < layer.size(); i++) { // reverse loop order if inefficient? // find & delete layer: for (int iLayer = 0; iLayer < poDS->GetLayerCount(); iLayer++) { OGRLayer *poLayer = poDS->GetLayer(iLayer); if (poLayer != NULL && EQUAL(poLayer->GetName(), layer[i])) { OGRErr err = poDS->DeleteLayer(iLayer); if (! quiet) { if (err == OGRERR_UNSUPPORTED_OPERATION) Rcpp::Rcout << "Deleting layer not supported by driver `" << driver[0] << "'" // #nocov << std::endl; // #nocov else { Rcpp::Rcout << "Deleting layer `" << layer[0] << "' using driver `" << driver[0] << "'" << std::endl; } } if (err != OGRERR_NONE) Rcpp::Rcout << "Deleting layer `" << layer[i] << "' failed" << std::endl; } } } if (transaction && poDS->CommitTransaction() != OGRERR_NONE) { // #nocov start poDS->RollbackTransaction(); Rcpp::Rcout << "CommitTransaction() failed." << std::endl; return 1; } // #nocov end GDALClose(poDS); return 0; } ================================================ FILE: src/geos.cpp ================================================ #define GEOS_USE_ONLY_R_API // prevents using non-thread-safe GEOSxx functions without _r extension. #include #if GEOS_VERSION_MAJOR == 3 # if GEOS_VERSION_MINOR >= 4 # define HAVE340 # endif # if GEOS_VERSION_MINOR >= 5 # define HAVE350 # endif # if GEOS_VERSION_MINOR == 6 # if GEOS_VERSION_PATCH >= 1 # define HAVE361 # endif # endif # if GEOS_VERSION_MINOR >= 7 # define HAVE361 # define HAVE370 # endif # if GEOS_VERSION_MINOR >= 8 # define HAVE380 # endif # if GEOS_VERSION_MINOR >= 9 # define HAVE390 # endif # if GEOS_VERSION_MINOR == 10 # if GEOS_VERSION_PATCH >= 1 # define HAVE3101 # endif # endif # if GEOS_VERSION_MINOR >= 10 # define HAVE310 # define HAVE3101 # endif # if GEOS_VERSION_MINOR >= 11 # define HAVE311 # endif # if GEOS_VERSION_MINOR >= 12 # define HAVE312 # endif #else # if GEOS_VERSION_MAJOR > 3 # define HAVE340 # define HAVE350 # define HAVE370 # define HAVE361 # define HAVE380 # define HAVE390 # define HAVE310 # define HAVE3101 # define HAVE311 # endif #endif #include #include #include #include "wkb.h" #include "hex.h" typedef int (* dist_fn)(GEOSContextHandle_t, const GEOSGeometry *, const GEOSGeometry *, double *); typedef int (* dist_parfn)(GEOSContextHandle_t, const GEOSGeometry *, const GEOSGeometry *, double, double *); typedef char (* log_fn)(GEOSContextHandle_t, const GEOSGeometry *, const GEOSGeometry *); typedef char (* log_prfn)(GEOSContextHandle_t, const GEOSPreparedGeometry *, const GEOSGeometry *); typedef GEOSGeom (* geom_fn)(GEOSContextHandle_t, const GEOSGeom, const GEOSGeom); typedef GEOSGeom (* geom_fnp)(GEOSContextHandle_t, const GEOSGeom, const GEOSGeom, double grid_size); static void __errorHandler(const char *fmt, ...) { // #nocov start char buf[BUFSIZ], *p; va_list ap; va_start(ap, fmt); vsnprintf(buf, (size_t) BUFSIZ, fmt, ap); va_end(ap); p = buf + strlen(buf) - 1; if(strlen(buf) > 0 && *p == '\n') *p = '\0'; Rcpp::Function error(".stop_geos", Rcpp::Environment::namespace_env("sf")); error(buf); return; // #nocov end } static void __warningHandler(const char *fmt, ...) { char buf[BUFSIZ], *p; va_list ap; va_start(ap, fmt); vsnprintf(buf, (size_t) BUFSIZ, fmt, ap); va_end(ap); p = buf + strlen(buf) - 1; if(strlen(buf) > 0 && *p == '\n') *p = '\0'; Rcpp::Function warning("warning"); warning(buf); return; } // #nocov start static void __countErrorHandler(const char *fmt, void *userdata) { int *i = (int *) userdata; *i = *i + 1; } static void __emptyNoticeHandler(const char *fmt, void *userdata) { } #ifdef GEOS350 static void __checkInterruptFn(void*) { R_CheckUserInterrupt(); } static void __checkInterrupt() { // Adapted from Rcpp/Interrupt.h if (!R_ToplevelExec(__checkInterruptFn, nullptr)) { GEOS_interruptRequest(); } } // #nocov end #endif // from terra: static void __warningIgnore(const char *fmt, ...) { return; } inline GEOSContextHandle_t geos_init(void) { #ifdef GEOS350 GEOSContextHandle_t ctxt = GEOS_init_r(); GEOSContext_setNoticeHandler_r(ctxt, __warningHandler); GEOSContext_setErrorHandler_r(ctxt, __errorHandler); GEOS_interruptRegisterCallback(__checkInterrupt); return ctxt; #else return initGEOS_r((GEOSMessageHandler) __warningHandler, (GEOSMessageHandler) __errorHandler); #endif } inline void geos_finish(GEOSContextHandle_t ctxt) { #ifdef GEOS350 GEOS_finish_r(ctxt); #else finishGEOS_r(ctxt); #endif } inline GEOSContextHandle_t geos_init2(void) { #ifdef GEOS350 GEOSContextHandle_t ctxt = GEOS_init_r(); GEOSContext_setNoticeHandler_r(ctxt, __warningIgnore); GEOSContext_setErrorHandler_r(ctxt, __errorHandler); return ctxt; #else return initGEOS_r((GEOSMessageHandler) __warningIgnore, (GEOSMessageHandler) __errorHandler); #endif } // RAII wrapper: declares the context handle before geometry vectors so that, // on scope exit, geometry vectors (which call GEOSGeom_destroy_r) are destroyed // first, and geos_finish is called last. Implicit conversion to // GEOSContextHandle_t means existing code works without changes. struct GEOSContextScope { GEOSContextHandle_t hctx; GEOSContextScope() : hctx(geos_init()) {} explicit GEOSContextScope(bool quiet) : hctx(quiet ? geos_init2() : geos_init()) {} ~GEOSContextScope() { geos_finish(hctx); } operator GEOSContextHandle_t() const { return hctx; } GEOSContextScope(const GEOSContextScope&) = delete; GEOSContextScope& operator=(const GEOSContextScope&) = delete; }; static int notice = 0; // global var to silently catch notice of illegal geoms, e.g. non-closed rings void cb(void *item, void *userdata) { // callback function for tree selection std::vector *ret = (std::vector *) userdata; ret->push_back(*((size_t *) item)); } using PrepGeomPtr= std::unique_ptr >; using GeomPtr= std::unique_ptr >; using TreePtr= std::unique_ptr >; static GeomPtr geos_ptr(GEOSGeometry* g, GEOSContextHandle_t hGEOSctxt) { auto deleter = std::bind(GEOSGeom_destroy_r, hGEOSctxt, std::placeholders::_1); return GeomPtr(g, deleter); } static PrepGeomPtr geos_ptr(const GEOSPreparedGeometry* pg, GEOSContextHandle_t hGEOSctxt) { auto deleter = std::bind(GEOSPreparedGeom_destroy_r, hGEOSctxt, std::placeholders::_1); return PrepGeomPtr(pg, deleter); } static TreePtr geos_ptr(GEOSSTRtree* t, GEOSContextHandle_t hGEOSctxt) { auto deleter = std::bind(GEOSSTRtree_destroy_r, hGEOSctxt, std::placeholders::_1); return TreePtr(t, deleter); } static std::vector to_raw(std::vector & g) { std::vector raw(g.size()); std::transform(g.begin(), g.end(), raw.begin(), [](GeomPtr & g) { return g.release(); }); return raw; } double geos_grid_size(Rcpp::List x) { double precision = x.attr("precision"); if (precision != 0.0) precision = 1. / precision; return precision; } double geos_grid_size_xy(Rcpp::List x, Rcpp::List y) { return std::max(geos_grid_size(x), geos_grid_size(y)); } std::vector geometries_from_sfc(GEOSContextHandle_t hGEOSCtxt, Rcpp::List sfc, int *dim = NULL, bool stop_on_NULL = true) { Rcpp::List sfc_cls = get_dim_sfc(sfc); Rcpp::CharacterVector cls = sfc_cls["_cls"]; if (dim != NULL) { Rcpp::IntegerVector sfc_dim = sfc_cls["_dim"]; if (sfc_dim.size() == 0) Rcpp::stop("sfc_dim size 0: should not happen"); // #nocov *dim = sfc_dim[0]; } if (cls[0] == "XYM" || cls[0] == "XYZM") Rcpp::stop("GEOS does not support XYM or XYZM geometries; use st_zm() to drop M\n"); // #nocov #ifdef HAVE_390 double grid_size = geos_grid_size(sfc); bool set_precision = grid_size != 0.0; sfc.attr("precision") = 0.0; // so that CPL_write_wkb doesn't do the rounding; #endif Rcpp::List wkblst = CPL_write_wkb(sfc, true); std::vector g(sfc.size()); GEOSWKBReader *wkb_reader = GEOSWKBReader_create_r(hGEOSCtxt); for (int i = 0; i < sfc.size(); i++) { Rcpp::RawVector r = wkblst[i]; g[i] = geos_ptr(GEOSWKBReader_read_r(hGEOSCtxt, wkb_reader, &(r[0]), r.size()), hGEOSCtxt); if (g[i].get() == NULL) { if (stop_on_NULL) { Rcpp::Rcout << "While converting geometry of record: " << i << " to GEOS:" << std::endl; Rcpp::stop("Illegal geometry found: fix manually, or filter out using st_is_valid() and is.na()\n"); } } #ifdef HAVE_390 else if (set_precision) g[i] = geos_ptr(GEOSGeom_setPrecision_r(hGEOSCtxt, g[i].get(), grid_size, GEOS_PREC_VALID_OUTPUT), hGEOSCtxt); #endif } GEOSWKBReader_destroy_r(hGEOSCtxt, wkb_reader); return g; } Rcpp::List sfc_from_geometry(GEOSContextHandle_t hGEOSCtxt, std::vector & geom, int dim = 2, bool free = true) { Rcpp::List out(geom.size()); GEOSWKBWriter *wkb_writer = GEOSWKBWriter_create_r(hGEOSCtxt); GEOSWKBWriter_setOutputDimension_r(hGEOSCtxt, wkb_writer, dim); // empty point, binary, with R NA's (not NaN's); GEOS can't WKB empty points, // so we need to work around; see also https://trac.osgeo.org/postgis/ticket/3031 // > sf:::CPL_raw_to_hex(st_as_binary(st_point())) // [1] "0101000000a20700000000f07fa20700000000f07f" Rcpp::RawVector empty_point(CPL_hex_to_raw("0101000000a20700000000f07fa20700000000f07f")[0]); for (size_t i = 0; i < geom.size(); i++) { bool is_empty_point = false; bool is_empty = GEOSisEmpty_r(hGEOSCtxt, geom[i].get()) == 1; if (is_empty) { char *geom_type = GEOSGeomType_r(hGEOSCtxt, geom[i].get()); is_empty_point = strcmp("Point", geom_type) == 0; GEOSFree_r(hGEOSCtxt, geom_type); } if (is_empty_point) out[i] = empty_point; else { size_t size; unsigned char *buf = GEOSWKBWriter_write_r(hGEOSCtxt, wkb_writer, geom[i].get(), &size); Rcpp::RawVector raw(size); memcpy(&(raw[0]), buf, size); GEOSFree_r(hGEOSCtxt, buf); out[i] = raw; } } GEOSWKBWriter_destroy_r(hGEOSCtxt, wkb_writer); return CPL_read_wkb(out, true, false); } Rcpp::NumericVector get_dim(double dim0, double dim1) { Rcpp::NumericVector dim(2); dim(0) = dim0; dim(1) = dim1; return dim; } Rcpp::IntegerVector get_which(Rcpp::LogicalVector row) { std::vector v; for (int i = 0; i < row.length(); i++) if (row(i)) v.push_back(i + 1); return Rcpp::wrap(v); } bool chk_(char value) { if (value == 2) Rcpp::stop("GEOS exception"); // #nocov return value; // 1: true, 0: false } log_fn which_geom_fn(const std::string op) { if (op == "intersects") return GEOSIntersects_r; // else if (op == "disjoint") // return GEOSDisjoint_r; else if (op == "touches") return GEOSTouches_r; else if (op == "crosses") return GEOSCrosses_r; else if (op == "within") return GEOSWithin_r; else if (op == "contains") return GEOSContains_r; else if (op == "overlaps") return GEOSOverlaps_r; else if (op == "equals") return GEOSEquals_r; else if (op == "covers") return GEOSCovers_r; else if (op == "covered_by") return GEOSCoveredBy_r; Rcpp::stop("wrong value for op: please report as issue"); // unlikely to happen unless user wants to #nocov return GEOSCoveredBy_r; // never reached; satisfy -Wreturn-type #nocov } log_prfn which_prep_geom_fn(const std::string op) { if (op == "intersects") return GEOSPreparedIntersects_r; // else if (op == "disjoint") // return GEOSPreparedDisjoint_r; else if (op == "touches") return GEOSPreparedTouches_r; else if (op == "crosses") return GEOSPreparedCrosses_r; else if (op == "within") return GEOSPreparedWithin_r; else if (op == "contains") return GEOSPreparedContains_r; else if (op == "contains_properly") return GEOSPreparedContainsProperly_r; else if (op == "overlaps") return GEOSPreparedOverlaps_r; //else if (op == "equals") // return GEOSPreparedEquals_r; else if (op == "covers") return GEOSPreparedCovers_r; else if (op == "covered_by") return GEOSPreparedCoveredBy_r; Rcpp::stop("wrong value for op"); // unlikely to happen unless user wants to #nocov return GEOSPreparedCoveredBy_r; // never reached; satisfy -Wreturn-type #nocov } /* Rcpp::LogicalVector get_dense(std::vector items, int length) { Rcpp::LogicalVector rowi(length); for (int j = 0; j < length; j++) rowi(j) = false; for (size_t j = 0; j < items.size(); j++) rowi(items[j] - 1) = true; // items is 1-based return rowi; } */ // [[Rcpp::export(rng=false)]] Rcpp::List CPL_geos_binop(Rcpp::List sfc0, Rcpp::List sfc1, std::string op, double par = 0.0, std::string pattern = "", bool prepared = false) { GEOSContextScope hGEOSCtxt; std::vector gmv0 = geometries_from_sfc(hGEOSCtxt, sfc0, NULL); std::vector gmv1 = geometries_from_sfc(hGEOSCtxt, sfc1, NULL); Rcpp::List ret_list; using namespace Rcpp; // so that later on the (i,_) works if (op == "relate") { // return character matrix: Rcpp::CharacterVector out(sfc0.length() * sfc1.length()); for (int i = 0; i < sfc0.length(); i++) { for (int j = 0; j < sfc1.length(); j++) { char *cp = GEOSRelate_r(hGEOSCtxt, gmv0[i].get(), gmv1[j].get()); if (cp == NULL) { GEOSFree_r(hGEOSCtxt, cp); // #nocov Rcpp::stop("GEOS error in GEOSRelate_r"); // #nocov } out[j * sfc0.length() + i] = cp; GEOSFree_r(hGEOSCtxt, cp); } Rcpp::checkUserInterrupt(); } out.attr("dim") = get_dim(sfc0.length(), sfc1.length()); ret_list = Rcpp::List::create(out); } else if (op == "Euclidean" || op == "distance" || op == "Hausdorff" || op == "Frechet") { // return double matrix: // dist_fn, dist_parfn Rcpp::NumericMatrix out(sfc0.length(), sfc1.length()); if (par <= 0.0) { dist_fn dist_function; if (op == "Euclidean" || op == "distance") dist_function = GEOSDistance_r; else if (op == "Hausdorff") dist_function = GEOSHausdorffDistance_r; #ifdef HAVE370 else if (op == "Frechet") dist_function = GEOSFrechetDistance_r; #endif else Rcpp::stop("distance function not supported"); // #nocov for (size_t i = 0; i < gmv0.size(); i++) { if (GEOSisEmpty_r(hGEOSCtxt, gmv0[i].get())) { for (size_t j = 0; j < gmv1.size(); j++) // #nocov out(i, j) = NA_REAL; // #nocov } else for (size_t j = 0; j < gmv1.size(); j++) { if (GEOSisEmpty_r(hGEOSCtxt, gmv1[j].get())) out(i, j) = NA_REAL; else { double dist = -1.0; if (dist_function(hGEOSCtxt, gmv0[i].get(), gmv1[j].get(), &dist) == 0) Rcpp::stop("GEOS error in GEOS_xx_Distance_r"); // #nocov out(i, j) = dist; } } Rcpp::checkUserInterrupt(); } } else { dist_parfn dist_function = NULL; if (op == "Hausdorff") dist_function = GEOSHausdorffDistanceDensify_r; #ifdef HAVE370 else if (op == "Frechet") dist_function = GEOSFrechetDistanceDensify_r; #endif else Rcpp::stop("distance function not supported"); // #nocov for (size_t i = 0; i < gmv0.size(); i++) { if (GEOSisEmpty_r(hGEOSCtxt, gmv0[i].get())) { for (size_t j = 0; j < gmv1.size(); j++) out(i, j) = NA_REAL; } else for (size_t j = 0; j < gmv1.size(); j++) { if (GEOSisEmpty_r(hGEOSCtxt, gmv1[j].get())) out(i, j) = NA_REAL; else { double dist = -1.0; if (dist_function(hGEOSCtxt, gmv0[i].get(), gmv1[j].get(), par, &dist) == 0) Rcpp::stop("GEOS error in GEOS_xx_Distance_r"); // #nocov out(i, j) = dist; } } Rcpp::checkUserInterrupt(); } } ret_list = Rcpp::List::create(out); } else if (op == "is_within_distance") { Rcpp::List sparsemat(sfc0.length()); for (size_t i = 0; i < gmv0.size(); i++) { std::vector sel; for (size_t j = 0; j < gmv1.size(); j++) { double dist = -1.0; if (GEOSDistance_r(hGEOSCtxt, gmv0[i].get(), gmv1[j].get(), &dist) == 0) Rcpp::stop("GEOS error in GEOSDistance_r"); // #nocov if (dist <= par) sel.push_back(j + 1); // 1-based } sparsemat[i] = Rcpp::IntegerVector(sel.begin(), sel.end()); Rcpp::checkUserInterrupt(); } ret_list = sparsemat; } else if (gmv1.size()) { // other cases: sparse matrix Rcpp::List sparsemat(sfc0.length()); std::vector items(gmv1.size()); TreePtr tree1 = geos_ptr(GEOSSTRtree_create_r(hGEOSCtxt, 10), hGEOSCtxt); for (size_t i = 0; i < gmv1.size(); i++) { items[i] = i; if (! GEOSisEmpty_r(hGEOSCtxt, gmv1[i].get())) GEOSSTRtree_insert_r(hGEOSCtxt, tree1.get(), gmv1[i].get(), &(items[i])); } if (op == "equals_exact") { // has it's own signature, needing `par': for (int i = 0; i < sfc0.length(); i++) { // row Rcpp::LogicalVector rowi(sfc1.length()); for (int j = 0; j < sfc1.length(); j++) rowi(j) = chk_(GEOSEqualsExact_r(hGEOSCtxt, gmv0[i].get(), gmv1[j].get(), par)); sparsemat[i] = get_which(rowi); Rcpp::checkUserInterrupt(); } } else if (op == "relate_pattern") { // needing pattern if (GEOSRelatePatternMatch_r(hGEOSCtxt, pattern.c_str(), "FF*FF****")) Rcpp::stop("use st_disjoint for this pattern"); // all remaining can use tree: for (int i = 0; i < sfc0.length(); i++) { // row // pre-select sfc1's using tree: std::vector tree_sel, sel; if (! GEOSisEmpty_r(hGEOSCtxt, gmv0[i].get())) GEOSSTRtree_query_r(hGEOSCtxt, tree1.get(), gmv0[i].get(), cb, &tree_sel); for (size_t j = 0; j < tree_sel.size(); j++) if (chk_(GEOSRelatePattern_r(hGEOSCtxt, gmv0[i].get(), gmv1[tree_sel[j]].get(), pattern.c_str()))) sel.push_back(tree_sel[j] + 1); // 1-based std::sort(sel.begin(), sel.end()); sparsemat[i] = Rcpp::IntegerVector(sel.begin(), sel.end()); Rcpp::checkUserInterrupt(); } } else if (op == "disjoint") Rcpp::stop("disjoint should have been handled in R"); // #nocov else { // anything else: if (prepared) { log_prfn logical_fn = which_prep_geom_fn(op); for (int i = 0; i < sfc0.length(); i++) { // row // pre-select sfc1's using tree: std::vector tree_sel, sel; if (! GEOSisEmpty_r(hGEOSCtxt, gmv0[i].get())) GEOSSTRtree_query_r(hGEOSCtxt, tree1.get(), gmv0[i].get(), cb, &tree_sel); if (! tree_sel.empty()) { PrepGeomPtr pr = geos_ptr(GEOSPrepare_r(hGEOSCtxt, gmv0[i].get()), hGEOSCtxt); for (size_t j = 0; j < tree_sel.size(); j++) if (chk_(logical_fn(hGEOSCtxt, pr.get(), gmv1[tree_sel[j]].get()))) sel.push_back(tree_sel[j] + 1); // 1-based std::sort(sel.begin(), sel.end()); } sparsemat[i] = Rcpp::IntegerVector(sel.begin(), sel.end()); Rcpp::checkUserInterrupt(); } } else { log_fn logical_fn = which_geom_fn(op); for (int i = 0; i < sfc0.length(); i++) { // row // pre-select sfc1's using tree: std::vector tree_sel, sel; if (! GEOSisEmpty_r(hGEOSCtxt, gmv0[i].get())) GEOSSTRtree_query_r(hGEOSCtxt, tree1.get(), gmv0[i].get(), cb, &tree_sel); for (size_t j = 0; j < tree_sel.size(); j++) if (chk_(logical_fn(hGEOSCtxt, gmv0[i].get(), gmv1[tree_sel[j]].get()))) sel.push_back(tree_sel[j] + 1); // 1-based std::sort(sel.begin(), sel.end()); sparsemat[i] = Rcpp::IntegerVector(sel.begin(), sel.end()); Rcpp::checkUserInterrupt(); } } } ret_list = sparsemat; } else { // gmv1.size() == 0: Rcpp::List sparsemat(sfc0.length()); for (size_t i = 0; i < gmv0.size(); i++) sparsemat[i] = Rcpp::IntegerVector(); ret_list = sparsemat; } return ret_list; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_geos_binop_by_element(Rcpp::List sfc0, Rcpp::List sfc1, std::string op, double par, std::string pattern, bool prepared) { GEOSContextScope hGEOSCtxt; std::vector gmv0 = geometries_from_sfc(hGEOSCtxt, sfc0, NULL); std::vector gmv1 = geometries_from_sfc(hGEOSCtxt, sfc1, NULL); if (gmv0.size() != gmv1.size()) Rcpp::stop("for element-wise predicates, x and y must have equal length"); size_t n = gmv0.size(); Rcpp::List ret_list; if (op == "relate") { Rcpp::CharacterVector out(n); for (size_t i = 0; i < n; i++) { char *cp = GEOSRelate_r(hGEOSCtxt, gmv0[i].get(), gmv1[i].get()); if (cp == NULL) Rcpp::stop("GEOS error in GEOSRelate_r"); // #nocov out[i] = cp; GEOSFree_r(hGEOSCtxt, cp); Rcpp::checkUserInterrupt(); } ret_list = Rcpp::List::create(out); } else if (op == "relate_pattern") { Rcpp::LogicalVector out(n); for (size_t i = 0; i < n; i++) { out[i] = chk_(GEOSRelatePattern_r(hGEOSCtxt, gmv0[i].get(), gmv1[i].get(), pattern.c_str())); Rcpp::checkUserInterrupt(); } ret_list = Rcpp::List::create(out); } else if (op == "equals_exact") { Rcpp::LogicalVector out(n); for (size_t i = 0; i < n; i++) { out[i] = chk_(GEOSEqualsExact_r(hGEOSCtxt, gmv0[i].get(), gmv1[i].get(), par)); Rcpp::checkUserInterrupt(); } ret_list = Rcpp::List::create(out); } else if (op == "is_within_distance") { Rcpp::LogicalVector out(n); for (size_t i = 0; i < n; i++) { double dist = -1.0; if (GEOSDistance_r(hGEOSCtxt, gmv0[i].get(), gmv1[i].get(), &dist) == 0) Rcpp::stop("GEOS error in GEOSDistance_r"); // #nocov // out[i] = dist <= par; Rcpp::checkUserInterrupt(); } ret_list = Rcpp::List::create(out); } else { log_fn logical_fn = which_geom_fn(op); Rcpp::LogicalVector out(n); for (size_t i = 0; i < n; i++) { out[i] = chk_(logical_fn(hGEOSCtxt, gmv0[i].get(), gmv1[i].get())); Rcpp::checkUserInterrupt(); } ret_list = Rcpp::List::create(out); } return ret_list; } // [[Rcpp::export(rng=false)]] Rcpp::CharacterVector CPL_geos_is_valid_reason(Rcpp::List sfc) { GEOSContextScope hGEOSCtxt; std::vector gmv = geometries_from_sfc(hGEOSCtxt, sfc, NULL, false); Rcpp::CharacterVector out(gmv.size()); for (int i = 0; i < out.length(); i++) { if (gmv[i].get() == NULL) out[i] = NA_STRING; else { char *buf = GEOSisValidReason_r(hGEOSCtxt, gmv[i].get()); if (buf == NULL) out[i] = NA_STRING; // #nocov else { out[i] = buf; GEOSFree_r(hGEOSCtxt, buf); } } } return out; } // #nocov start - no GEOS 3.8.0 on travis yet // [[Rcpp::export(rng=false)]] Rcpp::List CPL_geos_make_valid(Rcpp::List sfc, std::string method, bool keep_collapsed) { GEOSContextScope hGEOSCtxt; std::vector gmv = geometries_from_sfc(hGEOSCtxt, sfc, NULL); std::vector out(gmv.size()); #ifdef HAVE380 # ifdef HAVE3101 GEOSMakeValidParams *makeValidParams = GEOSMakeValidParams_create_r(hGEOSCtxt); if (method == "valid_linework") GEOSMakeValidParams_setMethod_r(hGEOSCtxt, makeValidParams, GEOS_MAKE_VALID_LINEWORK); else if (method == "valid_structure") GEOSMakeValidParams_setMethod_r(hGEOSCtxt, makeValidParams, GEOS_MAKE_VALID_STRUCTURE); else Rcpp::stop("geos_method not recognized"); GEOSMakeValidParams_setKeepCollapsed_r(hGEOSCtxt, makeValidParams, (int) keep_collapsed); for (size_t i = 0; i < gmv.size(); i++) gmv[i] = geos_ptr(GEOSMakeValidWithParams_r(hGEOSCtxt, gmv[i].get(), makeValidParams), hGEOSCtxt); GEOSMakeValidParams_destroy_r(hGEOSCtxt, makeValidParams); # else for (size_t i = 0; i < gmv.size(); i++) gmv[i] = geos_ptr(GEOSMakeValid_r(hGEOSCtxt, gmv[i].get()), hGEOSCtxt); # endif #else Rcpp::stop("this shouldn't happen: st_make_valid should use lwgeom"); #endif Rcpp::List ret = sfc_from_geometry(hGEOSCtxt, gmv); return ret; } // #nocov end // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_geos_is_valid(Rcpp::List sfc, bool NA_on_exception = true) { GEOSContextScope hGEOSCtxt; notice = 0; if (NA_on_exception) { /* if (sfc.size() > 1) Rcpp::stop("NA_on_exception will only work reliably with length 1 sfc objects"); // #nocov */ #ifdef HAVE350 GEOSContext_setNoticeMessageHandler_r(hGEOSCtxt, (GEOSMessageHandler_r) __emptyNoticeHandler, (void *) ¬ice); GEOSContext_setErrorMessageHandler_r(hGEOSCtxt, (GEOSMessageHandler_r) __countErrorHandler, (void *) ¬ice); #endif } Rcpp::LogicalVector out(sfc.size()); for (int i = 0; i < out.length(); i++) { // get geometry i: Rcpp::List geom_i = Rcpp::List::create(sfc[i]); geom_i.attr("precision") = sfc.attr("precision"); geom_i.attr("class") = sfc.attr("class"); geom_i.attr("crs") = sfc.attr("crs"); SEXP classes = sfc.attr("classes"); if (classes != R_NilValue) { Rcpp::CharacterVector cl = sfc.attr("classes"); geom_i.attr("classes") = cl[i]; } std::vector gmv = geometries_from_sfc(hGEOSCtxt, geom_i, NULL, false); // where notice might be set! int ret; if (gmv[0].get() == NULL) ret = 2; else ret = GEOSisValid_r(hGEOSCtxt, gmv[0].get()); if (NA_on_exception && (ret == 2 || notice != 0)) out[i] = NA_LOGICAL; // no need to set notice back here, as we only consider 1 geometry #nocov else out[i] = chk_(ret); notice = 0; // reset notice. } #ifdef HAVE350 GEOSContext_setNoticeHandler_r(hGEOSCtxt, __warningHandler); GEOSContext_setErrorHandler_r(hGEOSCtxt, __errorHandler); #endif return out; } // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_geos_is_simple(Rcpp::List sfc) { GEOSContextScope hGEOSCtxt; Rcpp::LogicalVector out(sfc.length()); std::vector g = geometries_from_sfc(hGEOSCtxt, sfc, NULL); for (size_t i = 0; i < g.size(); i++) out[i] = chk_(GEOSisSimple_r(hGEOSCtxt, g[i].get())); return out; } // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_geos_is_empty(Rcpp::List sfc) { GEOSContextScope hGEOSCtxt; Rcpp::LogicalVector out(sfc.length()); std::vector g = geometries_from_sfc(hGEOSCtxt, sfc, NULL); for (size_t i = 0; i < g.size(); i++) out[i] = chk_(GEOSisEmpty_r(hGEOSCtxt, g[i].get())); return out; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_geos_normalize(Rcpp::List sfc) { // #nocov start int dim = 2; GEOSContextScope hGEOSCtxt; std::vector gmv = geometries_from_sfc(hGEOSCtxt, sfc, &dim); for (int i = 0; i < sfc.size(); i++) { if (GEOSNormalize_r(hGEOSCtxt, gmv[i].get()) == -1) Rcpp::stop("normalize: GEOS exception"); } Rcpp::List out(sfc_from_geometry(hGEOSCtxt, gmv, dim)); out.attr("precision") = sfc.attr("precision"); out.attr("crs") = sfc.attr("crs"); return out; } // #nocov end // [[Rcpp::export(rng=false)]] Rcpp::List CPL_geos_union(Rcpp::List sfc, bool by_feature = false, bool is_coverage = false) { GEOSContextScope hGEOSCtxt; #ifndef HAVE380 if (is_coverage) { Rcpp::warning("ignoring 'is_coverage = TRUE' which requires GEOS version 3.8 or greater"); is_coverage = false; } #endif if (sfc.size() == 0) return sfc; // #nocov int dim = 2; std::vector gmv = geometries_from_sfc(hGEOSCtxt, sfc, &dim); std::vector gmv_out(by_feature ? sfc.size() : 1); if (by_feature) { for (int i = 0; i < sfc.size(); i++) { gmv_out[i] = geos_ptr(GEOSUnaryUnion_r(hGEOSCtxt, gmv[i].get()), hGEOSCtxt); } } else { bool all_inputs_same = true; // check to see if all geometries are identical, as in a call to summarize(..., do_union=TRUE) for (size_t i = 1; i < gmv.size(); i++) { if (!GEOSEqualsExact_r(hGEOSCtxt, gmv[0].get(), gmv[i].get(), 0.0)) { all_inputs_same = false; break; } } if (all_inputs_same) { gmv_out[0] = std::move(gmv[0]); } else { GeomPtr gc = geos_ptr(GEOSGeom_createCollection_r(hGEOSCtxt, GEOS_GEOMETRYCOLLECTION, to_raw(gmv).data(), gmv.size()), hGEOSCtxt); #ifdef HAVE380 if (is_coverage) gmv_out[0] = geos_ptr(GEOSCoverageUnion_r(hGEOSCtxt, gc.get()), hGEOSCtxt); else #endif gmv_out[0] = geos_ptr(GEOSUnaryUnion_r(hGEOSCtxt, gc.get()), hGEOSCtxt); } } Rcpp::List out(sfc_from_geometry(hGEOSCtxt, gmv_out, dim)); out.attr("precision") = sfc.attr("precision"); out.attr("crs") = sfc.attr("crs"); return out; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_geos_snap(Rcpp::List sfc0, Rcpp::List sfc1, Rcpp::NumericVector tolerance) { int dim = 2; GEOSContextScope hGEOSCtxt; std::vector gmv0 = geometries_from_sfc(hGEOSCtxt, sfc0, &dim); std::vector gmv1 = geometries_from_sfc(hGEOSCtxt, sfc1, &dim); GeomPtr gc; if (gmv1.size() > 1) gc = geos_ptr(GEOSGeom_createCollection_r(hGEOSCtxt, GEOS_GEOMETRYCOLLECTION, to_raw(gmv1).data(), gmv1.size()), hGEOSCtxt); else gc = std::move(gmv1[0]); std::vector gmv_out(sfc0.size()); for (int i = 0; i < sfc0.size(); i++) { gmv_out[i] = geos_ptr(GEOSSnap_r(hGEOSCtxt, gmv0[i].get(), gc.get(), tolerance[i]), hGEOSCtxt); if (gmv_out[i] == NULL) Rcpp::stop("snap: GEOS exception"); // #nocov } Rcpp::List out(sfc_from_geometry(hGEOSCtxt, gmv_out, dim)); out.attr("precision") = sfc0.attr("precision"); out.attr("crs") = sfc0.attr("crs"); return out; } GEOSGeometry *chkNULL(GEOSGeometry *value) { if (value == NULL) Rcpp::stop("GEOS exception"); // #nocov Rcpp::checkUserInterrupt(); return value; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_geos_op(std::string op, Rcpp::List sfc, Rcpp::NumericVector bufferDist, Rcpp::IntegerVector nQuadSegs, Rcpp::NumericVector dTolerance, Rcpp::LogicalVector preserveTopology, int bOnlyEdges = 1, Rcpp::IntegerVector endCapStyle = 0, Rcpp::IntegerVector joinStyle = 0, Rcpp::NumericVector mitreLimit = 1, Rcpp::LogicalVector singleside = 0) { GEOSContextScope hGEOSCtxt; int dim = 2; std::vector g = geometries_from_sfc(hGEOSCtxt, sfc, &dim); std::vector out(sfc.length()); if (op == "buffer") { if (bufferDist.size() != (int) g.size()) Rcpp::stop("invalid dist argument"); // #nocov for (size_t i = 0; i < g.size(); i++) out[i] = geos_ptr(chkNULL(GEOSBuffer_r(hGEOSCtxt, g[i].get(), bufferDist[i], nQuadSegs[i])), hGEOSCtxt); } else if (op == "buffer_with_style") { GEOSBufferParams *bufferparams = GEOSBufferParams_create_r(hGEOSCtxt); for (size_t i = 0; i < g.size(); i++) { if (GEOSBufferParams_setEndCapStyle_r(hGEOSCtxt, bufferparams, endCapStyle[i]) && GEOSBufferParams_setJoinStyle_r(hGEOSCtxt, bufferparams, joinStyle[i]) && GEOSBufferParams_setMitreLimit_r(hGEOSCtxt, bufferparams, mitreLimit[i]) && GEOSBufferParams_setQuadrantSegments_r(hGEOSCtxt, bufferparams, nQuadSegs[i]) && GEOSBufferParams_setSingleSided_r(hGEOSCtxt, bufferparams, singleside[i])) // out[i] = geos_ptr(chkNULL(GEOSBufferWithStyle_r(hGEOSCtxt, g[i].get(), bufferDist[i], nQuadSegs[i], endCapStyle[i], joinStyle[i], mitreLimit[i])), hGEOSCtxt); out[i] = geos_ptr(chkNULL(GEOSBufferWithParams_r(hGEOSCtxt, g[i].get(), bufferparams, bufferDist[i])), hGEOSCtxt); else Rcpp::stop("invalid buffer parameters"); // #nocov } GEOSBufferParams_destroy_r(hGEOSCtxt, bufferparams); } else if (op == "boundary") { for (size_t i = 0; i < g.size(); i++) out[i] = geos_ptr(chkNULL(GEOSBoundary_r(hGEOSCtxt, g[i].get())), hGEOSCtxt); } else if (op == "concave_hull") { #ifdef HAVE311 double ratio = bufferDist[0]; unsigned int allowHoles = preserveTopology[0]; for (size_t i = 0; i < g.size(); i++) out[i] = geos_ptr(chkNULL(GEOSConcaveHull_r(hGEOSCtxt, g[i].get(), ratio, allowHoles)), hGEOSCtxt); #else Rcpp::stop("st_concave_hull requires GEOS >= 3.11"); #endif } else if (op == "convex_hull") { for (size_t i = 0; i < g.size(); i++) out[i] = geos_ptr(chkNULL(GEOSConvexHull_r(hGEOSCtxt, g[i].get())), hGEOSCtxt); } else if (op == "simplify") { for (size_t i = 0; i < g.size(); i++) out[i] = geos_ptr( preserveTopology[i] ? chkNULL(GEOSTopologyPreserveSimplify_r(hGEOSCtxt, g[i].get(), dTolerance[i])) : chkNULL(GEOSSimplify_r(hGEOSCtxt, g[i].get(), dTolerance[i])), hGEOSCtxt); } else if (op == "linemerge") { for (size_t i = 0; i < g.size(); i++) out[i] = geos_ptr(chkNULL(GEOSLineMerge_r(hGEOSCtxt, g[i].get())), hGEOSCtxt); } else if (op == "linemergedirected") { #ifdef HAVE311 for (size_t i = 0; i < g.size(); i++) out[i] = geos_ptr(chkNULL(GEOSLineMergeDirected_r(hGEOSCtxt, g[i].get())), hGEOSCtxt); #else Rcpp::stop("directed line merge requires GEOS >= 3.11"); #endif } else if (op == "polygonize") { for (size_t i = 0; i < g.size(); i++) { const GEOSGeometry* gi = g[i].get(); out[i] = geos_ptr(chkNULL(GEOSPolygonize_r(hGEOSCtxt, &gi, 1)), hGEOSCtxt); } } else if (op == "centroid") { for (size_t i = 0; i < g.size(); i++) { out[i] = geos_ptr(chkNULL(GEOSGetCentroid_r(hGEOSCtxt, g[i].get())), hGEOSCtxt); } } else if (op == "node") { for (size_t i = 0; i < g.size(); i++) { out[i] = geos_ptr(chkNULL(GEOSNode_r(hGEOSCtxt, g[i].get())), hGEOSCtxt); } } else if (op == "point_on_surface") { for (size_t i = 0; i < g.size(); i++) { out[i] = geos_ptr(chkNULL(GEOSPointOnSurface_r(hGEOSCtxt, g[i].get())), hGEOSCtxt); } } else #ifdef HAVE340 if (op == "triangulate") { for (size_t i = 0; i < g.size(); i++) out[i] = geos_ptr(chkNULL(GEOSDelaunayTriangulation_r(hGEOSCtxt, g[i].get(), dTolerance[i], bOnlyEdges)), hGEOSCtxt); } else #endif #ifdef HAVE310 if (op == "triangulate_constrained") { for (size_t i = 0; i < g.size(); i++) out[i] = geos_ptr(chkNULL(GEOSConstrainedDelaunayTriangulation_r(hGEOSCtxt, g[i].get())), hGEOSCtxt); } else #endif #ifdef HAVE370 if (op == "reverse") { for (size_t i = 0; i < g.size(); i++) { out[i] = geos_ptr(chkNULL(GEOSReverse_r(hGEOSCtxt, g[i].get())), hGEOSCtxt); } } else #endif #ifdef HAVE380 if (op == "bounding_circle") { double r; for (size_t i = 0; i < g.size(); i++) out[i] = geos_ptr(chkNULL(GEOSMinimumBoundingCircle_r(hGEOSCtxt, g[i].get(), &r, NULL)), hGEOSCtxt); } else #endif #ifdef HAVE390 if (op == "inscribed_circle") { for (size_t i = 0; i < g.size(); i++) { out[i] = geos_ptr(chkNULL(GEOSMaximumInscribedCircle_r(hGEOSCtxt, g[i].get(), dTolerance[i])), hGEOSCtxt); } } else if (op == "minimum_rotated_rectangle") { for (size_t i = 0; i < g.size(); i++) { out[i] = geos_ptr(chkNULL(GEOSMinimumRotatedRectangle_r(hGEOSCtxt, g[i].get())), hGEOSCtxt); } } else #endif Rcpp::stop("invalid operation"); // #nocov Rcpp::List ret(sfc_from_geometry(hGEOSCtxt, out, dim)); ret.attr("precision") = sfc.attr("precision"); ret.attr("crs") = sfc.attr("crs"); return ret; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_geos_voronoi(Rcpp::List sfc, Rcpp::List env, double dTolerance = 0.0, int bOnlyEdges = 1) { GEOSContextScope hGEOSCtxt; int dim = 2; std::vector g = geometries_from_sfc(hGEOSCtxt, sfc, &dim); std::vector out(sfc.length()); #ifdef HAVE350 switch (env.size()) { case 0: ; case 1: { std::vector g_env = geometries_from_sfc(hGEOSCtxt, env); for (size_t i = 0; i < g.size(); i++) { out[i] = geos_ptr(chkNULL(GEOSVoronoiDiagram_r(hGEOSCtxt, g[i].get(), g_env.size() ? g_env[0].get() : NULL, dTolerance, bOnlyEdges)), hGEOSCtxt); } break; } default: Rcpp::stop("env should have length 0 or 1"); // #nocov } #else Rcpp::stop("voronoi diagrams require a GEOS version >= 3.5.0"); // #nocov #endif Rcpp::List ret(sfc_from_geometry(hGEOSCtxt, out, dim)); ret.attr("precision") = sfc.attr("precision"); ret.attr("crs") = sfc.attr("crs"); return ret; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_geos_op2(std::string op, Rcpp::List sfcx, Rcpp::List sfcy) { using namespace Rcpp; // so that later on the (_,1) works int dim = 2; GEOSContextScope hGEOSCtxt; std::vector x = geometries_from_sfc(hGEOSCtxt, sfcx, &dim); std::vector y = geometries_from_sfc(hGEOSCtxt, sfcy, &dim); std::vector out; std::vector index_x, index_y; std::vector items(x.size()); #ifdef HAVE_390 double grid_size = geos_grid_size_xy(sfcx, sfcy); #endif if (op == "intersection") { bool tree_empty = true; TreePtr tree = geos_ptr(GEOSSTRtree_create_r(hGEOSCtxt, 10), hGEOSCtxt); for (size_t i = 0; i < x.size(); i++) { items[i] = i; if (! GEOSisEmpty_r(hGEOSCtxt, x[i].get())) { GEOSSTRtree_insert_r(hGEOSCtxt, tree.get(), x[i].get(), &(items[i])); tree_empty = false; } } for (size_t i = 0; i < y.size(); i++) { // select x's using tree: std::vector sel; sel.reserve(x.size()); if (! GEOSisEmpty_r(hGEOSCtxt, y[i].get()) && ! tree_empty) GEOSSTRtree_query_r(hGEOSCtxt, tree.get(), y[i].get(), cb, &sel); std::sort(sel.begin(), sel.end()); for (size_t item = 0; item < sel.size(); item++) { size_t j = sel[item]; #ifndef HAVE_390 GeomPtr geom = geos_ptr(GEOSIntersection_r(hGEOSCtxt, x[j].get(), y[i].get()), hGEOSCtxt); #else GeomPtr geom = geos_ptr(GEOSIntersectionPrec_r(hGEOSCtxt, x[j].get(), y[i].get(), grid_size), hGEOSCtxt); #endif if (geom == nullptr) Rcpp::stop("GEOS exception"); // #nocov if (! chk_(GEOSisEmpty_r(hGEOSCtxt, geom.get()))) { index_x.push_back(j + 1); index_y.push_back(i + 1); out.push_back(std::move(geom)); // keep } Rcpp::checkUserInterrupt(); } } } else { #ifndef HAVE_390 geom_fn geom_function; if (op == "union") geom_function = (geom_fn) GEOSUnion_r; else if (op == "difference") geom_function = (geom_fn) GEOSDifference_r; else if (op == "sym_difference") geom_function = (geom_fn) GEOSSymDifference_r; #else geom_fnp geom_function; if (op == "union") geom_function = (geom_fn) GEOSUnionPrec_r; else if (op == "difference") geom_function = (geom_fn) GEOSDifferencePrec_r; else if (op == "sym_difference") geom_function = (geom_fn) GEOSSymDifferencePrec_r; #endif else Rcpp::stop("invalid operation"); // #nocov for (size_t i = 0; i < y.size(); i++) { for (size_t j = 0; j < x.size(); j++) { #ifndef HAVE_390 GeomPtr geom = geos_ptr(geom_function(hGEOSCtxt, x[j].get(), y[i].get()), hGEOSCtxt); #else GeomPtr geom = geos_ptr(geom_function(hGEOSCtxt, x[j].get(), y[i].get(), grid_size), hGEOSCtxt); #endif if (geom == nullptr) Rcpp::stop("GEOS exception"); // #nocov if (! chk_(GEOSisEmpty_r(hGEOSCtxt, geom.get()))) { index_x.push_back(j + 1); index_y.push_back(i + 1); out.push_back(std::move(geom)); // keep } Rcpp::checkUserInterrupt(); } } } Rcpp::NumericMatrix m(index_x.size(), 2); // and a set of 1-based indices to x and y m(_, 0) = Rcpp::NumericVector(index_x.begin(), index_x.end()); m(_, 1) = Rcpp::NumericVector(index_y.begin(), index_y.end()); Rcpp::List ret; if ((x.size() == 0 || y.size() == 0) && op != "intersection") { if (op == "union" || op == "sym_difference") { // return "the other" if (y.size() == 0) ret = sfcx; else ret = sfcy; } else // "difference" is asymmetric: x - 0 -> return x ret = sfcx; } else { ret = sfc_from_geometry(hGEOSCtxt, out, dim); ret.attr("crs") = sfcx.attr("crs"); ret.attr("idx") = m; } return ret; } // [[Rcpp::export(rng=false)]] Rcpp::NumericVector CPL_geos_dist_by_element(Rcpp::List sfc0, Rcpp::List sfc1, std::string which, double par) { GEOSContextScope hGEOSCtxt; int dim = 2; std::vector gmv0 = geometries_from_sfc(hGEOSCtxt, sfc0, &dim); std::vector gmv1 = geometries_from_sfc(hGEOSCtxt, sfc1, &dim); if (gmv0.size() != gmv1.size()) Rcpp::stop("for element-wise distance, x and y must have equal length"); size_t n = gmv0.size(); Rcpp::NumericVector out(n); if (par <= 0.0) { dist_fn dist_function; if (which == "Euclidean") dist_function = GEOSDistance_r; else if (which == "Hausdorff") dist_function = GEOSHausdorffDistance_r; #ifdef HAVE370 else if (which == "Frechet") dist_function = GEOSFrechetDistance_r; #endif else Rcpp::stop("distance function not supported"); // #nocov for (size_t i = 0; i < n; i++) { if (GEOSisEmpty_r(hGEOSCtxt, gmv0[i].get()) || GEOSisEmpty_r(hGEOSCtxt, gmv1[i].get())) out[i] = NA_REAL; else { double dist = -1.0; if (dist_function(hGEOSCtxt, gmv0[i].get(), gmv1[i].get(), &dist) == 0) Rcpp::stop("GEOS error in GEOS_xx_Distance_r"); // #nocov out[i] = dist; } Rcpp::checkUserInterrupt(); } } else { dist_parfn dist_function = NULL; if (which == "Hausdorff") dist_function = GEOSHausdorffDistanceDensify_r; #ifdef HAVE370 else if (which == "Frechet") dist_function = GEOSFrechetDistanceDensify_r; #endif else Rcpp::stop("distance function not supported"); // #nocov for (size_t i = 0; i < n; i++) { if (GEOSisEmpty_r(hGEOSCtxt, gmv0[i].get()) || GEOSisEmpty_r(hGEOSCtxt, gmv1[i].get())) out[i] = NA_REAL; else { double dist = -1.0; if (dist_function(hGEOSCtxt, gmv0[i].get(), gmv1[i].get(), par, &dist) == 0) Rcpp::stop("GEOS error in GEOS_xx_Distance_r"); // #nocov out[i] = dist; } Rcpp::checkUserInterrupt(); } } return out; } // [[Rcpp::export(rng=false)]] std::string CPL_geos_version(bool runtime = false, bool capi = false) { if (runtime) return GEOSversion(); else { if (capi) return GEOS_CAPI_VERSION; else return GEOS_VERSION; } } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_geos_op2_by_element(std::string op, Rcpp::List sfcx, Rcpp::List sfcy) { using namespace Rcpp; GEOSContextScope hGEOSCtxt; int dim = 2; std::vector x = geometries_from_sfc(hGEOSCtxt, sfcx, &dim); std::vector y = geometries_from_sfc(hGEOSCtxt, sfcy, &dim); if (x.size() != y.size()) Rcpp::stop("for element-wise operations, x and y must have equal length"); size_t n = x.size(); std::vector out(n); #ifdef HAVE390 double grid_size = geos_grid_size_xy(sfcx, sfcy); #endif #ifndef HAVE390 geom_fn geom_function; if (op == "intersection") geom_function = (geom_fn) GEOSIntersection_r; else if (op == "union") geom_function = (geom_fn) GEOSUnion_r; else if (op == "difference") geom_function = (geom_fn) GEOSDifference_r; else if (op == "sym_difference") geom_function = (geom_fn) GEOSSymDifference_r; #else geom_fnp geom_function; if (op == "intersection") geom_function = (geom_fnp) GEOSIntersectionPrec_r; else if (op == "union") geom_function = (geom_fnp) GEOSUnionPrec_r; else if (op == "difference") geom_function = (geom_fnp) GEOSDifferencePrec_r; else if (op == "sym_difference") geom_function = (geom_fnp) GEOSSymDifferencePrec_r; #endif else Rcpp::stop("invalid operation"); // #nocov for (size_t i = 0; i < n; i++) { if (GEOSisEmpty_r(hGEOSCtxt, x[i].get()) || GEOSisEmpty_r(hGEOSCtxt, y[i].get())) { out[i] = geos_ptr(GEOSGeom_createEmptyCollection_r(hGEOSCtxt, GEOS_GEOMETRYCOLLECTION), hGEOSCtxt); } else { #ifndef HAVE390 GeomPtr geom = geos_ptr(geom_function(hGEOSCtxt, x[i].get(), y[i].get()), hGEOSCtxt); #else GeomPtr geom = geos_ptr(geom_function(hGEOSCtxt, x[i].get(), y[i].get(), grid_size), hGEOSCtxt); #endif if (geom == nullptr) out[i] = geos_ptr(GEOSGeom_createEmptyCollection_r(hGEOSCtxt, GEOS_GEOMETRYCOLLECTION), hGEOSCtxt); else out[i] = std::move(geom); } Rcpp::checkUserInterrupt(); } Rcpp::NumericMatrix m(n, 2); for (size_t i = 0; i < n; i++) { m(i, 0) = i + 1; m(i, 1) = i + 1; } Rcpp::List ret = sfc_from_geometry(hGEOSCtxt, out, dim); ret.attr("crs") = sfcx.attr("crs"); ret.attr("idx") = m; return ret; } // [[Rcpp::export(rng=false)]] Rcpp::NumericMatrix CPL_geos_dist(Rcpp::List sfc0, Rcpp::List sfc1, Rcpp::CharacterVector which, double par) { Rcpp::NumericMatrix out = CPL_geos_binop(sfc0, sfc1, Rcpp::as(which), par, "", false)[0]; return out; } // requires 3.6.1: https://trac.osgeo.org/geos/browser/git/NEWS?rev=3.6.2 #ifdef HAVE361 // helper struct & distance function for STRtree: typedef struct { GEOSGeom g; size_t id; } item_g; int distance_fn(const void *item1, const void *item2, double *distance, void *userdata) { return GEOSDistance_r( (GEOSContextHandle_t) userdata, ((const item_g *)item1)->g, ((const item_g *)item2)->g, distance); } // [[Rcpp::export(rng=false)]] Rcpp::IntegerVector CPL_geos_nearest_feature(Rcpp::List sfc0, Rcpp::List sfc1) { // for every feature in sf0, find the index (1-based) of the nearest feature in sfc1 GEOSContextScope hGEOSCtxt; int dim = 2; std::vector gmv0 = geometries_from_sfc(hGEOSCtxt, sfc0, &dim); std::vector gmv1 = geometries_from_sfc(hGEOSCtxt, sfc1, &dim); TreePtr tree = geos_ptr(GEOSSTRtree_create_r(hGEOSCtxt, 10), hGEOSCtxt); std::vector items(gmv1.size()); bool tree_is_empty = true; for (size_t i = 0; i < gmv1.size(); i++) { items[i].id = i + 1; // 1-based items[i].g = gmv1[i].get(); if (!GEOSisEmpty_r(hGEOSCtxt, gmv1[i].get())) { GEOSSTRtree_insert_r(hGEOSCtxt, tree.get(), gmv1[i].get(), &(items[i])); tree_is_empty = false; } } Rcpp::IntegerVector out(gmv0.size()); for (size_t i = 0; i < gmv0.size(); i++) { if (!GEOSisEmpty_r(hGEOSCtxt, gmv0[i].get()) && !tree_is_empty) { item_g item; item.id = 0; // is irrelevant item.g = gmv0[i].get(); const item_g *ret_item; // now query tree for nearest GEOM at item: ret_item = (const item_g *) GEOSSTRtree_nearest_generic_r(hGEOSCtxt, tree.get(), &item, gmv0[i].get(), distance_fn, hGEOSCtxt); if (ret_item != NULL) out[i] = ret_item->id; // the index (1-based) of nearest GEOM else Rcpp::stop("st_nearest_feature: GEOS exception"); } else out[i] = NA_INTEGER; } return out; } #else Rcpp::IntegerVector CPL_geos_nearest_feature(Rcpp::List sfc0, Rcpp::List sfc1) { Rcpp::stop("GEOS version 3.6.1 required for selecting nearest features"); } #endif // HAVE_361 // [[Rcpp::export(rng=false)]] Rcpp::List CPL_geos_nearest_points(Rcpp::List sfc0, Rcpp::List sfc1, bool pairwise) { int dim = 2; GEOSContextScope hGEOSCtxt; std::vector gmv0 = geometries_from_sfc(hGEOSCtxt, sfc0, &dim); std::vector gmv1 = geometries_from_sfc(hGEOSCtxt, sfc1, &dim); Rcpp::List out; if (pairwise) { if (gmv0.size() != gmv1.size()) Rcpp::stop("for pairwise nearest points, both arguments need to have the same number of geometries"); // #nocov std::vector ls(sfc0.size()); for (size_t i = 0; i < gmv0.size(); i++) ls[i] = geos_ptr(GEOSGeom_createLineString_r(hGEOSCtxt, GEOSNearestPoints_r(hGEOSCtxt, gmv0[i].get(), gmv1[i].get())), hGEOSCtxt); // converts as LINESTRING out = sfc_from_geometry(hGEOSCtxt, ls, dim); } else { std::vector ls(sfc0.size() * sfc1.size()); for (size_t i = 0; i < gmv0.size(); i++) { for (size_t j = 0; j < gmv1.size(); j++) ls[(i * gmv1.size()) + j] = geos_ptr(GEOSGeom_createLineString_r(hGEOSCtxt, GEOSNearestPoints_r(hGEOSCtxt, gmv0[i].get(), gmv1[j].get())), hGEOSCtxt); // converts as LINESTRING R_CheckUserInterrupt(); } out = sfc_from_geometry(hGEOSCtxt, ls, dim); } out.attr("precision") = sfc0.attr("precision"); out.attr("crs") = sfc0.attr("crs"); return out; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_transpose_sparse_incidence(Rcpp::List m, int n) { // transpose a sparse incidence matrix list m that has n columns std::vector sizes(n); for (int i = 0; i < n; i++) sizes[i] = 0; // init for (int i = 0; i < m.size(); i++) { Rcpp::IntegerVector v = m[i]; for (int j = 0; j < v.size(); j++) { if (v[j] > n || v[j] < 0) Rcpp::stop("CPL_transpose_sparse_incidence: index out of bounds"); // #nocov sizes[v[j] - 1] += 1; // count } } Rcpp::List out(n); for (int i = 0; i < n; i++) out[i] = Rcpp::IntegerVector(sizes[i]); for (int i = 0; i < m.size(); i++) { Rcpp::IntegerVector v = m[i]; for (int j = 0; j < v.size(); j++) { size_t new_i = v[j] - 1; Rcpp::IntegerVector w = out[new_i]; w[w.size() - sizes[new_i]] = i + 1; // 1-based sizes[new_i] -= 1; } } return out; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_nary_difference(Rcpp::List sfc) { // initialize objects int dim = 2; std::vector index; GEOSContextScope hGEOSCtxt; std::vector x = geometries_from_sfc(hGEOSCtxt, sfc, &dim); std::vector out; #ifdef HAVE_390 double grid_size = geos_grid_size(sfc); #endif // initialize trees to find overlapping areas quickly for (size_t i = 0; i < x.size(); i++) { // if i'th geometry in x is empty then skip it if (! GEOSisEmpty_r(hGEOSCtxt, x[i].get())) { bool contained = false; TreePtr tree = geos_ptr(GEOSSTRtree_create_r(hGEOSCtxt, 10), hGEOSCtxt); GeomPtr geom = std::move(x[i]); // if out contains geometries than remove overlaps from geom if (out.size() > 0) { // generate tree for all items in out std::vector items(out.size()); for (size_t j = 0; j < out.size(); j++) { items[j] = j; if (! GEOSisEmpty_r(hGEOSCtxt, out[j].get())) { GEOSSTRtree_insert_r(hGEOSCtxt, tree.get(), out[j].get(), &(items[j])); } } // query which geometries in out overlap with geom std::vector tree_sel; GEOSSTRtree_query_r(hGEOSCtxt, tree.get(), geom.get(), cb, &tree_sel); // iterate over items in query and erase overlapping areas in geom for (size_t j = 0; j < tree_sel.size(); j++) { // test if the items are fully contained contained = chk_(GEOSContains_r(hGEOSCtxt, out[tree_sel[j]].get(), geom.get())); if (contained) break; // test if the items intersect with geom if (chk_(GEOSIntersects_r(hGEOSCtxt, geom.get(), out[tree_sel[j]].get()))) { // if they do then erase overlapping parts from geom #ifndef HAVE_390 geom = geos_ptr(GEOSDifference_r(hGEOSCtxt, geom.get(), out[tree_sel[j]].get()), hGEOSCtxt); #else geom = geos_ptr(GEOSDifferencePrec_r(hGEOSCtxt, geom.get(), out[tree_sel[j]].get(), grid_size), hGEOSCtxt); #endif if (geom == nullptr) Rcpp::stop("GEOS exception"); // #nocov // ensure that geom is valid } } } // add geom to out if not empty if (!contained) { index.push_back(i + 1); out.push_back(std::move(geom)); // keep } // check for user interrupt Rcpp::checkUserInterrupt(); } } // prepare output Rcpp::List ret(sfc_from_geometry(hGEOSCtxt, out, dim)); // destroys out ret.attr("crs") = sfc.attr("crs"); Rcpp::IntegerVector out_index = Rcpp::IntegerVector(index.begin(), index.end()); ret.attr("idx") = out_index; return ret; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_nary_intersection(Rcpp::List sfc) { GEOSContextScope hGEOSCtxt; // initialize objects int dim = 2; std::vector< std::vector > index; std::vector x = geometries_from_sfc(hGEOSCtxt, sfc, &dim); std::vector out; int errors = 0; #ifdef HAVE_390 double grid_size = geos_grid_size(sfc); #endif #ifdef HAVE350 notice = 0; GEOSContext_setNoticeMessageHandler_r(hGEOSCtxt, (GEOSMessageHandler_r) __emptyNoticeHandler, (void *) ¬ice); GEOSContext_setErrorMessageHandler_r(hGEOSCtxt, (GEOSMessageHandler_r) __countErrorHandler, (void *) ¬ice); #endif // initialize trees to find overlapping areas quickly for (size_t i = 0; i < x.size(); i++) { // if i'th geometry in x is empty then skip it if (! GEOSisEmpty_r(hGEOSCtxt, x[i].get())) { TreePtr tree = geos_ptr(GEOSSTRtree_create_r(hGEOSCtxt, 10), hGEOSCtxt); GeomPtr geom = std::move(x[i]); // if out contains geometries than remove overlaps from geom if (out.size() > 0) { // generate tree for all items in out std::vector items(out.size()); for (size_t j = 0; j < out.size(); j++) { items[j] = j; if (! GEOSisEmpty_r(hGEOSCtxt, out[j].get())) GEOSSTRtree_insert_r(hGEOSCtxt, tree.get(), out[j].get(), &(items[j])); } // query which geometries in out overlap with geom std::vector tree_sel; GEOSSTRtree_query_r(hGEOSCtxt, tree.get(), geom.get(), cb, &tree_sel); // iterate over items in query and erase overlapping areas in geom for (size_t j = 0; j < tree_sel.size(); j++) { size_t k = tree_sel[j]; #ifndef HAVE_390 GeomPtr inters = geos_ptr(GEOSIntersection_r(hGEOSCtxt, out[k].get(), geom.get()), hGEOSCtxt); #else GeomPtr inters = geos_ptr(GEOSIntersectionPrec_r(hGEOSCtxt, out[k].get(), geom.get(), grid_size), hGEOSCtxt); #endif if (geom.get() != nullptr) { if (inters == nullptr) errors++; else if (!chk_(GEOSisEmpty_r(hGEOSCtxt, inters.get()))) { // i and k intersection // cut out inters from geom: geom = geos_ptr(GEOSDifference_r(hGEOSCtxt, geom.get(), inters.get()), hGEOSCtxt); if (geom == nullptr) Rcpp::stop("GEOS exception"); // #nocov // cut out inters from out[k]: #ifndef HAVE_390 GeomPtr g = geos_ptr(GEOSDifference_r(hGEOSCtxt, out[k].get(), inters.get()), hGEOSCtxt); #else GeomPtr g = geos_ptr(GEOSDifferencePrec_r(hGEOSCtxt, out[k].get(), inters.get(), grid_size), hGEOSCtxt); #endif if (g == nullptr) Rcpp::warning("GEOS difference returns NULL"); // #nocov else { out[k] = std::move(g); out.push_back(std::move(inters)); // keep std::vector idx = index[k]; // k < i, and k might already be an intersection idx.push_back(i + 1); index.push_back(idx); } } } else errors++; } } if (geom != nullptr && ! chk_(GEOSisEmpty_r(hGEOSCtxt, geom.get()))) { out.push_back(std::move(geom)); std::vector idx; idx.push_back(i + 1); index.push_back(idx); } // check for user interrupt Rcpp::checkUserInterrupt(); } } // for i if (errors > 0) Rcpp::Rcout << "geometry errors: " << errors << std::endl; #ifdef HAVE350 if (notice > 0) Rcpp::warning("one or more notices ignored"); notice = 0; GEOSContext_setNoticeHandler_r(hGEOSCtxt, __warningHandler); GEOSContext_setErrorHandler_r(hGEOSCtxt, __errorHandler); #endif size_t j = 0; for (size_t i = 0; i < out.size(); i++) { if (! GEOSisEmpty_r(hGEOSCtxt, out[i].get())) { if (i != j) { out[j] = std::move(out[i]); index[j] = index[i]; } std::sort(index[j].begin(), index[j].end()); j++; } } out.resize(j); index.resize(j); // prepare output Rcpp::List ret(sfc_from_geometry(hGEOSCtxt, out, dim)); ret.attr("crs") = sfc.attr("crs"); Rcpp::List index_list(index.size()); for (size_t i = 0; i < index.size(); i++) { Rcpp::IntegerVector out_index = Rcpp::IntegerVector(index[i].begin(), index[i].end()); index_list[i] = out_index; } ret.attr("idx") = index_list; return ret; } // [[Rcpp::export(rng=false)]] Rcpp::NumericVector CPL_line_project(Rcpp::List lines, Rcpp::List points, bool normalized) { GEOSContextScope hGEOSCtxt; int dim = 2; std::vector l = geometries_from_sfc(hGEOSCtxt, lines, &dim); std::vector p = geometries_from_sfc(hGEOSCtxt, points, &dim); Rcpp::NumericVector ret(p.size()); if (normalized) { for (size_t i = 0; i < l.size() && i < p.size(); i++) ret[i] = GEOSProjectNormalized_r(hGEOSCtxt, l[i].get(), p[i].get()); } else { for (size_t i = 0; i < l.size() && i < p.size(); i++) ret[i] = GEOSProject_r(hGEOSCtxt, l[i].get(), p[i].get()); } return ret; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_line_interpolate(Rcpp::List lines, Rcpp::NumericVector dists, bool normalized) { GEOSContextScope hGEOSCtxt; int dim = 2; std::vector l = geometries_from_sfc(hGEOSCtxt, lines, &dim); std::vector p(l.size()); if (normalized) { for (int i = 0; i < (int) l.size() && i < dists.size(); i++) p[i] = geos_ptr(GEOSInterpolateNormalized_r(hGEOSCtxt, l[i].get(), dists[i]), hGEOSCtxt); } else { for (int i = 0; i < (int) l.size() && i < dists.size(); i++) p[i] = geos_ptr(GEOSInterpolate_r(hGEOSCtxt, l[i].get(), dists[i]), hGEOSCtxt); } Rcpp::List ret(sfc_from_geometry(hGEOSCtxt, p, dim)); return ret; } ================================================ FILE: src/hex.cpp ================================================ #include inline unsigned char char2int(char c) { if (c >= '0' && c <= '9') return c - '0'; if (c >= 'a' && c <= 'f') return c - 'a' + 10; if (c >= 'A' && c <= 'F') return c - 'A' + 10; Rcpp::stop("char2int: unrecognized character in hex string"); return '0'; // never reached, satisfy -Wreturn-type #nocov } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_hex_to_raw(Rcpp::CharacterVector cx) { // convert hexadecimal string into a raw vector: Rcpp::List output(cx.size()); for (int j = 0; j < cx.size(); j++) { Rcpp::RawVector raw(cx[j].size() / 2); const char *cp = cx[j]; for (int i = 0; i < raw.size(); i++) { raw[i] = (char2int(cp[0]) << 4) + char2int(cp[1]); cp += 2; if (i % 131072 == 0) // 2^17, see https://www.jottr.org/2015/06/05/checkuserinterrupt/ Rcpp::checkUserInterrupt(); } output[j] = raw; if (j % 1024 == 0) Rcpp::checkUserInterrupt(); } return output; } // [[Rcpp::export(rng=false)]] Rcpp::CharacterVector CPL_raw_to_hex(Rcpp::RawVector raw) { // convert a raw vector into hexadecimal string: std::vector str(raw.size() * 2 + 1); char hex[16] = { '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f' }; unsigned char *cp = &(raw[0]); int j = 0; for (int i = 0; i < raw.size(); i++) { str[j] = hex[(((int) cp[i]) / 16)]; j++; str[j] = hex[(((int) cp[i]) % 16)]; j++; } str[j] = '\0'; return Rcpp::CharacterVector::create(str.data()); } ================================================ FILE: src/hex.h ================================================ #ifndef SF_HEX_H_ #define SF_HEX_H_ Rcpp::List CPL_hex_to_raw(Rcpp::CharacterVector cx); Rcpp::CharacterVector CPL_raw_to_hex(Rcpp::RawVector raw); #endif // SF_HEX_H_ ================================================ FILE: src/mdim.cpp ================================================ // https://github.com/rouault/gdal/blob/rfc75/gdal/doc/source/tutorials/multidimensional_api_tut.rst #include "gdal_priv.h" #include #define NO_GDAL_CPP_HEADERS #include "gdal.h" #include "gdal_sf_pkg.h" using namespace Rcpp; #if defined(__MINGW32__) && !defined(__MINGW64__) #define WIN32BIT #endif #if GDAL_VERSION_NUM >= 3040000 && !(defined(WIN32BIT)) CharacterVector get_attributes(std::vector> a) { CharacterVector l(a.size()); CharacterVector na(a.size()); for (size_t i = 0; i < a.size(); i++) { l[i] = a[i]->ReadAsString(); na[i] = a[i]->GetName(); } if (a.size()) l.attr("names") = na; return l; } #endif #if GDAL_VERSION_NUM >= 3010000 && !(defined(WIN32BIT)) List get_dimension_values(std::shared_ptr array) { List ret(1); if (array == nullptr) { warning("array is NULL"); return ret; // FIXME but this is an error essentially. } size_t nValues = 1; std::vector anCount; IntegerVector dims; std::vector offset; CharacterVector d_names; for (const auto &poDim: array->GetDimensions()) { anCount.push_back(static_cast(poDim->GetSize())); dims.push_back(static_cast(poDim->GetSize())); d_names.push_back(poDim->GetName()); offset.push_back(0); nValues *= anCount.back(); } #if GDAL_VERSION_NUM >= 3040000 && !(defined(WIN32BIT)) CharacterVector att = get_attributes(array->GetAttributes()); #else CharacterVector att; #endif if (array->GetDataType().GetClass() == GEDTC_NUMERIC) { NumericVector vec( nValues ); bool ok = array->Read(offset.data(), anCount.data(), nullptr, /* step: defaults to 1,1,1 */ nullptr, /* stride: default to row-major convention */ GDALExtendedDataType::Create(GDT_Float64), vec.begin()); if (!ok) Rcout << "cannot convert values for array " << array->GetName() << std::endl; vec.attr("dim") = dims; vec.attr("units") = array->GetUnit(); vec.attr("d_names") = d_names; if (att.size()) vec.attr("attributes") = att; ret[0] = vec; } else { // CharacterVector vec(nValues); std::vector vec(nValues); bool ok = array->Read(offset.data(), anCount.data(), nullptr, /* step: defaults to 1,1,1 */ nullptr, /* stride: default to row-major convention */ GDALExtendedDataType::CreateString(100), vec.data()); if (!ok) Rcout << "cannot convert values for array " << array->GetName() << std::endl; CharacterVector cv(nValues); for (size_t i = 0; i < nValues; i++) cv[i] = vec[i]; if (att.size()) cv.attr("attributes") = att; ret[0] = cv; } return ret; } List get_dimension(const std::shared_ptr dim) { if (dim == nullptr) stop("dim is NULL"); List dv; if (dim->GetIndexingVariable() == nullptr) { NumericVector nv(dim->GetSize()); for (size_t i = 0; i < dim->GetSize(); i++) nv[i] = i + 1.0; dv = List::create(nv); } else dv = get_dimension_values(dim->GetIndexingVariable()); List dimension = List::create( _["from"] = IntegerVector::create(1), _["to"] = IntegerVector::create(dim->GetSize()), _["values"] = dv, _["type"] = CharacterVector::create(dim->GetType()), _["direction"] = CharacterVector::create(dim->GetDirection()) ); return dimension; } // if present, return geometry elements (coordinates, indexes), else return empty list List get_geometry(std::shared_ptr curGroup) { List lst; for (const auto &an: curGroup->GetMDArrayNames()) { auto a(curGroup->OpenMDArray(an)); if (a == nullptr) { Rcout << "could not open geometry array " << an << std::endl; stop("get_geometry(): cannot OpenMDArray()"); } auto geom = a->GetAttribute("geometry"); if (geom) { a = curGroup->OpenMDArray(geom->ReadAsString()); if (a == nullptr) { Rcout << "could not open geometry array " << geom->ReadAsString() << std::endl; stop("geometry array missing"); } auto nc = a->GetAttribute("node_coordinates"); if (nc && nc->GetDataType().GetClass() == GEDTC_STRING && nc->GetDimensionCount() == 0) { const char *ncs = nc->ReadAsString(); if (ncs) { const CPLStringList nc_names(CSLTokenizeString2(ncs, " ", 0)); // x and y coordinate array auto gt = a->GetAttribute("geometry_type"); if (gt == nullptr || gt->GetDataType().GetClass() != GEDTC_STRING) stop("cannot get geometry_type attribute"); auto nco = a->GetAttribute("node_count"); auto pnco = a->GetAttribute("part_node_count"); auto ir = a->GetAttribute("interior_ring"); lst = List::create( _["geometry_type"] = CharacterVector::create(gt->ReadAsString()), _["x"] = get_dimension_values(curGroup->OpenMDArray(nc_names[0])), _["y"] = get_dimension_values(curGroup->OpenMDArray(nc_names[1])), _["node_count"] = nco ? get_dimension_values(curGroup->OpenMDArray(nco->ReadAsString())) : List::create(), _["part_node_count"] = pnco ? get_dimension_values(curGroup->OpenMDArray(pnco->ReadAsString())) : List::create(), _["interior_ring"] = ir ? get_dimension_values(curGroup->OpenMDArray(ir->ReadAsString())): List::create() ); } } } } return(lst); } List get_all_arrays(std::shared_ptr curGroup, List ret, std::string name) { auto array_names(curGroup->GetMDArrayNames()); // for (size_t i = 0 i < array_names CharacterVector a(array_names.size()); // ret needs to be a _named_ list, so that na is never null CharacterVector na = ret.attr("names"); if (a.size() > 0) { // group with array(s): for (int i = 0; i < a.size(); i++) a[i] = array_names[i]; ret.push_back(a); CharacterVector gn; // gn.push_back(""); std::string group_name; if (name == "/") group_name = name; else group_name = name + "/"; na.push_back(group_name); } ret.attr("names") = na; auto gn(curGroup->GetGroupNames()); for (const auto &gn: curGroup->GetGroupNames()) { // iterate over groups: std::string slash; if (name == "/") slash = ""; else slash = "/"; ret = get_all_arrays(curGroup->OpenGroup(gn), ret, name + slash + gn); } return ret; } std::shared_ptr get_array(std::shared_ptr grp, const std::string &osName) { CPLStringList aosTokens(CSLTokenizeString2(osName.c_str(), "/", 0)); for (int i = 0; i < aosTokens.size() - 1; i++) { auto curGroupNew = grp->OpenGroup(aosTokens[i]); if (!curGroupNew) { Rcout << "Cannot find group " << aosTokens[i] << std::endl; stop("group not found"); } grp = curGroupNew; } const char *pszArrayName = aosTokens[aosTokens.size() - 1]; auto array(grp->OpenMDArray(pszArrayName)); if (!array) { Rcout << "Cannot open array " << pszArrayName << std::endl; stop("array not found"); } return array; } // [[Rcpp::export(rng=false)]] List CPL_read_mdim(CharacterVector file, CharacterVector array_names, CharacterVector oo, IntegerVector offset, IntegerVector count, IntegerVector step, bool proxy = false, bool debug = false) { std::vector oo_char = create_options(oo, true); // open options auto poDataset = std::unique_ptr( GDALDataset::Open((const char *) file[0], GDAL_OF_MULTIDIM_RASTER | GDAL_OF_VERBOSE_ERROR, nullptr, oo_char.data(), nullptr)); if( !poDataset ) stop("file not found"); auto poRootGroup = poDataset->GetRootGroup(); if( !poRootGroup ) stop("cannot open root group"); if (array_names.size() == 1 && array_names[0] == "?") { List l; l.attr("names") = CharacterVector::create(); return get_all_arrays(poRootGroup, l, poRootGroup->GetName()); } auto curGroup = poRootGroup; // find possible vector geometry array, and construct List geometry = get_geometry(curGroup); // Rcout << "name: " << curGroup->GetName() << " full_name: " << curGroup->GetFullName() << std::endl; if (array_names.size() == 0) { // find the one(s) with the most dimensions: int ndim = 0; int largest_size = 0; for (const auto &an: curGroup->GetMDArrayNames()) { // find largest size: auto a(curGroup->OpenMDArray(an)); ndim = a->GetDimensions().size(); if (ndim > largest_size) largest_size = ndim; } for (const auto &an: curGroup->GetMDArrayNames()) { // identify target arrays: auto a(curGroup->OpenMDArray(an)); ndim = a->GetDimensions().size(); if (ndim == largest_size) array_names.push_back(an); } if (array_names.size() == 0) stop("no array names found"); } int n = array_names.size(); const char *name = array_names[0]; std::shared_ptr array; array = get_array(curGroup, name); if (!array) stop("Cannot find array"); if (offset.size() != 0 && (size_t) offset.size() != array->GetDimensionCount()) stop("offset has wrong size"); if (count.size() != 0 && (size_t) count.size() != array->GetDimensionCount()) stop("count has wrong size"); if (step.size() != 0 && (size_t) step.size() != array->GetDimensionCount()) stop("step has wrong size"); if (proxy && (offset.size() != 0 || count.size() != 0 || step.size() != 0)) stop("if proxy=TRUE, do not set offset, count or step, use these when reading data (downsample)"); size_t nValues = 1; std::vector anCount; std::vector stp; IntegerVector dims; CharacterVector dim_names; std::vector offst; List dimensions; int i = 0; for (const auto &poDim: array->GetDimensions()) { dim_names.push_back(poDim->GetName()); if (offset.size() == 0) offst.push_back(0); else offst.push_back(offset[i]); if (step.size() == 0) stp.push_back(1); else stp.push_back(step[i]); if (count.size() == 0 || count[i] == NA_INTEGER || count[i] <= 0) anCount.push_back((poDim->GetSize() - offst.back())/stp.back()); else anCount.push_back(count[i]); dims.push_back(anCount.back()); nValues *= anCount.back(); if (debug) { Rcout << "Dimension name: " << poDim->GetName() << "\n"; if (count.size() > i) Rcout << "count[i]: " << count[i] << "\n"; Rcout << "nValues: " << nValues << "\n"; Rcout << "stp[i]: " << stp[i] << "\n"; Rcout << "anCount[i]: " << anCount[i] << "\n"; Rcout << "offst[i]: " << offst[i] << "\n"; Rcout << "dims[i]: " << dims[i] << "\n"; } List dimension(get_dimension(poDim)); dimensions.push_back(dimension); // mind the "s" i++; } List vec_lst(n); CharacterVector a_names(n); for (int i = 0; i < n; i++) { name = array_names[i]; a_names[i] = array_names[i]; auto arr(get_array(curGroup, name)); dims.attr("names") = dim_names; dimensions.attr("names") = dim_names; if (! proxy) { // read the arrays: auto data_type(arr->GetDataType()); size_t sz = data_type.GetSize(); if (data_type.GetClass() == GEDTC_NUMERIC) { NumericVector vec(nValues); if (debug) Rcout << "size of vec: " << vec.size() << "\n"; bool ok = arr->Read(offst.data(), anCount.data(), stp.data(), /* step: defaults to 1,1,1 */ nullptr, /* stride: default to row-major convention */ GDALExtendedDataType::Create(GDT_Float64), vec.begin()); if (!ok) stop("Cannot read array into a Float64 buffer"); bool has_offset = false; double offst = arr->GetOffset(&has_offset); if (!has_offset) offst = 0.0; bool has_scale = false; double scale = arr->GetScale(&has_scale); if (!has_scale) scale = 1.0; bool has_nodata = false; double nodata_value = arr->GetNoDataValueAsDouble(&has_nodata); if (has_offset || has_scale || has_nodata) { for (size_t j = 0; j < nValues; j++) { if (ISNAN(vec[j]) || (has_nodata && vec[j] == nodata_value)) vec[j] = NA_REAL; else vec[j] = vec[j] * scale + offst; } } vec.attr("dim") = dims; vec.attr("units") = arr->GetUnit(); vec_lst[i] = vec; } else if (data_type.GetClass() == GEDTC_COMPOUND) { const auto &components = data_type.GetComponents(); std::vector buf(sz * nValues); bool ok = arr->Read(offst.data(), anCount.data(), stp.data(), /* step: defaults to 1,1,1 */ nullptr, /* stride: default to row-major convention */ data_type, &buf[0]); if (!ok) stop("Cannot read array into Compound buffer"); DataFrame tbl; GByte *v = buf.data(); for (const auto &co: components) { auto t(co->GetType()); if (t.GetClass() == GEDTC_NUMERIC) { if (t.GetNumericDataType() != GDT_Float64) stop("only Float64 data supported in numeric compounds"); NumericVector vec(nValues); for (size_t j = 0; j < nValues; j++) memcpy(&(vec[j]), v + j * sz + co->GetOffset(), sizeof(double)); tbl.push_back(vec, co->GetName()); } else if (t.GetClass() == GEDTC_STRING) { CharacterVector vec(nValues); const char *str; for (size_t j = 0; j < nValues; j++) { memcpy(&str, v + j * sz + co->GetOffset(), sizeof(const char *)); vec[j] = str; // deep copy } tbl.push_back(vec, co->GetName()); } else stop("unsupported type"); } vec_lst[i] = tbl; } else { // GEDTC_STRING: std::vector buf(sz * nValues); bool ok = arr->Read(offst.data(), anCount.data(), stp.data(), /* step: defaults to 1,1,1 */ nullptr, /* stride: default to row-major convention */ data_type, &buf[0]); if (!ok) stop("Cannot read array into string buffer"); GByte *v = buf.data(); CharacterVector vec(nValues); const char *str; for (size_t j = 0; j < nValues; j++) { memcpy(&str, v + j * sz, sizeof(const char *)); vec[j] = str; // deep copy } vec.attr("dim") = dims; vec.attr("units") = arr->GetUnit(); vec_lst[i] = vec; } } } vec_lst.attr("names") = a_names; std::shared_ptr srs = array->GetSpatialRef(); List ret = List::create( _["array_list"] = vec_lst, _["dimensions"] = dimensions, _["srs"] = srs == nullptr ? CharacterVector::create(NA_STRING) : wkt_from_spatial_reference(srs.get()), _["geometry"] = geometry ); return ret; } /// WRITE: void write_attributes(std::shared_ptr md, CharacterVector attrs) { if (attrs.size() > 0) { CharacterVector names = attrs.attr("names"); std::vector empty; for (int i = 0; i < attrs.size(); i++) { const char *name = names[i]; std::shared_ptr at = md->CreateAttribute(name, empty, GDALExtendedDataType::CreateString(0), nullptr); if (at == nullptr) { Rcout << names[i] << ":" << std::endl; warning("could not create attribute: does it already exist? (skipping)"); } else at->Write(attrs[i]); } } } // [[Rcpp::export(rng=false)]] List CPL_write_mdim(CharacterVector name, CharacterVector driver, IntegerVector dimensions, List variables, CharacterVector wkt, CharacterVector xy, CharacterVector RootGroupOptions, CharacterVector CreationOptions, bool as_float = true) { if (name.size() != 1) stop("name should have length 1"); if (driver.size() != 1) stop("driver should have length 1"); GDALDriver *nc = GetGDALDriverManager()->GetDriverByName(driver[0]); if (nc == NULL) stop("cannot open driver"); OGRSpatialReference *dest = NULL; if (wkt.size()) { char *cp = wkt[0]; dest = new OGRSpatialReference; dest->importFromWkt((const char *) cp); } // create n-D array std::vector rgo = create_options(RootGroupOptions, true); std::vector co = create_options(CreationOptions, true); // open options GDALDataset *md = nc->CreateMultiDimensional(name[0], RootGroupOptions.size() ? rgo.data() : nullptr, CreationOptions.size() ? co.data() : nullptr); if (md == NULL) stop("Cannot create MD array on this driver"); std::shared_ptr g = md->GetRootGroup(); if (g == NULL) stop("Cannot get RootGroup"); // create dimensions on g: CharacterVector dimnames; if (dimensions.attr("names") != R_NilValue) dimnames = dimensions.attr("names"); else stop("dimensions should have names"); std::vector> all_dims; for (int i = dimensions.size() - 1; i >= 0; i--) { // backwards, for whatever reason std::string type; std::string direction = ""; if (dimnames[i] == xy[0]) // "x" type = "HORIZONTAL_X"; else if (dimnames[i] == xy[1]) // "y" type = "HORIZONTAL_Y"; else if (dimnames[i] == "depth") { type = "VERTICAL"; direction = "DOWN"; } else if (dimnames[i] == "height") { type = "VERTICAL"; direction = "UP"; } else if (dimnames[i] == "time") type = "TEMPORAL"; else type = ""; const char *name = dimnames[i]; std::shared_ptr d = g->CreateDimension(name, type, direction, dimensions[i], nullptr); if (d == nullptr) stop("creation of dimension failed"); all_dims.push_back(d); } std::reverse(all_dims.begin(), all_dims.end()); // because I can't think backwards // create & write variables to g; write attributes GDALExtendedDataType edt = GDALExtendedDataType::Create(GDT_Float64); CharacterVector names; if (variables.attr("names") != R_NilValue) names = variables.attr("names"); else stop("variables should have names"); LogicalVector which_crs; if (variables.attr("which_crs") != R_NilValue) which_crs = variables.attr("which_crs"); else stop("which_crs attribute missing"); LogicalVector is_numeric; if (variables.attr("is_numeric") != R_NilValue) is_numeric = variables.attr("is_numeric"); else stop("is_numeric attribute missing"); for (int i = 0; i < variables.size(); i++) { NumericVector a; CharacterVector c; IntegerVector which_dims; std::vector> dims; if (is_numeric[i]) { if (as_float) edt = GDALExtendedDataType::Create(GDT_Float32); else edt = GDALExtendedDataType::Create(GDT_Float64); a = variables[i]; if (a.attr("which_dims") == R_NilValue) stop("variable has no attribute which_dims"); else which_dims = a.attr("which_dims"); } else { edt = GDALExtendedDataType::CreateString(0); c = variables[i]; if (c.attr("which_dims") == R_NilValue) stop("variable has no attribute which_dims"); else which_dims = c.attr("which_dims"); } for (int i = which_dims.size() - 1; i >= 0; i--) { if (which_dims[i] == NA_INTEGER) stop("NA value in which_dims: logic error"); dims.push_back(all_dims[which_dims[i]]); } const char *name = names[i]; std::shared_ptr mda = g->CreateMDArray(name, dims, edt, nullptr); if (dims.size() == 1 && names[i] == dimnames[which_dims[0]]) dims[0]->SetIndexingVariable(mda); // FIXME: NetCDF doesn't have? if (dest != NULL && which_crs[i] && !mda->SetSpatialRef(dest)) warning("failed to assign CRS to array"); // set start & count of writing area: std::vector start; std::vector count; for (int i = dims.size() - 1; i >= 0; i--) { start.push_back(0); // FIXME: modify if updating sub-array count.push_back(dimensions[which_dims[i]]); } bool success = true; if (is_numeric[i]) { // write numeric array: if (a.attr("attrs") != R_NilValue) write_attributes(mda, a.attr("attrs")); if (a.size() != 0) { // Rcout << "Variable: " << name << ", ndims: " << dims.size() << ", crs: " << which_crs[i] << std::endl; if (as_float) { std::vector flt(a.size()); for (int j = 0; j < a.size(); j++) flt[j] = a[j]; success = mda->Write(start.data(), count.data(), nullptr, nullptr, edt, flt.data(), nullptr, 0); } else success = mda->Write(start.data(), count.data(), nullptr, nullptr, edt, &(a[0]), nullptr, 0); } } else { // write character array: if (c.attr("attrs") != R_NilValue) write_attributes(mda, c.attr("attrs")); if (c.size() != 0) { if (dims.size() != 1) stop("can only write one-dimensional character variables"); std::vector v; for (int i = 0; i < c.size(); i++) { const char *cp = c[i]; v.push_back(cp); } success = mda->Write(start.data(), count.data(), nullptr, nullptr, edt, v.data(), nullptr, 0); } } if (! success) Rcout << "Error writing array " << name << std::endl; } // close, free & return: GDALClose(md); if (dest != NULL) delete dest; return variables; } #else List CPL_read_mdim(CharacterVector file, CharacterVector array_names, CharacterVector oo, IntegerVector offset, IntegerVector count, IntegerVector step, bool proxy = false, bool debug = false) { stop("requires GDAL >= 3.1.0 and 64-bit"); } List CPL_write_mdim(CharacterVector name, CharacterVector driver, IntegerVector dimensions, List variables, CharacterVector wkt, CharacterVector xy, CharacterVector RootGroupOptions, CharacterVector CreationOptions, bool as_float = true) { stop("requires GDAL >= 3.1.0 and 64-bit"); } #endif ================================================ FILE: src/ops.cpp ================================================ #include void add_feature(SEXP &feature, SEXP &value) { double* p_feature = REAL(feature); double* p_value = REAL(value); int nval = LENGTH(value); if (Rf_isMatrix(feature)) { int nrow = Rf_nrows(feature); int ncol = Rf_ncols(feature); ncol = ncol > 2 ? 2 : ncol; for (int i = 0; i < nrow * ncol; i ++) { p_feature[i] = p_feature[i] + p_value[(i / nrow) % nval]; } } else { int nfeat = LENGTH(feature); nfeat = nfeat > 2 ? 2 : nfeat; for (int i = 0; i < nfeat; i ++) { p_feature[i] = p_feature[i] + p_value[i % nval]; } } } void mult_feature(SEXP &feature, SEXP &value) { double* p_feature = REAL(feature); double* p_value = REAL(value); int nval = LENGTH(value); if (Rf_isMatrix(feature)) { int nrow = Rf_nrows(feature); int ncol = Rf_ncols(feature); ncol = ncol > 2 ? 2 : ncol; for (int i = 0; i < nrow * ncol; i ++) { p_feature[i] = p_feature[i] * p_value[(i / nrow) % nval]; } } else { int nfeat = LENGTH(feature); // # nocov start nfeat = nfeat > 2 ? 2 : nfeat; for (int i = 0; i < nfeat; i ++) { p_feature[i] = p_feature[i] * p_value[i % nval]; } // # nocov end } } void recursive_opp(SEXP &feature, SEXP &value, int mult) { if (Rf_isVectorList(feature)) { for (int i = 0; i < LENGTH(feature); i++) { SEXP next_feature = VECTOR_ELT(feature, i); if (Rf_isInteger(next_feature)) { SEXP num_feature = PROTECT(Rf_coerceVector(next_feature, REALSXP)); DUPLICATE_ATTRIB(num_feature, next_feature); next_feature = SET_VECTOR_ELT(feature, i, num_feature); UNPROTECT(1); } recursive_opp(next_feature, value, mult); } } else { if (mult) { mult_feature(feature, value); } else { add_feature(feature, value); } } } void transform_bbox(SEXP &feature, SEXP &value, int mult) { double* p_bbox = REAL(Rf_getAttrib(feature, Rf_install("bbox"))); double* p_value = REAL(value); if (mult) { p_bbox[0] = p_bbox[0] * p_value[0]; p_bbox[2] = p_bbox[2] * p_value[0]; p_bbox[1] = p_bbox[1] * p_value[1 % LENGTH(value)]; p_bbox[3] = p_bbox[3] * p_value[1 % LENGTH(value)]; } else { p_bbox[0] = p_bbox[0] + p_value[0]; p_bbox[2] = p_bbox[2] + p_value[0]; p_bbox[1] = p_bbox[1] + p_value[1 % LENGTH(value)]; p_bbox[3] = p_bbox[3] + p_value[1 % LENGTH(value)]; } } //[[Rcpp::export(rng=false)]] SEXP opp_sfc(SEXP geom, SEXP value, SEXP mult, SEXP crs) { SEXP new_geom = PROTECT(Rf_duplicate(geom)); int multiply = INTEGER(mult)[0] == 1; recursive_opp(new_geom, value, multiply); transform_bbox(new_geom, value, multiply); Rf_setAttrib(new_geom, Rf_install("crs"), crs); UNPROTECT(1); return new_geom; } //[[Rcpp::export(rng=false)]] SEXP normalize_sfc(SEXP geom, SEXP min, SEXP range, SEXP crs) { SEXP new_geom = PROTECT(Rf_duplicate(geom)); recursive_opp(new_geom, min, 0); recursive_opp(new_geom, range, 1); transform_bbox(new_geom, min, 0); transform_bbox(new_geom, range, 1); Rf_setAttrib(new_geom, Rf_install("crs"), crs); UNPROTECT(1); return new_geom; } ================================================ FILE: src/polygonize.cpp ================================================ #include #include #include // GDALDriver #include #include #include #include #include #include #include // atoi #include #include #include #include "gdal.h" #include "gdal_read.h" #include "gdal_sf_pkg.h" // # nocov start // [[Rcpp::export(rng=false)]] Rcpp::List CPL_polygonize(Rcpp::CharacterVector raster, Rcpp::CharacterVector mask_name, Rcpp::CharacterVector raster_driver, Rcpp::CharacterVector vector_driver, Rcpp::CharacterVector vector_dsn, Rcpp::CharacterVector options, Rcpp::IntegerVector iPixValField, Rcpp::CharacterVector contour_options, bool use_contours = false, bool use_integer = true) { GDALDataset *poDataset = (GDALDataset *) GDALOpenEx(raster[0], GA_ReadOnly, raster_driver.size() ? create_options(raster_driver).data() : NULL, // options.size() ? create_options(options).data() : NULL, NULL, NULL); if (poDataset == NULL) { Rcpp::Rcout << "trying to read file: " << raster[0] << std::endl; // #nocov Rcpp::stop("file not found"); // #nocov } const char *wkt = poDataset->GetProjectionRef(); GDALRasterBand *poBand = NULL; if (poDataset->GetRasterCount() > 0) poBand = poDataset->GetRasterBand( 1 ); else Rcpp::Rcout << "No bands in raster file." << std::endl; // #nocov // mask: GDALDataset *maskDataset = NULL; GDALRasterBand *maskBand = NULL; if (mask_name.size()) { maskDataset = (GDALDataset *) GDALOpenEx(mask_name[0], GA_ReadOnly, raster_driver.size() ? create_options(raster_driver).data() : NULL, // options.size() ? create_options(options).data() : NULL, NULL, NULL); if (maskDataset == NULL) { Rcpp::Rcout << "trying to read file: " << mask_name[0] << std::endl; // #nocov Rcpp::stop("file not found"); // #nocov } if (maskDataset->GetRasterCount() > 0) maskBand = maskDataset->GetRasterBand( 1 ); else Rcpp::Rcout << "No bands in mask file." << std::endl; // #nocov } // output: vector layer GDALDriver *poDriver = GetGDALDriverManager()->GetDriverByName(vector_driver[0]); if (poDriver == NULL) { Rcpp::Rcout << "driver `" << vector_driver[0] << "' not available." << std::endl; // #nocov Rcpp::stop("Driver not available.\n"); // #nocov } GDALDataset *poDS; if ((poDS = poDriver->Create(vector_dsn[0], 0, 0, 0, GDT_Unknown, NULL)) == NULL) { Rcpp::Rcout << "Creating dataset " << vector_dsn[0] << " failed." << std::endl; // #nocov Rcpp::stop("Creation failed.\n"); // #nocov } OGRSpatialReference *sr = NULL; if (wkt != NULL && *wkt != '\0') { sr = new OGRSpatialReference; sr = handle_axis_order(sr); #if GDAL_VERSION_NUM < 2030000 char **ppt = (char **) &wkt; #else const char **ppt = (const char **) &wkt; #endif sr->importFromWkt(ppt); } OGRLayer *poLayer = poDS->CreateLayer("raster", sr, wkbMultiPolygon, NULL); delete sr; if (use_integer) { // create field: OGRFieldDefn oField("Value", OFTInteger); if (poLayer->CreateField(&oField) != OGRERR_NONE) Rcpp::stop("Creating attribute field failed.\n"); // #nocov if (GDALPolygonize((GDALRasterBandH) poBand, maskBand, (OGRLayerH) poLayer, iPixValField[0], NULL, // create_options(options, true), NULL, NULL) != OGRERR_NONE) Rcpp::Rcout << "GDALPolygonize returned an error" << std::endl; // #nocov } else { OGRFieldDefn oField("Value", OFTReal); if (poLayer->CreateField(&oField) != OGRERR_NONE) Rcpp::stop("Creating attribute field failed.\n"); // #nocov OGRFieldDefn minField("Min", OFTReal); if (poLayer->CreateField(&minField) != OGRERR_NONE) Rcpp::stop("Creating attribute field failed.\n"); // #nocov OGRFieldDefn maxField("Max", OFTReal); if (poLayer->CreateField(&maxField) != OGRERR_NONE) Rcpp::stop("Creating attribute field failed.\n"); // #nocov if (!use_contours) { if (GDALFPolygonize((GDALRasterBandH) poBand, maskBand, (OGRLayerH) poLayer, iPixValField[0], create_options(options, true).data(), NULL, NULL) != OGRERR_NONE) Rcpp::Rcout << "GDALFPolygonize returned an error" << std::endl; // #nocov } else { #if GDAL_VERSION_NUM >= 2040000 if (GDALContourGenerateEx((GDALRasterBandH) poBand, (void *) poLayer, create_options(contour_options).data(), NULL, NULL) != OGRERR_NONE) Rcpp::stop("GDALContourGenerateEx returned an error"); #else Rcpp::stop("contour requires GDAL >= 2.4.0"); #endif } } Rcpp::NumericVector type(1); type[0] = 0; Rcpp::CharacterVector fid_column; // empty Rcpp::List lst = sf_from_ogrlayer(poLayer, false, true, type, fid_column, true, -1); GDALClose(poDataset); // raster GDALClose(poDS); // vector if (maskDataset != NULL) GDALClose(maskDataset); // mask return lst; } // # nocov end // [[Rcpp::export(rng=false)]] Rcpp::List CPL_rasterize(Rcpp::CharacterVector raster, Rcpp::CharacterVector raster_driver, Rcpp::List sfc, Rcpp::NumericVector values, Rcpp::CharacterVector options, Rcpp::NumericVector NA_value) { GDALDataset *poDataset = (GDALDataset *) GDALOpenEx(raster[0], GDAL_OF_UPDATE, raster_driver.size() ? create_options(raster_driver).data() : NULL, // options.size() ? create_options(options).data() : NULL, NULL, NULL); if (poDataset == NULL) { Rcpp::Rcout << "trying to read file: " << raster[0] << std::endl; // #nocov Rcpp::stop("file not found"); // #nocov } std::vector geoms = ogr_from_sfc(sfc, NULL); // int bandlist = 1; std::vector bandlist(poDataset->GetRasterCount()); for (size_t i = 0; i < bandlist.size(); i++) bandlist[i] = (int) i+1; // 1-based CPLErr err = GDALRasterizeGeometries((GDALDatasetH) poDataset, // hDS, poDataset->GetRasterCount(), // int nBandCount, bandlist.data(), // int * panBandList, geoms.size(), // int nGeomCount, (OGRGeometryH *) geoms.data(), // OGRGeometryH * pahGeometries, NULL, // GDALTransformerFunc pfnTransformer, NULL, // void * pTransformArg, (double *) &(values[0]), // double * padfGeomBurnValue, options.size() ? create_options(options).data() : NULL, // char ** papszOptions, NULL, // GDALProgressFunc pfnProgress, NULL //void * pProgressArg ); for (size_t i = 0; i < geoms.size(); i++) OGRGeometryFactory::destroyGeometry(geoms[i]); if (err != OGRERR_NONE) Rcpp::Rcout << "GDALRasterizeGeometries returned an error" << std::endl; // #nocov GDALClose(poDataset); // raster return Rcpp::List::create(); } ================================================ FILE: src/proj.cpp ================================================ #include #include #include #include "Rcpp.h" #define NO_GDAL_CPP_HEADERS #include "gdal_sf_pkg.h" // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_proj_h(bool b = false) { #if defined(HAVE_PROJ_H) && !defined(ACCEPT_USE_OF_DEPRECATED_PROJ_API_H) return true; #else return false; #endif } #if defined(HAVE_PROJ_H) && !defined(ACCEPT_USE_OF_DEPRECATED_PROJ_API_H) // new api # include #if PROJ_VERSION_MAJOR > 7 # define HAVE_71 #else # if PROJ_VERSION_MAJOR == 7 # if PROJ_VERSION_MINOR >= 1 # define HAVE_71 # endif # endif #endif // [[Rcpp::export(rng=false)]] Rcpp::DataFrame CPL_get_pipelines(Rcpp::CharacterVector crs, Rcpp::CharacterVector authority, Rcpp::NumericVector AOI, Rcpp::CharacterVector Use, Rcpp::CharacterVector grid_availability, double accuracy = -1.0, bool strict_containment = false, bool axis_order_auth_compl = false) { #ifdef HAVE_71 if (crs.size() != 2) Rcpp::stop("length 2 character vector expected"); const char *auth = NULL; if (authority.size()) auth = authority[0]; PJ_OPERATION_FACTORY_CONTEXT *factory_ctx = proj_create_operation_factory_context(PJ_DEFAULT_CTX, auth); if (accuracy >= 0.0) proj_operation_factory_context_set_desired_accuracy(PJ_DEFAULT_CTX, factory_ctx, accuracy); if (AOI.size() == 4) proj_operation_factory_context_set_area_of_interest(PJ_DEFAULT_CTX, factory_ctx, AOI[0], AOI[1], AOI[2], AOI[3]); else if (Use.size() == 1) { if (Use[0] == "NONE") proj_operation_factory_context_set_crs_extent_use(PJ_DEFAULT_CTX, factory_ctx, PJ_CRS_EXTENT_NONE); else if (Use[0] == "BOTH") proj_operation_factory_context_set_crs_extent_use(PJ_DEFAULT_CTX, factory_ctx, PJ_CRS_EXTENT_BOTH); else if (Use[0] == "INTERSECTION") proj_operation_factory_context_set_crs_extent_use(PJ_DEFAULT_CTX, factory_ctx, PJ_CRS_EXTENT_INTERSECTION); else if (Use[0] == "SMALLEST") proj_operation_factory_context_set_crs_extent_use(PJ_DEFAULT_CTX, factory_ctx, PJ_CRS_EXTENT_SMALLEST); else Rcpp::stop("unknown value for Use"); } // FIXME: // handle many more constraining options if (strict_containment) proj_operation_factory_context_set_spatial_criterion(PJ_DEFAULT_CTX, factory_ctx, PROJ_SPATIAL_CRITERION_STRICT_CONTAINMENT); else proj_operation_factory_context_set_spatial_criterion(PJ_DEFAULT_CTX, factory_ctx, PROJ_SPATIAL_CRITERION_PARTIAL_INTERSECTION); // PROJ_GRID_AVAILABILITY_USE if (grid_availability.size() == 1) { if (grid_availability[0] == "USED") proj_operation_factory_context_set_grid_availability_use(PJ_DEFAULT_CTX, factory_ctx, PROJ_GRID_AVAILABILITY_USED_FOR_SORTING); // Grid availability is only used for sorting results. // Operations where some grids are missing will be sorted last. else if (grid_availability[0] == "DISCARD") proj_operation_factory_context_set_grid_availability_use(PJ_DEFAULT_CTX, factory_ctx, PROJ_GRID_AVAILABILITY_DISCARD_OPERATION_IF_MISSING_GRID); // Completely discard an operation if a required grid is missing. else if (grid_availability[0] == "IGNORED") proj_operation_factory_context_set_grid_availability_use(PJ_DEFAULT_CTX, factory_ctx, PROJ_GRID_AVAILABILITY_IGNORED); // Ignore grid availability at all. Results will be presented as if all grids were available. else if (grid_availability[0] == "AVAILABLE") proj_operation_factory_context_set_grid_availability_use(PJ_DEFAULT_CTX, factory_ctx, PROJ_GRID_AVAILABILITY_KNOWN_AVAILABLE); // Results will be presented as if grids known to PROJ // (that is registered in the grid_alternatives table of its database) // were available. Used typically when networking is enabled. else Rcpp::stop("Unknown value for grid_availability"); } PJ *source_crs = proj_create(PJ_DEFAULT_CTX, crs[0]); if (source_crs == NULL) Rcpp::stop(proj_errno_string(proj_context_errno(PJ_DEFAULT_CTX))); PJ *target_crs = proj_create(PJ_DEFAULT_CTX, crs[1]); if (target_crs == NULL) Rcpp::stop(proj_errno_string(proj_context_errno(PJ_DEFAULT_CTX))); PJ_OBJ_LIST *obj_list = proj_create_operations(PJ_DEFAULT_CTX, source_crs, target_crs, factory_ctx); if (obj_list == NULL) Rcpp::stop("proj_create_operations() returned NULL"); // and clean up? int n = proj_list_get_count(obj_list); Rcpp::CharacterVector id(n); Rcpp::CharacterVector description(n); Rcpp::CharacterVector definition(n); Rcpp::LogicalVector has_inverse(n); Rcpp::LogicalVector axis_order(n); Rcpp::NumericVector acc(n); Rcpp::IntegerVector grid_count(n); Rcpp::LogicalVector instantiable(n); Rcpp::List grids(n); for (int i = 0; i < n; i++) { PJ *pj = proj_list_get(PJ_DEFAULT_CTX, obj_list, i); if (! axis_order_auth_compl) { PJ* orig = pj; pj = proj_normalize_for_visualization(PJ_DEFAULT_CTX, orig); proj_destroy(orig); } axis_order(i) = axis_order_auth_compl; grid_count(i) = proj_coordoperation_get_grid_used_count(PJ_DEFAULT_CTX, pj); instantiable(i) = (bool) proj_coordoperation_is_instantiable(PJ_DEFAULT_CTX, pj); PJ_PROJ_INFO info = proj_pj_info(pj); description(i) = info.description; definition(i) = info.definition; if (info.id != NULL) id(i) = info.id; has_inverse(i) = info.has_inverse != 0; if (info.accuracy == -1.0) acc(i) = NA_REAL; else acc(i) = info.accuracy; if (grid_count(i) > 0) { Rcpp::List g(grid_count(i)); for (int j = 0; j < grid_count(i); j++) { const char *out_short_name, *out_full_name, *out_package_name, *out_url; int grid_OK, out_direct_download, out_open_license, out_available; grid_OK = proj_coordoperation_get_grid_used(PJ_DEFAULT_CTX, pj, j, &out_short_name, &out_full_name, &out_package_name, &out_url, &out_direct_download, &out_open_license, &out_available); if (grid_OK) { g(j) = Rcpp::List::create( Rcpp::Named("out_short_name") = out_short_name, Rcpp::Named("out_full_name") = out_full_name, Rcpp::Named("out_package_name") = out_package_name, Rcpp::Named("out_url") = out_url, Rcpp::Named("out_direct_download") = out_direct_download, Rcpp::Named("out_open_license") = out_open_license, Rcpp::Named("out_available") = out_available ); } } grids(i) = g; } proj_destroy(pj); } // int sug = proj_get_suggested_operation(PJ_DEFAULT_CTX, *obj_list, PJ_DIRECTION direction, PJ_COORD coord) proj_list_destroy(obj_list); Rcpp::DataFrame df = Rcpp::DataFrame::create( Rcpp::Named("id") = id, Rcpp::Named("description") = description, Rcpp::Named("definition") = definition, Rcpp::Named("has_inverse") = has_inverse, Rcpp::Named("accuracy") = acc, Rcpp::Named("axis_order") = axis_order, Rcpp::Named("grid_count") = grid_count, Rcpp::Named("instantiable") = instantiable ); df.attr("grids") = grids; proj_destroy(source_crs); proj_destroy(target_crs); proj_operation_factory_context_destroy(factory_ctx); return df; #else Rcpp::warning("PROJ >= 7.1 required"); return Rcpp::DataFrame::create(); #endif } // [[Rcpp::export(rng=false)]] Rcpp::CharacterVector CPL_get_data_dir(bool from_proj = false) { if (from_proj) { Rcpp::CharacterVector ret(proj_info().searchpath); return ret; } else { #if GDAL_VERSION_NUM >= 3000300 char **ogr_sp = OSRGetPROJSearchPaths(); Rcpp::CharacterVector ogr_sp_sf = charpp2CV(ogr_sp); CSLDestroy(ogr_sp); return ogr_sp_sf; #else Rcpp::stop("requires GDAL >= 3.0.3"); #endif } } // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_is_network_enabled(bool b = false) { #if PROJ_VERSION_MAJOR >= 7 #if GDAL_VERSION_NUM >= 3040000 if (OSRGetPROJEnableNetwork() != proj_context_is_network_enabled(PJ_DEFAULT_CTX)) Rcpp::warning("GDAL and PROJ have different settings for network enablement; use sf_use_network() to sync them"); #endif return Rcpp::LogicalVector::create(proj_context_is_network_enabled(PJ_DEFAULT_CTX)); #else return Rcpp::LogicalVector::create(false); #endif } // [[Rcpp::export(rng=false)]] Rcpp::CharacterVector CPL_enable_network(Rcpp::CharacterVector url, bool enable = true) { #ifdef HAVE_71 if (enable) { proj_context_set_enable_network(PJ_DEFAULT_CTX, 1); #if GDAL_VERSION_NUM >= 3040000 OSRSetPROJEnableNetwork(1); #endif if (url.size()) proj_context_set_url_endpoint(PJ_DEFAULT_CTX, url[0]); return Rcpp::CharacterVector::create(proj_context_get_url_endpoint(PJ_DEFAULT_CTX)); } else { // disable: proj_context_set_enable_network(PJ_DEFAULT_CTX, 0); #if GDAL_VERSION_NUM >= 3040000 OSRSetPROJEnableNetwork(0); #endif return Rcpp::CharacterVector::create(); } #else return Rcpp::CharacterVector::create(); #endif } // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_set_data_dir(Rcpp::CharacterVector data_dir, bool with_proj) { if (with_proj) { if (data_dir.size() != 1) Rcpp::stop("data_dir should be size 1 character vector"); // #nocov std::string dd = Rcpp::as(data_dir); const char *cp = dd.c_str(); proj_context_set_search_paths(PJ_DEFAULT_CTX, 1, &cp); } else { #if GDAL_VERSION_NUM >= 3000000 std::vector dirs = create_options(data_dir, true); OSRSetPROJSearchPaths(dirs.data()); #else Rcpp::stop("setting proj search path for GDAL requires GDAL >= 3.0.0"); #endif } return true; } // [[Rcpp::export(rng=false)]] Rcpp::LogicalVector CPL_use_proj4_init_rules(Rcpp::IntegerVector v) { proj_context_use_proj4_init_rules(PJ_DEFAULT_CTX, v[0]); return true; } // [[Rcpp::export(rng=false)]] std::string CPL_proj_version(bool b = false) { std::stringstream buffer; buffer << PROJ_VERSION_MAJOR << "." << PROJ_VERSION_MINOR << "." << PROJ_VERSION_PATCH; return buffer.str(); } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_proj_is_valid(std::string proj4string) { Rcpp::List out(2); proj_context_use_proj4_init_rules(PJ_DEFAULT_CTX, 1); PJ *P = proj_create(PJ_DEFAULT_CTX, proj4string.c_str()); if (P == NULL) { out(0) = Rcpp::LogicalVector::create(false); out(1) = Rcpp::CharacterVector::create( proj_errno_string(proj_context_errno(PJ_DEFAULT_CTX))); } else { out(0) = Rcpp::LogicalVector::create(true); PJ_PROJ_INFO pi; pi = proj_pj_info(P); out(1) = Rcpp::CharacterVector::create(pi.description); proj_destroy(P); } return out; } // [[Rcpp::export(rng=false)]] bool CPL_have_datum_files(SEXP foo) { // TODO: // create a PJ with e.g. conus, check success, if yes destroy, return success Rcpp::warning("CPL_have_datum not yet implemented for PROJ6 proj.h interface"); return true; } // [[Rcpp::export(rng=false)]] Rcpp::NumericMatrix CPL_proj_direct(Rcpp::CharacterVector from_to, Rcpp::NumericMatrix pts, bool keep, bool warn = true, bool authority_compliant = false) { using namespace Rcpp; if (from_to.size() != 1 && from_to.size() != 2) stop("from_to should be size 1 or 2 character vector"); // #nocov if (pts.ncol() < 2 || pts.ncol() > 4) stop("pts should be 2-, 3- or 4-column numeric vector"); // #nocov bool have_z = pts.ncol() > 2; // column 3 bool have_t = pts.ncol() > 3; // column 4 proj_context_use_proj4_init_rules(PJ_DEFAULT_CTX, 1); // FIXME: needed? PJ *P = NULL; if (from_to.size() == 2) // source + target: P = proj_create_crs_to_crs(PJ_DEFAULT_CTX, from_to[0], from_to[1], NULL); // PJ_AREA *area); else // source to target pipeline: P = proj_create(PJ_DEFAULT_CTX, from_to[0]); if (P == NULL) stop(proj_errno_string(proj_context_errno(PJ_DEFAULT_CTX))); if (!authority_compliant && from_to.size() == 2) { // keep lat/lon as lon/lat PJ *NewP = proj_normalize_for_visualization(PJ_DEFAULT_CTX, P); proj_destroy(P); if (NewP == NULL) stop(proj_errno_string(proj_context_errno(PJ_DEFAULT_CTX))); else P = NewP; } // copy over: std::vector x(pts.nrow()); for (int i = 0; i < pts.nrow(); i++) { x.data()[i].lpzt.lam = pts(i, 0); x.data()[i].lpzt.phi = pts(i, 1); // for default z and t values, see https://proj.org/development/migration.html x.data()[i].lpzt.z = have_z ? pts(i, 2) : 0.0; x.data()[i].lpzt.t = have_t ? pts(i, 3) : HUGE_VAL; } // deg2rad? if (proj_angular_output(P, PJ_INV)) { for (int i = 0; i < pts.nrow(); i++) { x.data()[i].lpzt.lam = proj_torad(x.data()[i].lpzt.lam); x.data()[i].lpzt.phi = proj_torad(x.data()[i].lpzt.phi); } } // transform: if (keep) { // use proj_trans() on individual points, making unprojectable points be NA PJ_COORD row = {{ 0.0, 0.0, 0.0, 0.0 }}, projected; for (int i = 0; i < pts.nrow(); i++) { /* row.lpzt.lam = x.data()[i].lpzt.lam; row.lpzt.phi = x.data()[i].lpzt.phi; row.lpzt.z = x.data()[i].lpzt.z; row.lpzt.t = x.data()[i].lpzt.t; */ row.lpzt = x.data()[i].lpzt; projected = proj_trans(P, PJ_FWD, row); /* x.data()[i].lpzt.lam = projected.lpzt.lam; x.data()[i].lpzt.phi = projected.lpzt.phi; x.data()[i].lpzt.z = projected.lpzt.z; x.data()[i].lpzt.t = projected.lpzt.t; */ x.data()[i].lpzt = projected.lpzt; } } else { // DEFAULT: use proj_trans_array() on array, returning zero-length if any point is unprojectable if (proj_trans_array(P, PJ_FWD, x.size(), x.data())) { proj_destroy(P); stop(proj_errno_string(proj_context_errno(PJ_DEFAULT_CTX))); } } // rad2deg? if (proj_angular_output(P, PJ_FWD)) { for (int i = 0; i < pts.nrow(); i++) { x.data()[i].lpzt.lam = proj_todeg(x.data()[i].lpzt.lam); x.data()[i].lpzt.phi = proj_todeg(x.data()[i].lpzt.phi); } } proj_destroy(P); // copy to out matrix: NumericMatrix out(pts.nrow(), pts.ncol()); for (int i = 0; i < out.nrow(); i++) { out(i, 0) = x.data()[i].lpzt.lam; out(i, 1) = x.data()[i].lpzt.phi; if (have_z) out(i, 2) = x.data()[i].lpzt.z; if (have_t) out(i, 3) = x.data()[i].lpzt.t; } int nwarn = 0; for (int i = 0; i < out.nrow(); i++) { if (out(i, 0) == HUGE_VAL || out(i, 1) == HUGE_VAL) { out(i, 0) = NA_REAL; out(i, 1) = NA_REAL; if (have_z) out(i, 2) = NA_REAL; if (have_t) out(i, 3) = NA_REAL; nwarn++; // #nocov } } if (warn && nwarn > 0) warning("one or more projected point(s) not finite"); // #nocov return out; } #else // if defined(HAVE_PROJ_H) && !defined(ACCEPT_USE_OF_DEPRECATED_PROJ_API_H) i.e., old proj_api: # include #if PJ_VERSION >= 600 # define PROJ6 1 #endif Rcpp::DataFrame CPL_get_pipelines(Rcpp::CharacterVector crs, Rcpp::CharacterVector authority, Rcpp::NumericVector AOI, Rcpp::CharacterVector Use, Rcpp::CharacterVector grid_availability, double accuracy = -1.0, bool strict_containment = false, bool axis_order_auth_compl = false) { Rcpp::stop("PROJ 7 required"); return Rcpp::DataFrame::create(); } Rcpp::LogicalVector CPL_is_network_enabled(bool b = false) { #if PROJ_VERSION_MAJOR >= 7 return Rcpp::LogicalVector::create(proj_context_is_network_enabled(PJ_DEFAULT_CTX)); #else return Rcpp::LogicalVector::create(false); #endif } Rcpp::CharacterVector CPL_enable_network(Rcpp::CharacterVector url, bool enable = true) { #if PROJ_VERSION_MAJOR >= 7 if (enable) { proj_context_set_enable_network(PJ_DEFAULT_CTX, 1); if (url.size()) proj_context_set_url_endpoint(PJ_DEFAULT_CTX, url[0]); return Rcpp::CharacterVector::create(proj_context_get_url_endpoint(PJ_DEFAULT_CTX)); } else { // disable: proj_context_set_enable_network(PJ_DEFAULT_CTX, 0); return Rcpp::CharacterVector::create(); } #else return Rcpp::CharacterVector::create(); #endif } Rcpp::CharacterVector CPL_get_data_dir(bool from_proj = false) { #if PROJ_VERSION_MAJOR >= 7 return Rcpp::CharacterVector(proj_info().searchpath); #else return Rcpp::CharacterVector(NA_STRING); #endif } Rcpp::LogicalVector CPL_set_data_dir(Rcpp::CharacterVector data_dir, bool with_proj) { // #nocov start return false; } Rcpp::LogicalVector CPL_use_proj4_init_rules(Rcpp::IntegerVector v) { return false; } // #nocov end #if PJ_VERSION == 480 extern "C" { FILE *pj_open_lib(projCtx, const char *, const char *); } #endif #include "Rcpp.h" std::string CPL_proj_version(bool b = false) { int v = PJ_VERSION; std::stringstream buffer; buffer << v / 100 << "." << (v / 10) % 10 << "." << v % 10; return buffer.str(); } Rcpp::List CPL_proj_is_valid(std::string proj4string) { Rcpp::List out(2); projPJ pj = pj_init_plus(proj4string.c_str()); if (pj == NULL) { out(0) = Rcpp::LogicalVector::create(false); out(1) = Rcpp::CharacterVector::create(pj_strerrno(*pj_get_errno_ref())); } else { out(0) = Rcpp::LogicalVector::create(true); char *def = pj_get_def(pj, 0); out(1) = Rcpp::CharacterVector::create(def); pj_free(pj); free(def); } return out; } bool CPL_have_datum_files(SEXP foo) { #if PJ_VERSION <= 480 FILE *fp; #else PAFile fp; #endif projCtx ctx; ctx = pj_get_default_ctx(); fp = pj_open_lib(ctx, "conus", "rb"); if (fp != NULL) { #if PJ_VERSION <= 480 fclose(fp); #else pj_ctx_fclose(ctx, fp); #endif return true; } else return false; // #nocov } Rcpp::NumericMatrix CPL_proj_direct(Rcpp::CharacterVector from_to, Rcpp::NumericMatrix pts, bool keep, bool warn = true, bool authority_compliant = false) { using namespace Rcpp; if (authority_compliant) stop("authority_compliant = TRUE requires the new PROJ (proj.h) interface"); if (from_to.size() != 2) stop("from_to should be size 2 character vector"); // #nocov if (pts.ncol() != 2) stop("pts should be 2-column numeric vector"); // #nocov projPJ fromPJ, toPJ; if (!(fromPJ = pj_init_plus(from_to[0]))) stop(pj_strerrno(*pj_get_errno_ref())); if (!(toPJ = pj_init_plus(from_to[1]))) stop(pj_strerrno(*pj_get_errno_ref())); // copy over: std::vector xx(pts.nrow()), yy(pts.nrow()); for (int i = 0; i < pts.nrow(); i++) { xx[i] = pts(i, 0); yy[i] = pts(i, 1); } if (pj_is_latlong(fromPJ)) { for (int i = 0; i < pts.nrow(); i++) { xx[i] *= DEG_TO_RAD; yy[i] *= DEG_TO_RAD; } } // for (int i = 0; i < pts.nrow(); i++) // Rcout << xx[i] << " " << yy[i] << std::endl; if (keep) { // use proj_trans() on individual points, making unprojectable points be NA // FIXME: not tested, since author has no access to the old proj API. double thisx, thisy; for (int i = 0; i < pts.nrow(); i++) { thisx = xx[i]; thisy = yy[i]; if (pj_transform(fromPJ, toPJ, 1, 0, &thisx, &thisy, NULL) != 0) { xx[i] = R_PosInf; yy[i] = R_PosInf; } else { xx[i] = thisx; yy[i] = thisy; } } } else { // DEFAULT: use proj_trans_array() on array, returning zero-length if any point is unprojectable if (pj_transform(fromPJ, toPJ, pts.nrow(), 0, xx.data(), yy.data(), NULL) != 0) { pj_free(fromPJ); pj_free(toPJ); // #nocov start Rcout << "error in pj_transform: " << pj_strerrno(*pj_get_errno_ref()) << std::endl; stop("error"); // #nocov end } } pj_free(fromPJ); if (pj_is_latlong(toPJ)) { for (int i = 0; i < pts.nrow(); i++) { xx[i] *= RAD_TO_DEG; yy[i] *= RAD_TO_DEG; } } // copy to out matrix: NumericMatrix out(pts.nrow(), pts.ncol()); for (int i = 0; i < out.nrow(); i++) { out(i, 0) = xx[i]; out(i, 1) = yy[i]; } pj_free(toPJ); int nwarn = 0; for (int i = 0; i < out.nrow(); i++) { if (out(i, 0) == HUGE_VAL || out(i, 1) == HUGE_VAL) { out(i, 0) = NA_REAL; out(i, 1) = NA_REAL; nwarn++; // #nocov } } if (warn && nwarn > 0) warning("one or more projected point(s) not finite"); // #nocov return out; } #endif ================================================ FILE: src/proj_info.cpp ================================================ #include "Rcpp.h" #ifdef HAVE_PROJ_H #include // [[Rcpp::export(rng=false)]] Rcpp::List CPL_proj_info(int type) { Rcpp::List ret; switch (type) { case 0: { Rcpp::List ans(2); ans.attr("names") = Rcpp::CharacterVector::create("name", "description"); int n = 0; const struct PJ_LIST *lp; for (lp = proj_list_operations() ; lp->id ; ++lp) { if( strcmp(lp->id,"latlong") == 0 || strcmp(lp->id,"longlat") == 0 || strcmp(lp->id,"geocent") == 0 ) continue; n++; } Rcpp::CharacterVector cv0(n); Rcpp::CharacterVector cv1(n); n = 0; for (lp = proj_list_operations() ; lp->id ; ++lp) { if (strcmp(lp->id,"latlong") == 0 || strcmp(lp->id,"longlat") == 0 || strcmp(lp->id,"geocent") == 0 ) continue; cv0(n) = lp->id; cv1(n) = *lp->descr; n++; } ans(0) = cv0; ans(1) = cv1; ret = ans; } break; case 1: { Rcpp::List ans(4); ans.attr("names") = Rcpp::CharacterVector::create("name", "major", "ell", "description"); int n = 0; const struct PJ_ELLPS *le; for (le = proj_list_ellps(); le->id ; ++le) n++; Rcpp::CharacterVector ans0(n); Rcpp::CharacterVector ans1(n); Rcpp::CharacterVector ans2(n); Rcpp::CharacterVector ans3(n); n = 0; for (le = proj_list_ellps(); le->id ; ++le) { ans0(n) = le->id; ans1(n) = le->major; ans2(n) = le->ell; ans3(n) = le->name; n++; } ans(0) = ans0; ans(1) = ans1; ans(2) = ans2; ans(3) = ans3; ret = ans; } break; case 2: { ret = R_NilValue; } break; case 3: { Rcpp::List ans(3); ans.attr("names") = Rcpp::CharacterVector::create("id", "to_meter", "name"); int n = 0; #if ((PROJ_VERSION_MAJOR == 7 && PROJ_VERSION_MINOR >= 1) || PROJ_VERSION_MAJOR > 7) PROJ_UNIT_INFO** units; units = proj_get_units_from_database(nullptr, nullptr, "linear", false, nullptr); for (int i = 0; units && units[i]; i++) { if (units[i]->proj_short_name) n++; } Rcpp::CharacterVector ans0(n); Rcpp::NumericVector ans1(n); Rcpp::CharacterVector ans2(n); int item = 0; for (int i = 0; units && units[i]; i++) { if (units[i]->proj_short_name) { ans0[item] = units[i]->proj_short_name; ans1[item] = units[i]->conv_factor; ans2[item] = units[i]->name; item++; } if (item >= n) break; } proj_unit_list_destroy(units); ans(0) = ans0; ans(1) = ans1; ans(2) = ans2; #else const struct PJ_UNITS *lu; for (lu = proj_list_units(); lu->id ; ++lu) n++; Rcpp::CharacterVector ans0(n); Rcpp::CharacterVector ans1(n); Rcpp::CharacterVector ans2(n); n = 0; for (lu = proj_list_units(); lu->id ; ++lu) { ans0(n) = lu->id; ans1(n) = lu->to_meter; ans2(n) = lu->name; n++; } ans(0) = ans0; ans(1) = ans1; ans(2) = ans2; #endif ret = ans; } break; case 4: { Rcpp::List ans(2); ans.attr("names") = Rcpp::CharacterVector::create("id", "definition"); int n = 0; const struct PJ_PRIME_MERIDIANS *lpm; for (lpm = proj_list_prime_meridians(); lpm->id ; ++lpm) n++; Rcpp::CharacterVector ans0(n); Rcpp::CharacterVector ans1(n); n = 0; for (lpm = proj_list_prime_meridians(); lpm->id ; ++lpm) { ans0(n) = lpm->id; ans1(n) = lpm->defn; n++; } ans(0) = ans0; ans(1) = ans1; ret = ans; } break; default: Rcpp::stop("unknown type"); // #nocov break; } return ret; } #else #include extern "C" { // modified from: rgdal/pkg/src/projectit.cpp // copied necessary parts from projects.h; full header conflicts with R headers; // should these things ever change in the proj API, then we're in trouble. struct PJconsts; struct PJ_LIST { char *id; /* projection keyword */ struct PJconsts *(*proj)(struct PJconsts*);/* projection entry point */ char * const *descr; /* description text */ }; struct PJ_LIST *pj_get_list_ref( void ); struct PJ_ELLPS { char *id; /* ellipse keyword name */ char *major; /* a= value */ char *ell; /* elliptical parameter */ char *name; /* comments */ }; struct PJ_ELLPS *pj_get_ellps_ref( void ); struct PJ_DATUMS { char *id; /* datum keyword */ char *defn; /* ie. "to_wgs84=..." */ char *ellipse_id; /* ie from ellipse table */ char *comments; /* EPSG code, etc */ }; struct PJ_DATUMS *pj_get_datums_ref( void ); struct PJ_UNITS { char *id; /* units keyword */ char *to_meter; /* multiply by value to get meters */ char *name; /* comments */ #if PJ_VERSION >= 500 double factor; /* to_meter factor in actual numbers */ #endif }; struct PJ_UNITS *pj_get_units_ref( void ); } // extern "C" Rcpp::List CPL_proj_info(int type) { Rcpp::List ret; switch (type) { case 0: { Rcpp::List ans(2); ans.attr("names") = Rcpp::CharacterVector::create("name", "description"); int n = 0; struct PJ_LIST *lp; for (lp = pj_get_list_ref() ; lp->id ; ++lp) n++; Rcpp::CharacterVector cv0(n); Rcpp::CharacterVector cv1(n); n = 0; for (lp = pj_get_list_ref() ; lp->id ; ++lp) { cv0(n) = lp->id; cv1(n) = *lp->descr; n++; } ans(0) = cv0; ans(1) = cv1; ret = ans; } break; case 1: { Rcpp::List ans(4); ans.attr("names") = Rcpp::CharacterVector::create("name", "major", "ell", "description"); int n = 0; struct PJ_ELLPS *le; for (le = pj_get_ellps_ref(); le->id ; ++le) n++; Rcpp::CharacterVector ans0(n); Rcpp::CharacterVector ans1(n); Rcpp::CharacterVector ans2(n); Rcpp::CharacterVector ans3(n); n = 0; for (le = pj_get_ellps_ref(); le->id ; ++le) { ans0(n) = le->id; ans1(n) = le->major; ans2(n) = le->ell; ans3(n) = le->name; n++; } ans(0) = ans0; ans(1) = ans1; ans(2) = ans2; ans(3) = ans3; ret = ans; } break; case 2: { Rcpp::List ans(4); ans.attr("names") = Rcpp::CharacterVector::create("name", "ellipse", "definition", "description"); int n = 0; struct PJ_DATUMS *ld; for (ld = pj_get_datums_ref(); ld->id ; ++ld) n++; Rcpp::CharacterVector ans0(n); Rcpp::CharacterVector ans1(n); Rcpp::CharacterVector ans2(n); Rcpp::CharacterVector ans3(n); n = 0; for (ld = pj_get_datums_ref(); ld->id ; ++ld) { ans0(n) = ld->id; ans1(n) = ld->ellipse_id; ans2(n) = ld->defn; ans3(n) = ld->comments; n++; } ans(0) = ans0; ans(1) = ans1; ans(2) = ans2; ans(3) = ans3; ret = ans; } break; case 3: { #if PJ_VERSION >= 500 Rcpp::List ans(4); ans.attr("names") = Rcpp::CharacterVector::create("id", "to_meter", "name", "factor"); int n = 0; struct PJ_UNITS *ld; for (ld = pj_get_units_ref(); ld->id ; ++ld) n++; Rcpp::CharacterVector ans0(n); Rcpp::CharacterVector ans1(n); Rcpp::CharacterVector ans2(n); Rcpp::NumericVector ans3(n); n = 0; for (ld = pj_get_units_ref(); ld->id ; ++ld) { ans0(n) = ld->id; ans1(n) = ld->to_meter; ans2(n) = ld->name; ans3(n) = ld->factor; n++; } ans(0) = ans0; ans(1) = ans1; ans(2) = ans2; ans(3) = ans3; ret = ans; #else Rcpp::List ans(3); ans.attr("names") = Rcpp::CharacterVector::create("id", "to_meter", "name"); int n = 0; struct PJ_UNITS *ld; for (ld = pj_get_units_ref(); ld->id ; ++ld) n++; Rcpp::CharacterVector ans0(n); Rcpp::CharacterVector ans1(n); Rcpp::CharacterVector ans2(n); n = 0; for (ld = pj_get_units_ref(); ld->id ; ++ld) { ans0(n) = ld->id; ans1(n) = ld->to_meter; ans2(n) = ld->name; n++; } ans(0) = ans0; ans(1) = ans1; ans(2) = ans2; ret = ans; #endif } break; default: Rcpp::stop("unknown type"); // #nocov break; } return ret; } #endif // HAVE_PROJ_H ================================================ FILE: src/raster2sf.cpp ================================================ #include "Rcpp.h" using namespace Rcpp; // [[Rcpp::export(rng=false)]] List CPL_xy2sfc(NumericMatrix cc, IntegerVector dim, bool to_points, IntegerVector which, bool cc_has_NAs) { if (cc.nrow() != dim[0] * dim[1]) stop("xy2sfc: wrong dimensions"); // #nocov List sfc(which.length()); if (to_points) { NumericVector point(2); point.attr("class") = CharacterVector::create("XY", "POINT", "sfg"); for (int i = 0; i < which.length(); i++) { int ix = which[i] - 1; point(0) = cc(ix, 0); point(1) = cc(ix, 1); sfc(i) = clone(point); } sfc.attr("class") = CharacterVector::create("sfc_POINT", "sfc"); } else { for (int i = 0; i < which.length(); i++) { int ix = which[i] - 1; // from R, 1-based size_t y = ix / (dim[0] - 1); // row index size_t x = ix % (dim[0] - 1); // col index // Rcpp::Rcout << "x is:" << x << " y is:" << y << std::endl; NumericMatrix points(5, 2); // the four corners points(0,0) = cc(y * (dim[0]) + x , 0); // top left points(0,1) = cc(y * (dim[0]) + x , 1); // top left points(1,0) = cc(y * (dim[0]) + x + 1, 0); // top right points(1,1) = cc(y * (dim[0]) + x + 1, 1); // top right points(2,0) = cc((y + 1) * (dim[0]) + x + 1, 0); // bottom right points(2,1) = cc((y + 1) * (dim[0]) + x + 1, 1); // bottom right points(3,0) = cc((y + 1) * (dim[0]) + x , 0); // bottom left points(3,1) = cc((y + 1) * (dim[0]) + x , 1); // bottom left points(4,0) = cc(y * (dim[0]) + x , 0); // top left points(4,1) = cc(y * (dim[0]) + x , 1); // top left bool empty = false; if (cc_has_NAs) { NumericVector xy(8); xy(0) = points(0,0); xy(1) = points(0,1); xy(2) = points(1,0); xy(3) = points(1,1); xy(4) = points(2,0); xy(5) = points(2,1); xy(6) = points(3,0); xy(7) = points(3,1); LogicalVector b = any(is_na(xy)); if (b[0]) { List polygon; polygon.attr("class") = CharacterVector::create("XY", "POLYGON", "sfg"); sfc(i) = polygon; // empty polygon empty = true; } } if (!empty) { List polygon(1); polygon.attr("class") = CharacterVector::create("XY", "POLYGON", "sfg"); polygon(0) = points; sfc(i) = polygon; } } sfc.attr("class") = CharacterVector::create("sfc_POLYGON", "sfc"); } sfc.attr("precision") = NumericVector::create(0.0); return(sfc); } ================================================ FILE: src/sfc-sfg.cpp ================================================ #include using namespace Rcpp; #include // [[Rcpp::export(rng=false)]] LogicalVector sfc_is_null(List sfc) { LogicalVector out(sfc.size()); // An element identical to NA_logical_ or NULL is considered NULL // for the purposes of the sfc constructor SEXP item; for (R_xlen_t i = 0; i < sfc.size(); i++) { item = sfc[i]; out[i] = item == R_NilValue || (TYPEOF(item) == LGLSXP && Rf_length(item) == 1 && LOGICAL(item)[0] == NA_LOGICAL); } return out; } // [[Rcpp::export(rng=false)]] List sfc_unique_sfg_dims_and_types(List sfc) { if (sfc.size() == 0) { return List::create( _["class_dim"] = CharacterVector::create(), _["class_type"] = CharacterVector::create()); } std::unordered_set class_dim; std::unordered_set class_type; SEXP item; for (R_xlen_t i = 0; i < sfc.size(); i++) { item = sfc[i]; // Because Rf_inherits() is faster than using Rf_getAttrib // or RObject::attr() if (Rf_inherits(item, "XY")) { class_dim.insert("XY"); } else if (Rf_inherits(item, "XYZ")) { class_dim.insert("XYZ"); } else if (Rf_inherits(item, "XYM")) { class_dim.insert("XYM"); } else if (Rf_inherits(item, "XYZM")) { class_dim.insert("XYZM"); } if (!Rf_inherits(item, "sfg")) stop("object(s) should be of class 'sfg'"); if (Rf_inherits(item, "POINT")) { class_type.insert("POINT"); continue; } else if (Rf_inherits(item, "LINESTRING")) { class_type.insert("LINESTRING"); continue; } else if (Rf_inherits(item, "POLYGON")) { class_type.insert("POLYGON"); continue; } else if (Rf_inherits(item, "MULTIPOINT")) { class_type.insert("MULTIPOINT"); continue; } else if (Rf_inherits(item, "MULTILINESTRING")) { class_type.insert("MULTILINESTRING"); continue; } else if (Rf_inherits(item, "MULTIPOLYGON")) { class_type.insert("MULTIPOLYGON"); continue; } // Other types exist, too, but are more rare are not optimized yet RObject itemSlow(sfc[i]); RObject classes = itemSlow.attr("class"); if (classes == R_NilValue) { continue; } CharacterVector classes_chr(classes); if (classes_chr.size() == 3) { class_type.insert(static_cast(classes_chr[1])); } } CharacterVector class_dim_chr(class_dim.begin(), class_dim.end()); CharacterVector class_type_chr(class_type.begin(), class_type.end()); return List::create( _["class_dim"] = class_dim_chr, _["class_type"] = class_type_chr); } // [[Rcpp::export(rng=false)]] LogicalVector sfc_is_empty(List sfc) { LogicalVector out(sfc.size()); SEXP item; for (R_xlen_t i = 0; i < sfc.size(); i++) { item = sfc[i]; int item_len = Rf_length(item); bool is_empty = true; if (Rf_inherits(item, "POINT")) { if (TYPEOF(item) == REALSXP) { for (int j = 0; j < item_len; j++) { double val = REAL(item)[j]; if (!ISNA(val) && !ISNAN(val)) { is_empty = false; break; } } } else if (TYPEOF(item) == INTSXP) { for (int j = 0; j < item_len; j++) { int val = INTEGER(item)[j]; if (val != NA_INTEGER) { is_empty = false; break; } } } } else { if (item_len == 0) is_empty = true; else if (TYPEOF(item) == VECSXP) { // #2463 item = VECTOR_ELT(item, 0); is_empty = Rf_length(item) == 0 || // e.g. POLYGON with 1 ring without coordinates (TYPEOF(item) == VECSXP && Rf_length(VECTOR_ELT(item, 0)) == 0); // same for one level deeper, e.g. MULTIPOLYGON: } else is_empty = false; } out[i] = is_empty; } return out; } // [[Rcpp::export(rng=false)]] LogicalVector sfc_is_full(List sfc) { LogicalVector out(sfc.size()); SEXP item; for (R_xlen_t i = 0; i < sfc.size(); i++) { item = sfc[i]; int item_len = Rf_length(item); bool is_full = false; if (item_len == 1 && Rf_inherits(item, "POLYGON")) { SEXP m = VECTOR_ELT(item, 0); if (Rf_isMatrix(m) && Rf_nrows(m) == 2) /* we can go on and check the values, but... */ is_full = true; } out[i] = is_full; } return out; } // [[Rcpp::export(rng=false)]] List points_cpp(NumericMatrix pts, CharacterVector gdim = "XY") { int n = pts.nrow(); List out(n); CharacterVector cls = CharacterVector::create(gdim[0], "POINT", "sfg"); for (int i = 0; i < n; i++) { NumericVector lp = pts(i, _); lp.attr("class") = cls; out[i] = lp; } return out; } ================================================ FILE: src/signed_area.cpp ================================================ #include using namespace Rcpp; // return signed area of a ring; // positive area indicates a counter clock-wise ring direction // https://en.wikipedia.org/wiki/Shoelace_formula // [[Rcpp::export(rng=false)]] double CPL_signed_area(NumericMatrix pts) { double sum = 0.0; double x0, x, y1, y2; if (pts.ncol() < 2) stop("need at least two columns in matrix\n"); // #nocov if (pts.nrow() <= 3) return 0.0; x0 = pts(0, 0); for (int i = 2; i < pts.nrow(); i++) { x = pts(i-1, 0) - x0; y1 = pts(i, 1); y2 = pts(i-2, 1); sum += x * (y1 - y2); } return sum / 2.0; } ================================================ FILE: src/stars.cpp ================================================ #include #include #include #include #include #include #include #include #include #include "gdal.h" #include "gdal_read.h" #include "gdal_sf_pkg.h" using namespace Rcpp; CharacterVector get_meta_data(GDALDatasetH ds, CharacterVector domain_item) { CharacterVector ret; if (ds == NULL) return NA_STRING; if (domain_item.size() == 0) ret = charpp2CV(GDALGetMetadata(ds, NULL)); // #nocov else if (domain_item.size() == 1) { if (CharacterVector::is_na(domain_item[0])) { char **dl = GDALGetMetadataDomainList(ds); ret = charpp2CV(dl); CSLDestroy(dl); } else ret = charpp2CV(GDALGetMetadata(ds, domain_item[0])); } else if (domain_item.size() == 2) // domain and item // #nocov start ret = CharacterVector::create(GDALGetMetadataItem(ds, domain_item[1], domain_item[0])); else ret = NA_STRING; // #nocov end return(ret); } List get_band_meta_data(GDALDataset *poDataset) { int n_bands = poDataset->GetRasterCount(); List ret(n_bands); for (int band = 1; band <= n_bands; band++) { // unlike x & y, band is 1-based GDALRasterBand *poBand = poDataset->GetRasterBand( band ); ret[band - 1] = charpp2CV(poBand->GetMetadata(NULL)); } return ret; } // [[Rcpp::export(rng=false)]] CharacterVector CPL_get_metadata(CharacterVector obj, CharacterVector domain_item, CharacterVector options) { GDALDatasetH ds = GDALOpenEx(obj[0], GDAL_OF_RASTER | GDAL_OF_READONLY, NULL, NULL, create_options(options).data()); CharacterVector ret = get_meta_data(ds, domain_item); if (ds != NULL) GDALClose(ds); return ret; } // [[Rcpp::export(rng=false)]] List CPL_get_crs(CharacterVector obj, CharacterVector options) { List ret(4); GDALDatasetH ds = GDALOpenEx(obj[0], GDAL_OF_RASTER | GDAL_OF_READONLY, NULL, NULL, create_options(options).data()); if (ds == NULL) return ret; // #nocov ret(0) = GDALGetRasterCount(ds); ret(1) = GDALGetProjectionRef(ds); // wkt double gt[6]; GDALGetGeoTransform(ds, gt); NumericVector gt_r(6); for (int i = 0; i < 6; i++) gt_r(i) = gt[i]; ret(2) = gt_r; double gt_inv[6]; int retval = GDALInvGeoTransform(gt, gt_inv); NumericVector gt_r_inv(6); for (int i = 0; i < 6; i++) gt_r_inv(i) = retval ? gt_inv[i] : NA_REAL; ret(3) = gt_r_inv; ret.attr("names") = CharacterVector::create("nbands", "crs", "gt", "gt_inv"); return ret; } // [[Rcpp::export(rng=false)]] NumericVector CPL_inv_geotransform(NumericVector gt_r) { if (gt_r.size() != 6) stop("wrong length geotransform"); // #nocov double gt_inv[6], gt[6]; for (int i = 0; i < 6; i++) gt[i] = gt_r[i]; int retval = GDALInvGeoTransform(gt, gt_inv); NumericVector gt_r_inv(6); for (int i = 0; i < 6; i++) gt_r_inv(i) = retval ? gt_inv[i] : NA_REAL; return gt_r_inv; } bool equals_na(double value, double na, GDALDataType dt) { if (ISNAN(value)) return true; if (dt == GDT_Float32) return (float) value == (float) na; else return value == na; } // formerly: stars/src/gdal.cpp NumericVector read_gdal_data(GDALDataset *poDataset, NumericVector nodatavalue, int nXOff, int nYOff, int nXSize, int nYSize, int nBufXSize, int nBufYSize, IntegerVector bands, GDALRasterIOExtraArg *resample ) { // collapse x & y into rows, redim later: NumericVector vec( 1.0 * nBufXSize * nBufYSize * bands.size() ); // floor returns double -> no integer overflow // read bands: if (poDataset->RasterIO( GF_Read, nXOff, nYOff, nXSize, nYSize, vec.begin(), nBufXSize, nBufYSize, GDT_Float64, bands.size(), bands.begin(), 0, 0, 0, resample) == CE_Failure) stop("read failure"); // #nocov CharacterVector units(bands.size()); // scale && set NA: for (int i = 0; i < bands.size(); i++) { int band = bands(i); GDALRasterBand *poBand = poDataset->GetRasterBand( band ); // NumericVector nodatavalue = NumericVector::create(NA_REAL); // int success = 0, int has_scale = 0, has_offset = 0; double offset = 0.0, scale = 1.0; // poBand->GetNoDataValue(&success); // if (success) // nodatavalue = poBand->GetNoDataValue(NULL); // #nocov poBand->GetScale(&has_scale); if (has_scale) scale = poBand->GetScale(NULL); poBand->GetOffset(&has_offset); if (has_offset) offset = poBand->GetOffset(NULL); units[i] = poBand->GetUnitType(); // if (! NumericVector::is_na(nodatavalue[0]) || has_offset || has_scale) { // outcommented because of NaN handling, https://github.com/r-spatial/stars/issues/333 for (R_xlen_t j = i * (((R_xlen_t) nBufXSize) * nBufYSize); // start of band i j < (i + 1) * (((R_xlen_t) nBufXSize) * nBufYSize); // end of band i j++) { if (equals_na(vec[j], nodatavalue[0], poBand->GetRasterDataType())) vec[j] = NA_REAL; // #nocov else vec[j] = (vec[j] * scale) + offset; } // } checkUserInterrupt(); } vec.attr("units") = units; // set dim attr: IntegerVector dims; if (bands.size() == 1) { // single band: dims = IntegerVector::create(nBufXSize, nBufYSize); dims.attr("names") = CharacterVector::create("x", "y"); } else { // multiple bands: dims = IntegerVector::create(nBufXSize, nBufYSize, bands.size()); // #nocov dims.attr("names") = CharacterVector::create("x", "y", "band"); // #nocov } vec.attr("dim") = dims; return vec; } int get_from_list(List lst, const char *name, int otherwise) { if (lst.containsElementNamed(name) && lst[name] != R_NilValue) { IntegerVector ret = lst[name]; // #nocov return(ret[0]); // #nocov } else return(otherwise); } NumericMatrix get_color_table(GDALColorTable *tbl) { int n = tbl->GetColorEntryCount(); NumericMatrix t(n, 4); for (int i = 0; i < n; i++) { const GDALColorEntry *ce = tbl->GetColorEntry(i); t(i, 0) = ce->c1; t(i, 1) = ce->c2; t(i, 2) = ce->c3; t(i, 3) = ce->c4; } int i = (int) tbl->GetPaletteInterpretation(); t.attr("interpretation") = IntegerVector::create(i); return t; } List get_cat(char **cat) { if (cat == NULL) return(List::create()); int n = 0; for (n = 0; cat[n] != NULL; n++) ; // n is number of categories List t(1); CharacterVector col(n); IntegerVector row_names(n); for (int i = 0; i < n; i++) { col(i) = cat[i]; row_names(i) = i+1; } t(0) = col; t.attr("names") = CharacterVector::create("category"); t.attr("row.names") = row_names; t.attr("class") = CharacterVector::create("data.frame"); return t; } List get_rat(GDALRasterAttributeTable *tbl) { if (tbl == NULL) return(List::create()); List t(tbl->GetColumnCount()); List names(tbl->GetColumnCount()); for (int i = 0; i < tbl->GetColumnCount(); i++) { switch (tbl->GetTypeOfCol(i)) { case GFT_Integer: { IntegerVector col(tbl->GetRowCount()); for (int j = 0; j < tbl->GetRowCount(); j++) col(j) = tbl->GetValueAsInt(j, i); t(i) = col; } break; case GFT_Real: { NumericVector col(tbl->GetRowCount()); for (int j = 0; j < tbl->GetRowCount(); j++) col(j) = tbl->GetValueAsDouble(j, i); t(i) = col; } break; case GFT_String: { CharacterVector col(tbl->GetRowCount()); for (int j = 0; j < tbl->GetRowCount(); j++) col(j) = tbl->GetValueAsString(j, i); t(i) = col; } break; default: stop("unknown column type in raster attribute table"); } names(i) = tbl->GetNameOfCol(i); } IntegerVector row_names(tbl->GetRowCount()); for (int i = 0; i < tbl->GetRowCount(); i++) row_names(i) = i+1; t.attr("names") = names; t.attr("row.names") = row_names; t.attr("class") = CharacterVector::create("data.frame"); return t; } // [[Rcpp::export(rng=false)]] List CPL_read_gdal(CharacterVector fname, CharacterVector options, CharacterVector driver, bool read_data, NumericVector NA_value, List RasterIO_parameters, double max_cells) { // reads and returns data set metadata, and adds data array if read_data is true, or less // than max_cells are to be read GDALDataset *poDataset = (GDALDataset *) GDALOpenEx(fname[0], GA_ReadOnly, driver.size() ? create_options(driver).data() : NULL, options.size() ? create_options(options).data() : NULL, NULL); if (poDataset == NULL) { Rcout << "trying to read file: " << fname[0] << std::endl; // #nocov stop("file not found"); // #nocov } CharacterVector Driver = CharacterVector::create( poDataset->GetDriver()->GetDescription(), poDataset->GetDriver()->GetMetadataItem( GDAL_DMD_LONGNAME )); /* if (poDataset->GetRasterCount() == 0) stop("zero bands"); -->> this indicates there are (only) subdatasets */ // geotransform: double adfGeoTransform[6]; CPLErr err = poDataset->GetGeoTransform( adfGeoTransform ); // return the default geotransform as per the // GetGeoTransform() doc in classGDALDataset NumericVector geotransform = NumericVector::create( err == CE_None ? adfGeoTransform[0] : 0, err == CE_None ? adfGeoTransform[1] : 1, err == CE_None ? adfGeoTransform[2] : 0, err == CE_None ? adfGeoTransform[3] : 0, err == CE_None ? adfGeoTransform[4] : 0, err == CE_None ? adfGeoTransform[5] : 1); // see https://github.com/r-spatial/sf/pull/1307 int default_geotransform = 0; if (err != CE_None) { default_geotransform = 1; } bool geo_transform_set = (err == CE_None); // CRS, projection: #if GDAL_VERSION_NUM >= 3000000 const OGRSpatialReference *sr = poDataset->GetSpatialRef(); // sr = handle_axis_order(sr); -- should be done by GDAL; xy Rcpp::List crs = create_crs(sr, true); #else const char *wkt_gdal = poDataset->GetProjectionRef(); CharacterVector wkt = NA_STRING; if (*wkt_gdal != '\0') wkt = CharacterVector::create(wkt_gdal); #endif GDALRasterBand *poBand = NULL; NumericVector nodatavalue = NumericVector::create(NA_REAL); if (poDataset->GetRasterCount()) { poBand = poDataset->GetRasterBand( 1 ); int set = 0; poBand->GetNoDataValue(&set); if (NA_value.size() > 0 && !NumericVector::is_na(NA_value[0])) { if (set) warning("NoDataValue of band is ignored"); // #nocov nodatavalue[0] = NA_value[0]; } else if (set) nodatavalue[0] = poBand->GetNoDataValue(NULL); // #nocov } // bands: IntegerVector bands; if (RasterIO_parameters.containsElementNamed("bands")) bands = RasterIO_parameters["bands"]; // #nocov else { bands = IntegerVector(poDataset->GetRasterCount()); for (int j = 0; j < bands.size(); j++) bands(j) = j + 1; // bands is 1-based } // get color table, attribute table, and min/max values: List colorTables(bands.size()); List attributeTables(bands.size()); CharacterVector descriptions(bands.size()); NumericMatrix ranges(bands.size(), 4); IntegerMatrix blocksizes(bands.size(), 2); IntegerVector colorInterp(bands.size()); for (int i = 0; i < bands.size(); i++) { if ((poBand = poDataset->GetRasterBand(bands(i))) == NULL) stop("trying to read a band that is not present"); const char *md = poBand->GetMetadataItem("BANDNAME", NULL); if (md == NULL) descriptions(i) = poBand->GetDescription(); else descriptions(i) = md; if (poBand->GetColorTable() != NULL) colorTables(i) = get_color_table(poBand->GetColorTable()); if (poBand->GetCategoryNames() != NULL) attributeTables(i) = get_cat(poBand->GetCategoryNames()); else attributeTables(i) = get_rat(poBand->GetDefaultRAT()); int set = 1; ranges(i, 0) = poBand->GetMinimum(&set); ranges(i, 1) = (double) set; ranges(i, 2) = poBand->GetMaximum(&set); ranges(i, 3) = (double) set; int nBlockXSize = 0; int nBlockYSize = 0; poBand->GetBlockSize(&nBlockXSize, &nBlockYSize); blocksizes(i, 0) = nBlockXSize; blocksizes(i, 1) = nBlockYSize; colorInterp(i) = (int) poBand->GetColorInterpretation(); } // get metadata items: CharacterVector items = get_meta_data((GDALDatasetH) poDataset, NA_STRING); CharacterVector sub = NA_STRING; for (int i = 0; i < items.size(); i++) { // Rcpp::Rcout << items[i] << std::endl; if (items[i] == "SUBDATASETS") sub = get_meta_data(poDataset, "SUBDATASETS"); // #nocov } // image dimension: int nXOff = get_from_list(RasterIO_parameters, "nXOff", 1) - 1; int nYOff = get_from_list(RasterIO_parameters, "nYOff", 1) - 1; int nXSize = get_from_list(RasterIO_parameters, "nXSize", poDataset->GetRasterXSize() - nXOff); int nYSize = get_from_list(RasterIO_parameters, "nYSize", poDataset->GetRasterYSize() - nYOff); int nBufXSize = get_from_list(RasterIO_parameters, "nBufXSize", nXSize); int nBufYSize = get_from_list(RasterIO_parameters, "nBufYSize", nYSize); if (max_cells > 0) read_data = (bands.size() * nBufXSize * nBufYSize) < max_cells; // resampling method: GDALRasterIOExtraArg resample; INIT_RASTERIO_EXTRA_ARG(resample); if (RasterIO_parameters.containsElementNamed("resample")) { // #nocov start CharacterVector res = RasterIO_parameters["resample"]; if (res[0] == "bilinear") resample.eResampleAlg = GRIORA_Bilinear; else if (res[0] == "cubic") resample.eResampleAlg = GRIORA_Cubic; else if (res[0] == "cubic_spline") resample.eResampleAlg = GRIORA_CubicSpline; else if (res[0] == "lanczos") resample.eResampleAlg = GRIORA_Lanczos; else if (res[0] == "average") resample.eResampleAlg = GRIORA_Average; else if (res[0] == "mode") resample.eResampleAlg = GRIORA_Mode; else if (res[0] == "Gauss") resample.eResampleAlg = GRIORA_Gauss; else if (res[0] == "nearest_neighbour") resample.eResampleAlg = GRIORA_NearestNeighbour; else stop("unknown method for resample"); // #nocov end } List ReturnList = List::create( _["filename"] = fname, _["driver"] = Driver, _["cols"] = NumericVector::create(nXOff + 1, nXOff + nBufXSize), _["rows"] = NumericVector::create(nYOff + 1, nYOff + nBufYSize), _["bands"] = bands, #if GDAL_VERSION_NUM >= 3000000 _["crs"] = crs, #else _["proj_wkt"] = wkt, #endif _["geotransform"] = geotransform, _["datatype"] = poBand != NULL ? GDALGetDataTypeName(poBand->GetRasterDataType()) : CharacterVector::create(NA_STRING), _["sub"] = sub, _["meta"] = get_meta_data(poDataset, CharacterVector::create()), _["band_meta"] = get_band_meta_data(poDataset), _["attribute_tables"] = attributeTables, _["color_tables"] = colorTables, _["ranges"] = ranges, _["blocksizes"] = blocksizes, _["descriptions"] = descriptions, _["default_geotransform"] = default_geotransform, _["proxy"] = LogicalVector::create(!read_data), _["colorInterp"] = colorInterp ); if (read_data) { ReturnList.attr("data") = read_gdal_data(poDataset, nodatavalue, nXOff, nYOff, nXSize, nYSize, nBufXSize, nBufYSize, bands, &resample); } GDALClose(poDataset); // adjust geotransform & offset if Buf?Size was set: if ((nXSize != nBufXSize || nYSize != nBufYSize) && geo_transform_set) { // #nocov start if (geotransform[2] != 0.0 || geotransform[4] != 0.0) stop("reading affine grids with resampling would result in a wrong geotransform; please file an issue"); // #nocov double ratio_x = (1.0 * nXSize) / nBufXSize; double ratio_y = (1.0 * nYSize) / nBufYSize; geotransform[1] = geotransform[1] * ratio_x; geotransform[5] = geotransform[5] * ratio_y; ReturnList["geotransform"] = geotransform; nXOff = (int) (nXOff / ratio_x); nYOff = (int) (nYOff / ratio_y); ReturnList["cols"] = NumericVector::create(nXOff + 1, nXOff + nBufXSize); ReturnList["rows"] = NumericVector::create(nYOff + 1, nYOff + nBufYSize); } // #nocov end return ReturnList; } // [[Rcpp::export(rng=false)]] void CPL_write_gdal(NumericMatrix x, CharacterVector fname, CharacterVector driver, CharacterVector options, CharacterVector Type, IntegerVector dims, IntegerVector from, NumericVector gt, CharacterVector p4s, NumericVector na_val, NumericVector scale_offset, bool create = true, bool only_create = false) { // figure out driver: if (driver.length() != 1) stop("driver should have length one"); // #nocov GDALDriver *poDriver; if ((poDriver = GetGDALDriverManager()->GetDriverByName(driver[0])) == NULL) stop("driver not recognized."); // #nocov // can this driver Create()? CSLConstList papszMetadata = poDriver->GetMetadata(); if (!CSLFetchBoolean( papszMetadata, GDAL_DCAP_CREATE, FALSE ) && !CSLFetchBoolean( papszMetadata, GDAL_DCAP_CREATECOPY, FALSE ) ) stop("driver does not support Create() or CreateCopy() method."); // #nocov // figure out eType: GDALDataType eType = GDT_Unknown; if (Type.length() != 1) stop("Type should have length 1"); // #nocov if (Type[0] == "Byte") eType = GDT_Byte; // #nocov #if GDAL_VERSION_NUM >= 3070000 else if (Type[0] == "Int8") eType = GDT_Int8; // #nocov #endif else if (Type[0] == "UInt16") eType = GDT_UInt16; // #nocov else if (Type[0] == "Int16") eType = GDT_Int16; // #nocov else if (Type[0] == "UInt32") eType = GDT_UInt32; // #nocov else if (Type[0] == "Int16") eType = GDT_Int32; // #nocov #if GDAL_VERSION_NUM >= 3110000 else if (Type[0] == "Float16") eType = GDT_Float16; // #nocov #endif else if (Type[0] == "Float32") eType = GDT_Float32; else if (Type[0] == "Float64") // #nocov eType = GDT_Float64; // #nocov else stop("unknown data type"); // #nocov // sanity checks: if (fname.length() != 1) stop("fname should have length one"); // #nocov if (dims.length() != 3) stop("dims should have length three"); // #nocov if (from.length() != 2) stop("from should have length two"); // #nocov if (na_val.length() != 1) stop("na_val should have length 1"); // #nocov if (scale_offset.size() != 2) stop("scale_offset should have length 2"); bool set_scale_offset = (scale_offset[0] != 1.0 || scale_offset[1] != 0.0); // create dataset: GDALDataset *poDstDS; bool createCopy = false; if (create) { if (from[0] != 0 || from[1] != 0) stop("from values should be zero when creating a dataset"); // #nocov if (poDriver->GetMetadataItem(GDAL_DCAP_CREATE) == NULL && poDriver->GetMetadataItem(GDAL_DCAP_CREATECOPY) != NULL) { createCopy = true; GDALDriver *memDriver = GetGDALDriverManager()->GetDriverByName("MEM"); if ((poDstDS = memDriver->Create(fname[0], dims[0], dims[1], dims[2], eType, NULL)) == NULL) stop("cannot create copy in memory"); // #nocov } else if ((poDstDS = poDriver->Create( fname[0], dims[0], dims[1], dims[2], eType, create_options(options).data())) == NULL) stop("creating dataset failed"); // #nocov // set geotransform: double adfGeoTransform[6]; if (gt.length() != 6) stop("gt should have length 6"); // #nocov for (int i = 0; i < gt.length(); i++) adfGeoTransform[i] = gt[i]; if (poDstDS->SetGeoTransform( adfGeoTransform ) != CE_None) warning("SetGeoTransform() returned an error: not available?"); // #nocov // CRS: if (p4s.length() != 1) stop("p4s should have length one"); // #nocov if (p4s[0] != NA_STRING) { OGRSpatialReference oSRS; oSRS.SetFromUserInput((const char *) p4s[0]); // handles wkt too #if GDAL_VERSION_NUM >= 3000000 poDstDS->SetSpatialRef(&oSRS); #else char *pszSRS_WKT = NULL; oSRS.exportToWkt( &pszSRS_WKT ); if (poDstDS->SetProjection( pszSRS_WKT ) != CE_None) stop("SetProjection: error"); // #nocov CPLFree( pszSRS_WKT ); #endif } // set band NA's if (! NumericVector::is_na(na_val[0])) { for (int band = 1; band <= dims(2); band++) { // unlike x & y, band is 1-based GDALRasterBand *poBand = poDstDS->GetRasterBand( band ); if (poBand->SetNoDataValue(na_val[0]) != CE_None) { warning("SetNoDataValue not supported by driver"); // #nocov break; // #nocov } } } // set scale_offset if (set_scale_offset) { for (int band = 1; band <= dims(2); band++) { // unlike x & y, band is 1-based GDALRasterBand *poBand = poDstDS->GetRasterBand( band ); if (poBand->SetScale(scale_offset[0]) != CE_None || poBand->SetOffset(scale_offset[1]) != CE_None) warning("writing scale and/or offset failed (not supported by driver)"); // #nocov } } // set descriptions: if (x.attr("descriptions") != R_NilValue) { Rcpp::CharacterVector descriptions = x.attr("descriptions"); for (int band = 1; band <= dims(2); band++) { GDALRasterBand *poBand = poDstDS->GetRasterBand( band ); poBand->SetDescription(descriptions(band-1)); } } // write factor levels to CategoryNames: if (x.attr("levels") != R_NilValue) { Rcpp::CharacterVector levels = x.attr("levels"); for (int band = 1; band <= dims(2); band++) { GDALRasterBand *poBand = poDstDS->GetRasterBand( band ); if (poBand->SetCategoryNames(create_options(levels).data()) != CE_None) warning("error writing factor levels to raster band"); } } // write color table: if (x.attr("rgba") != R_NilValue) { Rcpp::NumericMatrix co = x.attr("rgba"); // r g b alpha in columns; levels in rows GDALColorTable ct = GDALColorTable(GPI_RGB); GDALColorEntry ce; for (int i = 0; i < co.nrow(); i++) { ce.c1 = co(i, 0); ce.c2 = co(i, 1); ce.c3 = co(i, 2); ce.c4 = co(i, 3); ct.SetColorEntry(i, &ce); } GDALRasterBand *poBand = poDstDS->GetRasterBand( 1 ); // can only set CT for band 1 if (poBand->SetColorTable(&ct) != CE_None) warning("error writing color table to raster band"); } } else { // no create, update: if ((poDstDS = (GDALDataset *) GDALOpen(fname[0], GA_Update)) == NULL) // #nocov stop("updating dataset failed"); // #nocov } if (! only_create) { if (! NumericVector::is_na(na_val[0])) { // replace R's NA's with GDAL write NA value for (int i = 0; i < x.ncol(); i++) { NumericVector nv = x(_, i); for (int j = 0; j < x.nrow(); j++) { if (NumericVector::is_na(nv[j])) nv[j] = na_val[0]; } x(_, i) = nv; } checkUserInterrupt(); } if (set_scale_offset) { for (int i = 0; i < x.ncol(); i++) { NumericVector nv = x(_, i); for (int j = 0; j < x.nrow(); j++) nv[j] = (nv[j] - scale_offset[1]) / scale_offset[0]; // raw = (units - offset) / scale x(_, i) = nv; } } // write values: // write the whole lot: if (poDstDS->RasterIO(GF_Write, from[0], from[1], dims[0] - from[0], dims[1] - from[1], x.begin(), dims[0] - from[0], dims[1] - from[1], GDT_Float64, dims[2], NULL, 0, 0, 0, NULL) == CE_Failure) stop("write failure"); // #nocov if (createCopy) { // so far in memory, still need to write to disk: options.push_back("APPEND_SUBDATASET=YES"); GDALDataset *poCopyDS; if ((poCopyDS = poDriver->CreateCopy(fname[0], poDstDS, FALSE, create_options(options).data(), NULL, NULL)) == NULL) stop("cannot CreateCopy from memory dataset"); GDALClose(poCopyDS); } } /* close: */ GDALClose( (GDALDatasetH) poDstDS ); return; } double get_bilinear(GDALRasterBand *poBand, double Pixel, double Line, int iPixel, int iLine, double RasterXSize, double RasterYSize, int na_set, double na_value) { double pixels[4]; double dY = Line - iLine; // [0, 1) over a raster cell double dX = Pixel - iPixel; // [0, 1) over a raster cell double eps = 1.0e-13; if ((dY < 0.5 && iLine > 0) || (iLine == RasterYSize - 1)) { // where to start reading iLine -= 1; dY += 1.0; } if ((dX < 0.5 && iPixel > 0) || (iPixel == RasterXSize - 1)) { iPixel -= 1; dX += 1.0; } // x: if (Pixel < (0.5 - eps)) // border: dX = 0.0; else if (Pixel > (RasterXSize - 0.5 + eps)) dX = 1.0; else if (dX < (0.5 - eps)) // shift to pixel center: dX += 0.5; else dX -= 0.5; // y: if (Line < (0.5 - eps)) dY = 0.0; else if (Line > (RasterYSize - 0.5 + eps)) dY = 1.0; else if (dY < (0.5 - eps)) dY += 0.5; else dY -= 0.5; // read: if (poBand->RasterIO(GF_Read, iPixel, iLine, 2, 2, (void *) pixels, 2, 2, GDT_CFloat64, sizeof(double), 0, NULL) != CE_None) stop("Error reading!"); // Rprintf("px[%g (%g) %g (%g) %g (%g) %g (%g)] dY: %g dX: %g iLine: %d iPixel: %d Line: %g Pixel :%g\n", pixels[0], (1-dX)*(1-dY), pixels[1], dX * (1-dY), pixels[2], (1-dX) * dY, pixels[3], dX * dY, dY, dX, iLine, iPixel, Line, Pixel); // // f(0,0): pixels[0], f(1,0): pixels[1], f(0,1): pixels[2], f(1,1): pixels[3] if (na_set && (pixels[0] == na_value || pixels[1] == na_value || pixels[2] == na_value || pixels[3] == na_value)) return na_value; else // https://en.wikipedia.org/wiki/Bilinear_interpolation#Unit_square return pixels[0] * (1-dX) * (1-dY) + pixels[1] * dX * (1-dY) + pixels[2] * (1-dX) * dY + pixels[3] * dX * dY; } // [[Rcpp::export(rng=false)]] NumericMatrix CPL_extract(CharacterVector input, NumericMatrix xy, CharacterVector interpolate) { // mostly taken from gdal/apps/gdallocationinfo.cpp GDALDataset *poDataset = (GDALDataset *) GDALOpenEx(input[0], GA_ReadOnly, NULL, NULL, NULL); if (poDataset == NULL) { Rcout << "trying to read file: " << input[0] << std::endl; // #nocov stop("file not found"); // #nocov } NumericMatrix ret(xy.nrow(), poDataset->GetRasterCount()); int xsize = poDataset->GetRasterXSize(); int ysize = poDataset->GetRasterYSize(); GDALRIOResampleAlg RA; if (interpolate[0] == "nearest") RA = GRIORA_NearestNeighbour; else if (interpolate[0] == "bilinear") RA = GRIORA_Bilinear; else if (interpolate[0] == "cubic") RA = GRIORA_Cubic; else if (interpolate[0] == "cubicspline") RA = GRIORA_CubicSpline; else stop("interpolation method not supported"); // #nocov double gt[6]; int n_err = 0; poDataset->GetGeoTransform(gt); double gt_inv[6]; // int retval = GDALInvGeoTransform(gt, gt_inv); if (! GDALInvGeoTransform(gt, gt_inv)) stop("geotransform not invertible"); for (int j = 0; j < poDataset->GetRasterCount(); j++) { GDALRasterBand *poBand = poDataset->GetRasterBand(j+1); int bSuccess; double dfOffset = poBand->GetOffset(&bSuccess); double dfScale = poBand->GetScale(&bSuccess); double nodata = NA_REAL; int nodata_set = 0; poBand->GetNoDataValue(&nodata_set); if (nodata_set) nodata = poBand->GetNoDataValue(NULL); for (int i = 0; i < xy.nrow(); i++) { double dfGeoX = xy(i, 0); double dfGeoY = xy(i, 1); double Pixel = gt_inv[0] + gt_inv[1] * dfGeoX + gt_inv[2] * dfGeoY; double Line = gt_inv[3] + gt_inv[4] * dfGeoX + gt_inv[5] * dfGeoY; int iPixel = static_cast(floor( Pixel )); int iLine = static_cast(floor( Line )); double pixel; if (iPixel < 0 || iLine < 0 || iPixel >= xsize || iLine >= ysize) // outside bbox: pixel = NA_REAL; else { // read pixel: #if GDAL_VERSION_NUM >= 3100000 if (poBand->InterpolateAtPoint(Pixel, Line, RA, &pixel, nullptr) != CE_None) // tbd: handle GRIORA_Cubic, GRIORA_CubicSpline n_err += 1; #else if (RA == GRIORA_Cubic || RA == GRIORA_CubicSpline) stop("cubic or cubicspline requires GDAL >= 3.10.0"); if (RA == GRIORA_Bilinear) pixel = get_bilinear(poBand, Pixel, Line, iPixel, iLine, xsize, ysize, nodata_set, nodata); else if (poBand->RasterIO(GF_Read, iPixel, iLine, 1, 1, &pixel, 1, 1, GDT_CFloat64, 0, 0, NULL) != CE_None) stop("Error reading!"); #endif if (nodata_set && pixel == nodata) pixel = NA_REAL; else if (dfOffset != 0.0 || dfScale != 1.0) pixel = pixel * dfScale + dfOffset; } ret(i, j) = pixel; } } if (n_err > 0) Rcout << n_err << " error(s) in InterpolateAtPoint()" << std::endl; // #nocov GDALClose(poDataset); return ret; } // [[Rcpp::export(rng=false)]] void CPL_create(CharacterVector file, IntegerVector nxy, NumericVector value, CharacterVector wkt, NumericVector xlim, NumericVector ylim) { // // modified from gdal/apps/gdal_create.cpp: // int nPixels = nxy[0], nLines = nxy[1]; GDALDatasetH hDS = GDALCreate(GDALGetDriverByName("GTiff"), file[0], nPixels, nLines, 1, GDT_Byte, NULL); OGRSpatialReference oSRS; #if GDAL_VERSION_NUM >= 2050000 oSRS.SetAxisMappingStrategy(OAMS_TRADITIONAL_GIS_ORDER); #endif if (oSRS.SetFromUserInput( wkt[0] ) != OGRERR_NONE) { CPLError(CE_Failure, CPLE_AppDefined, "Failed to process SRS definition"); stop("CPL_create failed"); } char* pszSRS = nullptr; oSRS.exportToWkt( &pszSRS ); if( GDALSetProjection(hDS, pszSRS) != CE_None ) { CPLFree(pszSRS); GDALClose(hDS); stop("CPL_create failed"); } double adfGeoTransform[6]; adfGeoTransform[0] = xlim[0]; adfGeoTransform[1] = (xlim[1] - xlim[0]) / nPixels; adfGeoTransform[2] = 0; adfGeoTransform[3] = ylim[1]; adfGeoTransform[4] = 0; adfGeoTransform[5] = (ylim[0] - ylim[1]) / nLines; GDALSetGeoTransform(hDS, adfGeoTransform); GDALFillRaster(GDALGetRasterBand(hDS, 1), value[0], 0); CPLFree(pszSRS); GDALClose(hDS); } ================================================ FILE: src/wkb.cpp ================================================ /* everything with "write" is meant as "write from R into foreign (wkb)", "read" as "read from foreign (wkb) into R". */ #include #include #include #include #include // round() #include // memcpy() #include #include "wkb.h" #define EWKB_Z_BIT 0x80000000 #define EWKB_M_BIT 0x40000000 #define EWKB_SRID_BIT 0x20000000 // [[Rcpp::interfaces(r, cpp)]] typedef struct { const unsigned char *pt; size_t size; } wkb_buf; Rcpp::List read_data(wkb_buf *wkb, bool EWKB, bool spatialite, int endian, bool addclass, int *type, uint32_t *srid); void write_data(std::ostringstream& os, Rcpp::List sfc, int i, bool EWKB, int endian, const char *cls, const char *dim, double prec, int srid); static inline void wkb_read(wkb_buf *wkb, void *dst, size_t n) { if (n > wkb->size) Rcpp::stop("range check error: WKB buffer too small. Input file corrupt?"); // #nocov if (dst != NULL) memcpy(dst, wkb->pt, n); wkb->pt += n; wkb->size -= n; } template inline T wkb_read(wkb_buf *wkb) { if (sizeof(T) > wkb->size) Rcpp::stop("range check error: WKB buffer too small. Input file corrupt?"); T dst; memcpy(&dst, wkb->pt, sizeof(T)); wkb->pt += sizeof(T); wkb->size -= sizeof(T); return dst; } // https://stackoverflow.com/questions/105252/how-do-i-convert-between-big-endian-and-little-endian-values-in-c template T swap_endian(T u) { union { T u; unsigned char u8[sizeof(T)]; } source, dest; source.u = u; for (size_t k = 0; k < sizeof(T); k++) dest.u8[k] = source.u8[sizeof(T) - k - 1]; return dest.u; } void read_spatialite_header(wkb_buf *wkb, uint32_t *srid, bool swap) { // we're at byte 3 now: *srid = wkb_read(wkb); if (swap) *srid = swap_endian(*srid); // #nocov wkb_read(wkb, NULL, 32); // skip header // verify special marker; if not there, raise error: unsigned char marker; wkb_read(wkb, &marker, 1); // skip header if (marker != 0x7c) { Rcpp::Rcout << "byte 39 should be 0x7c, but is " << marker << std::endl; // #nocov Rcpp::stop("invalid spatialite header"); // #nocov } } void read_gpkg_header(wkb_buf *wkb, uint32_t *srid, int endian) { // http://www.geopackage.org/spec/#gpb_format wkb_read(wkb, NULL, 3); // 'G', 'P', version // read flag: unsigned char flag; wkb_read(wkb, &flag, 1); bool swap = ((flag & 0x01) != (int) endian); // endian check // read srid, if needed, swap: *srid = wkb_read(wkb); if (swap) *srid = swap_endian(*srid); // #nocov // how much header is there to skip? bbox: 4, 6, 6, or 8 doubles: flag = (flag >> 1) & 0x07; // get bytes 3,2,1 int n = 0; if (flag == 1) // [minx, maxx, miny, maxy] n = 32; else if (flag == 2 || flag == 3) // #nocov start // [minx, maxx, miny, maxy, minz, maxz] or [minx, maxx, miny, maxy, minm, maxm] n = 48; else if (flag == 4) // [minx, maxx, miny, maxy, minz, maxz, minm, maxm] n = 64; // #nocov end wkb_read(wkb, NULL, n); } Rcpp::NumericMatrix read_multipoint(wkb_buf *wkb, int n_dims, bool swap, bool EWKB = 0, bool spatialite = false, int endian = 0, Rcpp::CharacterVector cls = "", bool *empty = NULL) { uint32_t npts = wkb_read(wkb); if (swap) npts = swap_endian(npts); // #nocov Rcpp::NumericMatrix ret(npts, n_dims); for (size_t i = 0; i < npts; i++) { if (spatialite) { // verify special marker; if not there, raise error: unsigned char marker; wkb_read(wkb, &marker, 1); // absorb the 0x69 #nocov start if (marker != 0x69) { Rcpp::Rcout << "0x69 marker missing before ring " << i+1 << std::endl; Rcpp::stop("invalid spatialite header"); } // #nocov end } Rcpp::List lst = read_data(wkb, EWKB, spatialite, endian, false, NULL, NULL); Rcpp::NumericVector vec = lst[0]; for (int j = 0; j < n_dims; j++) ret(i,j) = vec(j); } if (cls.size() == 3) ret.attr("class") = cls; if (empty != NULL) *empty = npts == 0; return ret; } Rcpp::List read_geometrycollection(wkb_buf *wkb, int n_dims, bool swap, bool EWKB = 0, bool spatialite = false, int endian = 0, Rcpp::CharacterVector cls = "", bool isGC = true, bool *empty = NULL) { uint32_t nlst = wkb_read(wkb); if (swap) nlst = swap_endian(nlst); // #nocov Rcpp::List ret(nlst); for (size_t i = 0; i < nlst; i++) { if (spatialite) { // verify special marker; if not there, raise error unsigned char marker; wkb_read(wkb, &marker, 1); // absorb the 0x69 if (marker != 0x69) { // #nocov start Rcpp::Rcout << "0x69 marker missing before ring " << i+1 << std::endl; Rcpp::stop("invalid spatialite header"); } // #nocov end } ret[i] = read_data(wkb, EWKB, spatialite, endian, isGC, NULL, NULL)[0]; } if (cls.size() == 3) ret.attr("class") = cls; if (empty != NULL) *empty = nlst == 0; return ret; } Rcpp::NumericVector read_numeric_vector(wkb_buf *wkb, int n, bool swap, Rcpp::CharacterVector cls = "", bool *empty = NULL) { Rcpp::NumericVector ret(n); for (int i = 0; i < n; i++) { double d = wkb_read(wkb); if (swap) ret(i) = swap_endian(d); // #nocov else ret(i) = d; if (i == 0 && empty != NULL && std::isnan(d)) *empty = true; } if (cls.size() == 3) ret.attr("class") = cls; return ret; } Rcpp::NumericMatrix read_numeric_matrix(wkb_buf *wkb, int n_dims, bool swap, Rcpp::CharacterVector cls = "", bool *empty = NULL) { uint32_t npts = wkb_read(wkb); if (swap) npts = swap_endian(npts); // #nocov Rcpp::NumericMatrix ret = Rcpp::no_init(npts, n_dims); for (size_t i = 0; i < npts; i++) for (int j = 0; j< n_dims; j++) { double d = wkb_read(wkb); if (swap) ret(i, j) = swap_endian(d); // #nocov else ret(i, j) = d; } if (cls.size() == 3) ret.attr("class") = cls; if (empty != NULL) *empty = npts == 0; return ret; } Rcpp::List read_matrix_list(wkb_buf *wkb, int n_dims, bool swap, Rcpp::CharacterVector cls = "", bool *empty = NULL) { uint32_t nlst = wkb_read(wkb); if (swap) nlst = swap_endian(nlst); // #nocov Rcpp::List ret(nlst); for (size_t i = 0; i < nlst; i++) ret[i] = read_numeric_matrix(wkb, n_dims, swap, ""); if (cls.size() == 3) ret.attr("class") = cls; if (empty != NULL) *empty = nlst == 0; return ret; } Rcpp::List read_data(wkb_buf *wkb, bool EWKB = false, bool spatialite = false, int endian = 0, bool addclass = true, int *type = NULL, uint32_t *srid = NULL) { /* pt: handle to the memory buffer EWKB: should we read EWKB, as opposed to ISO WKB? endian: 0 or 1, indicating big (0) or little (1) endian of the buffer addclass: write class information to object? type: IF NOT NULL: output the geometry type of object read srid: IF NOT NULL: output the srid read; NULL indicates a nested call */ Rcpp::List output(1); // to deal with varying result type if (srid != NULL && wkb->size > 2 && wkb->pt[0] == 'G' && wkb->pt[1] == 'P') // GPKG header? skip: read_gpkg_header(wkb, srid, endian); if (spatialite && srid != NULL) wkb_read(wkb, NULL, 1); // starting 0x00 contains no information unsigned char swap_char; bool swap; if (spatialite && srid == NULL) // nested call: don't read swap: swap = false; else { wkb_read(wkb, &swap_char, 1); swap = ((int) swap_char != (int) endian); // endian check } if (spatialite) { if (swap) Rcpp::stop("reading non-native endian spatialite geometries not supported"); // #nocov if (srid != NULL) // not nested: read_spatialite_header(wkb, srid, swap); } // read type: uint32_t wkbType = wkb_read(wkb); if (swap) wkbType = swap_endian(wkbType); // #nocov int sf_type = 0, n_dims = 0; std::string dim_str = ""; if (EWKB) { // EWKB: PostGIS default sf_type = wkbType & 0x000000ff; // mask the other bits int wkbZ = wkbType & EWKB_Z_BIT; int wkbM = wkbType & EWKB_M_BIT; int wkbSRID = wkbType & EWKB_SRID_BIT; n_dims = 2 + (int) (wkbZ != 0) + (int) (wkbM != 0); if (wkbZ == 0 && wkbM == 0) dim_str = "XY"; else if (wkbZ != 0 && wkbM == 0) dim_str = "XYZ"; else if (wkbZ == 0 && wkbM != 1) dim_str = "XYM"; else dim_str = "XYZM"; if (wkbSRID != 0) { if (srid != NULL) { wkb_read(wkb, srid, 4); if (swap) *srid = swap_endian(*srid); // #nocov } } } else { // ISO sf_type = wkbType % 1000; switch (wkbType / 1000) { // 0: XY, 1: XYZ, 2: XYM, 3: XYZM case 0: n_dims = 2; dim_str = "XY"; break; case 1: n_dims = 3; dim_str = "XYZ"; break; case 2: n_dims = 3; dim_str = "XYM"; break; case 3: n_dims = 4; dim_str = "XYZM"; break; default: Rcpp::Rcout << "wkbType: " << wkbType << std::endl; // #nocov Rcpp::stop("unsupported wkbType dim in switch"); // #nocov } } bool empty = false; switch(sf_type) { case SF_Point: output[0] = read_numeric_vector(wkb, n_dims, swap, addclass ? Rcpp::CharacterVector::create(dim_str, "POINT", "sfg") : "", &empty); break; case SF_LineString: output[0] = read_numeric_matrix(wkb, n_dims, swap, addclass ? Rcpp::CharacterVector::create(dim_str, "LINESTRING", "sfg") : "", &empty); break; case SF_Polygon: output[0] = read_matrix_list(wkb, n_dims, swap, addclass ? Rcpp::CharacterVector::create(dim_str, "POLYGON", "sfg") : "", &empty); break; case SF_MultiPoint: output[0] = read_multipoint(wkb, n_dims, swap, EWKB, spatialite, endian, addclass ? Rcpp::CharacterVector::create(dim_str, "MULTIPOINT", "sfg") : "", &empty); break; case SF_MultiLineString: output[0] = read_geometrycollection(wkb, n_dims, swap, EWKB, spatialite, endian, Rcpp::CharacterVector::create(dim_str, "MULTILINESTRING", "sfg"), false, &empty); break; case SF_MultiPolygon: output[0] = read_geometrycollection(wkb, n_dims, swap, EWKB, spatialite, endian, Rcpp::CharacterVector::create(dim_str, "MULTIPOLYGON", "sfg"), false, &empty); break; case SF_GeometryCollection: output[0] = read_geometrycollection(wkb, n_dims, swap, EWKB, spatialite, endian, Rcpp::CharacterVector::create(dim_str, "GEOMETRYCOLLECTION", "sfg"), true, &empty); break; case SF_CircularString: output[0] = read_numeric_matrix(wkb, n_dims, swap, addclass ? Rcpp::CharacterVector::create(dim_str, "CIRCULARSTRING", "sfg") : "", &empty); break; case SF_CompoundCurve: output[0] = read_geometrycollection(wkb, n_dims, swap, EWKB, spatialite, endian, Rcpp::CharacterVector::create(dim_str, "COMPOUNDCURVE", "sfg"), true, &empty); break; case SF_CurvePolygon: output[0] = read_geometrycollection(wkb, n_dims, swap, EWKB, spatialite, endian, Rcpp::CharacterVector::create(dim_str, "CURVEPOLYGON", "sfg"), true, &empty); break; case SF_MultiCurve: output[0] = read_geometrycollection(wkb, n_dims, swap, EWKB, spatialite, endian, Rcpp::CharacterVector::create(dim_str, "MULTICURVE", "sfg"), true, &empty); break; case SF_MultiSurface: output[0] = read_geometrycollection(wkb, n_dims, swap, EWKB, spatialite, endian, Rcpp::CharacterVector::create(dim_str, "MULTISURFACE", "sfg"), true, &empty); break; case SF_Curve: // #nocov start output[0] = read_numeric_matrix(wkb, n_dims, swap, addclass ? Rcpp::CharacterVector::create(dim_str, "CURVE", "sfg") : "", &empty); break; case SF_Surface: output[0] = read_matrix_list(wkb, n_dims, swap, addclass ? Rcpp::CharacterVector::create(dim_str, "SURFACE", "sfg") : "", &empty); break; // #nocov end case SF_PolyhedralSurface: output[0] = read_geometrycollection(wkb, n_dims, swap, EWKB, spatialite, endian, Rcpp::CharacterVector::create(dim_str, "POLYHEDRALSURFACE", "sfg"), false, &empty); break; case SF_TIN: output[0] = read_geometrycollection(wkb, n_dims, swap, EWKB, spatialite, endian, Rcpp::CharacterVector::create(dim_str, "TIN", "sfg"), false, &empty); break; case SF_Triangle: output[0] = read_matrix_list(wkb, n_dims, swap, Rcpp::CharacterVector::create(dim_str, "TRIANGLE", "sfg"), &empty); break; default: { char cp[100]; snprintf(cp, 100, "reading wkb type %d is not supported\n", sf_type); Rcpp::stop(cp); } } if (type != NULL) { if (empty) *type = -sf_type; else *type = sf_type; } return output; } int native_endian(void) { const int one = 1; const unsigned char *cp = (const unsigned char *) &one; return (int) *cp; } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_read_wkb(Rcpp::List wkb_list, bool EWKB = false, bool spatialite = false) { Rcpp::List output(wkb_list.size()); int type = 0, last_type = 0, n_types = 0, n_empty = 0; int endian = native_endian(); uint32_t srid = 0; for (int i = 0; i < wkb_list.size(); i++) { Rcpp::checkUserInterrupt(); Rcpp::RawVector raw = wkb_list[i]; wkb_buf wkb; wkb.pt = &(raw[0]); wkb.size = raw.size(); // const unsigned char *pt = &(raw[0]); output[i] = read_data(&wkb, EWKB, spatialite, endian, true, &type, &srid)[0]; if (type <= 0) { type = -type; n_empty++; } // Rcpp::Rcout << "type is " << type << "\n"; if (n_types <= 1 && type != last_type) { last_type = type; n_types++; // check if there's more than 1 type: } } output.attr("single_type") = n_types <= 1; // if 0, we have only empty geometrycollections output.attr("n_empty") = (int) n_empty; if ((EWKB || spatialite) && srid != 0) output.attr("srid") = (int) srid; return output; } // // write wkb: // unsigned int make_type(const char *cls, const char *dim, bool EWKB = false, int *tp = NULL, int srid = 0) { int type = 0; if (strstr(cls, "sfc_") == cls) cls += 4; if (strcmp(cls, "POINT") == 0) type = SF_Point; else if (strcmp(cls, "LINESTRING") == 0) type = SF_LineString; else if (strcmp(cls, "POLYGON") == 0) type = SF_Polygon; else if (strcmp(cls, "MULTIPOINT") == 0) type = SF_MultiPoint; else if (strcmp(cls, "MULTILINESTRING") == 0) type = SF_MultiLineString; else if (strcmp(cls, "MULTIPOLYGON") == 0) type = SF_MultiPolygon; else if (strcmp(cls, "GEOMETRYCOLLECTION") == 0) type = SF_GeometryCollection; else if (strcmp(cls, "CIRCULARSTRING") == 0) type = SF_CircularString; else if (strcmp(cls, "COMPOUNDCURVE") == 0) type = SF_CompoundCurve; else if (strcmp(cls, "CURVEPOLYGON") == 0) type = SF_CurvePolygon; else if (strcmp(cls, "MULTICURVE") == 0) type = SF_MultiCurve; else if (strcmp(cls, "MULTISURFACE") == 0) type = SF_MultiSurface; else if (strcmp(cls, "CURVE") == 0) type = SF_Curve; // #nocov else if (strcmp(cls, "SURFACE") == 0) type = SF_Surface; // #nocov else if (strcmp(cls, "POLYHEDRALSURFACE") == 0) type = SF_PolyhedralSurface; else if (strcmp(cls, "TIN") == 0) type = SF_TIN; else if (strcmp(cls, "TRIANGLE") == 0) type = SF_Triangle; else type = SF_Unknown; // a mix: GEOMETRY if (tp != NULL) *tp = type; if (EWKB) { if (strcmp(dim, "XYZ") == 0) type = type | EWKB_Z_BIT; else if (strcmp(dim, "XYM") == 0) type = type | EWKB_M_BIT; else if (strcmp(dim, "XYZM") == 0) type = type | EWKB_M_BIT | EWKB_Z_BIT; if (srid != 0) type = type | EWKB_SRID_BIT; } else { if (strcmp(dim, "XYZ") == 0) type += 1000; else if (strcmp(dim, "XYM") == 0) type += 2000; else if (strcmp(dim, "XYZM") == 0) type += 3000; } return type; } void add_byte(std::ostringstream& os, char c) { os.write((char*) &c, sizeof(char)); } void add_int(std::ostringstream& os, unsigned int i) { char *cp = (char *)&i; os.write((char*) cp, sizeof(int)); } double make_precise(double d, double precision) { if (precision == 0.0) return d; if (precision < 0.0) { // round to float, 4-byte precision float f = d; return (double) f; } return round(d * precision) / precision; } void add_double(std::ostringstream& os, double d, double prec = 0.0) { d = make_precise(d, prec); // doubles are ALWAYS coordinates char *cp = (char *)&d; os.write((char*) cp, sizeof(double)); } void write_vector(std::ostringstream& os, Rcpp::NumericVector vec, double prec) { for (int i = 0; i < vec.length(); i++) add_double(os, vec(i), prec); } void write_matrix(std::ostringstream& os, Rcpp::NumericMatrix mat, double prec) { auto nrow = mat.nrow(); auto ncol = mat.ncol(); add_int(os, mat.nrow()); for (decltype(nrow) i = 0; i < nrow; i++) for (decltype(ncol) j = 0; j < ncol; j++) add_double(os, mat(i,j), prec); } void write_matrix_list(std::ostringstream& os, Rcpp::List lst, double prec) { size_t len = lst.length(); add_int(os, len); for (size_t i = 0; i < len; i++) write_matrix(os, lst[i], prec); } void write_multilinestring(std::ostringstream& os, Rcpp::List lst, bool EWKB = false, int endian = 0, double prec = 0.0) { Rcpp::CharacterVector cl_attr = lst.attr("class"); const char *dim = cl_attr[0]; add_int(os, lst.length()); for (int i = 0; i < lst.length(); i++) write_data(os, lst, i, EWKB, endian, "LINESTRING", dim, prec, 0); } void write_multipolygon(std::ostringstream& os, Rcpp::List lst, bool EWKB = false, int endian = 0, double prec = 0.0) { Rcpp::CharacterVector cl_attr = lst.attr("class"); const char *dim = cl_attr[0]; add_int(os, lst.length()); for (int i = 0; i < lst.length(); i++) write_data(os, lst, i, EWKB, endian, "POLYGON", dim, prec, 0); } void write_triangles(std::ostringstream& os, Rcpp::List lst, bool EWKB = false, int endian = 0, double prec = 0.0) { Rcpp::CharacterVector cl_attr = lst.attr("class"); const char *dim = cl_attr[0]; add_int(os, lst.length()); for (int i = 0; i < lst.length(); i++) write_data(os, lst, i, EWKB, endian, "TRIANGLE", dim, prec, 0); } void write_geometrycollection(std::ostringstream& os, Rcpp::List lst, bool EWKB = false, int endian = 0, double prec = 0.0) { add_int(os, lst.length()); Rcpp::Function Rclass("class"); for (int i = 0; i < lst.length(); i++) { Rcpp::CharacterVector cl_attr = Rclass(lst[i]); const char *cls = cl_attr[1], *dim = cl_attr[0]; write_data(os, lst, i, EWKB, endian, cls, dim, prec, 0); } } void write_multipoint(std::ostringstream& os, Rcpp::NumericMatrix mat, bool EWKB = false, int endian = 0, double prec = 0.0) { add_int(os, mat.nrow()); Rcpp::CharacterVector cl_attr = mat.attr("class"); const char *dim = cl_attr[0]; Rcpp::NumericVector v(mat.ncol()); // copy row i for (int i = 0; i < mat.nrow(); i++) { for (int j = 0; j < mat.ncol(); j++) v(j) = mat(i,j); write_data(os, Rcpp::List::create(v), 0, EWKB, endian, "POINT", dim, prec, 0); } } // write single simple feature object as (E)WKB to stream os void write_data(std::ostringstream& os, Rcpp::List sfc, int i = 0, bool EWKB = false, int endian = 0, const char *cls = NULL, const char *dim = NULL, double prec = 0.0, int srid = 0) { add_byte(os, (char) endian); int tp; unsigned int sf_type = make_type(cls, dim, EWKB, &tp, srid); add_int(os, sf_type); if (EWKB && srid != 0) add_int(os, srid); switch(tp) { case SF_Point: write_vector(os, sfc[i], prec); break; case SF_LineString: write_matrix(os, sfc[i], prec); break; case SF_Polygon: write_matrix_list(os, sfc[i], prec); break; case SF_MultiPoint: write_multipoint(os, sfc[i], EWKB, endian, prec); break; case SF_MultiLineString: write_multilinestring(os, sfc[i], EWKB, endian, prec); break; case SF_MultiPolygon: write_multipolygon(os, sfc[i], EWKB, endian, prec); break; case SF_GeometryCollection: write_geometrycollection(os, sfc[i], EWKB, endian, prec); break; case SF_CircularString: write_matrix(os, sfc[i], prec); break; case SF_CompoundCurve: write_geometrycollection(os, sfc[i], EWKB, endian, prec); break; case SF_CurvePolygon: write_geometrycollection(os, sfc[i], EWKB, endian, prec); break; case SF_MultiCurve: write_geometrycollection(os, sfc[i], EWKB, endian, prec); break; case SF_MultiSurface: write_geometrycollection(os, sfc[i], EWKB, endian, prec); break; case SF_Curve: write_matrix(os, sfc[i], prec); // #nocov start break; case SF_Surface: write_matrix_list(os, sfc[i], prec); break; // #nocov end case SF_PolyhedralSurface: write_multipolygon(os, sfc[i], EWKB, endian, prec); break; case SF_TIN: write_triangles(os, sfc[i], EWKB, endian, prec); break; case SF_Triangle: write_matrix_list(os, sfc[i], prec); break; default: { Rcpp::Rcout << "type is " << sf_type << "\n"; // #nocov Rcpp::stop("writing this sf type is not supported, please file an issue"); // #nocov } } } // [[Rcpp::export(rng=false)]] Rcpp::List CPL_write_wkb(Rcpp::List sfc, bool EWKB = false) { double precision = sfc.attr("precision"); Rcpp::CharacterVector cls_attr = sfc.attr("class"); Rcpp::List sfc_dim = get_dim_sfc(sfc); Rcpp::CharacterVector dim = sfc_dim["_cls"]; const char *cls = cls_attr[0], *dm = dim[0]; Rcpp::List output(sfc.size()); // with raw vectors int endian = native_endian(); // got the following from: // http://stackoverflow.com/questions/24744802/rcpp-how-to-check-if-any-attribute-is-null Rcpp::CharacterVector classes; bool have_classes = false; if (sfc.size() > 0 && strcmp(cls, "sfc_GEOMETRY") == 0) { if (sfc.hasAttribute("classes")) { // only sfc_GEOMETRY, the mixed bag, sets the classes attr classes = sfc.attr("classes"); if (classes.size() != sfc.size()) Rcpp::stop("attr classes has wrong size: please file an issue"); // #nocov have_classes = true; } else Rcpp::stop("sfc_GEOMETRY has no classes attribute; please file an issue"); // #nocov } int srid = 0; if (EWKB) { // get SRID from crs[["input"]], either of the form "4326" // or "XXXX:4326" with arbitrary XXXX string, // or else from the wkt field of the crs using srid_from_crs() Rcpp::List crs = sfc.attr("crs"); Rcpp::CharacterVector input = crs(0); char *inp = input[0]; char *remainder = NULL; // check for ":", and move one beyond: if ((remainder = strstr(inp, ":")) != NULL) inp = remainder + 1; long value = strtol(inp, &remainder, 10); if (*remainder == '\0') // strtol() succeeded: srid = (int) value; else { int i = srid_from_crs(crs); if (i != NA_INTEGER) srid = i; // else leave 0 } } for (int i = 0; i < sfc.size(); i++) { Rcpp::checkUserInterrupt(); std::ostringstream os; if (have_classes) cls = classes[i]; write_data(os, sfc, i, EWKB, endian, cls, dm, precision, srid); Rcpp::RawVector raw(os.str().size()); // os -> raw: std::string str = os.str(); const char *cp = str.c_str(); for (size_t j = 0; j < str.size(); j++) raw[j] = cp[j]; output[i] = raw; // raw vector to list } return output; } // get dim, "XY", "XYZ", "XYZM" or "XYM" from an sfc object Rcpp::List get_dim_sfc(Rcpp::List sfc) { if (sfc.length() == 0) return Rcpp::List::create( Rcpp::Named("_cls") = Rcpp::CharacterVector::create("XY"), Rcpp::Named("_dim") = Rcpp::IntegerVector::create(2) ); // we have data: Rcpp::CharacterVector cls = sfc.attr("class"); unsigned int tp = make_type(cls[0], "", false, NULL, 0); if (tp == SF_Unknown) { cls = sfc.attr("classes"); tp = make_type(cls[0], "", false, NULL, 0); } switch (tp) { case SF_Unknown: { // further check: Rcpp::stop("impossible classs in get_dim_sfc()"); // #nocov } break; case SF_Point: { // numeric: Rcpp::NumericVector v = sfc[0]; cls = v.attr("class"); } break; case SF_LineString: // matrix: case SF_MultiPoint: case SF_CircularString: case SF_Curve: { Rcpp::NumericMatrix m = sfc[0]; cls = m.attr("class"); } break; case SF_Polygon: // list: case SF_MultiLineString: case SF_MultiPolygon: case SF_GeometryCollection: case SF_CompoundCurve: case SF_CurvePolygon: case SF_MultiCurve: case SF_MultiSurface: case SF_Surface: case SF_PolyhedralSurface: case SF_TIN: case SF_Triangle: { Rcpp::List l = sfc[0]; cls = l.attr("class"); } break; } return Rcpp::List::create( Rcpp::Named("_cls") = cls, Rcpp::Named("_dim") = strstr(cls[0], "Z") != NULL ? Rcpp::IntegerVector::create(3) : Rcpp::IntegerVector::create(2)); } ================================================ FILE: src/wkb.h ================================================ #ifndef SF_WKB_H_ #define SF_WKB_H_ /* NULL/EMPTY 0 */ #define SF_Unknown 0 /* sfc_GEOMETRY */ #define SF_Point 1 #define SF_LineString 2 #define SF_Polygon 3 #define SF_MultiPoint 4 #define SF_MultiLineString 5 #define SF_MultiPolygon 6 #define SF_GeometryCollection 7 #define SF_CircularString 8 #define SF_CompoundCurve 9 #define SF_CurvePolygon 10 #define SF_MultiCurve 11 #define SF_MultiSurface 12 #define SF_Curve 13 #define SF_Surface 14 #define SF_PolyhedralSurface 15 #define SF_TIN 16 #define SF_Triangle 17 Rcpp::List CPL_read_wkb(Rcpp::List wkb_list, bool EWKB, bool spatialite); Rcpp::List CPL_write_wkb(Rcpp::List sfc, bool EWKB); unsigned int make_type(const char *cls, const char *dim, bool EWKB, int *tp, int srid); Rcpp::List get_dim_sfc(Rcpp::List sfc); int srid_from_crs(Rcpp::List crs); #endif // SF_WKB_H_ ================================================ FILE: src/zm_range.cpp ================================================ #include #include "zm_range.h" int get_m_position(Rcpp::NumericVector& pt) { if( pt.size() < 3 ) { return -1; } int pos = pt.size() == 3 ? 2 : 3; return pos; } int get_m_position(Rcpp::NumericMatrix& nm) { if( nm.ncol() < 3 ) { return -1; } int pos = nm.ncol() == 3 ? 2 : 3; return pos; } int get_z_position(Rcpp::NumericVector& pt) { if( pt.size() < 3 ) { return -1; } return 2; } int get_z_position(Rcpp::NumericMatrix& nm) { if( nm.ncol() < 3 ) { return -1; } return 2; } // [[Rcpp::export(rng=false)]] Rcpp::NumericVector CPL_get_z_range(Rcpp::List sf, int depth) { Rcpp::NumericVector bb_na(2); bb_na[0] = bb_na[1] = NA_REAL; Rcpp::NumericVector bb(2); bb[0] = bb[1] = NA_REAL; auto n = sf.size(); switch(depth) { case 0: // points: for (decltype(n) i = 0; i < n; i++) { Rcpp::NumericVector pt = sf[i]; int pos = get_z_position(pt); if (i == -1) return bb_na; else if (i == 0) { bb[0] = pt[pos]; bb[1] = pt[pos]; } else { bb[0] = std::min(pt[pos],bb[0]); bb[1] = std::max(pt[pos],bb[1]); } } break; case 1: { // list of matrices: bool initialised = false; for (decltype(n) i = 0; i < n; i++) { Rcpp::NumericMatrix m = sf[i]; int pos = get_z_position(m); if (pos == -1) return bb_na; auto rows = m.nrow(); if (rows > 0) { if (! initialised) { // initialize: bb[0] = m(0,pos); bb[1] = m(0,pos); initialised = true; } for (decltype(rows) j = 0; j < rows; j++) { bb[0] = std::min(m(j,pos),bb[0]); bb[1] = std::max(m(j,pos),bb[1]); } } } } break; default: // recursive list for (decltype(n) i = 0; i < n; i++) { Rcpp::NumericVector bbi = CPL_get_z_range(sf[i], depth - 1); // recurse if (! Rcpp::NumericVector::is_na(bbi[0])) { if (i == 0) { bb[0] = bbi[0]; bb[1] = bbi[1]; } else { bb[0] = std::min(bbi[0],bb[0]); bb[1] = std::max(bbi[1],bb[1]); } } } break; } return bb; } // [[Rcpp::export(rng=false)]] Rcpp::NumericVector CPL_get_m_range(Rcpp::List sf, int depth) { Rcpp::NumericVector bb_na(2); bb_na[0] = bb_na[1] = NA_REAL; Rcpp::NumericVector bb(2); bb[0] = bb[1] = NA_REAL; auto n = sf.size(); switch(depth) { case 0: // points: for (decltype(n) i = 0; i < n; i++) { Rcpp::NumericVector pt = sf[i]; int pos = get_m_position(pt); if (i == -1) return bb_na; else if (i == 0) { bb[0] = pt[pos]; bb[1] = pt[pos]; } else { bb[0] = std::min(pt[pos],bb[0]); bb[1] = std::max(pt[pos],bb[1]); } } break; case 1: { // list of matrices: bool initialised = false; for (decltype(n) i = 0; i < n; i++) { Rcpp::NumericMatrix m = sf[i]; int pos = get_m_position(m); if (pos == -1) return bb_na; auto rows = m.nrow(); if (rows > 0) { if (! initialised) { // initialize: bb[0] = m(0,pos); bb[1] = m(0,pos); initialised = true; } for (decltype(rows) j = 0; j < rows; j++) { bb[0] = std::min(m(j,pos),bb[0]); bb[1] = std::max(m(j,pos),bb[1]); } } } } break; default: // recursive list for (decltype(n) i = 0; i < n; i++) { Rcpp::NumericVector bbi = CPL_get_m_range(sf[i], depth - 1); // recurse if (! Rcpp::NumericVector::is_na(bbi[0])) { if (i == 0) { bb[0] = bbi[0]; bb[1] = bbi[1]; } else { bb[0] = std::min(bbi[0],bb[0]); bb[1] = std::max(bbi[1],bb[1]); } } } break; } return bb; } ================================================ FILE: src/zm_range.h ================================================ #ifndef SF_ZM_RANGE_H_ #define SF_ZM_RANGE_H_ //Rcpp::NumericVector CPL_get_zm_range(Rcpp::List sf, int depth); int get_m_position(Rcpp::NumericVector& pt); int get_m_position(Rcpp::NumericMatrix& nm); int get_z_position(Rcpp::NumericVector& pt); int get_z_position(Rcpp::NumericMatrix& nm); Rcpp::NumericVector CPL_get_z_range(Rcpp::List sf, int depth); Rcpp::NumericVector CPL_get_m_range(Rcpp::List sf, int depth); #endif // SF_ZM_RANGE_H_ ================================================ FILE: tests/aggregate.R ================================================ ## IGNORE_RDIFF_BEGIN library(sf) ## IGNORE_RDIFF_END # aggregate pl1 = st_polygon(list(rbind(c(0,0),c(1,0),c(1,1),c(0,0)))) pl2 = st_polygon(list(rbind(c(0,0),c(1,1),c(0,1),c(0,0)))) s = st_sf(a = 1:2, geom = st_sfc(pl1, pl2)) (a = aggregate(s, list(c(1,1)), mean, do_union = FALSE)) (a = aggregate(s, list(c(1,1)), mean, do_union = TRUE)) # expect_warning(st_cast(a, "POINT")) if (suppressPackageStartupMessages(require(sp, quietly = TRUE))) { demo(meuse_sf, echo = FALSE, ask = FALSE) a = aggregate(meuse_sf, list(meuse_sf$soil), mean) print(attributes(a)$agr) a = aggregate(meuse_sf, list(soil = meuse_sf$soil), mean) print(attributes(a)$agr) a = aggregate(meuse_sf, list(meuse_sf$soil, meuse_sf$ffreq), mean) print(attributes(a)$agr) a = aggregate(meuse_sf, list(soil = meuse_sf$soil, ff = meuse_sf$ffreq), mean) print(attributes(a)$agr) } # aggregate by sf/sfc a = st_polygon(list(rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0)))) * 2 b = a + 1 p = st_sfc(st_point(c(0.1,0.1)), st_point(c(1.5,1.5)), st_point(c(2.9,2.9))) x = st_sf(count = 1:3, geom = p) aggregate(x, st_sfc(a,b), mean) aggregate(x, st_sf(st_sfc(a,b)), mean) aggregate(x, st_sf(st_sfc(a,b,b+10)), mean) ================================================ FILE: tests/aggregate.Rout.save ================================================ R Under development (unstable) (2025-11-05 r88988 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## IGNORE_RDIFF_BEGIN > library(sf) Linking to GEOS 3.13.1, GDAL 3.11.4, PROJ 9.7.0; sf_use_s2() is TRUE > ## IGNORE_RDIFF_END > # aggregate > pl1 = st_polygon(list(rbind(c(0,0),c(1,0),c(1,1),c(0,0)))) > pl2 = st_polygon(list(rbind(c(0,0),c(1,1),c(0,1),c(0,0)))) > s = st_sf(a = 1:2, geom = st_sfc(pl1, pl2)) > (a = aggregate(s, list(c(1,1)), mean, do_union = FALSE)) Simple feature collection with 1 feature and 2 fields Attribute-geometry relationships: aggregate (1), identity (1) Geometry type: MULTIPOLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA Group.1 a geometry 1 1 1.5 MULTIPOLYGON (((0 0, 1 0, 1... > (a = aggregate(s, list(c(1,1)), mean, do_union = TRUE)) Simple feature collection with 1 feature and 2 fields Attribute-geometry relationships: aggregate (1), identity (1) Geometry type: POLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA Group.1 a geometry 1 1 1.5 POLYGON ((1 0, 0 0, 0 1, 1 ... > # expect_warning(st_cast(a, "POINT")) > if (suppressPackageStartupMessages(require(sp, quietly = TRUE))) { + demo(meuse_sf, echo = FALSE, ask = FALSE) + a = aggregate(meuse_sf, list(meuse_sf$soil), mean) + print(attributes(a)$agr) + a = aggregate(meuse_sf, list(soil = meuse_sf$soil), mean) + print(attributes(a)$agr) + a = aggregate(meuse_sf, list(meuse_sf$soil, meuse_sf$ffreq), mean) + print(attributes(a)$agr) + a = aggregate(meuse_sf, list(soil = meuse_sf$soil, ff = meuse_sf$ffreq), mean) + print(attributes(a)$agr) + } Group.1 cadmium copper lead zinc elev dist om identity aggregate aggregate aggregate aggregate aggregate aggregate aggregate ffreq soil lime landuse dist.m aggregate aggregate aggregate aggregate aggregate Levels: constant aggregate identity soil cadmium copper lead zinc elev dist om identity aggregate aggregate aggregate aggregate aggregate aggregate aggregate ffreq soil.1 lime landuse dist.m aggregate aggregate aggregate aggregate aggregate Levels: constant aggregate identity Group.1 Group.2 cadmium copper lead zinc elev dist identity identity aggregate aggregate aggregate aggregate aggregate aggregate om ffreq soil lime landuse dist.m aggregate aggregate aggregate aggregate aggregate aggregate Levels: constant aggregate identity soil ff cadmium copper lead zinc elev dist identity identity aggregate aggregate aggregate aggregate aggregate aggregate om ffreq soil.1 lime landuse dist.m aggregate aggregate aggregate aggregate aggregate aggregate Levels: constant aggregate identity There were 50 or more warnings (use warnings() to see the first 50) > > # aggregate by sf/sfc > a = st_polygon(list(rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0)))) * 2 > b = a + 1 > p = st_sfc(st_point(c(0.1,0.1)), st_point(c(1.5,1.5)), st_point(c(2.9,2.9))) > x = st_sf(count = 1:3, geom = p) > aggregate(x, st_sfc(a,b), mean) Simple feature collection with 2 features and 1 field Geometry type: POLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 3 ymax: 3 CRS: NA count geometry 1 1.5 POLYGON ((0 0, 2 0, 2 2, 0 ... 2 2.5 POLYGON ((1 1, 3 1, 3 3, 1 ... > aggregate(x, st_sf(st_sfc(a,b)), mean) Simple feature collection with 2 features and 1 field Geometry type: POLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 3 ymax: 3 CRS: NA count geometry 1 1.5 POLYGON ((0 0, 2 0, 2 2, 0 ... 2 2.5 POLYGON ((1 1, 3 1, 3 3, 1 ... > aggregate(x, st_sf(st_sfc(a,b,b+10)), mean) Simple feature collection with 3 features and 1 field Geometry type: POLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 13 ymax: 13 CRS: NA count geometry 1 1.5 POLYGON ((0 0, 2 0, 2 2, 0 ... 2 2.5 POLYGON ((1 1, 3 1, 3 3, 1 ... 3 NA POLYGON ((11 11, 13 11, 13 ... > > proc.time() user system elapsed 0.62 0.12 0.73 ================================================ FILE: tests/cast.R ================================================ suppressPackageStartupMessages(library(sf)) library(testthat) # "vertical" conversions: # column 1: mp = st_sfc(st_multipoint(matrix(0:3,,2)), st_multipoint(matrix(10:15,,2))) (ls = st_cast(mp, "LINESTRING")) st_cast(ls, "MULTIPOINT") # column 2: mls = st_sfc(st_multilinestring(list(rbind(c(0,0), c(10,0), c(10,10), c(0,10)), rbind(c(5,5),c(5,6), c(6,6), c(6,5)))), st_multilinestring(list(rbind(c(0,0), c(1,0), c(1,1), c(0,1))))) (pol = st_cast(mls, "POLYGON")) st_cast(pol, "MULTILINESTRING") # "horizontal" conversions: (pt = st_cast(mp, "POINT")) (i = attr(pt, "ids")) (xx = st_cast(pt, "MULTIPOINT", rep(seq_along(i), i))) try(yy <- st_cast(pt, "LINESTRING", rep(seq_along(i), i))) #(zz = st_cast(yy, "MULTILINESTRING")) #(zz = st_cast(yy, "POLYGON")) st_cast(mls, "LINESTRING") (g = st_sfc(c(mls, ls))) st_cast(g, "MULTILINESTRING") expect_warning(st_cast(g, "LINESTRING")) st_cast(st_cast(g, "MULTILINESTRING"), "LINESTRING") # will not loose gc = st_sfc(st_geometrycollection( list( st_multilinestring(list(rbind(c(0,0), c(10,0), c(10,10), c(0,10)), rbind(c(5,5),c(5,6), c(6,6), c(6,5)))), st_multilinestring(list(rbind(c(0,0), c(1,0), c(1,1), c(0,1)))), st_point(0:1) ))) try(st_cast(mls, "POINT")) try(st_cast(mls, "MULTIPOINT")) outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) pol1 = list(outer, hole1, hole2) pol2 = list(outer + 12, hole1 + 12) pol3 = list(outer + 24) mp = list(pol1,pol2,pol3) mp1 = st_multipolygon(mp) s = st_sfc(mp1) x = st_cast(s, "MULTIPOINT") x = st_cast(s, "POINT") expect_warning(st_cast(mp1, "LINESTRING")) expect_warning(st_cast(mp1, "POINT")) mls = mls[[1]] class(mls) #expect_error(st_cast(mls, "POLYGON")) st_cast(mls, "POLYGON") expect_warning(st_cast(mls, "POINT")) p1 = st_polygon(pol1) expect_warning(st_cast(p1, "POINT")) ls = ls[[1]] class(ls) expect_warning(st_cast(ls, "POINT")) mls = st_cast(p1, "MULTILINESTRING") p2 = st_cast(mls, "POLYGON") # st_is: st_is(st_point(0:1), "POINT") sfc = st_sfc(st_point(0:1), st_linestring(matrix(1:6,,2))) st_is(sfc, "POINT") st_is(sfc, "POLYGON") st_is(sfc, "LINESTRING") st_is(st_sf(a = 1:2, sfc), "LINESTRING") st_is(sfc, c("POINT", "LINESTRING")) #1194: wkt <- "MULTICURVE (COMPOUNDCURVE (LINESTRING (-83.62333 35.55244, -83.62328 35.55232, -83.62323 35.55223, -83.62319 35.55216, -83.62312 35.55209, -83.6231 35.55207), CIRCULARSTRING (-83.6231 35.55207, -83.62307 35.55205, -83.62302 35.55204), LINESTRING (-83.62302 35.55204, -83.62299 35.55203, -83.62289 35.55198, -83.62281 35.55189, -83.62271 35.55182)))" g <- st_as_sfc(wkt) g <- st_sf(demo = "test", geom = g, crs = 4326) m = st_cast(g, "MULTILINESTRING") identical(m$geom[[1]], st_cast(g$geom[[1]], "MULTILINESTRING")) st_cast(st_sfc(st_geometrycollection(), st_multipolygon()), 'MULTIPOLYGON') #1961 st_cast(st_sfc(st_geometrycollection(), st_multipolygon(), st_point(0:1)), 'POINT') #1961 ================================================ FILE: tests/cast.Rout.save ================================================ R Under development (unstable) (2025-11-05 r88988 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > suppressPackageStartupMessages(library(sf)) > library(testthat) > # "vertical" conversions: > # column 1: > mp = st_sfc(st_multipoint(matrix(0:3,,2)), st_multipoint(matrix(10:15,,2))) > (ls = st_cast(mp, "LINESTRING")) Geometry set for 2 features Geometry type: LINESTRING Dimension: XY Bounding box: xmin: 0 ymin: 2 xmax: 12 ymax: 15 CRS: NA LINESTRING (0 2, 1 3) LINESTRING (10 13, 11 14, 12 15) > st_cast(ls, "MULTIPOINT") Geometry set for 2 features Geometry type: MULTIPOINT Dimension: XY Bounding box: xmin: 0 ymin: 2 xmax: 12 ymax: 15 CRS: NA MULTIPOINT ((0 2), (1 3)) MULTIPOINT ((10 13), (11 14), (12 15)) > > # column 2: > mls = st_sfc(st_multilinestring(list(rbind(c(0,0), c(10,0), c(10,10), c(0,10)), + rbind(c(5,5),c(5,6), c(6,6), c(6,5)))), + st_multilinestring(list(rbind(c(0,0), c(1,0), c(1,1), c(0,1))))) > (pol = st_cast(mls, "POLYGON")) Geometry set for 2 features Geometry type: POLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 10 ymax: 10 CRS: NA POLYGON ((0 0, 10 0, 10 10, 0 10, 0 0), (5 5, 5... POLYGON ((0 0, 1 0, 1 1, 0 1, 0 0)) > st_cast(pol, "MULTILINESTRING") Geometry set for 2 features Geometry type: MULTILINESTRING Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 10 ymax: 10 CRS: NA MULTILINESTRING ((0 0, 10 0, 10 10, 0 10, 0 0),... MULTILINESTRING ((0 0, 1 0, 1 1, 0 1, 0 0)) > > # "horizontal" conversions: > > (pt = st_cast(mp, "POINT")) Geometry set for 5 features Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 2 xmax: 12 ymax: 15 CRS: NA POINT (0 2) POINT (1 3) POINT (10 13) POINT (11 14) POINT (12 15) > (i = attr(pt, "ids")) [1] 2 3 > (xx = st_cast(pt, "MULTIPOINT", rep(seq_along(i), i))) Geometry set for 5 features Geometry type: MULTIPOINT Dimension: XY Bounding box: xmin: 0 ymin: 2 xmax: 12 ymax: 15 CRS: NA MULTIPOINT ((0 2)) MULTIPOINT ((1 3)) MULTIPOINT ((10 13)) MULTIPOINT ((11 14)) MULTIPOINT ((12 15)) > try(yy <- st_cast(pt, "LINESTRING", rep(seq_along(i), i))) > > #(zz = st_cast(yy, "MULTILINESTRING")) > #(zz = st_cast(yy, "POLYGON")) > > st_cast(mls, "LINESTRING") Geometry set for 3 features Geometry type: LINESTRING Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 10 ymax: 10 CRS: NA LINESTRING (0 0, 10 0, 10 10, 0 10) LINESTRING (5 5, 5 6, 6 6, 6 5) LINESTRING (0 0, 1 0, 1 1, 0 1) > > (g = st_sfc(c(mls, ls))) Geometry set for 4 features Geometry type: GEOMETRY Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 12 ymax: 15 CRS: NA MULTILINESTRING ((0 0, 10 0, 10 10, 0 10), (5 5... MULTILINESTRING ((0 0, 1 0, 1 1, 0 1)) LINESTRING (0 2, 1 3) LINESTRING (10 13, 11 14, 12 15) > st_cast(g, "MULTILINESTRING") Geometry set for 4 features Geometry type: MULTILINESTRING Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 12 ymax: 15 CRS: NA MULTILINESTRING ((0 0, 10 0, 10 10, 0 10), (5 5... MULTILINESTRING ((0 0, 1 0, 1 1, 0 1)) MULTILINESTRING ((0 2, 1 3)) MULTILINESTRING ((10 13, 11 14, 12 15)) > expect_warning(st_cast(g, "LINESTRING")) > st_cast(st_cast(g, "MULTILINESTRING"), "LINESTRING") # will not loose Geometry set for 5 features Geometry type: LINESTRING Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 12 ymax: 15 CRS: NA LINESTRING (0 0, 10 0, 10 10, 0 10) LINESTRING (5 5, 5 6, 6 6, 6 5) LINESTRING (0 0, 1 0, 1 1, 0 1) LINESTRING (0 2, 1 3) LINESTRING (10 13, 11 14, 12 15) > > gc = st_sfc(st_geometrycollection( + list( + st_multilinestring(list(rbind(c(0,0), c(10,0), c(10,10), c(0,10)), + rbind(c(5,5),c(5,6), c(6,6), c(6,5)))), + st_multilinestring(list(rbind(c(0,0), c(1,0), c(1,1), c(0,1)))), + st_point(0:1) + ))) > try(st_cast(mls, "POINT")) Geometry set for 12 features Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 10 ymax: 10 CRS: NA First 5 geometries: POINT (0 0) POINT (10 0) POINT (10 10) POINT (0 10) POINT (5 5) > try(st_cast(mls, "MULTIPOINT")) Geometry set for 3 features Geometry type: MULTIPOINT Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 10 ymax: 10 CRS: NA MULTIPOINT ((0 0), (10 0), (10 10), (0 10)) MULTIPOINT ((5 5), (5 6), (6 6), (6 5)) MULTIPOINT ((0 0), (1 0), (1 1), (0 1)) > > outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) > hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) > hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) > pol1 = list(outer, hole1, hole2) > pol2 = list(outer + 12, hole1 + 12) > pol3 = list(outer + 24) > mp = list(pol1,pol2,pol3) > mp1 = st_multipolygon(mp) > s = st_sfc(mp1) > x = st_cast(s, "MULTIPOINT") > x = st_cast(s, "POINT") > expect_warning(st_cast(mp1, "LINESTRING")) > expect_warning(st_cast(mp1, "POINT")) > mls = mls[[1]] > class(mls) [1] "XY" "MULTILINESTRING" "sfg" > #expect_error(st_cast(mls, "POLYGON")) > st_cast(mls, "POLYGON") POLYGON ((0 0, 10 0, 10 10, 0 10, 0 0), (5 5, 5 6, 6 6, 6 5, 5 5)) > > expect_warning(st_cast(mls, "POINT")) > p1 = st_polygon(pol1) > expect_warning(st_cast(p1, "POINT")) > ls = ls[[1]] > class(ls) [1] "XY" "LINESTRING" "sfg" > expect_warning(st_cast(ls, "POINT")) > > mls = st_cast(p1, "MULTILINESTRING") > p2 = st_cast(mls, "POLYGON") > > # st_is: > st_is(st_point(0:1), "POINT") [1] TRUE > sfc = st_sfc(st_point(0:1), st_linestring(matrix(1:6,,2))) > st_is(sfc, "POINT") [1] TRUE FALSE > st_is(sfc, "POLYGON") [1] FALSE FALSE > st_is(sfc, "LINESTRING") [1] FALSE TRUE > st_is(st_sf(a = 1:2, sfc), "LINESTRING") [1] FALSE TRUE > st_is(sfc, c("POINT", "LINESTRING")) [1] TRUE TRUE > > #1194: > wkt <- "MULTICURVE (COMPOUNDCURVE (LINESTRING (-83.62333 35.55244, -83.62328 35.55232, -83.62323 35.55223, -83.62319 35.55216, -83.62312 35.55209, -83.6231 35.55207), CIRCULARSTRING (-83.6231 35.55207, -83.62307 35.55205, -83.62302 35.55204), LINESTRING (-83.62302 35.55204, -83.62299 35.55203, -83.62289 35.55198, -83.62281 35.55189, -83.62271 35.55182)))" > g <- st_as_sfc(wkt) > g <- st_sf(demo = "test", geom = g, crs = 4326) > m = st_cast(g, "MULTILINESTRING") > identical(m$geom[[1]], st_cast(g$geom[[1]], "MULTILINESTRING")) [1] TRUE > > st_cast(st_sfc(st_geometrycollection(), st_multipolygon()), 'MULTIPOLYGON') #1961 Geometry set for 2 features (with 2 geometries empty) Geometry type: MULTIPOLYGON Dimension: XY Bounding box: xmin: NA ymin: NA xmax: NA ymax: NA CRS: NA MULTIPOLYGON EMPTY MULTIPOLYGON EMPTY > st_cast(st_sfc(st_geometrycollection(), st_multipolygon(), st_point(0:1)), 'POINT') #1961 Geometry set for 3 features (with 2 geometries empty) Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 1 xmax: 0 ymax: 1 CRS: NA POINT EMPTY POINT EMPTY POINT (0 1) > > proc.time() user system elapsed 1.00 0.23 1.17 ================================================ FILE: tests/crs.R ================================================ suppressPackageStartupMessages(library(sf)) options(rgdal_show_exportToProj4_warnings = "none") suppressWarnings(st_crs(-1)) suppressWarnings(st_crs(999999)) inherits(try(st_crs("error"), silent = TRUE), "try-error") str = "+proj=sterea +lat_0=52.15616055555555 +lon_0=5.38763888888889 +k=0.9999079 +x_0=155000 +y_0=463000 +ellps=bessel +towgs84=565.4171,50.3319,465.5524,-0.398957388243134,0.343987817378283,-1.87740163998045,4.0725 +units=m +no_defs" x <- st_crs(str) x<- st_crs(3857) str = st_crs(3857)$proj4string st_crs(3857)$units x = st_crs("+proj=longlat +datum=WGS84") x = st_crs(4326) x = st_crs("+proj=laea") # no EPSG x = st_sfc(st_point(0:1)) y = st_crs(x, parameters = TRUE) st_crs(x) = 4326 y = st_crs(x, parameters = TRUE) from = st_crs(4326)$proj4string to = st_crs(3857)$proj4string ret = sf_project(from, to, rbind(c(0,0), c(1,1))) round(ret, 7) # create Inf points: #1227/#1228 suppressWarnings( sf_project("+proj=longlat", "+proj=lcc +lat_1=30 +lat_2=60", cbind(c(0,0),c(-80,-90)), keep = TRUE) ) sf_project(to, from, ret) suppressWarnings( sf_project("+proj=longlat", "+proj=lcc +lat_1=30 +lat_2=60", cbind(c(0,0),c(-80,-90)), keep = TRUE) ) st_transform(st_sfc(st_point(c(0,0)), st_point(c(1,1)), crs = 4326), 3857) if (sf_extSoftVersion()["USE_PROJ_H"] == "true" || sf_proj_info("have_datum_files")) { "datum files installed" } else { "datum files not installed" } # https://github.com/r-spatial/sf/issues/1170 g = st_as_sfc("POLYGON ((-61.66957 10.69214, -61.565 10.75728, -61.37453 10.77654, -61.40721 10.60681, -61.66957 10.69214))") d = st_as_sf(data.frame(id=1, geometry=g), crs=4326) st_area(d) st_area(st_transform(d, 2314)) st_axis_order() if (compareVersion(sf_extSoftVersion()["GDAL"], "2.5.0") > -1) st_axis_order(TRUE) st_axis_order(FALSE) ================================================ FILE: tests/crs.Rout.save ================================================ R Under development (unstable) (2025-11-05 r88988 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > suppressPackageStartupMessages(library(sf)) > options(rgdal_show_exportToProj4_warnings = "none") > suppressWarnings(st_crs(-1)) Coordinate Reference System: NA > suppressWarnings(st_crs(999999)) Coordinate Reference System: NA > inherits(try(st_crs("error"), silent = TRUE), "try-error") [1] TRUE > str = "+proj=sterea +lat_0=52.15616055555555 +lon_0=5.38763888888889 +k=0.9999079 +x_0=155000 +y_0=463000 +ellps=bessel +towgs84=565.4171,50.3319,465.5524,-0.398957388243134,0.343987817378283,-1.87740163998045,4.0725 +units=m +no_defs" > x <- st_crs(str) > x<- st_crs(3857) > str = st_crs(3857)$proj4string > st_crs(3857)$units [1] "m" > x = st_crs("+proj=longlat +datum=WGS84") > x = st_crs(4326) > x = st_crs("+proj=laea") # no EPSG > > x = st_sfc(st_point(0:1)) > y = st_crs(x, parameters = TRUE) > st_crs(x) = 4326 > y = st_crs(x, parameters = TRUE) > > from = st_crs(4326)$proj4string > to = st_crs(3857)$proj4string > ret = sf_project(from, to, rbind(c(0,0), c(1,1))) > round(ret, 7) [,1] [,2] [1,] 0.0 0.0 [2,] 111319.5 111325.1 > # create Inf points: #1227/#1228 > suppressWarnings( + sf_project("+proj=longlat", "+proj=lcc +lat_1=30 +lat_2=60", cbind(c(0,0),c(-80,-90)), keep = TRUE) + ) [,1] [,2] [1,] 0 -53554590 [2,] NA NA > sf_project(to, from, ret) [,1] [,2] [1,] 0 0 [2,] 1 1 > suppressWarnings( + sf_project("+proj=longlat", "+proj=lcc +lat_1=30 +lat_2=60", cbind(c(0,0),c(-80,-90)), keep = TRUE) + ) [,1] [,2] [1,] 0 -53554590 [2,] NA NA > st_transform(st_sfc(st_point(c(0,0)), st_point(c(1,1)), crs = 4326), 3857) Geometry set for 2 features Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 111319.5 ymax: 111325.1 Projected CRS: WGS 84 / Pseudo-Mercator POINT (0 0) POINT (111319.5 111325.1) > if (sf_extSoftVersion()["USE_PROJ_H"] == "true" || sf_proj_info("have_datum_files")) { + "datum files installed" + } else { + "datum files not installed" + } [1] "datum files installed" > > # https://github.com/r-spatial/sf/issues/1170 > g = st_as_sfc("POLYGON ((-61.66957 10.69214, -61.565 10.75728, -61.37453 10.77654, -61.40721 10.60681, -61.66957 10.69214))") > d = st_as_sf(data.frame(id=1, geometry=g), crs=4326) > st_area(d) 350534486 [m^2] > st_area(st_transform(d, 2314)) 349124497 [m^2] > > st_axis_order() [1] FALSE > if (compareVersion(sf_extSoftVersion()["GDAL"], "2.5.0") > -1) + st_axis_order(TRUE) > st_axis_order(FALSE) > > proc.time() user system elapsed 0.51 0.20 0.70 ================================================ FILE: tests/dist.R ================================================ suppressPackageStartupMessages(library(sf)) suppressPackageStartupMessages(library(units)) x = st_sfc( st_point(c(0,0)), st_point(c(1,0)), st_point(c(2,0)), st_point(c(3,0)), crs = 4326 ) y = st_sfc( st_point(c(0,10)), st_point(c(1,0)), st_point(c(2,0)), st_point(c(3,0)), st_point(c(4,0)), crs = 4326 ) if (suppressPackageStartupMessages(require(sp, quietly = TRUE))) { d.sf = st_distance(x, y) d.sp = spDists(as(x, "Spatial"), as(y, "Spatial")) units(d.sp) = as_units("km") print(round(d.sf - d.sp, 7)) #summary(unclass(d.sf) - d.sp) st_crs(x) = st_crs(y) = NA d.sf = st_distance(x, y) d.sp = spDists(as(x, "Spatial"), as(y, "Spatial")) print(round(d.sf - d.sp, 7)) } # st_length: st_crs(y) = 4326 (z = st_sfc(st_linestring(rbind(c(0,10), c(1,0), c(2,0), c(3,0), c(4,0))), crs = 4326)) d = st_distance(y, y) round(d, 7) st_length(z) round(st_length(z) - sum(d[1,2], d[2,3], d[3,4], d[4,5]), 7) # st_line_sample: ls = st_sfc(st_linestring(rbind(c(0,0),c(0,1))), st_linestring(rbind(c(0,0),c(10,0)))) # set.seed(135) st_line_sample(ls, density = 1) ls = st_sfc(st_linestring(rbind(c(0,0),c(0,1))), st_linestring(rbind(c(0,0),c(.1,0))), crs = 4326) st_length(ls) try(st_line_sample(ls, density = 1/1000)) x = st_line_sample(st_transform(ls, 3857), density = 1/1000) # one per km ================================================ FILE: tests/dist.Rout.save ================================================ R Under development (unstable) (2025-11-05 r88988 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > suppressPackageStartupMessages(library(sf)) > suppressPackageStartupMessages(library(units)) > > x = st_sfc( + st_point(c(0,0)), + st_point(c(1,0)), + st_point(c(2,0)), + st_point(c(3,0)), + crs = 4326 + ) > > y = st_sfc( + st_point(c(0,10)), + st_point(c(1,0)), + st_point(c(2,0)), + st_point(c(3,0)), + st_point(c(4,0)), + crs = 4326 + ) > > if (suppressPackageStartupMessages(require(sp, quietly = TRUE))) { + d.sf = st_distance(x, y) + d.sp = spDists(as(x, "Spatial"), as(y, "Spatial")) + units(d.sp) = as_units("km") + print(round(d.sf - d.sp, 7)) + + #summary(unclass(d.sf) - d.sp) + + st_crs(x) = st_crs(y) = NA + d.sf = st_distance(x, y) + d.sp = spDists(as(x, "Spatial"), as(y, "Spatial")) + print(round(d.sf - d.sp, 7)) + } Units: [m] [,1] [,2] [,3] [,4] [,5] [1,] 6107.765 -124.3896 -248.7792 -373.1688 -497.5585 [2,] 6065.138 0.0000 -124.3896 -248.7792 -373.1688 [3,] 5940.569 -124.3896 0.0000 -124.3896 -248.7792 [4,] 5743.252 -248.7792 -124.3896 0.0000 -124.3896 [,1] [,2] [,3] [,4] [,5] [1,] 0 0 0 0 0 [2,] 0 0 0 0 0 [3,] 0 0 0 0 0 [4,] 0 0 0 0 0 > > # st_length: > st_crs(y) = 4326 > (z = st_sfc(st_linestring(rbind(c(0,10), c(1,0), c(2,0), c(3,0), c(4,0))), crs = 4326)) Geometry set for 1 feature Geometry type: LINESTRING Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 4 ymax: 10 Geodetic CRS: WGS 84 LINESTRING (0 10, 1 0, 2 0, 3 0, 4 0) > d = st_distance(y, y) > round(d, 7) Units: [m] [,1] [,2] [,3] [,4] [,5] [1,] 0 1117440.6 1133750.1 1160423.1 1196767.0 [2,] 1117441 0.0 111195.1 222390.2 333585.3 [3,] 1133750 111195.1 0.0 111195.1 222390.2 [4,] 1160423 222390.2 111195.1 0.0 111195.1 [5,] 1196767 333585.3 222390.2 111195.1 0.0 > st_length(z) 1451026 [m] > round(st_length(z) - sum(d[1,2], d[2,3], d[3,4], d[4,5]), 7) 0 [m] > > # st_line_sample: > ls = st_sfc(st_linestring(rbind(c(0,0),c(0,1))), + st_linestring(rbind(c(0,0),c(10,0)))) > # set.seed(135) > st_line_sample(ls, density = 1) Geometry set for 2 features Geometry type: MULTIPOINT Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 9.5 ymax: 0.5 CRS: NA MULTIPOINT ((0 0.5)) MULTIPOINT ((0.5 0), (1.5 0), (2.5 0), (3.5 0),... > > ls = st_sfc(st_linestring(rbind(c(0,0),c(0,1))), + st_linestring(rbind(c(0,0),c(.1,0))), crs = 4326) > > st_length(ls) Units: [m] [1] 111195.10 11119.51 > try(st_line_sample(ls, density = 1/1000)) Error in st_line_sample(ls, density = 1/1000) : st_line_sample for longitude/latitude not supported; use st_segmentize? > x = st_line_sample(st_transform(ls, 3857), density = 1/1000) # one per km > > proc.time() user system elapsed 0.65 0.20 0.79 ================================================ FILE: tests/dplyr.R ================================================ suppressPackageStartupMessages(library(sf)) if (require(dplyr, quietly = TRUE) && require(tidyr, quietly = TRUE)) { options(dplyr.summarise.inform=FALSE) read_sf(system.file("shape/nc.shp", package="sf"), quiet = TRUE) |> st_transform(3857) -> nc nc |> filter(AREA > .1) |> plot() # plot 10 smallest counties in grey: nc |> select(BIR74, geometry) |> plot() nc |> select(AREA, geometry) |> arrange(AREA) |> slice(1:10) |> plot(add = TRUE, col = 'grey', main ="") # select: check both when geometry is part of the selection, and when not: nc |> select(SID74, SID79) |> names() nc |> select(SID74, SID79, geometry) |> names() nc |> select(SID74, SID79) |> class() nc |> select(SID74, SID79, geometry) |> class() # group_by: nc$area_cl = cut(nc$AREA, c(0, .1, .12, .15, .25)) nc |> group_by(area_cl) |> class() # mutate: nc2 <- nc |> mutate(area10 = AREA/10) # transmute: nc |> transmute(AREA = AREA/10, geometry = geometry) |> class() nc |> transmute(AREA = AREA/10) |> class() # rename: nc2 <- nc |> rename(area = AREA) # distinct: nc[c(1:100,1:10),] |> distinct() |> nrow() # summarize: nc$area_cl = cut(nc$AREA, c(0, .1, .12, .15, .25)) nc.g <- nc |> group_by(area_cl) nc.g |> summarise(mean(AREA)) nc.g |> summarize(mean(AREA)) |> plot(col = 3:6/7) library(tidyr) # time-wide to long table, using tidyr::gather # stack the two SID columns for the July 1, 1974 - June 30, 1978 and July 1, 1979 - June 30, 1984 periods # (see https://cran.r-project.org/web/packages/spdep/vignettes/sids.pdf) nc |> select(SID74, SID79, geometry) |> gather("VAR", "SID", -geometry) |> summary() # spread: nc$row = 1:100 nc.g <- nc |> select(SID74, SID79, row) |> gather("VAR", "SID", -row, -geometry) nc.g |> tail() nc.g |> spread(VAR, SID) |> head() nc |> select(SID74, SID79, geometry, row) |> gather("VAR", "SID", -geometry, -row) |> spread(VAR, SID) |> head() # test st_set_crs in pipe: sfc = st_sfc(st_point(c(0,0)), st_point(c(1,1))) x <- sfc |> st_set_crs(4326) |> st_transform(3857) x read_sf(system.file("shape/nc.shp", package="sf"), quiet = TRUE) |> st_transform(3857) -> nc nc.merc <- st_transform(nc, 32119) # NC State Plane suppressPackageStartupMessages(library(units)) install_unit("person") person = as_units("person") nc.merc <- nc.merc |> mutate(area = st_area(nc.merc), dens = BIR74 * person / area) # summary(nc.merc$dens) # requires units 0.4-2 nc.merc$area_cl <- cut(nc$AREA, c(0, .1, .12, .15, .25)) nc.grp <- nc.merc |> group_by(area_cl) out <- nc.grp |> summarise(A = sum(area), pop = sum(dens * area), new_dens = sum(dens * area)/sum(area)) # mean densities depend on grouping: nc.merc |> summarize(mean(dens)) out |> summarise(mean(new_dens)) # total densities don't: nc.merc |> summarise(sum(area * dens)) out |> summarise(sum(A * new_dens)) conn = system.file("gpkg/nc.gpkg", package = "sf") if (require(DBI, quietly = TRUE) && require(RSQLite, quietly = TRUE)) { con = dbConnect(SQLite(), dbname = system.file("gpkg/nc.gpkg", package = "sf")) dbReadTable(con, "nc.gpkg") |> filter(AREA > 0.2) |> collect() |> st_sf() # nest: storms.sf = st_as_sf(storms, coords = c("long", "lat"), crs = 4326) x <- storms.sf |> group_by(name, year) |> nest() nrow(distinct(nc[c(1,1,1,2,2,3:100),])) # set.seed(1331) nc$gp <- sample(10, 100, replace=TRUE) # Get centroid of each group of polygons; https://github.com/r-spatial/sf/issues/969 nc_gp_cent <- nc |> group_by(gp) |> group_map(st_area) nc |> st_filter(nc[1,]) |> nrow() } # DBI & SQLITE } # dplyr & tidyr ================================================ FILE: tests/dplyr.Rout.save ================================================ R version 4.6.0 (2026-04-24) -- "Because it was There" Copyright (C) 2026 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > suppressPackageStartupMessages(library(sf)) > > if (require(dplyr, quietly = TRUE) && require(tidyr, quietly = TRUE)) { + options(dplyr.summarise.inform=FALSE) + read_sf(system.file("shape/nc.shp", package="sf"), quiet = TRUE) |> + st_transform(3857) -> nc + nc |> filter(AREA > .1) |> plot() + + # plot 10 smallest counties in grey: + nc |> + select(BIR74, geometry) |> + plot() + + nc |> + select(AREA, geometry) |> + arrange(AREA) |> + slice(1:10) |> + plot(add = TRUE, col = 'grey', main ="") + + # select: check both when geometry is part of the selection, and when not: + nc |> select(SID74, SID79) |> names() + nc |> select(SID74, SID79, geometry) |> names() + nc |> select(SID74, SID79) |> class() + nc |> select(SID74, SID79, geometry) |> class() + + # group_by: + nc$area_cl = cut(nc$AREA, c(0, .1, .12, .15, .25)) + nc |> group_by(area_cl) |> class() + + # mutate: + nc2 <- nc |> mutate(area10 = AREA/10) + + # transmute: + nc |> transmute(AREA = AREA/10, geometry = geometry) |> class() + nc |> transmute(AREA = AREA/10) |> class() + + # rename: + nc2 <- nc |> rename(area = AREA) + + # distinct: + nc[c(1:100,1:10),] |> distinct() |> nrow() + + # summarize: + nc$area_cl = cut(nc$AREA, c(0, .1, .12, .15, .25)) + nc.g <- nc |> group_by(area_cl) + nc.g |> summarise(mean(AREA)) + nc.g |> summarize(mean(AREA)) |> plot(col = 3:6/7) + + library(tidyr) + + # time-wide to long table, using tidyr::gather + # stack the two SID columns for the July 1, 1974 - June 30, 1978 and July 1, 1979 - June 30, 1984 periods + # (see https://cran.r-project.org/web/packages/spdep/vignettes/sids.pdf) + nc |> select(SID74, SID79, geometry) |> gather("VAR", "SID", -geometry) |> summary() + + # spread: + nc$row = 1:100 + nc.g <- nc |> select(SID74, SID79, row) |> gather("VAR", "SID", -row, -geometry) + nc.g |> tail() + nc.g |> spread(VAR, SID) |> head() + nc |> select(SID74, SID79, geometry, row) |> gather("VAR", "SID", -geometry, -row) |> spread(VAR, SID) |> head() + + # test st_set_crs in pipe: + sfc = st_sfc(st_point(c(0,0)), st_point(c(1,1))) + x <- sfc |> st_set_crs(4326) |> st_transform(3857) + x + + read_sf(system.file("shape/nc.shp", package="sf"), quiet = TRUE) |> + st_transform(3857) -> nc + nc.merc <- st_transform(nc, 32119) # NC State Plane + suppressPackageStartupMessages(library(units)) + install_unit("person") + person = as_units("person") + nc.merc <- nc.merc |> mutate(area = st_area(nc.merc), dens = BIR74 * person / area) + + # summary(nc.merc$dens) # requires units 0.4-2 + nc.merc$area_cl <- cut(nc$AREA, c(0, .1, .12, .15, .25)) + nc.grp <- nc.merc |> group_by(area_cl) + + out <- nc.grp |> summarise(A = sum(area), pop = sum(dens * area), + new_dens = sum(dens * area)/sum(area)) + + # mean densities depend on grouping: + nc.merc |> summarize(mean(dens)) + out |> summarise(mean(new_dens)) + + # total densities don't: + nc.merc |> summarise(sum(area * dens)) + out |> summarise(sum(A * new_dens)) + + conn = system.file("gpkg/nc.gpkg", package = "sf") + + if (require(DBI, quietly = TRUE) && require(RSQLite, quietly = TRUE)) { + con = dbConnect(SQLite(), dbname = system.file("gpkg/nc.gpkg", package = "sf")) + dbReadTable(con, "nc.gpkg") |> filter(AREA > 0.2) |> collect() |> st_sf() + + # nest: + storms.sf = st_as_sf(storms, coords = c("long", "lat"), crs = 4326) + x <- storms.sf |> group_by(name, year) |> nest() + + nrow(distinct(nc[c(1,1,1,2,2,3:100),])) + + # set.seed(1331) + nc$gp <- sample(10, 100, replace=TRUE) + # Get centroid of each group of polygons; https://github.com/r-spatial/sf/issues/969 + nc_gp_cent <- nc |> + group_by(gp) |> + group_map(st_area) + + nc |> st_filter(nc[1,]) |> nrow() + } # DBI & SQLITE + } # dplyr & tidyr Attaching package: 'dplyr' The following objects are masked from 'package:stats': filter, lag The following objects are masked from 'package:base': intersect, setdiff, setequal, union [1] 4 Warning message: plotting the first 10 out of 14 attributes; use max.plot = 14 to plot all > > proc.time() user system elapsed 1.692 1.299 1.596 ================================================ FILE: tests/empty.R ================================================ suppressPackageStartupMessages(library(sf)) # create empty geometries: st_point(rep(NA_real_,2)) st_point(rep(NA_real_,3), dim = "XYZ") st_point(rep(NA_real_,3), dim = "XYM") st_point(rep(NA_real_,4), dim = "XYZM") st_multipoint() st_multipoint(matrix(numeric(0), 0, 3), dim = "XYZ") st_multipoint(matrix(numeric(0), 0, 3), dim = "XYM") st_multipoint(matrix(numeric(0), 0, 4), dim = "XYZM") st_linestring(matrix(numeric(0), 0, 2), "XY") st_linestring(matrix(numeric(0), 0, 3), "XYZ") st_linestring(matrix(numeric(0), 0, 3), "XYM") st_linestring(matrix(numeric(0), 0, 4), "XYZM") st_multilinestring(list(), "XY") st_multilinestring(list(), "XYZ") st_multilinestring(list(), "XYM") st_multilinestring(list(), "XYZM") st_polygon(list(), "XY") st_polygon(list(), "XYZ") st_polygon(list(), "XYM") st_polygon(list(), "XYZM") st_multipolygon(list(), "XY") st_multipolygon(list(), "XYZ") st_multipolygon(list(), "XYM") st_multipolygon(list(), "XYZM") st_geometrycollection() st_geometrycollection(dim = "XYZ") st_geometrycollection(dim = "XYM") st_geometrycollection(dim = "XYZM") st_point(rep(NA_real_,2)) st_multipoint() st_linestring(matrix(numeric(0), 0, 2)) st_multilinestring(list(), "XY") st_polygon(list(), "XY") st_multipolygon(list(), "XY") st_geometrycollection(, "XY") (e1 = st_sfc( st_point(rep(NA_real_,2)), st_multipoint(), st_linestring(matrix(numeric(0), 0, 2)), st_multilinestring(list(), "XY"), st_polygon(list(), "XY"), st_multipolygon(list(), "XY"), st_geometrycollection(, "XY"))) (e2 = st_sfc(st_point(rep(NA_real_,3), "XYZ"), st_multipoint(matrix(numeric(0),0,3), dim = "XYZ"), st_linestring(matrix(numeric(0), 0, 3)), st_multilinestring(list(), "XYZ"), st_polygon(list(), "XYZ"), st_multipolygon(list(), "XYZ"), st_geometrycollection(dim = "XYZ"))) (e3 = st_sfc(st_point(rep(NA_real_,3), "XYM"), st_multipoint(matrix(numeric(0),0,3), dim = "XYM"), st_linestring(matrix(numeric(0), 0, 3), "XYM"), st_multilinestring(list(), "XYM"), st_polygon(list(), "XYM"), st_multipolygon(list(), "XYM"), st_geometrycollection(dim = "XYM"))) (e4 = st_sfc(st_point(rep(NA_real_,4)), st_multipoint(matrix(numeric(0),0,4), dim = "XYZM"), st_linestring(matrix(numeric(0), 0, 4)), st_multilinestring(list(), "XYZM"), st_polygon(list(), "XYZM"), st_multipolygon(list(), "XYZM"), st_geometrycollection(dim = "XYZM"))) st_as_sfc(st_as_binary(e1, pureR = TRUE)) st_as_sfc(st_as_binary(e1, pureR = FALSE)) st_as_sfc(st_as_binary(e2, pureR = FALSE)) st_as_sfc(st_as_binary(e3, pureR = FALSE)) st_as_sfc(st_as_binary(e4, pureR = FALSE)) st_as_sfc(st_as_binary(e1, pureR = FALSE)) # sfc_GEOMETRY: x = st_sfc(st_point(0:1), st_linestring(matrix(1:4,2,2))) st_intersects(x, x, sparse = FALSE) # two empty geoms: x = st_sfc(st_multipoint(), st_linestring()) st_intersects(x, x, sparse = FALSE) # write & read: x = st_sf(a = 2:1, geom = structure(st_sfc(st_linestring(), st_linestring(matrix(1:4,2))))) write_sf(x, "empty.gpkg") y = st_read("empty.gpkg", quiet = TRUE) all.equal(x, y) # https://github.com/edzer/sfr/issues/398 : pt = st_sfc(st_point(c(0,92)), crs = 4267) robin_crs <- "+proj=robin +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs" # india_crs <- "EPSG:24383" # India-centered Lambert conformal conic projection india_crs <- "+proj=lcc +lat_1=12 +lat_0=12 +lon_0=80 +k_0=0.99878641 +x_0=2743195.5 +y_0=914398.5 +a=6377299.151 +b=6356098.145120132 +towgs84=295,736,257,0,0,0,0 +units=m +no_defs" st_transform(st_transform(pt, robin_crs), india_crs)[[1]] ================================================ FILE: tests/empty.Rout.save ================================================ R Under development (unstable) (2025-11-05 r88988 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > suppressPackageStartupMessages(library(sf)) > > # create empty geometries: > st_point(rep(NA_real_,2)) POINT EMPTY > st_point(rep(NA_real_,3), dim = "XYZ") POINT Z EMPTY > st_point(rep(NA_real_,3), dim = "XYM") POINT M EMPTY > st_point(rep(NA_real_,4), dim = "XYZM") POINT ZM EMPTY > > st_multipoint() MULTIPOINT EMPTY > st_multipoint(matrix(numeric(0), 0, 3), dim = "XYZ") MULTIPOINT Z EMPTY > st_multipoint(matrix(numeric(0), 0, 3), dim = "XYM") MULTIPOINT M EMPTY > st_multipoint(matrix(numeric(0), 0, 4), dim = "XYZM") MULTIPOINT ZM EMPTY > > st_linestring(matrix(numeric(0), 0, 2), "XY") LINESTRING EMPTY > st_linestring(matrix(numeric(0), 0, 3), "XYZ") LINESTRING Z EMPTY > st_linestring(matrix(numeric(0), 0, 3), "XYM") LINESTRING M EMPTY > st_linestring(matrix(numeric(0), 0, 4), "XYZM") LINESTRING ZM EMPTY > > st_multilinestring(list(), "XY") MULTILINESTRING EMPTY > st_multilinestring(list(), "XYZ") MULTILINESTRING Z EMPTY > st_multilinestring(list(), "XYM") MULTILINESTRING M EMPTY > st_multilinestring(list(), "XYZM") MULTILINESTRING ZM EMPTY > > st_polygon(list(), "XY") POLYGON EMPTY > st_polygon(list(), "XYZ") POLYGON Z EMPTY > st_polygon(list(), "XYM") POLYGON M EMPTY > st_polygon(list(), "XYZM") POLYGON ZM EMPTY > > st_multipolygon(list(), "XY") MULTIPOLYGON EMPTY > st_multipolygon(list(), "XYZ") MULTIPOLYGON Z EMPTY > st_multipolygon(list(), "XYM") MULTIPOLYGON M EMPTY > st_multipolygon(list(), "XYZM") MULTIPOLYGON ZM EMPTY > > st_geometrycollection() GEOMETRYCOLLECTION EMPTY > st_geometrycollection(dim = "XYZ") GEOMETRYCOLLECTION Z EMPTY > st_geometrycollection(dim = "XYM") GEOMETRYCOLLECTION M EMPTY > st_geometrycollection(dim = "XYZM") GEOMETRYCOLLECTION ZM EMPTY > > st_point(rep(NA_real_,2)) POINT EMPTY > st_multipoint() MULTIPOINT EMPTY > st_linestring(matrix(numeric(0), 0, 2)) LINESTRING EMPTY > st_multilinestring(list(), "XY") MULTILINESTRING EMPTY > st_polygon(list(), "XY") POLYGON EMPTY > st_multipolygon(list(), "XY") MULTIPOLYGON EMPTY > st_geometrycollection(, "XY") GEOMETRYCOLLECTION EMPTY > > (e1 = st_sfc( + st_point(rep(NA_real_,2)), + st_multipoint(), + st_linestring(matrix(numeric(0), 0, 2)), + st_multilinestring(list(), "XY"), + st_polygon(list(), "XY"), + st_multipolygon(list(), "XY"), + st_geometrycollection(, "XY"))) Geometry set for 7 features (with 7 geometries empty) Geometry type: GEOMETRY Dimension: XY Bounding box: xmin: NA ymin: NA xmax: NA ymax: NA CRS: NA First 5 geometries: POINT EMPTY MULTIPOINT EMPTY LINESTRING EMPTY MULTILINESTRING EMPTY POLYGON EMPTY > > (e2 = st_sfc(st_point(rep(NA_real_,3), "XYZ"), + st_multipoint(matrix(numeric(0),0,3), dim = "XYZ"), + st_linestring(matrix(numeric(0), 0, 3)), + st_multilinestring(list(), "XYZ"), + st_polygon(list(), "XYZ"), + st_multipolygon(list(), "XYZ"), + st_geometrycollection(dim = "XYZ"))) Geometry set for 7 features (with 7 geometries empty) Geometry type: GEOMETRY Dimension: XYZ Bounding box: xmin: NA ymin: NA xmax: NA ymax: NA z_range: zmin: NA zmax: NA CRS: NA First 5 geometries: POINT Z EMPTY MULTIPOINT Z EMPTY LINESTRING Z EMPTY MULTILINESTRING Z EMPTY POLYGON Z EMPTY > > (e3 = st_sfc(st_point(rep(NA_real_,3), "XYM"), + st_multipoint(matrix(numeric(0),0,3), dim = "XYM"), + st_linestring(matrix(numeric(0), 0, 3), "XYM"), + st_multilinestring(list(), "XYM"), + st_polygon(list(), "XYM"), + st_multipolygon(list(), "XYM"), + st_geometrycollection(dim = "XYM"))) Geometry set for 7 features (with 7 geometries empty) Geometry type: GEOMETRY Dimension: XYM Bounding box: xmin: NA ymin: NA xmax: NA ymax: NA m_range: mmin: NA mmax: NA CRS: NA First 5 geometries: POINT M EMPTY MULTIPOINT M EMPTY LINESTRING M EMPTY MULTILINESTRING M EMPTY POLYGON M EMPTY > > (e4 = st_sfc(st_point(rep(NA_real_,4)), + st_multipoint(matrix(numeric(0),0,4), dim = "XYZM"), + st_linestring(matrix(numeric(0), 0, 4)), + st_multilinestring(list(), "XYZM"), + st_polygon(list(), "XYZM"), + st_multipolygon(list(), "XYZM"), + st_geometrycollection(dim = "XYZM"))) Geometry set for 7 features (with 7 geometries empty) Geometry type: GEOMETRY Dimension: XYZM Bounding box: xmin: NA ymin: NA xmax: NA ymax: NA z_range: zmin: NA zmax: NA m_range: mmin: NA mmax: NA CRS: NA First 5 geometries: POINT ZM EMPTY MULTIPOINT ZM EMPTY LINESTRING ZM EMPTY MULTILINESTRING ZM EMPTY POLYGON ZM EMPTY > > st_as_sfc(st_as_binary(e1, pureR = TRUE)) Geometry set for 7 features (with 7 geometries empty) Geometry type: GEOMETRY Dimension: XY Bounding box: xmin: NA ymin: NA xmax: NA ymax: NA CRS: NA First 5 geometries: POINT EMPTY MULTIPOINT EMPTY LINESTRING EMPTY MULTILINESTRING EMPTY POLYGON EMPTY > st_as_sfc(st_as_binary(e1, pureR = FALSE)) Geometry set for 7 features (with 7 geometries empty) Geometry type: GEOMETRY Dimension: XY Bounding box: xmin: NA ymin: NA xmax: NA ymax: NA CRS: NA First 5 geometries: POINT EMPTY MULTIPOINT EMPTY LINESTRING EMPTY MULTILINESTRING EMPTY POLYGON EMPTY > st_as_sfc(st_as_binary(e2, pureR = FALSE)) Geometry set for 7 features (with 7 geometries empty) Geometry type: GEOMETRY Dimension: XYZ Bounding box: xmin: NA ymin: NA xmax: NA ymax: NA z_range: zmin: NA zmax: NA CRS: NA First 5 geometries: POINT Z EMPTY MULTIPOINT Z EMPTY LINESTRING Z EMPTY MULTILINESTRING Z EMPTY POLYGON Z EMPTY > st_as_sfc(st_as_binary(e3, pureR = FALSE)) Geometry set for 7 features (with 7 geometries empty) Geometry type: GEOMETRY Dimension: XYM Bounding box: xmin: NA ymin: NA xmax: NA ymax: NA m_range: mmin: NA mmax: NA CRS: NA First 5 geometries: POINT M EMPTY MULTIPOINT M EMPTY LINESTRING M EMPTY MULTILINESTRING M EMPTY POLYGON M EMPTY > st_as_sfc(st_as_binary(e4, pureR = FALSE)) Geometry set for 7 features (with 7 geometries empty) Geometry type: GEOMETRY Dimension: XYZM Bounding box: xmin: NA ymin: NA xmax: NA ymax: NA z_range: zmin: NA zmax: NA m_range: mmin: NA mmax: NA CRS: NA First 5 geometries: POINT ZM EMPTY MULTIPOINT ZM EMPTY LINESTRING ZM EMPTY MULTILINESTRING ZM EMPTY POLYGON ZM EMPTY > st_as_sfc(st_as_binary(e1, pureR = FALSE)) Geometry set for 7 features (with 7 geometries empty) Geometry type: GEOMETRY Dimension: XY Bounding box: xmin: NA ymin: NA xmax: NA ymax: NA CRS: NA First 5 geometries: POINT EMPTY MULTIPOINT EMPTY LINESTRING EMPTY MULTILINESTRING EMPTY POLYGON EMPTY > > # sfc_GEOMETRY: > x = st_sfc(st_point(0:1), st_linestring(matrix(1:4,2,2))) > st_intersects(x, x, sparse = FALSE) [,1] [,2] [1,] TRUE FALSE [2,] FALSE TRUE > > # two empty geoms: > x = st_sfc(st_multipoint(), st_linestring()) > st_intersects(x, x, sparse = FALSE) [,1] [,2] [1,] FALSE FALSE [2,] FALSE FALSE > > # write & read: > x = st_sf(a = 2:1, geom = structure(st_sfc(st_linestring(), st_linestring(matrix(1:4,2))))) > write_sf(x, "empty.gpkg") writing: substituting ENGCRS["Undefined Cartesian SRS with unknown unit"] for missing CRS > y = st_read("empty.gpkg", quiet = TRUE) > all.equal(x, y) [1] "Component \"geom\": Attributes: < Component \"crs\": Component \"input\": 'is.NA' value mismatch: 0 in current 1 in target >" [2] "Component \"geom\": Attributes: < Component \"crs\": Component \"wkt\": 'is.NA' value mismatch: 0 in current 1 in target >" > > # https://github.com/edzer/sfr/issues/398 : > pt = st_sfc(st_point(c(0,92)), crs = 4267) > robin_crs <- "+proj=robin +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs" > # india_crs <- "EPSG:24383" # India-centered Lambert conformal conic projection > india_crs <- "+proj=lcc +lat_1=12 +lat_0=12 +lon_0=80 +k_0=0.99878641 +x_0=2743195.5 +y_0=914398.5 +a=6377299.151 +b=6356098.145120132 +towgs84=295,736,257,0,0,0,0 +units=m +no_defs" > st_transform(st_transform(pt, robin_crs), india_crs)[[1]] POINT EMPTY > > proc.time() user system elapsed 0.54 0.23 0.71 ================================================ FILE: tests/full.R ================================================ suppressPackageStartupMessages(library(sf)) # create full polygon: (f = st_as_sfc("POLYGON FULL")) g = st_sfc(st_polygon(list(matrix(c(0,-90,0,-90), 2, byrow = TRUE)))) identical(f, g) old = sf_use_s2(FALSE) try(st_as_sfc("POLYGON FULL")) # errors sf_use_s2(old) (f = st_as_sfc(c("POLYGON FULL", "POLYGON((0 0,1 0,1 1,0 1,0 0))"))) st_is_full(f) st_bbox(f[1]) st_bbox(f[2]) st_is_valid(f) # full polygon NA: right, we don't know the CRS st_crs(f) = 'OGC:CRS84' # geodetic: st_is_valid(f) try(st_set_crs(f, NA)) # errors st_crs(f) = 'OGC:CRS84' # geodetic: st_make_valid(f) # mixed geometries: (f = st_as_sfc(c("POLYGON FULL", "POLYGON((0 0,1 0,1 1,0 1,0 0))", "POINT(3 1)"), crs = 'OGC:CRS84')) st_bbox(f[1]) st_bbox(f[3]) st_is_valid(f) st_make_valid(f) st_make_valid(f[2:3]) # roundtrip: sf = st_as_sf(data.frame(attr = 1:3, geom = f[1:3])) write_sf(sf, fn <- tempfile(fileext=".gpkg")) g = read_sf(fn) g st_is_empty(g) st_is_full(g) st_is_valid(g) st_is_simple(g) st_dimension(g) st_area(g) st_length(g) st_distance(g) ================================================ FILE: tests/full.Rout.save ================================================ R Under development (unstable) (2025-11-05 r88988 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > suppressPackageStartupMessages(library(sf)) > > # create full polygon: > (f = st_as_sfc("POLYGON FULL")) Geometry set for 1 feature Geometry type: POLYGON Dimension: XY Bounding box: xmin: -180 ymin: -90 xmax: 180 ymax: 90 CRS: NA POLYGON FULL > g = st_sfc(st_polygon(list(matrix(c(0,-90,0,-90), 2, byrow = TRUE)))) > identical(f, g) [1] TRUE > old = sf_use_s2(FALSE) Spherical geometry (s2) switched off > try(st_as_sfc("POLYGON FULL")) # errors OGR: Corrupt data Error : OGR error > sf_use_s2(old) Spherical geometry (s2) switched on > (f = st_as_sfc(c("POLYGON FULL", "POLYGON((0 0,1 0,1 1,0 1,0 0))"))) Geometry set for 2 features Geometry type: POLYGON Dimension: XY Bounding box: xmin: -180 ymin: -90 xmax: 180 ymax: 90 CRS: NA POLYGON FULL POLYGON ((0 0, 1 0, 1 1, 0 1, 0 0)) > st_is_full(f) [1] TRUE FALSE > st_bbox(f[1]) xmin ymin xmax ymax -180 -90 180 90 > st_bbox(f[2]) xmin ymin xmax ymax 0 0 1 1 > st_is_valid(f) # full polygon NA: right, we don't know the CRS [1] NA TRUE > st_crs(f) = 'OGC:CRS84' # geodetic: > st_is_valid(f) [1] TRUE TRUE > try(st_set_crs(f, NA)) # errors Error in `st_crs<-.sfc`(`*tmp*`, value = value) : To set the crs to NA, first remove the full polygons; see: st_is_full() > st_crs(f) = 'OGC:CRS84' # geodetic: > st_make_valid(f) Geometry set for 2 features Geometry type: POLYGON Dimension: XY Bounding box: xmin: -180 ymin: -90 xmax: 180 ymax: 90 Geodetic CRS: WGS 84 (CRS84) POLYGON FULL POLYGON ((0 0, 1 0, 1 1, 0 1, 0 0)) > # mixed geometries: > (f = st_as_sfc(c("POLYGON FULL", "POLYGON((0 0,1 0,1 1,0 1,0 0))", "POINT(3 1)"), crs = 'OGC:CRS84')) Geometry set for 3 features Geometry type: GEOMETRY Dimension: XY Bounding box: xmin: -180 ymin: -90 xmax: 180 ymax: 90 Geodetic CRS: WGS 84 (CRS84) POLYGON FULL POLYGON ((0 0, 1 0, 1 1, 0 1, 0 0)) POINT (3 1) > st_bbox(f[1]) xmin ymin xmax ymax -180 -90 180 90 > st_bbox(f[3]) xmin ymin xmax ymax 3 1 3 1 > st_is_valid(f) [1] TRUE TRUE TRUE > st_make_valid(f) Geometry set for 3 features Geometry type: GEOMETRY Dimension: XY Bounding box: xmin: -180 ymin: -90 xmax: 180 ymax: 90 Geodetic CRS: WGS 84 (CRS84) POLYGON FULL POLYGON ((0 0, 1 0, 1 1, 0 1, 0 0)) POINT (3 1) > st_make_valid(f[2:3]) Geometry set for 2 features Geometry type: GEOMETRY Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 3 ymax: 1 Geodetic CRS: WGS 84 (CRS84) POLYGON ((0 0, 1 0, 1 1, 0 1, 0 0)) POINT (3 1) > > # roundtrip: > sf = st_as_sf(data.frame(attr = 1:3, geom = f[1:3])) > write_sf(sf, fn <- tempfile(fileext=".gpkg")) > g = read_sf(fn) > g Simple feature collection with 3 features and 1 field Geometry type: GEOMETRY Dimension: XY Bounding box: xmin: -180 ymin: -90 xmax: 180 ymax: 90 Geodetic CRS: WGS 84 (CRS84) # A tibble: 3 × 2 attr geom 1 1 POLYGON FULL 2 2 POLYGON ((0 0, 1 0, 1 1, 0 1, 0 0)) 3 3 POINT (3 1) > > st_is_empty(g) [1] FALSE FALSE FALSE > st_is_full(g) [1] TRUE FALSE FALSE > st_is_valid(g) [1] TRUE TRUE TRUE > st_is_simple(g) [1] TRUE TRUE TRUE > st_dimension(g) [1] 2 2 0 > st_area(g) Units: [m^2] [1] 5.100661e+14 1.236404e+10 0.000000e+00 > st_length(g) Units: [m] [1] 0 0 0 > st_distance(g) Units: [m] [,1] [,2] [,3] [1,] 0 0.0 0.0 [2,] 0 0.0 222356.3 [3,] 0 222356.3 0.0 > > proc.time() user system elapsed 0.90 0.18 1.00 ================================================ FILE: tests/gdal_geom.R ================================================ suppressPackageStartupMessages(library(sf)) nc = st_read(system.file("shape/nc.shp", package="sf"), "nc", crs = 4267, agr = c(AREA = "aggregate", PERIMETER = "aggregate", CNTY_ = "identity", CNTY_ID = "identity", NAME = "identity", FIPS = "identity", FIPSNO = "identity", CRESS_ID = "identity", BIR74 = "aggregate", SID74 = "aggregate", NWBIR74 = "aggregate", BIR79 = "aggregate", SID79 = "aggregate", NWBIR79 = "aggregate"), quiet = TRUE) st_is_valid(nc) st_is_simple(nc) nc_tr = st_transform(nc, 3857) x = st_buffer(nc_tr, 1000) x = st_boundary(nc) x = st_convex_hull(nc) x = st_simplify(nc_tr, dTolerance = 1e4) x = st_simplify(nc_tr, dTolerance = rep(1e4, nrow(nc_tr))) x = st_simplify(nc_tr, preserveTopology = TRUE) if (sf:::CPL_geos_version() >= "3.4.0") x = st_triangulate(nc_tr) mls = st_multilinestring(list(matrix(c(0,0,0,1,1,1,0,0),,2,byrow=TRUE))) x = st_polygonize(mls) x = st_segmentize(nc_tr, 5e4) try(x <- st_segmentize(nc_tr, -0.1)) x = st_centroid(nc_tr) x = st_point_on_surface(nc_tr) a = nc[1:5,] b = nc[4:10,] x <- st_intersection(a[1,] ,b) u = st_union(b) x <- st_intersection(st_geometry(a), st_geometry(u)) x = st_union(a[1,], b) x = st_union(a, st_union(b)) x = st_difference(a[1,], b) x = st_difference(a, st_union(b)) x = st_sym_difference(a[1,], b) x = st_sym_difference(a, st_union(b)) x = st_drivers() #cat(paste("GDAL has", nrow(x), "drivers\n")) # GEOS ops: st_relate(a, b) st_disjoint(a, b) st_touches(a, b) st_crosses(a, b) st_within(a, b) st_contains(a, b) st_overlaps(a, b) st_equals(a, b) st_covers(a, b) st_covered_by(a, b) st_equals_exact(a, b, 0.01) # st_is_within_distance(a, b, 2) st_geometry_type(st_sfc(st_point(1:2), st_linestring(matrix(1:4,2,2)))) st_geometry_type(st_sfc(st_point(1:2), st_linestring(matrix(1:4,2,2))), by_geometry = FALSE) st_zm(list(st_point(1:3), st_linestring(matrix(1:6,2,3)))) st_zm(list(st_point(1:2), st_linestring(matrix(1:6,3,2))), add = TRUE, "Z") st_transform(st_sfc(st_point(c(0,0)), crs=4326), st_crs("+proj=geocent"))[[1]] cbind(st_area(nc_tr[1:5,]), a$AREA) st_area(st_polygon(list(rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0))))) st_length(st_linestring(rbind(c(0,0),c(0,1)))) st_length(st_multilinestring(list(rbind(c(0,0),c(0,1))))) try(st_length(st_polygon(list(rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0)))))) st_area(st_multilinestring(list(rbind(c(0,0),c(0,1))))) # adds the (0.5 0.5) node: st_union(st_multilinestring(list(rbind(c(0,0),c(1,1)), rbind(c(0,1), c(1,0))))) p1 = st_point(c(7,52)) p2 = st_point(c(-30,20)) sfc = st_sfc(p1, p2) try(st_buffer(sfc, units::set_units(1000, km))) # error: no crs sfc = st_sfc(p1, p2, crs = 4326) try(zzz <- st_buffer(sfc, units::set_units(1000, km))) # error: wrong units if (version$os == "linux-gnu") { # FIXME: why does this break on windows - degree symbol? x = st_buffer(sfc, units::set_units(0.1, rad)) # OK: will convert to arc_degrees } x = st_transform(sfc, 3857) x = st_buffer(x, units::set_units(1000, km)) # success cr = st_as_sfc("CIRCULARSTRING(0 0,1 0,1 1)") cr1 = st_sf(a = 1, geometry = cr) plot(cr) st_as_grob(cr[[1]]) x = st_as_sfc("MULTISURFACE(CURVEPOLYGON(COMPOUNDCURVE(LINESTRING(-159.399779123 22.226016471, -159.399699153 22.226276431, -159.398736217 22.226118372, -159.398260872 22.226095318, -159.398140792 22.2260564590001, -159.398163058 22.2257268010001, -159.397882642 22.225394244, -159.397397157 22.225057335, -159.397318825 22.2251780230001, -159.396993115 22.225177984, -159.396748242 22.2248808800001, -159.396901679 22.224770398, -159.396876329 22.224673093, -159.399167008 22.224731392, -159.399502204 22.225551382), CIRCULARSTRING(-159.399502204 22.225551382, -159.399622762077 22.2257930044972, -159.399779123 22.226016471))))") mp <- x[[1]] |> st_cast("MULTIPOLYGON") x = st_as_sfc("COMPOUNDCURVE(CIRCULARSTRING(0 0, 1 1, 1 0),(1 0, 0 1))") ls <- x[[1]] |> st_cast() class(ls) is.na(st_bbox(ls)) mp = st_combine(st_buffer(st_sfc(lapply(1:3, function(x) st_point(c(x,x)))), 0.2 * 1:3)) plot(st_centroid(mp), add = TRUE, col = 'red') # centroid of combined geometry plot(st_centroid(mp, of_largest_polygon = TRUE), add = TRUE, col = 'blue', pch = 3) # center of largest sub-polygon x = st_sfc(st_polygon(list(rbind(c(0,0),c(0.5,0),c(0.5,0.5),c(0.5,0),c(1,0),c(1,1),c(0,1),c(0,0))))) suppressWarnings(st_is_valid(x)) y = st_make_valid(x) y = st_make_valid(x[[1]]) y = st_make_valid(st_sf(a = 1, geom = x)) st_is_valid(y) ================================================ FILE: tests/gdal_geom.Rout.save ================================================ R version 4.5.2 (2025-10-31) -- "[Not] Part in a Rumble" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > suppressPackageStartupMessages(library(sf)) > > nc = st_read(system.file("shape/nc.shp", package="sf"), "nc", crs = 4267, + agr = c(AREA = "aggregate", PERIMETER = "aggregate", CNTY_ = "identity", + CNTY_ID = "identity", NAME = "identity", FIPS = "identity", FIPSNO = "identity", + CRESS_ID = "identity", BIR74 = "aggregate", SID74 = "aggregate", NWBIR74 = "aggregate", + BIR79 = "aggregate", SID79 = "aggregate", NWBIR79 = "aggregate"), quiet = TRUE) > > st_is_valid(nc) [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE [16] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE [31] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE [46] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE [61] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE [76] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE [91] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > > st_is_simple(nc) [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE [16] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE [31] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE [46] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE [61] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE [76] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE [91] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > > nc_tr = st_transform(nc, 3857) > > x = st_buffer(nc_tr, 1000) > > x = st_boundary(nc) > > x = st_convex_hull(nc) > > x = st_simplify(nc_tr, dTolerance = 1e4) > > x = st_simplify(nc_tr, dTolerance = rep(1e4, nrow(nc_tr))) > > x = st_simplify(nc_tr, preserveTopology = TRUE) > > if (sf:::CPL_geos_version() >= "3.4.0") + x = st_triangulate(nc_tr) > > mls = st_multilinestring(list(matrix(c(0,0,0,1,1,1,0,0),,2,byrow=TRUE))) > x = st_polygonize(mls) > > x = st_segmentize(nc_tr, 5e4) > > try(x <- st_segmentize(nc_tr, -0.1)) Error : argument dfMaxLength should be positive > > x = st_centroid(nc_tr) Warning message: st_centroid assumes attributes are constant over geometries > x = st_point_on_surface(nc_tr) Warning message: st_point_on_surface assumes attributes are constant over geometries > > a = nc[1:5,] > b = nc[4:10,] > > x <- st_intersection(a[1,] ,b) Warning message: attribute variables are assumed to be spatially constant throughout all geometries > > u = st_union(b) > > x <- st_intersection(st_geometry(a), st_geometry(u)) > > x = st_union(a[1,], b) Warning message: attribute variables are assumed to be spatially constant throughout all geometries > > x = st_union(a, st_union(b)) Warning message: attribute variables are assumed to be spatially constant throughout all geometries > > x = st_difference(a[1,], b) Warning message: attribute variables are assumed to be spatially constant throughout all geometries > > x = st_difference(a, st_union(b)) Warning message: attribute variables are assumed to be spatially constant throughout all geometries > > x = st_sym_difference(a[1,], b) Warning message: attribute variables are assumed to be spatially constant throughout all geometries > > x = st_sym_difference(a, st_union(b)) Warning message: attribute variables are assumed to be spatially constant throughout all geometries > > x = st_drivers() > #cat(paste("GDAL has", nrow(x), "drivers\n")) > > # GEOS ops: > > st_relate(a, b) although coordinates are longitude/latitude, st_relate assumes that they are planar [,1] [,2] [,3] [,4] [,5] [,6] [1,] "FF2FF1212" "FF2FF1212" "FF2FF1212" "FF2FF1212" "FF2FF1212" "FF2FF1212" [2,] "FF2FF1212" "FF2FF1212" "FF2FF1212" "FF2FF1212" "FF2FF1212" "FF2FF1212" [3,] "FF2FF1212" "FF2FF1212" "FF2FF1212" "FF2FF1212" "FF2FF1212" "FF2FF1212" [4,] "2FFF1FFF2" "FF2FF1212" "FF2FF1212" "FF2F11212" "FF2FF1212" "FF2FF1212" [5,] "FF2FF1212" "2FFF1FFF2" "FF2F11212" "FF2FF1212" "FF2FF1212" "FF2F11212" [,7] [1,] "FF2FF1212" [2,] "FF2FF1212" [3,] "FF2F11212" [4,] "FF2FF1212" [5,] "FF2FF1212" > > st_disjoint(a, b) Sparse geometry binary predicate list of length 5, where the predicate was `disjoint' 1: 1, 2, 3, 4, 5, 6, 7 2: 1, 2, 3, 4, 5, 6, 7 3: 1, 2, 3, 4, 5, 6 4: 2, 3, 5, 6, 7 5: 1, 4, 5, 7 > > st_touches(a, b) Sparse geometry binary predicate list of length 5, where the predicate was `touches' 1: (empty) 2: (empty) 3: 7 4: 4 5: 3, 6 > > st_crosses(a, b) although coordinates are longitude/latitude, st_crosses assumes that they are planar Sparse geometry binary predicate list of length 5, where the predicate was `crosses' 1: (empty) 2: (empty) 3: (empty) 4: (empty) 5: (empty) > > st_within(a, b) Sparse geometry binary predicate list of length 5, where the predicate was `within' 1: (empty) 2: (empty) 3: (empty) 4: 1 5: 2 > > st_contains(a, b) Sparse geometry binary predicate list of length 5, where the predicate was `contains' 1: (empty) 2: (empty) 3: (empty) 4: 1 5: 2 > > st_overlaps(a, b) although coordinates are longitude/latitude, st_overlaps assumes that they are planar Sparse geometry binary predicate list of length 5, where the predicate was `overlaps' 1: (empty) 2: (empty) 3: (empty) 4: (empty) 5: (empty) > > st_equals(a, b) Sparse geometry binary predicate list of length 5, where the predicate was `equals' 1: (empty) 2: (empty) 3: (empty) 4: 1 5: 2 > > st_covers(a, b) Sparse geometry binary predicate list of length 5, where the predicate was `covers' 1: (empty) 2: (empty) 3: (empty) 4: 1 5: 2 > > st_covered_by(a, b) Sparse geometry binary predicate list of length 5, where the predicate was `covered_by' 1: (empty) 2: (empty) 3: (empty) 4: 1 5: 2 > > st_equals_exact(a, b, 0.01) Sparse geometry binary predicate list of length 5, where the predicate was `equals_exact' 1: (empty) 2: (empty) 3: (empty) 4: 1 5: 2 > > # st_is_within_distance(a, b, 2) > > st_geometry_type(st_sfc(st_point(1:2), st_linestring(matrix(1:4,2,2)))) [1] POINT LINESTRING 18 Levels: GEOMETRY POINT LINESTRING POLYGON MULTIPOINT ... TRIANGLE > > st_geometry_type(st_sfc(st_point(1:2), st_linestring(matrix(1:4,2,2))), by_geometry = FALSE) [1] GEOMETRY 18 Levels: GEOMETRY POINT LINESTRING POLYGON MULTIPOINT ... TRIANGLE > > st_zm(list(st_point(1:3), st_linestring(matrix(1:6,2,3)))) [[1]] POINT (1 2) [[2]] LINESTRING (1 3, 2 4) > > st_zm(list(st_point(1:2), st_linestring(matrix(1:6,3,2))), add = TRUE, "Z") [[1]] POINT (1 2) [[2]] LINESTRING (1 4, 2 5, 3 6) > > st_transform(st_sfc(st_point(c(0,0)), crs=4326), st_crs("+proj=geocent"))[[1]] POINT Z (6378137 0 0) > > cbind(st_area(nc_tr[1:5,]), a$AREA) Units: [m^2] [,1] [,2] [1,] 1760230516 0.114 [2,] 946417787 0.061 [3,] 2202223078 0.143 [4,] 1074332698 0.070 [5,] 2352528086 0.153 > > st_area(st_polygon(list(rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0))))) [1] 1 > > st_length(st_linestring(rbind(c(0,0),c(0,1)))) [1] 1 > > st_length(st_multilinestring(list(rbind(c(0,0),c(0,1))))) [1] 1 > > try(st_length(st_polygon(list(rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0)))))) [1] 0 > > st_area(st_multilinestring(list(rbind(c(0,0),c(0,1))))) [1] 0 > > # adds the (0.5 0.5) node: > st_union(st_multilinestring(list(rbind(c(0,0),c(1,1)), rbind(c(0,1), c(1,0))))) MULTILINESTRING ((0 0, 1 1), (0 1, 1 0)) > > p1 = st_point(c(7,52)) > p2 = st_point(c(-30,20)) > sfc = st_sfc(p1, p2) > try(st_buffer(sfc, units::set_units(1000, km))) # error: no crs Error in st_buffer.sfc(sfc, units::set_units(1000, km)) : x does not have a crs set: can't convert units > sfc = st_sfc(p1, p2, crs = 4326) > try(zzz <- st_buffer(sfc, units::set_units(1000, km))) # error: wrong units > if (version$os == "linux-gnu") { # FIXME: why does this break on windows - degree symbol? + x = st_buffer(sfc, units::set_units(0.1, rad)) # OK: will convert to arc_degrees + } > x = st_transform(sfc, 3857) > x = st_buffer(x, units::set_units(1000, km)) # success > > cr = st_as_sfc("CIRCULARSTRING(0 0,1 0,1 1)") > cr1 = st_sf(a = 1, geometry = cr) > plot(cr) > st_as_grob(cr[[1]]) lines[GRID.lines.1] > > x = st_as_sfc("MULTISURFACE(CURVEPOLYGON(COMPOUNDCURVE(LINESTRING(-159.399779123 22.226016471, -159.399699153 22.226276431, -159.398736217 22.226118372, -159.398260872 22.226095318, -159.398140792 22.2260564590001, -159.398163058 22.2257268010001, -159.397882642 22.225394244, -159.397397157 22.225057335, -159.397318825 22.2251780230001, -159.396993115 22.225177984, -159.396748242 22.2248808800001, -159.396901679 22.224770398, -159.396876329 22.224673093, -159.399167008 22.224731392, -159.399502204 22.225551382), CIRCULARSTRING(-159.399502204 22.225551382, -159.399622762077 22.2257930044972, -159.399779123 22.226016471))))") > mp <- x[[1]] |> st_cast("MULTIPOLYGON") > > x = st_as_sfc("COMPOUNDCURVE(CIRCULARSTRING(0 0, 1 1, 1 0),(1 0, 0 1))") > ls <- x[[1]] |> st_cast() > class(ls) [1] "XY" "LINESTRING" "sfg" > > is.na(st_bbox(ls)) [1] FALSE > > mp = st_combine(st_buffer(st_sfc(lapply(1:3, function(x) st_point(c(x,x)))), 0.2 * 1:3)) > plot(st_centroid(mp), add = TRUE, col = 'red') # centroid of combined geometry > plot(st_centroid(mp, of_largest_polygon = TRUE), add = TRUE, col = 'blue', pch = 3) # center of largest sub-polygon > > x = st_sfc(st_polygon(list(rbind(c(0,0),c(0.5,0),c(0.5,0.5),c(0.5,0),c(1,0),c(1,1),c(0,1),c(0,0))))) > suppressWarnings(st_is_valid(x)) [1] FALSE > y = st_make_valid(x) > y = st_make_valid(x[[1]]) > y = st_make_valid(st_sf(a = 1, geom = x)) > st_is_valid(y) [1] TRUE > > proc.time() user system elapsed 0.844 1.405 0.746 ================================================ FILE: tests/geos.R ================================================ suppressPackageStartupMessages(library(sf)) # nc = st_read(system.file("gpkg/nc.gpkg", package="sf")) nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) nc_checked = st_transform(nc, 32119, check = TRUE) ncm = st_transform(nc, 32119) x = st_transform(nc[1:10,], 32119) st_distance(x) st_is_valid(nc) st_is_empty(st_sfc(st_point(), st_linestring())) ops = c("intersects", #"disjoint", "touches", "crosses", "within", "contains", "overlaps", "equals", "covers", "covered_by", "equals_exact") for (op in ops) { x = sf:::st_geos_binop(op, ncm[1:50,], ncm[51:100,], 0, NA_character_, FALSE) x = sf:::st_geos_binop(op, ncm[1:50,], ncm[51:100,], 0, NA_character_, TRUE) } ops = c("intersects", #"disjoint", "touches", "crosses", "within", "contains", "overlaps", "covers", "covered_by") df = data.frame(ops = ops) df$equal = NA for (op in ops) df[df$ops == op, "equal"] = identical( sf:::st_geos_binop(op, ncm[1:50,], ncm[51:100,], 0, NA_character_, TRUE, FALSE), sf:::st_geos_binop(op, ncm[1:50,], ncm[51:100,], 0, NA_character_, TRUE, TRUE) ) df st_contains_properly(ncm[1:3,], ncm[1:3]) st_combine(nc) st_dimension(st_sfc(st_point(0:1), st_linestring(rbind(c(0,0),c(1,1))), st_polygon(list(rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0)))))) ncbb = st_as_sfc(st_bbox(nc)) g = st_make_grid(ncbb) x = st_intersection(nc, g) x = st_intersection(g, nc) ls = st_sfc(st_linestring(rbind(c(0,0),c(0,1))), st_linestring(rbind(c(0,0),c(10,0)))) suppressWarnings(RNGversion("3.5.3")) set.seed(13531) st_line_sample(ls, density = 1, type = "random") g = st_make_grid(ncbb, n = c(20,10)) a1 = st_interpolate_aw(nc["BIR74"], g, FALSE) sum(a1$BIR74) / sum(nc$BIR74) # not close to one: property is assumed spatially intensive a2 = st_interpolate_aw(nc["BIR74"], g, extensive = TRUE) sum(a2$BIR74) / sum(nc$BIR74) # missing x: g = st_make_grid(offset = c(0,0), cellsize = c(1,1), n = c(10,10)) g = st_make_grid(what = "centers") length(g) g = st_make_grid(what = "corners") length(g) g1 = st_make_grid(ncbb, 0.1, what = "polygons", square = FALSE) g2 = st_make_grid(ncbb, 0.1, what = "points", square = FALSE) # st_line_merge: mls = st_multilinestring(list(rbind(c(0,0), c(1,1)), rbind(c(2,0), c(1,1)))) st_line_merge(mls) if (isTRUE(try(compareVersion(sf_extSoftVersion()["GEOS"], "3.5.0") > -1, silent = TRUE))) { # voronoi: set.seed(1) m = matrix(runif(10),,2) x = st_multipoint(m) box = st_polygon(list(rbind(c(0,0),c(1,0),c(1,1),c(0,1),c(0,0)))) v = st_sfc(st_voronoi(x, st_sfc(box))) plot(v, col = 0, border = 1, axes = TRUE) plot(box, add = TRUE, col = 0, border = 1) # a larger box is returned, as documented plot(x, add = TRUE, col = 'red', cex=2, pch=16) plot(st_intersection(st_cast(v), box)) # clip to smaller box plot(x, add = TRUE, col = 'red', cex=2, pch=16) v0 = st_sfc(st_voronoi(st_sfc(x), st_sfc(box))) pal <- c("black", "red", "green", "blue", "orange") opar = par(mfrow=c(1,2)) plot(st_collection_extract(v0, "POLYGON"), col=pal) text(m[,1], m[,2], label=1:5, col="white") if (isTRUE(try(compareVersion(sf_extSoftVersion()["GEOS"], "3.12.0") > -1, silent = TRUE))) { v2 = st_sfc(st_voronoi(st_sfc(x), st_sfc(box), point_order=TRUE)) plot(st_collection_extract(v2, "POLYGON"), col=pal) text(m[,1], m[,2], label=1:5, col="white") } par(opar) v = st_voronoi(x) print(class(v)) v = st_sfc(st_voronoi(st_sfc(x))) print(class(v)) v = st_voronoi(st_sf(a = 1, geom = st_sfc(x))) print(class(v)) } i = st_intersects(ncm, ncm[1:88,]) all.equal(i, t(t(i))) # check use of pattern in st_relate: sfc = st_as_sfc(st_bbox(st_sfc(st_point(c(0,0)), st_point(c(3,3))))) grd = st_make_grid(sfc, n = c(3,3)) st_intersects(grd) st_relate(grd, pattern = "****1****") st_relate(grd, pattern = "****0****") st_rook = function(a, b = a, ...) st_relate(a, b, pattern = "F***1****", ...) st_rook(grd, sparse = FALSE) #if (Sys.getenv("USER") %in% c("edzer", "travis")) { # memory leaks: try(st_relate(st_point(), st_point(), pattern = "FF*FF****")) # error: use st_disjoint #} a = st_is_within_distance(nc[c(1:3,20),], nc[1:3,], 100000, sparse = FALSE) b = st_is_within_distance(nc[c(1:3,20),], nc[1:3,], units::set_units(100000, m), sparse = FALSE) all.equal(a, b) x = st_is_within_distance(nc[1:3,], nc[1:5,], 100000) y = st_is_within_distance(nc[1:3,], nc[1:5,], units::set_units(100, km)) all.equal(x, y) nc_3857 = st_transform(nc, 3857) a = st_is_within_distance(nc_3857[c(1:3,20),], nc_3857[1:3,], 100000, sparse = FALSE) b = st_is_within_distance(nc_3857[c(1:3,20),], nc_3857[1:3,], units::set_units(100000, m), sparse = FALSE) all.equal(a, b) x = st_is_within_distance(nc_3857, nc_3857, 100000) y = st_is_within_distance(nc_3857, nc_3857, units::set_units(100, km)) all.equal(x, y) pe = st_sfc(st_point()) p = st_sfc(st_point(c(0,0)), st_point(c(0,1)), st_point(c(0,2))) st_distance(p, p) st_distance(p, pe) st_distance(p, p, by_element = TRUE) st_crs(p) = 4326 st_distance(p, p[c(2,3,1)], by_element = TRUE) p = st_transform(p, 3587) st_distance(p, p[c(2,3,1)], by_element = TRUE) # from https://github.com/r-spatial/sf/issues/458 : pts <- st_sfc(st_point(c(.5,.5)), st_point(c(1.5, 1.5)), st_point(c(2.5, 2.5))) pol <- st_polygon(list(rbind(c(0,0), c(2,0), c(2,2), c(0,2), c(0,0)))) pol_df <- data.frame(id = 1) st_geometry(pol_df) <- st_sfc(pol) st_intersects(pts, pol_df[pol_df$id == 2,]) # with empty sf/sfc st_intersects(pts, pol_df[pol_df$id == 2,], sparse = FALSE) # with empty sf/sfc # st_node l = st_linestring(rbind(c(0,0), c(1,1), c(0,1), c(1,0), c(0,0))) st_node(l) st_node(st_sfc(l)) st_node(st_sf(a = 1, st_sfc(l))) # print.sgbp: (lst = st_disjoint(nc, nc)) # dim.sgbp: dim(lst) # as.matrix.sgbp: as.matrix(lst)[1:5, 1:5] # negate: !lst # as.data.frame: head(as.data.frame(lst), 10) # snap: nc1 = st_transform(nc, 32119) g = st_make_grid(nc1, c(5000,5000), what = "centers") s = st_snap(nc1[1:3,], g, 2501*sqrt(2)) sfg = st_snap(st_geometry(nc1)[[1]], g, 2501*sqrt(2)) sfg = st_snap(st_geometry(nc1)[[1]], st_combine(g), 2501*sqrt(2)) # Hausdorff distance: http://geos.refractions.net/ro/doxygen_docs/html/classgeos_1_1algorithm_1_1distance_1_1DiscreteHausdorffDistance.html A = st_as_sfc("LINESTRING (0 0, 100 0, 10 100, 10 100)") B = st_as_sfc("LINESTRING (0 100, 0 10, 80 10)") st_distance(c(A,B)) st_distance(c(A,B), which = "Hausdorff") st_distance(c(A,B), which = "Hausdorff", par = 0.001) LE = st_as_sfc("LINESTRING EMPTY") st_distance(c(A, LE), which = "Hausdorff", par = 0.001) # one-argument st_intersection and st_difference: set.seed(131) m = rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0)) p = st_polygon(list(m)) n = 100 l = vector("list", n) for (i in 1:n) l[[i]] = p + 10 * runif(2) s = st_sfc(l) plot(s, col = sf.colors(categorical = TRUE, alpha = .5)) d = st_difference(s) # sequential differences: s1, s2-s1, s3-s2-s1, ... plot(d, col = sf.colors(categorical = TRUE, alpha = .5)) i = st_intersection(s) # all intersections plot(i, col = sf.colors(categorical = TRUE, alpha = .5)) summary(lengths(st_overlaps(s, s))) summary(lengths(st_overlaps(d, d))) summary(lengths(st_overlaps(i, i))) sf = st_sf(s) i = st_intersection(sf) # all intersections plot(i["n.overlaps"]) summary(i$n.overlaps - lengths(i$origins)) # st_nearest_points: pt1 = st_point(c(.1,.1)) pt2 = st_point(c(.9,.9)) b1 = st_buffer(pt1, 0.1) b2 = st_buffer(pt2, 0.1) plot(b1, xlim = c(0,1), ylim = c(0,1)) plot(b2, add = TRUE) (ls0 = try(st_nearest_points(b1, b2))) # sfg (ls = try(st_nearest_points(st_sfc(b1), st_sfc(b2)))) # sfc (ls = try(st_nearest_points(st_sfc(b1), st_sfc(b2), pairwise = TRUE))) # sfc identical(ls0, ls) # plot(ls, add = TRUE, col = 'red') nc = read_sf(system.file("gpkg/nc.gpkg", package="sf")) plot(st_geometry(nc)) ls = try(st_nearest_points(nc[1,], nc)) # plot(ls, col = 'red', add = TRUE) pts = st_cast(ls, "POINT") # gives all start & end points # starting, "from" points, corresponding to x: plot(pts[seq(1, 200, 2)], add = TRUE, col = 'blue') # ending, "to" points, corresponding to y: plot(pts[seq(2, 200, 2)], add = TRUE, col = 'red') # points to nearest features ls1 = st_linestring(rbind(c(0,0), c(1,0))) ls2 = st_linestring(rbind(c(0,0.1), c(1,0.1))) ls3 = st_linestring(rbind(c(0,1), c(1,1))) (l = st_sfc(ls1, ls2, ls3)) p1 = st_point(c(0.1, -0.1)) p2 = st_point(c(0.1, 0.11)) p3 = st_point(c(0.1, 0.09)) p4 = st_point(c(0.1, 0.9)) p5 = st_point() (p = st_sfc(p1, p2, p3, p4, p5)) #st_nearest_points(p, l) n = try(st_nearest_feature(p,l)) if (!inherits(n, "try-error")) { print(st_nearest_points(p, l[n], pairwise = TRUE)) print(st_nearest_feature(p, l)) print(st_nearest_feature(p, st_sfc())) print(st_nearest_feature(st_sfc(), l)) } # can do centroid of empty geom: st_centroid(st_polygon()) #999: pt = data.frame(x=1:2, y=1:2,a=letters[1:2]) pt = st_as_sf(pt, coords=c("x","y")) bf =st_buffer(pt, dist=0.3) st_within(pt,bf, sparse=FALSE) st_within(pt[1,], bf[1,], sparse = FALSE) st_relate(pt[1,], bf[1,], pattern = "T*F**F***", sparse = FALSE) sf:::is_symmetric(pattern = "010121010") sf:::is_symmetric(pattern = "010121021") st_intersects(st_point(0:1), st_point(2:3)) # sfg method if (isTRUE(try(compareVersion(sf_extSoftVersion()["GEOS"], "3.7.0") > -1, silent = TRUE))) { ls = st_linestring(rbind(c(1,1), c(2,2), c(3,3))) print(st_reverse(ls)) print(st_reverse(st_sfc(ls))) print(st_reverse(st_sf(a = 2, geom = st_sfc(ls)))) } p = st_polygon(list(rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0)))) y = st_sfc(p) x = st_sfc(p + 1.001) x |> st_set_precision(0) |> st_intersects(y) x |> st_set_precision(10000) |> st_intersects(y) x |> st_set_precision(1000) |> st_intersects(y) x |> st_set_precision(501) |> st_intersects(y) # no x |> st_set_precision(500) |> st_intersects(y) # yes x |> st_set_precision(100) |> st_intersects(y) x |> st_set_precision(10) |> st_intersects(y) p1 = st_point(0:1) p2 = st_point(2:1) p = st_sf(a = letters[1:8], geom = st_sfc(p1, p1, p2, p1, p1, p2, p2, p1)) st_equals(p) st_equals(p, remove_self = TRUE) (u = st_equals(p, retain_unique = TRUE)) # retain the records with unique geometries: p[-unlist(u),] ================================================ FILE: tests/geos.Rout.save ================================================ R version 4.5.2 (2025-10-31) -- "[Not] Part in a Rumble" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > suppressPackageStartupMessages(library(sf)) > # nc = st_read(system.file("gpkg/nc.gpkg", package="sf")) > nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) > nc_checked = st_transform(nc, 32119, check = TRUE) > ncm = st_transform(nc, 32119) > > x = st_transform(nc[1:10,], 32119) > st_distance(x) Units: [m] [,1] [,2] [,3] [,4] [,5] [,6] [,7] [1,] 0.00 0.00 25651.99 440561.48 299772.34 361529.73 419671.66 [2,] 0.00 0.00 0.00 409429.44 268945.05 332590.52 388545.58 [3,] 25651.99 0.00 0.00 367556.52 227018.38 290298.04 346669.14 [4,] 440561.48 409429.44 367556.52 0.00 67226.86 45537.62 0.00 [5,] 299772.34 268945.05 227018.38 67226.86 0.00 0.00 46527.56 [6,] 361529.73 332590.52 290298.04 45537.62 0.00 0.00 30213.17 [7,] 419671.66 388545.58 346669.14 0.00 46527.56 30213.17 0.00 [8,] 384593.29 354295.06 312351.76 16130.19 11926.86 0.00 0.00 [9,] 262353.97 231217.73 189310.73 140455.97 0.00 64606.27 119564.00 [10,] 71138.53 41943.71 0.00 330752.58 190183.42 252373.26 309863.33 [,8] [,9] [,10] [1,] 384593.29 262353.97 71138.53 [2,] 354295.06 231217.73 41943.71 [3,] 312351.76 189310.73 0.00 [4,] 16130.19 140455.97 330752.58 [5,] 11926.86 0.00 190183.42 [6,] 0.00 64606.27 252373.26 [7,] 0.00 119564.00 309863.33 [8,] 0.00 85533.33 275391.07 [9,] 85533.33 0.00 152489.45 [10,] 275391.07 152489.45 0.00 > > st_is_valid(nc) [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE [16] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE [31] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE [46] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE [61] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE [76] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE [91] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > > st_is_empty(st_sfc(st_point(), st_linestring())) [1] TRUE TRUE > > ops = c("intersects", #"disjoint", + "touches", "crosses", "within", "contains", "overlaps", "equals", "covers", "covered_by", "equals_exact") > for (op in ops) { + x = sf:::st_geos_binop(op, ncm[1:50,], ncm[51:100,], 0, NA_character_, FALSE) + x = sf:::st_geos_binop(op, ncm[1:50,], ncm[51:100,], 0, NA_character_, TRUE) + } > > ops = c("intersects", #"disjoint", + "touches", "crosses", "within", "contains", "overlaps", "covers", "covered_by") > df = data.frame(ops = ops) > df$equal = NA > for (op in ops) + df[df$ops == op, "equal"] = identical( + sf:::st_geos_binop(op, ncm[1:50,], ncm[51:100,], 0, NA_character_, TRUE, FALSE), + sf:::st_geos_binop(op, ncm[1:50,], ncm[51:100,], 0, NA_character_, TRUE, TRUE) + ) > df ops equal 1 intersects TRUE 2 touches TRUE 3 crosses TRUE 4 within TRUE 5 contains TRUE 6 overlaps TRUE 7 covers TRUE 8 covered_by TRUE > > st_contains_properly(ncm[1:3,], ncm[1:3]) Sparse geometry binary predicate list of length 3, where the predicate was `contains_properly' 1: (empty) 2: (empty) 3: (empty) > > st_combine(nc) Geometry set for 1 feature Geometry type: MULTIPOLYGON Dimension: XY Bounding box: xmin: -84.32385 ymin: 33.88199 xmax: -75.45698 ymax: 36.58965 Geodetic CRS: NAD27 MULTIPOLYGON (((-81.47276 36.23436, -81.54084 3... > > st_dimension(st_sfc(st_point(0:1), st_linestring(rbind(c(0,0),c(1,1))), + st_polygon(list(rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0)))))) [1] 0 1 2 > > ncbb = st_as_sfc(st_bbox(nc)) > g = st_make_grid(ncbb) > x = st_intersection(nc, g) Warning message: attribute variables are assumed to be spatially constant throughout all geometries > x = st_intersection(g, nc) > > ls = st_sfc(st_linestring(rbind(c(0,0),c(0,1))), + st_linestring(rbind(c(0,0),c(10,0)))) > > suppressWarnings(RNGversion("3.5.3")) > set.seed(13531) > > st_line_sample(ls, density = 1, type = "random") Geometry set for 2 features Geometry type: MULTIPOINT Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 6.880179 ymax: 0.8878369 CRS: NA MULTIPOINT ((0 0.8878369)) MULTIPOINT ((0.2986488 0), (2.48417 0), (2.5678... > > g = st_make_grid(ncbb, n = c(20,10)) > > a1 = st_interpolate_aw(nc["BIR74"], g, FALSE) Warning message: In st_interpolate_aw.sf(nc["BIR74"], g, FALSE) : st_interpolate_aw assumes attributes are constant or uniform over areas of x > sum(a1$BIR74) / sum(nc$BIR74) # not close to one: property is assumed spatially intensive [1] 1.436123 > a2 = st_interpolate_aw(nc["BIR74"], g, extensive = TRUE) Warning message: In st_interpolate_aw.sf(nc["BIR74"], g, extensive = TRUE) : st_interpolate_aw assumes attributes are constant or uniform over areas of x > sum(a2$BIR74) / sum(nc$BIR74) [1] 1 > > # missing x: > g = st_make_grid(offset = c(0,0), cellsize = c(1,1), n = c(10,10)) > g = st_make_grid(what = "centers") > length(g) [1] 648 > g = st_make_grid(what = "corners") > length(g) [1] 703 > > g1 = st_make_grid(ncbb, 0.1, what = "polygons", square = FALSE) > g2 = st_make_grid(ncbb, 0.1, what = "points", square = FALSE) > > # st_line_merge: > mls = st_multilinestring(list(rbind(c(0,0), c(1,1)), rbind(c(2,0), c(1,1)))) > st_line_merge(mls) LINESTRING (0 0, 1 1, 2 0) > > if (isTRUE(try(compareVersion(sf_extSoftVersion()["GEOS"], "3.5.0") > -1, silent = TRUE))) { + # voronoi: + set.seed(1) + m = matrix(runif(10),,2) + x = st_multipoint(m) + box = st_polygon(list(rbind(c(0,0),c(1,0),c(1,1),c(0,1),c(0,0)))) + v = st_sfc(st_voronoi(x, st_sfc(box))) + plot(v, col = 0, border = 1, axes = TRUE) + plot(box, add = TRUE, col = 0, border = 1) # a larger box is returned, as documented + plot(x, add = TRUE, col = 'red', cex=2, pch=16) + plot(st_intersection(st_cast(v), box)) # clip to smaller box + plot(x, add = TRUE, col = 'red', cex=2, pch=16) + v0 = st_sfc(st_voronoi(st_sfc(x), st_sfc(box))) + pal <- c("black", "red", "green", "blue", "orange") + opar = par(mfrow=c(1,2)) + plot(st_collection_extract(v0, "POLYGON"), col=pal) + text(m[,1], m[,2], label=1:5, col="white") + if (isTRUE(try(compareVersion(sf_extSoftVersion()["GEOS"], "3.12.0") > -1, silent = TRUE))) { + v2 = st_sfc(st_voronoi(st_sfc(x), st_sfc(box), point_order=TRUE)) + plot(st_collection_extract(v2, "POLYGON"), col=pal) + text(m[,1], m[,2], label=1:5, col="white") + } + par(opar) + + v = st_voronoi(x) + print(class(v)) + v = st_sfc(st_voronoi(st_sfc(x))) + print(class(v)) + v = st_voronoi(st_sf(a = 1, geom = st_sfc(x))) + print(class(v)) + } [1] "XY" "GEOMETRYCOLLECTION" "sfg" [1] "sfc_GEOMETRYCOLLECTION" "sfc" [1] "sf" "data.frame" > > i = st_intersects(ncm, ncm[1:88,]) > all.equal(i, t(t(i))) [1] TRUE > > # check use of pattern in st_relate: > sfc = st_as_sfc(st_bbox(st_sfc(st_point(c(0,0)), st_point(c(3,3))))) > grd = st_make_grid(sfc, n = c(3,3)) > st_intersects(grd) Sparse geometry binary predicate list of length 9, where the predicate was `intersects' 1: 1, 2, 4, 5 2: 1, 2, 3, 4, 5, 6 3: 2, 3, 5, 6 4: 1, 2, 4, 5, 7, 8 5: 1, 2, 3, 4, 5, 6, 7, 8, 9 6: 2, 3, 5, 6, 8, 9 7: 4, 5, 7, 8 8: 4, 5, 6, 7, 8, 9 9: 5, 6, 8, 9 > st_relate(grd, pattern = "****1****") Sparse geometry binary predicate list of length 9, where the predicate was `relate_pattern' 1: 1, 2, 4 2: 1, 2, 3, 5 3: 2, 3, 6 4: 1, 4, 5, 7 5: 2, 4, 5, 6, 8 6: 3, 5, 6, 9 7: 4, 7, 8 8: 5, 7, 8, 9 9: 6, 8, 9 > st_relate(grd, pattern = "****0****") Sparse geometry binary predicate list of length 9, where the predicate was `relate_pattern' 1: 5 2: 4, 6 3: 5 4: 2, 8 5: 1, 3, 7, 9 6: 2, 8 7: 5 8: 4, 6 9: 5 > st_rook = function(a, b = a, ...) st_relate(a, b, pattern = "F***1****", ...) > st_rook(grd, sparse = FALSE) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [1,] FALSE TRUE FALSE TRUE FALSE FALSE FALSE FALSE FALSE [2,] TRUE FALSE TRUE FALSE TRUE FALSE FALSE FALSE FALSE [3,] FALSE TRUE FALSE FALSE FALSE TRUE FALSE FALSE FALSE [4,] TRUE FALSE FALSE FALSE TRUE FALSE TRUE FALSE FALSE [5,] FALSE TRUE FALSE TRUE FALSE TRUE FALSE TRUE FALSE [6,] FALSE FALSE TRUE FALSE TRUE FALSE FALSE FALSE TRUE [7,] FALSE FALSE FALSE TRUE FALSE FALSE FALSE TRUE FALSE [8,] FALSE FALSE FALSE FALSE TRUE FALSE TRUE FALSE TRUE [9,] FALSE FALSE FALSE FALSE FALSE TRUE FALSE TRUE FALSE > > #if (Sys.getenv("USER") %in% c("edzer", "travis")) { # memory leaks: > try(st_relate(st_point(), st_point(), pattern = "FF*FF****")) # error: use st_disjoint Error : use st_disjoint for this pattern > #} > > a = st_is_within_distance(nc[c(1:3,20),], nc[1:3,], 100000, sparse = FALSE) > b = st_is_within_distance(nc[c(1:3,20),], nc[1:3,], units::set_units(100000, m), sparse = FALSE) > all.equal(a, b) [1] TRUE > x = st_is_within_distance(nc[1:3,], nc[1:5,], 100000) > y = st_is_within_distance(nc[1:3,], nc[1:5,], units::set_units(100, km)) > all.equal(x, y) [1] TRUE > > nc_3857 = st_transform(nc, 3857) > a = st_is_within_distance(nc_3857[c(1:3,20),], nc_3857[1:3,], 100000, sparse = FALSE) > b = st_is_within_distance(nc_3857[c(1:3,20),], nc_3857[1:3,], units::set_units(100000, m), sparse = FALSE) > all.equal(a, b) [1] TRUE > x = st_is_within_distance(nc_3857, nc_3857, 100000) > y = st_is_within_distance(nc_3857, nc_3857, units::set_units(100, km)) > all.equal(x, y) [1] TRUE > > pe = st_sfc(st_point()) > p = st_sfc(st_point(c(0,0)), st_point(c(0,1)), st_point(c(0,2))) > st_distance(p, p) [,1] [,2] [,3] [1,] 0 1 2 [2,] 1 0 1 [3,] 2 1 0 > st_distance(p, pe) [,1] [1,] NA [2,] NA [3,] NA > st_distance(p, p, by_element = TRUE) [1] 0 0 0 > st_crs(p) = 4326 > st_distance(p, p[c(2,3,1)], by_element = TRUE) Units: [m] [1] 111195.1 111195.1 222390.2 > p = st_transform(p, 3587) > st_distance(p, p[c(2,3,1)], by_element = TRUE) Units: [m] [1] 144589.5 142873.3 287462.8 > > # from https://github.com/r-spatial/sf/issues/458 : > pts <- st_sfc(st_point(c(.5,.5)), st_point(c(1.5, 1.5)), st_point(c(2.5, 2.5))) > pol <- st_polygon(list(rbind(c(0,0), c(2,0), c(2,2), c(0,2), c(0,0)))) > pol_df <- data.frame(id = 1) > st_geometry(pol_df) <- st_sfc(pol) > st_intersects(pts, pol_df[pol_df$id == 2,]) # with empty sf/sfc Sparse geometry binary predicate list of length 3, where the predicate was `intersects' 1: (empty) 2: (empty) 3: (empty) > st_intersects(pts, pol_df[pol_df$id == 2,], sparse = FALSE) # with empty sf/sfc [1,] [2,] [3,] > > # st_node > l = st_linestring(rbind(c(0,0), c(1,1), c(0,1), c(1,0), c(0,0))) > st_node(l) MULTILINESTRING ((0 0, 0.5 0.5), (0.5 0.5, 1 1, 0 1, 0.5 0.5), (0.5 0.5, 1 0, 0 0)) > st_node(st_sfc(l)) Geometry set for 1 feature Geometry type: MULTILINESTRING Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA MULTILINESTRING ((0 0, 0.5 0.5), (0.5 0.5, 1 1,... > st_node(st_sf(a = 1, st_sfc(l))) Simple feature collection with 1 feature and 1 field Geometry type: MULTILINESTRING Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA a st_sfc.l. 1 1 MULTILINESTRING ((0 0, 0.5 ... > > # print.sgbp: > (lst = st_disjoint(nc, nc)) Sparse geometry binary predicate list of length 100, where the predicate was `disjoint' first 10 elements: 1: 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, ... 2: 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, ... 3: 1, 4, 5, 6, 7, 8, 9, 11, 12, 13, ... 4: 1, 2, 3, 5, 6, 8, 9, 10, 11, 12, ... 5: 1, 2, 3, 4, 7, 8, 10, 11, 12, 13, ... 6: 1, 2, 3, 4, 7, 9, 10, 11, 12, 13, ... 7: 1, 2, 3, 5, 6, 9, 10, 11, 12, 13, ... 8: 1, 2, 3, 4, 5, 9, 10, 11, 12, 13, ... 9: 1, 2, 3, 4, 6, 7, 8, 10, 11, 12, ... 10: 1, 2, 4, 5, 6, 7, 8, 9, 11, 13, ... > # dim.sgbp: > dim(lst) [1] 100 100 > # as.matrix.sgbp: > as.matrix(lst)[1:5, 1:5] [,1] [,2] [,3] [,4] [,5] [1,] FALSE FALSE TRUE TRUE TRUE [2,] FALSE FALSE FALSE TRUE TRUE [3,] TRUE FALSE FALSE TRUE TRUE [4,] TRUE TRUE TRUE FALSE TRUE [5,] TRUE TRUE TRUE TRUE FALSE > # negate: > !lst Sparse geometry binary predicate list of length 100, where the predicate was `!disjoint' first 10 elements: 1: 1, 2, 18, 19 2: 1, 2, 3, 18 3: 2, 3, 10, 18, 23, 25 4: 4, 7, 56 5: 5, 6, 9, 16, 28 6: 5, 6, 8, 28 7: 4, 7, 8, 17 8: 6, 7, 8, 17, 20, 21 9: 5, 9, 15, 16, 24, 31 10: 3, 10, 12, 25, 26 > # as.data.frame: > head(as.data.frame(lst), 10) row.id col.id 1 1 3 2 1 4 3 1 5 4 1 6 5 1 7 6 1 8 7 1 9 8 1 10 9 1 11 10 1 12 > > # snap: > nc1 = st_transform(nc, 32119) > g = st_make_grid(nc1, c(5000,5000), what = "centers") > s = st_snap(nc1[1:3,], g, 2501*sqrt(2)) > sfg = st_snap(st_geometry(nc1)[[1]], g, 2501*sqrt(2)) > sfg = st_snap(st_geometry(nc1)[[1]], st_combine(g), 2501*sqrt(2)) > > # Hausdorff distance: http://geos.refractions.net/ro/doxygen_docs/html/classgeos_1_1algorithm_1_1distance_1_1DiscreteHausdorffDistance.html > A = st_as_sfc("LINESTRING (0 0, 100 0, 10 100, 10 100)") > B = st_as_sfc("LINESTRING (0 100, 0 10, 80 10)") > st_distance(c(A,B)) [,1] [,2] [1,] 0.000000 8.176236 [2,] 8.176236 0.000000 > st_distance(c(A,B), which = "Hausdorff") [,1] [,2] [1,] 0.00000 22.36068 [2,] 22.36068 0.00000 > st_distance(c(A,B), which = "Hausdorff", par = 0.001) [,1] [,2] [1,] 2.929643e-14 4.789000e+01 [2,] 4.789000e+01 2.131628e-14 > LE = st_as_sfc("LINESTRING EMPTY") > st_distance(c(A, LE), which = "Hausdorff", par = 0.001) [,1] [,2] [1,] 2.929643e-14 NA [2,] NA NA > > # one-argument st_intersection and st_difference: > set.seed(131) > m = rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0)) > p = st_polygon(list(m)) > n = 100 > l = vector("list", n) > for (i in 1:n) + l[[i]] = p + 10 * runif(2) > s = st_sfc(l) > plot(s, col = sf.colors(categorical = TRUE, alpha = .5)) > d = st_difference(s) # sequential differences: s1, s2-s1, s3-s2-s1, ... > plot(d, col = sf.colors(categorical = TRUE, alpha = .5)) > i = st_intersection(s) # all intersections > plot(i, col = sf.colors(categorical = TRUE, alpha = .5)) > summary(lengths(st_overlaps(s, s))) Min. 1st Qu. Median Mean 3rd Qu. Max. 0.00 2.00 3.50 3.66 5.00 8.00 > summary(lengths(st_overlaps(d, d))) Min. 1st Qu. Median Mean 3rd Qu. Max. 0 0 0 0 0 0 > summary(lengths(st_overlaps(i, i))) Min. 1st Qu. Median Mean 3rd Qu. Max. 0 0 0 0 0 0 > > sf = st_sf(s) > i = st_intersection(sf) # all intersections > plot(i["n.overlaps"]) > summary(i$n.overlaps - lengths(i$origins)) Min. 1st Qu. Median Mean 3rd Qu. Max. 0 0 0 0 0 0 > > # st_nearest_points: > pt1 = st_point(c(.1,.1)) > pt2 = st_point(c(.9,.9)) > b1 = st_buffer(pt1, 0.1) > b2 = st_buffer(pt2, 0.1) > plot(b1, xlim = c(0,1), ylim = c(0,1)) > plot(b2, add = TRUE) > (ls0 = try(st_nearest_points(b1, b2))) # sfg Geometry set for 1 feature Geometry type: LINESTRING Dimension: XY Bounding box: xmin: 0.1707107 ymin: 0.1707107 xmax: 0.8292893 ymax: 0.8292893 CRS: NA LINESTRING (0.1707107 0.1707107, 0.8292893 0.82... > (ls = try(st_nearest_points(st_sfc(b1), st_sfc(b2)))) # sfc Geometry set for 1 feature Geometry type: LINESTRING Dimension: XY Bounding box: xmin: 0.1707107 ymin: 0.1707107 xmax: 0.8292893 ymax: 0.8292893 CRS: NA LINESTRING (0.1707107 0.1707107, 0.8292893 0.82... > (ls = try(st_nearest_points(st_sfc(b1), st_sfc(b2), pairwise = TRUE))) # sfc Geometry set for 1 feature Geometry type: LINESTRING Dimension: XY Bounding box: xmin: 0.1707107 ymin: 0.1707107 xmax: 0.8292893 ymax: 0.8292893 CRS: NA LINESTRING (0.1707107 0.1707107, 0.8292893 0.82... > identical(ls0, ls) [1] TRUE > # plot(ls, add = TRUE, col = 'red') > > nc = read_sf(system.file("gpkg/nc.gpkg", package="sf")) > plot(st_geometry(nc)) > ls = try(st_nearest_points(nc[1,], nc)) > # plot(ls, col = 'red', add = TRUE) > pts = st_cast(ls, "POINT") # gives all start & end points There were 50 or more warnings (use warnings() to see the first 50) > # starting, "from" points, corresponding to x: > plot(pts[seq(1, 200, 2)], add = TRUE, col = 'blue') > # ending, "to" points, corresponding to y: > plot(pts[seq(2, 200, 2)], add = TRUE, col = 'red') > > # points to nearest features > ls1 = st_linestring(rbind(c(0,0), c(1,0))) > ls2 = st_linestring(rbind(c(0,0.1), c(1,0.1))) > ls3 = st_linestring(rbind(c(0,1), c(1,1))) > (l = st_sfc(ls1, ls2, ls3)) Geometry set for 3 features Geometry type: LINESTRING Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA LINESTRING (0 0, 1 0) LINESTRING (0 0.1, 1 0.1) LINESTRING (0 1, 1 1) > > p1 = st_point(c(0.1, -0.1)) > p2 = st_point(c(0.1, 0.11)) > p3 = st_point(c(0.1, 0.09)) > p4 = st_point(c(0.1, 0.9)) > p5 = st_point() > > (p = st_sfc(p1, p2, p3, p4, p5)) Geometry set for 5 features (with 1 geometry empty) Geometry type: POINT Dimension: XY Bounding box: xmin: 0.1 ymin: -0.1 xmax: 0.1 ymax: 0.9 CRS: NA POINT (0.1 -0.1) POINT (0.1 0.11) POINT (0.1 0.09) POINT (0.1 0.9) POINT EMPTY > #st_nearest_points(p, l) > n = try(st_nearest_feature(p,l)) > if (!inherits(n, "try-error")) { + print(st_nearest_points(p, l[n], pairwise = TRUE)) + print(st_nearest_feature(p, l)) + print(st_nearest_feature(p, st_sfc())) + print(st_nearest_feature(st_sfc(), l)) + } Geometry set for 5 features (with 1 geometry empty) Geometry type: LINESTRING Dimension: XY Bounding box: xmin: 0.1 ymin: -0.1 xmax: 0.1 ymax: 1 CRS: NA LINESTRING (0.1 -0.1, 0.1 0) LINESTRING (0.1 0.11, 0.1 0.1) LINESTRING (0.1 0.09, 0.1 0.1) LINESTRING (0.1 0.9, 0.1 1) LINESTRING EMPTY [1] 1 2 2 3 NA [1] NA NA NA NA NA integer(0) > > # can do centroid of empty geom: > st_centroid(st_polygon()) POINT EMPTY > > #999: > pt = data.frame(x=1:2, y=1:2,a=letters[1:2]) > pt = st_as_sf(pt, coords=c("x","y")) > > bf =st_buffer(pt, dist=0.3) > > st_within(pt,bf, sparse=FALSE) [,1] [,2] [1,] TRUE FALSE [2,] FALSE TRUE > st_within(pt[1,], bf[1,], sparse = FALSE) [,1] [1,] TRUE > st_relate(pt[1,], bf[1,], pattern = "T*F**F***", sparse = FALSE) [,1] [1,] TRUE > > sf:::is_symmetric(pattern = "010121010") [1] TRUE > sf:::is_symmetric(pattern = "010121021") [1] FALSE > > st_intersects(st_point(0:1), st_point(2:3)) # sfg method Sparse geometry binary predicate list of length 1, where the predicate was `intersects' 1: (empty) > > if (isTRUE(try(compareVersion(sf_extSoftVersion()["GEOS"], "3.7.0") > -1, silent = TRUE))) { + ls = st_linestring(rbind(c(1,1), c(2,2), c(3,3))) + print(st_reverse(ls)) + print(st_reverse(st_sfc(ls))) + print(st_reverse(st_sf(a = 2, geom = st_sfc(ls)))) + } LINESTRING (3 3, 2 2, 1 1) Geometry set for 1 feature Geometry type: LINESTRING Dimension: XY Bounding box: xmin: 1 ymin: 1 xmax: 3 ymax: 3 CRS: NA LINESTRING (3 3, 2 2, 1 1) Simple feature collection with 1 feature and 1 field Geometry type: LINESTRING Dimension: XY Bounding box: xmin: 1 ymin: 1 xmax: 3 ymax: 3 CRS: NA a geom 1 2 LINESTRING (3 3, 2 2, 1 1) > > p = st_polygon(list(rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0)))) > y = st_sfc(p) > x = st_sfc(p + 1.001) > > x |> st_set_precision(0) |> st_intersects(y) Sparse geometry binary predicate list of length 1, where the predicate was `intersects' 1: (empty) > x |> st_set_precision(10000) |> st_intersects(y) Sparse geometry binary predicate list of length 1, where the predicate was `intersects' 1: (empty) > x |> st_set_precision(1000) |> st_intersects(y) Sparse geometry binary predicate list of length 1, where the predicate was `intersects' 1: (empty) > x |> st_set_precision(501) |> st_intersects(y) # no Sparse geometry binary predicate list of length 1, where the predicate was `intersects' 1: (empty) > x |> st_set_precision(500) |> st_intersects(y) # yes Sparse geometry binary predicate list of length 1, where the predicate was `intersects' 1: 1 > x |> st_set_precision(100) |> st_intersects(y) Sparse geometry binary predicate list of length 1, where the predicate was `intersects' 1: 1 > x |> st_set_precision(10) |> st_intersects(y) Sparse geometry binary predicate list of length 1, where the predicate was `intersects' 1: 1 > > p1 = st_point(0:1) > p2 = st_point(2:1) > p = st_sf(a = letters[1:8], geom = st_sfc(p1, p1, p2, p1, p1, p2, p2, p1)) > st_equals(p) Sparse geometry binary predicate list of length 8, where the predicate was `equals' 1: 1, 2, 4, 5, 8 2: 1, 2, 4, 5, 8 3: 3, 6, 7 4: 1, 2, 4, 5, 8 5: 1, 2, 4, 5, 8 6: 3, 6, 7 7: 3, 6, 7 8: 1, 2, 4, 5, 8 > st_equals(p, remove_self = TRUE) Sparse geometry binary predicate list of length 8, where the predicate was `equals', with remove_self = TRUE 1: 2, 4, 5, 8 2: 1, 4, 5, 8 3: 6, 7 4: 1, 2, 5, 8 5: 1, 2, 4, 8 6: 3, 7 7: 3, 6 8: 1, 2, 4, 5 > (u = st_equals(p, retain_unique = TRUE)) Sparse geometry binary predicate list of length 8, where the predicate was `equals', with retain_unique = TRUE 1: 2, 4, 5, 8 2: 4, 5, 8 3: 6, 7 4: 5, 8 5: 8 6: 7 7: (empty) 8: (empty) > # retain the records with unique geometries: > p[-unlist(u),] Simple feature collection with 2 features and 1 field Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 1 xmax: 2 ymax: 1 CRS: NA a geom 1 a POINT (0 1) 3 c POINT (2 1) > > proc.time() user system elapsed 11.306 1.440 11.246 ================================================ FILE: tests/graticule.R ================================================ if (require(maps, quietly = TRUE)) { m = map('usa', plot = FALSE, fill = TRUE) suppressPackageStartupMessages(library(sf)) m0 <- st_as_sfc(m) m <- st_as_sf(m) laea = st_crs("+proj=laea +lat_0=30 +lon_0=-95") # Lambert equal area m <- st_transform(st_as_sf(m), laea) bb = st_bbox(m) bbox = st_linestring(rbind(c( bb[1],bb[2]),c( bb[3],bb[2]),c( bb[3],bb[4]),c( bb[1],bb[4]),c( bb[1],bb[2]))) g = st_graticule(m) plot(m, xlim = 1.2 * c(-2450853.4, 2186391.9)) plot(g[1], add = TRUE, col = 'grey') plot(bbox, add = TRUE) points(g$x_start, g$y_start, col = 'red') points(g$x_end, g$y_end, col = 'blue') invisible(lapply(seq_len(nrow(g)), function(i) { if (g$type[i] == "N" && g$x_start[i] - min(g$x_start) < 1000) text(g$x_start[i], g$y_start[i], labels = parse(text = g$degree_label[i]), srt = g$angle_start[i], pos = 2, cex = .7) if (g$type[i] == "E" && g$y_start[i] - min(g$y_start) < 1000) text(g$x_start[i], g$y_start[i], labels = parse(text = g$degree_label[i]), srt = g$angle_start[i] - 90, pos = 1, cex = .7) if (g$type[i] == "N" && g$x_end[i] - max(g$x_end) > -1000) text(g$x_end[i], g$y_end[i], labels = parse(text = g$degree_label[i]), srt = g$angle_end[i], pos = 4, cex = .7) if (g$type[i] == "E" && g$y_end[i] - max(g$y_end) > -1000) text(g$x_end[i], g$y_end[i], labels = parse(text = g$degree_label[i]), srt = g$angle_end[i] - 90, pos = 3, cex = .7) })) plot(m, graticule = st_crs(4326)) nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) # options(warn=2) g = st_graticule(nc, datum = st_crs(nc)) #g = st_graticule(nc) plot(nc[1], graticule = st_crs(nc)) plot(nc[1], graticule = st_crs(nc), axes = TRUE) g = st_graticule() if (require(ggplot2, quietly = TRUE) && utils::packageVersion("ggplot2") > "2.2.1") { ggplot() + geom_sf(data = st_set_crs(nc, NA_crs_)) # NA_crs_ for crs } library(maps) #421 (wrld2 = st_as_sf(map('world2', plot=FALSE, fill=TRUE ))) try(plot(wrld2, graticule = TRUE)) } ================================================ FILE: tests/graticule.Rout.save ================================================ R Under development (unstable) (2025-11-05 r88988 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > if (require(maps, quietly = TRUE)) { + m = map('usa', plot = FALSE, fill = TRUE) + suppressPackageStartupMessages(library(sf)) + m0 <- st_as_sfc(m) + m <- st_as_sf(m) + + laea = st_crs("+proj=laea +lat_0=30 +lon_0=-95") # Lambert equal area + m <- st_transform(st_as_sf(m), laea) + + bb = st_bbox(m) + bbox = st_linestring(rbind(c( bb[1],bb[2]),c( bb[3],bb[2]),c( bb[3],bb[4]),c( bb[1],bb[4]),c( bb[1],bb[2]))) + + g = st_graticule(m) + plot(m, xlim = 1.2 * c(-2450853.4, 2186391.9)) + plot(g[1], add = TRUE, col = 'grey') + plot(bbox, add = TRUE) + points(g$x_start, g$y_start, col = 'red') + points(g$x_end, g$y_end, col = 'blue') + + invisible(lapply(seq_len(nrow(g)), function(i) { + if (g$type[i] == "N" && g$x_start[i] - min(g$x_start) < 1000) + text(g$x_start[i], g$y_start[i], labels = parse(text = g$degree_label[i]), + srt = g$angle_start[i], pos = 2, cex = .7) + if (g$type[i] == "E" && g$y_start[i] - min(g$y_start) < 1000) + text(g$x_start[i], g$y_start[i], labels = parse(text = g$degree_label[i]), + srt = g$angle_start[i] - 90, pos = 1, cex = .7) + if (g$type[i] == "N" && g$x_end[i] - max(g$x_end) > -1000) + text(g$x_end[i], g$y_end[i], labels = parse(text = g$degree_label[i]), + srt = g$angle_end[i], pos = 4, cex = .7) + if (g$type[i] == "E" && g$y_end[i] - max(g$y_end) > -1000) + text(g$x_end[i], g$y_end[i], labels = parse(text = g$degree_label[i]), + srt = g$angle_end[i] - 90, pos = 3, cex = .7) + })) + + plot(m, graticule = st_crs(4326)) + nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) + # options(warn=2) + g = st_graticule(nc, datum = st_crs(nc)) + #g = st_graticule(nc) + + plot(nc[1], graticule = st_crs(nc)) + + plot(nc[1], graticule = st_crs(nc), axes = TRUE) + + g = st_graticule() + + if (require(ggplot2, quietly = TRUE) && utils::packageVersion("ggplot2") > "2.2.1") { + ggplot() + geom_sf(data = st_set_crs(nc, NA_crs_)) # NA_crs_ for crs + } + + library(maps) #421 + (wrld2 = st_as_sf(map('world2', plot=FALSE, fill=TRUE ))) + try(plot(wrld2, graticule = TRUE)) + } > > proc.time() user system elapsed 1.68 0.37 2.04 ================================================ FILE: tests/grid.R ================================================ # MULTIPOLYGONS suppressPackageStartupMessages(library(sf)) library(grid) nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) grid.newpage() # pushViewport(viewport(width = 0.8, height = 0.8)) pushViewport(st_viewport(nc)) invisible(lapply(st_geometry(nc), function(x) grid.draw(st_as_grob(x, gp = gpar(fill = 'red'))))) # POLYGONS # nc = st_read(system.file("gpkg/nc.gpkg", package="sf"), "nc.gpkg", type = 3) nc = st_read(system.file("shape/nc.shp", package="sf"), type = 3, quiet = TRUE) grid.newpage() pushViewport(st_viewport(nc)) invisible(lapply(st_geometry(nc), function(x) grid.draw(st_as_grob(x, gp = gpar(fill = 'red'))))) # POINTS: if (suppressPackageStartupMessages(require(sp, quietly = TRUE))) { data(meuse, package = "sp") meuse_sf = st_as_sf(meuse, coords = c("x", "y"), crs = 28992, agr = "constant") grid.newpage() pushViewport(st_viewport(meuse_sf)) invisible(lapply(st_geometry(meuse_sf), function(x) grid.draw(st_as_grob(x, gp = gpar(fill = 'red'))))) } # MULTIPOINTS mp = st_multipoint(cbind(runif(100), runif(100))) grid.newpage() pushViewport(st_viewport(mp)) grid.draw(st_as_grob(mp, gp = gpar(fill = 'red'))) # LINESTRING ls = st_linestring(cbind(1:10, rnorm(10))) grid.newpage() pushViewport(st_viewport(ls)) grid.draw(st_as_grob(ls, gp = gpar(fill = 'red'))) # MULTILINESTRING ls = st_multilinestring(list(cbind(1:10, 5+rnorm(10)), cbind(1:10, rnorm(10)), cbind(1:10, -5+rnorm(10)))) grid.newpage() pushViewport(st_viewport(ls)) grid.draw(st_as_grob(ls, gp = gpar(fill = 'red'))) if (require(sp, quietly = TRUE)) { # POINTS, right aspect in Long/Lat: meuse_ll = st_transform(meuse_sf, 4326) grid.newpage() pushViewport(st_viewport(meuse_ll)) invisible(lapply(st_geometry(meuse_ll), function(x) grid.draw(st_as_grob(x, gp = gpar(fill = 'red'))))) # WRONG aspect: st_crs(meuse_ll) = NA grid.newpage() pushViewport(st_viewport(meuse_ll)) invisible(lapply(st_geometry(meuse_ll), function(x) grid.draw(st_as_grob(x, gp = gpar(fill = 'red'))))) } gc = st_geometrycollection(list(st_point(0:1), st_linestring(matrix(1:4,2)))) grb = st_as_grob(gc) ================================================ FILE: tests/grid.Rout.save ================================================ R Under development (unstable) (2025-11-05 r88988 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > # MULTIPOLYGONS > suppressPackageStartupMessages(library(sf)) > library(grid) > nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) > grid.newpage() > # pushViewport(viewport(width = 0.8, height = 0.8)) > pushViewport(st_viewport(nc)) > invisible(lapply(st_geometry(nc), function(x) grid.draw(st_as_grob(x, gp = gpar(fill = 'red'))))) > > # POLYGONS > # nc = st_read(system.file("gpkg/nc.gpkg", package="sf"), "nc.gpkg", type = 3) > nc = st_read(system.file("shape/nc.shp", package="sf"), type = 3, quiet = TRUE) > grid.newpage() > pushViewport(st_viewport(nc)) > invisible(lapply(st_geometry(nc), function(x) grid.draw(st_as_grob(x, gp = gpar(fill = 'red'))))) > > # POINTS: > if (suppressPackageStartupMessages(require(sp, quietly = TRUE))) { + data(meuse, package = "sp") + meuse_sf = st_as_sf(meuse, coords = c("x", "y"), crs = 28992, agr = "constant") + grid.newpage() + pushViewport(st_viewport(meuse_sf)) + invisible(lapply(st_geometry(meuse_sf), + function(x) grid.draw(st_as_grob(x, gp = gpar(fill = 'red'))))) + } > > # MULTIPOINTS > mp = st_multipoint(cbind(runif(100), runif(100))) > grid.newpage() > pushViewport(st_viewport(mp)) > grid.draw(st_as_grob(mp, gp = gpar(fill = 'red'))) > > # LINESTRING > ls = st_linestring(cbind(1:10, rnorm(10))) > grid.newpage() > pushViewport(st_viewport(ls)) > grid.draw(st_as_grob(ls, gp = gpar(fill = 'red'))) > > # MULTILINESTRING > ls = st_multilinestring(list(cbind(1:10, 5+rnorm(10)), cbind(1:10, rnorm(10)), cbind(1:10, -5+rnorm(10)))) > grid.newpage() > pushViewport(st_viewport(ls)) > grid.draw(st_as_grob(ls, gp = gpar(fill = 'red'))) > > if (require(sp, quietly = TRUE)) { + # POINTS, right aspect in Long/Lat: + meuse_ll = st_transform(meuse_sf, 4326) + grid.newpage() + pushViewport(st_viewport(meuse_ll)) + invisible(lapply(st_geometry(meuse_ll), + function(x) grid.draw(st_as_grob(x, gp = gpar(fill = 'red'))))) + + # WRONG aspect: + st_crs(meuse_ll) = NA + grid.newpage() + pushViewport(st_viewport(meuse_ll)) + invisible(lapply(st_geometry(meuse_ll), + function(x) grid.draw(st_as_grob(x, gp = gpar(fill = 'red'))))) + } > > gc = st_geometrycollection(list(st_point(0:1), st_linestring(matrix(1:4,2)))) > grb = st_as_grob(gc) > > proc.time() user system elapsed 0.90 0.15 1.04 ================================================ FILE: tests/maps.R ================================================ suppressPackageStartupMessages(library(sf)) if (require(maps, quietly = TRUE)) { m = map(xlim = c(4,9), ylim = c(48,55), fill = TRUE, plot = FALSE) st_as_sf(m) m = map(xlim = c(4,9), ylim = c(48,55), plot = FALSE) st_as_sf(m, fill = FALSE) st_as_sf(map(), fill = FALSE) st_as_sf(map(fill = TRUE)) st_as_sf(map(), fill = FALSE, group = FALSE) st_as_sf(map(fill = TRUE), group = FALSE) } ================================================ FILE: tests/maps.Rout.save ================================================ R Under development (unstable) (2025-11-05 r88988 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > suppressPackageStartupMessages(library(sf)) > > if (require(maps, quietly = TRUE)) { + m = map(xlim = c(4,9), ylim = c(48,55), fill = TRUE, plot = FALSE) + st_as_sf(m) + m = map(xlim = c(4,9), ylim = c(48,55), plot = FALSE) + st_as_sf(m, fill = FALSE) + st_as_sf(map(), fill = FALSE) + st_as_sf(map(fill = TRUE)) + st_as_sf(map(), fill = FALSE, group = FALSE) + st_as_sf(map(fill = TRUE), group = FALSE) + } Simple feature collection with 1627 features and 1 field Geometry type: MULTIPOLYGON Dimension: XY Bounding box: xmin: -180 ymin: -85.19218 xmax: 190.2708 ymax: 83.59961 Geodetic CRS: +proj=longlat +ellps=clrk66 +no_defs +type=crs First 10 features: ID Aruba Aruba Afghanistan Afghanistan Angola Angola Angola:Cabinda Angola:Cabinda Anguilla Anguilla Albania Albania Finland:Aland Islands:Foglo Finland:Aland Islands:Foglo Finland:Aland Islands:Eckero Finland:Aland Islands:Eckero Finland:Aland Islands:Fasta Aland Finland:Aland Islands:Fasta Aland Andorra Andorra geom Aruba MULTIPOLYGON (((-69.89912 1... Afghanistan MULTIPOLYGON (((74.89131 37... Angola MULTIPOLYGON (((23.9665 -10... Angola:Cabinda MULTIPOLYGON (((12.21367 -5... Anguilla MULTIPOLYGON (((-63.00122 1... Albania MULTIPOLYGON (((20.06396 42... Finland:Aland Islands:Foglo MULTIPOLYGON (((20.61133 60... Finland:Aland Islands:Eckero MULTIPOLYGON (((19.6623 60.... Finland:Aland Islands:Fasta Aland MULTIPOLYGON (((19.98955 60... Andorra MULTIPOLYGON (((1.706055 42... > > proc.time() user system elapsed 1.28 0.18 1.45 ================================================ FILE: tests/plot.R ================================================ suppressPackageStartupMessages(library(sf)) options(rgdal_show_exportToProj4_warnings = "none") if (require(dplyr, quietly = TRUE)) { # plot linestrings: l1 = st_linestring(matrix(runif(6)-0.5,,2)) l2 = st_linestring(matrix(runif(6)-0.5,,2)) l3 = st_linestring(matrix(runif(6)-0.5,,2)) s = st_sf(a=2:4, b=st_sfc(l1,l2,l3)) plot(s, col = s$a, axes = FALSE) plot(s, col = s$a) if (suppressPackageStartupMessages(require(sp, quietly = TRUE))) { attr(s$b, "proj4string") = sp::CRS("+proj=longlat +ellps=WGS84 +no_defs")@projargs } plot(s, col = s$a, axes = TRUE) plot(s, col = s$a, lty = s$a, lwd = s$a, pch = s$a, type = 'b') l4 = st_linestring(matrix(runif(6),,2)) plot(st_sf(a=1,b=st_sfc(l4)), add = TRUE) # plot multilinestrings: ml1 = st_multilinestring(list(l1, l2)) ml2 = st_multilinestring(list(l3, l4)) ml = st_sf(a = 2:3, b = st_sfc(ml1, ml2)) plot(ml, col = ml$a, lty = ml$a, lwd = ml$a, pch = ml$a, type = 'b') # plot points: p1 = st_point(c(1,2)) p2 = st_point(c(3,3)) p3 = st_point(c(3,0)) p = st_sf(a=2:4, b=st_sfc(p1,p2,p3)) plot(p, col = s$a, axes = TRUE) plot(p, col = s$a) plot(p, col = p$a, pch = p$a, cex = p$a, bg = s$a, lwd = 2, lty = 2, type = 'b') p4 = st_point(c(2,2)) plot(st_sf(a=1, st_sfc(p4)), add = TRUE) # multipoints: mp1 = st_multipoint(matrix(1:4,2)) mp2 = st_multipoint(matrix(5:8,2)) mp = st_sf(a = 2:3, b = st_sfc(mp1, mp2)) plot(mp) plot(mp, col = mp$a, pch = mp$a, cex = mp$a, bg = mp$a, lwd = mp$a, lty = mp$a, type = 'b') # polygon: outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) pl1 = st_polygon(list(outer, hole1, hole2)) pl2 = st_polygon(list(outer+10, hole1+10, hole2+10)) po = st_sf(a = 2:3, st_sfc(pl1,pl2)) plot(po, col = po$a, border = rev(po$a), lwd=3) # multipolygon r10 = matrix(rep(c(0,10),each=5),5) pl1 = list(outer, hole1, hole2) pl2 = list(outer+10, hole1+10, hole2+10) pl3 = list(outer+r10, hole1+r10, hole2+r10) mpo1 = st_multipolygon(list(pl1,pl2)) mpo2 = st_multipolygon(list(pl3)) mpo = st_sf(a=2:3, b=st_sfc(mpo1,mpo2)) plot(mpo, col = mpo$a, border = rev(mpo$a), lwd = 2) # geometrycollection: gc1 = st_geometrycollection(list(mpo1, st_point(c(21,21)), l1 * 2 + 21)) gc2 = st_geometrycollection(list(mpo2, l2 - 2, l3 - 2, st_point(c(-1,-1)))) gc = st_sf(a=2:3, b = st_sfc(gc1,gc2)) plot(gc, cex = gc$a, col = gc$a, border = rev(gc$a) + 2, lwd = 2) plot(gc1) plot(st_sfc(mp1, mpo1)) # color ramp nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) plot(nc) plot(nc, axes = TRUE) plot(nc, col="lightgrey") plot(st_centroid(nc), add = TRUE, col = 1) if ("geometry" %in% names(nc)) { nc |> select(geometry) |> plot() } nc$f = cut(nc[[1]], 5) plot(nc["f"], key.pos = 1) plot(nc[1], key.pos = 1) # test background map plotting: load("bgmap.rda") merc = st_crs(3857) WGS84 = st_crs(4326) nc = st_transform(nc, WGS84) ## ggmap: #library(ggmap) #bgMap = get_map(unname(st_bbox(nc)), source = "google", zoom = 8) plot(st_transform(nc[1], merc), bgMap = bgMap) # RgoogleMaps: #library(RgoogleMaps) #center = c(mean(st_bbox(nc)[c(2,4)]), mean(st_bbox(nc)[c(1,3)])) #g = GetMap(center=center, zoom=6) # google par(mar = c(0,0,1,0)) plot(st_transform(nc, merc), bgMap = g) m = st_make_grid() st_crs(m) = NA_crs_ m = st_segmentize(m, 2) st_crs(m) = 4326 plot(m, axes = TRUE) g = st_transform(m, st_crs("+proj=ortho +lat_0=30 +lon_0=45"), check = TRUE) plot(g, axes = TRUE) nc[[1]] = NA nc[[10]] = 1 plot(nc, pal = rainbow, nbreaks = 3) plot(nc, pal = rainbow, breaks = "jenks", nbreaks = 3) plot(nc, pal = rainbow, breaks = (0:10)/3) # logz: nc$e = 10^(nc$SID74) plot(nc["e"], logz = TRUE) # shared key: plot(nc[c("SID74", "SID79")], key.pos = -1) plot(nc[c("BIR74", "BIR79")], key.pos = 1, logz=TRUE) } ================================================ FILE: tests/plot.Rout.save ================================================ R version 4.5.2 (2025-10-31) -- "[Not] Part in a Rumble" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > suppressPackageStartupMessages(library(sf)) > options(rgdal_show_exportToProj4_warnings = "none") > > if (require(dplyr, quietly = TRUE)) { + + # plot linestrings: + l1 = st_linestring(matrix(runif(6)-0.5,,2)) + l2 = st_linestring(matrix(runif(6)-0.5,,2)) + l3 = st_linestring(matrix(runif(6)-0.5,,2)) + s = st_sf(a=2:4, b=st_sfc(l1,l2,l3)) + plot(s, col = s$a, axes = FALSE) + plot(s, col = s$a) + if (suppressPackageStartupMessages(require(sp, quietly = TRUE))) { + attr(s$b, "proj4string") = sp::CRS("+proj=longlat +ellps=WGS84 +no_defs")@projargs + } + plot(s, col = s$a, axes = TRUE) + plot(s, col = s$a, lty = s$a, lwd = s$a, pch = s$a, type = 'b') + l4 = st_linestring(matrix(runif(6),,2)) + plot(st_sf(a=1,b=st_sfc(l4)), add = TRUE) + # plot multilinestrings: + ml1 = st_multilinestring(list(l1, l2)) + ml2 = st_multilinestring(list(l3, l4)) + ml = st_sf(a = 2:3, b = st_sfc(ml1, ml2)) + plot(ml, col = ml$a, lty = ml$a, lwd = ml$a, pch = ml$a, type = 'b') + # plot points: + p1 = st_point(c(1,2)) + p2 = st_point(c(3,3)) + p3 = st_point(c(3,0)) + p = st_sf(a=2:4, b=st_sfc(p1,p2,p3)) + plot(p, col = s$a, axes = TRUE) + plot(p, col = s$a) + plot(p, col = p$a, pch = p$a, cex = p$a, bg = s$a, lwd = 2, lty = 2, type = 'b') + p4 = st_point(c(2,2)) + plot(st_sf(a=1, st_sfc(p4)), add = TRUE) + # multipoints: + mp1 = st_multipoint(matrix(1:4,2)) + mp2 = st_multipoint(matrix(5:8,2)) + mp = st_sf(a = 2:3, b = st_sfc(mp1, mp2)) + plot(mp) + plot(mp, col = mp$a, pch = mp$a, cex = mp$a, bg = mp$a, lwd = mp$a, lty = mp$a, type = 'b') + # polygon: + outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) + hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) + hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) + pl1 = st_polygon(list(outer, hole1, hole2)) + pl2 = st_polygon(list(outer+10, hole1+10, hole2+10)) + po = st_sf(a = 2:3, st_sfc(pl1,pl2)) + plot(po, col = po$a, border = rev(po$a), lwd=3) + # multipolygon + r10 = matrix(rep(c(0,10),each=5),5) + pl1 = list(outer, hole1, hole2) + pl2 = list(outer+10, hole1+10, hole2+10) + pl3 = list(outer+r10, hole1+r10, hole2+r10) + mpo1 = st_multipolygon(list(pl1,pl2)) + mpo2 = st_multipolygon(list(pl3)) + mpo = st_sf(a=2:3, b=st_sfc(mpo1,mpo2)) + plot(mpo, col = mpo$a, border = rev(mpo$a), lwd = 2) + # geometrycollection: + gc1 = st_geometrycollection(list(mpo1, st_point(c(21,21)), l1 * 2 + 21)) + gc2 = st_geometrycollection(list(mpo2, l2 - 2, l3 - 2, st_point(c(-1,-1)))) + gc = st_sf(a=2:3, b = st_sfc(gc1,gc2)) + plot(gc, cex = gc$a, col = gc$a, border = rev(gc$a) + 2, lwd = 2) + + plot(gc1) + + plot(st_sfc(mp1, mpo1)) + + # color ramp + nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) + plot(nc) + plot(nc, axes = TRUE) + plot(nc, col="lightgrey") + plot(st_centroid(nc), add = TRUE, col = 1) + if ("geometry" %in% names(nc)) { + nc |> + select(geometry) |> + plot() + } + + nc$f = cut(nc[[1]], 5) + plot(nc["f"], key.pos = 1) + plot(nc[1], key.pos = 1) + + # test background map plotting: + load("bgmap.rda") + merc = st_crs(3857) + WGS84 = st_crs(4326) + nc = st_transform(nc, WGS84) + ## ggmap: + #library(ggmap) + #bgMap = get_map(unname(st_bbox(nc)), source = "google", zoom = 8) + plot(st_transform(nc[1], merc), bgMap = bgMap) + + # RgoogleMaps: + #library(RgoogleMaps) + #center = c(mean(st_bbox(nc)[c(2,4)]), mean(st_bbox(nc)[c(1,3)])) + #g = GetMap(center=center, zoom=6) # google + par(mar = c(0,0,1,0)) + plot(st_transform(nc, merc), bgMap = g) + + m = st_make_grid() + st_crs(m) = NA_crs_ + m = st_segmentize(m, 2) + st_crs(m) = 4326 + plot(m, axes = TRUE) + g = st_transform(m, st_crs("+proj=ortho +lat_0=30 +lon_0=45"), check = TRUE) + plot(g, axes = TRUE) + + nc[[1]] = NA + nc[[10]] = 1 + plot(nc, pal = rainbow, nbreaks = 3) + plot(nc, pal = rainbow, breaks = "jenks", nbreaks = 3) + plot(nc, pal = rainbow, breaks = (0:10)/3) + + # logz: + nc$e = 10^(nc$SID74) + plot(nc["e"], logz = TRUE) + + # shared key: + plot(nc[c("SID74", "SID79")], key.pos = -1) + plot(nc[c("BIR74", "BIR79")], key.pos = 1, logz=TRUE) + } Attaching package: 'dplyr' The following objects are masked from 'package:stats': filter, lag The following objects are masked from 'package:base': intersect, setdiff, setequal, union There were 13 warnings (use warnings() to see them) > > proc.time() user system elapsed 3.065 1.396 3.020 ================================================ FILE: tests/read.R ================================================ Sys.setenv(TZ="UTC") suppressPackageStartupMessages(library(sf)) if ("GPKG" %in% st_drivers()$name) { tst = st_read(system.file("gpkg/nc.gpkg", package="sf"), "nc.gpkg", crs = 4267, quiet = TRUE) tst = st_read(system.file("gpkg/nc.gpkg", package="sf"), quiet = TRUE) # default layer name } tst = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) # no layer specified # data from https://github.com/edzer/sfr/issues/6 tst = st_read(system.file("shape/storms_xyz.shp", package="sf"), quiet = TRUE) class(st_geometry(tst)) class(st_geometry(tst)[[1]]) tst = st_read(system.file("shape/storms_xyzm.shp", package="sf"), quiet = TRUE) class(st_geometry(tst)) class(st_geometry(tst)[[1]]) tst = st_read(system.file("shape/storms_xyz_feature.shp", package="sf"), quiet = TRUE) class(st_geometry(tst)) class(st_geometry(tst)[[1]]) tst = st_read(system.file("shape/storms_xyzm_feature.shp", package="sf"), quiet = TRUE) class(st_geometry(tst)) class(st_geometry(tst)[[1]]) if ("GPKG" %in% st_drivers()$name) { # read Int64 print(st_read(system.file("gpkg/tl.gpkg", package="sf"), quiet = TRUE)$AWATER) print(st_read(system.file("gpkg/tl.gpkg", package="sf"), quiet = TRUE, int64_as_string = TRUE)$AWATER) } # see https://github.com/edzer/sfr/issues/45 : if ("OSM" %in% st_drivers()$name && Sys.info()['sysname'] != "Darwin") { osm = system.file("osm/overpass.osm", package="sf") osm_l = st_layers(osm) osm_lc = suppressWarnings(st_layers(osm, do_count = TRUE)) osm_r = suppressWarnings(st_read(osm, "multipolygons", quiet = TRUE)) } # layer opening option: st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE, options = c("ADJUST_TYPE=YES", "ENCODING=CPL_ENC_UTF8")) x <- st_sf(a = 1:2, geom = st_sfc(st_point(0:1), st_multipoint(matrix(1:4,2,2)))) try(st_layers("foo")) # cannot open datasource try(st_read("foo")) # cannot open datasource try(st_read("x.gpkg", "xyz")) # cannot open layer try(st_write(c("foo", "bar"))) try(st_write(x, c("foo", "bar"))) try(st_write(x, "foo", driver = "foo")) if (Sys.getenv("USER") == "travis") { try(st_write(x, "/x", driver = "ESRI Shapefile")) st_write(x, "xxx.gpkg") st_write(x, "xxx.gpkg", append = TRUE, quiet = FALSE) # appends to layer y <- st_sf(b = 1:2, geom = st_sfc(st_point(0:1), st_multipoint(matrix(1:4,2,2)))) try(st_write(y, "xxx.gpkg")) } geom = st_sfc(st_point(0:1), st_multipoint(matrix(1:4,2,2))) st_write(geom, "geom.gpkg") st_write(geom, "geom1.gpkg", layer = "foo") df <- data.frame( a = c(0, 1, NA, -Inf, Inf), b = c("a", "b", NA, "c", ""), c = c(as.Date("2001-01-01"), as.Date(c(NA, -99, 0, 1), origin = "1970-01-01")), d = c(as.POSIXct("2001-01-01"), as.POSIXct(c(NA, -99, 0, 1), origin = "1970-01-01")), x = 1:5, y = 1:5) x = st_as_sf(df, coords = c("x", "y")) if ("GPKG" %in% st_drivers()$name) { st_write(x, "x2.gpkg", quiet = TRUE) y = st_read("x2.gpkg", quiet = TRUE) print(y) } if ("SQLite" %in% st_drivers()$name && require(RSQLite)) { db = system.file("sqlite/meuse.sqlite", package = "sf") dbcon <- dbConnect(dbDriver("SQLite"), db) m = dbReadTable(dbcon, "meuse.sqlite") m$GEOMETRY = st_as_sfc(m$GEOMETRY, spatialite = FALSE) # ISO wkb print(st_sf(m), n = 3) # or: (s = st_read(dbcon, "meuse.sqlite"))[1:3,] dbDisconnect(dbcon) db = system.file("sqlite/nc.sqlite", package = "sf") dbcon <- dbConnect(dbDriver("SQLite"), db) m = dbReadTable(dbcon, "nc.sqlite") m$GEOMETRY = st_as_sfc(m$GEOMETRY, spatialite = FALSE) # ISO wkb print(st_sf(m), n = 3) dbDisconnect(dbcon) db = system.file("sqlite/b.sqlite", package = "sf") # has an INT8 field b = st_read(db, quiet = TRUE) print(b) b = st_read(db, int64_as_string = TRUE, quiet = TRUE) print(b) if (.Platform$endian == "little") { db = system.file("sqlite/test3.sqlite", package = "sf") dbcon <- dbConnect(dbDriver("SQLite"), db) m = dbReadTable(dbcon, "HighWays") m$Geometry = st_as_sfc(m$Geometry, spatialite = TRUE) # spatialite wkb print(st_sf(m), n = 1) m = dbReadTable(dbcon, "Towns") m$Geometry = st_as_sfc(m$Geometry, spatialite = TRUE) # spatialite wkb print(st_sf(m), n = 1) m = dbReadTable(dbcon, "Regions") m$Geometry = st_as_sfc(m$Geometry, spatialite = TRUE) # spatialite wkb print(st_sf(m), n = 1) } } csv = system.file("csv/pt.csv", package = "sf") identical(st_read(quiet = TRUE, csv, options = "AUTODETECT_TYPE=Yes")$Int64[3], NA_real_) identical(st_read(quiet = TRUE, csv, int64_as_string = TRUE, stringsAsFactors = FALSE, options = "AUTODETECT_TYPE=Yes")$Int64[3], NA_character_) identical(st_read(quiet = TRUE, csv, options = "AUTODETECT_TYPE=Yes")$Int32[3], NA_integer_) if ("GML" %in% st_drivers()$name) { gml = system.file("gml/fmi_test.gml", package = "sf") print(dim(st_read(gml, quiet = TRUE, use_stream = FALSE))) gml = system.file("gml/20170930_OB_530964_UKSH.xml.gz", package = "sf") print(dim(st_read(gml, layer = "Parcely", quiet = TRUE, use_stream = FALSE))) print(dim(st_read(gml, layer = "Parcely", int64_as_string=TRUE, quiet = TRUE, use_stream = FALSE))) } # logical: if ("GPKG" %in% st_drivers()$name) { tst = read_sf(system.file("gpkg/nc.gpkg", package="sf"), quiet = TRUE) # default layer name tst$bool = tst$NWBIR79 > 800 # logical tst$bool[1:3] = NA write_sf(tst, "tst__.gpkg") tst2 = read_sf("tst__.gpkg") stopifnot(identical(tst$bool, tst2$bool)) } # spatial filter: nc = read_sf(system.file("gpkg/nc.gpkg", package="sf")) wkt = st_as_text(st_geometry(nc[1,])) wkt nc_filtered = read_sf(system.file("gpkg/nc.gpkg", package="sf"), wkt_filter = wkt) try(read_sf(system.file("gpkg/nc.gpkg", package="sf"), wkt_filter = "wrong")) nc_filtered$NAME ================================================ FILE: tests/read.Rout.save ================================================ R Under development (unstable) (2025-11-05 r88988 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > Sys.setenv(TZ="UTC") > suppressPackageStartupMessages(library(sf)) > if ("GPKG" %in% st_drivers()$name) { + tst = st_read(system.file("gpkg/nc.gpkg", package="sf"), "nc.gpkg", crs = 4267, quiet = TRUE) + tst = st_read(system.file("gpkg/nc.gpkg", package="sf"), quiet = TRUE) # default layer name + } > > tst = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) # no layer specified > > # data from https://github.com/edzer/sfr/issues/6 > tst = st_read(system.file("shape/storms_xyz.shp", package="sf"), quiet = TRUE) > class(st_geometry(tst)) [1] "sfc_LINESTRING" "sfc" > class(st_geometry(tst)[[1]]) [1] "XYZ" "LINESTRING" "sfg" > tst = st_read(system.file("shape/storms_xyzm.shp", package="sf"), quiet = TRUE) > class(st_geometry(tst)) [1] "sfc_LINESTRING" "sfc" > class(st_geometry(tst)[[1]]) [1] "XYM" "LINESTRING" "sfg" > tst = st_read(system.file("shape/storms_xyz_feature.shp", package="sf"), quiet = TRUE) > class(st_geometry(tst)) [1] "sfc_LINESTRING" "sfc" > class(st_geometry(tst)[[1]]) [1] "XYZ" "LINESTRING" "sfg" > tst = st_read(system.file("shape/storms_xyzm_feature.shp", package="sf"), quiet = TRUE) > class(st_geometry(tst)) [1] "sfc_LINESTRING" "sfc" > class(st_geometry(tst)[[1]]) [1] "XYM" "LINESTRING" "sfg" > > if ("GPKG" %in% st_drivers()$name) { # read Int64 + print(st_read(system.file("gpkg/tl.gpkg", package="sf"), quiet = TRUE)$AWATER) + print(st_read(system.file("gpkg/tl.gpkg", package="sf"), quiet = TRUE, int64_as_string = TRUE)$AWATER) + } [1] 1028678842 [1] "1028678842" > > # see https://github.com/edzer/sfr/issues/45 : > if ("OSM" %in% st_drivers()$name && Sys.info()['sysname'] != "Darwin") { + osm = system.file("osm/overpass.osm", package="sf") + osm_l = st_layers(osm) + osm_lc = suppressWarnings(st_layers(osm, do_count = TRUE)) + osm_r = suppressWarnings(st_read(osm, "multipolygons", quiet = TRUE)) + } > > # layer opening option: > st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE, + options = c("ADJUST_TYPE=YES", "ENCODING=CPL_ENC_UTF8")) Simple feature collection with 100 features and 14 fields Geometry type: MULTIPOLYGON Dimension: XY Bounding box: xmin: -84.32385 ymin: 33.88199 xmax: -75.45698 ymax: 36.58965 Geodetic CRS: NAD27 First 10 features: AREA PERIMETER CNTY_ CNTY_ID NAME FIPS FIPSNO CRESS_ID BIR74 SID74 1 0.114 1.442 1825 1825 Ashe 37009 37009 5 1091 1 2 0.061 1.231 1827 1827 Alleghany 37005 37005 3 487 0 3 0.143 1.630 1828 1828 Surry 37171 37171 86 3188 5 4 0.070 2.968 1831 1831 Currituck 37053 37053 27 508 1 5 0.153 2.206 1832 1832 Northampton 37131 37131 66 1421 9 6 0.097 1.670 1833 1833 Hertford 37091 37091 46 1452 7 7 0.062 1.547 1834 1834 Camden 37029 37029 15 286 0 8 0.091 1.284 1835 1835 Gates 37073 37073 37 420 0 9 0.118 1.421 1836 1836 Warren 37185 37185 93 968 4 10 0.124 1.428 1837 1837 Stokes 37169 37169 85 1612 1 NWBIR74 BIR79 SID79 NWBIR79 geometry 1 10 1364 0 19 MULTIPOLYGON (((-81.47276 3... 2 10 542 3 12 MULTIPOLYGON (((-81.23989 3... 3 208 3616 6 260 MULTIPOLYGON (((-80.45634 3... 4 123 830 2 145 MULTIPOLYGON (((-76.00897 3... 5 1066 1606 3 1197 MULTIPOLYGON (((-77.21767 3... 6 954 1838 5 1237 MULTIPOLYGON (((-76.74506 3... 7 115 350 2 139 MULTIPOLYGON (((-76.00897 3... 8 254 594 2 371 MULTIPOLYGON (((-76.56251 3... 9 748 1190 2 844 MULTIPOLYGON (((-78.30876 3... 10 160 2038 5 176 MULTIPOLYGON (((-80.02567 3... > > x <- st_sf(a = 1:2, geom = st_sfc(st_point(0:1), st_multipoint(matrix(1:4,2,2)))) > > try(st_layers("foo")) # cannot open datasource Cannot open data source foo Error : Open failed. > try(st_read("foo")) # cannot open datasource Error : Cannot open "foo"; The file doesn't seem to exist. > try(st_read("x.gpkg", "xyz")) # cannot open layer Error : Cannot open "x.gpkg"; The file doesn't seem to exist. > try(st_write(c("foo", "bar"))) Error in UseMethod("st_write") : no applicable method for 'st_write' applied to an object of class "character" > try(st_write(x, c("foo", "bar"))) writing: substituting ENGCRS["Undefined Cartesian SRS with unknown unit"] for missing CRS Error in guess_driver(dns) : length(dsn) == 1 is not TRUE > try(st_write(x, "foo", driver = "foo")) writing: substituting ENGCRS["Undefined Cartesian SRS with unknown unit"] for missing CRS driver `foo' not available. Error : Driver not available. > if (Sys.getenv("USER") == "travis") { + try(st_write(x, "/x", driver = "ESRI Shapefile")) + st_write(x, "xxx.gpkg") + st_write(x, "xxx.gpkg", append = TRUE, quiet = FALSE) # appends to layer + y <- st_sf(b = 1:2, geom = st_sfc(st_point(0:1), st_multipoint(matrix(1:4,2,2)))) + try(st_write(y, "xxx.gpkg")) + } > > geom = st_sfc(st_point(0:1), st_multipoint(matrix(1:4,2,2))) > st_write(geom, "geom.gpkg") writing: substituting ENGCRS["Undefined Cartesian SRS with unknown unit"] for missing CRS Writing layer `geom' to data source `geom.gpkg' using driver `GPKG' Writing 2 features with 0 fields and geometry type Unknown (any). > st_write(geom, "geom1.gpkg", layer = "foo") writing: substituting ENGCRS["Undefined Cartesian SRS with unknown unit"] for missing CRS Writing layer `foo' to data source `geom1.gpkg' using driver `GPKG' Writing 2 features with 0 fields and geometry type Unknown (any). > > df <- data.frame( + a = c(0, 1, NA, -Inf, Inf), + b = c("a", "b", NA, "c", ""), + c = c(as.Date("2001-01-01"), + as.Date(c(NA, -99, 0, 1), origin = "1970-01-01")), + d = c(as.POSIXct("2001-01-01"), + as.POSIXct(c(NA, -99, 0, 1), origin = "1970-01-01")), + x = 1:5, + y = 1:5) > > x = st_as_sf(df, coords = c("x", "y")) > > if ("GPKG" %in% st_drivers()$name) { + st_write(x, "x2.gpkg", quiet = TRUE) + y = st_read("x2.gpkg", quiet = TRUE) + print(y) + } writing: substituting ENGCRS["Undefined Cartesian SRS with unknown unit"] for missing CRS Simple feature collection with 5 features and 4 fields Geometry type: POINT Dimension: XY Bounding box: xmin: 1 ymin: 1 xmax: 5 ymax: 5 Projected CRS: Undefined Cartesian SRS with unknown unit a b c d geom 1 0 a 2001-01-01 2001-01-01 00:00:00 POINT (1 1) 2 1 b POINT (2 2) 3 NA 1969-09-24 1969-12-31 23:58:21 POINT (3 3) 4 -Inf c 1970-01-01 1970-01-01 00:00:00 POINT (4 4) 5 Inf 1970-01-02 1970-01-01 00:00:01 POINT (5 5) > > if ("SQLite" %in% st_drivers()$name && require(RSQLite)) { + db = system.file("sqlite/meuse.sqlite", package = "sf") + dbcon <- dbConnect(dbDriver("SQLite"), db) + m = dbReadTable(dbcon, "meuse.sqlite") + m$GEOMETRY = st_as_sfc(m$GEOMETRY, spatialite = FALSE) # ISO wkb + print(st_sf(m), n = 3) + # or: + (s = st_read(dbcon, "meuse.sqlite"))[1:3,] + dbDisconnect(dbcon) + + db = system.file("sqlite/nc.sqlite", package = "sf") + dbcon <- dbConnect(dbDriver("SQLite"), db) + m = dbReadTable(dbcon, "nc.sqlite") + m$GEOMETRY = st_as_sfc(m$GEOMETRY, spatialite = FALSE) # ISO wkb + print(st_sf(m), n = 3) + dbDisconnect(dbcon) + + db = system.file("sqlite/b.sqlite", package = "sf") # has an INT8 field + b = st_read(db, quiet = TRUE) + print(b) + b = st_read(db, int64_as_string = TRUE, quiet = TRUE) + print(b) + + if (.Platform$endian == "little") { + db = system.file("sqlite/test3.sqlite", package = "sf") + dbcon <- dbConnect(dbDriver("SQLite"), db) + m = dbReadTable(dbcon, "HighWays") + m$Geometry = st_as_sfc(m$Geometry, spatialite = TRUE) # spatialite wkb + print(st_sf(m), n = 1) + m = dbReadTable(dbcon, "Towns") + m$Geometry = st_as_sfc(m$Geometry, spatialite = TRUE) # spatialite wkb + print(st_sf(m), n = 1) + m = dbReadTable(dbcon, "Regions") + m$Geometry = st_as_sfc(m$Geometry, spatialite = TRUE) # spatialite wkb + print(st_sf(m), n = 1) + } + } Loading required package: RSQLite Simple feature collection with 155 features and 13 fields Geometry type: POINT Dimension: XY Bounding box: xmin: 178605 ymin: 329714 xmax: 181390 ymax: 333611 CRS: NA First 3 features: ogc_fid cadmium copper lead zinc elev dist om ffreq soil lime 1 1 11.7 85 299 1022 7.909 0.00135803 13.6 1 1 1 2 2 8.6 81 277 1141 6.983 0.01222430 14.0 1 1 1 3 3 6.5 68 199 640 7.800 0.10302900 13.0 1 1 1 landuse dist.m GEOMETRY 1 Ah 50 POINT (181072 333611) 2 Ah 30 POINT (181025 333558) 3 Ah 150 POINT (181165 333537) Simple feature collection with 100 features and 15 fields Geometry type: MULTIPOLYGON Dimension: XY Bounding box: xmin: -84.32385 ymin: 33.88199 xmax: -75.45698 ymax: 36.58965 CRS: NA First 3 features: ogc_fid area perimeter cnty_ cnty_id name fips fipsno cress_id bir74 1 1 0.114 1.442 1825 1825 Ashe 37009 37009 5 1091 2 2 0.061 1.231 1827 1827 Alleghany 37005 37005 3 487 3 3 0.143 1.630 1828 1828 Surry 37171 37171 86 3188 sid74 nwbir74 bir79 sid79 nwbir79 GEOMETRY 1 1 10 1364 0 19 MULTIPOLYGON (((-81.47276 3... 2 0 10 542 3 12 MULTIPOLYGON (((-81.23989 3... 3 5 208 3616 6 260 MULTIPOLYGON (((-80.45634 3... Integer64 values larger than 9.0072e+15 lost significance after conversion to double; use argument int64_as_string = TRUE to import them lossless, as character Simple feature collection with 1 feature and 2 fields Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 1 xmax: 0 ymax: 1 CRS: NA a bigint GEOMETRY 1 1 4.611686e+18 POINT (0 1) Simple feature collection with 1 feature and 2 fields Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 1 xmax: 0 ymax: 1 CRS: NA a bigint GEOMETRY 1 1 4611686018427387904 POINT (0 1) Simple feature collection with 10 features and 2 fields Geometry type: LINESTRING Dimension: XY Bounding box: xmin: 645003 ymin: 4822568 xmax: 748805.6 ymax: 4992001 Projected CRS: WGS 84 / UTM zone 32N First 1 features: PK_UID Name Geometry 1 1 Unknown LINESTRING (668540.7 485826... Simple feature collection with 8101 features and 6 fields Geometry type: POINT Dimension: XY Bounding box: xmin: 319224 ymin: 3934674 xmax: 1308585 ymax: 5214373 Projected CRS: WGS 84 / UTM zone 32N First 1 features: PK_UID Name Peoples LocalCounc County Region Geometry 1 1 Brozolo 435 1 0 0 POINT (427002.8 4996361) Simple feature collection with 10 features and 2 fields Geometry type: MULTIPOLYGON Dimension: XY Bounding box: xmin: 378359.8 ymin: 4198234 xmax: 1211486 ymax: 5036803 Projected CRS: WGS 84 / UTM zone 32N First 1 features: PK_UID Name Geometry 1 1 VENETO MULTIPOLYGON (((752912.3 50... > > csv = system.file("csv/pt.csv", package = "sf") > identical(st_read(quiet = TRUE, csv, options = "AUTODETECT_TYPE=Yes")$Int64[3], NA_real_) [1] TRUE > identical(st_read(quiet = TRUE, csv, int64_as_string = TRUE, stringsAsFactors = FALSE, + options = "AUTODETECT_TYPE=Yes")$Int64[3], NA_character_) [1] TRUE > identical(st_read(quiet = TRUE, csv, options = "AUTODETECT_TYPE=Yes")$Int32[3], NA_integer_) [1] TRUE > > if ("GML" %in% st_drivers()$name) { + gml = system.file("gml/fmi_test.gml", package = "sf") + print(dim(st_read(gml, quiet = TRUE, use_stream = FALSE))) + gml = system.file("gml/20170930_OB_530964_UKSH.xml.gz", package = "sf") + print(dim(st_read(gml, layer = "Parcely", quiet = TRUE, use_stream = FALSE))) + print(dim(st_read(gml, layer = "Parcely", int64_as_string=TRUE, quiet = TRUE, use_stream = FALSE))) + } [1] 22 11 [1] 644 25 [1] 644 25 Warning messages: 1: In CPL_read_ogr(dsn, layer, query, as.character(options), quiet, : GDAL Message 1: Field with same name (identifier) already exists in (PointTimeSeriesObservation). Skipping newer ones 2: In CPL_read_ogr(dsn, layer, query, as.character(options), quiet, : GDAL Message 1: Field with same name (name) already exists in (PointTimeSeriesObservation). Skipping newer ones > > # logical: > if ("GPKG" %in% st_drivers()$name) { + tst = read_sf(system.file("gpkg/nc.gpkg", package="sf"), quiet = TRUE) # default layer name + tst$bool = tst$NWBIR79 > 800 # logical + tst$bool[1:3] = NA + write_sf(tst, "tst__.gpkg") + tst2 = read_sf("tst__.gpkg") + stopifnot(identical(tst$bool, tst2$bool)) + } > > # spatial filter: > nc = read_sf(system.file("gpkg/nc.gpkg", package="sf")) > wkt = st_as_text(st_geometry(nc[1,])) > wkt [1] "MULTIPOLYGON (((-81.47276 36.23436, -81.54084 36.27251, -81.56198 36.27359, -81.63306 36.34069, -81.74107 36.39178, -81.69828 36.47178, -81.7028 36.51934, -81.67 36.58965, -81.3453 36.57286, -81.34754 36.53791, -81.32478 36.51368, -81.31332 36.4807, -81.26624 36.43721, -81.26284 36.40504, -81.24069 36.37942, -81.23989 36.36536, -81.26424 36.35241, -81.32899 36.3635, -81.36137 36.35316, -81.36569 36.33905, -81.35413 36.29972, -81.36745 36.2787, -81.40639 36.28505, -81.41233 36.26729, -81.43104 36.26072, -81.45289 36.23959, -81.47276 36.23436)))" > nc_filtered = read_sf(system.file("gpkg/nc.gpkg", package="sf"), wkt_filter = wkt) > try(read_sf(system.file("gpkg/nc.gpkg", package="sf"), wkt_filter = "wrong")) Cannot create geometry from: wrong Error : wkt parse error. > nc_filtered$NAME [1] "Watauga" "Ashe" "Wilkes" "Alleghany" > > proc.time() user system elapsed 1.46 0.46 1.92 ================================================ FILE: tests/roundtrip.R ================================================ #library(rgdal2) #openOGRLayer("PG:dbname=postgis" , "meuse2") suppressPackageStartupMessages(library(sf)) options(rgdal_show_exportToProj4_warnings = "none") outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) pol1 = list(outer, hole1, hole2) pol2 = list(outer + 12, hole1 + 12) pol3 = list(outer + 24) mp = list(pol1,pol2,pol3) mp1 = st_multipolygon(mp) sf = st_sf(a=1, st_sfc(mp1)) if (suppressPackageStartupMessages(require(sp, quietly = TRUE))) { a = as(sf, "Spatial") print(class(a)) b = st_as_sf(a) a2 = as(a, "SpatialPolygonsDataFrame") print(all.equal(a, a2)) # round-trip b1 = as(a, "sf") print(all.equal(b, b1)) b = st_as_sfc(a) b1 = as(a, "sfc") print(all.equal(b, b1)) } # SpatialMultiPoints if (require(sp, quietly = TRUE)) { suppressWarnings(RNGversion("3.5.3")) set.seed(1331) # example(SpatialMultiPoints, ask = FALSE, echo = FALSE) # loads mpdf cl1 = cbind(rnorm(3, 10), rnorm(3, 10)) cl2 = cbind(rnorm(5, 10), rnorm(5, 0)) cl3 = cbind(rnorm(7, 0), rnorm(7, 10)) mpdf = SpatialMultiPointsDataFrame(list(a=cl1, b=cl2, c=cl3), data.frame(a = 1:3, row.names=c("a", "b", "c"))) m = st_as_sf(mpdf) all.equal(as(m, "Spatial"), mpdf) # TRUE demo(meuse, ask = FALSE, echo = FALSE) #meuse = spTransform(meuse, CRS("+proj=longlat +ellps=WGS84 +no_defs")) pol.grd = as(meuse.grid, "SpatialPolygonsDataFrame") #meuse.grd = spTransform(meuse.grid, CRS("+proj=longlat +ellps=WGS84 +no_defs")) #pol.grd = spTransform(pol.grd, CRS("+proj=longlat +ellps=WGS84 +no_defs")) #meuse.area = spTransform(meuse.area, CRS("+proj=longlat +ellps=WGS84 +no_defs")) #meuse.riv = spTransform(meuse.riv, CRS("+proj=longlat +ellps=WGS84 +no_defs")) #summary(st_as_sf(meuse)) #summary(st_as_sf(meuse.grd)) #x <- st_as_sf(meuse.grid) # don't print: CRS variations. #summary(st_as_sf(meuse.area)) #summary(st_as_sf(meuse.riv)) #summary(st_as_sf(as(meuse.riv, "SpatialLines"))) #summary(st_as_sf(pol.grd)) #summary(st_as_sf(as(pol.grd, "SpatialLinesDataFrame"))) nc = st_read(system.file("gpkg/nc.gpkg", package="sf"), "nc.gpkg", quiet = TRUE) all.equal(nc, st_as_sf(as(nc, "Spatial"))) st_crs(nc) == st_crs(st_as_sf(as(nc, "Spatial"))) detach("package:sp") } ================================================ FILE: tests/roundtrip.Rout.save ================================================ R Under development (unstable) (2025-11-05 r88988 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > #library(rgdal2) > #openOGRLayer("PG:dbname=postgis" , "meuse2") > > suppressPackageStartupMessages(library(sf)) > options(rgdal_show_exportToProj4_warnings = "none") > outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) > hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) > hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) > pol1 = list(outer, hole1, hole2) > pol2 = list(outer + 12, hole1 + 12) > pol3 = list(outer + 24) > mp = list(pol1,pol2,pol3) > mp1 = st_multipolygon(mp) > sf = st_sf(a=1, st_sfc(mp1)) > if (suppressPackageStartupMessages(require(sp, quietly = TRUE))) { + a = as(sf, "Spatial") + print(class(a)) + b = st_as_sf(a) + a2 = as(a, "SpatialPolygonsDataFrame") + print(all.equal(a, a2)) # round-trip + + b1 = as(a, "sf") + print(all.equal(b, b1)) + b = st_as_sfc(a) + b1 = as(a, "sfc") + print(all.equal(b, b1)) + } [1] "SpatialPolygonsDataFrame" attr(,"package") [1] "sp" [1] TRUE [1] TRUE [1] TRUE > > # SpatialMultiPoints > if (require(sp, quietly = TRUE)) { + suppressWarnings(RNGversion("3.5.3")) + set.seed(1331) + # example(SpatialMultiPoints, ask = FALSE, echo = FALSE) # loads mpdf + cl1 = cbind(rnorm(3, 10), rnorm(3, 10)) + cl2 = cbind(rnorm(5, 10), rnorm(5, 0)) + cl3 = cbind(rnorm(7, 0), rnorm(7, 10)) + mpdf = SpatialMultiPointsDataFrame(list(a=cl1, b=cl2, c=cl3), data.frame(a = 1:3, row.names=c("a", "b", "c"))) + m = st_as_sf(mpdf) + all.equal(as(m, "Spatial"), mpdf) # TRUE + + demo(meuse, ask = FALSE, echo = FALSE) + #meuse = spTransform(meuse, CRS("+proj=longlat +ellps=WGS84 +no_defs")) + pol.grd = as(meuse.grid, "SpatialPolygonsDataFrame") + #meuse.grd = spTransform(meuse.grid, CRS("+proj=longlat +ellps=WGS84 +no_defs")) + #pol.grd = spTransform(pol.grd, CRS("+proj=longlat +ellps=WGS84 +no_defs")) + #meuse.area = spTransform(meuse.area, CRS("+proj=longlat +ellps=WGS84 +no_defs")) + #meuse.riv = spTransform(meuse.riv, CRS("+proj=longlat +ellps=WGS84 +no_defs")) + #summary(st_as_sf(meuse)) + #summary(st_as_sf(meuse.grd)) + #x <- st_as_sf(meuse.grid) # don't print: CRS variations. + #summary(st_as_sf(meuse.area)) + #summary(st_as_sf(meuse.riv)) + #summary(st_as_sf(as(meuse.riv, "SpatialLines"))) + #summary(st_as_sf(pol.grd)) + #summary(st_as_sf(as(pol.grd, "SpatialLinesDataFrame"))) + + nc = st_read(system.file("gpkg/nc.gpkg", package="sf"), "nc.gpkg", quiet = TRUE) + all.equal(nc, st_as_sf(as(nc, "Spatial"))) + st_crs(nc) == st_crs(st_as_sf(as(nc, "Spatial"))) + + detach("package:sp") + } > > proc.time() user system elapsed 1.10 0.12 1.21 ================================================ FILE: tests/s2.R ================================================ suppressPackageStartupMessages(library(sf)) d = data.frame(z = 1:100, x = runif(100), y = runif(100)) n0 = st_as_sf(d, coords = c("x", "y"), crs = 4326) n1 = st_transform(n0, 3857) # st_nearest_points cp1 = st_nearest_points(n0[1:50,], n0[51:100,]) cp2 = st_transform(st_nearest_points(n1[1:50,], n1[51:100,]), 4326) length(cp1) all.equal(cp1, cp2) # st_nearest_points, pairwise cp1 = st_nearest_points(n0[1:50,], n0[51:100,], pairwise = TRUE) cp2 = st_transform(st_nearest_points(n1[1:50,], n1[51:100,], pairwise = TRUE), 4326) length(cp1) all.equal(cp1, cp2) if (compareVersion(sf_extSoftVersion()["GEOS"], "3.6.1") > -1) { # st_nearest_feature nf1 = st_nearest_feature(n0[1:50,], n0[51:100,]) nf2 = st_nearest_feature(n1[1:50,], n1[51:100,]) print(all.equal(nf1, nf2)) } set.seed(131) n = 1000 pts = st_as_sf(data.frame(x = runif(n), y = runif(n)), coords = c("x", "y"), crs = 4326) # unit square in degrees: 111 x 111 km size = 15000 w <- st_is_within_distance(pts[1,], pts, size)[[1]] bs = units::set_units(size / s2::s2_earth_radius_meters(), rad) b1 = st_buffer(pts[1,], bs) b2 = st_buffer(pts[1,], size) all.equal(b1, b2) #plot(pts) #plot(pts[1,], add = TRUE, pch = 16, cex = 2, col = 'blue') #plot(st_buffer(pts[1,], bs), add = TRUE) #plot(pts[w,], add = TRUE, col = 'red') ================================================ FILE: tests/s2.Rout.save ================================================ R Under development (unstable) (2025-11-05 r88988 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > suppressPackageStartupMessages(library(sf)) > d = data.frame(z = 1:100, x = runif(100), y = runif(100)) > n0 = st_as_sf(d, coords = c("x", "y"), crs = 4326) > n1 = st_transform(n0, 3857) > > # st_nearest_points > cp1 = st_nearest_points(n0[1:50,], n0[51:100,]) > cp2 = st_transform(st_nearest_points(n1[1:50,], n1[51:100,]), 4326) > length(cp1) [1] 2500 > all.equal(cp1, cp2) [1] TRUE > > # st_nearest_points, pairwise > cp1 = st_nearest_points(n0[1:50,], n0[51:100,], pairwise = TRUE) > cp2 = st_transform(st_nearest_points(n1[1:50,], n1[51:100,], pairwise = TRUE), 4326) > length(cp1) [1] 50 > all.equal(cp1, cp2) [1] TRUE > > if (compareVersion(sf_extSoftVersion()["GEOS"], "3.6.1") > -1) { + # st_nearest_feature + nf1 = st_nearest_feature(n0[1:50,], n0[51:100,]) + nf2 = st_nearest_feature(n1[1:50,], n1[51:100,]) + print(all.equal(nf1, nf2)) + } [1] TRUE > > set.seed(131) > n = 1000 > pts = st_as_sf(data.frame(x = runif(n), y = runif(n)), coords = c("x", "y"), crs = 4326) > # unit square in degrees: 111 x 111 km > > size = 15000 > w <- st_is_within_distance(pts[1,], pts, size)[[1]] > > bs = units::set_units(size / s2::s2_earth_radius_meters(), rad) > b1 = st_buffer(pts[1,], bs) > b2 = st_buffer(pts[1,], size) > all.equal(b1, b2) [1] TRUE > > #plot(pts) > #plot(pts[1,], add = TRUE, pch = 16, cex = 2, col = 'blue') > #plot(st_buffer(pts[1,], bs), add = TRUE) > #plot(pts[w,], add = TRUE, col = 'red') > > proc.time() user system elapsed 1.07 0.18 1.25 ================================================ FILE: tests/sample.R ================================================ suppressPackageStartupMessages(library(sf)) bb = st_bbox(c(xmin=0, ymin=1, xmax=3, ymax=2)) xx <- st_make_grid(st_as_sfc(bb), square = FALSE, what = "polygons") plot(xx, border = 'green', main = "pointy topped") x <- st_make_grid(st_as_sfc(bb), square = FALSE, what = "points") plot(x, add = TRUE) x <- st_make_grid(st_as_sfc(bb), square = FALSE, what = "corners") plot(x, col = 'orange', add = TRUE) plot(st_as_sfc(bb), add = TRUE, border = 'red') st_overlaps(xx) |> lengths() |> sum() st_as_sfc(bb) |> st_difference(st_union(xx)) |> st_area() xx <- st_make_grid(st_as_sfc(bb), square = FALSE, what = "polygons", flat_topped = TRUE) plot(xx, border = 'green', main = "flat topped") x <- st_make_grid(st_as_sfc(bb), square = FALSE, what = "points", flat_topped = TRUE) plot(x, add = TRUE) x <- st_make_grid(st_as_sfc(bb), square = FALSE, what = "corners", flat_topped = TRUE) plot(x, col = 'orange', add = TRUE) plot(st_as_sfc(bb), add = TRUE, border = 'red') st_overlaps(xx) |> lengths() |> sum() st_as_sfc(bb) |> st_difference(st_union(xx)) |> st_area() ================================================ FILE: tests/sample.Rout.save ================================================ R version 4.5.2 (2025-10-31) -- "[Not] Part in a Rumble" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > suppressPackageStartupMessages(library(sf)) > bb = st_bbox(c(xmin=0, ymin=1, xmax=3, ymax=2)) > xx <- st_make_grid(st_as_sfc(bb), square = FALSE, what = "polygons") > plot(xx, border = 'green', main = "pointy topped") > x <- st_make_grid(st_as_sfc(bb), square = FALSE, what = "points") > plot(x, add = TRUE) > x <- st_make_grid(st_as_sfc(bb), square = FALSE, what = "corners") > plot(x, col = 'orange', add = TRUE) > plot(st_as_sfc(bb), add = TRUE, border = 'red') > st_overlaps(xx) |> + lengths() |> + sum() [1] 0 > > st_as_sfc(bb) |> + st_difference(st_union(xx)) |> + st_area() numeric(0) > > xx <- st_make_grid(st_as_sfc(bb), square = FALSE, what = "polygons", flat_topped = TRUE) > plot(xx, border = 'green', main = "flat topped") > x <- st_make_grid(st_as_sfc(bb), square = FALSE, what = "points", flat_topped = TRUE) > plot(x, add = TRUE) > x <- st_make_grid(st_as_sfc(bb), square = FALSE, what = "corners", flat_topped = TRUE) > plot(x, col = 'orange', add = TRUE) > plot(st_as_sfc(bb), add = TRUE, border = 'red') > st_overlaps(xx) |> + lengths() |> + sum() [1] 0 > > st_as_sfc(bb) |> + st_difference(st_union(xx)) |> + st_area() numeric(0) > > proc.time() user system elapsed 0.580 1.388 0.463 ================================================ FILE: tests/sfc.R ================================================ suppressPackageStartupMessages(library(sf)) p = st_point(c(1/3,1/6)) st_sfc(p, precision = 1000) st_as_sfc(st_as_binary(st_sfc(p, precision = 0L))) st_as_sfc(st_as_binary(st_sfc(p, precision = 1000))) st_as_sfc(st_as_binary(st_sfc(p, precision = 1000000))) st_as_sfc(st_as_binary(st_sfc(p, precision = 10L))) st_as_sfc(st_as_binary(st_sfc(p, precision = -1))) d = data.frame(a = 1:2) d$geom = c("POINT(0 0)", "POINT(1 1)") st_as_sf(d, wkt = "geom") st_as_sf(d, wkt = 2) st_as_sf(d, wkt = "geom", remove = FALSE) st_as_sfc(c("POINT(0 0)", "POINT(1 1)")) st_as_sfc(c("POINT(0 0)", "POINT(1 1)", "POLYGON((0 0,1 1,0 1,0 0))")) st_as_sfc(character(0)) x = st_as_sfc(character(0), 4326) y = st_as_sfc(character(0), crs = 4326) all.equal(x, y) st_as_sfc(c("POINT(0 0)", "POINT(1 1)", "POLYGON((0 0,1 1,0 1,0 0))"), "+proj=longlat +datum=WGS84") dg = st_as_sf(d, wkt = "geom") print(dg, n = 1) head(st_as_sf(d, wkt = "geom"), 1) d$geom = st_as_sfc(d$geom) d1 = d attr(d1, "sf_col") = "geom" st_geometry(d1) = d$geom d$geometry = d$geom # second geometry list-column if (require(testthat, quietly = TRUE)) { expect_warning(st_geometry(d) <- d$geom) } d x = st_sfc(list(st_point(0:1), st_point(0:1)), crs = 4326) # don't warn when replacing crs with identical value: st_sfc(x, crs = 4326) y = st_sfc(x, crs = "+proj=longlat +datum=WGS84 +no_defs") # but do when it changes: y = st_sfc(x, crs = 3857) p = st_point(0:1) st_cast(p, "MULTIPOINT") mp = st_multipoint(rbind(c(0,1), c(2,2))) st_cast(mp, "POINT") st_cast(mp, "MULTIPOINT") # geometry collection to its elements: st_cast(st_geometrycollection(list(mp)), "POINT") st_cast(st_geometrycollection(list(mp)), "MULTIPOINT") st_cast(st_geometrycollection(list(p,mp)), "MULTIPOINT") mp = st_multipoint(rbind(c(0,1))) x = st_sfc(p, mp) st_cast(x, "POINT") sf = st_sf(a = 3:2, geom = x) st_cast(sf, "POINT") x |> st_cast("POINT") # points: mp = st_multipoint(rbind(c(0,1))) # single-point multipoint st_sfc(p,mp) |> st_cast("POINT") st_sfc(p,mp) |> st_cast("MULTIPOINT") # lines: pts = rbind(c(0,0), c(1,1), c(2,1)) st_sfc(st_linestring(pts), st_multilinestring(list(pts))) |> st_cast("LINESTRING") st_sfc(st_linestring(pts), st_multilinestring(list(pts))) |> st_cast("MULTILINESTRING") # polygons: pts = rbind(c(0,0), c(1,1), c(0,1), c(0,0)) st_sfc(st_polygon(list(pts)), st_multipolygon(list(list(pts)))) |> st_cast("POLYGON") st_sfc(st_polygon(list(pts)), st_multipolygon(list(list(pts)))) |> st_cast("MULTIPOLYGON") st_sfc(st_geometrycollection(list(p)), st_geometrycollection(list(mp))) |> st_cast() st_sfc(st_geometrycollection(list(p)), st_geometrycollection(list(mp))) |> st_cast() |> st_cast("POINT") p = rbind(c(0,0),c(1,0),c(1,1),c(0,1),c(0,0)) pol = st_polygon(list(p)) # plot(pol) try(plot(st_polygonize(pol))) # --> breaks st_length(st_sfc(st_point(c(0,0)))) try(as(st_sfc(st_linestring(matrix(1:9,3))), "Spatial")) # check conus is present: x = st_sfc(st_point(c(-90,35)), st_point(c(-80,36)), crs = "+proj=longlat +datum=NAD27") y = st_transform(x, 3857) ## IGNORE_RDIFF_BEGIN sf_extSoftVersion()[1:3] ## IGNORE_RDIFF_END # Ops.sfc: ls = st_sfc(st_linestring(rbind(c(0,0),c(0,1)))) ls * 2 ls - 2 (ls + 2) %% 3 ls / ls p_ = st_point(0:1) ll = st_sfc(ls[[1]], p_) ll & st_sfc(p_) ll | st_sfc(p_) ll %/% st_sfc(p_) ll == st_sfc(p_) ll != st_sfc(p_) str(x) nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) str(nc) bb = st_as_sfc(st_bbox(nc)) format(st_bbox(nc)) st_agr("constant") st_agr() x <- st_sf(a = 1:2, b = 3:4, geom = x, agr = c("constant", "aggregate")) y <- x |> st_set_agr("constant") y sf1 <- st_sf(a = c("x", "y"), geom = st_sfc(st_point(3:4), st_point(3:4))) sf1[names(sf1)] st_bbox(sf1) bb = st_bbox(nc) bb st_crs(bb) st_bbox(c(xmin = 16.1, xmax = 16.6, ymin = 48.6, ymax = 47.9), crs = st_crs(4326)) st_bbox(c(xmin = 16.1, xmax = 16.6, ymin = 48.6, ymax = 47.9), crs = 4326) bb$xrange bb$yrange bb$xmin bb$ymin bb$xmax bb$ymax try(bb$foo) # merge: a = data.frame(a = 1:3, b = 5:7) st_geometry(a) = st_sfc(st_point(c(0,0)), st_point(c(1,1)), st_point(c(2,2))) b = data.frame(x = c("a", "b", "c"), b = c(2,5,6)) merge(a, b) merge(a, b, all = TRUE) if (require(dplyr, quietly = TRUE)) { # joins: inner_join(a, b) left_join(a, b) right_join(a, b) full_join(a, b) semi_join(a, b) anti_join(a, b) left_join(a, data.frame(b, geometry = 1), by = "b") } # st_joins: a = st_sf(a = 1:3, geom = st_sfc(st_point(c(1,1)), st_point(c(2,2)), st_point(c(3,3)))) b = st_sf(a = 11:14, geom = st_sfc(st_point(c(10,10)), st_point(c(2,2)), st_point(c(2,2)), st_point(c(3,3)))) st_join(a, b) st_join(a, b, left = FALSE) # st_join, largest = TRUE: nc <- st_transform(st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE), 2264) gr = st_sf( label = apply(expand.grid(1:10, LETTERS[10:1])[,2:1], 1, paste0, collapse = " "), geom = st_make_grid(st_as_sfc(st_bbox(nc)))) gr$col = sf.colors(10, categorical = TRUE, alpha = .3) # cut, to check, NA's work out: gr = gr[-(1:30),] st_join(nc, gr, largest = TRUE) # rbind: x = st_sf(a = 1:2, geom = st_sfc(list(st_point(0:1), st_point(0:1)), crs = 4326)) rbind(x, x, x) nc2 = rbind(nc[1:50, ], nc[51:100, ]) all.equal(nc, nc2) # st_sample: suppressWarnings(RNGversion("3.5.3")) set.seed(131) options(digits=6) x = st_sfc(st_polygon(list(rbind(c(0,1),c(90,1),c(90,90),c(0,90),c(0,1)))), crs = st_crs(4326)) (p <- st_sample(x, 10)) p <- st_sample(x[[1]], 10) # sfg method x = st_sfc(st_polygon(list(rbind(c(0,0),c(90,0),c(90,90),c(0,90),c(0,0))))) # NOT long/lat: p <- st_sample(x, 10) x = st_sfc(st_polygon(list(rbind(c(-180,-90),c(180,-90),c(180,90),c(-180,90),c(-180,-90)))), crs=st_crs(4326)) #FIXME: # if (sf_extSoftVersion()[["proj.4"]] >= "4.9.0") # lwgeom breaks on this # (p <- st_sample(x, 10)) pt = st_multipoint(matrix(1:20,,2)) st_sample(p, 3) try(st_sample(p, 3.3)) ls = st_sfc(st_linestring(rbind(c(0,0),c(0,1))), st_linestring(rbind(c(0,0),c(.1,0))), st_linestring(rbind(c(0,1),c(.1,1))), st_linestring(rbind(c(2,2),c(2,2.00001)))) st_sample(ls, 80) st_sample(nc[1:2,], size = c(10,20)) # try with LINES, LongLat, should generate a warning: nc[1:2,] |> st_transform(4326) |> st_cast("MULTILINESTRING") |> st_sample(size = c(10,20)) st_sample(ls, 80, type = "regular") p_sample = lapply(1:10, function(i) st_sample(nc[i, ], 100, exact = FALSE)) lengths(p_sample) p_sample_exact = lapply(1:10, function(i) st_sample(nc[i, ], 100, exact = TRUE)) lengths(p_sample_exact) #plot(nc$geometry[1]) #plot(p_sample[[1]], add = TRUE) #plot(p_sample_exact[[1]], add = TRUE) if (require(dplyr, quietly = TRUE)) { #class(st_bind_cols(nc, as.data.frame(nc)[1:3])) print(class(dplyr::bind_cols(nc, as.data.frame(nc)[1:3]))) } class(rbind(nc, nc)) class(cbind(nc, nc)) x = st_sfc(st_point(0:1), st_point(2:3)) x[c(NA,1,NA,2,NA)] # jitter pts = st_centroid(st_geometry(nc)) plot(pts) plot(st_jitter(pts, .05), add = TRUE, col = 'red') plot(st_geometry(nc)) plot(st_jitter(st_geometry(nc), factor = .01), add = TRUE, col = '#ff8888') st_jitter(st_sfc(st_point(0:1)), amount = .1) # st_bbox: if (suppressPackageStartupMessages(require(sp, quietly = TRUE)) && require(raster, quietly = TRUE)) { demo(meuse, ask = FALSE, echo = FALSE) suppressWarnings(st_bbox(meuse)) crs = suppressWarnings(st_crs(meuse)) suppressWarnings(st_bbox(raster(meuse.grid))) st_bbox(extent(raster())) } # st_to_s2 if (FALSE) { # stops working with GDAL 2.3.0 / PROJ 5.0.1: x = sf:::st_to_s2(nc) x1 = st_geometry(x) cc = st_coordinates(x1) summary(sqrt(cc[,1]^2+cc[,2]^2+cc[,3]^2)) } # check_ring_dir m = rbind(c(0,0), c(0,1), c(1,1), c(1,0), c(0,0)) mi = m[nrow(m):1,] pol = st_polygon(list(m * 10, m + .5, mi + 1.5, mi + 3.5, m + 5, mi + 6.5)) st_sfc(pol) x = st_sfc(pol, check_ring_dir=TRUE) y = st_sf(a = 1, geom = st_sfc(pol), check_ring_dir=TRUE) str(x) x = st_sfc(st_polygon(), st_polygon(), check_ring_dir=TRUE) str(x) # empty ring/zero area: x = st_sfc(st_polygon(list(m[c(1,3,1),])), check_ring_dir=TRUE) mp = st_multipolygon(list(pol, pol)) try(x <- st_sfc(mp, st_polygon(), check_ring_dir=TRUE)) x <- st_sfc(mp, pol) |> st_cast("MULTIPOLYGON") |> st_sfc(check_ring_dir=TRUE) x str(x) x = st_sfc(st_linestring(rbind(c(-179,0),c(179,0))), crs = 4326) st_wrap_dateline(st_sf(a = 1, geometry = x)) st_wrap_dateline(x) st_wrap_dateline(x[[1]]) geo <- c("{\"geodesic\":true,\"type\":\"Point\",\"coordinates\":[-118.68152563269095,36.43764870908927]}", "{\"geodesic\":true,\"type\":\"Point\",\"coordinates\":[-118.67408758213843,36.43366018922779]}", "{\"geodesic\":true,\"type\":\"Point\",\"coordinates\":[-118.67708346361097,36.44208638659282]}", "{\"geodesic\":true,\"type\":\"Point\",\"coordinates\":[-118.67886661944996,36.44110273135671]}", "{\"geodesic\":true,\"type\":\"Point\",\"coordinates\":[-118.68089232041565,36.44173155205561]}") st_as_sfc(geo, GeoJSON = TRUE) st_as_sfc(geo, GeoJSON = TRUE, crs = 4326) st_as_sfc(st_as_binary(st_sfc(st_point(0:1)))[[1]], crs = 4326) x = nc x$geom = NULL class(x) st_as_sfc(list(st_point(0:1)), crs = 4326) # crop: box = c(xmin = 0, ymin = 0, xmax = 1, ymax = 1) pol = st_sfc(st_buffer(st_point(c(.5, .5)), .65)) pol_sf = st_sf(a=1, geom=pol) st_crop(pol, box) st_crop(pol, st_bbox(box)) st_crop(pol_sf, box) st_crop(pol_sf, st_bbox(box)) # new sample methods: x = st_sfc(st_polygon(list(rbind(c(0,0),c(90,0),c(90,90),c(0,90),c(0,0))))) # NOT long/lat: p <- st_sample(x, 10, type = "regular") p <- st_sample(x, 10, type = "hexagonal") all.equal(st_drop_geometry(pol_sf), st_set_geometry(pol_sf, NULL)) # https://github.com/r-spatial/sf/issues/1024 shape1 <-st_sfc(st_polygon(list(rbind(c(0,0), c(1,0), c(3,2), c(2,4), c(1,4), c(0,0))))) shape2 <- st_sfc(st_polygon()) shape3 <- st_sfc(st_polygon()) shape4 = st_intersection(shape2, shape3) # has zero features st_difference(shape1, shape4) st_difference(shape4, shape1) st_sym_difference(shape1, shape4) st_union(shape1, shape4) st_union(shape4, shape1) # transform empty: tr = st_sf(geom=st_sfc()) |> st_set_crs(3587) |> st_transform(4326) # NA values are converted to empty; #1114: x <- data.frame(name=LETTERS) y <- data.frame(name=LETTERS[1:13], letters[14:26]) y$geometry <- st_sfc(st_point(c(0,0))) y <- st_sf(y) out = merge(x, y, all.x=TRUE) class(out) st_as_sf(st_sfc(st_point(0:1))) # st_exterior_ring(): outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) pts = list(outer, hole1, hole2) pl1 = st_polygon(pts) mpl1 = st_multipolygon(list(pl1,pl1+20)) spl1 = st_as_sfc(list(pl1),crs=4326) smpl1 = st_as_sfc(list(mpl1),crs=4326) st_exterior_ring(spl1[[1]]) st_exterior_ring(spl1) st_exterior_ring(st_sf(a = 1, geom = spl1)) st_exterior_ring(smpl1[[1]]) st_exterior_ring(st_sfc(smpl1)) st_exterior_ring(st_sf(a = 1, geom = st_sfc(smpl1))) '{"type":"Polygon","coordinates":[[]]}' |> read_sf() |> st_is_empty() # '{"type":"Polygon","coordinates":[]}' |> read_sf() |> st_is_empty() # breaks on GDAL < 3.9 or so '{"type":"MultiPolygon","coordinates":[[[]]]}' |> read_sf() |> st_is_empty() '{"type":"MultiPolygon","coordinates":[[]]}' |> read_sf() |> st_is_empty() ================================================ FILE: tests/sfc.Rout.save ================================================ R version 4.5.2 (2025-10-31) -- "[Not] Part in a Rumble" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > suppressPackageStartupMessages(library(sf)) > > p = st_point(c(1/3,1/6)) > st_sfc(p, precision = 1000) Geometry set for 1 feature Geometry type: POINT Dimension: XY Bounding box: xmin: 0.3333333 ymin: 0.1666667 xmax: 0.3333333 ymax: 0.1666667 CRS: NA Precision: 1000 POINT (0.3333333 0.1666667) > st_as_sfc(st_as_binary(st_sfc(p, precision = 0L))) Geometry set for 1 feature Geometry type: POINT Dimension: XY Bounding box: xmin: 0.3333333 ymin: 0.1666667 xmax: 0.3333333 ymax: 0.1666667 CRS: NA POINT (0.3333333 0.1666667) > st_as_sfc(st_as_binary(st_sfc(p, precision = 1000))) Geometry set for 1 feature Geometry type: POINT Dimension: XY Bounding box: xmin: 0.333 ymin: 0.167 xmax: 0.333 ymax: 0.167 CRS: NA POINT (0.333 0.167) > st_as_sfc(st_as_binary(st_sfc(p, precision = 1000000))) Geometry set for 1 feature Geometry type: POINT Dimension: XY Bounding box: xmin: 0.333333 ymin: 0.166667 xmax: 0.333333 ymax: 0.166667 CRS: NA POINT (0.333333 0.166667) > st_as_sfc(st_as_binary(st_sfc(p, precision = 10L))) Geometry set for 1 feature Geometry type: POINT Dimension: XY Bounding box: xmin: 0.3 ymin: 0.2 xmax: 0.3 ymax: 0.2 CRS: NA POINT (0.3 0.2) > st_as_sfc(st_as_binary(st_sfc(p, precision = -1))) Geometry set for 1 feature Geometry type: POINT Dimension: XY Bounding box: xmin: 0.3333333 ymin: 0.1666667 xmax: 0.3333333 ymax: 0.1666667 CRS: NA POINT (0.3333333 0.1666667) > > d = data.frame(a = 1:2) > d$geom = c("POINT(0 0)", "POINT(1 1)") > > st_as_sf(d, wkt = "geom") Simple feature collection with 2 features and 1 field Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA a geom 1 1 POINT (0 0) 2 2 POINT (1 1) > st_as_sf(d, wkt = 2) Simple feature collection with 2 features and 1 field Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA a geom 1 1 POINT (0 0) 2 2 POINT (1 1) > st_as_sf(d, wkt = "geom", remove = FALSE) Simple feature collection with 2 features and 2 fields Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA a geom geometry 1 1 POINT(0 0) POINT (0 0) 2 2 POINT(1 1) POINT (1 1) > > st_as_sfc(c("POINT(0 0)", "POINT(1 1)")) Geometry set for 2 features Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA POINT (0 0) POINT (1 1) > st_as_sfc(c("POINT(0 0)", "POINT(1 1)", "POLYGON((0 0,1 1,0 1,0 0))")) Geometry set for 3 features Geometry type: GEOMETRY Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA POINT (0 0) POINT (1 1) POLYGON ((0 0, 1 1, 0 1, 0 0)) > st_as_sfc(character(0)) Geometry set for 0 features Bounding box: xmin: NA ymin: NA xmax: NA ymax: NA CRS: NA > x = st_as_sfc(character(0), 4326) > y = st_as_sfc(character(0), crs = 4326) > all.equal(x, y) [1] TRUE > st_as_sfc(c("POINT(0 0)", "POINT(1 1)", "POLYGON((0 0,1 1,0 1,0 0))"), + "+proj=longlat +datum=WGS84") Geometry set for 3 features Geometry type: GEOMETRY Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 Geodetic CRS: +proj=longlat +datum=WGS84 POINT (0 0) POINT (1 1) POLYGON ((0 0, 1 1, 0 1, 0 0)) > dg = st_as_sf(d, wkt = "geom") > print(dg, n = 1) Simple feature collection with 2 features and 1 field Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA First 1 features: a geom 1 1 POINT (0 0) > head(st_as_sf(d, wkt = "geom"), 1) Simple feature collection with 1 feature and 1 field Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 0 ymax: 0 CRS: NA a geom 1 1 POINT (0 0) > > d$geom = st_as_sfc(d$geom) > d1 = d > attr(d1, "sf_col") = "geom" > st_geometry(d1) = d$geom > > d$geometry = d$geom # second geometry list-column > if (require(testthat, quietly = TRUE)) { + expect_warning(st_geometry(d) <- d$geom) + } > d Simple feature collection with 2 features and 1 field Active geometry column: geom Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA a geom geometry 1 1 POINT (0 0) POINT (0 0) 2 2 POINT (1 1) POINT (1 1) > > x = st_sfc(list(st_point(0:1), st_point(0:1)), crs = 4326) > # don't warn when replacing crs with identical value: > st_sfc(x, crs = 4326) Geometry set for 2 features Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 1 xmax: 0 ymax: 1 Geodetic CRS: WGS 84 POINT (0 1) POINT (0 1) > y = st_sfc(x, crs = "+proj=longlat +datum=WGS84 +no_defs") > # but do when it changes: > y = st_sfc(x, crs = 3857) Warning message: st_crs<- : replacing crs does not reproject data; use st_transform for that > > p = st_point(0:1) > st_cast(p, "MULTIPOINT") MULTIPOINT ((0 1)) > mp = st_multipoint(rbind(c(0,1), c(2,2))) > st_cast(mp, "POINT") POINT (0 1) Warning message: In st_cast.MULTIPOINT(mp, "POINT") : point from first coordinate only > st_cast(mp, "MULTIPOINT") MULTIPOINT ((0 1), (2 2)) > > # geometry collection to its elements: > st_cast(st_geometrycollection(list(mp)), "POINT") POINT (0 1) Warning message: In st_cast.MULTIPOINT(x[[1]], to, ...) : point from first coordinate only > st_cast(st_geometrycollection(list(mp)), "MULTIPOINT") MULTIPOINT ((0 1), (2 2)) > st_cast(st_geometrycollection(list(p,mp)), "MULTIPOINT") MULTIPOINT ((0 1)) Warning message: In st_cast.GEOMETRYCOLLECTION(st_geometrycollection(list(p, mp)), : only first part of geometrycollection is retained > > mp = st_multipoint(rbind(c(0,1))) > x = st_sfc(p, mp) > st_cast(x, "POINT") Geometry set for 2 features Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 1 xmax: 0 ymax: 1 CRS: NA POINT (0 1) POINT (0 1) Warning message: In st_cast.MULTIPOINT(X[[i]], ...) : point from first coordinate only > > sf = st_sf(a = 3:2, geom = x) > st_cast(sf, "POINT") Simple feature collection with 2 features and 1 field Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 1 xmax: 0 ymax: 1 CRS: NA a geom 1 3 POINT (0 1) 2 2 POINT (0 1) Warning message: In st_cast.MULTIPOINT(X[[i]], ...) : point from first coordinate only > > > x |> st_cast("POINT") Geometry set for 2 features Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 1 xmax: 0 ymax: 1 CRS: NA POINT (0 1) POINT (0 1) Warning message: In st_cast.MULTIPOINT(X[[i]], ...) : point from first coordinate only > > # points: > mp = st_multipoint(rbind(c(0,1))) # single-point multipoint > st_sfc(p,mp) |> st_cast("POINT") Geometry set for 2 features Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 1 xmax: 0 ymax: 1 CRS: NA POINT (0 1) POINT (0 1) Warning message: In st_cast.MULTIPOINT(X[[i]], ...) : point from first coordinate only > st_sfc(p,mp) |> st_cast("MULTIPOINT") Geometry set for 2 features Geometry type: MULTIPOINT Dimension: XY Bounding box: xmin: 0 ymin: 1 xmax: 0 ymax: 1 CRS: NA MULTIPOINT ((0 1)) MULTIPOINT ((0 1)) > > # lines: > pts = rbind(c(0,0), c(1,1), c(2,1)) > st_sfc(st_linestring(pts), st_multilinestring(list(pts))) |> st_cast("LINESTRING") Geometry set for 2 features Geometry type: LINESTRING Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 2 ymax: 1 CRS: NA LINESTRING (0 0, 1 1, 2 1) LINESTRING (0 0, 1 1, 2 1) > st_sfc(st_linestring(pts), st_multilinestring(list(pts))) |> st_cast("MULTILINESTRING") Geometry set for 2 features Geometry type: MULTILINESTRING Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 2 ymax: 1 CRS: NA MULTILINESTRING ((0 0, 1 1, 2 1)) MULTILINESTRING ((0 0, 1 1, 2 1)) > > # polygons: > pts = rbind(c(0,0), c(1,1), c(0,1), c(0,0)) > st_sfc(st_polygon(list(pts)), st_multipolygon(list(list(pts)))) |> st_cast("POLYGON") Geometry set for 2 features Geometry type: POLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA POLYGON ((0 0, 1 1, 0 1, 0 0)) POLYGON ((0 0, 1 1, 0 1, 0 0)) > st_sfc(st_polygon(list(pts)), st_multipolygon(list(list(pts)))) |> st_cast("MULTIPOLYGON") Geometry set for 2 features Geometry type: MULTIPOLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA MULTIPOLYGON (((0 0, 1 1, 0 1, 0 0))) MULTIPOLYGON (((0 0, 1 1, 0 1, 0 0))) > > > st_sfc(st_geometrycollection(list(p)), st_geometrycollection(list(mp))) |> st_cast() Geometry set for 2 features Geometry type: GEOMETRY Dimension: XY Bounding box: xmin: 0 ymin: 1 xmax: 0 ymax: 1 CRS: NA POINT (0 1) MULTIPOINT ((0 1)) > st_sfc(st_geometrycollection(list(p)), st_geometrycollection(list(mp))) |> + st_cast() |> + st_cast("POINT") Geometry set for 2 features Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 1 xmax: 0 ymax: 1 CRS: NA POINT (0 1) POINT (0 1) Warning message: In st_cast.MULTIPOINT(X[[i]], ...) : point from first coordinate only > > p = rbind(c(0,0),c(1,0),c(1,1),c(0,1),c(0,0)) > pol = st_polygon(list(p)) > # plot(pol) > try(plot(st_polygonize(pol))) # --> breaks Error in st_polygonize.sfc(st_sfc(x)) : inherits(x, "sfc_LINESTRING") || inherits(x, "sfc_MULTILINESTRING") is not TRUE > st_length(st_sfc(st_point(c(0,0)))) [1] 0 > > try(as(st_sfc(st_linestring(matrix(1:9,3))), "Spatial")) Error in StopZ(zm) : sp supports Z dimension only for POINT and MULTIPOINT. use `st_zm(...)` to coerce to XY dimensions > > # check conus is present: > x = st_sfc(st_point(c(-90,35)), st_point(c(-80,36)), + crs = "+proj=longlat +datum=NAD27") > y = st_transform(x, 3857) > > ## IGNORE_RDIFF_BEGIN > sf_extSoftVersion()[1:3] GEOS GDAL proj.4 "3.12.2" "3.11.4" "9.4.1" > ## IGNORE_RDIFF_END > > # Ops.sfc: > ls = st_sfc(st_linestring(rbind(c(0,0),c(0,1)))) > ls * 2 Geometry set for 1 feature Geometry type: LINESTRING Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 0 ymax: 2 CRS: NA LINESTRING (0 0, 0 2) > ls - 2 Geometry set for 1 feature Geometry type: LINESTRING Dimension: XY Bounding box: xmin: -2 ymin: -2 xmax: -2 ymax: -1 CRS: NA LINESTRING (-2 -2, -2 -1) > (ls + 2) %% 3 Geometry set for 1 feature Geometry type: LINESTRING Dimension: XY Bounding box: xmin: 2 ymin: 0 xmax: 2 ymax: 2 CRS: NA LINESTRING (2 2, 2 0) > ls / ls Geometry set for 1 feature (with 1 geometry empty) Geometry type: GEOMETRYCOLLECTION Dimension: XY Bounding box: xmin: NA ymin: NA xmax: NA ymax: NA CRS: NA GEOMETRYCOLLECTION EMPTY > p_ = st_point(0:1) > ll = st_sfc(ls[[1]], p_) > ll & st_sfc(p_) Geometry set for 2 features Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 1 xmax: 0 ymax: 1 CRS: NA POINT (0 1) POINT (0 1) > ll | st_sfc(p_) Geometry set for 2 features Geometry type: GEOMETRY Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 0 ymax: 1 CRS: NA LINESTRING (0 0, 0 1) POINT (0 1) > ll %/% st_sfc(p_) Geometry set for 2 features (with 1 geometry empty) Geometry type: GEOMETRY Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 0 ymax: 1 CRS: NA LINESTRING (0 0, 0 1) GEOMETRYCOLLECTION EMPTY > ll == st_sfc(p_) [1] FALSE TRUE > ll != st_sfc(p_) [1] TRUE FALSE > > > str(x) sfc_POINT of length 2; first list element: 'XY' num [1:2] -90 35 > nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) > str(nc) Classes 'sf' and 'data.frame': 100 obs. of 15 variables: $ AREA : num 0.114 0.061 0.143 0.07 0.153 0.097 0.062 0.091 0.118 0.124 ... $ PERIMETER: num 1.44 1.23 1.63 2.97 2.21 ... $ CNTY_ : num 1825 1827 1828 1831 1832 ... $ CNTY_ID : num 1825 1827 1828 1831 1832 ... $ NAME : chr "Ashe" "Alleghany" "Surry" "Currituck" ... $ FIPS : chr "37009" "37005" "37171" "37053" ... $ FIPSNO : num 37009 37005 37171 37053 37131 ... $ CRESS_ID : int 5 3 86 27 66 46 15 37 93 85 ... $ BIR74 : num 1091 487 3188 508 1421 ... $ SID74 : num 1 0 5 1 9 7 0 0 4 1 ... $ NWBIR74 : num 10 10 208 123 1066 ... $ BIR79 : num 1364 542 3616 830 1606 ... $ SID79 : num 0 3 6 2 3 5 2 2 2 5 ... $ NWBIR79 : num 19 12 260 145 1197 ... $ geometry :sfc_MULTIPOLYGON of length 100; first list element: List of 1 ..$ :List of 1 .. ..$ : num [1:27, 1:2] -81.5 -81.5 -81.6 -81.6 -81.7 ... ..- attr(*, "class")= chr [1:3] "XY" "MULTIPOLYGON" "sfg" - attr(*, "sf_column")= chr "geometry" - attr(*, "agr")= Factor w/ 3 levels "constant","aggregate",..: NA NA NA NA NA NA NA NA NA NA ... ..- attr(*, "names")= chr [1:14] "AREA" "PERIMETER" "CNTY_" "CNTY_ID" ... > bb = st_as_sfc(st_bbox(nc)) > format(st_bbox(nc)) [1] "((-84.32385,33.88199),(-75.45698,36.58965))" > > st_agr("constant") [1] constant Levels: constant aggregate identity > st_agr() [1] Levels: constant aggregate identity > x <- st_sf(a = 1:2, b = 3:4, geom = x, agr = c("constant", "aggregate")) > y <- x |> st_set_agr("constant") > y Simple feature collection with 2 features and 2 fields Attribute-geometry relationships: constant (2) Geometry type: POINT Dimension: XY Bounding box: xmin: -90 ymin: 35 xmax: -80 ymax: 36 Geodetic CRS: +proj=longlat +datum=NAD27 a b geom 1 1 3 POINT (-90 35) 2 2 4 POINT (-80 36) > > sf1 <- st_sf(a = c("x", "y"), geom = st_sfc(st_point(3:4), st_point(3:4))) > sf1[names(sf1)] Simple feature collection with 2 features and 1 field Geometry type: POINT Dimension: XY Bounding box: xmin: 3 ymin: 4 xmax: 3 ymax: 4 CRS: NA a geom 1 x POINT (3 4) 2 y POINT (3 4) > > st_bbox(sf1) xmin ymin xmax ymax 3 4 3 4 > bb = st_bbox(nc) > bb xmin ymin xmax ymax -84.32385 33.88199 -75.45698 36.58965 > st_crs(bb) Coordinate Reference System: User input: NAD27 wkt: GEOGCRS["NAD27", DATUM["North American Datum 1927", ELLIPSOID["Clarke 1866",6378206.4,294.978698213898, LENGTHUNIT["metre",1]]], PRIMEM["Greenwich",0, ANGLEUNIT["degree",0.0174532925199433]], CS[ellipsoidal,2], AXIS["latitude",north, ORDER[1], ANGLEUNIT["degree",0.0174532925199433]], AXIS["longitude",east, ORDER[2], ANGLEUNIT["degree",0.0174532925199433]], ID["EPSG",4267]] > st_bbox(c(xmin = 16.1, xmax = 16.6, ymin = 48.6, ymax = 47.9), crs = st_crs(4326)) xmin ymin xmax ymax 16.1 48.6 16.6 47.9 > st_bbox(c(xmin = 16.1, xmax = 16.6, ymin = 48.6, ymax = 47.9), crs = 4326) xmin ymin xmax ymax 16.1 48.6 16.6 47.9 > > bb$xrange xmin xmax -84.32385 -75.45698 > bb$yrange ymin ymax 33.88199 36.58965 > bb$xmin xmin -84.32385 > bb$ymin ymin 33.88199 > bb$xmax xmax -75.45698 > bb$ymax ymax 36.58965 > try(bb$foo) Error in `$.bbox`(bb, foo) : unsupported name > > # merge: > a = data.frame(a = 1:3, b = 5:7) > st_geometry(a) = st_sfc(st_point(c(0,0)), st_point(c(1,1)), st_point(c(2,2))) > b = data.frame(x = c("a", "b", "c"), b = c(2,5,6)) > merge(a, b) Simple feature collection with 2 features and 3 fields Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA b a x geometry 1 5 1 b POINT (0 0) 2 6 2 c POINT (1 1) > merge(a, b, all = TRUE) Simple feature collection with 4 features and 3 fields (with 1 geometry empty) Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 2 ymax: 2 CRS: NA b a x geometry 1 2 NA a POINT EMPTY 2 5 1 b POINT (0 0) 3 6 2 c POINT (1 1) 4 7 3 POINT (2 2) > > if (require(dplyr, quietly = TRUE)) { + # joins: + inner_join(a, b) + left_join(a, b) + right_join(a, b) + full_join(a, b) + semi_join(a, b) + anti_join(a, b) + left_join(a, data.frame(b, geometry = 1), by = "b") + } Attaching package: 'dplyr' The following objects are masked from 'package:stats': filter, lag The following objects are masked from 'package:base': intersect, setdiff, setequal, union Joining with `by = join_by(b)` Joining with `by = join_by(b)` Joining with `by = join_by(b)` Joining with `by = join_by(b)` Joining with `by = join_by(b)` Joining with `by = join_by(b)` Simple feature collection with 3 features and 4 fields Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 2 ymax: 2 CRS: NA a b x geometry.y geometry.x 1 1 5 b 1 POINT (0 0) 2 2 6 c 1 POINT (1 1) 3 3 7 NA POINT (2 2) > > # st_joins: > a = st_sf(a = 1:3, + geom = st_sfc(st_point(c(1,1)), st_point(c(2,2)), st_point(c(3,3)))) > b = st_sf(a = 11:14, + geom = st_sfc(st_point(c(10,10)), st_point(c(2,2)), st_point(c(2,2)), st_point(c(3,3)))) > st_join(a, b) Simple feature collection with 4 features and 2 fields Geometry type: POINT Dimension: XY Bounding box: xmin: 1 ymin: 1 xmax: 3 ymax: 3 CRS: NA a.x a.y geom 1 1 NA POINT (1 1) 2 2 12 POINT (2 2) 2.1 2 13 POINT (2 2) 3 3 14 POINT (3 3) > st_join(a, b, left = FALSE) Simple feature collection with 3 features and 2 fields Geometry type: POINT Dimension: XY Bounding box: xmin: 2 ymin: 2 xmax: 3 ymax: 3 CRS: NA a.x a.y geom 2 2 12 POINT (2 2) 2.1 2 13 POINT (2 2) 3 3 14 POINT (3 3) > # st_join, largest = TRUE: > nc <- st_transform(st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE), 2264) > gr = st_sf( + label = apply(expand.grid(1:10, LETTERS[10:1])[,2:1], 1, paste0, collapse = " "), + geom = st_make_grid(st_as_sfc(st_bbox(nc)))) > gr$col = sf.colors(10, categorical = TRUE, alpha = .3) > # cut, to check, NA's work out: > gr = gr[-(1:30),] > st_join(nc, gr, largest = TRUE) Simple feature collection with 100 features and 16 fields Geometry type: MULTIPOLYGON Dimension: XY Bounding box: xmin: 406265 ymin: 48359.7 xmax: 3052877 ymax: 1044143 Projected CRS: NAD83 / North Carolina (ftUS) First 10 features: AREA PERIMETER CNTY_ CNTY_ID NAME FIPS FIPSNO CRESS_ID BIR74 SID74 1 0.114 1.442 1825 1825 Ashe 37009 37009 5 1091 1 2 0.061 1.231 1827 1827 Alleghany 37005 37005 3 487 0 3 0.143 1.630 1828 1828 Surry 37171 37171 86 3188 5 4 0.070 2.968 1831 1831 Currituck 37053 37053 27 508 1 5 0.153 2.206 1832 1832 Northampton 37131 37131 66 1421 9 6 0.097 1.670 1833 1833 Hertford 37091 37091 46 1452 7 7 0.062 1.547 1834 1834 Camden 37029 37029 15 286 0 8 0.091 1.284 1835 1835 Gates 37073 37073 37 420 0 9 0.118 1.421 1836 1836 Warren 37185 37185 93 968 4 10 0.124 1.428 1837 1837 Stokes 37169 37169 85 1612 1 NWBIR74 BIR79 SID79 NWBIR79 label col geometry 1 10 1364 0 19 A 4 #fb80724d MULTIPOLYGON (((1270813 913... 2 10 542 3 12 A 4 #fb80724d MULTIPOLYGON (((1340553 959... 3 208 3616 6 260 A 5 #80b1d34d MULTIPOLYGON (((1570586 910... 4 123 830 2 145 A 10 #bc80bd4d MULTIPOLYGON (((2881206 948... 5 1066 1606 3 1197 A 8 #fccde54d MULTIPOLYGON (((2525700 911... 6 954 1838 5 1237 A 9 #d9d9d94d MULTIPOLYGON (((2665112 911... 7 115 350 2 139 A 10 #bc80bd4d MULTIPOLYGON (((2881206 948... 8 254 594 2 371 A 9 #d9d9d94d MULTIPOLYGON (((2717988 951... 9 748 1190 2 844 A 8 #fccde54d MULTIPOLYGON (((2203888 914... 10 160 2038 5 176 A 5 #80b1d34d MULTIPOLYGON (((1697618 911... Warning message: attribute variables are assumed to be spatially constant throughout all geometries > > # rbind: > x = st_sf(a = 1:2, geom = st_sfc(list(st_point(0:1), st_point(0:1)), crs = 4326)) > rbind(x, x, x) Simple feature collection with 6 features and 1 field Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 1 xmax: 0 ymax: 1 Geodetic CRS: WGS 84 a geom 1 1 POINT (0 1) 2 2 POINT (0 1) 3 1 POINT (0 1) 4 2 POINT (0 1) 5 1 POINT (0 1) 6 2 POINT (0 1) > nc2 = rbind(nc[1:50, ], nc[51:100, ]) > all.equal(nc, nc2) [1] TRUE > > # st_sample: > suppressWarnings(RNGversion("3.5.3")) > set.seed(131) > options(digits=6) > x = st_sfc(st_polygon(list(rbind(c(0,1),c(90,1),c(90,90),c(0,90),c(0,1)))), crs = st_crs(4326)) > (p <- st_sample(x, 10)) Geometry set for 10 features Geometry type: POINT Dimension: XY Bounding box: xmin: 11.2448 ymin: 3.16385 xmax: 82.3451 ymax: 60.1703 Geodetic CRS: WGS 84 First 5 geometries: POINT (18.5793 25.2416) POINT (11.2448 20.8596) POINT (26.3946 60.1703) POINT (33.8202 19.146) POINT (76.1712 32.1029) > p <- st_sample(x[[1]], 10) # sfg method > x = st_sfc(st_polygon(list(rbind(c(0,0),c(90,0),c(90,90),c(0,90),c(0,0))))) # NOT long/lat: > p <- st_sample(x, 10) > x = st_sfc(st_polygon(list(rbind(c(-180,-90),c(180,-90),c(180,90),c(-180,90),c(-180,-90)))), + crs=st_crs(4326)) > #FIXME: > # if (sf_extSoftVersion()[["proj.4"]] >= "4.9.0") # lwgeom breaks on this > # (p <- st_sample(x, 10)) > pt = st_multipoint(matrix(1:20,,2)) > st_sample(p, 3) Geometry set for 1 feature Geometry type: MULTIPOINT Dimension: XY Bounding box: xmin: 41.0557 ymin: 27.8024 xmax: 80.9558 ymax: 65.5424 CRS: NA MULTIPOINT ((57.2118 52.329), (80.9558 65.5424)... > try(st_sample(p, 3.3)) Geometry set for 1 feature Geometry type: MULTIPOINT Dimension: XY Bounding box: xmin: 19.3415 ymin: 9.17624 xmax: 80.9558 ymax: 65.5424 CRS: NA MULTIPOINT ((19.3415 18.6622), (57.1389 9.17624... Warning message: In st_sample.sfc(p, 3.3) : size is not an integer > ls = st_sfc(st_linestring(rbind(c(0,0),c(0,1))), + st_linestring(rbind(c(0,0),c(.1,0))), + st_linestring(rbind(c(0,1),c(.1,1))), + st_linestring(rbind(c(2,2),c(2,2.00001)))) > st_sample(ls, 80) Geometry set for 4 features (with 1 geometry empty) Geometry type: MULTIPOINT Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 0.0914728 ymax: 1 CRS: NA MULTIPOINT ((0 0.137868), (0 0.777635), (0 0.40... MULTIPOINT ((0.0914728 0), (0.073852 0), (0.003... MULTIPOINT ((0.0488222 1), (0.0716508 1), (0.08... MULTIPOINT EMPTY > st_sample(nc[1:2,], size = c(10,20)) Geometry set for 30 features Geometry type: POINT Dimension: XY Bounding box: xmin: 1216510 ymin: 935852 xmax: 1428880 ymax: 1031490 Projected CRS: NAD83 / North Carolina (ftUS) First 5 geometries: POINT (1264558 935852) POINT (1256623 949369) POINT (1222665 972624) POINT (1333528 968263) POINT (1310837 958630) > # try with LINES, LongLat, should generate a warning: > nc[1:2,] |> st_transform(4326) |> st_cast("MULTILINESTRING") |> st_sample(size = c(10,20)) although coordinates are longitude/latitude, st_sample assumes that they are planar although coordinates are longitude/latitude, st_sample assumes that they are planar Geometry set for 2 features Geometry type: MULTIPOINT Dimension: XY Bounding box: xmin: -81.6893 ymin: 36.2491 xmax: -80.914 ymax: 36.5726 Geodetic CRS: WGS 84 MULTIPOINT ((-81.2401 36.3717), (-81.6893 36.36... MULTIPOINT ((-81.2629 36.4076), (-81.1375 36.56... > st_sample(ls, 80, type = "regular") Geometry set for 4 features (with 1 geometry empty) Geometry type: MULTIPOINT Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 0.095454 ymax: 1 CRS: NA MULTIPOINT ((0 0.0104441), (0 0.0254442), (0 0.... MULTIPOINT ((0.000452334 0), (0.0154525 0), (0.... MULTIPOINT ((0.00545321 1), (0.0204533 1), (0.0... MULTIPOINT EMPTY > p_sample = lapply(1:10, function(i) st_sample(nc[i, ], 100, exact = FALSE)) > lengths(p_sample) [1] 104 106 110 96 98 120 87 105 104 99 > p_sample_exact = lapply(1:10, function(i) st_sample(nc[i, ], 100, exact = TRUE)) > lengths(p_sample_exact) [1] 100 100 100 100 100 100 100 100 100 100 > #plot(nc$geometry[1]) > #plot(p_sample[[1]], add = TRUE) > #plot(p_sample_exact[[1]], add = TRUE) > > if (require(dplyr, quietly = TRUE)) { + #class(st_bind_cols(nc, as.data.frame(nc)[1:3])) + print(class(dplyr::bind_cols(nc, as.data.frame(nc)[1:3]))) + } New names: • `AREA` -> `AREA...1` • `PERIMETER` -> `PERIMETER...2` • `CNTY_` -> `CNTY_...3` • `AREA` -> `AREA...16` • `PERIMETER` -> `PERIMETER...17` • `CNTY_` -> `CNTY_...18` [1] "sf" "data.frame" > class(rbind(nc, nc)) [1] "sf" "data.frame" > class(cbind(nc, nc)) [1] "sf" "data.frame" > > x = st_sfc(st_point(0:1), st_point(2:3)) > x[c(NA,1,NA,2,NA)] Geometry set for 5 features (with 3 geometries empty) Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 1 xmax: 2 ymax: 3 CRS: NA POINT EMPTY POINT (0 1) POINT EMPTY POINT (2 3) POINT EMPTY > > # jitter > pts = st_centroid(st_geometry(nc)) > plot(pts) > plot(st_jitter(pts, .05), add = TRUE, col = 'red') > plot(st_geometry(nc)) > plot(st_jitter(st_geometry(nc), factor = .01), add = TRUE, col = '#ff8888') > st_jitter(st_sfc(st_point(0:1)), amount = .1) Geometry set for 1 feature Geometry type: POINT Dimension: XY Bounding box: xmin: -0.0500922 ymin: 0.992953 xmax: -0.0500922 ymax: 0.992953 CRS: NA POINT (-0.0500922 0.992953) > > # st_bbox: > if (suppressPackageStartupMessages(require(sp, quietly = TRUE)) && require(raster, quietly = TRUE)) { + demo(meuse, ask = FALSE, echo = FALSE) + suppressWarnings(st_bbox(meuse)) + crs = suppressWarnings(st_crs(meuse)) + suppressWarnings(st_bbox(raster(meuse.grid))) + st_bbox(extent(raster())) + } Attaching package: 'raster' The following object is masked from 'package:dplyr': select xmin ymin xmax ymax -180 -90 180 90 > > # st_to_s2 > if (FALSE) { # stops working with GDAL 2.3.0 / PROJ 5.0.1: + x = sf:::st_to_s2(nc) + x1 = st_geometry(x) + cc = st_coordinates(x1) + summary(sqrt(cc[,1]^2+cc[,2]^2+cc[,3]^2)) + } > > # check_ring_dir > m = rbind(c(0,0), c(0,1), c(1,1), c(1,0), c(0,0)) > mi = m[nrow(m):1,] > pol = st_polygon(list(m * 10, m + .5, mi + 1.5, mi + 3.5, m + 5, mi + 6.5)) > st_sfc(pol) Geometry set for 1 feature Geometry type: POLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 10 ymax: 10 CRS: NA POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0), (0.5 0.... > x = st_sfc(pol, check_ring_dir=TRUE) > y = st_sf(a = 1, geom = st_sfc(pol), check_ring_dir=TRUE) > str(x) sfc_POLYGON of length 1; first list element: List of 6 $ : num [1:5, 1:2] 0 10 10 0 0 0 0 10 10 0 $ : num [1:5, 1:2] 0.5 0.5 1.5 1.5 0.5 0.5 1.5 1.5 0.5 0.5 $ : num [1:5, 1:2] 1.5 1.5 2.5 2.5 1.5 1.5 2.5 2.5 1.5 1.5 $ : num [1:5, 1:2] 3.5 3.5 4.5 4.5 3.5 3.5 4.5 4.5 3.5 3.5 $ : num [1:5, 1:2] 5 5 6 6 5 5 6 6 5 5 $ : num [1:5, 1:2] 6.5 6.5 7.5 7.5 6.5 6.5 7.5 7.5 6.5 6.5 - attr(*, "class")= chr [1:3] "XY" "POLYGON" "sfg" > x = st_sfc(st_polygon(), st_polygon(), check_ring_dir=TRUE) > str(x) sfc_POLYGON of length 2; first list element: list() - attr(*, "class")= chr [1:3] "XY" "POLYGON" "sfg" > # empty ring/zero area: > x = st_sfc(st_polygon(list(m[c(1,3,1),])), check_ring_dir=TRUE) > > mp = st_multipolygon(list(pol, pol)) > try(x <- st_sfc(mp, st_polygon(), check_ring_dir=TRUE)) Error in check_ring_dir(lst) : check_ring_dir: not supported for class sfc_GEOMETRY > x <- st_sfc(mp, pol) |> st_cast("MULTIPOLYGON") |> st_sfc(check_ring_dir=TRUE) > x Geometry set for 2 features Geometry type: MULTIPOLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 10 ymax: 10 CRS: NA MULTIPOLYGON (((0 0, 10 0, 10 10, 0 10, 0 0), (... MULTIPOLYGON (((0 0, 10 0, 10 10, 0 10, 0 0), (... > str(x) sfc_MULTIPOLYGON of length 2; first list element: List of 2 $ :List of 6 ..$ : num [1:5, 1:2] 0 10 10 0 0 0 0 10 10 0 ..$ : num [1:5, 1:2] 0.5 0.5 1.5 1.5 0.5 0.5 1.5 1.5 0.5 0.5 ..$ : num [1:5, 1:2] 1.5 1.5 2.5 2.5 1.5 1.5 2.5 2.5 1.5 1.5 ..$ : num [1:5, 1:2] 3.5 3.5 4.5 4.5 3.5 3.5 4.5 4.5 3.5 3.5 ..$ : num [1:5, 1:2] 5 5 6 6 5 5 6 6 5 5 ..$ : num [1:5, 1:2] 6.5 6.5 7.5 7.5 6.5 6.5 7.5 7.5 6.5 6.5 ..- attr(*, "class")= chr [1:3] "XY" "POLYGON" "sfg" $ :List of 6 ..$ : num [1:5, 1:2] 0 10 10 0 0 0 0 10 10 0 ..$ : num [1:5, 1:2] 0.5 0.5 1.5 1.5 0.5 0.5 1.5 1.5 0.5 0.5 ..$ : num [1:5, 1:2] 1.5 1.5 2.5 2.5 1.5 1.5 2.5 2.5 1.5 1.5 ..$ : num [1:5, 1:2] 3.5 3.5 4.5 4.5 3.5 3.5 4.5 4.5 3.5 3.5 ..$ : num [1:5, 1:2] 5 5 6 6 5 5 6 6 5 5 ..$ : num [1:5, 1:2] 6.5 6.5 7.5 7.5 6.5 6.5 7.5 7.5 6.5 6.5 ..- attr(*, "class")= chr [1:3] "XY" "POLYGON" "sfg" - attr(*, "class")= chr [1:3] "XY" "MULTIPOLYGON" "sfg" > > x = st_sfc(st_linestring(rbind(c(-179,0),c(179,0))), crs = 4326) > st_wrap_dateline(st_sf(a = 1, geometry = x)) Simple feature collection with 1 feature and 1 field Geometry type: MULTILINESTRING Dimension: XY Bounding box: xmin: -180 ymin: 0 xmax: 180 ymax: 0 Geodetic CRS: WGS 84 a geometry 1 1 MULTILINESTRING ((-179 0, -... > st_wrap_dateline(x) Geometry set for 1 feature Geometry type: MULTILINESTRING Dimension: XY Bounding box: xmin: -180 ymin: 0 xmax: 180 ymax: 0 Geodetic CRS: WGS 84 MULTILINESTRING ((-179 0, -180 0), (180 0, 179 0)) > st_wrap_dateline(x[[1]]) MULTILINESTRING ((-179 0, -180 0), (180 0, 179 0)) > > geo <- c("{\"geodesic\":true,\"type\":\"Point\",\"coordinates\":[-118.68152563269095,36.43764870908927]}", + "{\"geodesic\":true,\"type\":\"Point\",\"coordinates\":[-118.67408758213843,36.43366018922779]}", + "{\"geodesic\":true,\"type\":\"Point\",\"coordinates\":[-118.67708346361097,36.44208638659282]}", + "{\"geodesic\":true,\"type\":\"Point\",\"coordinates\":[-118.67886661944996,36.44110273135671]}", + "{\"geodesic\":true,\"type\":\"Point\",\"coordinates\":[-118.68089232041565,36.44173155205561]}") > st_as_sfc(geo, GeoJSON = TRUE) Geometry set for 5 features Geometry type: POINT Dimension: XY Bounding box: xmin: -118.682 ymin: 36.4337 xmax: -118.674 ymax: 36.4421 Geodetic CRS: WGS 84 POINT (-118.682 36.4376) POINT (-118.674 36.4337) POINT (-118.677 36.4421) POINT (-118.679 36.4411) POINT (-118.681 36.4417) > st_as_sfc(geo, GeoJSON = TRUE, crs = 4326) Geometry set for 5 features Geometry type: POINT Dimension: XY Bounding box: xmin: -118.682 ymin: 36.4337 xmax: -118.674 ymax: 36.4421 Geodetic CRS: WGS 84 POINT (-118.682 36.4376) POINT (-118.674 36.4337) POINT (-118.677 36.4421) POINT (-118.679 36.4411) POINT (-118.681 36.4417) > > st_as_sfc(st_as_binary(st_sfc(st_point(0:1)))[[1]], crs = 4326) Geometry set for 1 feature Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 1 xmax: 0 ymax: 1 Geodetic CRS: WGS 84 POINT (0 1) > > x = nc > x$geom = NULL > class(x) [1] "sf" "data.frame" > > st_as_sfc(list(st_point(0:1)), crs = 4326) Geometry set for 1 feature Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 1 xmax: 0 ymax: 1 Geodetic CRS: WGS 84 POINT (0 1) > > # crop: > box = c(xmin = 0, ymin = 0, xmax = 1, ymax = 1) > > pol = st_sfc(st_buffer(st_point(c(.5, .5)), .65)) > pol_sf = st_sf(a=1, geom=pol) > > st_crop(pol, box) Geometry set for 1 feature Geometry type: POLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA POLYGON ((0.983044 0.0650651, 0.959619 0.040380... > st_crop(pol, st_bbox(box)) Geometry set for 1 feature Geometry type: POLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA POLYGON ((0.983044 0.0650651, 0.959619 0.040380... > st_crop(pol_sf, box) Simple feature collection with 1 feature and 1 field Geometry type: POLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA a geom 1 1 POLYGON ((0.983044 0.065065... Warning message: attribute variables are assumed to be spatially constant throughout all geometries > st_crop(pol_sf, st_bbox(box)) Simple feature collection with 1 feature and 1 field Geometry type: POLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA a geom 1 1 POLYGON ((0.983044 0.065065... Warning message: attribute variables are assumed to be spatially constant throughout all geometries > > # new sample methods: > x = st_sfc(st_polygon(list(rbind(c(0,0),c(90,0),c(90,90),c(0,90),c(0,0))))) # NOT long/lat: > p <- st_sample(x, 10, type = "regular") > p <- st_sample(x, 10, type = "hexagonal") > > all.equal(st_drop_geometry(pol_sf), st_set_geometry(pol_sf, NULL)) [1] TRUE > > # https://github.com/r-spatial/sf/issues/1024 > shape1 <-st_sfc(st_polygon(list(rbind(c(0,0), c(1,0), c(3,2), c(2,4), c(1,4), c(0,0))))) > shape2 <- st_sfc(st_polygon()) > shape3 <- st_sfc(st_polygon()) > > shape4 = st_intersection(shape2, shape3) # has zero features > > st_difference(shape1, shape4) Geometry set for 1 feature Geometry type: POLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 3 ymax: 4 CRS: NA POLYGON ((0 0, 1 0, 3 2, 2 4, 1 4, 0 0)) > st_difference(shape4, shape1) Geometry set for 0 features Bounding box: xmin: NA ymin: NA xmax: NA ymax: NA CRS: NA > st_sym_difference(shape1, shape4) Geometry set for 1 feature Geometry type: POLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 3 ymax: 4 CRS: NA POLYGON ((0 0, 1 0, 3 2, 2 4, 1 4, 0 0)) > st_union(shape1, shape4) Geometry set for 1 feature Geometry type: POLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 3 ymax: 4 CRS: NA POLYGON ((0 0, 1 0, 3 2, 2 4, 1 4, 0 0)) > st_union(shape4, shape1) Geometry set for 1 feature Geometry type: POLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 3 ymax: 4 CRS: NA POLYGON ((0 0, 1 0, 3 2, 2 4, 1 4, 0 0)) > > # transform empty: > tr = st_sf(geom=st_sfc()) |> st_set_crs(3587) |> st_transform(4326) > > # NA values are converted to empty; #1114: > x <- data.frame(name=LETTERS) > y <- data.frame(name=LETTERS[1:13], letters[14:26]) > y$geometry <- st_sfc(st_point(c(0,0))) > y <- st_sf(y) > out = merge(x, y, all.x=TRUE) > class(out) [1] "data.frame" > > st_as_sf(st_sfc(st_point(0:1))) Simple feature collection with 1 feature and 0 fields Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 1 xmax: 0 ymax: 1 CRS: NA x 1 POINT (0 1) > > # st_exterior_ring(): > outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) > hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) > hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) > pts = list(outer, hole1, hole2) > pl1 = st_polygon(pts) > mpl1 = st_multipolygon(list(pl1,pl1+20)) > > spl1 = st_as_sfc(list(pl1),crs=4326) > smpl1 = st_as_sfc(list(mpl1),crs=4326) > > st_exterior_ring(spl1[[1]]) POLYGON ((0 0, 10 0, 10 10, 0 10, 0 0)) > st_exterior_ring(spl1) Geometry set for 1 feature Geometry type: POLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 10 ymax: 10 Geodetic CRS: WGS 84 POLYGON ((0 0, 10 0, 10 10, 0 10, 0 0)) > st_exterior_ring(st_sf(a = 1, geom = spl1)) Simple feature collection with 1 feature and 1 field Geometry type: POLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 10 ymax: 10 Geodetic CRS: WGS 84 a geom 1 1 POLYGON ((0 0, 10 0, 10 10,... > st_exterior_ring(smpl1[[1]]) MULTIPOLYGON (((0 0, 10 0, 10 10, 0 10, 0 0)), ((20 20, 30 20, 30 30, 20 30, 20 20))) > st_exterior_ring(st_sfc(smpl1)) Geometry set for 1 feature Geometry type: MULTIPOLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 30 ymax: 30 Geodetic CRS: WGS 84 MULTIPOLYGON (((0 0, 10 0, 10 10, 0 10, 0 0)), ... > st_exterior_ring(st_sf(a = 1, geom = st_sfc(smpl1))) Simple feature collection with 1 feature and 1 field Geometry type: MULTIPOLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 30 ymax: 30 Geodetic CRS: WGS 84 a geom 1 1 MULTIPOLYGON (((0 0, 10 0, ... > > '{"type":"Polygon","coordinates":[[]]}' |> read_sf() |> st_is_empty() [1] TRUE > # '{"type":"Polygon","coordinates":[]}' |> read_sf() |> st_is_empty() # breaks on GDAL < 3.9 or so > '{"type":"MultiPolygon","coordinates":[[[]]]}' |> read_sf() |> st_is_empty() [1] TRUE > '{"type":"MultiPolygon","coordinates":[[]]}' |> read_sf() |> st_is_empty() [1] TRUE > > proc.time() user system elapsed 5.476 1.458 5.453 ================================================ FILE: tests/sfg.R ================================================ suppressPackageStartupMessages(library(sf)) c(st_point(1:2), st_point(5:6)) c(st_point(1:2), st_multipoint(matrix(5:8,2))) c(st_multipoint(matrix(1:4,2)), st_multipoint(matrix(5:8,2))) c(st_linestring(matrix(1:6,3)), st_linestring(matrix(11:16,3))) c(st_linestring(matrix(1:6,3)), st_multilinestring(list(matrix(11:16,3)))) c(st_multilinestring(list(matrix(1:6,3))), st_multilinestring(list(matrix(11:16,3)))) pl = list(rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0))) c(st_polygon(pl), st_polygon(pl)) c(st_polygon(pl), st_multipolygon(list(pl))) c(st_linestring(matrix(1:6,3)), st_point(1:2)) c(st_geometrycollection(list(st_point(1:2), st_linestring(matrix(1:6,3)))), st_geometrycollection(list(st_multilinestring(list(matrix(11:16,3)))))) c(st_geometrycollection(list(st_point(1:2), st_linestring(matrix(1:6,3)))), st_multilinestring(list(matrix(11:16,3))), st_point(5:6), st_geometrycollection(list(st_point(10:11)))) head(st_point(0:1), 2) # Ops.sfg: ls = st_linestring(rbind(c(0,0),c(0,1))) pt = st_point(1:0) ls | pt ls / pt ls & pt ls %/% pt # arith: ls + pt ls - pt ls * pt ls / pt # unary: +pt -pt try(!pt) ================================================ FILE: tests/sfg.Rout.save ================================================ R Under development (unstable) (2025-11-05 r88988 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > suppressPackageStartupMessages(library(sf)) > c(st_point(1:2), st_point(5:6)) MULTIPOINT ((1 2), (5 6)) > c(st_point(1:2), st_multipoint(matrix(5:8,2))) MULTIPOINT ((1 2), (5 7), (6 8)) > c(st_multipoint(matrix(1:4,2)), st_multipoint(matrix(5:8,2))) MULTIPOINT ((1 3), (2 4), (5 7), (6 8)) > c(st_linestring(matrix(1:6,3)), st_linestring(matrix(11:16,3))) MULTILINESTRING ((1 4, 2 5, 3 6), (11 14, 12 15, 13 16)) > c(st_linestring(matrix(1:6,3)), st_multilinestring(list(matrix(11:16,3)))) MULTILINESTRING ((11 14, 12 15, 13 16), (1 4, 2 5, 3 6)) > c(st_multilinestring(list(matrix(1:6,3))), st_multilinestring(list(matrix(11:16,3)))) MULTILINESTRING ((1 4, 2 5, 3 6), (11 14, 12 15, 13 16)) > pl = list(rbind(c(0,0), c(1,0), c(1,1), c(0,1), c(0,0))) > c(st_polygon(pl), st_polygon(pl)) MULTIPOLYGON (((0 0, 1 0, 1 1, 0 1, 0 0)), ((0 0, 1 0, 1 1, 0 1, 0 0))) > c(st_polygon(pl), st_multipolygon(list(pl))) MULTIPOLYGON (((0 0, 1 0, 1 1, 0 1, 0 0)), ((0 0, 1 0, 1 1, 0 1, 0 0))) > c(st_linestring(matrix(1:6,3)), st_point(1:2)) GEOMETRYCOLLECTION (LINESTRING (1 4, 2 5, 3 6), POINT (1 2)) > c(st_geometrycollection(list(st_point(1:2), st_linestring(matrix(1:6,3)))), + st_geometrycollection(list(st_multilinestring(list(matrix(11:16,3)))))) GEOMETRYCOLLECTION (POINT (1 2), LINESTRING (1 4, 2 5, 3 6), MULTILINESTRING ((11 14, 12 15, 13 16))) > c(st_geometrycollection(list(st_point(1:2), st_linestring(matrix(1:6,3)))), + st_multilinestring(list(matrix(11:16,3))), st_point(5:6), + st_geometrycollection(list(st_point(10:11)))) GEOMETRYCOLLECTION (MULTILINESTRING ((11 14, 12 15, 13 16)), POINT (5 6), POINT (1 2), LINESTRING (1 4, 2 5, 3 6), POINT (10 11)) > head(st_point(0:1), 2) POINT (0 1) > > # Ops.sfg: > ls = st_linestring(rbind(c(0,0),c(0,1))) > pt = st_point(1:0) > ls | pt GEOMETRYCOLLECTION (LINESTRING (0 0, 0 1), POINT (1 0)) > ls / pt LINESTRING (0 0, 0 1) > ls & pt GEOMETRYCOLLECTION EMPTY > ls %/% pt GEOMETRYCOLLECTION (LINESTRING (0 0, 0 1), POINT (1 0)) > # arith: > ls + pt LINESTRING (1 0, 1 1) > ls - pt LINESTRING (-1 0, -1 1) > ls * pt LINESTRING (0 0, 0 0) > ls / pt LINESTRING (0 0, 0 1) > # unary: > +pt POINT (1 0) > -pt POINT (-1 0) > try(!pt) Error in Ops.sfg(pt) : unary ! not defined for "sfg" objects > > proc.time() user system elapsed 0.42 0.14 0.54 ================================================ FILE: tests/spatstat.R ================================================ suppressPackageStartupMessages(library(sf)) ## IGNORE_RDIFF_BEGIN if (require(spatstat.random, quietly = TRUE)) { data(chicago) st_as_sf(chicago) # ppp: g = gorillas st_as_sf(g) marks(g) = NULL st_as_sf(g) # multipolygon: https://github.com/r-spatial/sf/issues/1161 window = read_sf(system.file("shape/nc.shp", package = "sf")) |> st_transform(32119) win = spatstat.geom::as.owin(window) set.seed(1331) pp2a = runifpoint(n = 50, win = win) print(st_as_sf(pp2a)) # st_sample going the spatstat way x <- sf::st_sfc(sf::st_polygon(list(rbind(c(0, 0), c(10, 0), c(10, 10), c(0, 0))))) try(pts <- st_sample(x, type = "thomas")) try(pts <- st_sample(x, kappa = 1, mu = 10, type = "Thomas")) # points expected set.seed(1331) pts <- st_sample(x, kappa = 1, mu = 10, scale = 0.1, type = "Thomas") #plot(x) #plot(pts, add = TRUE) pts # see https://github.com/r-spatial/sf/issues/1233 # png("/tmp/spa%03d.png") p1 = st_point(0:1) p2 = st_point(1:2) p3 = st_point(c(-1,2)) p = st_sfc(p1, p2, p3) as.ppp(p) try(as.ppp(st_set_crs(p, 4326))) sf = st_sf(geom = p) try(as.ppp(sf)) sf = st_sf(a = 1:3, geom = p) as.ppp(sf) sf = st_sf(a = 1:3, b=3:1, geom = p) as.ppp(sf) # warns w = st_as_sfc(st_bbox(st_sfc(p1, p2))) sf = st_sf(a = 1:3, geom = p) (p0 = rbind(st_sf(a = 0, geom = w), sf)) suppressWarnings(try(as.ppp(p0))) # errors: one point outside window w = st_as_sfc(st_bbox(p)) sf = st_sf(a = 1:3, geom = p) (p0 = rbind(st_sf(a = 0, geom = w), sf)) as.ppp(p0) # as.owin.sf, as.owin.sfc_* nc = st_read(system.file("gpkg/nc.gpkg", package="sf"), check_ring_dir = TRUE, quiet = TRUE) try(as.owin(nc)) # should be projected nc = st_transform(nc, 32119) plot(as.owin(nc), col = 'grey') plot(as.owin(st_geometry(nc)), col = 'grey') sq = rbind(c(-1,-1), c(1, -1), c(1,1), c(-1,1), c(-1,-1)) pol = st_polygon(list(0.5 * sq, sq[5:1,] * 0.45)) # w hole plot(as.owin(pol), col = 'grey') plot(as.owin(st_sfc(pol)), col = 'grey') mpol = st_multipolygon(list( list(sq, sq[5:1,] * 0.9), list(sq * 2, sq[5:1,] * 1.8))) plot(as.owin(mpol), col = 'grey') plot(as.owin(st_sfc(mpol)), col = 'grey') plot(as.owin(st_sfc(pol, mpol)), col = 'grey') plot(as.owin(st_sf(a=1:2, st_sfc(pol, mpol))), col = 'grey') (o = as.owin(st_sf(a=1:2, st_sfc(pol, mpol)))) st_as_sfc(o) plot(st_as_sfc(o), col = 'blue', main = 'st_as_sfc(o)') plot(st_as_sf(o), col = 'blue', main = 'st_as_sf(o)') data(japanesepines) st_as_sf(japanesepines) # warns about multiplier jp = rescale(japanesepines) st_as_sf(jp) # No warning data(nztrees) qNZ <- quadratcount(nztrees, nx=4, ny=3) ts = as.tess(qNZ) plot(st_as_sfc(ts)) ls = st_linestring(rbind(c(0,0), c(1,1), c(2,0))) plot(as.psp(ls)) mls = st_multilinestring(list(rbind(c(0,0), c(1,1), c(2,0)), rbind(c(3,3), c(4,2)))) plot(as.psp(mls)) plot(as.psp(st_sfc(ls))) plot(as.psp(st_sfc(mls))) plot(as.psp(st_sfc(ls, mls))) sf = st_sf(st_cast(st_sfc(ls, mls), "MULTILINESTRING"), marks = 1:2, foo = 2:1) as.psp(sf) # picks marks itself as.psp(sf, marks = 5:1) (x = st_as_sf(as.psp(sf))) (y = st_as_sfc(as.psp(sf))) all.equal(st_geometry(x), y) # Test sf -> ppp conversion when the conversion involves more than 1 column of mark(s) # (https://github.com/r-spatial/sf/issues/2450) reference_ppp <- ppp( x = c(0.25, 0.75), y = c(0.25, 0.75), # We consider a data.frame of marks which includes several types of columns # (and also a list column) marks = data.frame( a = TRUE, b = 1L, c = pi, d = I(list(list(1, 2), list("A", "B", "C"))), #NB: row.names should always defined as a vector with character character #since they are converted as characters when applying st_as_sf (see line #below) which mixes NA and not-NA row.names row.names = c("point1", "point2") ) ) # The st_as_sf conversion returns an sf object where the first row is the Window # and the other rows are the points tmp <- st_as_sf(reference_ppp) pts <- tmp[tmp$label == "point", 1:4] target_ppp <- as.ppp(pts) Window(target_ppp) <- owin() all.equal(reference_ppp, target_ppp) } ## IGNORE_RDIFF_END ================================================ FILE: tests/spatstat.Rout.save ================================================ R Under development (unstable) (2025-11-05 r88988 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > suppressPackageStartupMessages(library(sf)) > ## IGNORE_RDIFF_BEGIN > if (require(spatstat.random, quietly = TRUE)) { + + data(chicago) + st_as_sf(chicago) + # ppp: + g = gorillas + st_as_sf(g) + marks(g) = NULL + st_as_sf(g) + + # multipolygon: https://github.com/r-spatial/sf/issues/1161 + window = read_sf(system.file("shape/nc.shp", package = "sf")) %>% + st_transform(32119) + + win = spatstat.geom::as.owin(window) + + set.seed(1331) + pp2a = runifpoint(n = 50, win = win) + print(st_as_sf(pp2a)) + + # st_sample going the spatstat way + x <- sf::st_sfc(sf::st_polygon(list(rbind(c(0, 0), c(10, 0), c(10, 10), c(0, 0))))) + try(pts <- st_sample(x, type = "thomas")) + try(pts <- st_sample(x, kappa = 1, mu = 10, type = "Thomas")) + # points expected + set.seed(1331) + pts <- st_sample(x, kappa = 1, mu = 10, scale = 0.1, type = "Thomas") + #plot(x) + #plot(pts, add = TRUE) + pts + + # see https://github.com/r-spatial/sf/issues/1233 + # png("/tmp/spa%03d.png") + + p1 = st_point(0:1) + p2 = st_point(1:2) + p3 = st_point(c(-1,2)) + p = st_sfc(p1, p2, p3) + as.ppp(p) + try(as.ppp(st_set_crs(p, 4326))) + + sf = st_sf(geom = p) + try(as.ppp(sf)) + sf = st_sf(a = 1:3, geom = p) + as.ppp(sf) + sf = st_sf(a = 1:3, b=3:1, geom = p) + as.ppp(sf) # warns + + w = st_as_sfc(st_bbox(st_sfc(p1, p2))) + sf = st_sf(a = 1:3, geom = p) + (p0 = rbind(st_sf(a = 0, geom = w), sf)) + suppressWarnings(try(as.ppp(p0))) # errors: one point outside window + + w = st_as_sfc(st_bbox(p)) + sf = st_sf(a = 1:3, geom = p) + (p0 = rbind(st_sf(a = 0, geom = w), sf)) + as.ppp(p0) + + # as.owin.sf, as.owin.sfc_* + nc = st_read(system.file("gpkg/nc.gpkg", package="sf"), check_ring_dir = TRUE, quiet = TRUE) + try(as.owin(nc)) # should be projected + nc = st_transform(nc, 32119) + plot(as.owin(nc), col = 'grey') + plot(as.owin(st_geometry(nc)), col = 'grey') + + sq = rbind(c(-1,-1), c(1, -1), c(1,1), c(-1,1), c(-1,-1)) + pol = st_polygon(list(0.5 * sq, sq[5:1,] * 0.45)) # w hole + plot(as.owin(pol), col = 'grey') + plot(as.owin(st_sfc(pol)), col = 'grey') + mpol = st_multipolygon(list( + list(sq, sq[5:1,] * 0.9), + list(sq * 2, sq[5:1,] * 1.8))) + plot(as.owin(mpol), col = 'grey') + plot(as.owin(st_sfc(mpol)), col = 'grey') + plot(as.owin(st_sfc(pol, mpol)), col = 'grey') + plot(as.owin(st_sf(a=1:2, st_sfc(pol, mpol))), col = 'grey') + (o = as.owin(st_sf(a=1:2, st_sfc(pol, mpol)))) + st_as_sfc(o) + + plot(st_as_sfc(o), col = 'blue', main = 'st_as_sfc(o)') + plot(st_as_sf(o), col = 'blue', main = 'st_as_sf(o)') + + data(japanesepines) + st_as_sf(japanesepines) # warns about multiplier + jp = rescale(japanesepines) + st_as_sf(jp) # No warning + + data(nztrees) + qNZ <- quadratcount(nztrees, nx=4, ny=3) + ts = as.tess(qNZ) + plot(st_as_sfc(ts)) + + ls = st_linestring(rbind(c(0,0), c(1,1), c(2,0))) + plot(as.psp(ls)) + mls = st_multilinestring(list(rbind(c(0,0), c(1,1), c(2,0)), rbind(c(3,3), c(4,2)))) + plot(as.psp(mls)) + + plot(as.psp(st_sfc(ls))) + plot(as.psp(st_sfc(mls))) + plot(as.psp(st_sfc(ls, mls))) + + sf = st_sf(st_cast(st_sfc(ls, mls), "MULTILINESTRING"), marks = 1:2, foo = 2:1) + as.psp(sf) # picks marks itself + as.psp(sf, marks = 5:1) + + (x = st_as_sf(as.psp(sf))) + (y = st_as_sfc(as.psp(sf))) + all.equal(st_geometry(x), y) + + # Test sf -> ppp conversion when the conversion involves more than 1 column of mark(s) + # (https://github.com/r-spatial/sf/issues/2450) + reference_ppp <- ppp( + x = c(0.25, 0.75), + y = c(0.25, 0.75), + # We consider a data.frame of marks which includes several types of columns + # (and also a list column) + marks = data.frame( + a = TRUE, b = 1L, c = pi, d = I(list(list(1, 2), list("A", "B", "C"))), + #NB: row.names should always defined as a vector with character character + #since they are converted as characters when applying st_as_sf (see line + #below) which mixes NA and not-NA row.names + row.names = c("point1", "point2") + ) + ) + # The st_as_sf conversion returns an sf object where the first row is the Window + # and the other rows are the points + tmp <- st_as_sf(reference_ppp) + pts <- tmp[tmp$label == "point", 1:4] + target_ppp <- as.ppp(pts) + Window(target_ppp) <- owin() + all.equal(reference_ppp, target_ppp) + } spatstat.univar 3.1-4 spatstat.geom 3.6-0 spatstat.random 3.4-2 Simple feature collection with 51 features and 1 field Geometry type: GEOMETRY Dimension: XY Bounding box: xmin: 123829.8 ymin: 14740.06 xmax: 930518.6 ymax: 318255.5 CRS: NA First 10 features: label geom 1 window MULTIPOLYGON (((886135.8 31... 2 point POINT (339121.1 257811.6) 3 point POINT (827440.4 246568.3) 4 point POINT (451339.2 207943.6) 5 point POINT (268749.7 203323.4) 6 point POINT (516676.5 198556.1) 7 point POINT (692366 238643.1) 8 point POINT (843278.5 287241.6) 9 point POINT (648477.7 235466.6) 10 point POINT (852593 267248.3) Error in st_poly_sample(x, size = size, ..., type = type, by_polygon = by_polygon, : rthomas is not an exported function from spatstat.random. Error in st_poly_sample(x, size = size, ..., type = type, by_polygon = by_polygon, : The spatstat function rThomas did not return a valid result. Consult the help file. Error message from spatstat: Error in spatstat_fun(..., win = spatstat.geom::as.owin(x)) : argument "scale" is missing, with no default Error : Only projected coordinates may be converted to spatstat class objects Error in `marks<-.ppp`(`*tmp*`, value = value) : number of rows of data frame != number of points Error : Only projected coordinates may be converted to spatstat class objects [1] TRUE Warning message: In st_as_sfc.owin(spatstat.geom::as.owin(x)) : The spatstat object has an measurement unit multiplier != 1. Consider rescaling before converting. > ## IGNORE_RDIFF_END > > proc.time() user system elapsed 1.92 0.46 2.39 ================================================ FILE: tests/stars.R ================================================ suppressPackageStartupMessages(library(sf)) tif = system.file("tif/geomatrix.tif", package = "sf") gdal_metadata(tif) gdal_metadata(tif, NA_character_) try(gdal_metadata(tif, "wrongDomain")) gdal_metadata(tif, c("IMAGE_STRUCTURE")) try(length(gdal_metadata(tif, c("DERIVED_SUBDATASETS")))) # fails on Fedora 26 if (require(stars, quietly = TRUE)) { tif = system.file("tif/geomatrix.tif", package = "sf") r = read_stars(tif) d = (st_dimensions(r)) gt = c(1841001.75, 1.5, -5, 1144003.25, -5, -1.5) x1 = st_as_sfc(d, as_points = TRUE, use_cpp = TRUE, geotransform = gt) x2 = st_as_sfc(d, as_points = TRUE, use_cpp = FALSE, geotransform = gt) print(identical(x1, x2)) y1 = st_as_sfc(d, as_points = FALSE, use_cpp = TRUE, geotransform = gt) y2 = st_as_sfc(d, as_points = FALSE, use_cpp = FALSE, geotransform = gt) print(identical(y1, y2)) # rectilinear grid: m = matrix(1:20, nrow = 5, ncol = 4) x = c(0,0.5,1,2,4,5) y = c(0.3,0.5,1,2,2.2) r = st_as_stars(list(m = m), dimensions = st_dimensions(x = x, y = y, .raster = c("x", "y"))) print(st_as_sfc(st_dimensions(r), as_points = TRUE)) print(st_as_sfc(st_dimensions(r), as_points = FALSE)) # curvilinear grid: lon = st_as_stars(matrix(1:5, 4, 5, byrow = TRUE)) lat = st_as_stars(matrix(1:4, 4, 5)) ll = c(X1 = lon, X2 = lat) curv = st_as_stars(st_as_stars(t(m)), curvilinear = setNames(ll, c("X1", "X2"))) print(st_as_sfc(st_dimensions(curv), as_points = TRUE)) print(st_as_sfc(st_dimensions(curv), as_points = FALSE)) demo(nc, echo = FALSE, ask = FALSE) print(x <- st_rasterize(nc)) # default grid: print(p <- st_as_sf(x, as_points = FALSE)) # polygonize: follow raster boundaries print(p <- st_as_sf(x, as_points = FALSE, use_integer = TRUE)) # polygonize integers: follow raster boundaries print(try(p <- st_as_sf(x, as_points = TRUE))) # polygonize: contour, requies GDAL >= 2.4.0 if (utils::packageVersion("stars") >= "0.2-1") { write_stars(read_stars(tif), tempfile(fileext = ".tif")) write_stars(read_stars(tif, proxy = TRUE), tempfile(fileext = ".tif")) write_stars(read_stars(tif, proxy = TRUE), tempfile(fileext = ".tif"), chunk_size = c(200,200)) na.tif = read_stars(system.file("tif/na.tif", package = "stars")) write_stars(na.tif, "na.tif") write_stars(na.tif, "na.tif", NA_value = -999) na.tif = read_stars(system.file("tif/na.tif", package = "stars"), NA_value = -999) write_stars(na.tif, "na.tif") write_stars(na.tif, "na.tif", NA_value = -999) na.tif = read_stars(system.file("tif/na.tif", package = "stars"), NA_value = -999, proxy = TRUE) write_stars(na.tif, "na.tif") write_stars(na.tif, "na.tif", NA_value = -999) } # https://github.com/mtennekes/tmap/issues/368 if (utils::packageVersion("stars") > "0.4-0") { lc = system.file('tif/lc.tif', package = 'stars') if (lc != "") { r = read_stars(lc, RAT = "Land Cover Class") r <- droplevels(r) } } } r = gdal_read(tif) gt = c(0,1,0,0,0,1) gdal_inv_geotransform(gt) rc = expand.grid(x=1:3, y = 1:3) #(xy = xy_from_colrow(rc, gt)) #xy_from_colrow(xy, gt, inverse = TRUE) crs <- gdal_crs(tif) try(gdal_metadata("foo")) gdal_metadata(tif) suppressMessages( suppressWarnings( if (require(stars, quietly = TRUE)) { p = normalizePath(system.file("nc/ones.zarr.zip", package = "sf")) z = paste0('ZARR:/vsizip/"', p, '"/ones.zarr') d = try(gdal_utils("mdiminfo", z), silent = TRUE) if (!inherits(d, "try-error")) { print(d) cat("\n") } e = try(read_stars(z, normalize_path = FALSE), silent = TRUE) f = try(read_mdim(z, normalize_path = FALSE), silent = TRUE) if (inherits(e, "try-error") || inherits(f, "try-error")) { print("Cannot read blosc-compressed Zarr file: blosc not supported?") } else { print(e) print(f) } } )) ================================================ FILE: tests/stars.Rout.save ================================================ R version 4.5.2 (2025-10-31) -- "[Not] Part in a Rumble" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > suppressPackageStartupMessages(library(sf)) > > tif = system.file("tif/geomatrix.tif", package = "sf") > > gdal_metadata(tif) [1] "AREA_OR_POINT=Point" > gdal_metadata(tif, NA_character_) [1] "IMAGE_STRUCTURE" "DERIVED_SUBDATASETS" "" > try(gdal_metadata(tif, "wrongDomain")) Error in gdal_metadata(tif, "wrongDomain") : domain_item[1] not found in available metadata domains > gdal_metadata(tif, c("IMAGE_STRUCTURE")) $INTERLEAVE [1] "BAND" attr(,"class") [1] "gdal_metadata" > try(length(gdal_metadata(tif, c("DERIVED_SUBDATASETS")))) # fails on Fedora 26 [1] 2 > > if (require(stars, quietly = TRUE)) { + tif = system.file("tif/geomatrix.tif", package = "sf") + r = read_stars(tif) + d = (st_dimensions(r)) + gt = c(1841001.75, 1.5, -5, 1144003.25, -5, -1.5) + x1 = st_as_sfc(d, as_points = TRUE, use_cpp = TRUE, geotransform = gt) + x2 = st_as_sfc(d, as_points = TRUE, use_cpp = FALSE, geotransform = gt) + print(identical(x1, x2)) + y1 = st_as_sfc(d, as_points = FALSE, use_cpp = TRUE, geotransform = gt) + y2 = st_as_sfc(d, as_points = FALSE, use_cpp = FALSE, geotransform = gt) + print(identical(y1, y2)) + + # rectilinear grid: + m = matrix(1:20, nrow = 5, ncol = 4) + x = c(0,0.5,1,2,4,5) + y = c(0.3,0.5,1,2,2.2) + r = st_as_stars(list(m = m), dimensions = st_dimensions(x = x, y = y, .raster = c("x", "y"))) + print(st_as_sfc(st_dimensions(r), as_points = TRUE)) + print(st_as_sfc(st_dimensions(r), as_points = FALSE)) + + # curvilinear grid: + lon = st_as_stars(matrix(1:5, 4, 5, byrow = TRUE)) + lat = st_as_stars(matrix(1:4, 4, 5)) + ll = c(X1 = lon, X2 = lat) + curv = st_as_stars(st_as_stars(t(m)), curvilinear = setNames(ll, c("X1", "X2"))) + print(st_as_sfc(st_dimensions(curv), as_points = TRUE)) + print(st_as_sfc(st_dimensions(curv), as_points = FALSE)) + + demo(nc, echo = FALSE, ask = FALSE) + print(x <- st_rasterize(nc)) # default grid: + print(p <- st_as_sf(x, as_points = FALSE)) # polygonize: follow raster boundaries + print(p <- st_as_sf(x, as_points = FALSE, use_integer = TRUE)) # polygonize integers: follow raster boundaries + print(try(p <- st_as_sf(x, as_points = TRUE))) # polygonize: contour, requies GDAL >= 2.4.0 + if (utils::packageVersion("stars") >= "0.2-1") { + write_stars(read_stars(tif), tempfile(fileext = ".tif")) + write_stars(read_stars(tif, proxy = TRUE), tempfile(fileext = ".tif")) + write_stars(read_stars(tif, proxy = TRUE), tempfile(fileext = ".tif"), chunk_size = c(200,200)) + na.tif = read_stars(system.file("tif/na.tif", package = "stars")) + write_stars(na.tif, "na.tif") + write_stars(na.tif, "na.tif", NA_value = -999) + na.tif = read_stars(system.file("tif/na.tif", package = "stars"), NA_value = -999) + write_stars(na.tif, "na.tif") + write_stars(na.tif, "na.tif", NA_value = -999) + na.tif = read_stars(system.file("tif/na.tif", package = "stars"), NA_value = -999, proxy = TRUE) + write_stars(na.tif, "na.tif") + write_stars(na.tif, "na.tif", NA_value = -999) + } + # https://github.com/mtennekes/tmap/issues/368 + if (utils::packageVersion("stars") > "0.4-0") { + lc = system.file('tif/lc.tif', package = 'stars') + if (lc != "") { + r = read_stars(lc, RAT = "Land Cover Class") + r <- droplevels(r) + } + } + } [1] TRUE [1] TRUE Geometry set for 20 features Geometry type: POINT Dimension: XY Bounding box: xmin: 0.25 ymin: 0.4 xmax: 4.5 ymax: 2.1 CRS: NA First 5 geometries: POINT (0.25 0.4) POINT (0.75 0.4) POINT (1.5 0.4) POINT (3 0.4) POINT (4.5 0.4) Geometry set for 20 features Geometry type: POLYGON Dimension: XY Bounding box: xmin: 0 ymin: 0.3 xmax: 5 ymax: 2.2 CRS: NA First 5 geometries: POLYGON ((0 0.3, 0.5 0.3, 0.5 0.5, 0 0.5, 0 0.3)) POLYGON ((0.5 0.3, 1 0.3, 1 0.5, 0.5 0.5, 0.5 0... POLYGON ((1 0.3, 2 0.3, 2 0.5, 1 0.5, 1 0.3)) POLYGON ((2 0.3, 4 0.3, 4 0.5, 2 0.5, 2 0.3)) POLYGON ((4 0.3, 5 0.3, 5 0.5, 4 0.5, 4 0.3)) Geometry set for 20 features Geometry type: POINT Dimension: XY Bounding box: xmin: 1 ymin: 1 xmax: 5 ymax: 4 Geodetic CRS: WGS 84 (CRS84) First 5 geometries: POINT (1 1) POINT (1 2) POINT (1 3) POINT (1 4) POINT (2 1) Geometry set for 20 features Geometry type: POLYGON Dimension: XY Bounding box: xmin: 0.5 ymin: 0.5 xmax: 5.5 ymax: 4.5 Geodetic CRS: WGS 84 (CRS84) First 5 geometries: POLYGON ((0.5 0.5, 0.5 1.5, 1.5 1.5, 1.5 0.5, 0... POLYGON ((0.5 1.5, 0.5 2.5, 1.5 2.5, 1.5 1.5, 0... POLYGON ((0.5 2.5, 0.5 3.5, 1.5 3.5, 1.5 2.5, 0... POLYGON ((0.5 3.5, 0.5 4.5, 1.5 4.5, 1.5 3.5, 0... POLYGON ((1.5 0.5, 1.5 1.5, 2.5 1.5, 2.5 0.5, 1... stars object with 2 dimensions and 12 attributes attribute(s): Min. 1st Qu. Median Mean 3rd Qu. Max. NAs AREA 0.042 0.108 0.142 1.451932e-01 0.181 0.241 30904 PERIMETER 0.999 1.461 1.716 1.786110e+00 2.004 3.640 30904 CNTY_ 1825.000 1907.000 1989.000 1.998403e+03 2085.000 2241.000 30904 CNTY_ID 1825.000 1907.000 1989.000 1.998403e+03 2085.000 2241.000 30904 FIPSNO 37001.000 37049.000 37101.000 3.710042e+04 37153.000 37199.000 30904 CRESS_ID 1.000 25.000 51.000 5.071206e+01 77.000 100.000 30904 BIR74 248.000 1323.000 2648.000 3.791637e+03 4139.000 21588.000 30904 SID74 0.000 3.000 5.000 7.891985e+00 10.000 44.000 30904 NWBIR74 1.000 297.000 844.000 1.246210e+03 1396.000 8027.000 30904 BIR79 319.000 1606.000 3108.000 4.852046e+03 5400.000 30757.000 30904 SID79 0.000 3.000 6.000 9.584098e+00 13.000 57.000 30904 NWBIR79 3.000 360.000 1058.000 1.604642e+03 1524.000 11631.000 30904 dimension(s): from to offset delta refsys point x/y x 1 461 -84.32 0.01925 NAD27 FALSE [x] y 1 141 36.59 -0.01925 NAD27 FALSE [y] Simple feature collection with 34097 features and 12 fields Geometry type: POLYGON Dimension: XY Bounding box: xmin: -84.32385 ymin: 33.87563 xmax: -75.45034 ymax: 36.58965 Geodetic CRS: NAD27 First 10 features: AREA PERIMETER CNTY_ CNTY_ID FIPSNO CRESS_ID BIR74 SID74 NWBIR74 BIR79 1 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 2 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 3 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 4 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 5 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 6 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 7 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 8 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 9 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 10 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 SID79 NWBIR79 geometry 1 0 19 POLYGON ((-81.66757 36.5896... 2 0 19 POLYGON ((-81.64833 36.5896... 3 0 19 POLYGON ((-81.62908 36.5896... 4 0 19 POLYGON ((-81.60983 36.5896... 5 0 19 POLYGON ((-81.59058 36.5896... 6 0 19 POLYGON ((-81.57133 36.5896... 7 0 19 POLYGON ((-81.55208 36.5896... 8 0 19 POLYGON ((-81.53283 36.5896... 9 0 19 POLYGON ((-81.51359 36.5896... 10 0 19 POLYGON ((-81.49434 36.5896... Simple feature collection with 34097 features and 12 fields Geometry type: POLYGON Dimension: XY Bounding box: xmin: -84.32385 ymin: 33.87563 xmax: -75.45034 ymax: 36.58965 Geodetic CRS: NAD27 First 10 features: AREA PERIMETER CNTY_ CNTY_ID FIPSNO CRESS_ID BIR74 SID74 NWBIR74 BIR79 1 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 2 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 3 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 4 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 5 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 6 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 7 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 8 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 9 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 10 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 SID79 NWBIR79 geometry 1 0 19 POLYGON ((-81.66757 36.5896... 2 0 19 POLYGON ((-81.64833 36.5896... 3 0 19 POLYGON ((-81.62908 36.5896... 4 0 19 POLYGON ((-81.60983 36.5896... 5 0 19 POLYGON ((-81.59058 36.5896... 6 0 19 POLYGON ((-81.57133 36.5896... 7 0 19 POLYGON ((-81.55208 36.5896... 8 0 19 POLYGON ((-81.53283 36.5896... 9 0 19 POLYGON ((-81.51359 36.5896... 10 0 19 POLYGON ((-81.49434 36.5896... Simple feature collection with 34097 features and 12 fields Geometry type: POINT Dimension: XY Bounding box: xmin: -84.31423 ymin: 33.88525 xmax: -75.45997 ymax: 36.58003 Geodetic CRS: NAD27 First 10 features: AREA PERIMETER CNTY_ CNTY_ID FIPSNO CRESS_ID BIR74 SID74 NWBIR74 BIR79 1 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 2 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 3 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 4 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 5 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 6 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 7 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 8 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 9 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 10 0.114 1.442 1825 1825 37009 5 1091 1 10 1364 SID79 NWBIR79 geometry 1 0 19 POINT (-81.65795 36.58003) 2 0 19 POINT (-81.6387 36.58003) 3 0 19 POINT (-81.61945 36.58003) 4 0 19 POINT (-81.6002 36.58003) 5 0 19 POINT (-81.58096 36.58003) 6 0 19 POINT (-81.56171 36.58003) 7 0 19 POINT (-81.54246 36.58003) 8 0 19 POINT (-81.52321 36.58003) 9 0 19 POINT (-81.50396 36.58003) 10 0 19 POINT (-81.48471 36.58003) > > r = gdal_read(tif) > gt = c(0,1,0,0,0,1) > gdal_inv_geotransform(gt) [1] 0 1 0 0 0 1 > rc = expand.grid(x=1:3, y = 1:3) > #(xy = xy_from_colrow(rc, gt)) > #xy_from_colrow(xy, gt, inverse = TRUE) > crs <- gdal_crs(tif) > > try(gdal_metadata("foo")) [1] NA > gdal_metadata(tif) [1] "AREA_OR_POINT=Point" > > suppressMessages( + suppressWarnings( + if (require(stars, quietly = TRUE)) { + p = normalizePath(system.file("nc/ones.zarr.zip", package = "sf")) + z = paste0('ZARR:/vsizip/"', p, '"/ones.zarr') + d = try(gdal_utils("mdiminfo", z), silent = TRUE) + if (!inherits(d, "try-error")) { + print(d) + cat("\n") + } + e = try(read_stars(z, normalize_path = FALSE), silent = TRUE) + f = try(read_mdim(z, normalize_path = FALSE), silent = TRUE) + if (inherits(e, "try-error") || inherits(f, "try-error")) { + print("Cannot read blosc-compressed Zarr file: blosc not supported?") + } else { + print(e) + print(f) + } + } + )) { "type": "group", "driver": "Zarr", "name": "/", "arrays": { "ones": { "datatype": "Int32", "dimensions": [ { "name": "dim0", "full_name": "dim0", "size": 100 }, { "name": "dim1", "full_name": "dim1", "size": 100 } ], "dimension_size": [ 100, 100 ], "block_size": [ 50, 50 ], "nodata_value": 0, "structural_info": { "COMPRESSOR": "{ \"blocksize\": 0, \"clevel\": 5, \"cname\": \"lz4\", \"id\": \"blosc\", \"shuffle\": 1 }" } } } }[1] "{\n \"type\": \"group\",\n \"driver\": \"Zarr\",\n \"name\": \"/\",\n \"arrays\": {\n \"ones\": {\n \"datatype\": \"Int32\",\n \"dimensions\": [\n {\n \"name\": \"dim0\",\n \"full_name\": \"dim0\",\n \"size\": 100\n },\n {\n \"name\": \"dim1\",\n \"full_name\": \"dim1\",\n \"size\": 100\n }\n ],\n \"dimension_size\": [\n 100,\n 100\n ],\n \"block_size\": [\n 50,\n 50\n ],\n \"nodata_value\": 0,\n \"structural_info\": {\n \"COMPRESSOR\": \"{ \\\"blocksize\\\": 0, \\\"clevel\\\": 5, \\\"cname\\\": \\\"lz4\\\", \\\"id\\\": \\\"blosc\\\", \\\"shuffle\\\": 1 }\"\n }\n }\n }\n}" stars object with 2 dimensions and 1 attribute attribute(s): Min. 1st Qu. Median Mean 3rd Qu. Max. ones.zarr 1 1 1 1 1 1 dimension(s): from to offset delta x/y x 1 100 0 1 [x] y 1 100 100 -1 [y] stars object with 2 dimensions and 1 attribute attribute(s): Min. 1st Qu. Median Mean 3rd Qu. Max. ones 1 1 1 1 1 1 dimension(s): from to offset delta x/y dim1 1 100 0.5 1 [x] dim0 1 100 0.5 1 [y] > > proc.time() user system elapsed 1.948 4.046 1.515 ================================================ FILE: tests/test-by-element.R ================================================ suppressPackageStartupMessages(library(sf)) # setup b0 = st_polygon(list(rbind(c(0,0), c(2,0), c(2,2), c(0,2), c(0,0)))) b1 = st_polygon(list(rbind(c(1,1), c(3,1), c(3,3), c(1,3), c(1,1)))) b2 = st_polygon(list(rbind(c(5,5), c(6,5), c(6,6), c(5,6), c(5,5)))) a0 = st_polygon(list(rbind(c(0.5,0.5), c(1.5,0.5), c(1.5,1.5), c(0.5,1.5), c(0.5,0.5)))) a1 = st_polygon(list(rbind(c(1.5,1.5), c(2.5,1.5), c(2.5,2.5), c(1.5,2.5), c(1.5,1.5)))) a2 = st_polygon(list(rbind(c(5.1,5.1), c(5.9,5.1), c(5.9,5.9), c(5.1,5.9), c(5.1,5.1)))) x = st_sfc(b0, b1, b2) y = st_sfc(a0, a1, a2) # predicates r = st_intersects(x, y, by_element = TRUE) stopifnot(is.logical(r), length(r) == 3, all(r)) r = st_contains(x, y, by_element = TRUE) stopifnot(is.logical(r), all(r)) r = !st_intersects(st_sfc(b0, b2), st_sfc(b2, b0), by_element = TRUE) stopifnot(is.logical(r), all(r)) # relate r = st_relate(x, y, by_element = TRUE) stopifnot(is.character(r), length(r) == 3, all(nchar(r) == 9)) r = st_relate(x, y, pattern = "T********", by_element = TRUE) stopifnot(is.logical(r), length(r) == 3) # geometric ops: correctness r = st_intersection(x, y, by_element = TRUE) m = st_sfc(st_intersection(b0, a0), st_intersection(b1, a1), st_intersection(b2, a2)) stopifnot(inherits(r, "sfc"), length(r) == 3) stopifnot(all(st_equals(r, m, sparse = FALSE)[cbind(1:3, 1:3)])) # geometric ops: empty result for disjoint pair r = st_intersection(st_sfc(b0), st_sfc(b2), by_element = TRUE) stopifnot(st_is_empty(r[1])) # difference and sym_difference r = st_difference(st_sfc(b0), st_sfc(a0), by_element = TRUE) stopifnot(st_equals(r[[1]], st_difference(b0, a0), sparse = FALSE)[1,1]) r = st_sym_difference(st_sfc(b0), st_sfc(a0), by_element = TRUE) stopifnot(st_equals(r[[1]], st_sym_difference(b0, a0), sparse = FALSE)[1,1]) # unequal lengths error try(st_intersects(st_sfc(b0, b1), st_sfc(a0), by_element = TRUE)) try(st_intersection(st_sfc(b0, b1), st_sfc(a0), by_element = TRUE)) # distance: non-POINT geometries l = st_sfc(st_linestring(rbind(c(0,0), c(1,0))), st_linestring(rbind(c(0,1), c(1,1)))) m = st_sfc(st_linestring(rbind(c(0,2), c(1,2))), st_linestring(rbind(c(0,3), c(1,3)))) d = st_distance(l, m, by_element = TRUE) stopifnot(all.equal(as.numeric(d), c(2, 2))) # defaults unchanged stopifnot(length(st_intersection(x, x)) >= 3) stopifnot(inherits(st_intersects(x, y), "sgbp")) ================================================ FILE: tests/test-by-element.Rout.save ================================================ R version 4.5.3 (2026-03-11) -- "Reassured Reassurer" Copyright (C) 2026 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > suppressPackageStartupMessages(library(sf)) > > # setup > b0 = st_polygon(list(rbind(c(0,0), c(2,0), c(2,2), c(0,2), c(0,0)))) > b1 = st_polygon(list(rbind(c(1,1), c(3,1), c(3,3), c(1,3), c(1,1)))) > b2 = st_polygon(list(rbind(c(5,5), c(6,5), c(6,6), c(5,6), c(5,5)))) > a0 = st_polygon(list(rbind(c(0.5,0.5), c(1.5,0.5), c(1.5,1.5), c(0.5,1.5), c(0.5,0.5)))) > a1 = st_polygon(list(rbind(c(1.5,1.5), c(2.5,1.5), c(2.5,2.5), c(1.5,2.5), c(1.5,1.5)))) > a2 = st_polygon(list(rbind(c(5.1,5.1), c(5.9,5.1), c(5.9,5.9), c(5.1,5.9), c(5.1,5.1)))) > x = st_sfc(b0, b1, b2) > y = st_sfc(a0, a1, a2) > > # predicates > r = st_intersects(x, y, by_element = TRUE) > stopifnot(is.logical(r), length(r) == 3, all(r)) > r = st_contains(x, y, by_element = TRUE) > stopifnot(is.logical(r), all(r)) > r = !st_intersects(st_sfc(b0, b2), st_sfc(b2, b0), by_element = TRUE) > stopifnot(is.logical(r), all(r)) > > # relate > r = st_relate(x, y, by_element = TRUE) > stopifnot(is.character(r), length(r) == 3, all(nchar(r) == 9)) > r = st_relate(x, y, pattern = "T********", by_element = TRUE) > stopifnot(is.logical(r), length(r) == 3) > > # geometric ops: correctness > r = st_intersection(x, y, by_element = TRUE) > m = st_sfc(st_intersection(b0, a0), st_intersection(b1, a1), st_intersection(b2, a2)) > stopifnot(inherits(r, "sfc"), length(r) == 3) > stopifnot(all(st_equals(r, m, sparse = FALSE)[cbind(1:3, 1:3)])) > > # geometric ops: empty result for disjoint pair > r = st_intersection(st_sfc(b0), st_sfc(b2), by_element = TRUE) > stopifnot(st_is_empty(r[1])) > > # difference and sym_difference > r = st_difference(st_sfc(b0), st_sfc(a0), by_element = TRUE) > stopifnot(st_equals(r[[1]], st_difference(b0, a0), sparse = FALSE)[1,1]) > r = st_sym_difference(st_sfc(b0), st_sfc(a0), by_element = TRUE) > stopifnot(st_equals(r[[1]], st_sym_difference(b0, a0), sparse = FALSE)[1,1]) > > # unequal lengths error > try(st_intersects(st_sfc(b0, b1), st_sfc(a0), by_element = TRUE)) Error in st_geos_binop("intersects", x, y, sparse = sparse, prepared = prepared, : length(x) == length(y) is not TRUE > try(st_intersection(st_sfc(b0, b1), st_sfc(a0), by_element = TRUE)) Error in geos_op2_geom("intersection", x, y, ...) : length(x) == length(y) is not TRUE > > # distance: non-POINT geometries > l = st_sfc(st_linestring(rbind(c(0,0), c(1,0))), st_linestring(rbind(c(0,1), c(1,1)))) > m = st_sfc(st_linestring(rbind(c(0,2), c(1,2))), st_linestring(rbind(c(0,3), c(1,3)))) > d = st_distance(l, m, by_element = TRUE) > stopifnot(all.equal(as.numeric(d), c(2, 2))) > > # defaults unchanged > stopifnot(length(st_intersection(x, x)) >= 3) > stopifnot(inherits(st_intersects(x, y), "sgbp")) > > proc.time() user system elapsed 0.548 1.286 0.421 ================================================ FILE: tests/testthat/test-aw.R ================================================ test_that("st_interpolate_aw", { sq = function(x, y, s=1) st_polygon(list(rbind(c(x,y),c(x+s,y),c(x+s,y+s),c(x,y+s),c(x,y)))) sq2 = function(x, y) st_polygon(list(rbind(c(x,y),c(x+1,y),c(x+1,y+2),c(x,y+2),c(x,y)))) x = st_sf(a = 1:2, b = c(10,1), geom = st_sfc(sq(2,3), sq(2,4))) # plot(st_geometry(x)) y1 = st_sfc(sq2(2, 3)) # plot(y, add = TRUE, lty = 2, lwd = 3) st_agr(x) = "constant" expect_equal(st_interpolate_aw(x, y1, extensive = TRUE)$a, 3) expect_equal(st_interpolate_aw(x, y1, extensive = FALSE)$a, 1.5) y2 = st_sf(a = 5, st_sfc(sq2(1.5, 2.5))) st_agr(y2) = "constant" # plot(y, add = TRUE, lty = 3, lwd = 3) st_interpolate_aw(x, y2, extensive = TRUE) expect_equal(st_interpolate_aw(x, y2, extensive = TRUE)$a, 1) expect_equal(st_interpolate_aw(x, y2, extensive = FALSE)$a, 1 + 1/3) expect_equal(st_interpolate_aw(x, y2, extensive = FALSE, include_non_intersected = TRUE)$a, 0.5) expect_equal(st_interpolate_aw(x, y2, extensive = TRUE, weights = "a")$b, 11) expect_error(st_interpolate_aw(x, y2, extensive = FALSE, weights = "a")) expect_error(st_interpolate_aw(x, y2, extensive = TRUE, include_non_intersected = TRUE, weights = "a"), "include") t1 = sq(0, 1) t2 = sq(0, 0, 2) t = st_difference(t2, t1) to = st_sf(a = c(9,1), geom = st_sfc(t1,t)) x = st_sf(s = 20, geom = st_sfc(sq(0, 0, 2))) st_agr(to) = "constant" expect_equal(st_interpolate_aw(x, to, extensive = TRUE, weights = "a")$s, c(18,2)) x = st_sf(s = 20, geom = st_sfc(sq(0, .5, 1))) expect_equal(st_interpolate_aw(x, to, extensive = TRUE, weights = "a")$s, c(4.5/(4.5+1/6)*20, (1/6)/(4.5+1/6)*20)) x = st_sf(s = 20, geom = st_sfc(sq(-.5, .5, 1))) expect_equal(st_interpolate_aw(x, to, extensive = TRUE, weights = "a")$s, c(4.5/(4.5+1/6)*20, (1/6)/(4.5+1/6)*20)) x = st_sf(s = 20, geom = st_sfc(sq(-1, .5, 1))) expect_equal(st_interpolate_aw(x, to, extensive = TRUE, weights = "a")$s, c(NA_real_,NA_real_)) geom = st_sfc( sq(0, 0, 1), sq(1, 0, 1), sq(0, 1, 1), sq(1, 1, 1)) x = st_sf(s = 1:4, geom = geom) expect_equal(st_interpolate_aw(x, to, extensive = TRUE, weights = "a")$s, c(3,7)) }) ================================================ FILE: tests/testthat/test-bbox.R ================================================ test_that("st_bbox", { p1 = st_point(1:3) bb = st_bbox(p1) expect_true(all(st_bbox(p1) == c(1,2,1,2))) expect_true(all(names(st_bbox(p1)) == c("xmin","ymin","xmax","ymax"))) x = st_geometrycollection(list(st_point(1:2),st_linestring(matrix(1:4,2)))) expect_true(all(st_bbox(x) == c(1,2,2,4))) expect_true(all(names(st_bbox(x)) == c("xmin","ymin","xmax","ymax"))) x = st_sf(a = 1, geom = st_sfc(x)) expect_true(all(st_bbox(x) == c(1,2,2,4))) bb = st_bbox(x) expect_identical(st_bbox(bb), bb) }) ================================================ FILE: tests/testthat/test-collection_extract.R ================================================ pt <- st_point(c(1, 0)) ls <- st_linestring(matrix(c(4, 3, 0, 0), ncol = 2)) poly1 <- st_polygon(list(matrix(c(5.5, 7, 7, 6, 5.5, 0, 0, -0.5, -0.5, 0), ncol = 2))) poly2 <- st_polygon(list(matrix(c(6.6, 8, 8, 7, 6.6, 1, 1, 1.5, 1.5, 1), ncol = 2))) multipoly <- st_multipolygon(list(poly1, poly2)) i <- st_geometrycollection(list(pt, ls, poly1, poly2)) j <- st_geometrycollection(list(pt, ls, poly1, poly2, multipoly)) ## A GEOMETRYCOLLECTION aa <- rbind(st_sf(a=1, geom = st_sfc(i)), st_sf(a=2, geom = st_sfc(j))) ## ## A GEOMETRY of single types bb <- rbind( st_sf(a = 1, geom = st_sfc(pt)), st_sf(a = 2, geom = st_sfc(ls)), st_sf(a = 3, geom = st_sfc(poly1)), st_sf(a = 4, geom = st_sfc(multipoly)) ) ## A GEOMETRY of mixed single types and GEOMETRYCOLLECTIONS cc <- rbind(aa, bb) test_that("st_collection_extract works with sfg objects", { expect_s3_class(st_collection_extract(i, "POLYGON"), "sfc_POLYGON") expect_s3_class(st_collection_extract(j, "POLYGON"), "sfc_MULTIPOLYGON") expect_s3_class(st_collection_extract(i, "POINT"), "POINT") expect_s3_class(st_collection_extract(i, "LINESTRING"), "LINESTRING") }) test_that("st_collection_extract works with sfc objects", { expect_s3_class(st_collection_extract(st_geometry(aa), "POLYGON"), "sfc_MULTIPOLYGON") expect_s3_class(st_collection_extract(st_geometry(aa), "LINESTRING"), "sfc_LINESTRING") expect_s3_class(st_collection_extract(st_geometry(aa), "POINT"), "sfc_POINT") expect_s3_class(st_collection_extract(st_geometry(bb), "POINT"), "sfc_POINT") expect_s3_class(st_collection_extract(st_geometry(cc), "POLYGON"), "sfc_MULTIPOLYGON") }) test_that("st_collection_extract works with sf objects", { expect_s3_class(st_geometry(st_collection_extract(aa, "POLYGON")), "sfc_MULTIPOLYGON") expect_s3_class(st_geometry(st_collection_extract(aa, "LINESTRING")), "sfc_LINESTRING") expect_s3_class(st_geometry(st_collection_extract(aa, "POINT")), "sfc_POINT") expect_s3_class(st_geometry(st_collection_extract(bb, "POLYGON")), "sfc_MULTIPOLYGON") expect_s3_class(st_geometry(st_collection_extract(cc, "POLYGON")), "sfc_MULTIPOLYGON") }) test_that("st_collection_extract behaves with unexpected inputs", { expect_warning(st_collection_extract(poly1, "POLYGON"), "x is already of type POLYGON") expect_error(st_collection_extract(st_sfc(pt), "POLYGON"), "x is of singular geometry type that is different to supplied type") expect_error(st_collection_extract(st_sf(a = "a", geom = st_sfc(pt)), "POLYGON"), "x is of singular geometry type that is different to supplied type") ## Returns empty geometry expect_warning(st_collection_extract(st_sfc(pt, ls), "POLYGON"), "x contains no geometries of specified type") expect_warning(st_collection_extract(st_sf(a = c("a", "b"), geom = st_sfc(ls, pt)), "POLYGON"), "x contains no geometries of specified type") expect_warning(zero_len <- st_collection_extract(st_geometrycollection(list(pt, ls)), "POLYGON"), "x contains no geometries of specified type") expect_length(zero_len, 0L) expect_s3_class(zero_len, "sfg") expect_true(st_is(zero_len, "POLYGON")) }) ================================================ FILE: tests/testthat/test-crs.R ================================================ test_that("st_crs works", { nc1 = st_read(system.file("shape/nc.shp", package="sf"), "nc", crs = 4267, quiet = TRUE) nc2 = st_read(system.file("shape/nc.shp", package="sf"), "nc", quiet = TRUE) nc3 = st_read(system.file("shape/nc.shp", package="sf"), "nc", crs = NA, quiet = TRUE) crs_4267 <- st_crs(4267) expect_equal(st_crs(nc1)[1:2], crs_4267[1:2]) # expect_equal(st_crs(nc2)[1:2], crs_4267[1:2]) expect_equal(st_crs(nc3), NA_crs_) expect_equal(st_set_crs(nc3, 4267) |> st_crs(), crs_4267) # expect_equal(st_crs(nc1)[1:2], st_crs(nc2)[1:2]) expect_warning(st_crs(nc2) <- 3857, "replacing crs does not reproject data") expect_silent(st_crs(nc2) <- 3857) #expect_warning(st_crs(nc2) <- 0, "Failed to lookup UOM CODE") -> changes in gdal 2.2: #expect_warning(st_crs(nc2) <- 0) #expect_warning(st_crs(nc2) <- 1000, "not found in EPSG") -> changes in gdal 2.5.0 expect_silent(st_crs(nc1) <- st_crs(nc1)) if (sf_extSoftVersion()[["GDAL"]] > "2.2.3") { suppressWarnings(expect_error(st_crs("+proj=ll"), "invalid crs")) # expect_error(st_crs("+proj=longlat +datum=NAD26")) } expect_silent(st_crs("+proj=longlat")) expect_silent(st_crs("+proj=longlat +datum=NAD27")) a <- st_crs(4326) expect_silent(wkt <- st_as_text(a, pretty = TRUE)) expect_silent(wkt <- st_as_text(a)) expect_silent(b <- st_crs(wkt)) # expect_equal(a, b) # -> breaks on CRAN/fedora expect_true(st_crs("+proj=longlat +ellps=WGS84 +towgs84=0,0,0,0,0,0,0 +no_defs") != st_crs("+proj=longlat +datum=WGS84 +no_defs")) }) test_that("sf_proj_info works", { expect_silent(x <- sf_proj_info("proj")) expect_silent(x <- sf_proj_info("ellps")) expect_silent(x <- sf_proj_info("datum")) expect_silent(x <- sf_proj_info("units")) expect_silent(path <- sf_proj_info("path")[1]) expect_type(sf_proj_info(path = path), "logical") expect_type(sf_proj_info("network"), "logical") }) test_that("sf_proj_info works for datum files", { skip_if(sf_extSoftVersion()[["proj.4"]] >= "6.0.0") expect_silent(x <- sf_proj_info("have_datum_files")) }) test_that("$.crs works", { skip_if(sf_extSoftVersion()[["proj.4"]] >= "6.0.0") expect_false(is.null(st_crs("+init=epsg:3857")$epsg)) expect_type(st_crs("+init=epsg:3857")$proj4string, "character") }) test_that("$.crs works with +units", { skip_if(sf_extSoftVersion()[["proj.4"]] >= "6.0.0") expect_type(st_crs("+init=epsg:3857 +units=m")$b, "double") expect_type(st_crs("+init=epsg:3857 +units=m")$units, "character") }) test_that("$.crs works 2", { skip_if_not(sf_extSoftVersion()[["GDAL"]] < "2.5.0" && sf_extSoftVersion()[["proj.4"]] < "6.0.0") expect_type(st_crs("+init=epsg:3857 +units=km")$b, "double") expect_type(st_crs("+init=epsg:3857 +units=km")$units, "character") }) test_that("CRS comparison uses ellipsoid and datum (#180)", { # skip_if_not(sf_extSoftVersion()[["GDAL"]] < "2.5.0") # expect_equal( # st_crs("+proj=tmerc +lat_0=0 +lon_0=0 +k=0.9999 +x_0=304800 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs"), # st_crs("+proj=tmerc +lat_0=0 +lon_0=0 +k=0.9999 +x_0=304800 +y_0=0 +datum=NAD83 +units=m +no_defs")) }) #test_that("Can create dummy crs", { # #expect_equal(st_crs(0, valid = FALSE), structure(list(epsg = 0, proj4string = ""), class = "crs")) # #expect_equal(st_crs(991115, proj4text = "+random", valid = FALSE), # # structure(list(epsg = 991115, proj4string = "+random"), class = "crs")) #}) #test_that("Warning if trying to supply proj4 with numeric", { # expect_warning(st_crs(2939, proj4text = "+random"), "`proj4text` is not used to validate crs") #}) test_that("old-style crs are repaired", { x = structure(list(proj4string = "+proj=longlat", epsg = 4326), class = "crs") x_new = st_crs(x) expect_warning(x$proj4string) }) test_that("sp-style CRS objects are accepted", { skip_if_not_installed("sp") library(sp) x = CRS("+proj=longlat") x_crs = st_crs("+proj=longlat") expect_equal(x_crs$wkt, st_crs(x)$wkt) comment(x) = NULL expect_equal(x_crs$wkt, st_crs(x)$wkt) }) test_that("print.crs works", { x = st_crs(4326) print(x) x$input = NA print(x) }) test_that("crs.Raster works", { skip_if_not_installed("raster") library(raster) r = raster() x = st_crs(r) expect_s3_class(x, "crs", exact = TRUE) }) ================================================ FILE: tests/testthat/test-gdal.R ================================================ test_that("st_transform works", { skip_if_not_installed("sp") library(sp) s = st_sfc(st_point(c(1,1)), st_point(c(10,10)), st_point(c(5,5)), crs = 4326) s1.tr = st_transform(s, 3857) sp = as(s, "Spatial") # sp.tr = spTransform(sp, CRS("+proj=merc +a=6378137 +b=6378137 +lat_ts=0.0 +lon_0=0.0 +x_0=0.0 +y_0=0 +k=1.0 +nadgrids=@null +no_defs")) # web mercator # s2.tr = st_as_sfc(sp.tr) #attr(s1.tr, "crs")$proj4string = "" #attr(s2.tr, "crs")$proj4string = "" st_crs(s1.tr) = NA_crs_ # st_crs(s2.tr) = NA_crs_ # if (sf_extSoftVersion()[["proj.4"]] < "5.0.0") # FIXME: # expect_equal(s1.tr, s2.tr) toCrs = 3857 s1.tr = st_transform(s, toCrs) #attr(s1.tr, "crs")$proj4string = "" st_crs(s1.tr) = NA_crs_ # st_crs(s2.tr) = NA_crs_ # if (sf_extSoftVersion()[["proj.4"]] < "5.0.0") # FIXME: # expect_equal(s1.tr, s2.tr) expect_silent({ sf.tr = st_transform(st_sf(a=1:3, s), toCrs) # for sf sfg.tr = st_transform(structure(s[[1]], proj4string="+proj=longlat +datum=WGS84 +no_defs"), toCrs) # sfg }) }) #test_that("gdal can be loaded, unloaded, and loaded", { # expect_silent({ # unload_gdal() # load_gdal() # } # ) #}) test_that("st_wrap_dateline works", { expect_silent(x <- st_wrap_dateline(st_sfc(st_linestring(rbind(c(-179,0),c(179,0))), crs = 4326))) }) test_that('gdal_subdatasets works', { skip_if(sf_extSoftVersion()[["GDAL"]] < "2.1.0") skip_if(sf_extSoftVersion()[["GDAL"]] >= "2.5.0") # FIXME: skip_on_os("mac") # FIXME: fname = system.file("nc/cropped.nc", package = "sf") sd2 = gdal_subdatasets(fname)[[2]] }) # context("gdal utils") test_that('gdal_utils work', { skip_on_appveyor() # FIXME: skip_if_not(Sys.getenv("USER") == "edzer") skip_if_not(sf_extSoftVersion()[["GDAL"]] >= "2.1.0") fname = system.file("nc/cropped.nc", package = "sf") #fname = system.file("tif/geomatrix.tif", package = "sf") info = gdal_utils("info", fname, quiet = TRUE) sd2 = gdal_subdatasets(fname)[[2]] info = gdal_utils("info", sd2, quiet = TRUE) tf = tempfile() tf2 = tempfile() tf3 = tempfile() #tf = "foo" #gdal_utils("rasterize", points, tif) -> need a good example #gdal_utils("warp", sd2, tf, c("-t_srs", "+proj=utm +zone=11 +datum=WGS84")) #expect_true(gdal_utils("warp", sd2, tf, c("-t_srs", "+proj=utm +zone=11 +datum=WGS84"))) #gdal_utils("warp", sd2, tf, c("-t_srs", "+proj=utm +zone=11 +datum=WGS84")) #expect_true(gdal_utils("warp", sd2, tf)) #expect_true(gdal_utils("rasterize", sd2, tf)) expect_true(gdal_utils("translate", sd2, tf)) expect_true(gdal_utils("vectortranslate", sd2, tf2)) shp = system.file("shape/nc.shp", package="sf") gpkg = paste0(tempfile(), ".gpkg") options = c("-f", "GPKG", "-overwrite", "-nlt", "PROMOTE_TO_MULTI", "-oo", "ADJUST_TYPE=NO", "-doo", "FLATTEN_NESTED_ATTRIBUTES=NO") expect_true(gdal_utils("vectortranslate", shp, gpkg, options = options)) expect_warning(gdal_utils("nearblack", sd2, tf)) # create point geom: points = system.file("gpkg/nc.gpkg", package="sf") expect_true(gdal_utils("grid", points, tf)) expect_true(gdal_utils("buildvrt", sd2, tf3)) expect_warning(gdal_utils("buildvrt", sd2, tf3, c("-oo", "FOO=BAR"))) # fake opening options expect_error(gdal_utils("buildvrt", "foo.tif", tf3, c("-oo", "FOO=BAR")), "cannot open source dataset") expect_true(gdal_utils("demprocessing", sd2, tf, processing = "hillshade")) # check gdalfootprint skip_if_not(sf_extSoftVersion()[["GDAL"]] >= "3.8.0") tif <- system.file("tif/geomatrix.tif", package="sf") tf4 <- tempfile(fileext = ".gpkg") expect_true(gdal_utils("footprint", tif, tf4)) }) # gdalwarp -t_srs '+proj=utm +zone=11 +datum=WGS84' -overwrite NETCDF:avhrr-only-v2.19810901.nc:anom utm11.tif # becomes: # st_gdalwarp("NETCDF:avhrr-only-v2.19810901.nc:anom", "utm11.tif", c("-t_srs", "+proj=utm +zone=11 +datum=WGS84")) test_that('gdal_addo works', { skip_on_cran() has_overviews = function(x){ info = gdal_utils(source = x, quiet = TRUE) grepl("overview", info, ignore.case = TRUE) } has_compressed_overviews = function(x){ # Check if sidecar overview file has compression, x is tif path path = paste0(x, ".ovr") # overview file info = gdal_utils(source = path, quiet = TRUE) if(!file.exists(path)) return(NA) grepl("compression", info, ignore.case = TRUE) } # setup dir = file.path(tempdir(), "gdal_addo") dir.create(dir) on.exit(unlink(dir, recursive = TRUE)) # cleanup when done tif = file.path(dir, "geomatrix.tif") file.copy(system.file("tif/geomatrix.tif", package = "sf"), tif, overwrite = TRUE) expect_false(has_overviews(tif)) # Default arguments expect_no_error(gdal_addo(tif)) # internal overview expect_true(has_overviews(tif)) expect_true(is.na(has_compressed_overviews(tif))) # no overview file # Clean overviews expect_no_error(gdal_addo(tif, clean = TRUE)) expect_false(has_overviews(tif)) # Overviews in separate file expect_no_error(gdal_addo(tif, read_only = TRUE)) expect_false(has_compressed_overviews(tif)) # uncompressed overview file # Clean overviews expect_no_error(gdal_addo(tif, clean = TRUE)) expect_false(has_overviews(tif)) # Compression via config_options works expect_no_error(gdal_addo(tif, read_only = TRUE, config_options = c(COMPRESS_OVERVIEW="LZW"))) expect_true(has_compressed_overviews(tif)) }) ================================================ FILE: tests/testthat/test-geos.R ================================================ test_that("CPL_geos_is_valid works", { expect_true( sf:::CPL_geos_is_valid( st_sfc(st_polygon(list(cbind(c(0,1,1,0,0), c(0,0,1, 1,0))))))) expect_warning( expect_false(sf:::CPL_geos_is_valid( st_sfc(st_polygon(list(cbind(c(0,1,1,.5,0),c(0,0,1,-1,0))))), FALSE)) ) expect_false(st_is_valid(st_sfc(st_polygon(list(cbind(c(0,1,1,.5,0),c(0,0,1,-1,0))))))) p0 = st_as_sfc(factor("POLYGON((0 0, 0 10, 10 0, 10 10, 0 0))")) p1 = st_as_sfc("POLYGON((0 0, 0 10, 10 0, 10 10, 0 0))") expect_equal(p0, p1) expect_false(st_is_valid(p1)) expect_equal(st_is_valid(p1, reason = TRUE), "Self-intersection[5 5]") expect_warning(st_is_valid(p1, NA_on_exception = FALSE), "Self-intersection at or near point 5 5") expect_false(st_is_valid(p1[[1]])) }) test_that("geos ops give warnings and errors on longlat", { skip_if_not_installed("lwgeom") skip_if(sf_use_s2()) nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) x = nc[1:2,] y = nc[2:3,] expect_silent(st_equals(x, y)) expect_silent(st_equals_exact(x, y, 0.01)) l = st_sfc(st_linestring(matrix(1:10, ncol=2)), crs = st_crs(nc)) expect_silent(st_polygonize(l)) expect_message(st_intersects(x,y)) expect_message(st_disjoint(x,y)) expect_message(st_touches(x,y)) expect_message(st_crosses(x,y)) expect_message(st_within(x,y)) expect_message(st_contains(x,y)) expect_message(st_overlaps (x,y)) expect_message(st_covers(x,y)) expect_message(st_covered_by(x,y)) expect_warning(st_buffer(x, .1)) expect_warning(st_buffer(x, .1, joinStyle = "BEVEL")) expect_warning(st_simplify(x, dTolerance = .1)) expect_warning(st_centroid(x)) expect_silent(st_segmentize(l, 1e5)) expect_silent(st_segmentize(l, 1e5)) expect_silent(out <- st_segmentize(l, units::set_units(0.001, rad))) expect_silent(out <- st_segmentize(l, units::set_units(100, km))) if (CPL_geos_version() >= "3.4.0") expect_warning(st_triangulate(x)) else expect_error(st_triangulate(x)) expect_silent(st_area(x)) expect_silent(st_length(l)) # distance on long/lat: if (utils::packageVersion("lwgeom") <= "0.1-0") expect_error(st_distance(x, y)) else expect_silent(st_distance(x, y)) }) test_that("st_area() works on GEOMETRY in longlat (#131)", { skip_if_not_installed("lwgeom") single <- list(rbind(c(0,0), c(1,0), c(1, 1), c(0,1), c(0,0))) |> st_polygon() multi <- list(single + 2, single + 4) |> st_multipolygon() w <- st_sfc(single + 0.1, multi) expect_equal(st_area(w), 1:2) expect_silent(st_area(st_set_crs(w, 4326))) # outcome might depend on backend used: lwgeom if proj.4 < 490, else proj.4 }) nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) pnc <- st_transform(nc[4:6, ], "+proj=laea +lon_0=-90") gpnc <- st_geometry(pnc) suppressWarnings(lnc <- st_cast(pnc, "MULTILINESTRING")) glnc <- st_geometry(lnc) test_that("geom operations work on sfg or sfc or sf", { expect_silent(st_buffer(pnc, 1000)) expect_silent(st_buffer(gpnc, 1000)) expect_silent(st_buffer(gpnc[[1L]], 1000)) expect_silent(st_buffer(pnc, 1000, endCapStyle = "SQUARE")) expect_silent(st_buffer(gpnc, 1000, joinStyle = "BEVEL")) expect_silent(st_buffer(gpnc[[1L]], 1000, joinStyle = "MITRE", mitreLimit = 0.2)) expect_silent(st_boundary(pnc)) expect_s3_class(st_boundary(gpnc), "sfc_MULTILINESTRING") expect_s3_class(st_boundary(gpnc[[1L]]), "MULTILINESTRING") expect_s3_class(st_convex_hull(pnc)$geometry, "sfc_POLYGON") expect_s3_class(st_convex_hull(gpnc), "sfc_POLYGON") expect_s3_class(st_convex_hull(gpnc[[1L]]), "POLYGON") expect_silent(st_simplify(pnc, FALSE, 1e4)) expect_silent(st_simplify(gpnc, FALSE, 1e4)) expect_silent(st_simplify(gpnc[[1L]], FALSE, 1e4)) if (sf:::CPL_geos_version() >= "3.4.0") { expect_silent(st_triangulate(pnc)) expect_s3_class(st_triangulate(gpnc), "sfc_GEOMETRYCOLLECTION") expect_s3_class(st_triangulate(gpnc[[1]]), "GEOMETRYCOLLECTION") } expect_silent(st_polygonize(lnc)) expect_silent(st_polygonize(glnc)) expect_silent(st_polygonize(glnc[[1]])) expect_s3_class(st_line_merge(lnc), "sf") expect_s3_class(st_line_merge(glnc), "sfc") expect_s3_class(st_line_merge(glnc[[3]]), "sfg") expect_warning(st_centroid(lnc)) # was: silent expect_s3_class(st_centroid(glnc), "sfc_POINT") expect_s3_class(st_centroid(glnc[[1]]), "POINT") expect_warning(st_point_on_surface(lnc)) # was: silent expect_s3_class(st_point_on_surface(glnc), "sfc_POINT") expect_s3_class(st_point_on_surface(glnc[[1]]), "POINT") expect_silent(st_segmentize(lnc, 10000)) expect_silent(st_segmentize(glnc, 10000)) expect_silent(st_segmentize(glnc[[1]], 10000)) }) test_that("st_union/difference/sym_difference/intersection work, for all types", { p = st_point(0:1) l = st_linestring(matrix(1:10,,2)) pl = st_polygon(list(rbind(c(0,0),c(1,0),c(1,1),c(0,1),c(0,0)))) x = list( pl, st_sfc(pl,l,pl), st_sf(a=5:7, st_sfc(pl,l,pl), agr = "constant") ) y = x for (f in list(st_union, st_difference, st_sym_difference, st_intersection)) { for (xx in x) for (yy in y) expect_silent(f(xx,yy)) } for (f in list(st_difference, st_sym_difference, st_intersection)) { for (xx in x) for (yy in y) expect_equal(tail(class(f(xx,yy)),1), tail(class(xx),1)) } }) test_that("st_union works with by_feature", { p = st_point(0:1) l = st_linestring(matrix(1:10,,2)) pl = st_polygon(list(rbind(c(0,0),c(1,0),c(1,1),c(0,1),c(0,0)))) x = list( pl, st_sfc(pl,l,pl), st_sf(a=5:7, st_sfc(pl,l,pl), agr = "constant") ) expect_silent(z <- st_union(x[[1]], by_feature = TRUE)) expect_silent(z <- st_union(x[[2]], by_feature = TRUE)) expect_silent(z <- st_union(x[[3]], by_feature = TRUE)) }) test_that("st_difference works with partially overlapping geometries", { # create input testing data pl1 = st_polygon(list(matrix(c(0, 0, 2, 0, 1, 1, 0 ,0), byrow = TRUE, ncol=2))) pl2 = st_polygon(list(matrix(c(0, 0.5, 2, 0.5, 1, 1.5, 0, 0.5), byrow = TRUE, ncol = 2))) pl3 = st_polygon(list(matrix(c(0, 1.25, 2, 1.25, 1, 2.5, 0, 1.25), byrow = TRUE, ncol = 2))) in1 = st_sfc(list(pl1, pl2, pl3)) in2 = st_sf(order = c("A", "B", "C"), geometry = st_sfc(list(pl1, pl2, pl3), crs = 4326), agr = "constant") if (package_version(gsub("[a-zA-Z]", "", sf_extSoftVersion()[["GEOS"]])) < "3.9.0") { correct_geom = st_sfc(list( st_polygon(list(matrix(c(0, 2, 1, 0, 0, 0, 1, 0), ncol = 2))), st_polygon(list(matrix(c(0.5, 0, 1, 2, 1.5, 1, 0.5, 0.5, 0.5, 1.5, 0.5, 0.5, 1, 0.5), ncol = 2))), st_polygon(list(matrix(c(0.75, 0, 1, 2, 1.25, 1, 0.75, 1.25, 1.25, 2.5, 1.25, 1.25, 1.5, 1.25), ncol = 2))))) } else { correct_geom = st_sfc(list( st_polygon(list(matrix(c(0, 2, 1, 0, 0, 0, 1, 0), ncol = 2))), st_polygon(list(matrix(c(0, 1, 2, 1.5, 1, 0.5, 0, 0.5, 1.5, 0.5, 0.5, 1, 0.5, 0.5), ncol = 2))), st_polygon(list(matrix(c(0, 1, 2, 1.25, 1, 0.75, 0, 1.25, 2.5, 1.25, 1.25, 1.5, 1.25, 1.25), ncol = 2))))) } # erase overlaps out1 = st_difference(in1) out2 = st_difference(in2) # check that output class is correct expect_s3_class(out1, "sfc") expect_s3_class(out2, "sf") # check that output geometries are valid expect_true(all(sf::st_is_valid(out1))) expect_true(all(sf::st_is_valid(out2))) # check that output geometries have correct attributes expect_equal(attr(out1, "idx"), seq_len(3)) #expect_equal(attr(out2, "idx"), seq_len(3)) expect_equal(attr(out1, "crs"), attr(in1, "crs")) expect_equal(st_crs(out2), st_crs(in2)) # check that output geometries are actually correct expect_length(out1, 3) expect_equal(nrow(out2), 3) expect_equal(out1[[1]][[1]], correct_geom[[1]][[1]]) expect_equal(out1[[2]][[1]], correct_geom[[2]][[1]]) expect_equal(out1[[3]][[1]], correct_geom[[3]][[1]]) }) test_that("st_difference works with fully contained geometries", { # create input testing data pl1 = st_polygon(list(matrix(c(0, 0, 2, 0, 2, 2, 0, 2, 0, 0), byrow = TRUE, ncol=2))) pl2 = st_polygon(list(matrix(c(0.5, 0.5, 1.5, 0.5, 1.5, 1.5, 0.5, 1.5, 0.5, 0.5), byrow = TRUE, ncol = 2))) pl3 = st_polygon(list(matrix(c(5, 5, 7, 5, 7, 7, 5, 7, 5, 5), byrow = TRUE, ncol = 2))) in1 = st_sfc(list(pl1, pl2, pl3)) in2 = st_sf(order = c("A", "B", "C"), geometry = st_sfc(list(pl1, pl2, pl3), crs = 4326), agr = "constant") correct_geom = st_sfc(list(pl1, pl3)) # erase overlaps out1 = st_difference(in1) out2 = st_difference(in2) # check that output class is correct expect_s3_class(out1, "sfc") expect_s3_class(out2, "sf") # check that output geometries are valid expect_true(all(sf::st_is_valid(out1))) expect_true(all(sf::st_is_valid(out2))) # check that output geometries have correct attributes expect_equal(attr(out1, "idx"), c(1L, 3L)) #expect_equal(attr(out2, "idx"), c(1L, 3L)) expect_equal(attr(out1, "crs"), attr(in1, "crs")) expect_equal(st_crs(out2), st_crs(in2)) # check that output geometries are actually correct expect_length(out1, 2) expect_length(out2, 2) expect_equal(out1[[1]][[1]], correct_geom[[1]][[1]]) #expect_equal(out1[[2]][[1]], correct_geom[[2]][[1]]) #expect_equal(out2[[1]][[1]], correct_geom[[1]][[1]]) #expect_equal(out2[[2]][[1]], correct_geom[[2]][[1]]) # check change in order in3 = st_sfc(list(pl2, pl1)) correct_geom = list(pl2, st_difference(pl1, pl2)) out3 = st_difference(in3) expect_equal(correct_geom[[1]], out3[[1]]) expect_equal(correct_geom[[2]], out3[[2]]) }) test_that("binary operations work on sf objects with common column names", { pol1 <- st_sfc(st_polygon(list(cbind(c(0,3,3,0,0),c(0,0,3,3,0))))) pol2 <- pol1 + 1 sf1 <- st_sf(id = 1, pol1) sf2 <- st_sf(id = 2, pol2) # Test as regular data.frames expect_s3_class(st_intersection(sf1, sf2), "sf") # Convert to tibbles sf1 <- st_as_sf(tibble::as_tibble(sf1)) sf2 <- st_as_sf(tibble::as_tibble(sf2)) expect_s3_class(st_intersection(sf1, sf2), c("sf", "tbl_df")) }) test_that("binary operations on empty sfg objects return NA", { x = st_point() == st_linestring() expect_equal(x, NA) }) ================================================ FILE: tests/testthat/test-grid.R ================================================ test_that("point grob constructors work", { p1 <- st_point(c(0, 1)) p2 <- st_point(c(2, 3)) p3 <- st_multipoint(matrix(11:20, ncol = 2)) p4 <- st_sfc(list(p1, p2, p3)) g1 <- st_as_grob(p1) expect_s3_class(g1, c('points', 'grob')) g2 <- st_as_grob(p4, gp = grid::gpar(col = c('red', 'green', 'blue'))) expect_s3_class(g2, c('points', 'grob')) expect_equal(as.numeric(g2$x), unname(rbind(p1, p2, p3)[,1])) expect_equal(g2$gp$col, rep(c('red', 'green', 'blue'), c(1, 1, 5))) }) test_that("linestring grob construction work", { lines <- list( matrix(11:20, ncol = 2), matrix(21:30, ncol = 2), matrix(31:50, ncol = 2) ) l1 <- st_linestring(lines[[1]]) l2 <- st_multilinestring(lines[2:3]) l3 <- st_sfc(list(l1, l2)) g1 <- st_as_grob(l1) expect_s3_class(g1, c('lines', 'grob')) g2 <- st_as_grob(l3, gp = grid::gpar(lwd = c(2, 4))) expect_s3_class(g2, c('lines', 'grob')) expect_equal(as.numeric(g2$x), do.call(rbind, lines)[, 1]) expect_equal(g2$gp$lwd, rep(c(2, 4), c(1, 2))) expect_equal(g2$id.lengths, c(5, 5, 10)) }) holed_rect <- function(x0, y0, width, height, hole) { outer <- cbind( c(x0 - width/2, x0 + width/2, x0 + width/2, x0 - width/2, x0 - width/2), c(y0 - height/2, y0 - height/2, y0 + height/2, y0 + height/2, y0 - height/2) ) inner <- outer inner[,1] <- (inner[,1] - x0) * hole + x0 inner[,2] <- (inner[,2] - y0) * hole + y0 list(outer, inner) } test_that("polygon grob construction work", { polys <- list( holed_rect(0, 0, 1, 1, 0.5), holed_rect(10, 5, 5, 1, 0.25), holed_rect(-3, -10, 4, 10, 0.7) ) p1 <- st_polygon(polys[[1]]) p2 <- st_multipolygon(polys[2:3]) p3 <- st_sfc(list(p1, p2)) g1 <- st_as_grob(p1) expect_s3_class(g1, c('pathgrob', 'grob')) g2 <- st_as_grob(p3, gp = grid::gpar(fill = c('red', 'blue'))) if (getRversion() < as.numeric_version("3.6")) { expect_s3_class(g2, 'gList') expect_equal(g2[[1]]$gp$fill, 'red') expect_equal(g2[[2]]$gp$fill, 'blue') } else { expect_s3_class(g2, c('pathgrob', 'grob')) coords <- do.call(rbind, unlist(polys, recursive = FALSE)) expect_equal(as.numeric(g2$x), coords[, 1]) expect_equal(g2$id.lengths, rep(5, 6)) expect_equal(g2$pathId.lengths, rep(10, 3)) expect_equal(g2$gp$fill, c('red', 'blue', 'blue')) } }) test_that("mixed sfc grob construction works", { p1 <- st_point(c(0, 1)) p2 <- st_multipoint(matrix(11:20, ncol = 2)) l1 <- st_linestring(matrix(21:30, ncol = 2)) p3 <- st_polygon(holed_rect(0, 0, 1, 1, 0.5)) sfc <- st_sfc(list(p1, p2, l1, p3)) g1 <- st_as_grob(sfc, pch = 1:4, gp = grid::gpar(col = 'blue', fill = c('red', 'red', 'blue', 'green'))) expect_s3_class(g1[[1]], c('points', 'grob')) expect_s3_class(g1[[2]], c('points', 'grob')) expect_s3_class(g1[[3]], c('lines', 'grob')) expect_s3_class(g1[[4]], c('pathgrob', 'grob')) expect_equal(g1[[1]]$pch, 1) expect_equal(g1[[2]]$pch, 2) expect_null(g1[[3]]$pch) expect_null(g1[[4]]$pch) expect_equal(g1[[1]]$gp$col, 'blue') expect_equal(g1[[2]]$gp$col, 'blue') expect_equal(g1[[3]]$gp$col, 'blue') expect_equal(g1[[4]]$gp$col, 'blue') expect_equal(g1[[1]]$gp$fill, 'red') expect_equal(g1[[2]]$gp$fill, 'red') expect_equal(g1[[3]]$gp$fill, 'blue') expect_equal(g1[[4]]$gp$fill, 'green') }) ================================================ FILE: tests/testthat/test-normalize.R ================================================ set.seed(1) test_that("normalize", { p0 <- st_point(c(0,1)) p0_norm <- st_normalize(p0, c(0,0,10,10)) expect_equal(p0_norm, st_point(c(0,0.1))) p1 <- st_multipoint(matrix(runif(20, max = 25), ncol = 2)) p1_norm <- st_normalize(p1) expect_equal(unclass(st_bbox(p1_norm)), c(0,0,1,1), check.attributes = FALSE) p2 <- st_polygon(list(matrix(runif(10, max = 100), ncol = 2)[c(1:5, 1), ])) sfc <- st_sfc(p1, p2) sfc_norm <- st_normalize(sfc) expect_equal(unclass(st_bbox(sfc_norm)), c(0,0,1,1), check.attributes = FALSE) sf <- st_sf(geometry = sfc) sf_norm <- st_normalize(sf) expect_equal(unclass(st_bbox(sf_norm)), c(0,0,1,1), check.attributes = FALSE) expect_equal(sfc_norm, sf_norm$geometry) }) test_that("ops", { p0 <- st_point(c(0, 1, 2)) expect_equal(st_sfc(p0) - st_sfc(st_point(c(1,2,3))), st_sfc(st_point(c(-1,-1,-1)))) expect_equal(st_sfc(p0) * st_sfc(st_point(c(1,2,3))), st_sfc(st_point(c(0,2,6)))) }) test_that("grob stuff", { p0 <- st_point(c(0,1)) g <- st_as_grob(st_sfc(p0)) p1 <- st_linestring(matrix(runif(20, max = 25), ncol = 2)) g <- st_as_grob(st_sfc(p1)) p2 <- st_polygon(list(matrix(runif(10, max = 100), ncol = 2)[c(1:5, 1), ])) g <- st_as_grob(st_sfc(p2)) }) ================================================ FILE: tests/testthat/test-plot.R ================================================ test_that("plot.sf() support characters", { m <- list(rbind(c(0,0), c(1,0), c(1, 1), c(0,1), c(0,0))) |> st_polygon() x <- data.frame(a = c("a", "b"), stringsAsFactors = FALSE) |> st_as_sf(geom = st_sfc(m, m + 2)) expect_silent(plot(x)) }) test_that("plot.sf warns on more than 15 attributes", { nc = st_read(system.file("shape/nc.shp", package="sf"), "nc", quiet = TRUE) x = cbind(nc,nc) expect_warning(plot(x)) }) test_that("plot.sf deals with key.length in cm", { nc = st_read(system.file("shape/nc.shp", package="sf"), "nc", quiet = TRUE) expect_silent(plot(nc[1], key.length = lcm(5), key.pos = 2)) expect_silent(plot(nc[1], key.length = lcm(5), key.pos = 1)) nc$f = factor(rep(c("a", "b"), each = 50)) expect_silent(plot(nc["f"], key.length = lcm(5), key.pos = 2)) expect_silent(plot(nc["f"], key.length = lcm(5), key.pos = 1)) }) ================================================ FILE: tests/testthat/test-postgis_ODBC.R ================================================ skip_if_not_installed("RPostgres") library(sf) library(DBI) library(RPostgreSQL) library(testthat) can_con <- function(x) inherits(x, "DBIObject") db_drop_table_schema <- function(con, schema, table = NULL) { if (is.null(table)) { table <- paste(c("public", schema), collapse = ".") } else { table <- paste(c(schema, table), collapse = ".") } DBI::dbSendQuery(pg, paste("DROP TABLE ", table, " CASCADE;")) } require("sp") data(meuse) pts <- st_as_sf(meuse, coords = c("x", "y"), crs = 28992) epsg_31370 = paste0("+proj=lcc +lat_1=51.16666723333333 +lat_2=49.8333339 ", "+lat_0=90 +lon_0=4.367486666666666 +x_0=150000.013 ", "+y_0=5400088.438 +ellps=intl +towgs84=-106.869,52.2978,", "-103.724,0.3366,-0.457,1.8422,-1.2747 +units=m +no_defs") pg <- NULL test_that("check utils", expect_false(can_con(pg))) # requires to apt-get install odbc-postgresql try(pg <- dbConnect(odbc::odbc(), "PostgreSQL"), silent=TRUE) pg <- NULL # tests ------------------------------------------------------------------------ test_that("can write to db", { skip_if_not(can_con(pg), "could not connect to postgis database") expect_silent(suppressMessages(st_write(pts, pg, "sf_meuse__"))) expect_error(st_write(pts, pg, "sf_meuse__"), "exists") expect_true(st_write(pts, pg, "sf_meuse__", overwrite = TRUE)) expect_true(st_write(pts, pg, "sf_meuse2__", binary = FALSE)) expect_warning(z <- st_set_crs(pts, epsg_31370)) expect_message(st_write(z, pg, "sf_meuse3__"), "Inserted local crs") expect_silent(st_write(z, pg, "sf_meuse3__", append = TRUE)) expect_warning(expect_equal(nrow(DBI::dbReadTable(pg, "sf_meuse3__")), nrow(z) * 2), "Unknown field type") expect_silent(st_write(z, pg, "sf_meuse3__", overwrite = TRUE)) }) test_that("can handle multiple geom columns", { skip_if_not(can_con(pg), "could not connect to postgis database") multi <- cbind(pts[["geometry"]], st_transform(pts, 4326)) expect_silent(st_write(multi, pg, "meuse_multi", overwrite = TRUE)) expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE)) expect_equal(st_crs(x[["geometry"]]), st_crs(multi[["geometry"]])) expect_equal(st_crs(x[["geometry.1"]]), st_crs(multi[["geometry.1"]])) expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, type = c(1,4))) expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, type = c(4,4))) expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, promote_to_multi = FALSE)) expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, geometry_column = "geometry.1")) x <- st_layers("PG:host=localhost dbname=postgis") multi2 <- cbind(pts[["geometry"]], st_set_crs(st_transform(pts, 4326), NA)) expect_silent(st_write(multi2, pg, "meuse_multi2", overwrite = TRUE)) expect_silent(x <- st_read(pg, "meuse_multi2")) expect_equal(st_crs(x[["geometry"]]), st_crs(multi2[["geometry"]])) expect_equal(st_crs(x[["geometry.1"]]), st_crs(multi2[["geometry.1"]])) expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi2", quiet = TRUE)) #expect_equal(st_crs(x[["geometry"]]), st_crs(multi2[["geometry"]])) expect_equal(st_crs(x[["geometry.1"]]), st_crs(multi2[["geometry.1"]])) }) test_that("sf can write units to database (#264)", { skip_if_not(can_con(pg), "could not connect to postgis database") ptsu <- pts ptsu[["u"]] <- ptsu[["cadmium"]] units(ptsu[["u"]]) <- units::as_units("km") expect_silent(st_write(ptsu, pg, "sf_units__", overwrite = TRUE)) r <- st_read(pg, "sf_units__") expect_type(r[["u"]], "double") expect_equal(sort(r[["u"]]), sort(as.numeric(ptsu[["u"]]))) dbRemoveTable(pg, "sf_units__") }) test_that("sf can preserve types (#592)", { skip_if_not(can_con(pg), "could not connect to postgis database") dtypes <- data.frame( logi = c(TRUE, FALSE, NA), chara = c("a", "", NA), nume = c(1.1e1, 2.2e2, NA), inte = c(1L, 2L, NA), fact = factor(c("a", "b", NA), levels = letters), #comp = c(complex(1, 2), complex(2, 3)), date = c(rep(Sys.Date(), 2), NA), time = c(rep(Sys.time(), 2), NA), x = c(1, 2, 4), y = c(1, 2, 4), stringsAsFactors = FALSE) # cannot write lists #dtypes$lst <- c(list(matrix("a")), list(matrix(c("b", "c"))), list(NA)) dtypes <- st_as_sf(dtypes, coords = c("x", "y")) st_write(dtypes, pg, overwrite = TRUE) x <- st_read(pg, "dtypes") dtypes$fact <- as.character(dtypes$fact) expect_equal(x, dtypes) DBI::dbRemoveTable(pg, "dtypes") }) test_that("can write to other schema", { skip_if_not(can_con(pg), "could not connect to postgis database") try(DBI::dbSendQuery(pg, "CREATE SCHEMA sf_test__;"), silent = TRUE) q <- "SELECT schema_name FROM information_schema.schemata WHERE schema_name = 'sf_test__';" suppressWarnings(could_schema <- DBI::dbGetQuery(pg, q) |> nrow() > 0) skip_if_not(could_schema, "Could not create schema (might need to run 'GRANT CREATE ON DATABASE postgis TO ')") expect_error(st_write(pts, pg, Id(schema = "public", table = "sf_meuse__")), "exists") expect_silent(st_write(pts, pg, Id(schema = "sf_test__", table = "sf_meuse__"))) expect_error(st_write(pts, pg, Id(schema = "sf_test__", table = "sf_meuse__")), "exists") expect_silent(st_write(pts, pg, Id(schema = "sf_test__", table = "sf_meuse__"), overwrite = TRUE)) expect_warning(z <- st_set_crs(pts, epsg_31370)) expect_silent(st_write(z, pg, Id(schema = "sf_test__", table = "sf_meuse33__"))) expect_silent(st_write(z, pg, Id(schema = "sf_test__", table = "sf_meuse4__"))) # weird name work expect_silent(st_write(pts, pg, c(NULL, "sf_test__.meuse__"), overwrite = TRUE)) expect_silent(st_write(pts.2 <- pts, pg, overwrite = TRUE)) expect_true(DBI::dbRemoveTable(pg, "pts.2 <- pts")) }) test_that("support for capital names (#571)", { skip_if_not(can_con(pg), "could not connect to postgis database") expect_silent(st_write(pts, pg, "Meuse_tbl")) expect_true(DBI::dbRemoveTable(pg, "Meuse_tbl")) try(DBI::dbSendQuery(pg, "CREATE SCHEMA \"CAP__\";"), silent = TRUE) q <- "SELECT schema_name FROM information_schema.schemata WHERE schema_name = 'CAP__';" suppressWarnings(could_schema <- DBI::dbGetQuery(pg, q) |> nrow() > 0) skip_if_not(could_schema, "Could not create schema (might need to run 'GRANT CREATE ON DATABASE postgis TO ')") expect_silent(st_write(pts, pg, Id(schema = "CAP__", table = "Meuse_tbl"))) expect_true(DBI::dbRemoveTable(pg, Id(schema = "CAP__", table = "Meuse_tbl"))) dbExecute(pg, 'DROP SCHEMA "CAP__" CASCADE;') }) test_that("can read from db", { skip_if_not(can_con(pg), "could not connect to postgis database") q <- "select * from sf_meuse__" #expect_warning(x <- st_read(pg, query = q), "crs") expect_silent(x <- st_read(pg, query = q)) expect_error(st_read(pg), "table name or a query") y <- st_read(pg, "sf_meuse__") expect_equal(dim(pts), dim(y)) expect_identical(st_crs(pts), st_crs(y)) expect_identical(st_precision(pts), st_precision(y)) expect_warning(z <- st_read(pg, "sf_meuse3__"), "code \\d+ not found") expect_equal(dim(pts), dim(z)) #expect_identical(st_crs(NA), st_crs(z)) expect_true(st_crs(epsg_31370) == st_crs(z)) expect_identical(st_precision(pts), st_precision(z)) w <- st_read(pg, c("sf_test__", "sf_meuse__")) expect_equal(dim(y), dim(w)) expect_identical(st_crs(y), st_crs(w)) expect_identical(st_precision(y), st_precision(w)) expect_error(st_read(pg, "missing"), "not exist") expect_error(st_read(pg, c("missing", "missing")), "not exist") # make sure it reads in the correct schema expect_error(st_read(pg, c("sf_test__", "sf_meuse3__")), "not exist") }) test_that("can read views (#212)", { skip_if_not(Sys.getenv("USER") != "edzer") # this stopped working for me skip_if_not(can_con(pg), "could not connect to postgis database") expect_equal(DBI::dbExecute(pg, "CREATE VIEW sf_view__ AS SELECT * FROM sf_meuse__;"), 0) expect_equal(DBI::dbExecute(pg, "CREATE VIEW sf_test__.sf_view__ AS SELECT * FROM sf_meuse__;"), 0) expect_equal(DBI::dbExecute(pg, "CREATE MATERIALIZED VIEW sf_viewm__ AS SELECT * FROM sf_meuse__;"), 155) expect_equal(DBI::dbExecute(pg, "CREATE MATERIALIZED VIEW sf_test__.sf_viewm__ AS SELECT * FROM sf_meuse__;"), 155) x <- st_read(pg, "sf_meuse__") expect_identical(st_read(pg, "sf_view__"), x) expect_identical(st_read(pg, c("public", "sf_view__")), x) expect_identical(st_read(pg, c("sf_test__", "sf_view__")), x) expect_identical(st_read(pg, c("sf_viewm__")), x) expect_identical(st_read(pg, c("sf_test__", "sf_viewm__")), x) try(DBI::dbExecute(pg, "DROP VIEW sf_view__"), silent = TRUE) try(DBI::dbExecute(pg, "DROP VIEW sf_test__.sf_view__"), silent = TRUE) try(DBI::dbExecute(pg, "DROP MATERIALIZED VIEW sf_viewm__"), silent = TRUE) try(DBI::dbExecute(pg, "DROP MATERIALIZED VIEW sf_test__.sf_viewm__"), silent = TRUE) }) test_that("round trips", { skip_if_not(can_con(pg), "could not connect to postgis database") round_trip = function(conn, wkt) { query = paste0("SELECT '", wkt, "'::geometry;") returnstr = suppressWarnings(DBI::dbGetQuery(conn, query)$geometry) wkb = structure(returnstr, class = "WKB") ret = st_as_sfc(wkb, EWKB = TRUE) message(paste("IN: ", wkt, "\n")) # OUT contains WKB created in PostGIS from wkt, interpreted to R by sf, printed as WKT by sf message(paste("OUT: ", txt <- st_as_text(ret, EWKT=TRUE)[[1]], "\n")) if (length(grep("SRID", txt)) == 0) { query = paste0("SELECT ST_AsText('",sf:::CPL_raw_to_hex(st_as_binary(ret[[1]])),"');") received = suppressWarnings(DBI::dbGetQuery(conn, query)$st_astext) # PG: contains the PostGIS WKT, after reading the WKB created by sf from R native message(paste("PG: ", received, "\n")) } expect_equal(wkt, txt) } round_trip(pg, "SRID=4326;POINT M (0 0 0)") round_trip(pg, "POINT Z (0 0 0)") round_trip(pg, "POINT ZM (0 0 0 0)") round_trip(pg, "POINT (0 0)") round_trip(pg, "LINESTRING (0 0, 1 1, 2 2)") round_trip(pg, "MULTIPOINT (0 0, 1 1, 2 2)") round_trip(pg, "POLYGON ((0 0, 1 0, 1 1, 0 0))") round_trip(pg, "MULTIPOLYGON (((0 0, 1 0, 1 1, 0 0)), ((2 2, 3 2, 3 3, 2 2)))") round_trip(pg, paste("MULTIPOLYGON (((0 0, 1 0, 1 1, 0 0),", "(0.2 0.2, 0.8 0.2, 0.8 0.8, 0.2 0.2)),", "((2 2, 3 2, 3 3, 2 2)))")) round_trip(pg, paste("MULTILINESTRING ((0 0, 1 0, 1 1, 0 0),", "(0.2 0.2, 0.8 0.2, 0.8 0.8, 0.2 0.2),", "(2 2, 3 2, 3 3, 2 2))")) # other types; examples taken from the PostGIS manuals (ch 4): round_trip(pg, "CIRCULARSTRING (0 0, 1 1, 1 0)") round_trip(pg, "CIRCULARSTRING (0 0, 4 0, 4 4, 0 4, 0 0)") round_trip(pg, paste("CURVEPOLYGON (CIRCULARSTRING (0 0, 4 0, 4 4, 0 4, 0 0),", "LINESTRING (1 1, 3 3, 3 1, 1 1))")) round_trip(pg, paste("COMPOUNDCURVE (CIRCULARSTRING (0 0, 1 1, 1 0),", "LINESTRING (1 0, 0 1))")) round_trip(pg, paste0("CURVEPOLYGON (COMPOUNDCURVE (CIRCULARSTRING (0 0, 2 0, 2 1, 2 3, 4 3), ", "LINESTRING (4 3, 4 5, 1 4, 0 0)), ", "CIRCULARSTRING (1.7 1, 1.4 0.4, 1.6 0.4, 1.6 0.5, 1.7 1))")) round_trip(pg, "MULTICURVE (LINESTRING (0 0, 5 5), CIRCULARSTRING (4 0, 4 4, 8 4))") round_trip(pg, paste("MULTISURFACE (CURVEPOLYGON (CIRCULARSTRING (0 0, 4 0, 4 4, 0 4, 0 0),", "LINESTRING (1 1, 3 3, 3 1, 1 1)),", "POLYGON ((10 10, 14 12, 11 10, 10 10),", "(11 11, 11.5 11, 11 11.5, 11 11)))")) round_trip(pg, paste("MULTICURVE (LINESTRING (0 0, 5 5),", "CIRCULARSTRING (4 0, 4 4, 8 4))")) round_trip(pg, paste("POLYHEDRALSURFACE Z (((0 0 0, 0 0 1, 0 1 1, 0 1 0, 0 0 0)),", "((0 0 0, 0 1 0, 1 1 0, 1 0 0, 0 0 0)),", "((0 0 0, 1 0 0, 1 0 1, 0 0 1, 0 0 0)),", "((1 1 0, 1 1 1, 1 0 1, 1 0 0, 1 1 0)),", "((0 1 0, 0 1 1, 1 1 1, 1 1 0, 0 1 0)),", "((0 0 1, 1 0 1, 1 1 1, 0 1 1, 0 0 1)))")) round_trip(pg, "TRIANGLE ((0 0, 0 9, 9 0, 0 0))") round_trip(pg, "TIN Z (((0 0 0, 0 0 1, 0 1 0, 0 0 0)), ((0 0 0, 0 1 0, 1 1 0, 0 0 0)))") }) test_that("can read using driver", { skip_if_not(can_con(pg), "could not connect to postgis database") layers <- st_layers("PG:host=localhost dbname=postgis") lyr_expect <- sort(c("sf_meuse__", "sf_meuse2__", "sf_meuse3__", "meuse_multi2", "sf_test__.sf_meuse__", "sf_test__.meuse__", "sf_test__.sf_meuse33__", "sf_test__.sf_meuse4__")) expect_true(all(lyr_expect %in% layers$name)) expect_true(all(layers$features == 155)) expect_true(all(layers$fields == 12)) skip_if_not(can_con(try(DBI::dbConnect(RPostgres::Postgres(), dbname = "empty"), silent=TRUE)), "could not connect to 'empty' database") expect_error(st_read("PG:host=localhost dbname=empty", quiet = TRUE), "No layers") }) test_that("Can safely manipulate crs", { skip_if_not(can_con(pg), "could not connect to postgis database") srid <- 4326 expect_true(get_postgis_crs(pg, srid) == st_crs(srid)) expect_error(set_postgis_crs(pg, st_crs(srid))) expect_warning(expect_true(is.na(st_crs(get_new_postgis_srid(pg)))), "not found") new_crs <- st_crs(get_new_postgis_srid(pg), "+proj=longlat +datum=WGS84 +no_defs", valid = FALSE) expect_message(set_postgis_crs(pg, new_crs, auth_name = "sf_test"), "Inserted local crs") expect_warning(expect_error(set_postgis_crs(pg, new_crs), "duplicate key"), "not found") expect_equal(delete_postgis_crs(pg, new_crs), 1) expect_equal(delete_postgis_crs(pg, new_crs), 0) }) test_that("new SRIDs are handled correctly", { skip_if_not(can_con(pg), "could not connect to postgis database") data(meuse, package = "sp") meuse_sf = st_as_sf(meuse, coords = c("x", "y"), crs = NA_crs_) crs = st_crs(NA_integer_, paste("+proj=sterea +lat_0=52 +lon_0=5", # creates FALSE, but new one "+k=1.0 +x_0=155000 +y_0=463000 +ellps=bessel", "+towgs84=565.4171,50.3319,465.5524,-0.398957,0.343988,", "-1.87740,4.0725 +units=m +no_defs"), valid = FALSE) st_crs(meuse_sf) = crs expect_message(st_write(meuse_sf, pg, overwrite = TRUE), "Inserted local crs") expect_warning(x <- st_read(pg, query = "select * from meuse_sf limit 3;"), "not found in EPSG support files") expect_true(st_crs(x)$proj4string == crs$proj4string) expect_silent(st_write(meuse_sf, pg, overwrite = TRUE)) }) test_that("schema_table", { expect_error(sf:::schema_table(pg, NA), "character vector") expect_error(sf:::schema_table(pg, NA_character_), "cannot be NA") expect_error(sf:::schema_table(pg, "a", NA), "cannot be NA") expect_error(sf:::schema_table(pg, letters), "longer than 2") expect_equal(sf:::schema_table(pg, "a", "b"), c("b", "a")) expect_equal(sf:::schema_table(pg, "a"), c("public", "a")) }) if (can_con(pg)) { # cleanup try(db_drop_table_schema(pg, "meuse_sf"), silent = TRUE) try(db_drop_table_schema(pg, "meuse_multi"), silent = TRUE) try(db_drop_table_schema(pg, "sf_meuse__"), silent = TRUE) try(db_drop_table_schema(pg, "sf_meuse2__"), silent = TRUE) try(db_drop_table_schema(pg, "sf_meuse3__"), silent = TRUE) try(db_drop_table_schema(pg, "meuse_multi2"), silent = TRUE) try(db_drop_table_schema(pg, '"sf_test__.meuse__"'), silent = TRUE) try(db_drop_table_schema(pg, "sf_test__", "sf_meuse__"), silent = TRUE) try(db_drop_table_schema(pg, "sf_test__", "sf_meuse2__"), silent = TRUE) try(db_drop_table_schema(pg, "sf_test__", "sf_meuse33__"), silent = TRUE) try(db_drop_table_schema(pg, "sf_test__", "sf_meuse4__"), silent = TRUE) try(DBI::dbExecute(pg, "DROP SCHEMA sf_test__ CASCADE;"), silent = TRUE) try(DBI::dbExecute(pg, "DELETE FROM spatial_ref_sys WHERE auth_name = 'sf';"), silent = TRUE) try(DBI::dbDisconnect(pg), silent = TRUE) } ================================================ FILE: tests/testthat/test-postgis_RPostgreSQL.R ================================================ skip_if_not_installed("RPostgres") library(sf) library(DBI) library(RPostgreSQL) library(testthat) can_con <- function(x) inherits(x, "PostgreSQLConnection") db_drop_table_schema <- function(con, schema, table = NULL) { if (is.null(table)) { table <- paste(c("public", schema), collapse = ".") } else { table <- paste(c(schema, table), collapse = ".") } DBI::dbExecute(pg, paste("DROP TABLE ", table, " CASCADE;")) } require("sp") data(meuse) pts <- st_as_sf(meuse, coords = c("x", "y"), crs = 28992) epsg_31370 = paste0("+proj=lcc +lat_1=51.16666723333333 +lat_2=49.8333339 ", "+lat_0=90 +lon_0=4.367486666666666 +x_0=150000.013 ", "+y_0=5400088.438 +ellps=intl +towgs84=-106.869,52.2978,", "-103.724,0.3366,-0.457,1.8422,-1.2747 +units=m +no_defs") pg <- NULL test_that("check utils", expect_false(can_con(pg))) #try(pg <- DBI::dbConnect(RPostgreSQL::PostgreSQL(), host = "localhost", dbname = "postgis"), silent=TRUE) # tests ------------------------------------------------------------------------ test_that("can write to db", { skip_if_not(can_con(pg), "could not connect to postgis database") expect_silent(suppressMessages(st_write(pts, pg, "sf_meuse__"))) expect_error(st_write(pts, pg, "sf_meuse__"), "exists") expect_silent(st_write(pts, pg, "sf_meuse__", overwrite = TRUE)) expect_silent(st_write(pts, pg, "sf_meuse2__", binary = FALSE)) expect_warning(z <- st_set_crs(pts, epsg_31370)) expect_message(st_write(z, pg, "sf_meuse3__"), "Inserted local crs") expect_silent(st_write(z, pg, "sf_meuse3__", append = TRUE)) expect_warning(expect_equal(nrow(DBI::dbReadTable(pg, "sf_meuse3__")), nrow(z) * 2), "unrecognized PostgreSQL field type geometry") expect_silent(st_write(z, pg, "sf_meuse3__", overwrite = TRUE)) }) test_that("can handle multiple geom columns", { skip_if_not(can_con(pg), "could not connect to postgis database") multi <- cbind(pts[["geometry"]], st_transform(pts, 4326)) expect_silent(st_write(multi, pg, "meuse_multi", overwrite = TRUE)) multi2 <- cbind(pts[["geometry"]], st_set_crs(st_transform(pts, 4326), NA)) expect_silent(st_write(multi2, pg, "meuse_multi2", overwrite = TRUE)) expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE)) # expect_equal(st_crs(x[["geometry"]]), st_crs(multi[["geometry"]])) -->> not generally true in case of different EPSG databases expect_equal(st_crs(x[["geometry.1"]]), st_crs(multi[["geometry.1"]])) expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, type = c(1,4))) expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, type = c(4,4))) expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, promote_to_multi = FALSE)) expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, geometry_column = "geometry.1")) x <- st_layers("PG:host=localhost dbname=postgis") expect_silent(x <- st_read(pg, "meuse_multi2")) # expect_equal(st_crs(x[["geometry"]]), st_crs(multi2[["geometry"]])) #-->> not generally the case, this CRS varies accross installations (EPSG db versions) expect_equal(st_crs(x[["geometry.1"]]), st_crs(multi2[["geometry.1"]])) expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi2", quiet = TRUE)) #expect_equal(st_crs(x[["geometry"]]), st_crs(multi2[["geometry"]])) expect_equal(st_crs(x[["geometry.1"]]), st_crs(multi2[["geometry.1"]])) }) test_that("RPostgreSQL driver can use `geometry_column` (#1045)", { skip_if_not(can_con(pg), "could not connect to postgis database") query <- "SELECT 'POINT(0 0)'::geometry as a, 'POINT(1 0)'::geometry as b" x <- st_read(pg, query = query) expect_equal(x$a, st_sfc(st_point(c(0, 0)))) expect_equal(x$b, st_sfc(st_point(c(1, 0)))) x <- st_read(pg, query = query, geometry_column = c("a", "b")) expect_equal(x$a, st_sfc(st_point(c(0, 0)))) expect_equal(x$b, st_sfc(st_point(c(1, 0)))) x <- st_read(pg, query = query, geometry_column = c("b")) expect_equal(x$a, "010100000000000000000000000000000000000000") expect_equal(x$b, st_sfc(st_point(c(1, 0)))) expect_error(st_read(pg, query = query, geometry_column = c("b", "c")), "Could not find") }) test_that("sf can write units to database (#264)", { skip_if_not(can_con(pg), "could not connect to postgis database") ptsu <- pts ptsu[["u"]] <- ptsu[["cadmium"]] units(ptsu[["u"]]) <- units::as_units("km") expect_silent(st_write(ptsu, pg, "sf_units__", overwrite = TRUE)) r <- st_read(pg, "sf_units__") expect_type(r[["u"]], "double") expect_equal(sort(r[["u"]]), sort(as.numeric(ptsu[["u"]]))) dbRemoveTable(pg, "sf_units__") }) test_that("sf can preserve types (#592)", { skip_if_not(can_con(pg), "could not connect to postgis database") dtypes <- data.frame( logi = c(TRUE, FALSE, NA), chara = c("a", "", NA), nume = c(1.1e1, 2.2e2, NA), inte = c(1L, 2L, NA), fact = factor(c("a", "b", NA), levels = letters), #comp = c(complex(1, 2), complex(2, 3)), date = rep(Sys.Date(), 3), time = rep(Sys.time(), 3), x = c(1, 2, 4), y = c(1, 2, 4), stringsAsFactors = FALSE) # cannot write lists #dtypes$lst <- c(list(matrix("a")), list(matrix(c("b", "c"))), list(NA)) dtypes <- st_as_sf(dtypes, coords = c("x", "y")) st_write(dtypes, pg, overwrite = TRUE) x <- st_read(pg, "dtypes") dtypes$fact <- as.character(dtypes$fact) dtypes$fact <- as.character(dtypes$fact) expect_equal(x[-7], dtypes[-7]) # ignore POSIXct timezone issue DBI::dbRemoveTable(pg, "dtypes") }) test_that("can write to other schema", { skip_if_not(can_con(pg), "could not connect to postgis database") try(DBI::dbSendQuery(pg, "CREATE SCHEMA sf_test__;"), silent = TRUE) q <- "SELECT schema_name FROM information_schema.schemata WHERE schema_name = 'sf_test__';" suppressWarnings(could_schema <- DBI::dbGetQuery(pg, q) |> nrow() > 0) skip_if_not(could_schema, "Could not create schema (might need to run 'GRANT CREATE ON DATABASE postgis TO ')") expect_error(st_write(pts, pg, c("public", "sf_meuse__")), "exists") expect_silent(st_write(pts, pg, c("sf_test__", "sf_meuse__"))) expect_error(st_write(pts, pg, c("sf_test__", "sf_meuse__")), "exists") expect_silent(st_write(pts, pg, c("sf_test__", "sf_meuse__"), overwrite = TRUE)) expect_warning(z <- st_set_crs(pts, epsg_31370)) expect_silent(st_write(z, pg, c("sf_test__", "sf_meuse33__"))) expect_silent(st_write(z, pg, c("sf_test__", "sf_meuse4__"))) # weird name work expect_silent(st_write(pts, pg, c(NULL, "sf_test__.meuse__"), overwrite = TRUE)) expect_silent(st_write(pts.2 <- pts, pg, overwrite = TRUE)) expect_true(DBI::dbRemoveTable(pg, "pts.2 <- pts")) }) test_that("support for capital names (#571)", { skip_if_not(can_con(pg), "could not connect to postgis database") expect_silent(st_write(pts, pg, "Meuse_tbl")) expect_true(DBI::dbRemoveTable(pg, "Meuse_tbl")) try(DBI::dbSendQuery(pg, "CREATE SCHEMA \"CAP__\";"), silent = TRUE) q <- "SELECT schema_name FROM information_schema.schemata WHERE schema_name = 'CAP__';" suppressWarnings(could_schema <- DBI::dbGetQuery(pg, q) |> nrow() > 0) skip_if_not(could_schema, "Could not create schema (might need to run 'GRANT CREATE ON DATABASE postgis TO ')") expect_silent(st_write(pts, pg, c("CAP__", "Meuse_tbl"))) expect_true(DBI::dbRemoveTable(pg, c("CAP__", "Meuse_tbl"))) dbExecute(pg, 'DROP SCHEMA "CAP__" CASCADE;') }) test_that("can read from db", { skip_if_not(can_con(pg), "could not connect to postgis database") q <- "select * from sf_meuse__" #expect_warning(x <- st_read(pg, query = q), "crs") expect_silent(x <- st_read(pg, query = q)) expect_error(st_read(pg), "Provide either a `layer` or a `query`") y <- st_read(pg, "sf_meuse__") expect_equal(dim(pts), dim(y)) expect_identical(st_crs(pts), st_crs(y)) expect_identical(st_precision(pts), st_precision(y)) expect_warning(z <- st_read(pg, "sf_meuse3__"), "code \\d+ not found") expect_equal(dim(pts), dim(z)) #expect_identical(st_crs(NA), st_crs(z)) expect_true(st_crs(epsg_31370) == st_crs(z)) expect_identical(st_precision(pts), st_precision(z)) w <- st_read(pg, c("sf_test__", "sf_meuse__")) expect_equal(dim(y), dim(w)) expect_identical(st_crs(y), st_crs(w)) expect_identical(st_precision(y), st_precision(w)) #Make sure it doesn't set column with all NAs to geometry: sf_meuseNA__ <- pts sf_meuseNA__$dummy <- rep(NA_character_, nrow(sf_meuseNA__)) st_write(sf_meuseNA__, pg, c("sf_test__", "sf_meuse_na__"), quiet = TRUE) z <- st_read(pg, query = "SELECT * FROM sf_test__.sf_meuse_na__", quiet = TRUE) expect_equal(sum(vapply(z, inherits, logical(1), "sfc")), 1) expect_equal(attr(z, "sf_column"), "geometry") expect_true(dbRemoveTable(pg, c("sf_test__", "sf_meuse_na__"))) expect_error(st_read(pg, "missing"), "attempt to set an attribute on NULL") expect_error(st_read(pg, c("missing", "missing")), "attempt to set an attribute on NULL") # make sure it reads in the correct schema expect_error(st_read(pg, c("sf_test__", "sf_meuse3__")), "attempt to set an attribute on NULL") }) test_that("can read views (#212)", { skip_if_not(Sys.getenv("USER") != "edzer") # this stopped working for me skip_if_not(can_con(pg), "could not connect to postgis database") expect_equal(DBI::dbExecute(pg, "CREATE VIEW sf_view__ AS SELECT * FROM sf_meuse__;"), 0) expect_equal(DBI::dbExecute(pg, "CREATE VIEW sf_test__.sf_view__ AS SELECT * FROM sf_meuse__;"), 0) expect_equal(DBI::dbExecute(pg, "CREATE MATERIALIZED VIEW sf_viewm__ AS SELECT * FROM sf_meuse__;"), 155) expect_equal(DBI::dbExecute(pg, "CREATE MATERIALIZED VIEW sf_test__.sf_viewm__ AS SELECT * FROM sf_meuse__;"), 155) x <- st_read(pg, "sf_meuse__") expect_identical(st_read(pg, "sf_view__"), x) expect_identical(st_read(pg, c("public", "sf_view__")), x) expect_identical(st_read(pg, c("sf_test__", "sf_view__")), x) expect_identical(st_read(pg, c("sf_viewm__")), x) expect_identical(st_read(pg, c("sf_test__", "sf_viewm__")), x) try(DBI::dbExecute(pg, "DROP VIEW sf_view__"), silent = TRUE) try(DBI::dbExecute(pg, "DROP VIEW sf_test__.sf_view__"), silent = TRUE) try(DBI::dbExecute(pg, "DROP MATERIALIZED VIEW sf_viewm__"), silent = TRUE) try(DBI::dbExecute(pg, "DROP MATERIALIZED VIEW sf_test__.sf_viewm__"), silent = TRUE) }) test_that("round trips", { skip_if_not(can_con(pg), "could not connect to postgis database") round_trip = function(conn, wkt) { query = paste0("SELECT '", wkt, "'::geometry;") returnstr = suppressWarnings(DBI::dbGetQuery(conn, query)$geometry) wkb = structure(returnstr, class = "WKB") ret = st_as_sfc(wkb, EWKB = TRUE) message(paste("IN: ", wkt, "\n")) # OUT contains WKB created in PostGIS from wkt, interpreted to R by sf, printed as WKT by sf message(paste("OUT: ", txt <- st_as_text(ret, EWKT=TRUE)[[1]], "\n")) if (length(grep("SRID", txt)) == 0) { query = paste0("SELECT ST_AsText('",sf:::CPL_raw_to_hex(st_as_binary(ret[[1]])),"');") received = suppressWarnings(DBI::dbGetQuery(conn, query)$st_astext) # PG: contains the PostGIS WKT, after reading the WKB created by sf from R native message(paste("PG: ", received, "\n")) } expect_equal(wkt, txt) } round_trip(pg, "SRID=4326;POINT M (0 0 0)") round_trip(pg, "POINT Z (0 0 0)") round_trip(pg, "POINT ZM (0 0 0 0)") round_trip(pg, "POINT (0 0)") round_trip(pg, "LINESTRING (0 0, 1 1, 2 2)") round_trip(pg, "MULTIPOINT ((0 0), (1 1), (2 2))") round_trip(pg, "POLYGON ((0 0, 1 0, 1 1, 0 0))") round_trip(pg, "MULTIPOLYGON (((0 0, 1 0, 1 1, 0 0)), ((2 2, 3 2, 3 3, 2 2)))") round_trip(pg, paste("MULTIPOLYGON (((0 0, 1 0, 1 1, 0 0),", "(0.2 0.2, 0.8 0.2, 0.8 0.8, 0.2 0.2)),", "((2 2, 3 2, 3 3, 2 2)))")) round_trip(pg, paste("MULTILINESTRING ((0 0, 1 0, 1 1, 0 0),", "(0.2 0.2, 0.8 0.2, 0.8 0.8, 0.2 0.2),", "(2 2, 3 2, 3 3, 2 2))")) # other types; examples taken from the PostGIS manuals (ch 4): round_trip(pg, "CIRCULARSTRING (0 0, 1 1, 1 0)") round_trip(pg, "CIRCULARSTRING (0 0, 4 0, 4 4, 0 4, 0 0)") round_trip(pg, paste("CURVEPOLYGON (CIRCULARSTRING (0 0, 4 0, 4 4, 0 4, 0 0),", "LINESTRING (1 1, 3 3, 3 1, 1 1))")) round_trip(pg, paste("COMPOUNDCURVE (CIRCULARSTRING (0 0, 1 1, 1 0),", "LINESTRING (1 0, 0 1))")) round_trip(pg, paste0("CURVEPOLYGON (COMPOUNDCURVE (CIRCULARSTRING (0 0, 2 0, 2 1, 2 3, 4 3), ", "LINESTRING (4 3, 4 5, 1 4, 0 0)), ", "CIRCULARSTRING (1.7 1, 1.4 0.4, 1.6 0.4, 1.6 0.5, 1.7 1))")) round_trip(pg, "MULTICURVE (LINESTRING (0 0, 5 5), CIRCULARSTRING (4 0, 4 4, 8 4))") round_trip(pg, paste("MULTISURFACE (CURVEPOLYGON (CIRCULARSTRING (0 0, 4 0, 4 4, 0 4, 0 0),", "LINESTRING (1 1, 3 3, 3 1, 1 1)),", "POLYGON ((10 10, 14 12, 11 10, 10 10),", "(11 11, 11.5 11, 11 11.5, 11 11)))")) round_trip(pg, paste("MULTICURVE (LINESTRING (0 0, 5 5),", "CIRCULARSTRING (4 0, 4 4, 8 4))")) round_trip(pg, paste("POLYHEDRALSURFACE Z (((0 0 0, 0 0 1, 0 1 1, 0 1 0, 0 0 0)),", "((0 0 0, 0 1 0, 1 1 0, 1 0 0, 0 0 0)),", "((0 0 0, 1 0 0, 1 0 1, 0 0 1, 0 0 0)),", "((1 1 0, 1 1 1, 1 0 1, 1 0 0, 1 1 0)),", "((0 1 0, 0 1 1, 1 1 1, 1 1 0, 0 1 0)),", "((0 0 1, 1 0 1, 1 1 1, 0 1 1, 0 0 1)))")) round_trip(pg, "TRIANGLE ((0 0, 0 9, 9 0, 0 0))") round_trip(pg, "TIN Z (((0 0 0, 0 0 1, 0 1 0, 0 0 0)), ((0 0 0, 0 1 0, 1 1 0, 0 0 0)))") }) test_that("can read using driver", { skip_if_not(can_con(pg), "could not connect to postgis database") layers <- st_layers("PG:host=localhost dbname=postgis") lyr_expect <- sort(c("sf_meuse__", "sf_meuse2__", "sf_meuse3__", "meuse_multi2", "sf_test__.sf_meuse__", "sf_test__.meuse__", "sf_test__.sf_meuse33__", "sf_test__.sf_meuse4__")) expect_true(all(lyr_expect %in% layers$name)) expect_true(all(layers$features == 155)) expect_true(all(layers$fields == 12)) empty <- try( DBI::dbConnect( RPostgres::Postgres(), host = "localhost", dbname = "empty"), silent=TRUE ) skip_if_not( can_con(empty), "could not connect to 'empty' database" ) expect_error(st_read("PG:dbname=empty", quiet = TRUE), "No layers") }) test_that("Can safely manipulate crs", { skip_if_not(can_con(pg), "could not connect to postgis database") srid <- 4326 expect_true(sf:::get_postgis_crs(pg, srid) == st_crs(srid)) expect_error(sf:::set_postgis_crs(pg, st_crs(srid))) expect_warning(expect_true(is.na(st_crs(sf:::get_new_postgis_srid(pg)))), "not found") new_crs <- st_crs(sf:::get_new_postgis_srid(pg), "+proj=longlat +datum=WGS84 +no_defs", valid = FALSE) expect_message(sf:::set_postgis_crs(pg, new_crs, auth_name = "sf_test"), "Inserted local crs") expect_warning(expect_error(sf:::set_postgis_crs(pg, new_crs), "duplicate key"), "not found") expect_equal(sf:::delete_postgis_crs(pg, new_crs), 1) expect_equal(sf:::delete_postgis_crs(pg, new_crs), 0) }) test_that("new SRIDs are handled correctly", { skip_if_not(can_con(pg), "could not connect to postgis database") data(meuse, package = "sp") meuse_sf = st_as_sf(meuse, coords = c("x", "y"), crs = NA_crs_) crs = st_crs(NA_integer_, paste("+proj=sterea +lat_0=52 +lon_0=5", # creates FALSE, but new one "+k=1.0 +x_0=155000 +y_0=463000 +ellps=bessel", "+towgs84=565.4171,50.3319,465.5524,-0.398957,0.343988,", "-1.87740,4.0725 +units=m +no_defs"), valid = FALSE) st_crs(meuse_sf) = crs expect_message(st_write(meuse_sf, pg, overwrite = TRUE), "Inserted local crs") expect_warning(x <- st_read(pg, query = "select * from meuse_sf limit 3;"), "not found in EPSG support files") expect_true(st_crs(x)$proj4string == crs$proj4string) expect_silent(st_write(meuse_sf, pg, overwrite = TRUE)) }) test_that("schema_table", { expect_error(sf:::schema_table(pg, NA), "character vector") expect_error(sf:::schema_table(pg, NA_character_), "cannot be NA") expect_error(sf:::schema_table(pg, "a", NA), "cannot be NA") expect_error(sf:::schema_table(pg, letters), "longer than 2") expect_equal(sf:::schema_table(pg, "a", "b"), c("b", "a")) expect_equal(sf:::schema_table(pg, "a"), c("public", "a")) }) if (can_con(pg)) { # cleanup try(db_drop_table_schema(pg, "meuse_sf"), silent = TRUE) try(db_drop_table_schema(pg, "meuse_multi"), silent = TRUE) try(db_drop_table_schema(pg, "sf_meuse__"), silent = TRUE) try(db_drop_table_schema(pg, "sf_meuse2__"), silent = TRUE) try(db_drop_table_schema(pg, "sf_meuse3__"), silent = TRUE) try(db_drop_table_schema(pg, "meuse_multi2"), silent = TRUE) try(db_drop_table_schema(pg, '"sf_test__.meuse__"'), silent = TRUE) try(db_drop_table_schema(pg, "sf_test__", "sf_meuse__"), silent = TRUE) try(db_drop_table_schema(pg, "sf_test__", "sf_meuse2__"), silent = TRUE) try(db_drop_table_schema(pg, "sf_test__", "sf_meuse33__"), silent = TRUE) try(db_drop_table_schema(pg, "sf_test__", "sf_meuse4__"), silent = TRUE) try(DBI::dbExecute(pg, "DROP SCHEMA sf_test__ CASCADE;"), silent = TRUE) try(DBI::dbExecute(pg, " DELETE FROM spatial_ref_sys WHERE auth_name = 'sf';"), silent = TRUE) try(DBI::dbDisconnect(pg), silent = TRUE) } ================================================ FILE: tests/testthat/test-postgis_RPostgres.R ================================================ #' To run the tests from the database, you can setup a docker container #' and run it as needed. #' docker run \ #' --name "postgis_test" \ #' -p 5432:5432 \ #' -e POSTGRES_USER=$USER \ #' -e POSTGRES_PASS=$USER \ #' -e POSTGRES_DBNAME=postgis \ #' -d -t kartoza/postgis #' docker start postgis skip_on_os("solaris") skip_if_not_installed("RPostgres") library(sf) library(DBI) library(RPostgres) library(testthat) can_con <- function(x) inherits(x, "PqConnection") db_drop_table_schema <- function(con, schema, table = NULL) { if (is.null(table)) { table <- paste(c("public", schema), collapse = ".") } else { table <- paste(c(schema, table), collapse = ".") } DBI::dbExecute(pg, paste("DROP TABLE ", table, " CASCADE;")) } require("sp") data(meuse) pts <- st_as_sf(meuse, coords = c("x", "y"), crs = 28992) epsg_31370 = paste0("+proj=lcc +lat_1=51.16666723333333 +lat_2=49.8333339 ", "+lat_0=90 +lon_0=4.367486666666666 +x_0=150000.013 ", "+y_0=5400088.438 +ellps=intl +towgs84=-106.869,52.2978,", "-103.724,0.3366,-0.457,1.8422,-1.2747 +units=m +no_defs") pg <- NULL test_that("check utils", expect_false(can_con(pg))) try(pg <- DBI::dbConnect( RPostgres::Postgres(), host = "localhost", dbname = "postgis", password = Sys.info()[["user"]]), silent=TRUE) # tests ------------------------------------------------------------------------ test_that("can write to db", { skip_if_not(can_con(pg), "could not connect to postgis database") expect_silent(suppressMessages(st_write(pts, pg, "sf_meuse__"))) expect_error(st_write(pts, pg, "sf_meuse__", append = FALSE, delete_layer = FALSE), "exists") expect_silent(st_write(pts, pg, "sf_meuse__", delete_layer = TRUE)) expect_silent(st_write(pts, pg, "sf_meuse2__", binary = FALSE)) suppressWarnings(z <- st_set_crs(pts, epsg_31370)) expect_message(st_write(z, pg, "sf_meuse3__"), "Inserted local crs") expect_silent(st_write(z, pg, "sf_meuse3__", append = TRUE)) expect_equal(nrow(DBI::dbReadTable(pg, "sf_meuse3__")), nrow(z) * 2) expect_silent(sf3 <- st_write(z, pg, "sf_meuse3__", delete_layer = TRUE)) expect_true(st_crs(sf3) == st_crs(epsg_31370)) # also test write_sf options expect_error(write_sf(pts, pg, "sf_meuse__", append = FALSE, delete_layer = FALSE), "exists") expect_silent(write_sf(pts, pg, "sf_meuse__", delete_layer = TRUE)) expect_error(write_sf(pts, pg, "sf_meuse__", append = FALSE, delete_layer = FALSE)) expect_error(write_sf(pts[1, ], pg, "sf_meuse__", append = TRUE, delete_layer = TRUE)) expect_error(write_sf(pts, pg, "sf_meuse__", overwrite = TRUE), "deprecated") expect_silent(write_sf(pts[1, ], pg, "sf_meuse__", append = TRUE)) p2 <- st_read(pg, "sf_meuse__") expect_equal(nrow(p2), nrow(pts) + 1) expect_silent(write_sf(pts, pg, "sf_meuse__", delete_layer = TRUE)) }) test_that("can create a missing table even if append is TRUE (#2206)", { skip_if_not(can_con(pg), "could not connect to postgis database") x <- st_sf(geometry = st_sfc(st_point(1:2))) dbWriteTable(pg, "x", x, append = TRUE, temporary = TRUE) col_type <- dbGetQuery(pg, "SELECT pg_typeof(geometry) as col_type FROM x") expect_equal(unclass(col_type[["col_type"]]), "geometry") dbExecute(pg, "drop table if exists x") }) test_that("can handle multiple geom columns", { skip_if_not(can_con(pg), "could not connect to postgis database") multi <- cbind(pts[["geometry"]], st_transform(pts, 4326)) expect_silent(st_write(multi, pg, "meuse_multi", delete_layer = TRUE)) expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE)) # expect_equal(st_crs(x[["geometry"]]), st_crs(multi[["geometry"]])) -> fails if EPSG databases differ expect_true(st_crs(x[["geometry.1"]]) == st_crs(multi[["geometry.1"]])) expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, type = c(1,4))) expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, type = c(4,4))) expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, promote_to_multi = FALSE)) expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi", quiet = TRUE, geometry_column = "geometry.1")) x <- st_layers("PG:host=localhost dbname=postgis") multi2 <- cbind(pts[["geometry"]], st_set_crs(st_transform(pts, 4326), NA)) expect_silent(st_write(multi2, pg, "meuse_multi2", delete_layer = TRUE)) expect_silent(x <- st_read(pg, "meuse_multi2")) expect_equal(st_crs(x[["geometry"]]), st_crs(multi2[["geometry"]])) expect_equal(st_crs(x[["geometry.1"]]), st_crs(multi2[["geometry.1"]])) expect_silent(x <- st_read("PG:host=localhost dbname=postgis", "meuse_multi2", quiet = TRUE)) #expect_equal(st_crs(x[["geometry"]]), st_crs(multi2[["geometry"]])) expect_equal(st_crs(x[["geometry.1"]]), st_crs(multi2[["geometry.1"]])) }) test_that("sf can write units to database (#264)", { skip_if_not(can_con(pg), "could not connect to postgis database") ptsu <- pts ptsu[["u"]] <- ptsu[["cadmium"]] units(ptsu[["u"]]) <- units::as_units("km") expect_silent(st_write(ptsu, pg, "sf_units__", delete_layer = TRUE)) r <- st_read(pg, "sf_units__") expect_type(r[["u"]], "double") expect_equal(sort(r[["u"]]), sort(as.numeric(ptsu[["u"]]))) dbRemoveTable(pg, "sf_units__") }) test_that("sf can read non-sf tables with geometries", { skip_if_not(can_con(pg), "could not connect to postgis database") expect_warning(st_read(pg, query = "select 1 as a"), "Could not find a simple features geometry column.") expect_silent(st_read(pg, query = "SELECT 'POINT(1 1)'::geometry")) expect_silent(st_read(pg, query = "SELECT 'POINT(1 1)'::geometry as a, 'POINT(2 2)'::geometry as b")) }) test_that("returns an `sf` object (#1039)", { skip_if_not(can_con(pg), "could not connect to postgis database") expect_s3_class(st_read(pg, query = "SELECT 'POINT(1 1)'::geometry"), "sf") expect_s3_class(st_read(pg, query = "SELECT 'POINT(1 1)'::geometry", as_tibble = TRUE), "sf") expect_s3_class(read_sf(pg, query = "SELECT 'POINT(1 1)'::geometry"), "sf") }) test_that("validates arguments", { skip_if_not(can_con(pg), "could not connect to postgis database") expect_error(st_read(pg), "Provide either a `layer` or a `query`") expect_warning(st_read(pg, "sf_meuse__", query = "select * from sf_meuse__"), "You provided both `layer` and `query`") expect_error(st_read(pg, "sf_meuse__", random_arg = "a"), "Unused arguments:") expect_error(st_read(pg, "sf_meuse__", table = "a"), "`layer` rather than `table`") expect_error(st_read(pg, "sf_meuse__", table = "a", x = 1, y = 2), "`layer` rather than `table`") }) test_that("sf can write non-sf tables with geometries", { skip_if_not(can_con(pg), "could not connect to postgis database") df <- as.data.frame(pts) expect_silent(st_write(df, pg, "df")) expect_silent(dfx <- st_read(pg, "df")) expect_equal(df[["geometry"]], dfx[["geometry"]]) expect_silent(DBI::dbRemoveTable(pg, "df")) }) test_that("sf can write non-sf tables with multiple geometries", { skip_if_not(can_con(pg), "could not connect to postgis database") df <- as.data.frame(pts) df$geography <- st_transform(df$geometry, 4326) expect_silent(st_write(df, pg, "df")) expect_silent(dfx <- st_read(pg, "df")) expect_equal(df[["geometry"]], dfx[["geometry"]]) expect_equal(df[["geography"]], dfx[["geography"]]) expect_silent(DBI::dbRemoveTable(pg, "df")) }) test_that("tidy workflow can write multiple geometries", { skip_if_not(can_con(pg), "could not connect to postgis database") df <- tibble::as_tibble(pts) df <- dplyr::mutate(df, geography = st_transform(geometry, 4326)) expect_silent(write_sf(df, pg, "df")) on.exit(DBI::dbRemoveTable(pg, "df")) expect_silent(dfx <- read_sf(pg, "df")) expect_equal(df[["geometry"]], dfx[["geometry"]]) expect_equal(df[["geography"]], dfx[["geography"]]) }) test_that("sf can preserve types (#592)", { skip_if_not(can_con(pg), "could not connect to postgis database") dtypes <- data.frame( logi = c(TRUE, FALSE, NA), chara = c("a", "", NA), nume = c(1.1e1, 2.2e2, NA), inte = c(1L, 2L, NA), fact = factor(c("a", "b", NA), levels = letters), #comp = c(complex(1, 2), complex(2, 3)), date = c(rep(Sys.Date(), 2), NA), time = c(rep(Sys.time(), 2), NA), x = c(1, 2, 4), y = c(1, 2, 4), stringsAsFactors = FALSE) # cannot write lists #dtypes$lst <- c(list(matrix("a")), list(matrix(c("b", "c"))), list(NA)) dtypes <- st_as_sf(dtypes, coords = c("x", "y")) st_write(dtypes, pg, delete_layer = TRUE) x <- st_read(pg, "dtypes") dtypes$fact <- as.character(dtypes$fact) # R 4.1; EP: attr(x$time, "tzone") = attr(dtypes$time, "tzone") = NULL expect_equal(x, dtypes) DBI::dbRemoveTable(pg, "dtypes") }) test_that("can write to other schema", { skip_if_not(can_con(pg), "could not connect to postgis database") try(DBI::dbSendQuery(pg, "CREATE SCHEMA sf_test__;"), silent = TRUE) q <- "SELECT schema_name FROM information_schema.schemata WHERE schema_name = 'sf_test__';" suppressWarnings(could_schema <- DBI::dbGetQuery(pg, q) |> nrow() > 0) skip_if_not(could_schema, "Could not create schema (might need to run 'GRANT CREATE ON DATABASE postgis TO ')") tbl_meuse_public <- Id(schema = "public", table = "sf_meuse__") tbl_meuse_test <- Id(schema = "sf_test__", table = "sf_meuse__") expect_error(st_write(pts, pg, tbl_meuse_public, append = FALSE, delete_layer = FALSE), "exists") expect_silent(st_write(pts, pg, tbl_meuse_test)) expect_error(st_write(pts, pg, tbl_meuse_test, append = FALSE, delete_layer = FALSE), "exists") expect_silent(st_write(pts, pg, tbl_meuse_test, delete_layer = TRUE)) expect_warning(z <- st_set_crs(pts, epsg_31370)) expect_silent(st_write(z, pg, Id(schema = "sf_test__", table = "sf_meuse33__"))) expect_silent(st_write(z, pg, Id(schema = "sf_test__", table = "sf_meuse4__"))) # weird name work expect_silent(st_write(pts, pg, c(NULL, "sf_test__.meuse__"), delete_layer = TRUE)) expect_silent(st_write(pts.2 <- pts, pg, delete_layer = TRUE)) expect_true(DBI::dbRemoveTable(pg, "pts.2 <- pts")) }) test_that("support for capital names (#571)", { skip_if_not(can_con(pg), "could not connect to postgis database") expect_silent(st_write(pts, pg, "Meuse_tbl")) expect_true(DBI::dbRemoveTable(pg, "Meuse_tbl")) try(DBI::dbSendQuery(pg, "CREATE SCHEMA \"CAP__\";"), silent = TRUE) q <- "SELECT schema_name FROM information_schema.schemata WHERE schema_name = 'CAP__';" suppressWarnings(could_schema <- DBI::dbGetQuery(pg, q) |> nrow() > 0) skip_if_not(could_schema, "Could not create schema (might need to run 'GRANT CREATE ON DATABASE postgis TO ')") expect_silent(st_write(pts, pg, Id(schema = "CAP__", table = "Meuse_tbl"))) expect_true(DBI::dbRemoveTable(pg, Id(schema = "CAP__", table = "Meuse_tbl"))) dbExecute(pg, 'DROP SCHEMA "CAP__" CASCADE;') }) test_that("can read from db", { skip_if_not(can_con(pg), "could not connect to postgis database") q <- "select * from sf_meuse__" #expect_warning(x <- st_read(pg, query = q), "crs") expect_silent(x <- st_read(pg, query = q)) expect_error(st_read(pg), "Provide either a `layer` or a `query`") y <- st_read(pg, "sf_meuse__") expect_equal(dim(pts), dim(y)) expect_identical(st_crs(pts), st_crs(y)) expect_identical(st_precision(pts), st_precision(y)) expect_warning(z <- st_read(pg, "sf_meuse3__"), "Could not find database srid") expect_equal(dim(pts), dim(z)) #expect_identical(st_crs(NA), st_crs(z)) expect_true(st_crs(epsg_31370) == st_crs(z)) expect_identical(st_precision(pts), st_precision(z)) w <- st_read(pg, DBI::Id(schema = "sf_test__", table = "sf_meuse__")) expect_equal(dim(y), dim(w)) expect_identical(st_crs(y), st_crs(w)) expect_identical(st_precision(y), st_precision(w)) expect_error(st_read(pg, "missing"), "not exist") expect_error(st_read(pg, DBI::Id(schema = "missing", table = "missing")), "not exist") # make sure it reads in the correct schema expect_error(st_read(pg, DBI::Id(schema = "sf_test__", table = "sf_meuse3__")), "not exist") }) test_that("can read views (#212)", { skip_if_not(Sys.getenv("USER") != "edzer") # this stopped working for me skip_if_not(can_con(pg), "could not connect to postgis database") expect_equal(DBI::dbExecute(pg, "CREATE VIEW sf_view__ AS SELECT * FROM sf_meuse__;"), 0) expect_equal(DBI::dbExecute(pg, "CREATE VIEW sf_test__.sf_view__ AS SELECT * FROM sf_meuse__;"), 0) expect_equal(DBI::dbExecute(pg, "CREATE MATERIALIZED VIEW sf_viewm__ AS SELECT * FROM sf_meuse__;"), 155) expect_equal(DBI::dbExecute(pg, "CREATE MATERIALIZED VIEW sf_test__.sf_viewm__ AS SELECT * FROM sf_meuse__;"), 155) x <- st_read(pg, "sf_meuse__") expect_identical(st_read(pg, "sf_view__"), x) expect_identical(st_read(pg, DBI::Id(schema = "public", table = "sf_view__")), x) expect_identical(st_read(pg, DBI::Id(schema = "sf_test__", table = "sf_view__")), x) expect_identical(st_read(pg, "sf_viewm__"), x) expect_identical(st_read(pg, DBI::Id(schema = "sf_test__", table = "sf_viewm__")), x) # cleanup ------------------------------------------------------------------ try(DBI::dbExecute(pg, "DROP VIEW sf_view__"), silent = TRUE) try(DBI::dbExecute(pg, "DROP VIEW sf_test__.sf_view__"), silent = TRUE) try(DBI::dbExecute(pg, "DROP MATERIALIZED VIEW sf_viewm__"), silent = TRUE) try(DBI::dbExecute(pg, "DROP MATERIALIZED VIEW sf_test__.sf_viewm__"), silent = TRUE) }) test_that("round trips", { skip_if_not(can_con(pg), "could not connect to postgis database") round_trip = function(conn, wkt) { query = paste0("SELECT '", wkt, "'::geometry;") returnstr = suppressWarnings(DBI::dbGetQuery(conn, query)$geometry) wkb = structure(returnstr, class = "WKB") ret = st_as_sfc(wkb, EWKB = TRUE) message(paste("IN: ", wkt, "\n")) # OUT contains WKB created in PostGIS from wkt, interpreted to R by sf, printed as WKT by sf message(paste("OUT: ", txt <- st_as_text(ret, EWKT=TRUE)[[1]], "\n")) if (length(grep("SRID", txt)) == 0) { query = paste0("SELECT ST_AsText('",sf:::CPL_raw_to_hex(st_as_binary(ret[[1]])),"');") received = suppressWarnings(DBI::dbGetQuery(conn, query)$st_astext) # PG: contains the PostGIS WKT, after reading the WKB created by sf from R native message(paste("PG: ", received, "\n")) } expect_equal(wkt, txt) } round_trip(pg, "SRID=4326;POINT M (0 0 0)") round_trip(pg, "POINT Z (0 0 0)") round_trip(pg, "POINT ZM (0 0 0 0)") round_trip(pg, "POINT (0 0)") round_trip(pg, "LINESTRING (0 0, 1 1, 2 2)") round_trip(pg, "MULTIPOINT ((0 0), (1 1), (2 2))") round_trip(pg, "POLYGON ((0 0, 1 0, 1 1, 0 0))") round_trip(pg, "MULTIPOLYGON (((0 0, 1 0, 1 1, 0 0)), ((2 2, 3 2, 3 3, 2 2)))") round_trip(pg, paste("MULTIPOLYGON (((0 0, 1 0, 1 1, 0 0),", "(0.2 0.2, 0.8 0.2, 0.8 0.8, 0.2 0.2)),", "((2 2, 3 2, 3 3, 2 2)))")) round_trip(pg, paste("MULTILINESTRING ((0 0, 1 0, 1 1, 0 0),", "(0.2 0.2, 0.8 0.2, 0.8 0.8, 0.2 0.2),", "(2 2, 3 2, 3 3, 2 2))")) # other types; examples taken from the PostGIS manuals (ch 4): round_trip(pg, "CIRCULARSTRING (0 0, 1 1, 1 0)") round_trip(pg, "CIRCULARSTRING (0 0, 4 0, 4 4, 0 4, 0 0)") round_trip(pg, paste("CURVEPOLYGON (CIRCULARSTRING (0 0, 4 0, 4 4, 0 4, 0 0),", "LINESTRING (1 1, 3 3, 3 1, 1 1))")) round_trip(pg, paste("COMPOUNDCURVE (CIRCULARSTRING (0 0, 1 1, 1 0),", "LINESTRING (1 0, 0 1))")) round_trip(pg, paste0("CURVEPOLYGON (COMPOUNDCURVE (CIRCULARSTRING (0 0, 2 0, 2 1, 2 3, 4 3), ", "LINESTRING (4 3, 4 5, 1 4, 0 0)), ", "CIRCULARSTRING (1.7 1, 1.4 0.4, 1.6 0.4, 1.6 0.5, 1.7 1))")) round_trip(pg, "MULTICURVE (LINESTRING (0 0, 5 5), CIRCULARSTRING (4 0, 4 4, 8 4))") round_trip(pg, paste("MULTISURFACE (CURVEPOLYGON (CIRCULARSTRING (0 0, 4 0, 4 4, 0 4, 0 0),", "LINESTRING (1 1, 3 3, 3 1, 1 1)),", "POLYGON ((10 10, 14 12, 11 10, 10 10),", "(11 11, 11.5 11, 11 11.5, 11 11)))")) round_trip(pg, paste("MULTICURVE (LINESTRING (0 0, 5 5),", "CIRCULARSTRING (4 0, 4 4, 8 4))")) round_trip(pg, paste("POLYHEDRALSURFACE Z (((0 0 0, 0 0 1, 0 1 1, 0 1 0, 0 0 0)),", "((0 0 0, 0 1 0, 1 1 0, 1 0 0, 0 0 0)),", "((0 0 0, 1 0 0, 1 0 1, 0 0 1, 0 0 0)),", "((1 1 0, 1 1 1, 1 0 1, 1 0 0, 1 1 0)),", "((0 1 0, 0 1 1, 1 1 1, 1 1 0, 0 1 0)),", "((0 0 1, 1 0 1, 1 1 1, 0 1 1, 0 0 1)))")) round_trip(pg, "TRIANGLE ((0 0, 0 9, 9 0, 0 0))") round_trip(pg, "TIN Z (((0 0 0, 0 0 1, 0 1 0, 0 0 0)), ((0 0 0, 0 1 0, 1 1 0, 0 0 0)))") }) test_that("can read using driver", { skip_if_not(can_con(pg), "could not connect to postgis database") layers <- st_layers("PG:host=localhost dbname=postgis") lyr_expect <- sort(c("sf_meuse__", "sf_meuse2__", "sf_meuse3__", "meuse_multi2", "sf_test__.sf_meuse__", "sf_test__.meuse__", "sf_test__.sf_meuse33__", "sf_test__.sf_meuse4__")) expect_true(all(lyr_expect %in% layers$name)) expect_true(all(layers$features == 155)) expect_true(all(layers$fields == 12)) empty <- try( DBI::dbConnect( RPostgres::Postgres(), host = "localhost", dbname = "empty"), silent = TRUE ) skip_if_not( can_con(empty), "could not connect to 'empty' database" ) expect_error(st_read("PG:dbname=empty", quiet = TRUE), "No layers") # EJP: removed host=localhost }) test_that("Can override local crs", { skip_if_not(can_con(pg), "could not connect to postgis database") ewkb <- c( wgs84 = sf:::db_binary(st_set_crs(st_sfc(st_point(1:2)), 4326)), unavailable = sf:::db_binary(st_set_crs(st_sfc(st_point(1:2)), sf:::make_empty_crs(1111))), missing = sf:::db_binary(st_sfc(st_point(1:2))) ) queries <- paste0("select st_srid('", ewkb, "'::geometry) as srid") expect_equal(dbGetQuery(pg, queries[1])[["srid"]], 4326) expect_equal(dbGetQuery(pg, queries[2])[["srid"]], 1111) expect_equal(dbGetQuery(pg, queries[3])[["srid"]], 0) }) test_that("Can safely manipulate crs", { skip_if_not(can_con(pg), "could not connect to postgis database") srid <- 4326 crs <- st_crs(srid) expect_true(sf:::db_find_srid(pg, srid = srid) == st_crs(srid)) expect_true(sf:::db_find_srtext(pg, crs) == st_crs(srid)) expect_error(sf:::db_insert_crs(pg, st_crs(srid)), "already exists") expect_warning(expect_true(is.na(st_crs(sf:::get_new_postgis_srid(pg)))), "not found") new_crs <- sf:::make_empty_crs( epsg = sf:::get_new_postgis_srid(pg), text = "+proj=longlat +datum=WGS84 +no_defs" ) expect_message(sf:::db_insert_crs(pg, new_crs, auth_name = "sf_test"), "Inserted local crs") expect_error(sf:::db_insert_crs(pg, new_crs), "duplicate key") expect_equal(sf:::delete_postgis_crs(pg, new_crs), 1) expect_equal(sf:::delete_postgis_crs(pg, new_crs), 0) # set and delete new_crs <- sf:::make_empty_crs( epsg = NA, text = st_as_text(st_crs(epsg_31370)) ) expect_message(new_srid <- sf:::db_insert_crs(pg, new_crs), "Inserted local crs") expect_error(sf:::delete_postgis_crs(pg, new_crs), "Missing SRID") crs2 <- sf:::make_empty_crs(sf:::epsg(new_srid), st_as_text(st_crs(3857))) expect_equal(sf:::delete_postgis_crs(pg, crs2), 0) # crs doesn't match any crs expect_equal(sf:::delete_postgis_crs(pg, new_srid), 1) # udpate expect_message(sf:::db_insert_crs(pg, new_srid), "Inserted local crs") new_srid[["wkt"]] <- crs2[["wkt"]] expect_error(sf:::db_insert_crs(pg, new_srid), "already exists") expect_message(sf:::db_insert_crs(pg, new_srid, update = TRUE), "Inserted local crs") }) test_that("new SRIDs are handled correctly", { skip_if_not(can_con(pg), "could not connect to postgis database") crs <- sf:::make_empty_crs( epsg = NA, wkt = st_as_text(st_crs(epsg_31370)) ) suppressWarnings(st_crs(pts) <- crs) expect_warning(x <- st_read(pg, query = "select * from sf_meuse3__ limit 3;"), "Could not find database srid") expect_true(st_as_text(st_crs(x)) == st_as_text(crs)) }) test_that("schema_table", { skip_if_not(can_con(pg), "could not connect to postgis database") expect_error(sf:::schema_table(pg, NA), "character vector") expect_error(sf:::schema_table(pg, NA_character_), "cannot be NA") expect_error(sf:::schema_table(pg, "a", NA), "cannot be NA") expect_error(sf:::schema_table(pg, letters), "longer than 2") expect_equal(sf:::schema_table(pg, "a", "b"), c("b", "a")) expect_equal(sf:::schema_table(pg, "a"), c("public", "a")) }) test_that("Can find a crs", { skip_if_not(can_con(pg), "could not connect to postgis database") expect_equal(sf:::db_find_srid(pg, st_crs(NA)), st_crs(NA)) expect_error(sf:::delete_postgis_crs(pg, st_crs(NA)), "M|missing (crs)|(SRID)") }) if (can_con(pg)) { skip_if_not(can_con(pg), "could not connect to postgis database") # cleanup try(db_drop_table_schema(pg, "meuse_sf"), silent = TRUE) try(db_drop_table_schema(pg, "meuse_multi"), silent = TRUE) try(db_drop_table_schema(pg, "sf_meuse__"), silent = TRUE) try(db_drop_table_schema(pg, "sf_meuse2__"), silent = TRUE) try(db_drop_table_schema(pg, "sf_meuse3__"), silent = TRUE) try(db_drop_table_schema(pg, "meuse_multi2"), silent = TRUE) try(db_drop_table_schema(pg, '"sf_test__.meuse__"'), silent = TRUE) try(db_drop_table_schema(pg, "sf_test__", "sf_meuse__"), silent = TRUE) try(db_drop_table_schema(pg, "sf_test__", "sf_meuse2__"), silent = TRUE) try(db_drop_table_schema(pg, "sf_test__", "sf_meuse33__"), silent = TRUE) try(db_drop_table_schema(pg, "sf_test__", "sf_meuse4__"), silent = TRUE) try(DBI::dbExecute(pg, "DROP SCHEMA sf_test__ CASCADE;"), silent = TRUE) try(DBI::dbExecute(pg, " DELETE FROM spatial_ref_sys WHERE auth_name = 'sf';"), silent = TRUE) try(DBI::dbDisconnect(pg), silent = TRUE) } ================================================ FILE: tests/testthat/test-proj.R ================================================ test_that("sf_project works", { sf_project(pts = matrix(0:1, 1, 2), st_crs(4326), st_crs(3587)) }) ================================================ FILE: tests/testthat/test-read.R ================================================ test_that("we can read a shapefile using st_read", { nc <- st_read(system.file("shape/nc.shp", package = "sf"), "nc", crs = 4267, quiet = TRUE) expect_s3_class(nc, c("sf", "data.frame"), exact = TRUE) expect_equal(dim(nc), c(100, 15)) }) test_that("we can read shapefiles with a query string", { nc <- st_read(system.file("shape/nc.shp", package="sf"), "nc", crs = 4267, quiet = TRUE) nc_all <- st_read(system.file("shape/nc.shp", package="sf"), query = "select * from nc", crs = 4267, quiet = TRUE) nc_some <- st_read(system.file("shape/nc.shp", package="sf"), query = "select * from nc where SID79 > 50", crs = 4267, quiet = TRUE) }) test_that("st_read.default gives error messages", { expect_error(st_read(), "dsn should specify a data source or filename") expect_error(st_read(NULL), "no st_read method available for objects of class NULL") }) test_that("st_write.sf gives error messages on unknown dsn", { expect_error(st_write(st_sf(st_sfc(st_point())), NULL), "no st_write method available for dsn of class NULL") }) test_that("stringsAsFactors = FALSE produces a data.frame with no factors", { nc <- st_read(system.file("shape/nc.shp", package="sf"), "nc", crs = 4267, stringsAsFactors = FALSE, quiet = TRUE) expect_false(any(sapply(nc, class) == "factor")) }) test_that("stringsAsFactors = TRUE produces a data.frame with factors", { nc <- st_read(system.file("shape/nc.shp", package="sf"), "nc", crs = 4267, stringsAsFactors = TRUE, quiet = TRUE) expect_true(any(sapply(nc, class) == "factor")) }) test_that("drivers extensions are all lowercase", { expect_equal(names(extension_map), tolower(names(extension_map))) expect_equal(names(prefix_map), tolower(names(prefix_map))) }) test_that("guess_driver is strict", { expect_error(guess_driver(c("PG:xyz", "x.shp")), "length") expect_error(guess_driver(1), "character") }) test_that("guess_driver works on extensions", { # for repeatability, this is how I turned the list to tests # `^"(\w+)" = ("[\w\s]+"),?` # to `expect_equal(guess_driver("nc.\1"), c("\1" = \2))` expect_equal(guess_driver("nc.bna"), c("bna" = "BNA")) expect_equal(guess_driver("nc.csv"), c("csv" = "CSV")) expect_equal(guess_driver("nc.e00"), c("e00" = "AVCE00")) expect_equal(guess_driver("nc.gdb"), c("gdb" = "OpenFileGDB")) expect_equal(guess_driver("nc.geojson"), c("geojson" = "GeoJSON")) expect_equal(guess_driver("nc.gml"), c("gml" = "GML")) expect_equal(guess_driver("nc.gmt"), c("gmt" = "GMT")) expect_equal(guess_driver("nc.gpkg"), c("gpkg" = "GPKG")) expect_equal(guess_driver("nc.gps"), c("gps" = "GPSBabel")) expect_equal(guess_driver("nc.gtm"), c("gtm" = "GPSTrackMaker")) expect_equal(guess_driver("nc.gxt"), c("gxt" = "Geoconcept")) expect_equal(guess_driver("nc.kml"), c("kml" = "KML")) expect_equal(guess_driver("nc.jml"), c("jml" = "JML")) expect_equal(guess_driver("nc.map"), c("map" = "WAsP")) expect_equal(guess_driver("nc.mdb"), c("mdb" = "Geomedia")) expect_equal(guess_driver("nc.nc"), c("nc" = "netCDF")) expect_equal(guess_driver("nc.ods"), c("ods" = "ODS")) expect_equal(guess_driver("nc.osm"), c("osm" = "OSM")) expect_equal(guess_driver("nc.pbf"), c("pbf" = "OSM")) expect_equal(guess_driver("nc.shp"), c("shp" = "ESRI Shapefile")) expect_equal(guess_driver("nc.sqlite"), c("sqlite" = "SQLite")) expect_equal(guess_driver("nc.vdv"), c("vdv" = "VDV")) expect_equal(guess_driver("nc.xls"), c("xls" = "xls")) expect_equal(guess_driver("nc.xlsx"), c("xlsx" = "XLSX")) # unsuported expect_equal(guess_driver("nc.notsupported"), NA) }) test_that("guess_driver works on suffixes", { # for repeatability, this is how I turned the list to tests # `^"(\w+)" = ("[\w\s]+"),?` # to `expect_equal(guess_driver("nc.\1"), c("\1" = \2))` expect_equal(guess_driver("couchdb:nc"), c("couchdb" = "CouchDB")) expect_equal(guess_driver("db2odbc:nc"), c("db2odbc" = "DB2ODBC")) expect_equal(guess_driver("dods:nc"), c("dods" = "DODS")) expect_equal(guess_driver("gft:nc"), c("gft" = "GFT")) expect_equal(guess_driver("mssql:nc"), c("mssql" = "MSSQLSpatial")) expect_equal(guess_driver("mysql:nc"), c("mysql" = "MySQL")) expect_equal(guess_driver("oci:nc"), c("oci" = "OCI")) expect_equal(guess_driver("odbc:nc"), c("odbc" = "ODBC")) expect_equal(guess_driver("pg:nc"), c("pg" = "PostgreSQL")) expect_equal(guess_driver("sde:nc"), c("sde" = "SDE")) # upper case expect_equal(guess_driver("CouchDB:nc"), c("couchdb" = "CouchDB")) expect_equal(guess_driver("db2ODBC:nc"), c("db2odbc" = "DB2ODBC")) expect_equal(guess_driver("DODS:nc"), c("dods" = "DODS")) expect_equal(guess_driver("GFT:nc"), c("gft" = "GFT")) expect_equal(guess_driver("MSSQL:nc"), c("mssql" = "MSSQLSpatial")) expect_equal(guess_driver("MYSQL:nc"), c("mysql" = "MySQL")) expect_equal(guess_driver("OCI:nc"), c("oci" = "OCI")) expect_equal(guess_driver("ODBC:nc"), c("odbc" = "ODBC")) expect_equal(guess_driver("PG:nc"), c("pg" = "PostgreSQL")) expect_equal(guess_driver("SDE:nc"), c("sde" = "SDE")) # unsuported expect_equal(guess_driver("notsupported:nc"), NA) }) test_that("weird names are supported", { expect_equal(guess_driver("pg:nc.shp"), c("pg" = "PostgreSQL")) expect_equal(guess_driver("pg:nc.shp.e00"), c("pg" = "PostgreSQL")) expect_equal(guess_driver("nc.shp.e00"), c("e00" = "AVCE00")) expect_equal(guess_driver("couchdb:shp"), c("couchdb" = "CouchDB")) expect_equal(guess_driver("notsupported:nc.shp"), NA) expect_equal(guess_driver("notsupported"), NA) }) test_that("driver utils work", { expect_true(is_driver_available("shp", data.frame(name = c("x", "y", "shp")))) expect_true(is_driver_available("shp", data.frame(name = c("shp")))) expect_false(is_driver_available("shp", data.frame(name = c("x", "y", "z")))) expect_false(is_driver_available("shp", data.frame(name = c("x", "y", "z")))) expect_error(is_driver_can("shp", data.frame(name = c("x", "y", "shp")), operation = "nothing")) expect_error(is_driver_can("shp", data.frame(name = c("x", "y")), operation = "nothing")) expect_true(is_driver_can("shp", data.frame(name = c("x", "y", "shp"), write = rep(TRUE, 3)), operation = "write")) expect_false(is_driver_can("shp", data.frame(name = c("x", "y", "shp"), write = c(TRUE, TRUE, FALSE)), operation = "write")) }) test_that("guess_driver_can_write", { expect_error(guess_driver_can_write("x.e00", NA), "Could not guess") expect_error(guess_driver_can_write("x.not", c("nothing" = "nothing")), "not available") expect_equal(guess_driver_can_write("x.csv"), c("csv" = "CSV")) expect_equal(guess_driver_can_write("c:/x.csv"), c("csv" = "CSV")) expect_error(guess_driver_can_write("x.unsuported"), "Could not guess driver") expect_error(guess_driver_can_write("unsuported:x"), "Could not guess driver") }) test_that("driver operations", { # These tests are driver specifics to GDAL version and OS. expect_error(guess_driver_can_write("x.e00"), "AVCE00 driver not available|cannot write") # expect_error(guess_driver_can_write("x.gdb"), "cannot write") -> no longer the case when GDAL >= 3.6.0 expect_equal(guess_driver_can_write("x.geojson"), c("geojson" = "GeoJSON")) expect_equal(guess_driver_can_write("x.csv"), c("csv" = "CSV")) expect_equal(guess_driver_can_write("x.gml"), c("gml" = "GML")) }) test_that("guess driver on windows with backslashes (#127)", { expect_identical(guess_driver("c:\\Temp\\this.shp"), guess_driver("c:/Temp/this.shp")) }) test_that("the first layer is selected with a warning", { skip_on_os("mac") expect_warning(st_read(system.file("osm/overpass.osm", package="sf"), quiet = TRUE), "automatically selected the first layer") expect_error(st_read(system.file("osm/overpass.osm", package="sf"), "foo", quiet = TRUE), "Opening layer failed") }) test_that("we get a warning when not specifying one of multiple layers", { skip_if_not("OSM" %in% st_drivers()$name && Sys.info()['sysname'] != "Darwin") Sys.setenv(OSM_USE_CUSTOM_INDEXING="NO") osm = system.file("osm/overpass.osm", package="sf") expect_warning(st_read(osm, quiet = TRUE), "automatically selected the first layer in a data source containing more than one.") }) test_that("reading non-spatial table works", { skip_if_not(sf_extSoftVersion()[["GDAL"]] >= "2.2.0") # error on OSX for 2.1.3 expect_warning(st_read(system.file("gpkg/nospatial.gpkg", package = "sf")), "no simple feature geometries present") expect_warning( expect_s3_class(st_read(system.file("gpkg/nospatial.gpkg", package = "sf")), "data.frame"), "no simple feature geometries" ) # expect_warning( # expect_s3_class(read_sf(system.file("gpkg/nospatial.gpkg", package = "sf")), # "tbl_df"), # "no simple feature geometries" # ) }) test_that("Missing data sources have useful error message (#967)", { # write temporary file x <- tempfile(fileext = ".kml") cat("empty", file = x) expect_error(st_read(tempfile(fileext = ".csv")), "The file doesn't seem to exist.") expect_error(st_read("PG:host=wrong"), "Check connection parameters.") expect_error(st_read(x), "The source could be corrupt or not supported.") expect_error(st_read(""), "not an empty string.") # delete temp file file.remove(x) }) ================================================ FILE: tests/testthat/test-s2.R ================================================ skip_if_not_installed("s2") test_that("s2 roundtrips work", { library(s2) nc = st_geometry(st_read(system.file("shape/nc.shp", package="sf"))) s2 = st_as_sfc(st_as_s2(nc), crs = st_crs(nc)) # precision? # FIXME this test appears to be failing? # expect_equal(sum(lengths(st_equals(s2, nc))), 0L) expect_equal(sum(lengths(st_equals(st_set_precision(s2, 1e8), st_set_precision(nc, 1e8))) == 1), 98L) expect_equal(sum(lengths(st_equals(st_set_precision(s2, 1e7), st_set_precision(nc, 1e7))) == 1), 100L) }) test_that("as_s2_geography() is defined for sf and sfc objects", { nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) expect_s3_class(s2::as_s2_geography(nc), "s2_geography") expect_s3_class(s2::as_s2_geography(st_geometry(nc)), "s2_geography") }) test_that("s2 polygon creation", { outer = rbind(c(10,35), # CCW: c(20,10), c(40,15), c(45,45), c(10,35)) inner = rbind(c(30,20), # CW: c(20,30), c(35,35), c(30,20)) # expect_silent(l <- s2polyline(outer)) # expect_error(p <- s2polygon(l)) # expect_silent(l <- s2polyline(outer[1:4,])) # expect_silent(p <- s2polygon(l)) # expect_silent(i <- s2polyline(inner)) # expect_error(p <- s2polygon(i)) # expect_silent(i <- s2polyline(inner[1:3,])) # expect_silent(p <- s2polygon(i)) }) ================================================ FILE: tests/testthat/test-sample.R ================================================ test_that("st_sample works", { skip_if_not_installed("lwgeom") nc = read_sf(system.file("shape/nc.shp", package="sf")) n = 100 sample_default = st_sample(x = nc, size = n) expect_s3_class(sample_default, "sfc") sample_exact = st_sample(x = nc, size = n, exact = TRUE) expect_length(sample_exact, n) }) ================================================ FILE: tests/testthat/test-sf.R ================================================ test_that("we can subset sf objects", { pt1 = st_point(1:2) pt2 = st_point(3:4) s1 = st_sf(a = c("x", "y"), geom = st_sfc(pt1, pt2)) expect_equal(as.character(s1[[1]]), c("x", "y")) expect_equal(s1[,1], s1) #data.frame(x = c("x", "y"))) expect_equal(nrow(s1[1,]), 1) expect_equal(c(st_bbox(s1[1,])), c(xmin=1,ymin=2,xmax=1,ymax=2)) a = c("x", "y") g = st_sfc(pt1, pt2) expect_silent(xxx <- st_sf(a, g, g)) expect_silent(st_sf(a, geom1 = g, geom2 = g, sf_column_name = "geom2")) x = st_sf(a, geom1 = g, geom2 = g, sf_column_name = "geom2") expect_silent(st_geometry(x) <- "geom2") expect_silent(st_geometry(x) <- "geom1") }) test_that("we can create points sf from data.frame", { skip_if_not_installed("sp") data(meuse, package = "sp") # load data.frame from sp meuse_sf = st_as_sf(meuse, coords = c("x", "y"), crs = 28992) meuse_sf[1:5,] summary(meuse_sf[1:5,]) expect_s3_class(meuse_sf, c("sf", "data.frame"), exact = TRUE) }) test_that("st_zm works", { pt = st_point(1:2) ptz = st_point(1:3, "XYZ") ptm = st_point(1:3, "XYM") ptzm = st_point(1:4, "XYZM") pl = st_multilinestring(list(matrix(1:10,,2), matrix(1:10,,2))) plz = st_multilinestring(list(matrix(1:15,,3), matrix(1:15,,3)), "XYZ") plm = st_multilinestring(list(matrix(1:15,,3), matrix(1:15,,3)), "XYM") plzm = st_multilinestring(list(matrix(1:20,,4), matrix(1:20,,4)), "XYZM") expect_identical(pt, st_zm(ptz)) expect_identical(pt, st_zm(ptm)) expect_identical(pt, st_zm(ptzm)) expect_identical(pl, st_zm(plz)) expect_identical(pl, st_zm(plm)) expect_identical(pl, st_zm(plzm)) expect_identical(st_sfc(pt,pl), st_zm(st_sfc(ptz,plz))) expect_identical(st_sfc(pt,pl), st_zm(st_sfc(ptm,plm))) expect_identical(st_sfc(pt,pl), st_zm(st_sfc(ptzm,plzm))) expect_identical(st_sf(a = 1:2, geom = st_sfc(pt,pl)), st_zm(st_sf(a = 1:2, geom = st_sfc(ptzm,plzm)))) expect_identical(st_zm(pt, drop = FALSE, what = "Z"), st_point(c(1:2,0))) expect_silent(st_zm(pl, drop = FALSE, what = "Z")) }) test_that("rbind/cbind work", { # cbind/rbind: x = st_sf(a = 1:2, geom = st_sfc(list(st_point(0:1), st_point(0:1)), crs = 4326)) # don't warn when replacing crs with identical value: if (version$major == "3") { if (version$minor >= "3.0") { expect_silent(xxx <- cbind(x, x, x)) rbind(x, x, x) } } }) test_that("st_as_sf bulk points work", { skip_if_not_installed("sp") data(meuse, package = "sp") # load data.frame from sp x <- meuse meuse_sf = st_as_sf(x, coords = c("x", "y"), crs = 28992) xyz_sf = st_as_sf(x, coords = c("y", "x", "dist")) xym_sf = st_as_sf(x, coords = c("y", "x", "dist"), dim = "XYM") xyzm_sf = st_as_sf(x, coords = c("x", "y", "dist", "zinc"), dim = "XYZM") expect_s3_class(meuse_sf, c("sf", "data.frame"), exact = TRUE) expect_s3_class(xyz_sf, c("sf", "data.frame"), exact = TRUE) expect_s3_class(xym_sf, c("sf", "data.frame"), exact = TRUE) expect_s3_class(xyzm_sf, c("sf", "data.frame"), exact = TRUE) expect_length(st_geometry(meuse_sf)[[1]], 2L) expect_length(st_geometry(xyz_sf)[[1]], 3L) expect_length(st_geometry(xym_sf)[[1]], 3L) expect_length(st_geometry(xyzm_sf)[[1]], 4L) }) test_that("transform work", { skip_if_not_installed("sp") data(meuse, package = "sp") x = st_as_sf(meuse, coords = c("x", "y"), crs = 28992) x2 = transform(x, elev2 = elev^2, lead_zinc = lead/zinc) expect_s3_class(x, "sf") expect_identical(class(x2), class(x)) expect_identical(st_bbox(x), st_bbox(x)) expect_identical(st_crs(x), st_crs(x)) expect_identical(x$elev^2, x2$elev2) }) test_that("empty agr attribute is named after subset", { sf = st_sf(data.frame(x = st_sfc(st_point(1:2)))) out = sf[, "geometry"] agr = attr(out, "agr") expect_named(agr, character()) }) test_that("duplicated work",{ sf = st_sf(data.frame(x = st_sfc(st_point(1:2))[rep(1,4)], a=gl(2,2), b=as.numeric(gl(2,2)))) expect_identical(duplicated(sf), c(FALSE,TRUE,FALSE,TRUE)) expect_s3_class(unique(sf), "sf") }) ================================================ FILE: tests/testthat/test-sfc.R ================================================ test_that("we can print sfc objects", { pt1 = st_point(1:2) pt2 = st_point(3:4) s1 = st_sf(a = c("x", "y"), geom = st_sfc(pt1, pt2)) expect_output(print(s1), "Simple feature collection") expect_output(print(st_sfc()), "Geometry set for 0 features") expect_length(st_sfc(), 0) }) test_that("st_is_longlat works", { pt1 = st_point(1:2) pt2 = st_point(3:4) s1 = st_sf(a = c("x", "y"), geom = st_sfc(pt1, pt2)) expect_equal(st_is_longlat(s1), NA) s2 = s1 st_crs(s2) = 3857 expect_false(st_is_longlat(s2)) st_crs(s1) = 4326 expect_true(st_is_longlat(s1)) }) test_that("st_crs returns NA for sfg objects", { pt1 = st_point(1:2) expect_true(is.na(st_crs(pt1))) }) test_that("st_as_binary handles non-native big endian", { gc = st_geometrycollection() r = st_as_binary(gc) r[1] = if (r[1] == 1) { as.raw(0) } else { as.raw(1) } r[2:5] = rev(r[2:5]) # swap bytes expect_identical(gc, st_as_sfc(structure(list(r), class = "WKB"), pureR = TRUE)[[1]]) expect_identical(gc, st_as_sfc(structure(list(r), class = "WKB"), pureR = TRUE, EWKB = TRUE)[[1]]) }) test_that("st_crs<- gives warnings on changing crs", { x = st_sfc(list(st_point(0:1), st_point(0:1))) y = x expect_silent(st_crs(y) <- 4326) expect_silent(st_crs(y) <- 4326) expect_warning(st_crs(y) <- 3857) x = st_sfc(list(st_point(0:1), st_point(0:1)), crs = 4326) #expect_silent(st_sfc(x, crs = "+proj=longlat +datum=WGS84 +no_defs")) #expect_silent(st_sfc(x, crs = "+proj=longlat +datum=WGS84")) #-->> breaks build on CRAN flavor fedora-gcc # but do when it changes: expect_warning(st_sfc(x, crs = "+proj=merc +a=6378137 +b=6378137 +lat_ts=0.0 +lon_0=0.0 +x_0=0.0 +y_0=0 +k=1.0 +units=m +nadgrids=@null +wktext +no_defs")) }) test_that("st_precision()", { x <- st_sfc(st_point(c(pi, pi)), precision = 1e-4, crs = 3857) # units m expect_equal(st_precision(x), 1e-4) expect_error(st_set_precision(x, NULL)) expect_error(st_set_precision(x, NA), "numeric") expect_error(st_set_precision(x, list()), "length") expect_error(st_set_precision(x, list(x = 1)), "numeric") expect_error(st_set_precision(x, 1:4), "length") expect_error(st_set_precision(x, NA_real_), "numeric") st_precision(x) <- 1e-2 expect_identical(st_set_precision(x, 1e-2), x) expect_identical(x, st_set_precision(x, units::set_units(100, m))) expect_error(st_set_precision(x, units::set_units(100, kg))) x <- st_transform(x, 4326) expect_silent(st_set_precision(x, units::set_units(0.001, rad))) expect_silent(st_set_precision(x, units::set_units(0.1, degree))) expect_error(st_set_precision(x, units::set_units(0.001, degree_C))) }) test_that("st_precision() works for sf", { x <- st_as_sf(data.frame("a" = 1), st_sfc(st_point(c(pi, pi)), precision = 1e-4)) expect_equal(st_precision(x), 1e-4) expect_error(st_set_precision(x, NULL)) expect_error(st_set_precision(x, NA), "numeric") expect_error(st_set_precision(x, list()), "length") expect_error(st_set_precision(x, list(x = 1)), "numeric") expect_error(st_set_precision(x, 1:4), "length") expect_error(st_set_precision(x, NA_real_), "numeric") st_precision(x) <- 1e-2 expect_identical(st_set_precision(x, 1e-2), x) }) test_that("st_as_sfc breaks on wrong input", { expect_error(st_as_sfc("foo")) }) test_that("st_coordinates works", { x <- st_sfc(st_point(c(pi, pi)), precision = 1e-4) expect_true(is.matrix(st_coordinates(st_sf(a = 1, geom = x)))) expect_true(is.matrix(st_coordinates(x))) expect_true(is.matrix(st_coordinates(x[[1]]))) nc <- st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) expect_true(is.matrix(st_coordinates(nc))) # expect_true(is.matrix(st_coordinates(st_geometrycollection(list(st_point))))) }) test_that("as.data.frame.sfc works", { sfc = st_sfc(st_point(0:1), st_point(3:4)) expect_silent(as.data.frame(sfc)) }) test_that("rep.sfc works", { expect_equal( st_sfc(st_point(0:1), st_point(0:1), crs = 4326), rep(st_sfc(st_point(0:1), crs=4326), 2)) }) test_that("c.sfc n_empty returns sum of st_is_empty(sfg)", { pt1 <- st_point(c(NA_real_, NA_real_)) pt2 <- st_point(0:1) expect_equal(attr(c(st_sfc(pt1), st_sfc(pt1)), "n_empty"), 2L) expect_equal(attr(c(st_sfc(pt1), st_sfc(pt2)), "n_empty"), 1L) }) test_that("st_is_longlat warns on invalid bounding box", { expect_warning(st_is_longlat(st_sfc(st_point(c(0,-95)), crs = 4326))) }) test_that("bounding box is flipped when geometry is flipped", { foo <- st_bbox(c(xmin = 0, xmax = 100, ymin = 0, ymax = 200)) |> st_as_sfc() bar <- foo * matrix(c(1,0,0,-1), nrow = 2) expect_equal(st_bbox(bar), st_bbox(c(xmin=0, ymin=-200, xmax=100, ymax=0))) }) ================================================ FILE: tests/testthat/test-sfg.R ================================================ test_that("MtrxSet is being called", { outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) pts = list(outer, hole1, hole2) pl1 = st_polygon(pts) expect_identical(st_as_text(pl1), "POLYGON ((0 0, 10 0, 10 10, 0 10, 0 0), (1 1, 1 2, 2 2, 2 1, 1 1), (5 5, 5 6, 6 6, 6 5, 5 5))") expect_identical(st_as_text(st_sfc(pl1, crs = 4326), EWKT=TRUE), "SRID=4326;POLYGON ((0 0, 10 0, 10 10, 0 10, 0 0), (1 1, 1 2, 2 2, 2 1, 1 1), (5 5, 5 6, 6 6, 6 5, 5 5))") }) test_that("Dimension works", { expect_identical(sf:::Dimension(st_point(1:2)), "XY") expect_identical(sf:::Dimension(st_point(1:3)), "XYZ") expect_identical(sf:::Dimension(st_point(1:3, "XYZ")), "XYZ") expect_identical(sf:::Dimension(st_point(1:3, "XYM")), "XYM") expect_identical(sf:::Dimension(st_point(1:4)), "XYZM") }) test_that("st_multilinestring works", { outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) pts = list(outer, hole1, hole2) ml1 = st_multilinestring(pts) expect_identical(st_as_text(ml1), "MULTILINESTRING ((0 0, 10 0, 10 10, 0 10, 0 0), (1 1, 1 2, 2 2, 2 1, 1 1), (5 5, 5 6, 6 6, 6 5, 5 5))") }) test_that("xx2multixx works", { expect_identical(sf:::POINT2MULTIPOINT(st_point(1:2)), st_multipoint(matrix(1:2,1))) m = matrix(1:6,,2) expect_identical(sf:::LINESTRING2MULTILINESTRING(st_linestring(m)), st_multilinestring(list(m))) outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) pts = list(outer, hole1, hole2) expect_identical(sf:::POLYGON2MULTIPOLYGON(st_polygon(pts)), st_multipolygon(list(pts))) }) test_that("print.sfg returns sfg", { x = st_point(1:2) expect_identical(print(x), x) }) test_that("format works", { digits = options("digits")[[1]] options(digits = 16) expect_identical(format(st_multipoint(matrix(1:6/6,3))), "MULTIPOINT ((0.166666666666...") expect_identical(format(st_sfc(st_multipoint(matrix(1:6/6,3)))), "MULTIPOINT ((0.166666666666...") options(digits = digits) expect_identical(obj_sum.sfc(st_sfc(st_multipoint(matrix(1:6/6,3)))), "MULTIPOINT (...") expect_identical(type_sum.sfc(st_sfc(st_multipoint(matrix(1:6/6,3)))), "MULTIPOINT") }) test_that("Ops work for sfc", { expect_identical(st_point(c(1,2,3)) + 4, st_point(c(5,6,7))) expect_identical(st_point(c(1,2,3)) * 3 + 4, st_point(c(7, 10, 13))) m = matrix(0, 2, 2) diag(m) = c(1, 3) expect_identical(st_point(c(1,2)) * m + c(2,5), st_point(c(3,11))) m = matrix(1:6,,2) expect_identical(sf:::LINESTRING2MULTILINESTRING(st_linestring(m)), st_multilinestring(list(m))) outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) pts = list(outer, hole1, hole2) expect_s3_class(st_multipolygon(list(pts)) * 2 + 3, "MULTIPOLYGON") gc = st_geometrycollection(list(st_multipolygon(list(pts)), st_point(c(2,2)))) m = matrix(0, 2, 2) diag(m) = c(1, 3) expect_s3_class(gc * m - 3, "GEOMETRYCOLLECTION") }) test_that("Ops work for sfg", { x = st_sfc(st_point(0:1), st_point(1:2)) y = st_sfc(st_point(2:3), st_point(3:4)) expect_equal(x + 2, y) }) test_that("st_dimension returns NA", { expect_equal(st_dimension(st_point()), NA_integer_) }) ================================================ FILE: tests/testthat/test-shift_longitude.R ================================================ test_that("st_shift_longitude", { pt1 = st_point(c(-170, 50)) pt2 = st_point(c(170, 50)) (sfc = st_sfc(pt1, pt2)) sfc = st_set_crs(sfc, 4326) crd1 = st_coordinates(st_shift_longitude(sfc))[1, "X"] crd2 = st_coordinates(st_shift_longitude(sfc))[2, "X"] # sfc ## pt1 should be shifted but pt2 should not expect_equal(crd1, st_coordinates(sfc)[1, "X"] + 360) expect_equal(crd2, st_coordinates(sfc)[2, "X"]) # sf d = st_as_sf(data.frame(id = 1:2, geometry = sfc)) ## same as above expect_equal(crd1, st_coordinates(st_shift_longitude(d))[1, "X"]) expect_equal(crd2, st_coordinates(d)[2, "X"]) # non-projected crs ## NA d = st_set_crs(d, NA) expect_error(st_shift_longitude(d)) ## arbitrary crs sfc = st_transform(sfc, 3035) expect_error(st_shift_longitude(sfc)) }) ================================================ FILE: tests/testthat/test-sp.R ================================================ test_that("we can convert points & lines to and from sp objects", { skip_if_not_installed("sp") pt1 = st_point(1:2) pt2 = st_point(3:4) s1 = st_sf(a = c("x", "y"), geom = st_sfc(pt1, pt2)) sp = as(s1, "Spatial") s2 = st_as_sf(sp) # expect_identical(s1, s2) -> name differences expect_s3_class(st_geometry(s2), c("sfc_POINT", "sfc"), exact = TRUE) #-> name differences l = st_linestring(matrix(1:6,3)) l1 = st_sf(a = 1, geom = st_sfc(l)) sp_l = as(l1, "Spatial") expect_s4_class(sp_l, "SpatialLinesDataFrame") #-> name differences l2 = st_as_sf(sp_l) expect_s3_class(st_geometry(l2), c("sfc_LINESTRING", "sfc"), exact = TRUE) #-> name differences # test multilinestring -> sp l = st_multilinestring(list(matrix(1:6,3), matrix(11:16,3), matrix(21:26,3))) l1 = st_sf(a = 1, geom = st_sfc(l)) sp_l = as(l1, "Spatial") expect_s4_class(sp_l, "SpatialLinesDataFrame") #-> name differences l2 = st_as_sf(sp_l) expect_s3_class(st_geometry(l2), c("sfc_MULTILINESTRING", "sfc"), exact = TRUE) #-> name differences }) test_that("we can convert SpatialPolygons objects without SF comments to sfc and back", { skip_if_not_installed("sp") # skip_if_not(package_version(sf_extSoftVersion()[["GEOS"]]) >= "3.11.0"); #2079 library(sp) # nested holes https://github.com/r-spatial/evolution/issues/9 p1 <- Polygon(cbind(x=c(0, 0, 10, 10, 0), y=c(0, 10, 10, 0, 0)), hole=FALSE) # I p2 <- Polygon(cbind(x=c(3, 3, 7, 7, 3), y=c(3, 7, 7, 3, 3)), hole=TRUE) # H p8 <- Polygon(cbind(x=c(1, 1, 2, 2, 1), y=c(1, 2, 2, 1, 1)), hole=TRUE) # H p9 <- Polygon(cbind(x=c(1, 1, 2, 2, 1), y=c(5, 6, 6, 5, 5)), hole=TRUE) # H p3 <- Polygon(cbind(x=c(20, 20, 30, 30, 20), y=c(20, 30, 30, 20, 20)), hole=FALSE) # I p4 <- Polygon(cbind(x=c(21, 21, 29, 29, 21), y=c(21, 29, 29, 21, 21)), hole=TRUE) # H p5 <- Polygon(cbind(x=c(22, 22, 28, 28, 22), y=c(22, 28, 28, 22, 22)), hole=FALSE) # I p6 <- Polygon(cbind(x=c(23, 23, 27, 27, 23), y=c(23, 27, 27, 23, 23)), hole=TRUE) # H p7 <- Polygon(cbind(x=c(13, 13, 17, 17, 13), y=c(13, 17, 17, 13, 13)), hole=FALSE) # I p10 <- Polygon(cbind(x=c(24, 24, 26, 26, 24), y=c(24, 26, 26, 24, 24)), hole=FALSE) # I p11 <- Polygon(cbind(x=c(24.25, 24.25, 25.75, 25.75, 24.25), y=c(24.25, 25.75, 25.75, 24.25, 24.25)), hole=TRUE) # H p12 <- Polygon(cbind(x=c(24.5, 24.5, 25.5, 25.5, 24.5), y=c(24.5, 25.5, 25.5, 24.5, 24.5)), hole=FALSE) # I p13 <- Polygon(cbind(x=c(24.75, 24.75, 25.25, 25.25, 24.75), y=c(24.75, 25.25, 25.25, 24.75, 24.75)), hole=TRUE) # H p9a <- Polygon(cbind(x=c(1, 1, 2, 2, 1), y=c(6, 7, 7, 6, 6)), hole=TRUE) # H p7a <- Polygon(cbind(x=c(14, 14, 15, 15, 14), y=c(13, 14, 14, 13, 13)), hole=TRUE) # H lp <- list(p1, p2, p13, p7, p7a, p6, p5, p4, p3, p8, p11, p12, p9, p9a, p10) spls <- SpatialPolygons(list(Polygons(lp, ID="1"))) expect_equal(comment(spls), "FALSE") expect_null(comment(slot(spls, "polygons")[[1]])) spls_sfc <- sf::st_as_sfc(spls) # rsbivand fork coerce_comments 2022-12-21 spls_rt <- as(spls_sfc, "Spatial") expect_equal(comment(spls_rt), "TRUE") expect_equal(comment(slot(spls_rt, "polygons")[[1]]), "0 1 1 1 0 0 6 0 8 0 10 0 12") }) test_that("as() can convert GEOMETRY to Spatial (#131)", { skip_if_not_installed("sp") single <- list(rbind(c(0,0), c(1,0), c(1, 1), c(0,1), c(0,0))) |> st_polygon() multi <- list(single + 2, single + 4) |> st_multipolygon() # polygons w <- st_sfc(single, multi) # class is GEOMETRY expect_s4_class(as(w, "Spatial"), "SpatialPolygons") expect_s4_class(as(st_cast(w, "MULTIPOLYGON"), "Spatial"), "SpatialPolygons") # lines lns <- st_cast(w, "MULTILINESTRING") expect_s4_class(as(lns, "Spatial"), "SpatialLines") expect_warning(ln <- st_cast(w, "LINESTRING"), "first ring") expect_s4_class(as(ln, "Spatial"), "SpatialLines") # points expect_warning(pt <- st_cast(w, "POINT"), "first coordinate") expect_s4_class(as(pt, "Spatial"), "SpatialPoints") pts <- st_cast(w, "MULTIPOINT") expect_s4_class(as(pts, "Spatial"), "SpatialMultiPoints") expect_warning(pt <- st_cast(w, "POINT"), "first coordinate") expect_s4_class(as(pt, "Spatial"), "SpatialPoints") }) test_that("as_Spatial can convert sf (#519)", { skip_if_not_installed("sp") h <- st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE) u <- as(h, "Spatial") s <- as_Spatial(h) g <- as_Spatial(st_geometry(h)) identical(u, s) expect_s4_class(s, "SpatialPolygonsDataFrame") expect_s4_class(g, "SpatialPolygons") expect_s4_class(as(st_geometry(h), "Spatial"), "SpatialPolygons") }) test_that("Can convert `XY` objects to sp", { skip_if_not_installed("sp") expect_s4_class(as(st_point(1:2), "Spatial"), "SpatialPoints") expect_error(as(st_point(1:3), "Spatial")) expect_error(as(st_point(1:4), "Spatial")) }) test_that("Can't convert `M` dimension to sp", { skip_if_not_installed("sp") skip_if_not(sf_extSoftVersion()[["GDAL"]] >= "2.1.0") x <- read_sf(system.file("shape/storms_xyzm_feature.shp", package = "sf"), quiet = TRUE) expect_error(as_Spatial(x), "not supported by sp") }) test_that("conversion to sp breaks on empty geometries", { skip_if_not_installed("sp") mysfc <- st_sfc(list( st_polygon(list(matrix(c(1,3,2,1,0,0,1,0), 4, 2))), st_polygon() # empty polygon )) expect_error(as_Spatial(mysfc), "conversion failed") }) ================================================ FILE: tests/testthat/test-st_cast.R ================================================ m <- rbind(c(0,0), c(1,0), c(1, 1), c(0,1), c(0,0)) s <- matrix(c(2, 0), 5, 2, byrow = TRUE) cc <- list( points = list( single = m[1, ] |> st_point(), multi = m |> st_multipoint(), multi_empty = st_multipoint() ), lines = list( single = m |> st_linestring(), multi = list(m, m + s) |> st_multilinestring() ), polygons = list( single = list(m + s) |> st_polygon(), multi = list(list(m), list(m + s)) |> st_multipolygon() ) ) test_that("st_cast() can coerce to MULTI* or GEOMETRY", { # st_cast # ====== # points pt <- st_sfc(cc$points$single, cc$points$single) expect_s3_class(st_cast(pt), "sfc_POINT") pts <- st_sfc(cc$points$single, cc$points$multi, cc$points$multi_empty) expect_s3_class(st_cast(pts), "sfc_MULTIPOINT") expect_warning(pt <- st_cast(pts, "POINT"), "first coordinate") expect_s3_class(pt, "sfc_POINT") expect_s3_class(st_cast(pts, "MULTIPOINT"), "sfc_MULTIPOINT") expect_error(st_cast(pts, "LINESTRING"), "cannot create LINESTRING from POINT") expect_error(st_cast(pts, "MULTILINESTRING"), "cannot create MULTILINESTRING from POINT") expect_error(st_cast(pts, "POLYGON"), "cannot create POLYGON from POINT") expect_error(st_cast(pts, "MULTIPOLYGON"), "cannot create MULTIPOLYGON from POINT") # multipoints mp <- st_sfc(st_multipoint(m[1:4,])) expect_s3_class(mp, "sfc_MULTIPOINT") expect_s3_class(st_cast(mp, "MULTIPOINT"), "sfc_MULTIPOINT") expect_s3_class(st_cast(mp, "POINT"), "sfc_POINT") expect_silent(st_cast(mp, "POINT")) expect_warning(st_cast(mp[[1]], "POINT"), "point from first coordinate only") expect_s3_class(st_cast(mp, "POLYGON"), "sfc_POLYGON") expect_s3_class(st_cast(mp[[1]], "POLYGON"), "POLYGON") expect_s3_class(st_cast(mp, "LINESTRING"), "sfc_LINESTRING") expect_s3_class(st_cast(mp[[1]], "LINESTRING"), "LINESTRING") expect_error(st_cast(mp, "MULTIPOLYGON"), "smaller steps") expect_s3_class(st_cast(mp[[1]], "MULTIPOLYGON"), "MULTIPOLYGON") expect_s3_class(st_cast(mp, "MULTILINESTRING"), "sfc_MULTILINESTRING") expect_s3_class(st_cast(mp[[1]], "MULTILINESTRING"), "MULTILINESTRING") expect_error(st_cast(mp, "GEOMETRYCOLLECTION"), "smaller steps") expect_s3_class(st_cast(mp[[1]], "GEOMETRYCOLLECTION"), "GEOMETRYCOLLECTION") # lines ln <- st_sfc(cc$lines$single, cc$lines$single) expect_s3_class(st_cast(ln), "sfc_LINESTRING") lns <- st_sfc(cc$lines$single, cc$lines$multi) expect_s3_class(st_cast(lns), "sfc_MULTILINESTRING") expect_warning(ln <- st_cast(lns, "POINT"), "first coordinate") expect_s3_class(ln, "sfc_POINT") expect_s3_class(st_cast(lns, "MULTIPOINT"), "sfc_MULTIPOINT") expect_warning(ln2 <- st_cast(lns, "LINESTRING"), "first linestring") expect_s3_class(ln2, "sfc_LINESTRING") expect_s3_class(st_cast(lns, "MULTILINESTRING"), "sfc_MULTILINESTRING") expect_s3_class(st_cast(lns, "POLYGON"), "sfc_POLYGON") expect_s3_class(st_cast(lns, "MULTIPOLYGON"), "sfc_MULTIPOLYGON") # polygons pl <- st_sfc(cc$polygons$single, cc$polygons$single) expect_s3_class(st_cast(pl), "sfc_POLYGON") pls <- st_sfc(cc$polygons$single, cc$polygons$multi) expect_s3_class(st_cast(pls), "sfc_MULTIPOLYGON") expect_warning(pl <- st_cast(pls, "POINT"), "first coordinate") expect_s3_class(pl, "sfc_POINT") expect_s3_class(st_cast(pls, "MULTIPOINT"), "sfc_MULTIPOINT") expect_warning(pl2 <- st_cast(pls, "LINESTRING"), "first ring") expect_s3_class(pl2, "sfc_LINESTRING") expect_s3_class(st_cast(pls, "MULTILINESTRING"), "sfc_MULTILINESTRING") expect_warning(pl3 <- st_cast(pls, "POLYGON"), "first part") expect_s3_class(pl3, "sfc_POLYGON") expect_s3_class(st_cast(pls, "MULTIPOLYGON"), "sfc_MULTIPOLYGON") # mixed expect_s3_class(st_cast(st_sfc(cc$points$single, cc$lines$multi)), "sfc_GEOMETRY") expect_s3_class(st_cast(st_sfc(cc$lines$multi, cc$polygons$multi)), "sfc_GEOMETRY") expect_s3_class(st_cast(st_sfc(cc$lines$multi, cc$polygons$multi)), "sfc_GEOMETRY") expect_s3_class(st_cast(st_sfc(cc$points$multi, cc$polygons$multi)), "sfc_GEOMETRY") expect_s3_class(st_cast(st_sfc(cc$points$multi, cc$lines$multi, cc$polygons$multi)), "sfc_GEOMETRY") expect_s3_class(st_cast(st_sfc(list(cc$points$multi, cc$lines$multi, cc$polygons$multi))), "sfc_GEOMETRY") }) test_that("st_cast preserves crs (#154)", { expect_identical(st_cast(st_sfc(cc$points$single, cc$lines$multi, crs = 4326)) |> st_crs(), st_sfc(cc$points$single, cc$lines$multi, crs = 4326) |> st_crs()) }) test_that("st_cast can crack GEOMETRYCOLLECTION", { gc1 <- st_geometrycollection(list(st_linestring(rbind(c(0,0),c(1,1),c(2,1))))) gc2 <- st_geometrycollection(list(st_multilinestring(list( rbind(c(2,2),c(1,3)), rbind(c(0,0),c(1,1),c(2,1)))))) gc3 <- st_geometrycollection(list(st_multilinestring(list( rbind(c(4,4),c(4,3)), rbind(c(2,2),c(2,1),c(3,1)))))) gc4 <- st_geometrycollection(list(st_multipoint(rbind(c(1,5), c(4,3))))) sfc <- st_sfc(gc1, gc2, gc3) expect_s3_class(st_cast(sfc), "sfc_GEOMETRY") # first, it cracks the collection expect_s3_class(st_cast(st_cast(sfc)), "sfc_MULTILINESTRING") # then cast to multi* # expect_warning(expect_s3_class(st_cast(sfc, "POINT"), "sfc_POINT"), "first coordinate") # expect_equal(st_cast(sfc, "POINT") |> length, sfc |> length) # @etienne: I think this is more useful; attr(x, "ids") contains the original lengths expect_s3_class(st_cast(sfc, "MULTIPOINT"), "sfc_MULTIPOINT") # expect_s3_class(st_cast(sfc, "LINESTRING"), "sfc_LINESTRING") expect_error(st_cast(sfc, "LINESTRING")) expect_error(st_cast(sfc, "MULTILINESTRING")) expect_s3_class(st_cast(sfc) |> st_cast("MULTILINESTRING"), "sfc_MULTILINESTRING") # Can deal with GCs containing empty geometries - #1767 gc5 <- st_as_sfc( c("GEOMETRYCOLLECTION (POLYGON ((5.5 0, 7 0, 7 -0.5, 6 -0.5, 5.5 0)))", "GEOMETRYCOLLECTION (POLYGON EMPTY)" ) ) expect_s3_class(st_cast(gc5), "sfc_POLYGON") expect_equal(st_is_empty(st_cast(gc5)), c(FALSE, TRUE)) sfc2 <- st_sfc(gc1, gc2, gc4) expect_s3_class(sfc2 |> st_cast(), "sfc_GEOMETRY") expect_equal(sapply(sfc2 |> st_cast(), class)[2, ], c("LINESTRING", "MULTILINESTRING", "MULTIPOINT")) }) test_that("can cast empty polygon (#1094)", { poly <- st_as_sfc(c('MULTIPOLYGON(((3 1,3 5,6 5,3 1)))', 'POLYGON EMPTY')) expect_s3_class(st_cast(poly), "sfc_MULTIPOLYGON") }) ================================================ FILE: tests/testthat/test-tidyverse-vctrs.R ================================================ test_that("`sfc` vectors are treated as vectors", { expect_true(vctrs::vec_is(st_sfc(st_point()))) expect_true(vctrs::vec_is(st_sfc(st_linestring()))) expect_true(vctrs::vec_is(st_sfc(st_point(), st_linestring()))) }) test_that("`sfc` vector proxy is correct", { x = st_sfc(st_point()) proxy = x attributes(proxy) = NULL expect_identical(vctrs::vec_proxy(x), proxy) x = st_sfc(st_linestring()) proxy = x attributes(proxy) = NULL expect_identical(vctrs::vec_proxy(x), proxy) x = st_sfc(st_point(), st_linestring()) proxy = x attributes(proxy) = NULL expect_identical(vctrs::vec_proxy(x), proxy) }) test_that("`sfc` restore proxy is correct", { x = st_sfc(st_point()) proxy = vctrs::vec_proxy(x) expect_identical(vctrs::vec_restore(proxy, x), x) x = st_sfc(st_linestring()) proxy = vctrs::vec_proxy(x) expect_identical(vctrs::vec_restore(proxy, x), x) x = st_sfc(st_point(), st_linestring()) proxy = vctrs::vec_proxy(x) expect_identical(vctrs::vec_restore(proxy, x), x) }) test_that("`sfc` vector ptype is correct", { x = st_sfc(st_point()) expect_identical(vctrs::vec_ptype(x), x[0]) expect_s3_class(vctrs::vec_ptype(x), "sfc_POINT") x = st_sfc(st_linestring()) expect_identical(vctrs::vec_ptype(x), x[0]) expect_s3_class(vctrs::vec_ptype(x), "sfc_LINESTRING") x = st_sfc(st_point(), st_linestring()) expect_identical(vctrs::vec_ptype(x), x[0]) expect_s3_class(vctrs::vec_ptype(x), "sfc_GEOMETRY") }) test_that("`sfc` vector ptype2 is correct", { x = st_sfc(st_point()) y = st_sfc(st_point(), crs = 3857) z = st_sfc(st_point(), precision = 1e-4) expect_identical(vctrs::vec_ptype2(x, x), x[0]) expect_error(vctrs::vec_ptype2(x, y)) expect_error(vctrs::vec_ptype2(x, z)) xl = vctrs::vec_ptype2(x, st_sfc(st_linestring())) expect_true(inherits(xl, "sfc_GEOMETRY")) expect_true(inherits(xl, "sfc")) x = st_sfc(st_linestring()) y = st_sfc(st_linestring(), crs = 3857) z = st_sfc(st_linestring(), precision = 1e-4) expect_identical(vctrs::vec_ptype2(x, x), x[0]) expect_error(vctrs::vec_ptype2(x, y)) expect_error(vctrs::vec_ptype2(x, z)) lp = vctrs::vec_ptype2(x, st_sfc(st_point())) expect_true(inherits(lp, "sfc_GEOMETRY")) expect_true(inherits(lp, "sfc")) x = st_sfc(st_point(), st_linestring()) y = st_sfc(st_point(), st_linestring(), crs = 3857) z = st_sfc(st_point(), st_linestring(), precision = 1e-4) expect_identical(vctrs::vec_ptype2(x, x), x[0]) expect_error(vctrs::vec_ptype2(x, y)) expect_error(vctrs::vec_ptype2(x, z)) xp = vctrs::vec_ptype2(x, st_sfc(st_point())) expect_true(inherits(xp, "sfc_GEOMETRY")) expect_true(inherits(xp, "sfc")) }) test_that("`sfc` vector cast is correct", { x = st_sfc(st_point()) expect_identical(vctrs::vec_cast(x, x), x) y = vctrs::vec_cast(x, st_sfc(st_linestring())) expect_true(inherits(y, "sfc_GEOMETRY")) expect_true(inherits(y, "sfc")) x = st_sfc(st_linestring()) expect_identical(vctrs::vec_cast(x, x), x) y = vctrs::vec_cast(x, st_sfc(st_point())) expect_true(inherits(y, "sfc_GEOMETRY")) expect_true(inherits(y, "sfc")) x = st_sfc(st_point(), st_linestring()) expect_identical(vctrs::vec_cast(x, x), x) y = vctrs::vec_cast(x, st_sfc(st_point())) expect_true(inherits(y, "sfc_GEOMETRY")) expect_true(inherits(y, "sfc")) }) test_that("`sfc` vectors can be sliced", { x = st_sfc(st_point(1:2), st_point(3:4)) expect_identical(vctrs::vec_slice(x, 1), x[1]) expect_identical(vctrs::vec_slice(x, 0), x[0]) x = st_sfc( st_linestring(matrix(1:2, ncol = 2)), st_linestring(matrix(3:4, ncol = 2)) ) expect_identical(vctrs::vec_slice(x, 1), x[1]) expect_identical(vctrs::vec_slice(x, 0), x[0]) x = st_sfc( st_point(1:2), st_linestring(matrix(3:4, ncol = 2)) ) expect_identical(vctrs::vec_slice(x, 1), x[1]) expect_identical(vctrs::vec_slice(x, 0), x[0]) }) test_that("`sfc` vectors can be initialized with correct missing value", { x = st_sfc(st_point()) expect_identical( vctrs::vec_init(x, 2), st_sfc(st_point(), st_point()) ) x = st_sfc(st_linestring()) expect_identical( vctrs::vec_init(x, 2), st_sfc(st_linestring(), st_linestring()) ) x = st_sfc(st_point(), st_linestring()) expect_identical( vctrs::vec_init(x, 2), # This doesn't give a `sfc_GEOMETRY`, it gives an `sfc_GEOMETRYCOLLECTION` # st_sfc(st_geometrycollection(), st_geometrycollection()) x[0][c(NA_integer_, NA_integer_)] ) }) test_that("`sfc` vectors can combine with unspecified in `vec_c()`", { na = st_point() x = st_point(1:2) out = vctrs::vec_c(c(NA, NA), st_sfc(x), NA) expect_identical(out, st_sfc(na, na, x, na)) na = st_linestring() x = st_linestring(matrix(1:2, nrow = 1)) out = vctrs::vec_c(c(NA, NA), st_sfc(x), NA) expect_identical(out, st_sfc(na, na, x, na)) na = st_geometrycollection() point = st_point(1:2) line = st_linestring(matrix(3:4, nrow = 1)) out = vctrs::vec_c(c(NA, NA), st_sfc(point, line), NA) expect_identical(out, st_sfc(na, na, point, line, na)) }) test_that("`sfc` vectors can combine with unspecified in `vec_rbind()`", { na = st_point() one = st_point(1:2) x = st_sfc(one) y = st_sfc(one, one) out = vctrs::vec_rbind( vctrs::data_frame(x = x), vctrs::data_frame(y = y) ) expect_identical( out, vctrs::data_frame( x = st_sfc(one, na, na), y = st_sfc(na, one, one) ) ) na = st_linestring() one = st_linestring(matrix(1:2, nrow = 1)) x = st_sfc(one) y = st_sfc(one, one) out = vctrs::vec_rbind( vctrs::data_frame(x = x), vctrs::data_frame(y = y) ) expect_identical( out, vctrs::data_frame( x = st_sfc(one, na, na), y = st_sfc(na, one, one) ) ) na = st_geometrycollection() point = st_point(1:2) line = st_linestring(matrix(3:4, nrow = 1)) x = st_sfc(point, line) y = st_sfc(line, point) out = vctrs::vec_rbind( vctrs::data_frame(x = x), vctrs::data_frame(y = y) ) expect_identical( out, vctrs::data_frame( x = st_sfc(point, line, na, na), y = st_sfc(na, na, line, point) ) ) }) test_that("`sfc` vector `n_empty` attribute is recomputed when slicing", { x = st_sfc(st_point(), st_point(0:1)) expect_identical(attr(vctrs::vec_slice(x, 1), "n_empty"), 1L) expect_identical(attr(vctrs::vec_slice(x, 2), "n_empty"), 0L) x = st_sfc(st_linestring(), st_linestring(matrix(1:2, nrow = 1))) expect_identical(attr(vctrs::vec_slice(x, 1), "n_empty"), 1L) expect_identical(attr(vctrs::vec_slice(x, 2), "n_empty"), 0L) x = st_sfc(st_point(), st_linestring(matrix(1:2, nrow = 1))) expect_identical(attr(vctrs::vec_slice(x, 1), "n_empty"), 1L) expect_identical(attr(vctrs::vec_slice(x, 2), "n_empty"), 0L) }) test_that("`sfc` vector `n_empty` attribute is recomputed when combining", { x = st_sfc(st_point()) y = st_sfc(st_point(0:1)) combined = vctrs::vec_c(x, y, x) expect_length(combined, 3) expect_identical(attr(combined, "n_empty"), 2L) x = st_sfc(st_linestring()) y = st_sfc(st_linestring(matrix(1:2, nrow = 1))) combined = vctrs::vec_c(x, y, x) expect_length(combined, 3) expect_identical(attr(combined, "n_empty"), 2L) x = st_sfc(st_point(), st_linestring()) y = st_sfc(st_point(), st_linestring(matrix(1:2, nrow = 1))) combined = vctrs::vec_c(x, y, x) expect_length(combined, 6) expect_identical(attr(combined, "n_empty"), 5L) }) test_that("`sfc` vectors `bbox` attribute is recomputed when slicing", { x = st_sfc(st_point(c(1, 2))) y = st_sfc(st_point(c(10, 20))) combined = c(x, y) expect_identical(st_bbox(vctrs::vec_slice(combined, 1)), st_bbox(x)) expect_identical(st_bbox(vctrs::vec_slice(combined, 2)), st_bbox(y)) x = st_sfc(st_linestring(matrix(1:2, nrow = 1))) y = st_sfc(st_linestring(matrix(10:11, nrow = 1))) combined = c(x, y) expect_identical(st_bbox(vctrs::vec_slice(combined, 1)), st_bbox(x)) expect_identical(st_bbox(vctrs::vec_slice(combined, 2)), st_bbox(y)) x = st_sfc(st_linestring(matrix(1:2, nrow = 1)), st_point(3:4)) y = st_sfc(st_linestring(matrix(10:11, nrow = 1)), st_point(12:15)) combined = c(x, y) expect_identical(st_bbox(vctrs::vec_slice(combined, 1:2)), st_bbox(x)) expect_identical(st_bbox(vctrs::vec_slice(combined, 3:4)), st_bbox(y)) }) test_that("`precision` and `crs` attributes of `sfc` vectors are restored when slicing", { x = st_sfc(st_point(), st_point(), precision = 1e-4, crs = 3857) out = vctrs::vec_slice(x, 1) expect_identical(st_precision(x), st_precision(out)) expect_identical(st_crs(x), st_crs(out)) x = st_sfc(st_linestring(), st_linestring(), precision = 1e-4, crs = 3857) out = vctrs::vec_slice(x, 1) expect_identical(st_precision(x), st_precision(out)) expect_identical(st_crs(x), st_crs(out)) x = st_sfc(st_point(), st_linestring(), precision = 1e-4, crs = 3857) out = vctrs::vec_slice(x, 1) expect_identical(st_precision(x), st_precision(out)) expect_identical(st_crs(x), st_crs(out)) }) test_that("`precision` and `crs` attributes of `sfc` vectors must be the same when combining", { x = st_sfc(st_point(c(pi, pi)), precision = 1e-4, crs = 3857) y = st_sfc(st_point(c(0, 0)), precision = 1e-2, crs = 3857) z = st_sfc(st_point(c(0, 0)), precision = 1e-4, crs = 4326) expect_identical(st_precision(x), st_precision(vctrs::vec_c(x, x))) expect_identical(st_crs(x), st_crs(vctrs::vec_c(x, x))) expect_error(vctrs::vec_c(x, y), "Precision mismatch: 1e-04 vs 0.01") expect_error(vctrs::vec_c(x, z), "CRS mismatch: EPSG:3857 vs EPSG:4326") expect_error(c(x, z), "arguments have different crs") x = st_sfc(st_linestring(matrix(1:2, nrow = 1)), precision = 1e-4, crs = 3857) y = st_sfc(st_linestring(matrix(1:2, nrow = 1)), precision = 1e-2, crs = 3857) z = st_sfc(st_linestring(matrix(1:2, nrow = 1)), precision = 1e-4, crs = 4326) expect_identical(st_precision(x), st_precision(vctrs::vec_c(x, x))) expect_identical(st_crs(x), st_crs(vctrs::vec_c(x, x))) expect_error(vctrs::vec_c(x, y), "Precision mismatch: 1e-04 vs 0.01") expect_error(vctrs::vec_c(x, z), "CRS mismatch: EPSG:3857 vs EPSG:4326") expect_error(c(x, z), "arguments have different crs") point = st_point() line = st_linestring(matrix(1:2, nrow = 1)) x = st_sfc(point, line, precision = 1e-4, crs = 3857) y = st_sfc(point, line, precision = 1e-2, crs = 3857) z = st_sfc(point, line, precision = 1e-4, crs = 4326) expect_identical(st_precision(x), st_precision(vctrs::vec_c(x, x))) expect_identical(st_crs(x), st_crs(vctrs::vec_c(x, x))) expect_error(vctrs::vec_c(x, y), "Precision mismatch: 1e-04 vs 0.01") expect_error(vctrs::vec_c(x, z), "CRS mismatch: EPSG:3857 vs EPSG:4326") expect_error(c(x, z), "arguments have different crs") }) # ------------------------------------------------------------------------------ # Miscellaneous test_that("`vec_locate_matches()` works with `sfc` vectors", { x = c( st_sfc(st_point(c(0, 0))), st_sfc(st_point(c(0, 1))), st_sfc(st_point(c(2, 1))) ) y = c( st_sfc(st_point(c(0, 0))), st_sfc(st_point(c(0, 3))), st_sfc(st_point(c(0, 0))), st_sfc(st_point(c(0, 1))) ) out = vctrs::vec_locate_matches(x, y) expect_identical(out$needles, c(1L, 1L, 2L, 3L)) expect_identical(out$haystack, c(1L, 3L, 4L, NA)) }) test_that("`vec_ptype2(, )` retains CRS and precision", { g = st_sfc(st_point(1:2)) x = st_sf(a = 3, g, crs = 8123, precision = .1) out = vctrs::vec_ptype2(x, x) expect_identical(st_crs(out), st_crs(x)) expect_identical(st_precision(out), st_precision(x)) }) test_that("`vec_proxy_order()` works", { x = st_sfc(st_point(1:2), st_point(2:3), st_point(1:2)) # expect_identical(vctrs::vec_proxy_order(x), c(1, 1, 1)) x = st_sfc(st_polygon(), st_linestring(rbind(c(0,0),c(10,10))), st_point(1:2)) # expect_identical(vctrs::vec_proxy_order(x), c(4.2,4.1,1.0)) }) ================================================ FILE: tests/testthat/test-tidyverse.R ================================================ suppressMessages(require(dplyr, quietly = TRUE)) nc <- st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) test_that("select works", { skip_if_not_installed("dplyr") expect_s3_class(nc |> select("AREA", attr(nc, "sf_column")), "sf") expect_s3_class(nc |> select(AREA), "sf") }) test_that("filter to sfc works", { skip_if_not_installed("dplyr") tbl = tibble(a = c("A", "B", "C"), geometry = st_sfc(st_point(c(1, 1)), st_point(), st_linestring())) d = st_sf(tbl) expect_identical(d |> filter(!st_is_empty(geometry)) |> st_cast(), d[1, ]) expect_identical(d |> filter(st_is(geometry, "POINT")) |> st_cast(), d[1:2, ]) }) suppressMessages(require(tidyr, quietly = TRUE)) test_that("separate and unite work", { skip_if_not_installed("dplyr") skip_if_not_installed("tidyr") expect_s3_class(nc |> separate(CNTY_ID, c("a", "b"), sep = 2), "sf") expect_s3_class(nc |> separate(CNTY_ID, c("a", "b"), sep = 2) |> unite(CNTY_ID_NEW, c("a", "b"), sep = ""), "sf") }) test_that("separate_rows work", { skip_if_not_installed("dplyr") skip_if_not_installed("tidyr") d <- st_as_sf(data.frame( x = seq_len(3), y = c("a", "d,e,f", "g,h"), geometry = st_sfc(st_point(c(1, 1)), st_point(c(2, 2)), st_point(c(3, 3))), stringsAsFactors = FALSE)) expect_s3_class(separate_rows(d, y, convert = TRUE), "sf") expect_identical(d |> separate_rows(y, convert = TRUE) |> st_geometry(), st_sfc(st_point(c(1, 1)), st_point(c(2, 2)), st_point(c(2, 2)), st_point(c(2, 2)), st_point(c(3, 3)), st_point(c(3, 3)))) }) test_that("group/ungroup works", { skip_if_not_installed("dplyr") tbl = tibble(a = c(1,1,2,2), g = st_sfc(st_point(0:1), st_point(1:2), st_point(2:3), st_point(3:4))) d = st_sf(tbl) e <- d |> group_by(a) |> ungroup() expect_equal(as.data.frame(d), as.data.frame(e)) }) test_that("sample_n etc work", { skip_if_not_installed("dplyr") tbl = tibble(a = c(1,1,2,2), g = st_sfc(st_point(0:1), st_point(1:2), st_point(2:3), st_point(3:4))) d = st_sf(tbl) expect_sampled <- function(x) { expect_s3_class(x, c("sf", "tbl_df")) expect_named(x, c("a", "g")) expect_equal(nrow(x), 2) expect_s3_class(x$g, "sfc_POINT") } expect_sampled(sample_n(d, 2)) expect_sampled(sample_frac(d, .5)) }) test_that("nest() works", { skip_if_not_installed("dplyr") skip_if_not_installed("tidyr") tbl = tibble(a = c(1,1,2,2), g = st_sfc(st_point(0:1), st_point(1:2), st_point(2:3), st_point(3:4))) d = st_sf(tbl) out = d |> group_by(a) |> nest() exp_data = list(d[1:2, "g"], d[3:4, "g"]) exp = tibble(a = c(1, 2), data = exp_data) |> group_by(a) expect_identical(out, exp) }) test_that("st_intersection of tbl returns tbl", { nc = read_sf(system.file("shape/nc.shp", package="sf")) nc = st_transform(nc[1:3,], 3857) st_agr(nc) = "constant" expect_s3_class(nc, "tbl_df") expect_s3_class(st_intersection(nc[1:3], nc[4:6]), "tbl_df") }) test_that("unnest works", { skip_if_not_installed("dplyr") skip_if_not_installed("tidyr") skip_if_not(utils::packageVersion("tidyr") > "0.7.2") nc = read_sf(system.file("shape/nc.shp", package = "sf")) |> slice(1:2) |> transmute(y = list(c("a"), c("b", "c"))) unnest_explicit = unnest(nc, y) # The second row is duplicated because the "b" and "c" become separate rows expected = nc[c(1,2,2), ] |> mutate(y = c("a", "b", "c")) # Would use expect_equal, but doesn't work with geometry cols expect_identical(unnest_explicit, expected) }) test_that("bind_rows() returns type of first input", { skip_if_not_installed("dplyr", "0.8.99") skip_if_not_installed("vctrs", "0.3.0.9000") sf1 = st_sf(x = 1, y = st_sfc(st_point(0:1))) sf2 = st_sf(z = st_sfc(st_point(2:3)), x = 2) # Avoid as.data.frame.sfc() method data_frame = function(...) { df = tibble(...) class(df) = "data.frame" df } # Output is a data frame if first input is a data frame out = bind_rows(data.frame(x = 1), sf2) exp = data_frame( x = c(1, 2), z = st_sfc(NA, st_point(2:3)) ) expect_identical(out, exp) out = bind_rows(sf1, data.frame(x = 1)) exp = st_as_sf(data_frame( x = c(1, 1), y = st_sfc(st_point(0:1), NA) )) expect_identical(out, exp) out = bind_rows(sf1, sf2) exp = st_as_sf(data_frame( x = c(1, 2), y = st_sfc(st_point(0:1), NA), z = st_sfc(NA, st_point(2:3)) )) expect_identical(out, exp) out = bind_rows(sf2, sf1) exp = st_as_sf(sf_column_name = "z", data_frame( x = c(2, 1), z = st_sfc(st_point(2:3), NA), y = st_sfc(NA, st_point(0:1)) )) expect_identical(out, exp) }) test_that("bind_cols() returns type of first input", { skip_if_not_installed("dplyr", "0.8.99") sf1 = st_sf(x = 1, y = st_sfc(st_point(0:1))) sf2 = st_sf(z = st_sfc(st_point(2:3)), w = 2) # Avoid as.data.frame.sfc() method data_frame = function(...) { df = tibble(...) class(df) = "data.frame" df } # Output is a data frame if first input is a data frame out = bind_cols(data.frame(x = 1), sf2) exp = data_frame( x = 1, w = 2, z = st_sfc(st_point(2:3)) ) expect_identical(out, exp) out = bind_cols(sf1, data.frame(w = 2)) exp = st_as_sf(data_frame( x = 1, w = 2, y = st_sfc(st_point(0:1)) )) expect_identical(out, exp) out = bind_cols(sf1, sf2) exp = st_as_sf(data_frame( x = 1, w = 2, y = st_sfc(st_point(0:1)), z = st_sfc(st_point(2:3)) )) expect_identical(out, exp) out = bind_cols(sf2, sf1) exp = st_as_sf(data_frame( w = 2, x = 1, z = st_sfc(st_point(2:3)), y = st_sfc(st_point(0:1)) )) expect_identical(out, exp) }) test_that("can rename geometry column with `select()`", { skip_if_not_installed("dplyr") sf = st_sf( x = 1, geo = st_sfc(st_point(1:2)), y = "foo" ) out = dplyr::select(sf, foo = geo) expect_identical(out, st_sf(foo = sf$geo)) # geometry column is sticky out = dplyr::select(sf, y) expect_identical(out, st_sf(geo = sf$geo, y = sf$y)) }) test_that("can rename geometry column with `rename()` (#1431)", { skip_if_not_installed("dplyr") geo_pt = st_sfc(st_point()) geo_ln = st_sfc(st_linestring()) sf = st_sf(x = 1, geo2 = geo_pt, geo1 = geo_ln, sf_column_name = "geo1") expect_identical( dplyr::rename(sf, y = x), st_sf(y = 1, geo2 = geo_pt, geo1 = geo_ln, sf_column_name = "geo1") ) expect_identical( dplyr::rename(sf, foo = geo1), st_sf(x = 1, geo2 = geo_pt, foo = geo_ln, sf_column_name = "foo") ) expect_identical( dplyr::rename(sf, foo = geo1, y = x), st_sf(y = 1, geo2 = geo_pt, foo = geo_ln, sf_column_name = "foo") ) expect_identical( dplyr::rename(sf, foo = geo1, y = x, bar = geo2), st_sf(y = 1, bar = geo_pt, foo = geo_ln, sf_column_name = "foo") ) }) test_that("`rename_with()` correctly changes the sf_column attribute (#2215)", { skip_if_not_installed("dplyr") sf_column = attr(nc, "sf_column") fn = function(x) paste0(x, "_renamed") expect_equal(nc |> rename_with(fn) |> attr("sf_column"), fn(sf_column)) expect_equal(nc |> rename_with(fn, "NAME") |> attr("sf_column"), sf_column) expect_equal(nc |> rename_with(fn, "geometry") |> attr("sf_column"), fn(sf_column)) }) test_that("`rename_with()` works for unquoted `.cols` (#2220)", { skip_if_not_installed("dplyr") sf_column = attr(nc, "sf_column") fn = function(x) paste0(x, "_renamed") expect_identical(nc |> rename_with(fn, c(FIPS, FIPSNO)), nc |> rename_with(fn, c("FIPS", "FIPSNO"))) }) test_that("`select()` and `transmute()` observe back-stickiness of geometry column (#1425)", { skip_if_not_installed("dplyr") sf = read_sf(system.file("shape/nc.shp", package = "sf")) exp = sf[, c("NAME", "FIPS")] expect_identical(dplyr::select(sf, NAME, FIPS), exp) expect_identical(dplyr::transmute(sf, NAME, FIPS), exp) }) test_that("rowwise_df class is retained on row slice", { skip_if_not_installed("dplyr") expect_s3_class(slice(rowwise(nc), 1), "rowwise_df") }) test_that("grouped_df class is retained on row slice", { skip_if_not_installed("dplyr") expect_s3_class(nc |> group_by(PERIMETER > 2) |> slice(1), "grouped_df") }) test_that("rowwise_df class is retained on filtered rows", { skip_if_not_installed("dplyr") expect_s3_class(nc |> rowwise() |> filter(AREA > .1), "rowwise_df") }) test_that("`group_split.sf()` ignores `.keep` for rowwise_df class", { skip_if_not_installed("dplyr") expect_no_warning(nc |> rowwise() |> group_split()) }) test_that("group_split.sf()` does not ignore `.keep` for grouped_df class", { skip_if_not_installed("dplyr") nc_kept <- nc |> group_by(CNTY_ID) |> group_split(.keep = TRUE) nc_notkept <- nc |> group_by(CNTY_ID) |> group_split(.keep = FALSE) expect_identical(names(nc_kept[[1]]), names(nc)) expect_identical(names(nc_notkept[[1]]), setdiff(names(nc), "CNTY_ID")) }) test_that("`pivot_wider()` works", { skip_if_not_installed("dplyr") skip_if_not_installed("tidyr") # Work for unquoted arguments (#2220) expect_identical(nc |> tidyr::pivot_wider(names_from = NAME, values_from = AREA), nc |> tidyr::pivot_wider(names_from = "NAME", values_from = "AREA")) # Pivot data from long sf to wide sf nc2 = nc |> mutate(name1 = "value_1", name2 = "value_2", name3 = "value_3") |> as_tibble() |> st_as_sf() nc2_longer = nc2 |> tidyr::pivot_longer(c(name1, name2, name3), names_to = "foo", values_to = "bar") nc2_wider = nc2_longer |> tidyr::pivot_wider(names_from = foo, values_from = bar) expect_identical(st_geometry(nc2), st_geometry(nc2_wider)) expect_identical(st_drop_geometry(nc2), st_drop_geometry(nc2_wider)) }) test_that("`count()` works", { skip_if_not_installed("dplyr") nc$area_cl <- cut(nc$AREA, c(0, .1, .12, .15, .25)) unsorted <- count(nc, area_cl, .drop_geometry = TRUE) sorted_and_named <- count(nc, area_cl, sort = TRUE, name = "number", .drop_geometry = TRUE) expect_equal(unsorted$n, c(35, 15, 22, 28)) expect_equal(sorted_and_named$number, c(35, 28, 22, 15)) expect_false("sf" %in% class(unsorted)) expect_true(inherits(count(nc["AREA"]), "sf")) # preserves geometries }) ================================================ FILE: tests/testthat/test-tm.R ================================================ test_that("st_read and write handle date and time", { Sys.setenv(TZ="") # local time x = st_sf(a = 1:2, b=c(5.6,3), dt = Sys.Date()+1:2, tm = Sys.time()+2:3, geometry = structure(st_sfc(st_point(c(1,1)), st_point(c(2,2))))) shp <- paste0(tempfile(), ".shp") gpkg <- paste0(tempfile(), ".gpkg") st_crs(x) = st_crs("ENGCRS[\"Undefined Cartesian SRS with unknown unit\",EDATUM[\"Unknown engineering datum\"],CS[Cartesian,2],AXIS[\"X\",unspecified,ORDER[1],LENGTHUNIT[\"unknown\",0]],AXIS[\"Y\",unspecified,ORDER[2],LENGTHUNIT[\"unknown\",0]]]") st_write(x[-4], shp[1], quiet = TRUE) x2 = st_read(shp[1], quiet = TRUE) expect_equal(x[-4], x2, check.attributes=FALSE) # WKT2 CRS do not roundtrip for ESRI Shapefile st_write(x, gpkg, quiet = TRUE) x2 = st_read(gpkg, quiet = TRUE) expect_equal(x[["a"]], x2[["a"]]) expect_equal(x[["b"]], x2[["b"]]) expect_equal(x[["dt"]], x2[["dt"]]) expect_equal(x[["tm"]], x2[["tm"]]) Sys.setenv(TZ="UTC") # GMT x = st_sf(a = 1:2, b=c(5.6,3), dt = Sys.Date()+1:2, tm = Sys.time()+2:3, geometry = structure(st_sfc(st_point(c(1,1)), st_point(c(2,2))))) shp <- paste0(tempfile(), ".shp") gpkg <- paste0(tempfile(), ".gpkg") st_crs(x) = st_crs("ENGCRS[\"Undefined Cartesian SRS with unknown unit\",EDATUM[\"Unknown engineering datum\"],CS[Cartesian,2],AXIS[\"X\",unspecified,ORDER[1],LENGTHUNIT[\"unknown\",0]],AXIS[\"Y\",unspecified,ORDER[2],LENGTHUNIT[\"unknown\",0]]]") st_write(x[-4], shp[1], quiet = TRUE) x2 = st_read(shp[1], quiet = TRUE) expect_equal(x[-4], x2, check.attributes=FALSE) # WKT2 CRS do not roundtrip for ESRI Shapefile st_write(x, gpkg, quiet = TRUE) x2 = st_read(gpkg, quiet = TRUE) expect_equal(x[["a"]], x2[["a"]]) expect_equal(x[["b"]], x2[["b"]]) expect_equal(x[["dt"]], x2[["dt"]]) expect_equal(x[["tm"]], x2[["tm"]]) }) ================================================ FILE: tests/testthat/test-valid.R ================================================ context("st_is_valid") # https://github.com/r-spatial/sf/issues/1760 test_that("st_is_valid", { p1 <- st_as_sfc("POLYGON((0 0, 0 10, 10 10, 10 0, 0 0))") p2 <- st_as_sfc("POLYGON((0 0, 0 10, 10 0))") set1 <- c(p1, p2, p1, p2, p1, p2) expect_identical(st_is_valid(set1), c(TRUE, NA, TRUE, NA, TRUE, NA)) expect_identical(st_is_valid(set1, reason = TRUE), c("Valid Geometry", NA, "Valid Geometry", NA, "Valid Geometry", NA)) }) ================================================ FILE: tests/testthat/test-wkb.R ================================================ test_that("well-known binary is read correctly", { wkb = structure(list("01010000204071000000000000801A064100000000AC5C1441"), class = "WKB") g = st_as_sfc(wkb, EWKB = TRUE)[[1]] attr(g, "epsg") <- NULL expect_true(identical(g, st_point(c(181072,333611)))) wkb = structure(list("0x01010000204071000000000000801A064100000000AC5C1441"), class = "WKB") g = st_as_sfc(wkb, EWKB = TRUE)[[1]] attr(g, "epsg") <- NULL expect_true(identical(g, st_point(c(181072,333611)))) wkb = structure(list("0x01010000204071000000000000801A064100000000AC5C1441")) g = st_as_sfc(wkb, EWKB = TRUE)[[1]] attr(g, "epsg") <- NULL expect_true(identical(g, st_point(c(181072,333611)))) }) test_that("Char -> Raw conversion in R and C++ gives identical results", { expect_identical( sf:::hex_to_raw( "0x01010000204071000000000000801A064100000000AC5C1441"), sf:::CPL_hex_to_raw(skip0x("0x01010000204071000000000000801A064100000000AC5C1441"))[[1]] ) expect_identical( sf:::hex_to_raw( "01010000204071000000000000801A064100000000AC5C1441"), sf:::CPL_hex_to_raw( "01010000204071000000000000801A064100000000AC5C1441")[[1]] ) expect_identical( # upper case, lower case: sf:::CPL_hex_to_raw("01010000204071000000000000801A064100000000AC5C1441"), sf:::CPL_hex_to_raw("01010000204071000000000000801a064100000000ac5c1441") ) expect_error(sf:::CPL_hex_to_raw("01010000204071000000000000801A064100000000AC5C144z")) # note the z }) test_that("Reading of big-endian and little-endian gives the same result", { x = structure(list("0x01010000204071000000000000801A064100000000AC5C1441"), class = "WKB") y = structure(list("0x00200000010000714041061A800000000041145CAC00000000"), class = "WKB") expect_identical(st_as_sfc(x, EWKB = TRUE), st_as_sfc(y, EWKB = TRUE)) expect_identical(st_as_sfc(x, EWKB = TRUE, pureR = TRUE), st_as_sfc(y, EWKB = TRUE, pureR = TRUE)) expect_identical(st_as_sfc(x, EWKB = TRUE), st_as_sfc(y, EWKB = TRUE, pureR = TRUE)) }) test_that("Reading of truncated buffers results in a proper error", { skip_on_os("mac") # doesn't give the message thrown wkb = structure(list("010100002040710000"), class = "WKB") expect_error(st_as_sfc(wkb, EWKB = TRUE), "WKB buffer too small. Input file corrupt?") wkb = structure(list("01"), class = "WKB") expect_error(st_as_sfc(wkb, EWKB = FALSE), "WKB buffer too small. Input file corrupt?") wkb = structure(list("0x01010000204071000000000000801A064100000000AC5C144"), class = "WKB") expect_error(st_as_sfc(wkb, EWKB = TRUE), "WKB buffer too small. Input file corrupt?") }) test_that("st_as_sfc() honors crs argument", { skip_if_not_installed("blob") raw = st_as_binary(st_point(c(26e5, 12e5))) list = list(raw) blob = blob::blob(raw) wkb = structure(list, class = "WKB") expect_identical(st_as_sfc(raw, crs = 2056), st_as_sfc(wkb, crs = 2056)) expect_identical(st_as_sfc(list, crs = 2056), st_as_sfc(wkb, crs = 2056)) expect_identical(st_as_sfc(blob, crs = 2056), st_as_sfc(wkb, crs = 2056)) }) ================================================ FILE: tests/testthat/test-wkt.R ================================================ test_that("well-known text", { gcol <- st_geometrycollection(list(st_point(1:2), st_linestring(matrix(1:4,2)))) expect_message(x <- print(gcol), "GEOMETRYCOLLECTION \\(POINT \\(1 2\\), LINESTRING \\(1 3, 2 4\\)\\)", all = TRUE) expect_equal(x, gcol) p1 = st_point(1:3) p2 = st_point(5:7) sfc = st_sfc(p1,p2) expect_identical(st_as_text(sfc), c("POINT Z (1 2 3)", "POINT Z (5 6 7)")) expect_equal(st_sfc(gcol), st_as_sfc(list("GEOMETRYCOLLECTION (POINT (1 2), LINESTRING (1 3, 2 4))"))) }) test_that("detect ewkt", { expect_equal(is_ewkt(c("LINESTRING(1663106 -105415,1664320 -104617)", "SRID=4326;POLYGON(1.0 -2.5,3.2 -5.70000)")), c(FALSE, TRUE)) }) test_that("can parse ewkt", { expect_equal(get_crs_ewkt("SRID=4326;POINT(1.0 -2.5,3.2 -5.7)"), 4326) expect_equal(ewkt_to_wkt("SRID=4326;POINT(1.0 -2.5, 3.2 -5.7)"), "POINT(1.0 -2.5, 3.2 -5.7)") expect_equal(ewkt_to_wkt("POINT(1.0 -2.5, 3.2 -5.7)"), "POINT(1.0 -2.5, 3.2 -5.7)") }) test_that("can read ewkt", { expect_equal(st_as_sfc("SRID=3879;LINESTRING(1663106 -105415,1664320 -104617)"), st_as_sfc("LINESTRING(1663106 -105415,1664320 -104617)", 3879)) expect_equal(st_as_sfc(c("SRID=3879;LINESTRING(1663106 -105415,1664320 -104617)", "SRID=3879;LINESTRING(0 0,1 1)")), st_as_sfc(c("LINESTRING(1663106 -105415,1664320 -104617)", "LINESTRING(0 0,1 1)"), 3879) ) expect_equal(st_crs(st_as_sfc(c("SRID=3879;LINESTRING(1663106 -105415,1664320 -104617)", "SRID=3879;LINESTRING(0 0,1 1)"))), st_crs(3879)) expect_error(st_as_sfc(c("SRID=3879;LINESTRING(1663106 -105415,1664320 -104617)", "SRID=4326;LINESTRING(0 0,1 1)")), "3879, 4326") }) ================================================ FILE: tests/testthat/test-write.R ================================================ if (require(sp, quietly = TRUE)) { data(meuse, package = "sp") meuse <- st_as_sf(meuse, coords = c("x", "y"), crs = 28992) drvs <- st_drivers()$name[sapply(st_drivers()$name, function(x) is_driver_can(x, operation = "write"))] |> as.character() } test_that("sf can write to all writable formats", { skip_if_not_installed("sp") # write to all formats available tf <- tempfile() excluded_drivers = c("gps", # requires options "gtm", # doesn't handle attributes "nc", # requires appropriate datum -> but writes in 4326, see below "map", # doesn't support points "ods", # generates valgrind error "gdb", # https://github.com/r-spatial/sf/issues/2027 "gpx") # needs specially named attributes for (ext in setdiff(names(extension_map[extension_map %in% drvs]), excluded_drivers)) { expect_silent(st_write(meuse, paste0(tf, ".", ext), quiet = TRUE)) } }) test_that("sf can write to netcdf", { skip_if_not_installed("sp") skip_on_os("windows") tf <- tempfile() if ("netCDF" %in% drvs) { expect_silent(st_write(st_transform(meuse, st_crs(4326)), paste0(tf, ".nc"), quiet = TRUE)) } }) test_that("sf can write units (#264)", { skip_if_not_installed("sp") tf <- tempfile(fileext = ".gpkg") meuse[["length"]] <- meuse[["cadmium"]] units(meuse$length) <- units::as_units("km") st_write(meuse, tf, quiet = TRUE) disc <- st_read(tf, quiet = TRUE) expect_type(disc[["length"]], "double") expect_equal(as.numeric(meuse[["length"]]), disc[["length"]]) }) test_that("delete and update work (#304)", { skip_if_not("GPKG" %in% st_drivers()$name) # shapefiles can't write point+multipoint mix: skip_on_os("mac") skip_if_not(Sys.getenv("USER") == "edzer") # FIXME: conditional, because it caused memory leaks on CRAN testing gpkg <- tempfile(fileext = ".gpkg") shp <- tempfile(fileext = ".shp") x <- st_sf(a = 1:2, geom = st_sfc(st_point(0:1), st_multipoint(matrix(1:4,2,2)), crs = 'EPSG:3857')) expect_error(st_write(x, gpkg, layer = c("a", "b"), driver = "GPKG", quiet = TRUE)) # error expect_error(st_write(x, gpkg, driver = "foo", quiet = TRUE)) # error expect_warning(st_write(x, gpkg, update = NA, quiet = TRUE), "deprecated") expect_silent(write_sf(x, gpkg, layer = "foo", delete_layer = TRUE)) expect_output(st_write(x, gpkg, layer = "foo", delete_layer = TRUE), "Deleting layer `foo' using") expect_output(st_write(x, gpkg, layer = "foo", delete_layer = TRUE), "Deleting layer `foo'") expect_silent(st_write(x, gpkg, "bar", quiet = TRUE)) expect_error(st_write(x, gpkg, "bar", quiet = TRUE), "Dataset already exists") i = which(st_layers(gpkg)$name == "bar") expect_true(st_layers(gpkg)$features[i] == 2) expect_silent(st_write(x, gpkg, "bar", append = FALSE, quiet = TRUE)) expect_true(st_layers(gpkg)$features[i] == 2) expect_silent(st_write(x, gpkg, "bar", append = TRUE, quiet = TRUE)) expect_true(st_layers(gpkg)$features[i] == 4) expect_output(st_write(x, gpkg, delete_dsn = TRUE), "Writing 2 features") expect_error(st_write(x, gpkg, quiet = TRUE), "Dataset already exists") expect_silent(st_write(x, gpkg, append = FALSE, quiet = TRUE)) expect_silent(st_write(x, gpkg, append = TRUE, quiet = TRUE)) expect_silent(write_sf(x, gpkg, layer = "foo", delete_layer = TRUE)) expect_output(st_write(x, gpkg, layer = "foo", delete_layer = TRUE), "Deleting layer `foo' using") expect_output(st_write(x, gpkg, layer = "foo", delete_layer = TRUE), "Deleting layer `foo'") expect_warning( expect_error(st_write(x, gpkg, layer = ".", quiet = TRUE), "Write error"), "special characters") expect_silent(st_layers(gpkg)) expect_output(st_write(x, gpkg, layer = "foo", delete_dsn = TRUE), "Deleting source") expect_silent(st_layers(gpkg)) expect_warning( expect_error(write_sf(x, shp, "x"), "Feature creation failed"), "non-point") # on osx el capitan: "c++ exception (unknown reason)" expect_silent(x <- st_read(gpkg, quiet = TRUE)) x <- st_sf(a = 1:2, geom = st_sfc(st_linestring(matrix(1:4,2,2)), st_multilinestring(list(matrix(1:4,2,2), matrix(10:13,2,2))))) expect_message(write_sf(x, shp, "x"), "writing: substituting ENGCRS") expect_message(write_sf(x, shp, delete_dsn = TRUE), "writing: substituting ENGCRS") expect_silent(x <- st_read(shp, quiet = TRUE)) expect_silent(x <- read_sf(shp)) expect_error(st_write(x, shp, driver = character(0), quiet = TRUE)) # err }) test_that("layer is deleted when fails to create features (#549)", { skip_if_not_installed("sp") skip_on_os("mac") shp <- tempfile(fileext = ".shp") x <- st_sf(a = 1:2, geom = st_sfc(st_point(0:1), st_multipoint(matrix(1:4,2,2)))) expect_warning(expect_error(st_write(x, shp, "x", quiet = TRUE), "Feature creation failed"), "non-point") expect_warning(expect_error(st_write(x, shp, "x", quiet = TRUE), "Feature creation failed"), "non-point") }) test_that("esri shapefiles shorten long field names", { shpx <- tempfile(fileext = ".shp") shpy <- tempfile(fileext = ".shp") nc <- st_read(system.file("shape/nc.shp", package="sf"), "nc", crs = 4267, quiet = TRUE) nc$this.is.a.very.long.field.name = 1 expect_warning(st_write(nc, shpx, quiet = TRUE), "Field names abbreviated for ESRI Shapefile driver") nc$this.is.a.very.long.field.name2 = 2 expect_warning(st_write(nc, shpy, quiet = TRUE), "Field names abbreviated for ESRI Shapefile driver") # expect_error(st_write(nc, shpz, quiet = TRUE), "Non-unique field names") }) test_that("FID feature ID gets written and read", { nc <- read_sf(system.file("shape/nc.shp", package="sf"), "nc", crs = 4267, quiet = TRUE, fid_column_name = "f_id") f_id = nc$f_id = rev(nc$f_id) tf <- paste0(tempfile(), ".geojson") write_sf(nc, tf, fid_column_name = "f_id") nc2 = read_sf(tf, fid_column_name = "f_id") if (sf_extSoftVersion()[["GDAL"]] >= "2.3.2") expect_equal(nc$f_id, nc2$f_id) }) test_that("append errors work", { skip_if_not(Sys.getenv("USER") == "edzer") # update to non-writable, non-existing file: x = st_sf(a = 1, geom = st_sfc(st_point(0:1))) expect_error( expect_message(st_write(x, "/x.gpkg", update = TRUE), "Creating dataset /x.gpkg failed."), "Creation failed.") # update to non-writable, existing file: f = paste0(tempfile(), ".gpkg") st_write(x, f, update = FALSE) system(paste("chmod -w", f)) expect_error( expect_message(st_write(x, f, append = TRUE), "cannot append to do you have write permission?"), "Cannot append to existing dataset.") system(paste("chmod +w", f)) }) test_that("non-spatial tables can be written to GPKG; #1345", { nc = system.file("gpkg/nc.gpkg", package = "sf") tf = tempfile(fileext = ".gpkg") file.copy(nc, tf) # how does an aspatial layer look like? NA geometry_type l = st_layers(system.file("gpkg/nospatial.gpkg", package = "sf")) expect_true(is.na(l$geomtype[[1]])) # demo: #a = data.frame(a = c(1L,-3L), b = c("foo", "bar")) a = data.frame(a = c(1L,-3L), b = c(3.5, 7.33)) # generates warnings on GDAL 3.1.1: write_sf(a, tf, layer = "nonspatial_table1", driver = "GPKG", delete_layer = TRUE, layer_options = "ASPATIAL_VARIANT=GPKG_ATTRIBUTES") l2 = st_layers(tf) expect_true(is.na(l2$geomtype[[2]])) # hence is aspatial a2 = as.data.frame(read_sf(tf, "nonspatial_table1")) expect_identical(a, a2) expect_output( expect_warning(st_read(tf, "nonspatial_table1"), "no simple feature geometries present:"), "Reading layer `nonspatial_table1' from data source") }) ================================================ FILE: tests/testthat/test-zm_range.R ================================================ # Expect the z range, strip attributes to only compare values. expect_st_z_range <- function(object, expected) { expect_equal(unclass(st_z_range(object)), expected, check.attributes = FALSE) } test_that("st_z_range and st_z_range returns correct value from sfg objects", { pt <- st_point(x = c(0,1,3,3)) expect_st_z_range(pt, c(3,3)) expect_equal(st_z_range(pt), st_z_range(pt)) mp <- st_multipoint(x = matrix(c(0,1,1,1,0,2,5,5), ncol = 4, byrow = TRUE)) expect_st_z_range(mp, c(1, 5)) expect_equal(st_z_range(mp), st_z_range(mp)) ls <- st_linestring(x = matrix(c(0,1,1,1,0,2,5,5,0,3,10,10), ncol = 4, byrow = TRUE)) expect_st_z_range(ls, c(1, 10)) expect_equal(st_z_range(ls), st_z_range(ls)) mls <- st_multilinestring(x = list(ls, matrix(c(0,1,5,5,0,1,-1,-1), ncol = 4, byrow = TRUE))) expect_st_z_range(mls, c(-1, 10)) expect_equal(st_z_range(mls), st_z_range(mls)) pl <- st_polygon(x = list(matrix(c(0,0,1,1,0,1,2,2,1,1,3,3,1,0,4,4,0,0,1,1), ncol = 4, byrow = T))) expect_st_z_range(pl, c(1, 4)) expect_equal(st_z_range(pl), st_z_range(pl)) mpl <- st_multipolygon( x = list(pl, st_polygon( x = list(matrix(c(0,0,10,10,0,-1,9,9,-1,-1,-10,-10,-1,0,-5,-5,0,0,10,10), ncol = 4, byrow = TRUE)))) ) expect_st_z_range(mpl, c(-10, 10)) expect_equal(st_z_range(mpl), st_z_range(mpl)) gc <- st_geometrycollection(x = list(pt, mp)) expect_st_z_range(gc, c(1, 5)) expect_equal(st_z_range(gc), st_z_range(gc)) gc <- st_geometrycollection(x = list(ls, pl)) expect_st_z_range(gc, c(1, 10)) expect_equal(st_z_range(gc), st_z_range(gc)) gc <- st_geometrycollection(x = list(pt, mpl)) expect_st_z_range(gc, c(-10, 10)) expect_equal(st_z_range(gc), st_z_range(gc)) }) test_that("sf::st_z_range and sf::st_z_range returns correct value from sfc objects", { pt <- st_sfc(st_point( x = c(0,1,3,3))) # expect_equal(attr( pt, "zbox" ), c(3, 3)) # FIXME: now NULL expect_st_z_range(pt, c(3, 3)) expect_equal(st_z_range(pt), st_z_range(pt)) mp <- st_sfc(st_multipoint( x = matrix(c(0,1,1,1,0,2,5,5), ncol = 4, byrow = TRUE))) expect_st_z_range(mp, c(1, 5)) expect_equal(st_z_range(mp), st_z_range(mp)) ls <- st_sfc(st_linestring(x = matrix(c(0,1,1,1,0,2,5,5,0,3,10,10), ncol = 4, byrow = TRUE))) expect_st_z_range(ls, c(1, 10)) expect_equal(st_z_range(ls), st_z_range(ls)) mls <- st_sfc(st_multilinestring(x = list(ls[[1]], matrix(c(0,1,5,5,0,1,-1,-1), ncol = 4, byrow = TRUE)))) expect_st_z_range(mls, c(-1, 10)) expect_equal(st_z_range(mls), st_z_range(mls)) pl <- st_sfc(st_polygon(x = list(matrix(c(0,0,1,1,0,1,2,2,1,1,3,3,1,0,4,4,0,0,1,1), ncol = 4, byrow = TRUE)))) expect_st_z_range(pl, c(1, 4)) expect_equal(st_z_range(pl), st_z_range(pl)) mpl <- st_sfc(st_multipolygon(x = list(pl[[1]], st_polygon( x = list( matrix(c(0,0,10,10,0,-1,9,9,-1,-1,-10,-10,-1,0,-5,-5,0,0,10,10), ncol = 4, byrow = TRUE)))))) expect_st_z_range(mpl, c(-10, 10)) expect_equal(st_z_range(mpl), st_z_range(mpl)) gc <- st_sfc(st_geometrycollection(x = list(pt[[1]], mp[[1]]))) expect_st_z_range(gc, c(1, 5)) expect_equal(st_z_range(gc), st_z_range(gc)) gc <- st_sfc(st_geometrycollection(x = list(ls[[1]], pl[[1]]))) expect_st_z_range(gc, c(1, 10)) expect_equal(st_z_range(gc), st_z_range(gc)) gc <- st_sfc(st_geometrycollection(x = list(pt[[1]], mpl[[1]]))) expect_st_z_range(gc, c(-10, 10)) expect_equal(st_z_range(gc), st_z_range(gc)) }) test_that("zmrange works on more compliated examples", { set.seed(123) m <- matrix(rnorm(300), ncol = 3) expected <- c(min(m[,3]), max(m[,3])) ls <- st_linestring(x = m) expect_st_z_range(ls, expected) ls <- st_sfc(ls) expect_st_z_range(ls, expected) expect_equal( unclass(attr(ls, "z_range")), expected, check.attributes = FALSE ) ls <- st_sf(geometry = ls) expect_st_z_range(ls, expected) expect_equal( unclass(attr(ls$geometry, "z_range")), expected, check.attributes = FALSE ) n <- 100 lst <- list() min_z <- numeric(n) max_z <- numeric(n) set.seed(123) for(i in seq_along(n)) { m <- matrix(rnorm(sample(seq(3,300, by = 3), size = 1)), ncol = 3) min_z[i] <- min(m[,3]) max_z[i] <- max(m[,3]) lst[[i]] <- st_linestring(m) } sfc <- st_sfc(lst) expect_st_z_range(sfc, c(min(min_z), max(max_z))) }) test_that("transform includes zm in output", { skip_if(sf_extSoftVersion()[["GDAL"]] <= "2.1.0") p1 = st_point(c(7,52,52)) p2 = st_point(c(-30,20,20)) sfc = st_sfc(p1, p2, crs = 4326) res <- st_transform(sfc, 3857) expect_contains(names(attributes(res)), "z_range") expect_equal(st_z_range(res[[1]]), st_z_range(sfc[[1]])) p1 = st_point(c(7,52,52,7)) p2 = st_point(c(-30,20,20,-30)) sfc = st_sfc(p1, p2, crs = 4326) res <- st_transform(sfc, 3857) expect_contains(names(attributes(res)), c("z_range", "m_range")) expect_equal(st_z_range(res[[1]]), st_z_range(sfc[[1]])) expect_equal(st_m_range(res[[1]]), st_m_range(sfc[[1]])) }) test_that("XYM-only objects correctly calculate M (and not Z)", { skip_if(sf_extSoftVersion()[["GDAL"]] <= "2.1.0") sf_m <- st_read(system.file("/shape/storms_xyzm.shp", package = "sf"), quiet = TRUE) m <- st_coordinates(sf_m) mmin <- min(m[, 3]) mmax <- max(m[, 3]) expect_equal(unclass(st_m_range(sf_m)), c(mmin, mmax), check.attributes = FALSE) sf_z <- st_read(system.file("/shape/storms_xyz.shp", package = "sf"), quiet = TRUE) expect_equal( unclass(st_m_range(sf_m)), unclass(st_z_range(sf_z)), check.attributes = FALSE ) expect_null(st_z_range(sf_m)) expect_null(st_m_range(sf_z)) }) ================================================ FILE: tests/testthat.R ================================================ if (require(testthat, quietly = TRUE)) { suppressPackageStartupMessages(library(sf)) test_check("sf") } ================================================ FILE: tests/units.R ================================================ suppressPackageStartupMessages(library(sf)) suppressPackageStartupMessages(library(units)) if (utils::packageVersion("units") >= "0.5-0") units_options(auto_convert_names_to_symbols = FALSE) st_crs(4326)$ud_unit u = names(sf:::udunits_from_proj)[1:21] unrecognized = NULL out = sapply(u, function(x) { p4s = paste0("+proj=laea +units=", x) cat(x, ": ") ret = try(st_crs(p4s)$ud_unit, silent = TRUE) if (! inherits(ret, "try-error")) print(ret) else unrecognized = c(unrecognized, x) }) if (length(unrecognized)) print(paste("unrecognized units:", paste(unrecognized, collapse = ", "), ": older GDAL version?")) ================================================ FILE: tests/units.Rout.save ================================================ R Under development (unstable) (2025-11-05 r88988 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > suppressPackageStartupMessages(library(sf)) > suppressPackageStartupMessages(library(units)) > > if (utils::packageVersion("units") >= "0.5-0") + units_options(auto_convert_names_to_symbols = FALSE) > > st_crs(4326)$ud_unit 1 [degree] > > u = names(sf:::udunits_from_proj)[1:21] > > unrecognized = NULL > out = sapply(u, function(x) { + p4s = paste0("+proj=laea +units=", x) + cat(x, ": ") + ret = try(st_crs(p4s)$ud_unit, silent = TRUE) + if (! inherits(ret, "try-error")) + print(ret) + else + unrecognized = c(unrecognized, x) + }) km : 1 [km] m : 1 [m] dm : 1 [dm] cm : 1 [cm] mm : 1 [mm] kmi : 1 [nautical_mile] in : 1 [inch] ft : 1 [foot] yd : 1 [yard] mi : 1 [mi] fath : 1 [fathom] ch : 1 [chain] link : 1 [link] us-in : 1 [us_in] us-ft : 1 [US_survey_foot] us-yd : 1 [US_survey_yard] us-ch : 1 [chain] us-mi : 1 [US_survey_mile] ind-yd : 1 [ind_yd] ind-ft : 1 [ind_ft] ind-ch : 1 [ind_ch] > > if (length(unrecognized)) + print(paste("unrecognized units:", paste(unrecognized, collapse = ", "), ": older GDAL version?")) > > proc.time() user system elapsed 0.57 0.15 0.71 ================================================ FILE: tests/wkb.R ================================================ suppressPackageStartupMessages(library(sf)) round_trip = function(x, EWKB = FALSE, pureR = FALSE) { if (inherits(x, "sfg")) x = st_sfc(x) wkb = st_as_binary(x, EWKB = EWKB, pureR = pureR) class(wkb) = "WKB" # print(wkb) y = st_as_sfc(wkb, EWKB = EWKB, pureR = pureR) a = all.equal(x, y) if (length(a) == 1 && is.logical(a) && a) TRUE else { print(x) print(wkb) print(y) FALSE } } p3 = st_point(c(0,0,0)) p3m = st_point(c(0,0,0), "XYM") p4 = st_point(c(0,0,0,0)) p2 = st_point(c(0,0)) ls = st_linestring(matrix(1:6,3)) mp = st_multipoint(matrix(1:6,3)) outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) pts = list(outer, hole1, hole2) pl1 = st_polygon(pts) pol1 = list(outer, hole1, hole2) pol2 = list(outer + 12, hole1 + 12) pol3 = list(outer + 24) mp1 = st_multipolygon(list(pol1,pol2,pol3)) ml1 = st_multilinestring(list(outer, hole1, hole2)) gc = st_geometrycollection(list(p2, ls, pl1, mp1)) sapply(list(p3, p3m, p4, p2, ls, mp, pl1, mp1, ml1, gc), round_trip, EWKB = FALSE) sapply(list(p3, p3m, p4, p2, ls, mp, pl1, mp1, ml1, gc), round_trip, EWKB = FALSE, pureR = TRUE) sapply(list(p3, p3m, p4, p2, ls, mp, pl1, mp1, ml1, gc), round_trip, EWKB = TRUE) sapply(list(p3, p3m, p4, p2, ls, mp, pl1, mp1, ml1, gc), round_trip, EWKB = TRUE, pureR = TRUE) rawToHex(st_as_binary(st_multipoint(matrix(1:6,3)))) rawToHex(st_as_binary(st_sfc(st_point(c(0,1)), st_multipoint(matrix(1:6,3))))) try(rawToHex("error")) # debug roundtrips sf -> GDAL -> sf; # the first WKT is what GDAL reports, and will lack M st_as_text(st_sfc(sf:::CPL_roundtrip(st_sfc(st_linestring(matrix(1:18,6,3),dim="XYZ"))))) st_as_text(st_sfc(sf:::CPL_roundtrip(st_sfc(st_multipoint(matrix(1:18,6,3),dim="XYZ"))))) st_as_text(st_sfc(sf:::CPL_roundtrip(st_sfc(st_point(c(0,0,0), dim="XYZ"))))) if (sf:::CPL_gdal_version() >= "2.1.0") { # address GDAL/Fedora (gdal 2.0.2) error: st_as_text(st_sfc(sf:::CPL_roundtrip(st_sfc(st_linestring(matrix(1:18,6,3),dim="XYM"))))) st_as_text(st_sfc(sf:::CPL_roundtrip(st_sfc(st_multipoint(matrix(1:18,6,3),dim="XYM"))))) st_as_text(st_sfc(sf:::CPL_roundtrip(st_sfc(st_point(c(0,0,0), dim="XYM"))))) } else { "(output expected when gdal <= 2.1.0, e.g. CRAN/fedora)" } ================================================ FILE: tests/wkb.Rout.save ================================================ R Under development (unstable) (2025-11-05 r88988 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > suppressPackageStartupMessages(library(sf)) > round_trip = function(x, EWKB = FALSE, pureR = FALSE) { + if (inherits(x, "sfg")) + x = st_sfc(x) + wkb = st_as_binary(x, EWKB = EWKB, pureR = pureR) + class(wkb) = "WKB" + # print(wkb) + y = st_as_sfc(wkb, EWKB = EWKB, pureR = pureR) + a = all.equal(x, y) + if (length(a) == 1 && is.logical(a) && a) + TRUE + else { + print(x) + print(wkb) + print(y) + FALSE + } + } > > p3 = st_point(c(0,0,0)) > p3m = st_point(c(0,0,0), "XYM") > p4 = st_point(c(0,0,0,0)) > p2 = st_point(c(0,0)) > ls = st_linestring(matrix(1:6,3)) > mp = st_multipoint(matrix(1:6,3)) > > outer = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE) > hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE) > hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE) > pts = list(outer, hole1, hole2) > pl1 = st_polygon(pts) > > pol1 = list(outer, hole1, hole2) > pol2 = list(outer + 12, hole1 + 12) > pol3 = list(outer + 24) > mp1 = st_multipolygon(list(pol1,pol2,pol3)) > > ml1 = st_multilinestring(list(outer, hole1, hole2)) > gc = st_geometrycollection(list(p2, ls, pl1, mp1)) > > sapply(list(p3, p3m, p4, p2, ls, mp, pl1, mp1, ml1, gc), round_trip, EWKB = FALSE) [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > sapply(list(p3, p3m, p4, p2, ls, mp, pl1, mp1, ml1, gc), round_trip, EWKB = FALSE, pureR = TRUE) [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > sapply(list(p3, p3m, p4, p2, ls, mp, pl1, mp1, ml1, gc), round_trip, EWKB = TRUE) [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > sapply(list(p3, p3m, p4, p2, ls, mp, pl1, mp1, ml1, gc), round_trip, EWKB = TRUE, pureR = TRUE) [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE > > rawToHex(st_as_binary(st_multipoint(matrix(1:6,3)))) [1] "0104000000030000000101000000000000000000f03f0000000000001040010100000000000000000000400000000000001440010100000000000000000008400000000000001840" > rawToHex(st_as_binary(st_sfc(st_point(c(0,1)), st_multipoint(matrix(1:6,3))))) [1] "01010000000000000000000000000000000000f03f" [2] "0104000000030000000101000000000000000000f03f0000000000001040010100000000000000000000400000000000001440010100000000000000000008400000000000001840" > try(rawToHex("error")) Error in rawToHex("error") : not implemented for objects of class character > > # debug roundtrips sf -> GDAL -> sf; > # the first WKT is what GDAL reports, and will lack M > st_as_text(st_sfc(sf:::CPL_roundtrip(st_sfc(st_linestring(matrix(1:18,6,3),dim="XYZ"))))) LINESTRING (1 7 13,2 8 14,3 9 15,4 10 16,5 11 17,6 12 18) [1] "LINESTRING Z (1 7 13, 2 8 14, 3 9 15, 4 10 16, 5 11 17, 6 12 18)" > st_as_text(st_sfc(sf:::CPL_roundtrip(st_sfc(st_multipoint(matrix(1:18,6,3),dim="XYZ"))))) MULTIPOINT (1 7 13,2 8 14,3 9 15,4 10 16,5 11 17,6 12 18) [1] "MULTIPOINT Z ((1 7 13), (2 8 14), (3 9 15), (4 10 16), (5 11 17), (6 12 18))" > st_as_text(st_sfc(sf:::CPL_roundtrip(st_sfc(st_point(c(0,0,0), dim="XYZ"))))) POINT (0 0 0) [1] "POINT Z (0 0 0)" > > if (sf:::CPL_gdal_version() >= "2.1.0") { # address GDAL/Fedora (gdal 2.0.2) error: + st_as_text(st_sfc(sf:::CPL_roundtrip(st_sfc(st_linestring(matrix(1:18,6,3),dim="XYM"))))) + st_as_text(st_sfc(sf:::CPL_roundtrip(st_sfc(st_multipoint(matrix(1:18,6,3),dim="XYM"))))) + st_as_text(st_sfc(sf:::CPL_roundtrip(st_sfc(st_point(c(0,0,0), dim="XYM"))))) + } else { + "(output expected when gdal <= 2.1.0, e.g. CRAN/fedora)" + } LINESTRING (1 7,2 8,3 9,4 10,5 11,6 12) MULTIPOINT (1 7,2 8,3 9,4 10,5 11,6 12) POINT (0 0) [1] "POINT M (0 0 0)" > > proc.time() user system elapsed 0.50 0.14 0.60 ================================================ FILE: tic.R ================================================ # installs dependencies, runs R CMD check, runs covr::codecov() do_package_checks() if (ci_on_ghactions() && ci_has_env("BUILD_PKGDOWN")) { # creates pkgdown site and pushes to gh-pages branch # only for the runner with the "BUILD_PKGDOWN" env var set do_pkgdown() } ================================================ FILE: tools/winlibs.R ================================================ if(getRversion() < "3.3.0") { stop("Your version of R is too old. This package requires R-3.3.0 or newer on Windows.") } # For details see: https://github.com/rwinlib/gdal3 VERSION <- commandArgs(TRUE) # wrong path: if(!file.exists(sprintf("../windows/gdal3-%s/include/gdal/gdal.h", VERSION))){ testfile <- sprintf("../windows/gdal3-%s/include/gdal-%s/gdal.h", VERSION, VERSION) if(!file.exists(testfile)){ if(getRversion() < "3.3.0") setInternet2() download.file(sprintf("https://github.com/rwinlib/gdal3/archive/v%s.zip", VERSION), "lib.zip", quiet = TRUE) dir.create("../windows", showWarnings = FALSE) unzip("lib.zip", exdir = "../windows") unlink("lib.zip") } ================================================ FILE: vignettes/sf.fig ================================================ #FIG 3.2 Produced by xfig version 3.2.5c Landscape Center Metric A4 100.00 Single -2 1200 2 2 2 0 3 12 7 50 -1 -1 0.000 0 0 -1 0 0 5 630 4275 15570 4275 15570 4815 630 4815 630 4275 2 2 0 3 10 7 50 -1 -1 0.000 0 0 -1 0 0 5 8820 4365 15165 4365 15165 4770 8820 4770 8820 4365 2 1 0 3 12 7 50 -1 -1 0.000 0 0 -1 1 0 2 1 1 2.00 75.00 180.00 6975 6390 7605 4815 2 1 0 3 4 7 50 -1 -1 0.000 0 0 -1 1 0 2 1 1 2.00 75.00 180.00 10710 6435 10800 5895 2 1 0 3 10 7 50 -1 -1 0.000 0 0 -1 1 0 2 1 1 2.00 75.00 180.00 15390 6165 14850 4770 2 5 0 1 0 -1 54 -1 -1 0.000 0 0 -1 0 0 5 0 sf2.png 0 0 16044 0 16044 5929 0 5929 0 0 2 2 0 3 4 7 50 -1 -1 0.000 0 0 -1 0 0 5 8775 3915 15345 3915 15345 5895 8775 5895 8775 3915 4 0 10 50 -1 16 16 0.0000 4 180 2610 12195 6390 Simple feature geometry (sfg)\001 4 0 12 50 -1 16 16 0.0000 4 165 1260 6075 6660 Simple feature\001 4 0 4 50 -1 16 16 0.0000 4 180 3600 8280 6660 Simple feature geometry list-colum (sfc)\001 ================================================ FILE: vignettes/sf1.Rmd ================================================ --- title: "1. Simple Features for R" author: "Edzer Pebesma" output: html_document: toc: true toc_float: collapsed: false smooth_scroll: false toc_depth: 2 vignette: > %\VignetteIndexEntry{1. Simple Features for R} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, echo=FALSE, include=FALSE} knitr::opts_chunk$set(collapse = TRUE) if (file.exists("nc.shp")) file.remove("nc.shp", "nc.dbf", "nc.shx") ``` [Simple features](https://en.wikipedia.org/wiki/Simple_Features) or _simple feature access_ refers to a formal standard (ISO 19125-1:2004) that describes how objects in the real world can be represented in computers, with emphasis on the _spatial_ geometry of these objects. It also describes how such objects can be stored in and retrieved from databases, and which geometrical operations should be defined for them. The standard is widely implemented in spatial databases (such as [PostGIS](https://postgis.net/)), commercial GIS (e.g., [ESRI ArcGIS](https://www.esri.com/en-us/home)) and forms the vector data basis for libraries such as [GDAL](https://gdal.org/). A subset of simple features forms the [GeoJSON](https://geojson.org/) standard. This vignette: * explains what is meant by features, and by `simple features` * shows how they are implemented in R * provides examples of how you can work with them * shows how they can be read from and written to external files or resources (I/O) * discusses how they can be converted to and from `sp` objects * shows how they can be used for meaningful and applied spatial analysis # What is a feature? A `feature` is thought of as a thing, or an object in the real world, such as a building or a tree. As is the case with objects, they often consist of other objects. This is the case with features too: a set of features can form a single feature. A forest stand can be a feature, a forest can be a feature, a city can be a feature. A satellite image pixel can be a feature, a complete image can be a feature too. Features have a _geometry_ describing _where_ on Earth the feature is located, and they have attributes, which describe other properties. The geometry of a tree can be the delineation of its crown, of its stem, or the point indicating its centre. Other properties may include its height, color, diameter at breast height at a particular date, and so on. The standard says: "_A simple feature is defined by the OpenGIS Abstract specification to have both spatial and non-spatial attributes. Spatial attributes are geometry valued, and simple features are based on 2D geometry with linear interpolation between vertices._" We will see soon that the same standard will extend its coverage beyond 2D and beyond linear interpolation. Here, we take simple features as the data structures and operations described in the standard. ## Dimensions All geometries are composed of points. Points are coordinates in a 2-, 3- or 4-dimensional space. All points in a geometry have the same dimensionality. In addition to X and Y coordinates, there are two optional additional dimensions: * a Z coordinate, denoting altitude * an M coordinate (rarely used), denoting some _measure_ that is associated with the point, rather than with the feature as a whole (in which case it would be a feature attribute); examples could be time of measurement, or measurement error of the coordinates The four possible cases then are: 1. two-dimensional points refer to x and y, easting and northing, or longitude and latitude, we refer to them as XY 2. three-dimensional points as XYZ 3. three-dimensional points as XYM 4. four-dimensional points as XYZM (the third axis is Z, fourth M) ## Simple feature geometry types The following seven simple feature types are the most common, and are for instance the only ones used for [GeoJSON](https://www.rfc-editor.org/rfc/rfc7946): | type | description | | ---- | -------------------------------------------------- | | `POINT` | zero-dimensional geometry containing a single point | | `LINESTRING` | sequence of points connected by straight, non-self intersecting line segments; one-dimensional geometry | | `POLYGON` | geometry with a positive area (two-dimensional); sequence of points form a closed, non-self intersecting ring; the first ring denotes the exterior ring, zero or more subsequent rings denote holes in this exterior ring | | `MULTIPOINT` | set of points; a MULTIPOINT is simple if no two Points in the MULTIPOINT are equal | | `MULTILINESTRING` | set of linestrings | | `MULTIPOLYGON` | set of polygons | | `GEOMETRYCOLLECTION` | set of geometries of any type except GEOMETRYCOLLECTION | Each of the geometry types can also be a (typed) empty set, containing zero coordinates (for `POINT` the standard is not clear how to represent the empty geometry). Empty geometries can be thought of being analogues to missing (`NA`) attributes, NULL values or empty lists. The remaining ten geometries are rare but are increasingly found: | type | description | | ---- | -------------------------------------------------- | | `CIRCULARSTRING` | The CIRCULARSTRING is the basic curve type, similar to a LINESTRING in the linear world. A single segment requires three points, the start and end points (first and third) and any other point on the arc. The exception to this is for a closed circle, where the start and end points are the same. In this case the second point MUST be the center of the arc, i.e., the opposite side of the circle. To chain arcs together, the last point of the previous arc becomes the first point of the next arc, just like in LINESTRING. This means that a valid circular string must have an odd number of points greater than 1. | | `COMPOUNDCURVE` | A compound curve is a single, continuous curve that has both curved (circular) segments and linear segments. That means that in addition to having well-formed components, the end point of every component (except the last) must be coincident with the start point of the following component. | | `CURVEPOLYGON` | Example compound curve in a curve polygon: CURVEPOLYGON(COMPOUNDCURVE(CIRCULARSTRING(0 0,2 0, 2 1, 2 3, 4 3),(4 3, 4 5, 1 4, 0 0)), CIRCULARSTRING(1.7 1, 1.4 0.4, 1.6 0.4, 1.6 0.5, 1.7 1) ) | | `MULTICURVE` | A MultiCurve is a 1-dimensional GeometryCollection whose elements are Curves, it can include linear strings, circular strings or compound strings. | | `MULTISURFACE` | A MultiSurface is a 2-dimensional GeometryCollection whose elements are Surfaces, all using coordinates from the same coordinate reference system. | | `CURVE` | A Curve is a 1-dimensional geometric object usually stored as a sequence of Points, with the subtype of Curve specifying the form of the interpolation between Points | | `SURFACE` | A Surface is a 2-dimensional geometric object | | `POLYHEDRALSURFACE` | A PolyhedralSurface is a contiguous collection of polygons, which share common boundary segments | | `TIN` | A TIN (triangulated irregular network) is a PolyhedralSurface consisting only of Triangle patches.| | `TRIANGLE` | A Triangle is a polygon with 3 distinct, non-collinear vertices and no interior boundary | Note that `CIRCULASTRING`, `COMPOUNDCURVE` and `CURVEPOLYGON` are not described in the SFA standard, but in the [SQL-MM part 3 standard](https://www.iso.org/standard/38651.html). The descriptions above were copied from the [PostGIS manual](http://postgis.net/docs/using_postgis_dbmanagement.html). ## Coordinate reference system Coordinates can only be placed on the Earth's surface when their coordinate reference system (CRS) is known; this may be a spheroid CRS such as [WGS84](https://en.wikipedia.org/wiki/World_Geodetic_System), a projected, two-dimensional (Cartesian) CRS such as a UTM zone or Web Mercator, or a CRS in three-dimensions, or including time. Similarly, M-coordinates need an attribute reference system, e.g. a [measurement unit](https://CRAN.R-project.org/package=units). # How simple features in R are organized Package `sf` represents simple features as native R objects. Similar to [PostGIS](http://postgis.net/), all functions and methods in `sf` that operate on spatial data are prefixed by `st_`, which refers to _spatial type_; this makes them easily findable by command-line completion. Simple features are implemented as R native data, using simple data structures (S3 classes, lists, matrix, vector). Typical use involves reading, manipulating and writing of sets of features, with attributes and geometries. As attributes are typically stored in `data.frame` objects (or the very similar `tbl_df`), we will also store feature geometries in a `data.frame` column. Since geometries are not single-valued, they are put in a list-column, a list of length equal to the number of records in the `data.frame`, with each list element holding the simple feature geometry of that feature. The three classes used to represent simple features are: * `sf`, the table (`data.frame`) with feature attributes and feature geometries, which contains * `sfc`, the list-column with the geometries for each feature (record), which is composed of * `sfg`, the feature geometry of an individual simple feature. We will now discuss each of these three classes. ## sf: objects with simple features As we usually do not work with geometries of single `simple features`, but with datasets consisting of sets of features with attributes, the two are put together in `sf` (simple feature) objects. The following command reads the `nc` dataset from a file that is contained in the `sf` package: ```{r} library(sf) nc <- st_read(system.file("shape/nc.shp", package="sf")) ``` (Note that users will not use `system.file()` but give a `filename` directly, and that shapefiles consist of more than one file, all with identical basename, which reside in the same directory.) The short report printed gives the file name, the driver (ESRI Shapefile), mentions that there are 100 features (records, represented as rows) and 14 fields (attributes, represented as columns). This object is of class ```{r} class(nc) ``` meaning it extends (and "is" a) `data.frame`, but with a single list-column with geometries, which is held in the column with name ```{r} attr(nc, "sf_column") ``` If we print the first three features, we see their attribute values and an abridged version of the geometry ```{r, echo=TRUE, eval=FALSE} print(nc[9:15], n = 3) ``` which would give the following output: ![](sf_fig.png) In the output we see: * in green a simple feature: a single record, or `data.frame` row, consisting of attributes and geometry * in blue a single simple feature geometry (an object of class `sfg`) * in red a simple feature list-column (an object of class `sfc`, which is a column in the `data.frame`) * that although geometries are native R objects, they are printed as [well-known text](#wkb) Methods for `sf` objects are: ```{r} methods(class = "sf") ``` It is also possible to create `data.frame` objects with geometry list-columns that are not of class `sf`, e.g. by: ```{r} nc.no_sf <- as.data.frame(nc) class(nc.no_sf) ``` However, such objects: * no longer register which column is the geometry list-column * no longer have a plot method, and * lack all of the other dedicated methods listed above for class `sf` ## sfc: simple feature geometry list-column The column in the `sf` data.frame that contains the geometries is a list, of class `sfc`. We can retrieve the geometry list-column in this case by `nc$geom` or `nc[[15]]`, but the more general way uses `st_geometry()`: ```{r} (nc_geom <- st_geometry(nc)) ``` Geometries are printed in abbreviated form, but we can view a complete geometry by selecting it, e.g. the first one by: ```{r} nc_geom[[1]] ``` The way this is printed is called _well-known text_, and is part of the standards. The word `MULTIPOLYGON` is followed by three parentheses, because it can consist of multiple polygons, in the form of `MULTIPOLYGON(POL1,POL2)`, where `POL1` might consist of an exterior ring and zero or more interior rings, as of `(EXT1,HOLE1,HOLE2)`. Sets of coordinates belonging to a single polygon are held together with parentheses, so we get `((crds_ext)(crds_hole1)(crds_hole2))` where `crds_` is a comma-separated set of coordinates of a ring. This leads to the case above, where `MULTIPOLYGON(((crds_ext)))` refers to the exterior ring (1), without holes (2), of the first polygon (3) - hence three parentheses. We can see there is a single polygon with no rings: ```{r fig.height=3} par(mar = c(0,0,1,0)) plot(nc[1], reset = FALSE) # reset = FALSE: we want to add to a plot with a legend plot(nc[1,1], col = 'grey', add = TRUE) ``` but some of the polygons in this dataset have multiple exterior rings; they can be identified by: ```{r fig.height=3.5} par(mar = c(0,0,1,0)) (w <- which(sapply(nc_geom, length) > 1)) plot(nc[w,1], col = 2:7) ``` Following the `MULTIPOLYGON` datastructure, in R we have a list of lists of lists of matrices. For instance, we get the first 3 coordinate pairs of the second exterior ring (first ring is always exterior) for the geometry of feature 4 by: ```{r} nc_geom[[4]][[2]][[1]][1:3,] ``` Geometry columns have their own class, ```{r} class(nc_geom) ``` Methods for geometry list-columns include: ```{r} methods(class = 'sfc') ``` Coordinate reference systems (`st_crs()` and `st_transform()`) are discussed in the section on [coordinate reference systems](#crs). `st_as_wkb()` and `st_as_text()` convert geometry list-columns into well-known-binary or well-known-text, explained [below](#wkb). `st_bbox()` retrieves the coordinate bounding box. Attributes include: ```{r} attributes(nc_geom) ``` ## Mixed geometry types The class of `nc_geom` is `c("sfc_MULTIPOLYGON", "sfc")`: `sfc` is shared with all geometry types, and `sfc_TYPE` with `TYPE` indicating the type of the particular geometry at hand. There are two "special" types: `GEOMETRYCOLLECTION`, and `GEOMETRY`. `GEOMETRYCOLLECTION` indicates that each of the geometries may contain a mix of geometry types, as in ```{r} (mix <- st_sfc(st_geometrycollection(list(st_point(1:2))), st_geometrycollection(list(st_linestring(matrix(1:4,2)))))) class(mix) ``` Still, the geometries are here of a single type. The second `GEOMETRY`, indicates that the geometries in the geometry list-column are of varying type: ```{r} (mix <- st_sfc(st_point(1:2), st_linestring(matrix(1:4,2)))) class(mix) ``` These two are fundamentally different: `GEOMETRY` is a superclass without instances, `GEOMETRYCOLLECTION` is a geometry instance. `GEOMETRY` list-columns occur when we read in a data source with a mix of geometry types. `GEOMETRYCOLLECTION` *is* a single feature's geometry: the intersection of two feature polygons may consist of points, lines and polygons, see the example [below](#geometrycollection). ## sfg: simple feature geometry Simple feature geometry (`sfg`) objects carry the geometry for a single feature, e.g. a point, linestring or polygon. Simple feature geometries are implemented as R native data, using the following rules 1. a single POINT is a numeric vector 2. a set of points, e.g. in a LINESTRING or ring of a POLYGON is a `matrix`, each row containing a point 3. any other set is a `list` Creator functions are rarely used in practice, since we typically bulk read and write spatial data. They are useful for illustration: ```{r} (x <- st_point(c(1,2))) str(x) (x <- st_point(c(1,2,3))) str(x) (x <- st_point(c(1,2,3), "XYM")) str(x) (x <- st_point(c(1,2,3,4))) str(x) st_zm(x, drop = TRUE, what = "ZM") ``` This means that we can represent 2-, 3- or 4-dimensional coordinates. All geometry objects inherit from `sfg` (simple feature geometry), but also have a type (e.g. `POINT`), and a dimension (e.g. `XYM`) class name. A figure illustrates six of the seven most common types. With the exception of the `POINT` which has a single point as geometry, the remaining six common single simple feature geometry types that correspond to single features (single records, or rows in a `data.frame`) are created like this ```{r} p <- rbind(c(3.2,4), c(3,4.6), c(3.8,4.4), c(3.5,3.8), c(3.4,3.6), c(3.9,4.5)) (mp <- st_multipoint(p)) s1 <- rbind(c(0,3),c(0,4),c(1,5),c(2,5)) (ls <- st_linestring(s1)) s2 <- rbind(c(0.2,3), c(0.2,4), c(1,4.8), c(2,4.8)) s3 <- rbind(c(0,4.4), c(0.6,5)) (mls <- st_multilinestring(list(s1,s2,s3))) p1 <- rbind(c(0,0), c(1,0), c(3,2), c(2,4), c(1,4), c(0,0)) p2 <- rbind(c(1,1), c(1,2), c(2,2), c(1,1)) pol <-st_polygon(list(p1,p2)) p3 <- rbind(c(3,0), c(4,0), c(4,1), c(3,1), c(3,0)) p4 <- rbind(c(3.3,0.3), c(3.8,0.3), c(3.8,0.8), c(3.3,0.8), c(3.3,0.3))[5:1,] p5 <- rbind(c(3,3), c(4,2), c(4,3), c(3,3)) (mpol <- st_multipolygon(list(list(p1,p2), list(p3,p4), list(p5)))) (gc <- st_geometrycollection(list(mp, mpol, ls))) ``` The objects created are shown here: ```{r, echo=FALSE} par(mar = c(0.1, 0.1, 1.3, 0.1), mfrow = c(2, 3)) plot(mp, col = 'red') box() title("MULTIPOINT") plot(ls, col = 'red') box() title("LINESTRING") plot(mls, col = 'red') box() title("MULTILINESTRING") plot(pol, border = 'red', col = 'grey', xlim = c(0,4)) box() title("POLYGON") plot(mpol, border = 'red', col = 'grey') box() title("MULTIPOLYGON") plot(gc, border = 'grey', col = 'grey') box() title("GEOMETRYCOLLECTION") par(mfrow = c(1, 1)) ``` Geometries can also be empty, as in ```{r} (x <- st_geometrycollection()) length(x) ``` ## Well-known text, well-known binary, precision {#wkb} ### WKT and WKB Well-known text (WKT) and well-known binary (WKB) are two encodings for simple feature geometries. Well-known text, e.g. seen in ```{r} x <- st_linestring(matrix(10:1,5)) st_as_text(x) ``` (but without the leading `## [1]` and quotes), is human-readable. Coordinates are usually floating point numbers, and moving large amounts of information as text is slow and imprecise. For that reason, we use well-known binary (WKB) encoding ```{r} st_as_binary(x) ``` WKT and WKB can both be transformed back into R native objects by ```{r} st_as_sfc("LINESTRING(10 5, 9 4, 8 3, 7 2, 6 1)")[[1]] st_as_sfc(structure(list(st_as_binary(x)), class = "WKB"))[[1]] ``` GDAL, GEOS, spatial databases and GIS read and write WKB which is fast and precise. Conversion between R native objects and WKB is done by package `sf` in compiled (C++/Rcpp) code, making this a reusable and fast route for I/O of simple feature geometries in R. ### Precision One of the attributes of a geometry list-column (`sfc`) is the `precision`: a double number that, when non-zero, causes some rounding during conversion to WKB, which might help certain geometrical operations succeed that would otherwise fail due to floating point representation. The model is that of GEOS, which copies from the Java Topology Suite ([JTS](https://locationtech.github.io/jts/)), and works like this: * if precision is zero (default, unspecified), nothing is modified * negative values convert to float (4-byte real) precision * positive values convert to `round(x*precision)/precision`. For the precision model, see also [here](https://locationtech.github.io/jts/javadoc/org/locationtech/jts/geom/PrecisionModel.html), where it is written that: "... to specify 3 decimal places of precision, use a scale factor of 1000. To specify -3 decimal places of precision (i.e. rounding to the nearest 1000), use a scale factor of 0.001." Note that all coordinates, so also `Z` or `M` values (if present) are affected. Choosing values for `precision` may require some experimenting. ## Reading and writing As we've seen above, reading spatial data from an external file can be done by: ```{r} filename <- system.file("shape/nc.shp", package="sf") nc <- st_read(filename) ``` we can suppress the output by adding argument `quiet=TRUE` or by using the otherwise nearly identical but more quiet ```{r} nc <- read_sf(filename) ``` Writing takes place in the same fashion, using `st_write()`: ```{r} st_write(nc, "nc.shp") ``` If we repeat this, we get an error message that the file already exists, and we can overwrite by: ```{r} st_write(nc, "nc.shp", delete_layer = TRUE) ``` or its quiet alternative that does this by default, ```{r} write_sf(nc, "nc.shp") # silently overwrites ``` ### Driver-specific options The `dsn` and `layer` arguments to `st_read()` and `st_write()` denote a data source name and optionally a layer name. Their exact interpretation as well as the options they support vary per driver, the [GDAL driver documentation](https://gdal.org/en/latest/drivers/vector/index.html) is best consulted for this. For instance, a PostGIS table in database `postgis` might be read by: ```{r eval=FALSE} meuse <- st_read("PG:dbname=postgis", "meuse") ``` where the `PG:` string indicates this concerns the PostGIS driver, followed by database name, and possibly port and user credentials. When the `layer` and `driver` arguments are not specified, `st_read()` tries to guess them from the datasource, or else simply reads the first layer, giving a warning in case there are more. `st_read()` typically reads the coordinate reference system as `proj4string`, but not the EPSG (SRID). GDAL cannot retrieve SRID (EPSG code) from `proj4string` strings, and, when needed, it has to be set by the user. See also the section on [coordinate reference systems](#crs). `st_drivers()` returns a `data.frame` listing available drivers, and their metadata: names, whether a driver can write, and whether it is a raster and/or vector driver. All drivers can read. Reading of some common data formats is illustrated below: `st_layers(dsn)` lists the layers present in data source `dsn`, and gives the number of fields, features and geometry type for each layer: ```{r eval=FALSE} st_layers(system.file("osm/overpass.osm", package="sf")) ``` we see that in this case, the number of features is `NA` because for this xml file the whole file needs to be read, which may be costly for large files. We can force counting by: ```{r eval=FALSE} Sys.setenv(OSM_USE_CUSTOM_INDEXING="NO") st_layers(system.file("osm/overpass.osm", package="sf"), do_count = TRUE) ``` Another example of reading kml and kmz files is: ```{r, eval=FALSE} # Download .shp data u_shp <- "http://coagisweb.cabq.gov/datadownload/biketrails.zip" download.file(u_shp, "biketrails.zip") unzip("biketrails.zip") u_kmz <- "http://coagisweb.cabq.gov/datadownload/BikePaths.kmz" download.file(u_kmz, "BikePaths.kmz") # Read file formats biketrails_shp <- st_read("biketrails.shp") if(Sys.info()[1] == "Linux") # may not work if not Linux biketrails_kmz <- st_read("BikePaths.kmz") u_kml = "http://www.northeastraces.com/oxonraces.com/nearme/safe/6.kml" download.file(u_kml, "bikeraces.kml") bikraces <- st_read("bikeraces.kml") ``` ### Create, read, update and delete {#crud} GDAL provides the [crud](https://en.wikipedia.org/wiki/Create,_read,_update_and_delete) (create, read, update, delete) functions to persistent storage. `st_read()` (or `read_sf()`) are used for reading. `st_write()` (or `write_sf()`) creates, and has the following arguments to control update and delete: * `update=TRUE` causes an existing data source to be updated, if it exists; this option is by default `TRUE` for all database drivers, where the database is updated by adding a table. * `delete_layer=TRUE` causes `st_write` try to open the data source and delete the layer; no errors are given if the data source is not present, or the layer does not exist in the data source. * `delete_dsn=TRUE` causes `st_write` to delete the data source when present, before writing the layer in a newly created data source. No error is given when the data source does not exist. This option should be handled with care, as it may wipe complete directories or databases. ### Connection to spatial databases Read and write functions, `st_read()` and `st_write()`, can handle connections to spatial databases to read WKB or WKT directly without using GDAL. Although intended to use the DBI interface, current use and testing of these functions are limited to PostGIS. ## Coordinate reference systems and transformations {#crs} Coordinate reference systems (CRS) are like measurement units for coordinates: they specify which location on Earth a particular coordinate pair refers to. We saw above that `sfc` objects (geometry list-columns) have an attribute of class `crs` that stores the CRS. This implies that all geometries in a geometry list-column have the same CRS. It may be `NA` in case the CRS is unknown, or when we work with local coordinate systems (e.g. inside a building, a body, or an abstract space); in that case coordinates are assumed to be Cartesian (in case of 2D: defining positions on in a flat plane). A `crs` object contains two character fields: `input` for the name (if existing) or the user-definition of the CRS, and `wkt` for the WKT-2 specification; WKT-2 is a standard encoding for describing CRS that is used throughout the spatial data science industry. When defining a CRS, a PROJ string may be used that is understood by the [PROJ](https://proj.org/) library. It defines projection types and (often) defines parameter values for particular projections, and hence can cover an infinite amount of different projections. Alternatively, codes like `EPSG:3035` or `OGC:CRS84` may be used; these are well-known identifiers of CRS defined in the PROJ database. Coordinate reference system transformations are carried out using `st_transform()`, e.g. converting longitudes/latitudes in NAD27 to Web Mercator (EPSG:3857) can be done by: ```{r} nc.web_mercator <- st_transform(nc, "EPSG:3857") st_geometry(nc.web_mercator)[[4]][[2]][[1]][1:3,] ``` ## Conversion, including to and from sp `sf` objects and objects deriving from `Spatial` (package `sp`) can be coerced both ways: ```{r} showMethods("coerce", classes = "sf") methods(st_as_sf) methods(st_as_sfc) # anticipate that sp::CRS will expand proj4strings: p4s <- "+proj=longlat +datum=NAD27 +no_defs +ellps=clrk66 +nadgrids=@conus,@alaska,@ntv2_0.gsb,@ntv1_can.dat" st_crs(nc) <- p4s # anticipate geometry column name changes: names(nc)[15] = "geometry" attr(nc, "sf_column") = "geometry" nc.sp <- as(nc, "Spatial") class(nc.sp) nc2 <- st_as_sf(nc.sp) all.equal(nc, nc2) ``` As the `Spatial*` objects only support `MULTILINESTRING` and `MULTIPOLYGON`, `LINESTRING` and `POLYGON` geometries are automatically coerced into their `MULTI` form. When converting `Spatial*` into `sf`, if all geometries consist of a single `POLYGON` (possibly with holes), a `POLYGON` and otherwise all geometries are returned as `MULTIPOLYGON`: a mix of `POLYGON` and `MULTIPOLYGON` (such as common in shapefiles) is not created. Argument `forceMulti=TRUE` will override this, and create `MULTIPOLYGON`s in all cases. For `LINES` the situation is identical. ## Geometrical operations {#geometrycollection} The standard for simple feature access defines a number of geometrical operations. `st_is_valid()` and `st_is_simple()` return a Boolean indicating whether a geometry is valid or simple. ```{r} st_is_valid(nc[1:2,]) ``` `st_distance()` returns a dense numeric matrix with distances between geometries. `st_relate()` returns a character matrix with the [DE9-IM](https://en.wikipedia.org/wiki/DE-9IM#Illustration) values for each pair of geometries: ```{r} x = st_transform(nc, 32119) st_distance(x[c(1,4,22),], x[c(1, 33,55,56),]) st_relate(nc[1:5,], nc[1:4,]) ``` `st_intersects()`, `st_disjoint()`, `st_touches()`, `st_crosses()`, `st_within()`, `st_contains()`, `st_overlaps()`, `st_equals()`, `st_covers()`, `st_covered_by()`, `st_equals_exact()` and `st_is_within_distance()` return a sparse matrix (`sgbp` object) with matching (`TRUE`) indexes, or a full logical matrix: ```{r} st_intersects(nc[1:5,], nc[1:4,]) st_intersects(nc[1:5,], nc[1:4,], sparse = FALSE) ``` `st_buffer()`, `st_boundary()`, `st_convexhull()`, `st_union_cascaded`, `st_simplify`, `st_triangulate()`, `st_polygonize()`, `st_centroid()`, `st_segmentize()`, and `st_union()` return new geometries, e.g.: ```{r fig.height=3} sel <- c(1,5,14) geom = st_geometry(nc.web_mercator[sel,]) buf <- st_buffer(geom, dist = 30000) plot(buf, border = 'red') plot(geom, add = TRUE) plot(st_buffer(geom, -5000), add = TRUE, border = 'blue') ``` `st_intersection()`, `st_union()`, `st_difference()`, and `st_sym_difference()` return new geometries that are a function of pairs of geometries: ```{r fig.height=3} par(mar = rep(0,4)) u <- st_union(nc) plot(u) ``` The following code shows how computing an intersection between two polygons may yield a `GEOMETRYCOLLECTION` with a point, line and polygon: ```{r fig.height=3, fig.width=7} opar <- par(mfrow = c(1, 2)) a <- st_polygon(list(cbind(c(0,0,7.5,7.5,0),c(0,-1,-1,0,0)))) b <- st_polygon(list(cbind(c(0,1,2,3,4,5,6,7,7,0),c(1,0,.5,0,0,0.5,-0.5,-0.5,1,1)))) plot(a, ylim = c(-1,1)) title("intersecting two polygons:") plot(b, add = TRUE, border = 'red') (i <- st_intersection(a,b)) plot(a, ylim = c(-1,1)) title("GEOMETRYCOLLECTION") plot(b, add = TRUE, border = 'red') plot(i, add = TRUE, col = 'green', lwd = 2) par(opar) ``` ## Non-simple and non-valid geometries Non-simple geometries are for instance self-intersecting lines (left); non-valid geometries are for instance polygons with slivers (middle) or self-intersections (right). ```{r} library(sf) x1 <- st_linestring(cbind(c(0,1,0,1),c(0,1,1,0))) x2 <- st_polygon(list(cbind(c(0,1,1,1,0,0),c(0,0,1,0.6,1,0)))) x3 <- st_polygon(list(cbind(c(0,1,0,1,0),c(0,1,1,0,0)))) st_is_simple(st_sfc(x1)) st_is_valid(st_sfc(x2,x3)) ``` ```{r echo=FALSE,fig=TRUE,fig.height=3} opar <- par(mfrow = c(1,3)) par(mar=c(1,1,4,1)) plot(st_sfc(x1), type = 'b', axes = FALSE, xlab = NULL, ylab = NULL); title(st_as_text(x1)) plot(st_sfc(st_linestring((cbind(c(0,1,1,1,0,0),c(0,0,1,0.6,1,0))))), type='b', axes = FALSE) title(st_as_text(x2)) plot(st_sfc(st_linestring(cbind(c(0,1,0,1,0),c(0,1,1,0,0)))), type = 'b', axes=F, xlab=NULL,ylab=NULL) title(st_as_text(x3)) par(opar) ``` # Units Where possible geometric operations such as `st_distance()`, `st_length()` and `st_area()` report results with a units attribute appropriate for the CRS: ```{r} a <- st_area(nc[1,]) attributes(a) ``` The **units** package can be used to convert between units: ```{r} units::set_units(a, km^2) # result in square kilometers units::set_units(a, ha) # result in hectares ``` The result can be stripped of their attributes if needs be: ```{r} as.numeric(a) ``` # How attributes relate to geometries (This will eventually be the topic of a new vignette; now here to explain the last attribute of `sf` objects) The standard documents about simple features are very detailed about the geometric aspects of features, but say nearly nothing about attributes, except that their values should be understood in another reference system (their units of measurement, e.g. as implemented in the package [**units**](https://CRAN.R-project.org/package=units)). But there is more to it. For variables like air temperature, interpolation usually makes sense, for others like human body temperature it doesn't. The difference is that air temperature is a field, which continues between sensors, where body temperature is an object property that doesn't extend beyond the body -- in spatial statistics bodies would be called a point pattern, their temperature the point marks. For geometries that have a non-zero size (positive length or area), attribute values may refer to the every sub-geometry (every point), or may summarize the geometry. For example, a state's population density summarizes the whole state, and is not a meaningful estimate of population density for a give point inside the state without the context of the state. On the other hand, land use or geological maps give polygons with constant land use or geology, every point inside the polygon is of that class. Some properties are spatially [extensive](https://en.wikipedia.org/wiki/Intensive_and_extensive_properties), meaning that attributes would summed up when two geometries are merged: population is an example. Other properties are spatially intensive, and should be averaged, with population density the example. Simple feature objects of class `sf` have an _agr_ attribute that points to the _attribute-geometry-relationship_, how attributes relate to their geometry. It can be defined at creation time: ```{r} nc <- st_read(system.file("shape/nc.shp", package="sf"), agr = c(AREA = "aggregate", PERIMETER = "aggregate", CNTY_ = "identity", CNTY_ID = "identity", NAME = "identity", FIPS = "identity", FIPSNO = "identity", CRESS_ID = "identity", BIR74 = "aggregate", SID74 = "aggregate", NWBIR74 = "aggregate", BIR79 = "aggregate", SID79 = "aggregate", NWBIR79 = "aggregate")) st_agr(nc) data(meuse, package = "sp") meuse_sf <- st_as_sf(meuse, coords = c("x", "y"), crs = 28992, agr = "constant") st_agr(meuse_sf) ``` When not specified, this field is filled with `NA` values, but if non-`NA`, it has one of three possibilities: | value | meaning | |-------| ----------------------------------| | constant | a variable that has a constant value at every location over a spatial extent; examples: soil type, climate zone, land use | | aggregate | values are summary values (aggregates) over the geometry, e.g. population density, dominant land use | | identity | values identify the geometry: they refer to (the whole of) this and only this geometry | With this information (still to be done) we can for instance * either return missing values or generate warnings when a _aggregate_ value at a point location inside a polygon is retrieved, or * list the implicit assumptions made when retrieving attribute values at points inside a polygon when `relation_to_geometry` is missing. * decide what to do with attributes when a geometry is split: do nothing in case the attribute is constant, give an error or warning in case it is an aggregate, change the `relation_to_geometry` to _constant_ in case it was _identity_. Further reading: 1. S. Scheider, B. Gräler, E. Pebesma, C. Stasch, 2016. Modelling spatio-temporal information generation. Int J of Geographic Information Science, 30 (10), 1980-2008. ([open access](https://doi.org/10.1080/13658816.2016.1151520)) 2. Stasch, C., S. Scheider, E. Pebesma, W. Kuhn, 2014. Meaningful Spatial Prediction and Aggregation. Environmental Modelling & Software, 51, (149–165, [open access](http://dx.doi.org/10.1016/j.envsoft.2013.09.006)). ================================================ FILE: vignettes/sf2.Rmd ================================================ --- title: "2. Reading, Writing and Converting Simple Features" author: "Edzer Pebesma" output: html_document: toc: true toc_float: collapsed: false smooth_scroll: false toc_depth: 2 vignette: > %\VignetteIndexEntry{2. Reading, Writing and Converting Simple Features} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r echo=FALSE, include=FALSE} knitr::opts_chunk$set(collapse = TRUE) if (file.exists("nc1.shp")) file.remove("nc1.shp", "nc1.dbf", "nc1.shx") ``` This vignette describes how simple features can be read in R from files or databases, and how they can be converted to other formats (text, [sp](https://cran.r-project.org/package=sp)) ## Reading and writing through GDAL The Geospatial Data Abstraction Library ([GDAL](https://gdal.org/)) is the Swiss Army Knife for spatial data: it reads and writes vector and raster data from and to practically every file format, or database, of significance. Package `sf` reads and writes using GDAL using `st_read()` and `st_write()`. The data model GDAL uses needs * a data source, which may be a file, directory, or database * a layer, which is a single geospatial dataset inside a file or directory or e.g. a table in a database. * the specification of a driver (i.e., which format) * driver-specific reading or writing data sources, or layers This may sound complex, but it is needed to map to over 200 data formats! Package `sf` tries hard to simplify this where possible (e.g. a file contains a single layer), but this vignette will try to point you to the options. ### Using st_read As an example, we read the North Carolina counties SIDS dataset, which comes shipped with the `sf` package by: ```{r} library(sf) fname <- system.file("shape/nc.shp", package="sf") fname nc <- st_read(fname) ``` Typical users will use a file name with path for `fname`, or first set R's working directory with `setwd()` and use file name without path. We see here that a single argument is used to find both the datasource and the layer. This works when the datasource contains a single layer. In case the number of layers is zero (e.g. a database with no tables), an error message is given. In case there are more layers than one, the first layer is returned, but a message and a warning are given: ```{r eval=FALSE} > st_read("PG:dbname=postgis") Multiple layers are present in data source PG:dbname=postgis, reading layer `meuse'. Use `st_layers' to list all layer names and their type in a data source. Set the `layer' argument in `st_read' to read a particular layer. Reading layer `meuse' from data source `PG:dbname=postgis' using driver `PostgreSQL' Simple feature collection with 155 features and 12 fields geometry type: POINT dimension: XY bbox: xmin: 178605 ymin: 329714 xmax: 181390 ymax: 333611 epsg (SRID): 28992 proj4string: +proj=sterea +lat_0=52.15616055555555 ... Warning message: In eval(substitute(expr), envir, enclos) : automatically selected the first layer in a data source containing more than one. ``` The message points to the `st_layers()` command, which lists the driver and layers in a datasource, e.g. ```{r eval=FALSE} > st_layers("PG:dbname=postgis") Driver: PostgreSQL Available layers: layer_name geometry_type features fields 1 meuse Point 155 12 2 meuse_sf Point 155 12 3 sids Multi Polygon 100 14 4 meuse_tbl Point 155 13 5 meuse_tbl2 Point 155 13 > ``` A particular layer can now be read by e.g. ```{r eval=FALSE} st_read("PG:dbname=postgis", "sids") ``` `st_layers()` has the option to count the number of features in case these are missing: some datasources (e.g. OSM xml files) do not report the number of features, but need to be completely read for this. GDAL allows for more than one geometry column for a feature layer; these are reported by `st_layers()`. In case a layer contains only geometries but no attributes (fields), `st_read()` still returns an `sf` object, with a geometry column only. We see that GDAL automatically detects the driver (file format) of the datasource, by trying them all in turn. `st_read()` follows the conventions of base R, similar to how it reads tabular data into `data.frame`s. This means that character data are read as `character` vectors by default (since R 4.1.0). For those who insist on retrieving character data as `factor`s, the argument `stringsAsFactors` can be set to `TRUE`: ```{r eval=FALSE} st_read(fname, stringsAsFactors = TRUE) ``` Alternatively, a user can set the global option `stringsAsFactors`, and this will have the same effect: ```{r} options(stringsAsFactors = TRUE) st_read(fname) ``` ### Using st_write To write a simple features object to a file, we need at least two arguments, the object and a filename: ```{r eval=FALSE} st_write(nc, "nc1.shp") ``` The file name is taken as the data source name. The default for the layer name is the basename (filename without path) of the data source name. For this, `st_write()` needs to guess the driver. The above command is, for instance, equivalent to: ```{r} st_write(nc, dsn = "nc1.shp", layer = "nc.shp", driver = "ESRI Shapefile") ``` How the guessing of drivers works is explained in the next section. ### Guessing a driver for output The output driver is guessed from the datasource name, either from its extension (`.shp`: `ESRI Shapefile`), or its prefix (`PG:`: `PostgreSQL`). The list of extensions with corresponding driver (short driver name) is: | extension| driver short name | | ---------| -----------------------------------------------------| | `bna` |`BNA` | | `csv` |`CSV` | | `e00` |`AVCE00` | | `gdb` |`FileGDB` | | `geojson`|`GeoJSON` | | `gml` |`GML` | | `gmt` |`GMT` | | `gpkg` |`GPKG` | | `gps` |`GPSBabel` | | `gtm` |`GPSTrackMaker`| | `gxt` |`Geoconcept` | | `jml` |`JML` | | `map` |`WAsP` | | `mdb` |`Geomedia` | | `nc` |`netCDF` | | `ods` |`ODS` | | `osm` |`OSM` | | `pbf` |`OSM` | | `shp` |`ESRI Shapefile` | | `sqlite` |`SQLite` | | `vdv` |`VDV` | | `xls` |`xls` | | `xlsx` |`XLSX` | The list with prefixes is: | prefix | driver short name | | ----------| ------------------------------------------------------------------| | `couchdb:`|`CouchDB` | | `DB2ODBC:`|`DB2ODBC` | | `DODS:` |`DODS` | | `GFT:` |`GFT` | | `MSSQL:` |`MSSQLSpatial` | | `MySQL:` |`MySQL` | | `OCI:` |`OCI` | | `ODBC:` |`ODBC` | | `PG:` |`PostgreSQL` | | `SDE:` |`SDE` | ### Dataset and layer reading or creation options Various GDAL drivers have options that influences the reading or writing process, for example what the driver should do when a table already exists in a database: append records to the table or overwrite it: ```{r eval=FALSE} st_write(st_as_sf(meuse), "PG:dbname=postgis", "meuse", layer_options = "OVERWRITE=true") ``` In case the table exists and the option is not specified, the driver will give an error. Driver-specific options are documented in the driver manual of [gdal](https://gdal.org/en/latest/drivers/vector/index.html). Multiple options can be given by multiple strings in `options`. For `st_read()`, there is only `options`; for `st_write()`, one needs to distinguish between `dataset_options` and `layer_options`, the first related to opening a dataset, the second to creating layers in the dataset. ## Reading and writing directly to and from spatial databases Package `sf` supports reading and writing from and to spatial databases using the `DBI` interface. So far, testing has mainly be done with `PostGIS`, other databases might work but may also need more work. An example of reading is: ```{r eval=FALSE} library(RPostgreSQL) conn = dbConnect(PostgreSQL(), dbname = "postgis") meuse = st_read(conn, "meuse") meuse_1_3 = st_read(conn, query = "select * from meuse limit 3;") dbDisconnect(conn) ``` We see here that in the second example a query is given. This query may contain spatial predicates, which could be a way to work through massive spatial datasets in R without having to read them completely in memory. Similarly, tables can be written: ```{r eval=FALSE} conn = dbConnect(PostgreSQL(), dbname = "postgis") st_write(conn, meuse, drop = TRUE) dbDisconnect(conn) ``` Here, the default table (layer) name is taken from the object name (`meuse`). Argument `drop` informs to drop (remove) the table before writing; logical argument `binary` determines whether to use well-known binary or well-known text when writing the geometry (where well-known binary is faster and lossless). ## Conversion to other formats: WKT, WKB, sp ### Conversion to and from well-known text The usual form in which we see simple features printed is well-known text: ```{r} st_point(c(0,1)) st_linestring(matrix(0:9,ncol=2,byrow=TRUE)) ``` We can create these well-known text strings explicitly using `st_as_text`: ```{r} x = st_linestring(matrix(0:9,ncol=2,byrow=TRUE)) str = st_as_text(x) x ``` We can convert back from WKT by using `st_as_sfc()`: ```{r} st_as_sfc(str) ``` ### Conversion to and from well-known binary Well-known binary is created from simple features by `st_as_binary()`: ```{r} x = st_linestring(matrix(0:9,ncol=2,byrow=TRUE)) (x = st_as_binary(x)) class(x) ``` The object returned by `st_as_binary()` is of class `WKB` and is either a list with raw vectors, or a single raw vector. These can be converted into a hexadecimal character vector using `rawToHex()`: ```{r} rawToHex(x) ``` Converting back to `sf` uses `st_as_sfc()`: ```{r} x = st_as_binary(st_sfc(st_point(0:1), st_point(5:6))) st_as_sfc(x) ``` ### Conversion to and from sp Spatial objects as maintained by package `sp` can be converted into simple feature objects or geometries by `st_as_sf()` and `st_as_sfc()`, respectively: ```{r} methods(st_as_sf) methods(st_as_sfc) ``` An example would be: ```{r} library(sp) data(meuse) coordinates(meuse) = ~x+y m.sf = st_as_sf(meuse) opar = par(mar=rep(0,4)) plot(m.sf) ``` Conversion of simple feature objects of class `sf` or `sfc` into corresponding `Spatial*` objects is done using the `as` method, coercing to `Spatial`: ```{r} x = st_sfc(st_point(c(5,5)), st_point(c(6,9)), crs = 4326) as(x, "Spatial") ``` ================================================ FILE: vignettes/sf3.Rmd ================================================ --- title: "3. Manipulating Simple Feature Geometries" author: "Edzer Pebesma" output: html_document: toc: true toc_float: collapsed: false smooth_scroll: false toc_depth: 2 vignette: > %\VignetteIndexEntry{3. Manipulating Simple Feature Geometries} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r echo=FALSE, include=FALSE} knitr::opts_chunk$set(collapse = TRUE) ``` This vignette describes how simple feature geometries can be manipulated, where manipulations include * type transformations (e.g., `POLYGON` to `MULTIPOLYGON`) * affine transformation (shift, scale, rotate) * transformation into a different coordinate reference system * geometrical operations, e.g. finding the centroid of a polygon, detecting whether pairs of feature geometries intersect, or find the union (overlap) of two polygons. ## Type transformations This sections discusses how simple feature geometries of one type can be converted to another. For converting lines to polygons, see also `st_polygonize()` below. ### For single geometries For single geometries, `st_cast()` will 1. convert from XX to MULTIXX, e.g. `LINESTRING` to `MULTILINESTRING` 2. convert from MULTIXX to XX if MULTIXX has length one (else, it will still convert but warn about loss of information) 3. convert from MULTIXX to XX if MULTIXX does not have length one, but it will warn about the loss of information 4. convert GEOMETRYCOLLECTION of length one to its component if Examples of the first three types are: ```{r} library(sf) suppressPackageStartupMessages(library(dplyr)) st_point(c(1,1)) |> st_cast("MULTIPOINT") st_multipoint(rbind(c(1,1))) |> st_cast("POINT") st_multipoint(rbind(c(1,1),c(2,2))) |> st_cast("POINT") ``` Examples of the fourth type are: ```{r} st_geometrycollection(list(st_point(c(1,1)))) |> st_cast("POINT") ``` ### For collections of geometry (sfc) and simple feature collections (sf) It should be noted here that when reading geometries using `st_read()`, the `type` argument can be used to control the class of the returned geometry: ```{r} shp = system.file("shape/nc.shp", package="sf") class(st_geometry(st_read(shp, quiet = TRUE))) class(st_geometry(st_read(shp, quiet = TRUE, type = 3))) class(st_geometry(st_read(shp, quiet = TRUE, type = 1))) ``` This option is handled by the GDAL library; in case of failure to convert to the target type, the original types are returned, which in this case is a mix of `POLYGON` and `MULTIPOLYGON` geometries, leading to a `GEOMETRY` as superclass. When we try to read multipolygons as polygons, all secondary rings of multipolygons get lost. When functions return objects with mixed geometry type (`GEOMETRY`), downstream functions such as `st_write()` may have difficulty handling them. For some of these cases, `st_cast()` may help modify their type. For sets of geometry objects (`sfc`) and simple feature sets (`sf), `st_cast` can be used by specifying the target type, or without specifying it. ```{r} ls <- st_linestring(rbind(c(0,0),c(1,1),c(2,1))) mls <- st_multilinestring(list(rbind(c(2,2),c(1,3)), rbind(c(0,0),c(1,1),c(2,1)))) (sfc <- st_sfc(ls,mls)) st_cast(sfc, "MULTILINESTRING") sf <- st_sf(a = 5:4, geom = sfc) st_cast(sf, "MULTILINESTRING") ``` When no target type is given, `st_cast()` tries to be smart for two cases: 1. if the class of the object is `GEOMETRY`, and all elements are of identical type, and 2. if all elements are length-one `GEOMETRYCOLLECTION` objects, in which case `GEOMETRYCOLLECTION` objects are replaced by their content (which may be a `GEOMETRY` mix again) Examples are: ```{r} ls <- st_linestring(rbind(c(0,0),c(1,1),c(2,1))) mls1 <- st_multilinestring(list(rbind(c(2,2),c(1,3)), rbind(c(0,0),c(1,1),c(2,1)))) mls2 <- st_multilinestring(list(rbind(c(4,4),c(4,3)), rbind(c(2,2),c(2,1),c(3,1)))) (sfc <- st_sfc(ls,mls1,mls2)) class(sfc[2:3]) class(st_cast(sfc[2:3])) gc1 <- st_geometrycollection(list(st_linestring(rbind(c(0,0),c(1,1),c(2,1))))) gc2 <- st_geometrycollection(list(st_multilinestring(list(rbind(c(2,2),c(1,3)), rbind(c(0,0),c(1,1),c(2,1)))))) gc3 <- st_geometrycollection(list(st_multilinestring(list(rbind(c(4,4),c(4,3)), rbind(c(2,2),c(2,1),c(3,1)))))) (sfc <- st_sfc(gc1,gc2,gc3)) class(st_cast(sfc)) class(st_cast(st_cast(sfc), "MULTILINESTRING")) ``` ## Affine transformations Affine transformations are transformations of the type $f(x) = xA + b$, where matrix $A$ is used to flatten, scale and/or rotate, and $b$ to translate $x$. Low-level examples are: ```{r} (p = st_point(c(0,2))) p + 1 p + c(1,2) p + p p * p rot = function(a) matrix(c(cos(a), sin(a), -sin(a), cos(a)), 2, 2) p * rot(pi/4) p * rot(pi/2) p * rot(pi) ``` Just to make the point, we can for instance rotate the counties of North Carolina 90 degrees clockwise around their centroid, and shrink them to 75% of their original size: ```{r,fig=TRUE} nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) ncg = st_geometry(nc) plot(ncg, border = 'grey') cntrd = st_centroid(ncg) ncg2 = (ncg - cntrd) * rot(pi/2) * .75 + cntrd plot(ncg2, add = TRUE) plot(cntrd, col = 'red', add = TRUE, cex = .5) ``` ## Coordinate reference systems conversion and transformation ### Getting and setting coordinate reference systems of sf objects The coordinate reference system of objects of class `sf` or `sfc` is obtained by `st_crs()`, and replaced by `st_crs<-`: ```{r} library(sf) geom = st_sfc(st_point(c(0,1)), st_point(c(11,12))) s = st_sf(a = 15:16, geometry = geom) st_crs(s) s1 = s st_crs(s1) <- 4326 st_crs(s1) s2 = s st_crs(s2) <- "+proj=longlat +datum=WGS84" all.equal(s1, s2) ``` An alternative, more pipe-friendly version of `st_crs<-` is ```{r} s1 |> st_set_crs(4326) ``` ### Coordinate reference system transformations If we change the coordinate reference system from one non-missing value into another non-missing value, the CRS is is changed without modifying any coordinates, but a warning is issued that this did not reproject values: ```{r} s3 <- s1 |> st_set_crs(4326) |> st_set_crs(3857) ``` A cleaner way to do this that better expresses intention and does not generate this warning is to first wipe the CRS by assigning it a missing value, and then set it to the intended value. ```{r} s3 <- s1 |> st_set_crs(NA) |> st_set_crs(3857) ``` To carry out a coordinate conversion or transformation, we use `st_transform()` ```{r} s3 <- s1 |> st_transform(3857) s3 ``` for which we see that coordinates are actually modified (projected). ## Geometrical operations All geometrical operations `st_op(x)` or `st_op2(x,y)` work both for `sf` objects and for `sfc` objects `x` and `y`; since the operations work on the geometries, the non-geometry parts of an `sf` object are simply discarded. Also, all binary operations `st_op2(x,y)` called with a single argument, as `st_op2(x)`, are handled as `st_op2(x,x)`. We will illustrate the geometrical operations on a very simple dataset: ```{r figure=TRUE} b0 = st_polygon(list(rbind(c(-1,-1), c(1,-1), c(1,1), c(-1,1), c(-1,-1)))) b1 = b0 + 2 b2 = b0 + c(-0.2, 2) x = st_sfc(b0, b1, b2) a0 = b0 * 0.8 a1 = a0 * 0.5 + c(2, 0.7) a2 = a0 + 1 a3 = b0 * 0.5 + c(2, -0.5) y = st_sfc(a0,a1,a2,a3) plot(x, border = 'red') plot(y, border = 'green', add = TRUE) ``` ### Unary operations `st_is_valid()` returns whether polygon geometries are topologically valid: ```{r} b0 = st_polygon(list(rbind(c(-1,-1), c(1,-1), c(1,1), c(-1,1), c(-1,-1)))) b1 = st_polygon(list(rbind(c(-1,-1), c(1,-1), c(1,1), c(0,-1), c(-1,-1)))) st_is_valid(st_sfc(b0,b1)) ``` and `st_is_simple()` whether line geometries are simple: ```{r} s = st_sfc(st_linestring(rbind(c(0,0), c(1,1))), st_linestring(rbind(c(0,0), c(1,1),c(0,1),c(1,0)))) st_is_simple(s) ``` `st_area()` returns the area of polygon geometries, `st_length()` the length of line geometries: ```{r} st_area(x) st_area(st_sfc(st_point(c(0,0)))) st_length(st_sfc(st_linestring(rbind(c(0,0),c(1,1),c(1,2))), st_linestring(rbind(c(0,0),c(1,0))))) st_length(st_sfc(st_multilinestring(list(rbind(c(0,0),c(1,1),c(1,2))),rbind(c(0,0),c(1,0))))) # ignores 2nd part! ``` ### Binary operations: distance and relate `st_distance()` computes the shortest distance matrix between geometries; this is a dense matrix: ```{r} st_distance(x,y) ``` `st_relate()` returns a dense character matrix with the DE9-IM relationships between each pair of geometries: ```{r} st_relate(x,y) ``` element [i,j] of this matrix has nine characters, referring to relationship between x[i] and y[j], encoded as $I_xI_y,I_xB_y,I_xE_y,B_xI_y,B_xB_y,B_xE_y,E_xI_y,E_xB_y,E_xE_y$ where $I$ refers to interior, $B$ to boundary, and $E$ to exterior, and e.g. $B_xI_y$ the dimensionality of the intersection of the boundary $B_x$ of x[i] and the interior $I_y$ of y[j], which is one of {0,1,2,F}, indicating zero-, one-, two-dimension intersection, and (F) no intersection, respectively. ### Binary logical operations: Binary logical operations return either a sparse matrix ```{r} st_intersects(x,y) ``` or a dense matrix ```{r} st_intersects(x, x, sparse = FALSE) st_intersects(x, y, sparse = FALSE) ``` where list element `i` of a sparse matrix contains the indices of the `TRUE` elements in row `i` of the dense matrix. For large geometry sets, dense matrices take up a lot of memory and are mostly filled with `FALSE` values, hence the default is to return a sparse matrix. `st_intersects()` returns for every geometry pair whether they intersect (dense matrix), or which elements intersect (sparse). Note that `st_intersection()` in this package returns a geometry for the intersection instead of logicals as in `st_intersects()` (see the next section of this vignette). Other binary predicates include (using sparse for readability): ```{r} st_disjoint(x, y, sparse = FALSE) st_touches(x, y, sparse = FALSE) st_crosses(s, s, sparse = FALSE) st_within(x, y, sparse = FALSE) st_contains(x, y, sparse = FALSE) st_overlaps(x, y, sparse = FALSE) st_equals(x, y, sparse = FALSE) st_covers(x, y, sparse = FALSE) st_covered_by(x, y, sparse = FALSE) st_covered_by(y, y, sparse = FALSE) st_equals_exact(x, y,0.001, sparse = FALSE) ``` ### Operations returning a geometry ```{r, fig=TRUE} u = st_union(x) plot(u) ``` ```{r, fig=TRUE} par(mfrow=c(1,2), mar = rep(0,4)) plot(st_buffer(u, 0.2)) plot(u, border = 'red', add = TRUE) plot(st_buffer(u, 0.2), border = 'grey') plot(u, border = 'red', add = TRUE) plot(st_buffer(u, -0.2), add = TRUE) ``` ```{r} plot(st_boundary(x)) ``` ```{r} par(mfrow = c(1:2)) plot(st_convex_hull(x)) plot(st_convex_hull(u)) par(mfrow = c(1,1)) ``` ```{r, fig=TRUE} par(mfrow=c(1,2)) plot(x) plot(st_centroid(x), add = TRUE, col = 'red') plot(x) plot(st_centroid(u), add = TRUE, col = 'red') ``` The intersection of two geometries is the geometry covered by both; it is obtained by `st_intersection()`: ```{r, fig=TRUE} plot(x) plot(y, add = TRUE) plot(st_intersection(st_union(x),st_union(y)), add = TRUE, col = 'red') ``` Note that `st_intersects()` returns a logical matrix indicating whether each geometry pair intersects (see the previous section in this vignette). To get _everything but_ the intersection, use `st_difference()` or `st_sym_difference()`: ```{r,fig=TRUE} par(mfrow=c(2,2), mar = c(0,0,1,0)) plot(x, col = '#ff333388'); plot(y, add=TRUE, col='#33ff3388') title("x: red, y: green") plot(x, border = 'grey') plot(st_difference(st_union(x),st_union(y)), col = 'lightblue', add = TRUE) title("difference(x,y)") plot(x, border = 'grey') plot(st_difference(st_union(y),st_union(x)), col = 'lightblue', add = TRUE) title("difference(y,x)") plot(x, border = 'grey') plot(st_sym_difference(st_union(y),st_union(x)), col = 'lightblue', add = TRUE) title("sym_difference(x,y)") ``` `st_segmentize()` adds points to straight line sections of a lines or polygon object: ```{r,fig=TRUE} par(mfrow=c(1,3),mar=c(1,1,0,0)) pts = rbind(c(0,0),c(1,0),c(2,1),c(3,1)) ls = st_linestring(pts) plot(ls) points(pts) ls.seg = st_segmentize(ls, 0.3) plot(ls.seg) pts = ls.seg points(pts) pol = st_polygon(list(rbind(c(0,0),c(1,0),c(1,1),c(0,1),c(0,0)))) pol.seg = st_segmentize(pol, 0.3) plot(pol.seg, col = 'grey') points(pol.seg[[1]]) ``` `st_polygonize()` polygonizes a multilinestring, as long as the points form a closed polygon: ```{r,fig=TRUE} par(mfrow=c(1,2),mar=c(0,0,1,0)) mls = st_multilinestring(list(matrix(c(0,0,0,1,1,1,0,0),,2,byrow=TRUE))) x = st_polygonize(mls) plot(mls, col = 'grey') title("multilinestring") plot(x, col = 'grey') title("polygon") ``` ================================================ FILE: vignettes/sf4.Rmd ================================================ --- title: "4. Manipulating Simple Features" author: "Edzer Pebesma" output: html_document: toc: true toc_float: collapsed: false smooth_scroll: false toc_depth: 2 vignette: > %\VignetteIndexEntry{4. Manipulating Simple Features} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r echo=FALSE, include=FALSE} knitr::opts_chunk$set(collapse = TRUE) ``` This vignette describes how simple features, i.e. records that come with a geometry, can be manipulated, for the case where these manipulations involve geometries. Manipulations include: * aggregating feature sets * summarising feature sets * joining two feature sets based on feature geometry Features are represented by records in an `sf` object, and have feature attributes (all non-geometry fields) and feature geometry. Since `sf` objects are a subclass of `data.frame` or `tbl_df`, operations on feature attributes work identically to how they work on `data.frame`s, e.g. ```{r} library(sf) nc <- st_read(system.file("shape/nc.shp", package="sf")) nc <- st_transform(nc, 2264) nc[1,] ``` prints the first record. Many of the tidyverse/dplyr verbs have methods for `sf` objects. This means that if both `sf` and `dplyr` are loaded, manipulations such as selecting a single attribute will return an `sf` object: ```{r} library(dplyr) nc |> select(NWBIR74) |> head(2) ``` which implies that the geometry is sticky, and gets added automatically. If we want to drop geometry, we can coerce to `data.frame` first, this drops geometry list-columns: ```{r} nc |> as.data.frame() |> select(NWBIR74) |> head(2) ``` ## Subsetting feature sets We can subset feature sets by using the square bracket notation ```{r} nc[1, "NWBIR74"] ``` and use the `drop` argument to drop geometries: ```{r} nc[1, "NWBIR74", drop = TRUE] ``` but we can also use a spatial object as the row selector, to select features that intersect with another spatial feature: ```{r} Ashe = nc[nc$NAME == "Ashe",] class(Ashe) nc[Ashe,] ``` We see that in the result set `Ashe` is included, as the default value for argument `op` in `[.sf` is `st_intersects()`, and `Ashe` intersects with itself. We could exclude self-intersection by using predicate `st_touches()` (overlapping features don't touch): ```{r} Ashe = nc[nc$NAME == "Ashe",] nc[Ashe, op = st_touches] ``` Using `dplyr`, we can do the same by calling the predicate directly: ```{r} nc |> filter(lengths(st_touches(nc, Ashe)) > 0) ``` ## Aggregating or summarizing feature sets Suppose we want to compare the 1974 fraction of SID (sudden infant death) of the counties that intersect with `Ashe` to the remaining ones. We can do this by: ```{r} a <- aggregate(nc[, c("SID74", "BIR74")], list(Ashe_nb = lengths(st_intersects(nc, Ashe)) > 0), sum) a <- a |> mutate(frac74 = SID74 / BIR74) |> select(frac74) plot(a[2], col = c(grey(.8), grey(.5))) plot(st_geometry(Ashe), border = '#ff8888', add = TRUE, lwd = 2) ``` ## Joining two feature sets based on attributes The usual join verbs of base R (`merge`) and of dplyr (`left_join()`, etc) work for `sf` objects as well; the joining takes place on attributes (ignoring geometries). In case of no matching geometry, an empty geometry is substituted. The second argument should be a `data.frame` (or similar), not an `sf` object: ```{r} x = st_sf(a = 1:2, geom = st_sfc(st_point(c(0,0)), st_point(c(1,1)))) y = data.frame(a = 2:3) merge(x, y) merge(x, y, all = TRUE) right_join(x, y) ``` ## Joining two feature sets based on geometries For joining based on spatial intersections (of any kind), `st_join()` is used: ```{r fig=TRUE} x = st_sf(a = 1:3, geom = st_sfc(st_point(c(1,1)), st_point(c(2,2)), st_point(c(3,3)))) y = st_buffer(x, 0.1) x = x[1:2,] y = y[2:3,] plot(st_geometry(x), xlim = c(.5, 3.5)) plot(st_geometry(y), add = TRUE) ``` The join method is a left join, retaining all records of the first attribute: ```{r} st_join(x, y) st_join(y, x) ``` and the geometry retained is that of the first argument. The spatial join predicate can be controlled with any function compatible with `st_intersects()` (the default), e.g. ```{r} st_join(x, y, join = st_covers) # no matching y records: points don't cover circles st_join(y, x, join = st_covers) # matches for those circles covering a point ``` ================================================ FILE: vignettes/sf5.Rmd ================================================ --- title: "5. Plotting Simple Features" author: "Edzer Pebesma" output: html_document: toc: true toc_float: collapsed: false smooth_scroll: false toc_depth: 2 vignette: > %\VignetteIndexEntry{5. Plotting Simple Features} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- This vignette describes the functions in `sf` that can help to plot simple features. It tries to be complete about the plot methods `sf` provides, and give examples and pointers to options to plot simple feature objects with other packages (mapview, tmap, ggplot2). # Plot methods for `sf` and `sfc` objects ## Geometry only: `sfc` Geometry list-columns (objects of class `sfc`, obtained by the `st_geometry` method) only show the geometry: ```{r} library(sf) demo(nc, ask = FALSE, echo = FALSE) plot(st_geometry(nc)) ``` which can be further annotated with colors, symbols, etc., as the usual base plots, e.g. points are added to a polygon plot by: ```{r} plot(st_geometry(nc), col = sf.colors(12, categorical = TRUE), border = 'grey', axes = TRUE) plot(st_geometry(st_centroid(nc)), pch = 3, col = 'red', add = TRUE) ``` and legends, titles and so on can be added afterwards. `border = NA` removes the polygon borders. As can be seen, the axes plotted are sensitive to the CRS, and in case of longitude/latitude coordinates, degree symbols and orientation are added if `axes = TRUE`. ## Geometry with attributes: `sf` The default plot of an `sf` object is a multi-plot of all attributes, up to a reasonable maximum: ```{r} plot(nc) ``` with a warning when not all attributes can be reasonably plotted. One can increase the maximum number of maps to be plotted by ```{r} plot(nc, max.plot = 14) ``` The row/column layout is chosen such that the plotting area is maximally filled. The default value for `max.plot` can be controlled, e.g. by setting the global option `sf_max.plot`: ```{r} options(sf_max.plot=1) plot(nc) ``` # Color key place and size In case a single attribute is selected, by default a color key is given the side of the plot where it leaves as much as possible room for the plotted map; for `nc` this is below: ```{r} plot(nc["AREA"]) ``` but this can be controlled, and set to a particular side (1=below, 2=left, 3=above and 4=right): ```{r} plot(nc["AREA"], key.pos = 4) ``` The size of a color key can be controlled, using either relative units (a number between 0 and 1) or absolute units (like `lcm(2)` for 2 cm): ```{r} plot(nc["AREA"], key.pos = 1, axes = TRUE, key.width = lcm(1.3), key.length = 1.0) ``` Keys for factor variables are a bit different, as we typically don't want to rotate text for them: ```{r} nc$f = cut(nc$AREA, 10) plot(nc["f"], axes = TRUE, key.pos = 4, pal = sf.colors(10), key.width = lcm(5)) ``` # Class intervals Color breaks (class intervals) can be controlled by plot arguments `breaks` and `nbreaks`. `nbreaks` specifies the number of breaks; `breaks` is either a vector with break values: ```{r} plot(nc["AREA"], breaks = c(0,.05,.1,.15,.2,.25)) ``` or `breaks` is used to indicate a breaks-finding method that is passed as the `style` argument to `classInt::classIntervals()`. Its default value, `pretty`, results in rounded class breaks, and has as a side effect that `nbreaks` may be honoured only approximately. Other methods include `"equal"` to break the data range into `"nbreaks"` equal classes, `"quantile"` to use quantiles as class breaks, and `"jenks"`, used in other software. ```{r} plot(nc["AREA"], breaks = "jenks") ``` # How does `sf` project geographic coordinates? Package `sf` plots projected maps in their native projection, meaning that easting and northing are mapped linearly to the x and y axis, keeping an aspect ratio of 1 (one unit east equals one unit north). For geographic data, where coordinates constitute degrees longitude and latitude, it chooses an [equirectangular projection](https://en.wikipedia.org/wiki/Equirectangular_projection) (also called _equidistant circular_), where at the center of the plot (or of the bounding box) one unit north equals one unit east. Proj.4 also lets you project data to this projection, and the plot of ```{r} plot(st_geometry(nc), axes = TRUE) ``` should, apart from the values along axes, be otherwise identical to ```{r} lat_ts = mean(st_bbox(nc)[c(2,4)]) # latitude of true scale eqc = st_transform(nc, paste0("+proj=eqc +lat_ts=", lat_ts)) plot(st_geometry(eqc), axes = TRUE) ``` # Graticules Graticules are grid lines along equal longitude (meridians) or latitude (parallels) that, depending on the projection used, often plot as curved lines on a map, giving it reference in terms of longitude and latitude. `sf::st_graticule()` tries to create a graticule grid for arbitrary maps. As there are infinitely many projections, there are most likely many cases where it does not succeed in doing this well, and examples of these are welcomed as [sf issues](https://github.com/r-spatial/sf/issues). The following plot shows a graticule geometry on itself, ```{r} library(maps) usa = st_as_sf(map('usa', plot = FALSE, fill = TRUE)) laea = st_crs("+proj=laea +lat_0=30 +lon_0=-95") # Lambert equal area usa <- st_transform(usa, laea) g = st_graticule(usa) plot(st_geometry(g), axes = TRUE) ``` where we see that the graticule does not reach the plot boundaries (but is cut off at the bounding box of `usa`), and that the axes show projected coordinates. When we compute the graticule within the plotting function, we know the plotting region and can compute it up to the plot margins, and add axes in graticule units: ```{r} plot(usa, graticule = TRUE, key.pos = NULL, axes = TRUE) ``` We can also pass a `crs` object to `graticule` to obtain a graticule in a datum different from the default (WGS84). `st_graticule()` takes parameters, and we can pass an object returned by it to the `graticule` parameter of `plot`, to get finer control: ```{r} g = st_graticule(usa, lon = seq(-130,-65,5)) plot(usa, graticule = g, key.pos = NULL, axes = TRUE, xlim = st_bbox(usa)[c(1,3)], ylim = st_bbox(usa)[c(2,4)], xaxs = "i", yaxs = "i") ``` which still doesn't look great -- completely controlling the plotting region of base plots is not easy. # Plotting sf objects with other packages ## grid: `st_as_grob` Package `sf` provides a number of methods for `st_as_grob()`: ```{r} methods(st_as_grob) ``` which convert simple simple feature objects into `grob` ("graphics objects") objects; `grob`s are the graphic primitives of the `grid` plotting package. These methods can be used by plotting packages that build on `grid`, such as `ggplot2` (which uses them in `geom_sf()`) and `tmap`. In addition, `st_viewport()` can be used to set up a grid viewport from an `sf` object, with an aspect ratio similar to that of `plot.sf()`. ## ggplot2 contains a geom specially for simple feature objects, with support for graticule white lines in the background using `sf::st_graticule()`. Support is currently good for polygons; for lines or points, your mileage may vary. ```{r} library(ggplot2) ggplot() + geom_sf(data = usa) ``` Polygons can be colored using `aes`: ```{r} ggplot() + geom_sf(data = nc, aes(fill = BIR74)) + scale_y_continuous(breaks = 34:36) ``` and sets of maps can be plotted as facet plots after rearranging the `sf` object, e.g. by ```{r} library(dplyr) library(tidyr) nc2 <- nc |> select(SID74, SID79, geom) |> gather(VAR, SID, -geom) ggplot() + geom_sf(data = nc2, aes(fill = SID)) + facet_wrap(~VAR, ncol = 1) + scale_y_continuous(breaks = 34:36) ``` ## mapview Package `mapview` creates interactive maps in html pages, using package `leaflet` as a workhorse. Extensive examples are found [here](https://r-spatial.github.io/mapview/). An example is obtained by ```{r, eval = FALSE} library(mapview) mapviewOptions(fgb = FALSE) # needed when creating web pages mapview(nc["BIR74"], col.regions = sf.colors(10), fgb = FALSE) ``` gives a map which is interactive: you can zoom and pan, and query features by clicking on them. ## tmap Package `tmap` is another package for plotting maps, with emphasis on production-ready maps. ```{r eval=require("tmap", quietly = TRUE)} library(tmap) qtm(nc) ``` `tmap` also has interactive leaflet maps: ```{r,eval=FALSE} tmap_mode("view") tm_shape(nc) + tm_fill("BIR74", palette = sf.colors(5)) ``` Replotting the last map in non-interactive mode is as simple as: ```{r,eval=FALSE} ttm() tmap_last() ``` A draft version of the book _Elegant and informative maps with tmap_ by Martijn Tennekes and Jakub Nowosad is found at https://r-tmap.github.io/ ================================================ FILE: vignettes/sf6.Rmd ================================================ --- title: "6. Miscellaneous" author: "Edzer Pebesma" output: html_document: toc: true toc_float: collapsed: false smooth_scroll: false toc_depth: 2 vignette: > %\VignetteIndexEntry{6. Miscellaneous} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r echo=FALSE, include=FALSE} knitr::opts_chunk$set(collapse = TRUE) ``` This vignette describes a number of issues that did not come up in the previous vignettes, and that may or may not be categorized as "frequently asked questions". Readers are encouraged to provide entries for this vignette (as for the others). # What is this EPSG code all about? EPSG stands for a maintained, well-understood registry of spatial reference systems, maintained by the International Association of Oil \& Gas Producers (IOGP). `EPSG` stands for the authority, e.g. `EPSG:4326` stands for spatial reference system with ID 4326 as it is maintained by the EPSG authority. The website for the EPSG registry is found at the epsg.org domain. Using `4326` instead of `EPSG:4326` is allowed (`EPSG` is the default authority) but the latter form, `EPSG:4326` is better (less ambiguous). # Why should we use `OGC:CRS84` instead of `EPSG:4326`? EPSG:4326 formally defines coordinate axes to be in the order latitude-longitude, but practically all data sources and software environments use longitude-latitude axis order. OGC:CRS84 is equivalent to EPSG:4326 except that it defines coordinate axis order longitude-latitude, removing this ambiguity so to speak. See also `st_axis_order()` # How does `sf` deal with secondary geometry columns? `sf` objects can have more than one geometry list-column, but always only one geometry column is considered _active_, and returned by `st_geometry()`. When there are multiple geometry columns, the default `print` methods reports which one is active: ```{r} library(sf) demo(nc, ask = FALSE, echo = FALSE) nc$geom2 = st_centroid(st_geometry(nc)) print(nc, n = 2) ``` We can switch the active geometry by using `st_geometry<-` or `st_set_geometry()`, as in ```{r} plot(st_geometry(nc)) st_geometry(nc) <- "geom2" plot(st_geometry(nc)) ``` # Does `st_simplify` preserve topology? `st_simplify()` is a topology-preserving function, but does this on the level of individual feature geometries. That means, simply said, that after applying it, a polygon will still be a polygon. However when two features have a longer shared boundary, applying `st_simplify` to the object does not guarantee that in the resulting object these two polygons still have the same boundary in common, since the simplification is done independently, _for each feature geometry_. # Why do my dplyr verbs not work for `sf` objects? They do! However, many developers like to write scripts that never load packages but address all functions by the `sf::` prefix, as in ```{r,eval=FALSE} i = sf::st_intersects(sf1, sf2) ``` This works up to the moment that a `dplyr` generic like `select` for an `sf` object is needed: should one call `dplyr::select` (won't know it should search in package `sf`) or `sf::select` (which doesn't exist)? Neither works. One should in this case simply load `sf`, e.g. by ```{r,eval=FALSE} library(sf) ``` ================================================ FILE: vignettes/sf7.Rmd ================================================ --- title: "7. Spherical geometry in sf using s2geometry" author: "Edzer Pebesma and Dewey Dunnington" output: html_document: toc: true toc_float: collapsed: false smooth_scroll: false toc_depth: 2 vignette: > %\VignetteIndexEntry{7. Spherical geometry in sf using s2geometry} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r echo=FALSE, include=FALSE} knitr::opts_chunk$set(collapse = TRUE) ``` # Introduction This vignette describes what spherical geometry implies, and how package `sf` uses the s2geometry library (https://s2geometry.io) for geometrical measures, predicates and transformations. After `sf` has been loaded, it will report whether `s2` is being used; it can be switched off (resorting to flat space geometry) by `sf_use_s2(FALSE)`. ```{r} library(sf) ``` ```{r} library(s2) ``` Most of the package's functions start with `s2_` in the same way that most `sf` function names start with `st_`. Most `sf` functions automatically use `s2` functions when working with ellipsoidal coordinates; if this is not the case, e.g. for `st_voronoi()`, a warning like ``` Warning message: In st_voronoi.sfc(st_geometry(x), st_sfc(envelope), dTolerance, : st_voronoi does not correctly triangulate longitude/latitude data ``` is emitted. # Projected and geographic coordinates Spatial coordinates either refer to _projected_ (or Cartesian) coordinates, meaning that they are associated to points on a flat space, or to unprojected or _geographic_ coordinates, when they refer to angles (latitude, longitude) pointing to locations on a sphere (or ellipsoid). The flat space is also referred to as $R^2$, the sphere as $S^2$. Package `sf` implements _simple features_, a standard for point, line, and polygon geometries where geometries are built from points (nodes) connected by straight lines (edges). The simple feature standard does not say much about its suitability for dealing with geographic coordinates, but the topological relational system it builds upon ([DE9-IM](https://en.wikipedia.org/wiki/DE-9IM)) refer to $R^2$, the two-dimensional flat space. Yet, more and more data are routinely served or exchanged using geographic coordinates. Using software that assumes an $R^2$, flat space may work for some problems, and although `sf` has some functions in place for spherical/ellipsoidal computations (from package `lwgeom`, for computing area, length, distance, and for segmentizing), it has also happily warned the user that it is doing $R^2$, flat computations with such coordinates with messages like ``` although coordinates are longitude/latitude, st_intersects assumes that they are planar ``` hinting to the responsibility of the user to take care of potential problems. Doing this however leaves ambiguities, e.g. whether `LINESTRING(-179 0,179 0)` * passes through `POINT(0 0)`, or * passes through `POINT(180 0)` and whether it is * a straight line, cutting through the Earth's surface, or * a curved line following the Earth's surface Starting with `sf` version 1.0, if you provide a spatial object in a geographical coordinate reference system, `sf` uses the new package `s2` (Dunnington, Pebesma, Rubak 2020) for spherical geometry, which has functions for computing pretty much all measures, predicates and transformations _on the sphere_. This means: * no more hodge-podge of some functions working on $R^2$, with annoying messages, some on the ellipsoid * a considerable speed increase for some functions * no computations on the ellipsoid (which are considered more accurate, but are also slower) The `s2` package is really a wrapper around the C++ [s2geometry](https://s2geometry.io) library which was written by Google, and which is used in many of its products (e.g. Google Maps, Google Earth Engine, BigQuery GIS) and has been translated in several other programming languages. With projected coordinates `sf` continues to work in $R^2$ as before. # Fundamental differences Compared to geometry on $R^2$, and DE9-IM, the `s2` package brings a few fundamentally new concepts, which are discussed first. ## Polygons on $S^2$ divide the sphere in two parts On the sphere ($S^2$), any polygon defines two areas; when following the exterior ring, we need to define what is inside, and the definition is _the left side of the enclosing edges_. This also means that we can flip a polygon (by inverting the edge order) to obtain the other part of the globe, and that in addition to an empty polygon (the empty set) we can have the full polygon (the entire globe). Simple feature geometries should obey a ring direction too: exterior rings should be counter clockwise, interior (hole) rings should be clockwise, but in some sense this is obsolete as the difference between exterior ring and interior rings is defined by their position (exterior, followed by zero or more interior). `sf::read_sf()` has an argument `check_ring_dir` that checks, and corrects, ring directions and many (legacy) datasets have wrong ring directions. With wrong ring directions, many things still work. For $S^2$, ring direction is essential. For that reason, `st_as_s2` has an argument `oriented = FALSE`, which will check and correct ring directions, assuming that all exterior rings occupy an area smaller than half the globe: ```{r} nc = read_sf(system.file("gpkg/nc.gpkg", package="sf")) # wrong ring directions s2_area(st_as_s2(nc, oriented = FALSE)[1:3]) # corrects ring direction, correct area: s2_area(st_as_s2(nc, oriented = TRUE)[1:3]) # wrong direction: Earth's surface minus area nc = read_sf(system.file("gpkg/nc.gpkg", package="sf"), check_ring_dir = TRUE) s2_area(st_as_s2(nc, oriented = TRUE)[1:3]) # no second correction needed here: ``` The default conversion from `sf` to `s2` uses `oriented = FALSE`, so that we get ```{r} all(units::drop_units(st_area(nc)) == s2_area(st_as_s2(nc, oriented = FALSE))) ``` Here is an example where the oceans are computed as the difference from the full polygon representing the entire globe, ```{r} g = st_as_sfc("POLYGON FULL", crs = 'EPSG:4326') g ``` and the countries, and shown in an orthographic projection: ```{r} options(s2_oriented = TRUE) # don't change orientation from here on co = st_as_sf(s2_data_countries()) oc = st_difference(g, st_union(co)) # oceans b = st_buffer(st_as_sfc("POINT(-30 52)", crs = 'EPSG:4326'), 9800000) # visible half i = st_intersection(b, oc) # visible ocean plot(st_transform(i, "+proj=ortho +lat_0=52 +lon_0=-30"), col = 'blue') ``` (Note that the printing of `POLYGON FULL` is not valid WKT according to the simple feature standard, which does not include this.) We can now calculate the proportion of the Earth's surface covered by oceans: ```{r} st_area(oc) / st_area(g) ``` ## Semi-open polygon boundaries Polygons in `s2geometry` can be * CLOSED: they contain their boundaries, and a point on the boundary intersects with the polygon * OPEN: they do not contain their boundaries, points on the boundary do not intersect with the polygon * SEMI-OPEN: they contain part of their boundaries, but no boundary of non-overlapping polygons is contained by more than one polygon. In principle the DE9-IM model deals with interior, boundary and exterior, and intersection predicates are sensitive to this (the difference between _contains_ and _covers_ is all about boundaries). DE9-IM however cannot uniquely assign points to polygons when polygons form a polygon _coverage_ (no overlaps, but shared boundaries). This means that if we would count points by polygon, and some points fall _on_ shared polygon boundaries, we either miss them (_contains_) or we count them double (_covers_, _intersects_); this might lead to bias and require post-processing. Using SEMI-OPEN non-overlapping polygons guarantees that every point is assigned to _maximally_ one polygon in an intersection. This corresponds to e.g. how this would be handled in a grid (raster) coverage, where every grid cell (typically) only contains its upper-left corner and its upper and left sides. ```{r} a = st_as_sfc("POINT(0 0)", crs = 'EPSG:4326') b = st_as_sfc("POLYGON((0 0,1 0,1 1,0 1,0 0))", crs = 'EPSG:4326') st_intersects(a, b, model = "open") st_intersects(a, b, model = "closed") st_intersects(a, b, model = "semi-open") # a toss st_intersects(a, b) # default: closed ``` ## Bounding cap, bounding rectangle Computing the minimum and maximum values over coordinate ranges, as `sf` does with `st_bbox()`, is of limited value for spherical coordinates because due the spherical space, the _area covered_ is not necessarily covered by the coordinate range. Two examples: * small regions covering the antimeridian (longitude +/- 180) end up with a huge longitude range, which doesn't make _clear_ the antimeridian is spanned * regions including a pole will end up with a latitude range not extending to +/- 90 S2 has two alternatives: the bounding cap and the bounding rectangle: ```{r} fiji = s2_data_countries("Fiji") aa = s2_data_countries("Antarctica") s2_bounds_cap(fiji) s2_bounds_rect(c(fiji,aa)) ``` The cap reports a bounding cap (circle) as a mid point (lat, lng) and an angle around this point. The bounding rectangle reports the `_lo` and `_hi` bounds of `lat` and `lng` coordinates. Note that for Fiji, `lng_lo` being higher than `lng_hi` indicates that the region covers (crosses) the antimeridian. # Switching between S2 and GEOS The two-dimensional $R^2$ library that was formerly used by `sf` is [GEOS](https://libgeos.org), and `sf` can be instrumented to use GEOS or `s2`. First we will ask if `s2` is being used by default: ```{r} sf_use_s2() ``` then we can switch it off (and use GEOS) by ```{r} sf_use_s2(FALSE) ``` and switch it on (and use s2) by ```{r} sf_use_s2(TRUE) ``` # Measures This section compares the differences in results between the `s2` and `lwgeom` (`sf_use_s2(FALSE)`) packages for calculating area, length and distance using geographic coordinates. Note that engaging the `GEOS` engine would require reprojection of the vector layer to the planar coordinate system (e.g. `EPGS:3857`). ## Area ```{r eval=require("lwgeom", quietly = TRUE)} options(s2_oriented = FALSE) # correct orientation from here on library(sf) library(units) nc = read_sf(system.file("gpkg/nc.gpkg", package="sf")) sf_use_s2(TRUE) a1 = st_area(nc) sf_use_s2(FALSE) a2 = st_area(nc) plot(a1, a2) abline(0, 1) summary((a1 - a2)/a1) ``` ## Length ```{r} nc_ls = st_cast(nc, "MULTILINESTRING") sf_use_s2(TRUE) l1 = st_length(nc_ls) sf_use_s2(FALSE) l2 = st_length(nc_ls) plot(l1 , l2) abline(0, 1) summary((l1 - l2)/l1) ``` ## Distances ```{r} sf_use_s2(TRUE) d1 = st_distance(nc, nc[1:10,]) sf_use_s2(FALSE) d2 = st_distance(nc, nc[1:10,]) plot(as.vector(d1), as.vector(d2)) abline(0, 1) summary(as.vector(d1) - as.vector(d2)) ``` # Predicates All unary and binary predicates are available in `s2`, except for `st_relate()` with a pattern. In addition, when using the `s2` predicates, depending on the `model`, intersections with neighbours are only reported when `model` is `closed` (the default): ```{r} sf_use_s2(TRUE) st_intersects(nc[1:3,], nc[1:3,]) # self-intersections + neighbours sf_use_s2(TRUE) st_intersects(nc[1:3,], nc[1:3,], model = "semi-open") # only self-intersections ``` # Transformations `st_intersection()`, `st_union()`, `st_difference()`, and `st_sym_difference()` are available as `s2` equivalents. N-ary intersection and difference are not (yet) present; cascaded union is present; unioning by feature does not work with `s2`. ## Buffers Buffers can be calculated for features with geographic coordinates as follows, using an unprojected object representing the UK as an example: ```{r, fig.show='hold', out.width="50%"} uk = s2_data_countries("United Kingdom") class(uk) uk_sfc = st_as_sfc(uk) uk_buffer = st_buffer(uk_sfc, dist = 20000) uk_buffer2 = st_buffer(uk_sfc, dist = 20000, max_cells = 10000) uk_buffer3 = st_buffer(uk_sfc, dist = 20000, max_cells = 100) class(uk_buffer) plot(uk_sfc) plot(uk_buffer) plot(uk_buffer2) plot(uk_buffer3) uk_sf = st_as_sf(uk) ``` The plots above show that you can adjust the level of spatial precision in the results of s2 buffer operations with the `max_cells` argument, set to 1000 by default. Deciding on an appropriate value is a balance between excessive detail increasing computational resources (represented by `uk_buffer2`, bottom left) and excessive simplification (bottom right). Note that buffers created with s2 _always_ follow s2 cell boundaries, they are never smooth. Hence, choosing a large number for `max_cells` leads to seemingly smooth but, zoomed in, very complex buffers. To achieve a similar result, you could first transform the result and then use `sf::st_buffer()`. A simple benchmark shows the computational efficiency of the `s2` geometry engine in comparison with transforming and then creating buffers: ```{r} # the sf way system.time({ uk_projected = st_transform(uk_sfc, 27700) uk_buffer_sf = st_buffer(uk_projected, dist = 20000) }) # sf way with few than the 30 segments in the buffer system.time({ uk_projected = st_transform(uk_sfc, 27700) uk_buffer_sf2 = st_buffer(uk_projected, dist = 20000, nQuadSegs = 4) }) # s2 with default cell size system.time({ uk_buffer = s2_buffer_cells(uk, distance = 20000) }) # s2 with 10000 cells system.time({ uk_buffer2 = s2_buffer_cells(uk, distance = 20000, max_cells = 10000) }) # s2 with 100 cells system.time({ uk_buffer2 = s2_buffer_cells(uk, distance = 20000, max_cells = 100) }) ``` The result of the previous benchmarks emphasizes the point that there are trade-offs between geographic resolution and computational resources, something that web developers working on geographic services such as Google Maps understand well. In this case the default setting of 1000 cells, which runs slightly faster than the default transform -> buffer workflow, is probably appropriate given the low resolution of the input geometry representing the UK. ## `st_buffer` or `st_is_within_distance`? As discussed in the [`sf` issue tracker](https://github.com/r-spatial/sf/issues/1367), deciding on workflows and selecting appropriate levels of level of geographic resolution can be an iterative process. `st_buffer()` as powered by GEOS, for $R^2$ data, are smooth and (nearly) exact. `st_buffer()` as powered by $S^2$ is rougher, complex, non-smooth, and may need tuning. A common pattern where `st_buffer()` is used is this: * compute buffers around a set of features `x` (points, lines, polygons) * within each of these buffers, find all occurrences of some other spatial variable `y` and aggregate them (e.g. count points, or average a raster variable like precipitation or population density) * work with these aggregated values (discard the buffer) When this is the case, and you are working with geographic coordinates, it may pay off to _not_ compute buffers, but instead directly work with `st_is_within_distance()` to select, for each feature of `x`, all features of `y` that are within a certain distance `d` from `x`. The $S^2$ version of this function uses spatial indexes, so is fast for large datasets. ## References * Dewey Dunnington, Edzer Pebesma and Ege Rubak, 2020. s2: Spherical Geometry Operators Using the $S^2$ Geometry Library. https://r-spatial.github.io/s2/, https://github.com/r-spatial/s2 ================================================ FILE: vignettes/sf_fig.drawio ================================================ ================================================ FILE: vignettes.awk ================================================ { if (NR == 4) { print("output: rmarkdown::html_vignette") } else if (NR > 4 && NR <= 10) { } else if (NR == 16) { print("\n**For a better version of the sf vignettes see** https://r-spatial.github.io/sf/articles/\n") } else if (NR == 17) { print print("knitr::opts_chunk$set(fig.height = 4.5)") print("knitr::opts_chunk$set(fig.width = 6)") } else print }