├── .Rbuildignore ├── .github └── workflows │ ├── R-CMD-check.yaml │ └── test-coverage.yaml ├── .gitignore ├── .hooks └── description ├── .pre-commit-config.yaml ├── CONTRIBUTING.md ├── DESCRIPTION ├── NAMESPACE ├── NEWS.md ├── R ├── add-axes.R ├── add-colourbar.R ├── add-osm-groups.R ├── add-osm-objects.R ├── add-osm-surface.R ├── adjust-colours.R ├── check-fns.R ├── colour-mat.R ├── connect-highways.R ├── extract-highways.R ├── extract-osm-objects.R ├── get-bbox.R ├── get-highway-cycle.R ├── line2poly.R ├── make-osm-map.R ├── order-lines.R ├── osm-basemap.R ├── osm-structures.R ├── osmplotr.R ├── print-osm-map.R ├── test-fns.R ├── utils.R └── zzz.R ├── README.Rmd ├── README.md ├── _pkgdown.yml ├── codemeta.json ├── cran-comments.md ├── data-raw └── pkg-data-scripts.Rmd ├── data └── london.rda ├── inst └── extdata │ └── hwys.rda ├── makefile ├── man ├── add_axes.Rd ├── add_colourbar.Rd ├── add_osm_groups.Rd ├── add_osm_objects.Rd ├── add_osm_surface.Rd ├── adjust_colours.Rd ├── colour_mat.Rd ├── connect_highways.Rd ├── extract_osm_objects.Rd ├── figures │ ├── map1.png │ ├── map2.png │ ├── map3.png │ ├── map4.png │ ├── map5.png │ ├── map6.png │ └── map7.png ├── get_bbox.Rd ├── london.Rd ├── make_osm_map.Rd ├── osm_basemap.Rd ├── osm_line2poly.Rd ├── osm_structures.Rd ├── osmplotr.Rd └── print_osm_map.Rd ├── tests ├── stub.R ├── testthat.R └── testthat │ ├── test-add-axes.R │ ├── test-add-colourbar.R │ ├── test-add-groups.R │ ├── test-add-objects.R │ ├── test-add-surface.R │ ├── test-adjust-colours.R │ ├── test-colourmat.R │ ├── test-connect-highways.R │ ├── test-extract-objects.R │ ├── test-get-bbox.R │ ├── test-make-osmmap.R │ ├── test-osm-basemap.R │ └── test-print-map.R └── vignettes ├── basic-maps.Rmd ├── data-maps.Rmd ├── makefile ├── maps-with-ocean.Rmd ├── melb_a1.png ├── testEE.png ├── testEN.png ├── testEW.png ├── testEWWS.png ├── testNN.png ├── testNS.png ├── testSN.png ├── testSS.png ├── testWE.png ├── testWS.png └── testWW.png /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^.github 3 | ^CODE_OF_CONDUCT.md$ 4 | ^CONTRIBUTING.md$ 5 | ^README\.Rmd$ 6 | ^\.Rproj\.user$ 7 | ^\.github$ 8 | ^\.gitignore$ 9 | ^\.hooks$ 10 | ^\.pre-commit-config\.yaml$ 11 | ^\.travis\.yml$ 12 | ^_pkgdown\.yml$ 13 | ^aaa\.Rmd$ 14 | ^appveyor\.yml$ 15 | ^codemeta\.json$ 16 | ^cran-comments.md$ 17 | ^data-raw$ 18 | ^data/nomenclatura* 19 | ^makefile$ 20 | ^maps$ 21 | ^paper\.bib$ 22 | ^paper\.md$ 23 | ^script\.R$ 24 | ^vignettes/makefile$ 25 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | 8 | name: R-CMD-check.yaml 9 | 10 | permissions: read-all 11 | 12 | jobs: 13 | R-CMD-check: 14 | runs-on: ${{ matrix.config.os }} 15 | 16 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 17 | 18 | strategy: 19 | fail-fast: false 20 | matrix: 21 | config: 22 | - {os: macos-latest, r: 'release'} 23 | - {os: windows-latest, r: 'release'} 24 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 25 | - {os: ubuntu-latest, r: 'release'} 26 | - {os: ubuntu-latest, r: 'oldrel-1'} 27 | 28 | env: 29 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 30 | R_KEEP_PKG_SOURCE: yes 31 | 32 | steps: 33 | - uses: actions/checkout@v4 34 | 35 | - uses: r-lib/actions/setup-pandoc@v2 36 | 37 | - uses: r-lib/actions/setup-r@v2 38 | with: 39 | r-version: ${{ matrix.config.r }} 40 | http-user-agent: ${{ matrix.config.http-user-agent }} 41 | use-public-rspm: true 42 | 43 | - uses: r-lib/actions/setup-r-dependencies@v2 44 | with: 45 | extra-packages: any::rcmdcheck 46 | needs: check 47 | 48 | - uses: r-lib/actions/check-r-package@v2 49 | with: 50 | upload-snapshots: true 51 | build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' 52 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | 8 | name: test-coverage.yaml 9 | 10 | permissions: read-all 11 | 12 | jobs: 13 | test-coverage: 14 | runs-on: ubuntu-latest 15 | env: 16 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 17 | 18 | steps: 19 | - uses: actions/checkout@v4 20 | 21 | - uses: r-lib/actions/setup-r@v2 22 | with: 23 | use-public-rspm: true 24 | 25 | - uses: r-lib/actions/setup-r-dependencies@v2 26 | with: 27 | extra-packages: any::covr, any::xml2 28 | needs: coverage 29 | 30 | - name: Test coverage 31 | run: | 32 | cov <- covr::package_coverage( 33 | quiet = FALSE, 34 | clean = FALSE, 35 | install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") 36 | ) 37 | covr::to_cobertura(cov) 38 | shell: Rscript {0} 39 | 40 | - uses: codecov/codecov-action@v4 41 | with: 42 | # Fail if error if not on PR, or if on PR and token is given 43 | fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} 44 | file: ./cobertura.xml 45 | plugin: noop 46 | disable_search: true 47 | token: ${{ secrets.CODECOV_TOKEN }} 48 | 49 | - name: Show testthat output 50 | if: always() 51 | run: | 52 | ## -------------------------------------------------------------------- 53 | find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true 54 | shell: bash 55 | 56 | - name: Upload test results 57 | if: failure() 58 | uses: actions/upload-artifact@v4 59 | with: 60 | name: coverage-test-failures 61 | path: ${{ runner.temp }}/package 62 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | makefile 2 | london2.rda 3 | aaa\.Rmd 4 | .Rproj.user 5 | .Rhistory 6 | .RData 7 | inst/doc 8 | inst/WORDLIST 9 | # History files 10 | .Rhistory 11 | .Rapp.history 12 | # Session Data files 13 | .RData 14 | # Output files from R CMD build 15 | /*.tar.gz 16 | # vim files 17 | .*.un~ 18 | .*.swp 19 | src/*.o 20 | -------------------------------------------------------------------------------- /.hooks/description: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env Rscript 2 | 3 | s <- gert::git_status() 4 | chk <- ("DESCRIPTION" %in% s$file && 5 | (s$status [s$file == "DESCRIPTION"] == "modified" | 6 | s$status [s$file == "DESCRIPTION"] == "new")) 7 | if (!chk) 8 | stop ("DESCRIPTION has not been updated") 9 | 10 | f <- file.path (rprojroot::find_root("DESCRIPTION"), "DESCRIPTION") 11 | x <- system2 ("git", args = c ("diff", "--cached", "-U0", f), stdout = TRUE) 12 | if (!any (grepl ("^\\+Version", x))) 13 | stop ("Version number in DESCRIPTION has not been incremented") 14 | -------------------------------------------------------------------------------- /.pre-commit-config.yaml: -------------------------------------------------------------------------------- 1 | # All available hooks: https://pre-commit.com/hooks.html 2 | # R specific hooks: https://github.com/lorenzwalthert/precommit 3 | repos: 4 | - repo: https://github.com/lorenzwalthert/precommit 5 | rev: v0.4.2 6 | hooks: 7 | - id: style-files 8 | args: [--style_pkg=spaceout, --style_fun=spaceout_style] 9 | additional_dependencies: 10 | - ropensci-review-tools/spaceout 11 | # - id: roxygenize 12 | # codemeta must be above use-tidy-description when both are used 13 | # - id: codemeta-description-updated 14 | - id: use-tidy-description 15 | - id: spell-check 16 | exclude: > 17 | (?x)^( 18 | .*\.[rR]| 19 | .*\.feather| 20 | .*\.jpeg| 21 | .*\.pdf| 22 | .*\.png| 23 | .*\.py| 24 | .*\.RData| 25 | .*\.rds| 26 | .*\.Rds| 27 | .*\.Rproj| 28 | .*\.sh| 29 | (.*/|)\.gitignore| 30 | (.*/|)\.gitlab-ci\.yml| 31 | (.*/|)\.lintr| 32 | (.*/|)\.pre-commit-.*| 33 | (.*/|)\.Rbuildignore| 34 | (.*/|)\.Renviron| 35 | (.*/|)\.Rprofile| 36 | (.*/|)\.travis\.yml| 37 | (.*/|)appveyor\.yml| 38 | (.*/|)NAMESPACE| 39 | (.*/|)renv/settings\.dcf| 40 | (.*/|)renv\.lock| 41 | (.*/|)WORDLIST| 42 | \.github/workflows/.*| 43 | data/.*| 44 | )$ 45 | # - id: lintr 46 | - id: readme-rmd-rendered 47 | - id: parsable-R 48 | - id: no-browser-statement 49 | - id: no-print-statement 50 | - id: no-debug-statement 51 | - id: deps-in-desc 52 | # - id: pkgdown 53 | - repo: https://github.com/pre-commit/pre-commit-hooks 54 | rev: v4.6.0 55 | hooks: 56 | - id: check-added-large-files 57 | args: ['--maxkb=200'] 58 | - id: file-contents-sorter 59 | files: '^\.Rbuildignore$' 60 | - id: end-of-file-fixer 61 | exclude: '\.Rd' 62 | - repo: https://github.com/pre-commit-ci/pre-commit-ci-config 63 | rev: v1.6.1 64 | hooks: 65 | # Only required when https://pre-commit.ci is used for config validation 66 | - id: check-pre-commit-ci-config 67 | - repo: local 68 | hooks: 69 | - id: forbid-to-commit 70 | name: Don't commit common R artifacts 71 | entry: Cannot commit .Rhistory, .RData, .Rds or .rds. 72 | language: fail 73 | files: '\.(Rhistory|RData|Rds|rds)$' 74 | # `exclude: ` to allow committing specific files 75 | - id: description version 76 | name: Version has been incremeneted in DESCRIPTION 77 | entry: .hooks/description 78 | language: script 79 | 80 | ci: 81 | autoupdate_schedule: monthly 82 | # skip: [pkgdown] 83 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing to osmplotr 2 | 3 | ## Opening issues 4 | 5 | The easiest way to note any behavioural curiosities or to request any new 6 | features is by opening a [github issue](https://github.com/ropensci/osmplotr/issues). 7 | 8 | 9 | ## Development guidelines 10 | 11 | If you'd like to contribute changes to `osmplotr`, we use [the GitHub 12 | flow](https://guides.github.com/introduction/flow/index.html) for proposing, 13 | submitting, reviewing, and accepting changes. If you haven't done this before, 14 | there's a nice overview of git [here](http://r-pkgs.had.co.nz/git.html), as well 15 | as best practices for submitting pull requests 16 | [here](http://r-pkgs.had.co.nz/git.html#pr-make). 17 | 18 | The `osmplotr` coding style diverges somewhat from [this commonly used R style 19 | guide](http://adv-r.had.co.nz/Style.html), primarily in the following two ways, 20 | both of which improve code readability: (1) All curly braces are vertically aligned: 21 | ```r 22 | this <- function () 23 | { 24 | x <- 1 25 | } 26 | ``` 27 | and **not** 28 | ```r 29 | this <- function(){ 30 | x <- 1 31 | } 32 | ``` 33 | and (2) Also highlighted in that code is the additional whitespace which 34 | permeates `osmplotr` code. Words of text are separated by whitespace, and so 35 | code words should be too: 36 | ```r 37 | this <- function1 (function2 (x)) 38 | ``` 39 | and **not** 40 | ```r 41 | this <- function1(function2(x)) 42 | ``` 43 | with the natural result that one ends up writing 44 | ```r 45 | this <- function () 46 | ``` 47 | with a space between `function` and `()`. That's it. 48 | 49 | 50 | ## Code of Conduct 51 | 52 | We want to encourage a warm, welcoming, and safe environment for contributing to 53 | this project. See the [code of 54 | conduct](https://github.com/ropensci/osmplotr/blob/master/CODE_OF_CONDUCT.md) 55 | for more information. 56 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: osmplotr 2 | Title: Bespoke Images of 'OpenStreetMap' Data 3 | Version: 0.3.5.022 4 | Authors@R: 5 | c(person(given = "Mark", 6 | family = "Padgham", 7 | role = c("aut", "cre"), 8 | email = "mark.padgham@email.com"), 9 | person(given = "Richard", 10 | family = "Beare", 11 | role = "aut"), 12 | person(given = "Finkelstein", 13 | family = "Noam", 14 | role = c("ctb", "cph"), 15 | comment = "Author of included stub.R code"), 16 | person(given = "Bartnik", 17 | family = "Lukasz", 18 | role = c("ctb", "cph"), 19 | comment = "Author of included stub.R code")) 20 | Description: Bespoke images of 'OpenStreetMap' ('OSM') data and data 21 | visualisation using 'OSM' objects. 22 | License: GPL-3 23 | URL: https://docs.ropensci.org/osmplotr/, 24 | https://github.com/ropensci/osmplotr 25 | BugReports: https://github.com/ropensci/osmplotr/issues 26 | Depends: 27 | R (>= 3.2.3) 28 | Imports: 29 | e1071, 30 | ggm, 31 | ggplot2, 32 | mapproj, 33 | methods, 34 | osmdata, 35 | sf, 36 | sfheaders, 37 | sp, 38 | spatstat (>= 2.0-0), 39 | spatstat.explore, 40 | spatstat.geom 41 | Suggests: 42 | curl, 43 | knitr, 44 | magrittr, 45 | markdown, 46 | rmarkdown, 47 | testthat 48 | VignetteBuilder: 49 | knitr 50 | Encoding: UTF-8 51 | LazyData: true 52 | RoxygenNote: 7.3.2 53 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(add_axes) 4 | export(add_colourbar) 5 | export(add_osm_groups) 6 | export(add_osm_objects) 7 | export(add_osm_surface) 8 | export(adjust_colours) 9 | export(colour_mat) 10 | export(connect_highways) 11 | export(extract_osm_objects) 12 | export(get_bbox) 13 | export(make_osm_map) 14 | export(osm_basemap) 15 | export(osm_line2poly) 16 | export(osm_structures) 17 | export(print_osm_map) 18 | import(spatstat) 19 | importFrom(ggplot2,aes) 20 | importFrom(ggplot2,coord_map) 21 | importFrom(ggplot2,element_blank) 22 | importFrom(ggplot2,element_rect) 23 | importFrom(ggplot2,geom_label) 24 | importFrom(ggplot2,geom_path) 25 | importFrom(ggplot2,geom_point) 26 | importFrom(ggplot2,geom_polygon) 27 | importFrom(ggplot2,geom_segment) 28 | importFrom(ggplot2,geom_tile) 29 | importFrom(ggplot2,ggplot) 30 | importFrom(ggplot2,margin) 31 | importFrom(ggplot2,scale_colour_gradientn) 32 | importFrom(ggplot2,scale_fill_gradientn) 33 | importFrom(ggplot2,scale_x_continuous) 34 | importFrom(ggplot2,scale_y_continuous) 35 | importFrom(ggplot2,theme_minimal) 36 | importFrom(ggplot2,unit) 37 | importFrom(grDevices,col2rgb) 38 | importFrom(grDevices,dev.cur) 39 | importFrom(grDevices,dev.new) 40 | importFrom(grDevices,heat.colors) 41 | importFrom(grDevices,rainbow) 42 | importFrom(grDevices,rgb) 43 | importFrom(graphics,lines) 44 | importFrom(graphics,par) 45 | importFrom(graphics,plot) 46 | importFrom(graphics,plot.new) 47 | importFrom(graphics,rect) 48 | importFrom(graphics,text) 49 | importFrom(mapproj,mapproject) 50 | importFrom(methods,hasArg) 51 | importFrom(methods,is) 52 | importFrom(methods,slot) 53 | importFrom(stats,runif) 54 | importFrom(utils,combn) 55 | importFrom(utils,head) 56 | importFrom(utils,setTxtProgressBar) 57 | importFrom(utils,tail) 58 | importFrom(utils,txtProgressBar) 59 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | 2 | osmplotr v0.3.3.X (dev) 3 | =============== 4 | 5 | Minor changes 6 | ------- 7 | 8 | - Replace now obsolete 'spatstat.core' to 'spatstat.explore' dependency 9 | 10 | 11 | osmplotr v0.3.3 12 | =============== 13 | 14 | Minor changes 15 | ------- 16 | - Changes in response to `spatstat` v2 updates 17 | 18 | Minor changes 19 | ------- 20 | - 'add_osm_surface' functions changed to directly calculate and plot colours of 21 | objects, rather than rely on `ggplot2::scale_fill_gradientn`. 22 | 23 | osmplotr v0.3.2 24 | =============== 25 | 26 | Minor changes 27 | ------- 28 | * 'verbose' parameter of 'extract_osm_objects' renamed to 'quiet' 29 | 30 | osmplotr v0.3.1 31 | =============== 32 | 33 | Major changes 34 | ------- 35 | * New function 'osm_line2poly' enables plotting polygonal shapes delineated only 36 | by lines, through tracing around the bounding box to form full polygons. 37 | * New vignette to describe this functionality, "maps-with-ocean". 38 | 39 | Minor changes 40 | ------- 41 | * 'osm_basemap' now accepts an 'sf' object instead of explicit 'bbox' values, 42 | and extracts the corresponding 'bbox' directly from that object. 43 | 44 | 45 | osmplotr v0.3.0 46 | =============== 47 | 48 | Major changes 49 | ------- 50 | * Major re-structure to use 'osmdata' package instead of 'osmar', with 51 | concomitantly enormous increase in speed of 'extract_osm_objects' 52 | * Package is now also 'sf'-compatible: objects to be plotted can be either 'sp' 53 | or 'sf' format, with all 'osmplotr' functions defaulting to 'sf' 54 | 55 | Minor changes 56 | ------- 57 | * Title in DESCRIPTION changed from "Customisable Images of OpenStreetMap Data" 58 | to "Bespoke Images of 'OpenStreetMap' Data" 59 | * Better control of timeout errors when calling the overpass API 60 | * Git host transferred from ropenscilabs to ropensci 61 | * Acknowledge OSM contributors on startup 62 | * Rename 'borderWidth' parameter of 'add_osm_groups' to 'border_width' 63 | * 'connect_highways' also entirely re-coded to be much more efficient, but 64 | this should not affect functionality at all. 65 | 66 | osmplotr v0.2.3 67 | =============== 68 | 69 | * add 'return_type' argument to 'extract_osm_objects' to enable explicit 70 | specification of return type (points, lines, polygons) 71 | * fix tests so they pass even if download fails 72 | 73 | osmplotr v0.2.2 74 | =============== 75 | 76 | * 'add_osm_surface' did not previously work properly for different bboxes 77 | (and so zooming was not possible). Now fixed. 78 | * both 'add_osm_surface' and 'add_osm_groups' now enable maps to be zoomed 79 | * fix make_osm_map to produce maps even when not all requested data exists 80 | 81 | osmplotr v0.2.1 82 | =============== 83 | 84 | * vignette 'making-maps' renamed 'basic-maps' and tidied 85 | * vignette 'making-maps-with-data' renamed 'data-maps' and tidied 86 | * 'plot_osm_basemap' renamed 'osm_basemap', and now uses 87 | 'ggplot2::coord_equal()' to ensure maps are scaled to bounding boxes. 88 | * 'print_osm_map' added to enable device proportions to be automatically scaled 89 | to bounding boxes. 90 | * manual entries cleaned up to remove non-exported functions 91 | 92 | osmplotr v0.2.0 93 | =============== 94 | 95 | Major update with (almost) all plotting routines shifted from 'graphics::plot' 96 | to 'ggplot2'. All previous parameters specifying graphics devices (such as 97 | heights and widths) no longer apply. 98 | 99 | Changes: 100 | 101 | * vignette 'downloading-data' removed (incorporate in 'making-maps') 102 | * vignette 'making-maps' extended 103 | * vignette 'making-maps-with-data' added 104 | * Extensive examples added to most functions 105 | * 'click_map' removed 106 | * 'connect_highways' renamed 'get_highway_cycle' 107 | * 'highways2polygon' renamed 'connect_highways' 108 | * 'extract_highway', 'extract_highways', 'order_lines' no longer exported 109 | * 'extract_osm_objects' now just returns objects (instead of '$obj' and 110 | '$warn'), and dumps warnings direct to screen. 111 | * 'add_osm_groups' now accepts lists of simple spatial points as groups 112 | * Coordinate reference system properly attributed to all objects 113 | * many tests added 114 | * Change to 'ggplot2' has considerably changed structure of many functions. For 115 | details see function examples and vignettes 116 | 117 | 118 | osmplotr v0.1-3 119 | =============== 120 | 121 | Changes: 122 | 123 | * added 'add_axes' to plot lat-lon axes 124 | * added 'add_osm_surface' to spatially interpolate continuous surfaces from 125 | user-defined data 126 | * added 'add_colourbar' to plot a colourbar legend for 'add_osm_surface' 127 | * renamed 'group_osm_objects' to 'add_osm_groups' 128 | * added 'adjust_colours' to allow colours to be lightened or darkened 129 | * all usages of 'xylims' (vectors of four components) and 'get_xylims' changed 130 | to 'bbox' (2-by-2 matrices) for consistency with sp and tmap 131 | * reduce size of 'london' data (through smaller bbox), with corresponding 132 | changes in vignettes 133 | 134 | osmplotr v0.1-1, 0.1-2 135 | ================= 136 | 137 | Published on CRAN 138 | -------------------------------------------------------------------------------- /R/add-osm-objects.R: -------------------------------------------------------------------------------- 1 | #' add_osm_objects 2 | #' 3 | #' Adds layers of spatial objects (polygons, lines, or points generated by 4 | #' \code{\link{extract_osm_objects}}) to a graphics object initialised with 5 | #' \code{\link{osm_basemap}}. 6 | #' 7 | #' @param map A \code{ggplot2} object to which the objects are to be added. 8 | #' @param obj A spatial (\code{sp}) data frame of polygons, lines, or points, 9 | #' typically as returned by \code{\link{extract_osm_objects}}. 10 | #' @param col Colour of lines or points; fill colour of polygons. 11 | #' @param border Border colour of polygons. 12 | #' @param hcol (Multipolygons only) Vector of fill colours for holes 13 | #' @param size Linewidth argument passed to \code{ggplot2} (polygon, path, 14 | #' point) functions: determines width of lines for (polygon, line), and sizes of 15 | #' points. Respective defaults are (0, 0.5, 0.5). 16 | #' @param shape Shape of points or lines (the latter passed as \code{linetype}); 17 | #' see \code{\link[ggplot2]{shape}}. 18 | #' @return modified version of \code{map} to which objects have been added. 19 | #' @importFrom ggplot2 geom_polygon geom_path aes geom_point 20 | #' 21 | #' @seealso \code{\link{osm_basemap}}, \code{\link{extract_osm_objects}}. 22 | #' 23 | #' @examples 24 | #' bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 25 | #' map <- osm_basemap (bbox = bbox, bg = "gray20") 26 | #' 27 | #' \dontrun{ 28 | #' # The 'london' data used below were downloaded as: 29 | #' dat_BNR <- extract_osm_objects ( 30 | #' bbox = bbox, 31 | #' key = "building", 32 | #' value = "!residential" 33 | #' ) 34 | #' dat_HP <- extract_osm_objects ( 35 | #' bbox = bbox, 36 | #' key = "highway", 37 | #' value = "primary" 38 | #' ) 39 | #' dat_T <- extract_osm_objects (bbox = bbox, key = "tree") 40 | #' } 41 | #' map <- add_osm_objects ( 42 | #' map, 43 | #' obj = london$dat_BNR, 44 | #' col = "gray40", 45 | #' border = "yellow" 46 | #' ) 47 | #' map <- add_osm_objects ( 48 | #' map, 49 | #' obj = london$dat_HP, 50 | #' col = "gray80", 51 | #' size = 1, shape = 2 52 | #' ) 53 | #' map <- add_osm_objects ( 54 | #' map, 55 | #' london$dat_T, 56 | #' col = "green", 57 | #' size = 2, shape = 1 58 | #' ) 59 | #' print_osm_map (map) 60 | #' 61 | #' # Polygons with different coloured borders 62 | #' map <- osm_basemap (bbox = bbox, bg = "gray20") 63 | #' map <- add_osm_objects (map, obj = london$dat_HP, col = "gray80") 64 | #' map <- add_osm_objects (map, london$dat_T, col = "green") 65 | #' map <- add_osm_objects (map, 66 | #' obj = london$dat_BNR, col = "gray40", 67 | #' border = "yellow", size = 0.5 68 | #' ) 69 | #' print_osm_map (map) 70 | #' @family construction 71 | #' @export 72 | 73 | add_osm_objects <- function (map, obj, col = "gray40", border = NA, hcol, 74 | size, shape) { 75 | 76 | # --------------- sanity checks and warnings --------------- 77 | check_map_arg (map) 78 | check_obj_arg (obj) 79 | check_col_arg (col) 80 | if (length (col) == 0) { 81 | stop ("a non-null col must be provided") 82 | } 83 | check_col_arg (border) 84 | # --------------- end sanity checks and warnings --------------- 85 | 86 | obj_type <- get_obj_type (obj) 87 | # Then a couple more checks using obj_type: 88 | shape <- default_shape (obj_type, shape) 89 | size <- default_size (obj_type, size) 90 | 91 | lon <- lat <- id <- NULL # suppress 'no visible binding' error 92 | 93 | 94 | if (obj_type == "multipolygon") { # sf 95 | 96 | for (i in seq_len (nrow (obj))) { 97 | 98 | # xy <- lapply (obj$geometry [[i]], function (i) i [[1]]) 99 | xy <- obj$geometry [[i]] [[1]] 100 | # if only one polygon in multipolygon, which can happen: 101 | if (!is.list (xy)) { 102 | xy <- list (xy) 103 | } 104 | xy <- list2df (xy) 105 | xy1 <- xy [which (xy$id == 1), ] 106 | xy_not1 <- xy [which (xy$id != 1), ] 107 | 108 | map <- map + 109 | ggplot2::geom_polygon ( 110 | ggplot2::aes (group = id), 111 | data = xy1, 112 | linewidth = size, 113 | fill = col, 114 | colour = border 115 | ) 116 | 117 | if (nrow (xy_not1) > 0) { 118 | 119 | if (missing (hcol)) { 120 | hcol <- map$theme$panel.background$fill 121 | } 122 | hcol <- rep (hcol, length.out = length (unique (xy_not1$id))) 123 | hcols <- NULL 124 | ids <- unique (xy_not1$id) 125 | for (i in seq (ids)) { 126 | 127 | n <- length (which (xy_not1$id == ids [i])) 128 | hcols <- c (hcols, rep (hcol [i], n)) 129 | } 130 | map <- map + 131 | ggplot2::geom_polygon ( 132 | ggplot2::aes (group = id), 133 | data = xy_not1, 134 | fill = hcols 135 | ) 136 | } 137 | } 138 | } else if (grepl ("polygon", obj_type)) { 139 | 140 | xy <- geom_to_xy (obj, obj_type) 141 | xy <- list2df (xy) 142 | map <- map + 143 | ggplot2::geom_polygon ( 144 | ggplot2::aes (group = id), 145 | data = xy, 146 | linewidth = size, 147 | fill = col, 148 | colour = border 149 | ) 150 | } else if (grepl ("line", obj_type)) { 151 | 152 | xy <- geom_to_xy (obj, obj_type) 153 | xy <- list2df (xy, islines = TRUE) 154 | map <- map + 155 | ggplot2::geom_path ( 156 | data = xy, 157 | ggplot2::aes (x = lon, y = lat), 158 | colour = col, 159 | linewidth = size, 160 | linetype = shape 161 | ) 162 | } else if (grepl ("point", obj_type)) { 163 | 164 | xy <- geom_to_xy (obj, obj_type) 165 | map <- map + 166 | ggplot2::geom_point ( 167 | data = xy, 168 | ggplot2::aes (x = lon, y = lat), 169 | col = col, 170 | size = size, 171 | shape = shape 172 | ) 173 | } else { 174 | stop ("obj is not a spatial class") 175 | } 176 | 177 | return (map) 178 | } 179 | 180 | #' list2df 181 | #' 182 | #' Converts lists of coordinates to single data frames 183 | #' 184 | #' @param xy A list of coordinates extracted from an sp object 185 | #' @param islines Set to TRUE for spatial lines, otherwise FALSE 186 | #' @return data frame 187 | #' 188 | #' @noRd 189 | list2df <- function (xy, islines = FALSE) { 190 | 191 | if (islines) { # lines have to be separated by NAs 192 | xy <- lapply (xy, function (i) rbind (i, rep (NA, 2))) 193 | } else { # Add id column to each: 194 | for (i in seq (xy)) { 195 | xy [[i]] <- cbind (i, xy [[i]]) 196 | } 197 | } 198 | # multiline/polygon names can be very long, prompting a strange R warning 199 | # when rbind'ing them, so 200 | names (xy) <- NULL 201 | # And rbind them to a single matrix. 202 | xy <- do.call (rbind, xy) 203 | # And then to a data.frame, for which duplicated row names flag warnings 204 | # which are not relevant, so are suppressed by specifying new row names 205 | xy <- data.frame (xy, row.names = seq_len (nrow (xy))) 206 | if (islines) { # remove terminal row of NAs 207 | xy <- xy [1:(nrow (xy) - 1), ] 208 | } else { 209 | names (xy) <- c ("id", "lon", "lat") 210 | } 211 | return (xy) 212 | } 213 | 214 | #' convert shape to default values dependent on class of obj 215 | #' 216 | #' @noRd 217 | default_shape <- function (obj_type, shape) { 218 | 219 | shape_default <- NULL 220 | if (grepl ("line", obj_type)) { 221 | shape_default <- 1 222 | } else if (grepl ("point", obj_type)) { 223 | shape_default <- 19 224 | } 225 | 226 | ret <- NULL 227 | if (!is.null (shape_default)) { 228 | 229 | if (!missing (shape)) { 230 | 231 | if (!is.numeric (shape)) { 232 | warning ( 233 | "shape should be numeric; defaulting to ", 234 | shape_default 235 | ) 236 | } else if (shape < 0) { 237 | warning ( 238 | "shape should be positive; defaulting to ", 239 | shape_default 240 | ) 241 | } 242 | } 243 | ret <- shape_default 244 | } 245 | 246 | return (ret) 247 | } 248 | 249 | #' convert size to default values dependent on class of obj 250 | #' 251 | #' @noRd 252 | default_size <- function (obj, size) { 253 | 254 | size_default <- 0 255 | if (!grepl ("polygon", get_obj_type (obj))) { 256 | size_default <- 0.5 257 | } 258 | 259 | if (missing (size)) { 260 | size <- size_default 261 | } else if (!is.numeric (size)) { 262 | 263 | warning ("size should be numeric; defaulting to ", size_default) 264 | size <- size_default 265 | } else if (size < 0) { 266 | 267 | warning ("size should be positive; defaulting to ", size_default) 268 | size <- size_default 269 | } 270 | 271 | return (size) 272 | } 273 | 274 | #' return geometries of sf/sp objects as lists of matrices 275 | #' 276 | #' @noRd 277 | geom_to_xy <- function (obj, obj_type) { 278 | 279 | if (obj_type == "polygon") { # sf 280 | xy <- lapply (obj$geometry, function (i) i [[1]]) 281 | } else if (obj_type == "linestring") { # sf 282 | xy <- lapply (obj$geometry, function (i) as.matrix (i)) 283 | } else if (obj_type == "point") { # sf 284 | 285 | xy <- data.frame (do.call (rbind, lapply (obj$geometry, as.numeric))) 286 | names (xy) <- c ("lon", "lat") 287 | } else if (obj_type %in% c ("polygons", "lines")) { # sp 288 | xy <- lapply (slot (obj, obj_type), function (x) { 289 | slot (slot (x, cap_first (obj_type)) [[1]], "coords") 290 | }) 291 | } else if (obj_type == "points") { # sp 292 | xy <- data.frame (slot (obj, "coords")) 293 | } 294 | 295 | return (xy) 296 | } 297 | -------------------------------------------------------------------------------- /R/adjust-colours.R: -------------------------------------------------------------------------------- 1 | #' adjust_colours 2 | #' 3 | #' Adjusts a given colour by lightening or darkening it by the specified amount 4 | #' (relative scale of -1 to 1). Adjustments are made in RGB space, for 5 | #' limitations of which see \code{?convertColor} 6 | #' 7 | #' @param cols A vector of \code{R} colours (for allowable formats of which, see 8 | #' \code{?col2rgb}). 9 | #' @param adj A number between -1 and 1 determining how much to lighten 10 | #' (positive values) or darken (negative values) the colours. 11 | #' @param plot If \code{TRUE}, generates a plot to allow visual comparison of 12 | #' original and adjusted colours. 13 | #' @return Corresponding vector of adjusted colours (as hexadecimal strings). 14 | #' 15 | #' @seealso \code{\link{osm_structures}}, \code{?col2rgb}. 16 | #' 17 | #' @examples 18 | #' cols <- adjust_colours (cols = heat.colors (10), adj = -0.2, plot = TRUE) 19 | #' 20 | #' # 'adjust_colours' also offers an easy way to adjust the default colour 21 | #' # schemes provided by 'osm_structures'. The following lines darken the 22 | #' # highway colour of the 'light' colour scheme by 20% 23 | #' structures <- osm_structures ( 24 | #' structures = c ("building", "highway", "park"), 25 | #' col_scheme = "light" 26 | #' ) 27 | #' structures$cols [2] <- adjust_colours (structures$cols [2], adj = -0.2) 28 | #' # Plot these structures: 29 | #' bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 30 | #' \dontrun{ 31 | #' dat_B <- extract_osm_objects (key = "building", bbox = bbox) 32 | #' dat_H <- extract_osm_objects (key = "highway", bbox = bbox) 33 | #' dat_P <- extract_osm_objects (key = "park", bbox = bbox) 34 | #' } 35 | #' # These data are also included in the 'london' data of 'osmplotr' 36 | #' osm_data <- list ( 37 | #' dat_B = london$dat_BNR, 38 | #' dat_H = london$dat_HP, 39 | #' dat_P = london$dat_P 40 | #' ) 41 | #' dat <- make_osm_map ( 42 | #' structures = structures, 43 | #' osm_data = osm_data, 44 | #' bbox = bbox 45 | #' ) 46 | #' print_osm_map (dat$map) 47 | #' @family colours 48 | #' @export 49 | 50 | 51 | adjust_colours <- function (cols, adj = 0, plot = FALSE) { 52 | 53 | # --------------- sanity checks and warnings --------------- 54 | check_col_arg (cols) 55 | if (length (cols) == 0) { 56 | stop ("cols must be non-null") 57 | } 58 | if (!methods::is (cols [1], "matrix")) { 59 | cols <- col2rgb (cols) 60 | } 61 | # ---------- adj 62 | adj <- check_arg (adj, "adj", "numeric") 63 | if (is.character (adj)) { 64 | stop (adj) 65 | } else if (adj < -1 || adj > 1) { 66 | stop ("adj must be between -1 and 1") 67 | } 68 | # ---------- plot 69 | plot <- check_arg (plot, "plot", "logical") 70 | if (is.na (plot)) { 71 | stop ("plot can not be coerced to logical") 72 | } 73 | # --------------- end sanity checks and warnings --------------- 74 | 75 | cols_old <- apply (cols, 2, function (x) { 76 | rgb (x [1], x [2], x [3], maxColorValue = 255) 77 | }) 78 | 79 | if (adj > 0) { 80 | cols <- cols + adj * (255 - cols) 81 | } else { 82 | cols <- cols + adj * cols 83 | } 84 | cols <- apply (cols, 2, function (x) { 85 | rgb (x [1], x [2], x [3], maxColorValue = 255) 86 | }) 87 | 88 | if (plot) { 89 | adj_colours_plot (cols, cols_old) 90 | } 91 | 92 | return (cols) 93 | } # end function colour.mat 94 | 95 | adj_colours_plot <- function (cols, cols_old) { 96 | 97 | n <- length (cols) 98 | plot.new () 99 | par (mar = rep (0, 4)) 100 | graphics::plot (NULL, NULL, 101 | xlim = c (0, n), ylim = c (0, 2), 102 | xaxs = "i", yaxs = "i" 103 | ) 104 | for (i in seq (n)) { 105 | 106 | rect (i - 1, 1, i, 2, col = cols_old [i], border = NA) 107 | rect (i - 1, 0, i, 1, col = cols [i], border = NA) 108 | } 109 | rect (0, 1.4, n, 1.6, col = rgb (1, 1, 1, 0.5), border = NA) 110 | text (n / 2, 1.5, labels = "old") 111 | rect (0, 0.4, n, 0.6, col = rgb (1, 1, 1, 0.5), border = NA) 112 | text (n / 2, 0.5, labels = "new") 113 | } 114 | -------------------------------------------------------------------------------- /R/check-fns.R: -------------------------------------------------------------------------------- 1 | check_map_arg <- function (map) { 2 | 3 | if (missing (map)) { 4 | stop ("a non-null map must be provided", call. = FALSE) 5 | } 6 | if (!is (map, "ggplot")) { 7 | stop ("map must be a ggplot2 object", call. = FALSE) 8 | } 9 | } 10 | 11 | #' get type of geometry object from either sf or sp objects 12 | #' 13 | #' @note \code{sf} objects return singular nouns ('polygon', 'point'), while 14 | #' \code{sp} return plurals ('polygons', 'points') 15 | #' 16 | #' @noRd 17 | get_obj_type <- function (obj) { 18 | 19 | if (is (obj, "sf")) { 20 | 21 | if (!inherits (obj$geometry, "sfc")) { 22 | warning ( 23 | "object class is sf, but the geometry column class is '", 24 | toString (class (obj$geometry)), 25 | "' instead of 'sfc'.\n", 26 | "This can occur e.g. after subsetting sf objects ", 27 | "without the sf package loaded." 28 | ) 29 | } 30 | i <- which (grepl ("sfc_", class (obj$geometry))) 31 | obj_type <- tolower (strsplit ( 32 | class (obj$geometry) [i], 33 | "sfc_" 34 | ) [[1]] [2]) 35 | } else { 36 | 37 | obj_type <- tolower (strsplit ( 38 | strsplit ( 39 | class (obj), 40 | "Spatial" 41 | ) [[1]] [2], 42 | "DataFrame" 43 | ) [[1]] [1]) 44 | } 45 | 46 | return (obj_type) 47 | } 48 | 49 | 50 | #' capitalise first letter of word 51 | #' 52 | #' @note does same as stringi::stri_trans_totitle 53 | #' 54 | #' @noRd 55 | cap_first <- function (x) { 56 | 57 | paste0 (toupper (substring (x, 1, 1)), substring (x, 2, nchar (x))) 58 | } 59 | 60 | check_obj_arg <- function (obj) { 61 | 62 | if (missing (obj)) { 63 | stop ("obj must be provided", call. = FALSE) 64 | } 65 | if (!(is (obj, "Spatial") || is (obj, "sf"))) { 66 | stop ("obj must be a spatial object", call. = FALSE) 67 | } 68 | } 69 | 70 | check_col_arg <- function (col) { 71 | 72 | if (missing (col)) { 73 | stop ("a non-null col must be provided") 74 | } 75 | 76 | # Note col2rbg (NA) = white 77 | tryCatch ( 78 | col2rgb (col), 79 | error = function (e) { 80 | 81 | e$message <- paste0 ("Invalid colour: ", col) 82 | stop (e) 83 | } 84 | ) 85 | } 86 | 87 | check_bbox_arg <- function (bbox) { 88 | 89 | if (missing (bbox)) { 90 | stop ("bbox must be provided") 91 | } 92 | if (is (bbox, "sf")) { # sf obj submitted to osm_basemap 93 | 94 | if (is (bbox$geometry, "sfc_LINESTRING") || 95 | is (bbox$geometry, "sfc_POINT")) { 96 | xy <- do.call (rbind, bbox$geometry) 97 | } else if (is (bbox$geometry, "sfc_POLYGON")) { 98 | xy <- do.call (rbind, lapply (bbox$geometry, function (i) i [[1]])) 99 | } else if (is (bbox$geometry, "sfc_MULTIPOLYGON") || 100 | is (bbox$geometry, "sfc_MULTILINESTRING")) { 101 | xy <- do.call (rbind, lapply ( 102 | bbox$geometry, 103 | function (i) i [[1]] [[1]] 104 | )) 105 | } 106 | bbox <- t (apply (xy, 2, range)) 107 | rownames (bbox) <- c ("x", "y") 108 | colnames (bbox) <- c ("min", "max") 109 | } 110 | if (!is.numeric (bbox)) { 111 | stop ("bbox is not numeric") 112 | } 113 | if (length (bbox) < 4) { 114 | stop ("bbox must have length = 4") 115 | } 116 | if (length (bbox) > 4) { 117 | 118 | warning ("bbox has length > 4; only first 4 elements will be used") 119 | bbox <- matrix (bbox [1:4], 2, 2) 120 | } 121 | 122 | return (bbox) 123 | } 124 | 125 | check_structures_arg <- function (structures) { 126 | 127 | if (!missing (structures)) { 128 | 129 | if (!is.data.frame (structures)) { 130 | stop ("structures must be a data frame") 131 | } 132 | ns <- c ("structure", "key", "value", "suffix", "cols") 133 | if (!all (names (structures) == ns)) { 134 | stop ("structures not in recognised format") 135 | } 136 | } 137 | } 138 | 139 | #' generic function to check argument conversion to given function type 140 | #' 141 | #' @noRd 142 | check_arg <- function (arg, arg_name, fn_type, na_okay = FALSE) { 143 | 144 | if (missing (arg)) { 145 | stop (paste (arg_name, "must be provided")) 146 | } else if (length (arg) == 0) { 147 | stop (paste (arg_name, "can not be NULL")) 148 | } else if (!na_okay && is.na (arg)) { 149 | stop (paste (arg_name, "can not be NA")) 150 | } 151 | 152 | adj <- tryCatch ( 153 | do.call (paste0 ("as.", fn_type), list (arg)), 154 | warning = function (w) { 155 | 156 | w$message <- paste ( 157 | arg_name, 158 | "can not be coerced to", 159 | fn_type 160 | ) 161 | } 162 | ) 163 | 164 | invisible (adj) 165 | } 166 | -------------------------------------------------------------------------------- /R/colour-mat.R: -------------------------------------------------------------------------------- 1 | #' colour_mat 2 | #' 3 | #' Generates a 2D matrix of graduated colours by interpolating between the given 4 | #' colours specifying the four corners. 5 | #' 6 | #' @param cols vector of length >= 4 of colors (example, default = \code{rainbow 7 | #' (4)}, or \code{RColorBrewer::brewer.pal (4, 'Set1')}). 8 | #' \code{cols} are wrapped clockwise around the corners from top left to bottom 9 | #' left. 10 | #' @param n number of rows and columns of colour matrix (default = 10; if length 11 | #' 2, then dimensions of rectangle). 12 | #' @param rotate rotates the entire colour matrix by the specified angle (in 13 | #' degrees). 14 | #' @param plot plots the colour matrix. 15 | #' @return \code{Matrix} of colours. 16 | #' 17 | #' @seealso \code{\link{add_osm_groups}}. 18 | #' 19 | #' @examples 20 | #' cm <- colour_mat (n = 5, cols = rainbow (4), rotate = 90, plot = TRUE) 21 | #' 22 | #' # 'colour_mat' is intended primarily for use in colouring groups added with 23 | #' # 'add_osm_groups' using the 'colmat = TRUE' option: 24 | #' bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 25 | #' # Generate random points to serve as group centres 26 | #' set.seed (2) 27 | #' ngroups <- 6 28 | #' x <- bbox [1, 1] + runif (ngroups) * diff (bbox [1, ]) 29 | #' y <- bbox [2, 1] + runif (ngroups) * diff (bbox [2, ]) 30 | #' groups <- cbind (x, y) 31 | #' groups <- sfheaders::sf_point (groups) 32 | #' # plot a basemap and add groups 33 | #' map <- osm_basemap (bbox = bbox, bg = "gray20") 34 | #' map <- add_osm_groups (map, 35 | #' obj = london$dat_BNR, group = groups, 36 | #' cols = rainbow (4), colmat = TRUE, rotate = 90 37 | #' ) 38 | #' print_osm_map (map) 39 | #' @family colours 40 | #' @export 41 | 42 | colour_mat <- function (cols, n = c (10, 10), rotate = NULL, plot = FALSE) { 43 | 44 | # --------------- sanity checks and warnings --------------- 45 | cols <- colourmat_input_cols (cols) 46 | n <- colourmat_input_n (n) 47 | rotate <- colourmat_input_rotate (rotate) 48 | # --------------- end sanity checks and warnings --------------- 49 | 50 | if (!is.null (rotate)) { 51 | cols <- rotate_colourmat (cols, rotate) 52 | } 53 | 54 | tl <- cols [, 1] # top left 55 | tr <- cols [, 2] # top right 56 | br <- cols [, 3] # bottom right 57 | bl <- cols [, 4] # bottom left 58 | # Then interpolate, starting with top and bottom rows 59 | ih <- t (array (seq (n [2]) - 1, dim = c (n [2], 3))) / (n [2] - 1) 60 | top <- (1 - ih) * tl + ih * tr 61 | bot <- (1 - ih) * bl + ih * br 62 | arr <- array (NA, dim = n) 63 | col_arrs <- list (r = arr, g = arr, b = arr) 64 | for (i in seq (3)) { 65 | 66 | col_arrs [[i]] [1, ] <- top [i, ] 67 | col_arrs [[i]] [n [1], ] <- bot [i, ] 68 | } 69 | # Then fill intervening rows 70 | indx <- (seq (n [1]) - 1) / (n [1] - 1) 71 | for (i in seq (3)) { 72 | col_arrs [[i]] <- apply (col_arrs [[i]], 2, function (x) { 73 | (1 - indx) * x [1] + indx * tail (x, 1) 74 | }) 75 | } 76 | # Then fill the actual colourmat with RGB colours composed of the 3 indices: 77 | carr <- array (rgb (col_arrs [[1]], col_arrs [[2]], col_arrs [[3]], 78 | maxColorValue = 255 79 | ), dim = n) 80 | 81 | if (plot) { 82 | plot_colourmat (carr) 83 | } 84 | 85 | return (carr) 86 | } # end function colour.mat 87 | 88 | colourmat_input_cols <- function (cols) { 89 | 90 | if (missing (cols)) stop ("cols must be provided") 91 | if (is.null (cols)) { 92 | return (NULL) 93 | } else if (length (cols) < 4) { 94 | stop ("cols must have length >= 4") 95 | } 96 | if (any (is.na (cols))) stop ("One or more cols is NA") 97 | if (!methods::is (cols, "matrix")) { 98 | 99 | cols <- sapply (cols, function (i) { 100 | tryCatch ( 101 | col2rgb (i), 102 | error = function (e) { 103 | 104 | e$message <- paste0 ("Invalid colours: ", i) 105 | } 106 | ) 107 | }) 108 | } else if (rownames (cols) != c ("red", "green", "blue")) { 109 | stop ("Colour matrix has unknown format") 110 | } 111 | if (any (grep ("Invalid colours", cols))) { 112 | stop (cols [grep ("Invalid colours", cols) [1]]) 113 | } 114 | 115 | indx <- floor (1:4 * ncol (cols) / 4) 116 | indx [1] <- 1 117 | cols <- cols [, indx] 118 | 119 | return (cols) 120 | } 121 | 122 | colourmat_input_n <- function (n) { 123 | 124 | if (length (n) == 1) { 125 | n <- rep (n, 2) 126 | } 127 | if (!all (is.numeric (n))) stop ("n must be numeric") 128 | if (any (is.na (n))) stop ("n can not be NA") 129 | if (any (n < 2)) stop ("n must be > 1") 130 | 131 | return (n) 132 | } 133 | 134 | colourmat_input_rotate <- function (rotate = NULL) { 135 | 136 | if (!is.null (rotate)) { 137 | 138 | if (length (rotate) > 1) { 139 | 140 | warning ("rotate has length > 1; using only first element") 141 | rotate <- rotate [1] 142 | } 143 | if (!is.numeric (rotate)) stop ("rotate must be numeric") 144 | if (is.na (rotate)) stop ("rotate can not be NA") 145 | } 146 | 147 | return (rotate) 148 | } 149 | 150 | rotate_colourmat <- function (cols, rotate) { 151 | 152 | # rotation generally lowers RGB values, so they are increased following 153 | # rotation according to the following value: 154 | max_int <- max (cols) 155 | 156 | while (rotate < 0) { 157 | rotate <- rotate + 360 158 | } 159 | while (rotate > 360) { 160 | rotate <- rotate - 360 161 | } 162 | 163 | cols <- cbind (cols, cols) 164 | 165 | # Clockwise rotation shifts the top left to the top right, meaning the 166 | # index of four colours must move *down* or *to the left* of cols 167 | i <- floor (rotate / 90) # number of columns to move 168 | i1 <- 1:4 - i 169 | if (min (i1) < 1) { 170 | i1 <- i1 + 4 171 | } 172 | i2 <- i1 + 1 173 | x <- (rotate %% 90) / 360 174 | cols <- (1 - x) * cols [, i1] + x * cols [, i2] 175 | cols <- apply (cols, 2, function (x) { 176 | 177 | if (max (x) == 0) { 178 | rep (0, 3) 179 | } else { 180 | x * max_int / max (x) 181 | } 182 | }) 183 | 184 | return (cols) 185 | } 186 | 187 | plot_colourmat <- function (carr) { 188 | 189 | plot.new () 190 | par (mar = rep (0, 4)) 191 | plot (NULL, NULL, 192 | xlim = c (0, dim (carr) [2]), 193 | ylim = c (0, dim (carr) [1]) 194 | ) 195 | for (i in seq (dim (carr) [1])) { 196 | for (j in seq (dim (carr) [2])) { 197 | rect (j - 1, i - 1, j, i, col = carr [i, j]) 198 | } 199 | } 200 | } 201 | -------------------------------------------------------------------------------- /R/extract-highways.R: -------------------------------------------------------------------------------- 1 | #' extract_highways 2 | #' 3 | #' Extracts a list of named OpenStreetMap highways. OSM data are neither 4 | #' structured nor ordered; this routine reduces data for each given highway to a 5 | #' minimal number of discrete and sequentially ordered segments. These segments 6 | #' may or may not connect, yet can be connected at their nearest points with 7 | #' \code{get_highway_cycle}. 8 | #' 9 | #' @param highway_names A vector of highway names passed directly to the 10 | #' Overpass API. Wildcards and whitespaces are `.'; for other options see 11 | #' overpass help. 12 | #' @param bbox the bounding box for the map. A 2-by-2 matrix of 4 elements with 13 | #' columns of min and max values, and rows of x and y values. 14 | #' @return A list of highways matching \code{highway_names} each element of 15 | #' which is a list of distinct components for the given highway. 16 | #' @return A \code{data.frame} of \code{sp} objects 17 | #' 18 | #' @noRd 19 | extract_highways <- function (highway_names, bbox) { 20 | 21 | if (missing (highway_names)) { 22 | stop ("A vector of highway names must be given") 23 | } 24 | if (missing (bbox)) { 25 | stop ("A bounding box must be given") 26 | } 27 | 28 | #----------Download OSM data for highways 29 | hw_abbrvs <- abbreviate_hwy_names (highway_names) 30 | dl_dat <- dl_hw_data (highway_names, hw_abbrvs, bbox) 31 | p4s <- dl_dat$p4s 32 | if (length (dl_dat$indx) < length (highway_names)) { 33 | 34 | hw_abbrvs <- hw_abbrvs [dl_dat$indx] 35 | highway_names <- highway_names [dl_dat$indx] 36 | } 37 | 38 | 39 | #---------Extract coordinates 40 | ways <- list () 41 | for (i in seq (highway_names)) { 42 | 43 | wi <- lapply ( 44 | get (hw_abbrvs [i])$geometry, 45 | function (i) as.matrix (i) 46 | ) 47 | ways [[i]] <- order_lines (wi) 48 | } 49 | names (ways) <- hw_abbrvs 50 | 51 | attr (ways, "crs") <- p4s 52 | 53 | return (ways) 54 | } 55 | 56 | abbreviate_hwy_names <- function (highway_names, nletters = 2) { 57 | 58 | hw_abbrvs <- sapply (highway_names, function (x) { 59 | tolower (substring (x, 1, nletters)) 60 | }) 61 | while (any (duplicated (hw_abbrvs))) { 62 | 63 | nletters <- nletters + 1 64 | hw_abbrvs <- sapply (highway_names, function (x) { 65 | tolower (substring (x, 1, nletters)) 66 | }) 67 | } 68 | 69 | return (hw_abbrvs) 70 | } 71 | 72 | dl_hw_data <- function (highway_names, hw_abbrvs, bbox) { 73 | 74 | message ("Downloading OSM data ...") 75 | p4s <- NULL 76 | lens_old <- length (highway_names) 77 | lens <- 0 78 | # in case download does not work, this will try again until same data are 79 | # returned twice in a row 80 | while (lens != lens_old) { 81 | 82 | indx <- NULL 83 | pb <- txtProgressBar (max = 1, style = 3) 84 | # style = 3 shows start and end positions 85 | for (i in seq (highway_names)) { 86 | 87 | dat <- extract_highway (name = highway_names [i], bbox = bbox) 88 | if (!is.null (dat)) { 89 | if (nrow (dat) > 0) { 90 | 91 | assign (hw_abbrvs [i], value = dat, envir = parent.frame ()) 92 | indx <- c (indx, i) 93 | } 94 | } 95 | setTxtProgressBar (pb, i / length (highway_names)) 96 | } 97 | lens <- rep (0, length (indx)) 98 | for (i in seq (indx)) { 99 | lens [i] <- nrow (get (hw_abbrvs [indx] [i], 100 | envir = parent.frame () 101 | )) 102 | } 103 | 104 | lens <- length (which (lens > 0)) # total number returning data 105 | if (lens > 0) { 106 | 107 | hw1 <- hw_abbrvs [indx] [which (lens > 0)] [1] 108 | p4s <- attr ( 109 | get (hw1, envir = parent.frame ())$geometry, 110 | "crs" 111 | )$proj4string 112 | } 113 | rm (dat) 114 | close (pb) 115 | lens_old <- lens 116 | } 117 | if (lens == 0) { 118 | stop ("No data able to be extracted") 119 | } else if (lens < length (highway_names)) { 120 | message ("Unable to download all requested data.") 121 | } 122 | 123 | list ("p4s" = p4s, "indx" = indx) 124 | } 125 | 126 | 127 | #' extract_highway 128 | #' 129 | #' Extracts an OpenStreetMap highway by name, within the given bounding box. 130 | #' 131 | #' @param name Name of highway. Lines components are return for *any* OSM way 132 | #' with a partially-matched. Both wildcards and whitespace should be represented 133 | #' by `.'. 134 | #' @param bbox the bounding box for the map. A 2-by-2 matrix of 4 elements with 135 | #' columns of min and max values, and rows of x and y values. 136 | #' @return A \code{SpatialLinesDataFrame} containing the highway. 137 | #' 138 | #' @noRd 139 | extract_highway <- function (name = "", bbox) { 140 | 141 | check_arg (name, "name", "character") 142 | bbox <- check_bbox_arg (bbox) 143 | 144 | qry <- osmdata::opq (bbox = bbox) 145 | qry <- osmdata::add_osm_feature (qry, key = "highway") 146 | qry <- osmdata::add_osm_feature (qry, 147 | key = "name", value = name, 148 | key_exact = FALSE, value_exact = FALSE, 149 | match_case = FALSE 150 | ) 151 | 152 | osmdata::osmdata_sf (qry)$osm_lines 153 | } 154 | -------------------------------------------------------------------------------- /R/extract-osm-objects.R: -------------------------------------------------------------------------------- 1 | #' extract_osm_objects 2 | #' 3 | #' Downloads OSM XML objects and converts to \code{sp} objects 4 | #' (\code{SpatialPointsDataFrame}, \code{SpatialLinesDataFrame}, or 5 | #' \code{SpatialPolygonsDataFrame}). 6 | #' 7 | #' @param bbox the bounding box within which all key-value objects should be 8 | #' downloaded. A 2-by-2 matrix of 4 elements with columns of min and 9 | #' max values, and rows of x and y values. 10 | #' @param key OSM key to search for. Useful keys include \code{building}, 11 | #' \code{waterway}, \code{natural}, \code{grass}, \code{park}, \code{amenity}, 12 | #' \code{shop}, \code{boundary}, and \code{highway}. Others will be passed 13 | #' directly to the overpass API and may not necessarily return results. 14 | #' @param value OSM value to match to key. If \code{NULL}, all keys will be 15 | #' returned. Negation is specified by \code{!value}. 16 | #' @param extra_pairs A list of additional \code{key-value} pairs to be passed 17 | #' to the overpass API. 18 | #' @param return_type If specified, force return of spatial (\code{point}, 19 | #' \code{line}, \code{polygon}, \code{multiline}, \code{multipolygon}) objects. 20 | #' \code{return_type = 'line'} will, for example, always return a 21 | #' SpatialLinesDataFrame. If not specified, defaults to 'sensible' values (for 22 | #' example, \code{lines} for highways, \code{points} for trees, \code{polygons} 23 | #' for buildings). 24 | #' @param sf If \code{TRUE}, return Simple Features (\code{sf}) objects; 25 | #' otherwise Spatial (\code{sp}) objects. 26 | #' @param geom_only If \code{TRUE}, return only those OSM data describing the 27 | #' geometric object; otherwise return all data describing each object. 28 | #' @param quiet If \code{FALSE}, provides notification of progress. 29 | #' 30 | #' @return Either a \code{SpatialPointsDataFrame}, \code{SpatialLinesDataFrame}, 31 | #' or \code{SpatialPolygonsDataFrame}. 32 | #' 33 | #' @seealso \code{\link{add_osm_objects}}. 34 | #' 35 | #' @examples 36 | #' \dontrun{ 37 | #' bbox <- get_bbox (c (-0.13, 51.50, -0.11, 51.52)) 38 | #' dat_B <- extract_osm_objects (key = "building", bbox = bbox) 39 | #' dat_H <- extract_osm_objects (key = "highway", bbox = bbox) 40 | #' dat_BR <- extract_osm_objects ( 41 | #' key = "building", 42 | #' value = "residential", 43 | #' bbox = bbox 44 | #' ) 45 | #' dat_HP <- extract_osm_objects ( 46 | #' key = "highway", 47 | #' value = "primary", 48 | #' bbox = bbox 49 | #' ) 50 | #' dat_HNP <- extract_osm_objects ( 51 | #' key = "highway", 52 | #' value = "!primary", 53 | #' bbox = bbox 54 | #' ) 55 | #' extra_pairs <- c ("name", "Royal.Festival.Hall") 56 | #' dat <- extract_osm_objects ( 57 | #' key = "building", extra_pairs = extra_pairs, 58 | #' bbox = bbox 59 | #' ) 60 | #' } 61 | #' @family data-extraction 62 | #' @export 63 | extract_osm_objects <- function (bbox, key = NULL, value, extra_pairs, 64 | return_type, sf = TRUE, 65 | geom_only = FALSE, quiet = FALSE) { 66 | 67 | check_arg (key, "key", "character") 68 | 69 | bbox <- check_bbox_arg (bbox) 70 | if (!missing (value) && missing (key)) { 71 | stop ("key must be provided for value") 72 | } 73 | 74 | qkv <- get_q_key_vals (key, value, extra_pairs) 75 | q_keys <- qkv$key 76 | q_vals <- qkv$vals 77 | 78 | # default to non-exact matches 79 | qry <- osmdata::opq (bbox = bbox) 80 | for (i in seq (q_keys)) { 81 | 82 | key_exact <- FALSE 83 | if (!is.na (q_vals [i]) && substring (q_vals [i], 1, 1) == "!") { 84 | key_exact <- TRUE 85 | } 86 | if (is.na (q_vals [i])) { 87 | qry <- osmdata::add_osm_feature (qry, 88 | key = q_keys [i], 89 | key_exact = key_exact, 90 | value_exact = FALSE, 91 | match_case = FALSE 92 | ) 93 | } else { 94 | qry <- osmdata::add_osm_feature (qry, 95 | key = q_keys [i], 96 | value = q_vals [i], 97 | key_exact = key_exact, 98 | value_exact = FALSE, 99 | match_case = FALSE 100 | ) 101 | } 102 | } 103 | 104 | if (sf) { 105 | obj <- osmdata::osmdata_sf (qry, quiet = quiet) 106 | } else { 107 | obj <- osmdata::osmdata_sp (qry, quiet = quiet) 108 | } 109 | 110 | obj <- get_obj_from_return_type (obj, return_type, q_keys, q_vals) 111 | 112 | if (NROW (obj) == 0) { 113 | warning ( 114 | "No valid data returned. ", 115 | "(Maybe try a different 'return_type')" 116 | ) 117 | } 118 | 119 | if (geom_only) { 120 | 121 | if (sf) { 122 | 123 | indx <- match (c ("osm_id", "geometry"), names (obj)) 124 | obj <- obj [, indx] 125 | } else { 126 | 127 | attr (obj, "data") <- NULL 128 | } 129 | } 130 | 131 | return (obj) 132 | } 133 | 134 | get_q_key_vals <- function (key, value, extra_pairs) { 135 | 136 | q_keys <- key 137 | if (missing (value)) { 138 | q_vals <- NA 139 | } else { 140 | q_vals <- value 141 | # If primary value is negation, then repeat primary key 142 | if (substring (q_vals, 1, 1) == "!") { 143 | 144 | q_keys <- rep (q_keys, 2) 145 | q_vals <- c (NA, q_vals) 146 | } 147 | } 148 | 149 | 150 | if (!missing (extra_pairs)) { 151 | 152 | if (!is.list (extra_pairs)) { 153 | extra_pairs <- list (extra_pairs) 154 | } 155 | nprs <- vapply (extra_pairs, length, 1L) 156 | if (!all (nprs %in% 1:2)) { 157 | stop ("Extra pairs must be just keys or key-val pairs") 158 | } 159 | 160 | q_keys <- c ( 161 | q_keys, 162 | vapply (extra_pairs, function (x) x [1], character (1)) 163 | ) 164 | q_vals <- c ( 165 | q_vals, 166 | vapply (extra_pairs, function (x) x [2], character (1)) 167 | ) 168 | } 169 | 170 | val_list <- c ("grass", "park", "tree", "water") 171 | key_list <- c ("landuse", "leisure", "natural", "natural") 172 | indx <- which (q_keys %in% val_list) 173 | if (length (indx) > 0) { 174 | 175 | indx2 <- match (q_keys [indx], val_list) 176 | q_keys [indx] <- key_list [indx2] 177 | q_vals [indx] <- val_list [indx2] 178 | } 179 | 180 | return (list (keys = q_keys, vals = q_vals)) 181 | } 182 | 183 | get_obj_from_return_type <- function (obj, return_type, q_keys, q_vals) { 184 | 185 | if (!missing (return_type)) { 186 | 187 | return_type <- tolower (return_type) 188 | if (substring (return_type, 1, 3) == "poi") { 189 | obj <- obj$osm_points 190 | } else if (substring (return_type, 1, 1) == "l") { 191 | obj <- obj$osm_lines 192 | } else if (substring (return_type, 1, 6) == "multil") { 193 | obj <- obj$osm_multilines 194 | } else if (substring (return_type, 1, 6) == "multip") { 195 | obj <- obj$osm_multipolygons 196 | } else { 197 | obj <- obj$osm_polygons 198 | } 199 | } else { 200 | 201 | if ("highway" %in% q_keys) { 202 | obj <- obj$osm_lines 203 | } else if ("building" %in% q_keys || "landuse" %in% q_keys || 204 | "leisure" %in% q_keys || 205 | ("natural" %in% q_keys && "water" %in% q_vals)) { 206 | obj <- obj$osm_polygons 207 | } else if ("route" %in% q_keys) { 208 | obj <- obj$osm_multilines 209 | } else if ("boundary" %in% q_keys || "waterway" %in% q_keys) { 210 | obj <- obj$osm_multipolygons 211 | } else if ("natural" %in% q_keys && "tree" %in% q_vals) { 212 | obj <- obj$osm_points 213 | } else { 214 | 215 | message (paste0 ( 216 | "Cannot determine return_type;", 217 | " maybe specify explicitly?" 218 | )) 219 | obj <- obj$osm_lines 220 | } 221 | } 222 | } 223 | -------------------------------------------------------------------------------- /R/get-bbox.R: -------------------------------------------------------------------------------- 1 | #' get_bbox 2 | #' 3 | #' Converts a string of latitudes and longitudes into a square matrix to be 4 | #' passed as a \code{bbox} argument (to \code{\link{extract_osm_objects}}, 5 | #' \code{\link{osm_basemap}}, or \code{\link{make_osm_map}}). 6 | #' 7 | #' @param latlon A vector of (longitude, latitude, longitude, latitude) values. 8 | #' @return A 2-by-2 matrix of 4 elements with columns of min and max values, and 9 | #' rows of x and y values. 10 | #' 11 | #' @examples 12 | #' bbox <- get_bbox (c (-0.15, 51.5, -0.1, 51.52)) 13 | #' @family data-extraction 14 | #' @export 15 | get_bbox <- function (latlon) { 16 | 17 | if (missing (latlon)) { 18 | stop ("latlon must be supplied") 19 | } 20 | if (!is.numeric (latlon)) { 21 | stop ("latlon is not numeric") 22 | } 23 | if (length (latlon) < 4) { 24 | stop ("latlon must have length = 4") 25 | } 26 | if (length (latlon) > 4) { 27 | 28 | warning ("latlon has length > 4; only first 4 elements will be used") 29 | latlon <- latlon [1:4] 30 | } 31 | 32 | if (latlon [1] > latlon [3]) latlon [c (1, 3)] <- latlon [c (3, 1)] 33 | if (latlon [2] > latlon [4]) latlon [c (2, 4)] <- latlon [c (4, 2)] 34 | 35 | bbox <- matrix (latlon, nrow = 2, ncol = 2) 36 | rownames (bbox) <- c ("x", "y") 37 | bbox <- data.frame (bbox) 38 | names (bbox) <- c ("min", "max") 39 | as.matrix (bbox) 40 | } 41 | -------------------------------------------------------------------------------- /R/get-highway-cycle.R: -------------------------------------------------------------------------------- 1 | #' get_highway_cycle 2 | #' 3 | #' Takes a list of OpenStreetMap highways returned by 4 | #' \code{\link{extract_highways}} and sequentially connects closest nodes of 5 | #' adjacent highways until the set of highways connects to form a cycle. 6 | #' 7 | #' Proceeds through the following 3 steps: 8 | #' (1) Add intersection nodes to junctions of ways where these don't already 9 | #' exist 10 | #' (2) Fill a connectivity matrix between all highways and extract the *longest* 11 | #' cycle connecting them all 12 | #' (3) Insert extra connections between highways until the longest cycle == 13 | #' length (highways). 14 | #' 15 | #' @param ways A list of highways as returned by 16 | #' \code{\link{extract_highways}}, each element of which is a list of distinct 17 | #' segments for a particular OSM highway. 18 | #' 19 | #' @return A modified version of ways, extended by the addition of 20 | #' connecting nodes. 21 | #' 22 | #' @noRd 23 | get_highway_cycle <- function (ways) { 24 | 25 | conmat <- get_conmat (ways) 26 | cycles <- try (ggm::fundCycles (conmat), TRUE) 27 | if (is (attr (cycles, "condition"), "simpleError")) { 28 | cycles <- NULL 29 | } 30 | 31 | cyc_len <- 0 32 | if (!is.null (cycles)) { 33 | cyc_len <- max (sapply (cycles, nrow)) 34 | } 35 | n <- length (ways) 36 | # i1_ref and i2_ref are index matricex of [from, to] 37 | i1_ref <- array (1:n, dim = c (n, n)) 38 | i2_ref <- t (i1_ref) 39 | i1_ref <- i1_ref [upper.tri (i1_ref)] 40 | i2_ref <- i2_ref [upper.tri (i2_ref)] 41 | while (cyc_len < length (ways)) { 42 | 43 | es <- extend_cycles (conmat, i1_ref, i2_ref) 44 | 45 | if (all (is.na (es$cyc_len))) { 46 | 47 | warning ("No cycles can be found or made") 48 | break 49 | } else if (max (es$cyc_len, na.rm = TRUE) <= cyc_len) { 50 | 51 | warning ("Cycle unable to be extended through all ways", 52 | call. = FALSE 53 | ) 54 | break 55 | } else { 56 | 57 | if (length (es$i1) > 1) { 58 | es <- closest_cycle_connection (ways, es) 59 | } 60 | cyc_len <- es$cyc_len 61 | } 62 | 63 | ways <- connect_two_ways (ways, es) 64 | conmat <- get_conmat (ways) 65 | cycles <- try (ggm::fundCycles (conmat), TRUE) 66 | if (!is.null (cycles)) { 67 | cyc_len <- max (sapply (cycles, nrow)) 68 | } 69 | } # end while cyc_len < length (ways) 70 | 71 | return (ways) 72 | } 73 | 74 | 75 | #' extend_cycles 76 | #' 77 | #' Find lengths of cycles formed by adding all possible single individual links 78 | #' in a conmat and return the connection that gives the longest conmat. 79 | #' 80 | #' @note There is no check for the proximity of potentially connected lines 81 | #' here, so it may theoretically occur that this routine will suggest shortcuts 82 | #' across large distances. 83 | #' 84 | #' @noRd 85 | extend_cycles <- function (conmat, i1, i2) { 86 | 87 | conmat_tri <- conmat [upper.tri (conmat)] 88 | indx <- which (!conmat_tri) 89 | conmat_tri <- conmat_tri [indx] 90 | i1 <- i1 [indx] 91 | i2 <- i2 [indx] 92 | # Then connect each in turn and get length of cycle if formed 93 | cyc_len <- rep (NA, length (i1)) 94 | conmat_ref <- conmat 95 | for (i in seq (i1)) { 96 | 97 | conmat <- conmat_ref 98 | conmat [i1 [i], i2 [i]] <- TRUE 99 | conmat [i2 [i], i1 [i]] <- TRUE 100 | cycles <- try (ggm::fundCycles (conmat), TRUE) 101 | if (is (attr (cycles, "condition"), "simpleError")) { 102 | cycles <- NULL 103 | } 104 | if (!is.null (cycles)) { 105 | cyc_len [i] <- max (sapply (cycles, nrow)) 106 | } 107 | } 108 | 109 | indx <- which (cyc_len == max (cyc_len)) 110 | 111 | return (list ( 112 | "cyc_len" = max (cyc_len), "i1" = i1 [indx], 113 | "i2" = i2 [indx] 114 | )) 115 | } 116 | 117 | # when extend_cycle returns multiple options, this returns the single option 118 | # as the two ways that are the closest together. 119 | closest_cycle_connection <- function (ways, es) { 120 | 121 | d <- rep (NA, length (es$i1)) 122 | for (i in seq (es$i1)) { 123 | 124 | way1 <- do.call (rbind, ways [[es$i1 [i]]]) # nolint 125 | way2 <- do.call (rbind, ways [[es$i2 [i]]]) # nolint 126 | d [i] <- haversine (way1, way2) [3] 127 | } 128 | es$i1 <- es$i1 [which.min (d)] 129 | es$i2 <- es$i2 [which.min (d)] 130 | 131 | return (es) 132 | } 133 | 134 | #' connect_two_ways 135 | #' 136 | #' @param ways A list of highways as returned by \code{\link{extract_highways}}, 137 | #' each element of which is a list of distinct segments for a particular OSM 138 | #' highway. 139 | #' @param es Result of call to \code{extend_cycles} 140 | #' @return Modified version of ways with a new connection that maximises the 141 | #' length of the cycle given in \code{es} 142 | #' 143 | #' @noRd 144 | connect_two_ways <- function (ways, es) { 145 | 146 | wi1 <- ways [[es$i1]] 147 | wi2 <- ways [[es$i2]] 148 | dmat <- array (NA, dim = c (length (wi1), length (wi2))) 149 | for (i in seq_along (wi1)) { 150 | for (j in seq_along (wi2)) { 151 | dmat [i, j] <- haversine (wi1 [[i]], wi2 [[j]]) [3] 152 | } 153 | } 154 | indx <- which (dmat == min (dmat), arr.ind = TRUE) [1, ] # there may be > 1 155 | 156 | hs <- haversine (wi1 [[indx [1]]], wi2 [[indx [2]]]) # nolint 157 | 158 | # Then insert one node in ways [[i1]] 159 | new_node <- wi2 [[indx [2]]] [hs [2], , drop = FALSE] # nolint 160 | wi11 <- wi1 [[indx [1]]] # nolint 161 | wi11 <- rbind ( 162 | wi11 [1:(hs [1] - 1), , drop = FALSE], # nolint 163 | new_node, 164 | wi11 [hs [1]:nrow (wi11), , drop = FALSE] 165 | ) # nolint 166 | 167 | ways [[es$i1]] [[indx [1]]] <- wi11 # nolint 168 | 169 | return (ways) 170 | } 171 | -------------------------------------------------------------------------------- /R/make-osm-map.R: -------------------------------------------------------------------------------- 1 | #' make_osm_map 2 | #' 3 | #' Makes an entire OSM map for the given bbox using the submitted data, or by 4 | #' downloading data if none submitted. This is a convenience function enabling 5 | #' an entire map to be produced according to the graphical format specified with 6 | #' the \code{structures} argument. 7 | #' 8 | #' @param bbox The bounding box for the map. A 2-by-2 matrix of 4 elements with 9 | #' columns of min and max values, and rows of x and y values. If \code{NULL}, 10 | #' \code{bbox} is taken from the largest extent of OSM objects in 11 | #' \code{osm_data}. 12 | #' @param osm_data A list of OSM objects as returned from 13 | #' \code{\link{extract_osm_objects}}. These objects may be included in the plot 14 | #' without downloading. These should all be named with the stated 15 | #' \code{dat_prefix} and have suffixes as given in \code{structures}. 16 | #' @param structures A \code{data.frame} specifying types of OSM structures as 17 | #' returned from \code{\link{osm_structures}}, and potentially modified to alter 18 | #' lists of structures to be plotted, and their associated colours. Objects are 19 | #' overlaid on plot according to the order given in \code{structures}. 20 | #' @param dat_prefix Prefix for data structures (default \code{dat_}). Final 21 | #' data structures are created by appending the suffixes from 22 | #' \code{\link{osm_structures}}. 23 | #' @return List of two components: 24 | #' \enumerate{ 25 | #' \item List of OSM structures each as 26 | #' \code{Spatial(Points/Lines/Polygons)DataFrame} and appended to 27 | #' \code{osm_data} (which is \code{NULL} by default), and 28 | #' \item The \code{map} as a \code{ggplot2} object 29 | #' } 30 | #' 31 | #' @section Note: 32 | #' If \code{osm_data} is not given, then data will be downloaded, which can take 33 | #' some time. Progress is dumped to screen. 34 | #' 35 | #' @seealso \code{\link{osm_basemap}}, \code{\link{add_osm_objects}}. 36 | #' 37 | #' @examples 38 | #' structures <- c ("highway", "park") 39 | #' structs <- osm_structures (structures = structures, col_scheme = "light") 40 | #' # make_osm_map returns potentially modified list of data using the provided 41 | #' # 'london' data for highways and parks. 42 | #' dat <- make_osm_map (osm_data = london, structures = structs) 43 | #' # or download data automatically using a defined bounding boox 44 | #' bbox <- get_bbox (c (-0.14, 51.51, -0.12, 51.52)) 45 | #' \donttest{ 46 | #' dat <- make_osm_map (bbox = bbox, structures = structs) 47 | #' print_osm_map (dat$map) 48 | #' } 49 | #' @family construction 50 | #' @export 51 | make_osm_map <- function (bbox, osm_data, 52 | structures = osm_structures (), dat_prefix = "dat_") { 53 | 54 | if (missing (bbox)) { 55 | bbox <- get_bbox_from_data (osm_data) 56 | } 57 | 58 | sfx <- structures$suffix [1:(nrow (structures) - 1)] 59 | if (missing (osm_data)) { 60 | 61 | structs_new <- seq (nrow (structures) - 1) 62 | osm_data <- list () 63 | } else { 64 | structs_new <- which (!sapply (sfx, function (i) { 65 | any (paste0 (dat_prefix, i) %in% names (osm_data)) 66 | })) 67 | } 68 | 69 | if (length (structs_new) > 0) { 70 | 71 | md <- get_missing_osm_data ( 72 | osm_data, structures [structs_new, ], 73 | bbox, dat_prefix 74 | ) 75 | 76 | indx <- c (md$indx, nrow (structures)) 77 | structures <- structures [indx, ] 78 | osm_data <- c (osm_data, md$osm_data) 79 | } 80 | ns <- nrow (structures) - 1 # last row is background 81 | if (ns == 0) { 82 | stop ("Downloads contain no data") 83 | } 84 | 85 | bg <- structures$col [structures$structure == "background"] 86 | map <- osm_basemap (bbox = bbox, bg = bg) 87 | for (i in seq (ns)) { 88 | 89 | obji <- paste0 ("dat_", structures$suffix [i]) 90 | map <- add_osm_objects (map, osm_data [[obji]], 91 | col = structures$cols [i] 92 | ) 93 | } 94 | 95 | list (osm_data = osm_data, map = map) 96 | } 97 | 98 | get_bbox_from_data <- function (osm_data) { 99 | 100 | if (missing (osm_data)) { 101 | stop ("Either bounding box or osm_data must be given") 102 | } 103 | bbox <- matrix (c (Inf, Inf, -Inf, -Inf), nrow = 2, ncol = 2) 104 | rownames (bbox) <- c ("x", "y") 105 | sp_classes <- c ( 106 | "SpatialLinesDataFrame", 107 | "SpatialPolygonsDataFrame", 108 | "SpatialPointsDataFrame" 109 | ) 110 | for (i in osm_data) { 111 | 112 | if (is (i, "sf")) { 113 | 114 | bbi <- attr (i$geometry, "bbox") 115 | if (bbi [1] < bbox [1, 1]) bbox [1, 1] <- bbi [1] 116 | if (bbi [2] < bbox [2, 1]) bbox [2, 1] <- bbi [2] 117 | if (bbi [1] > bbox [1, 2]) bbox [1, 2] <- bbi [1] 118 | if (bbi [2] > bbox [2, 2]) bbox [2, 2] <- bbi [2] 119 | } else if (any (class (i) %in% sp_classes)) { 120 | 121 | bbi <- slot (i, "bbox") 122 | if (bbi [1, 1] < bbox [1, 1]) bbox [1, 1] <- bbi [1, 1] 123 | if (bbi [2, 1] < bbox [2, 1]) bbox [2, 1] <- bbi [2, 1] 124 | if (bbi [1, 2] > bbox [1, 2]) bbox [1, 2] <- bbi [1, 2] 125 | if (bbi [2, 2] > bbox [2, 2]) bbox [2, 2] <- bbi [2, 2] 126 | } 127 | } 128 | 129 | return (bbox) 130 | } 131 | 132 | get_missing_osm_data <- function (osm_data, structures, bbox, dat_prefix) { 133 | 134 | message ( 135 | "Downloading and extracting OSM data for ", 136 | nrow (structures), " structures ..." 137 | ) 138 | pb <- txtProgressBar (max = 1, style = 3) 139 | t0 <- proc.time () 140 | indx <- NULL 141 | for (i in seq_len (nrow (structures))) { 142 | 143 | if (structures$value [i] == "") { 144 | dat <- extract_osm_objects ( 145 | key = structures$key [i], 146 | bbox = bbox 147 | ) 148 | } else { 149 | dat <- extract_osm_objects ( 150 | key = structures$key [i], 151 | value = structures$value [i], 152 | bbox = bbox 153 | ) 154 | } 155 | 156 | if (nrow (dat) > 0) { 157 | 158 | fname <- paste0 (dat_prefix, structures$suffix [i]) 159 | assign (fname, dat) 160 | osm_data [[fname]] <- get (fname) 161 | indx <- c (indx, i) 162 | } 163 | setTxtProgressBar (pb, i / nrow (structures)) 164 | } 165 | close (pb) 166 | message ("That took ", (proc.time () - t0) [3], "s\n", sep = "") 167 | 168 | list ("indx" = indx, "osm_data" = osm_data) 169 | } 170 | -------------------------------------------------------------------------------- /R/order-lines.R: -------------------------------------------------------------------------------- 1 | #' order_lines 2 | #' 3 | #' Accepts a single way as list of matrices representing an OpenStreetMap line 4 | #' object such as a highway. The list items of these objects are arbitrarily 5 | #' organised within OpenStreetMap. This function orders the components, 6 | #' returning a list of components each of which is ordered sequentially along 7 | #' the line. This list itself may contain several components where individual 8 | #' highway components either branch or are discrete. 9 | #' 10 | #' @param sp_lines A \code{SpatialLinesDataFrame} returned from 11 | #' \code{extract_osm_objects}. 12 | #' @return A list of ordered line segments. 13 | #' 14 | #' @section Note: 15 | #' This function is primarily used in \code{extract_highways}. 16 | #' 17 | #' @noRd 18 | order_lines <- function (xy) { 19 | 20 | xy_ord <- list (xy [[1]]) 21 | xy [[1]] <- NULL 22 | while (length (xy) > 0) { 23 | 24 | ex <- extend_ord_list (xy, xy_ord) 25 | xy <- ex$xy 26 | xy_ord <- ex$xy_ord 27 | } 28 | 29 | return (xy_ord) 30 | } 31 | 32 | extend_ord_list <- function (xy, xy_ord) { 33 | 34 | fn <- "head" 35 | ordi <- which_ord (xy_ord, xy, fn) 36 | if (ordi == 0) { 37 | 38 | fn <- "tail" 39 | ordi <- which_ord (xy_ord, xy, fn) 40 | } 41 | 42 | if (ordi > 0) { 43 | 44 | xy_ordi <- xy_ord [[ordi]] 45 | # xy_ordi is element of xy_ord that has either the head or tail of xy 46 | 47 | xyi <- which (which_xy (xy = xy, xy_ordi = xy_ordi, fn = fn)) [1] 48 | # [1] in case of mulitple matches 49 | 50 | xtmp <- xy [[xyi]] 51 | xy [[xyi]] <- NULL 52 | xy_ord [[ordi]] <- rbind_xy (xtmp, xy_ordi) 53 | } else { # no join so add first element of xy to xy_ord_list 54 | 55 | xy_ord [[length (xy_ord) + 1]] <- xy [[1]] 56 | xy [[1]] <- NULL 57 | } 58 | 59 | return (list ("xy" = xy, "xy_ord" = xy_ord)) 60 | } 61 | 62 | # which element of xy_ord contains head or tail element of any component of xy. 63 | # xy_ord has muliple list items only when a single highway has distinct or 64 | # branching components. This fn finds which component the element xy is to be 65 | # added to. 66 | # 67 | # @return single int index into xy_ord 68 | which_ord <- function (xy_ord, xy, fn = "head") { 69 | 70 | max (0, which (vapply (xy_ord, function (i) { 71 | max (0, which_xy (i, xy = xy, fn = fn)) 72 | }, numeric (1)) > 0)) 73 | } 74 | 75 | # which element of xy has head or tail of xy_ord [[i]] 76 | # 77 | # @return logical vector same length as xy 78 | which_xy <- function (xy, xy_ordi, fn = "head") { 79 | 80 | vapply (xy, function (i) { 81 | do.call (fn, list (rownames (xy_ordi), 1)) %in% rownames (i) 82 | }, logical (1)) 83 | } 84 | 85 | #' rbind_xy 86 | #' 87 | #' rbind xy to xy_ordi, flipping both where necessary 88 | #' 89 | #' @noRd 90 | rbind_xy <- function (xy, xy_ord) { 91 | 92 | if (head (rownames (xy_ord), 1) %in% rownames (xy)) { 93 | xy_ord <- apply (xy_ord, 2, rev) 94 | } # flip to rbind at bottom 95 | if (tail (rownames (xy), 1) %in% rownames (xy_ord)) { 96 | xy <- apply (xy, 2, rev) 97 | } # flip to rbind at top 98 | 99 | # rownames don't carry if xy only has 2 rows - tibble it? 100 | xynm <- rownames (xy) [2:nrow (xy)] 101 | xy <- matrix (xy [2:nrow (xy), ], ncol = 2) 102 | rownames (xy) <- xynm 103 | rbind (xy_ord, xy) 104 | } 105 | -------------------------------------------------------------------------------- /R/osm-basemap.R: -------------------------------------------------------------------------------- 1 | #' osm_basemap 2 | #' 3 | #' Generates a base OSM plot ready for polygon, line, and point objects to be 4 | #' overlain with \code{\link{add_osm_objects}}. 5 | #' 6 | #' @param bbox bounding box (Latitude-longitude range) to be plotted. A 2-by-2 7 | #' matrix of 4 elements with columns of min and max values, and rows of x and y 8 | #' values. Can also be an object of class \code{sf}, for example as returned 9 | #' from \code{extract_osm_objects} or the \code{osmdata} package, in which case 10 | #' the bounding box will be extracted from the object coordinates. 11 | #' @param structures Data frame returned by \code{\link{osm_structures}} used 12 | #' here to specify background colour of plot; if missing, the colour is 13 | #' specified by \code{bg}. 14 | #' @param bg Background colour of map (default = \code{gray20}) only if 15 | #' \code{structs} not given). 16 | #' @return A \code{ggplot2} object containing the base \code{map}. 17 | #' @importFrom ggplot2 ggplot coord_map aes scale_x_continuous 18 | #' scale_y_continuous theme_minimal element_rect element_blank margin unit 19 | #' @importFrom mapproj mapproject 20 | #' 21 | #' @seealso \code{\link{add_osm_objects}}, \code{\link{make_osm_map}}. 22 | #' 23 | #' @examples 24 | #' bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 25 | #' map <- osm_basemap (bbox = bbox, bg = "gray20") 26 | #' map <- add_osm_objects (map, london$dat_BNR, col = "gray40") 27 | #' print_osm_map (map) 28 | #' @family construction 29 | #' @export 30 | osm_basemap <- function (bbox, structures, bg = "gray20") { 31 | 32 | # --------------- sanity checks and warnings --------------- 33 | bbox <- check_bbox_arg (bbox) 34 | if (!missing (structures)) { 35 | 36 | check_structures_arg (structures) 37 | bg <- structure$cols [which (structures$structure == "background")] 38 | } 39 | check_col_arg (bg) 40 | if (length (bg) > 1) { 41 | 42 | warning ("bg has length > 1; only first element will be used") 43 | bg <- bg [1] 44 | } 45 | # --------------- end sanity checks and warnings --------------- 46 | 47 | map_theme <- set_map_theme (bg = bg) 48 | 49 | lon <- lat <- NA 50 | map <- ggplot2::ggplot () + 51 | map_theme + 52 | ggplot2::coord_map ( 53 | xlim = range (bbox [1, ]), 54 | ylim = range (bbox [2, ]) 55 | ) + 56 | ggplot2::aes (x = lon, y = lat) + 57 | ggplot2::scale_x_discrete (expand = c (0, 0)) + 58 | ggplot2::scale_y_discrete (expand = c (0, 0)) 59 | 60 | return (map) 61 | } 62 | 63 | set_map_theme <- function (bg) { 64 | 65 | theme <- ggplot2::theme_minimal () 66 | theme$panel.background <- ggplot2::element_rect (fill = bg, linewidth = 0) # nolint 67 | theme$line <- ggplot2::element_blank () 68 | theme$axis.text <- ggplot2::element_blank () # nolint 69 | theme$axis.title <- ggplot2::element_blank () # nolint 70 | theme$plot.margin <- ggplot2::margin (rep (ggplot2::unit (0, "null"), 4)) 71 | theme$plot.margin <- ggplot2::margin (rep (ggplot2::unit (-0.5, "line"), 4)) 72 | theme$legend.position <- "none" # nolint 73 | theme$axis.ticks.length <- ggplot2::unit (0, "null") # nolint 74 | 75 | return (theme) 76 | } 77 | -------------------------------------------------------------------------------- /R/osm-structures.R: -------------------------------------------------------------------------------- 1 | #' osm_structures 2 | #' 3 | #' For the given vector of structure types returns a \code{data.frame} 4 | #' containing two columns of corresponding OpenStreetMap \code{key-value} pairs, 5 | #' one column of unambiguous suffixes to be appended to the objects returned by 6 | #' \code{\link{extract_osm_objects}}, and one column specifying colours. This 7 | #' \code{data.frame} may be subsequently modified as desired, and ultimately 8 | #' passed to \code{\link{make_osm_map}} to automate map production. 9 | #' 10 | #' @param structures The vector of types of structures (defaults listed in 11 | #' \code{\link{extract_osm_objects}}). 12 | #' @param col_scheme Colour scheme for the plot (current options include 13 | #' \code{dark} and \code{light}). 14 | #' @return \code{data.frame} of structures, \code{key-value} pairs, 15 | #' corresponding prefixes, and colours. 16 | #' 17 | #' 18 | #' @seealso \code{\link{make_osm_map}}. 19 | #' 20 | #' @examples 21 | #' # Default structures: 22 | #' osm_structures () 23 | #' # user-defined structures: 24 | #' structures <- c ("highway", "park", "ameniiy", "tree") 25 | #' structs <- osm_structures (structures = structures, col_scheme = "light") 26 | #' # make_osm_map returns potentially modified list of data 27 | #' dat <- make_osm_map (osm_data = london, structures = structs) 28 | #' # map contains updated $osm_data and actual map in $map 29 | #' \donttest{ 30 | #' print_osm_map (dat$map) 31 | #' } 32 | #' @family construction 33 | #' @export 34 | osm_structures <- function (structures = c ( 35 | "building", "amenity", "waterway", 36 | "grass", "natural", "park", 37 | "highway", "boundary", "tree" 38 | ), 39 | col_scheme = "dark") { 40 | 41 | kv <- get_key_vals (structures) # key-val pairs 42 | 43 | # Get suffixes for naming data objects 44 | indx_in <- which (!duplicated (structures)) 45 | indx_out <- which (duplicated (structures)) 46 | lettrs <- sapply (structures [indx_in], function (x) { 47 | toupper (substr (x, 1, 1)) 48 | }) 49 | lettrs <- unique_suffixes (lettrs, structures, indx_in) 50 | suffixes <- extend_suffixes (lettrs, structures, indx_in, indx_out) 51 | 52 | scheme_cols <- NULL 53 | if (col_scheme == "dark") { 54 | scheme_cols <- get_dark_cols () 55 | } else if (col_scheme == "light") { 56 | scheme_cols <- get_light_cols () 57 | } 58 | 59 | if (!is.null (scheme_cols)) { 60 | cols <- set_cols (scheme_cols, structures) 61 | } 62 | 63 | # Then add row to designate background colour (this has to be done prior to 64 | # data.frame construction, because cols are converted there to factors): 65 | structures <- c (structures, "background") 66 | kv$keys <- c (kv$keys, "") 67 | kv$values <- c (kv$values, "") 68 | suffixes <- c (suffixes, "") 69 | cols <- c (cols, scheme_cols$col_bg) 70 | 71 | dat <- data.frame (cbind (structures, kv$keys, kv$values, suffixes, cols), 72 | stringsAsFactors = FALSE, 73 | row.names = seq_along (kv$keys) 74 | ) 75 | names (dat) <- c ("structure", "key", "value", "suffix", "cols") 76 | return (dat) 77 | } 78 | 79 | get_key_vals <- function (structures) { 80 | 81 | keys <- structures 82 | values <- rep ("", length (keys)) 83 | val_list <- c ("grass", "park", "tree", "water") 84 | key_list <- c ("landuse", "leisure", "natural", "natural") 85 | 86 | for (i in seq (val_list)) { 87 | if (any (structures == val_list [i])) { 88 | 89 | keys [structures == val_list [i]] <- key_list [i] 90 | values [structures == val_list [i]] <- val_list [i] 91 | } 92 | } 93 | 94 | return (list ("keys" = keys, "values" = values)) 95 | } 96 | 97 | get_dark_cols <- function () { 98 | 99 | list ( 100 | col_bg = "gray20", 101 | col_green = rgb (100, 120, 100, 255, maxColorValue = 255), 102 | col_green_bright = rgb (100, 160, 100, 255, maxColorValue = 255), 103 | col_blue = rgb (100, 100, 120, 255, maxColorValue = 255), 104 | col_gray1 = rgb (100, 100, 100, 255, maxColorValue = 255), 105 | col_gray2 = rgb (120, 120, 120, 255, maxColorValue = 255), 106 | col_white = rgb (200, 200, 200, 255, maxColorValue = 255), 107 | col_black = rgb (0, 0, 0, 255, maxColorValue = 255) 108 | ) 109 | } 110 | 111 | get_light_cols <- function () { 112 | 113 | list ( 114 | col_bg = "gray95", 115 | col_green = rgb (200, 220, 200, 255, maxColorValue = 255), 116 | col_green_bright = rgb (200, 255, 200, 255, maxColorValue = 255), 117 | col_blue = rgb (200, 200, 220, 255, maxColorValue = 255), 118 | col_gray1 = rgb (200, 200, 200, 255, maxColorValue = 255), 119 | col_gray2 = rgb (220, 220, 220, 255, maxColorValue = 255), 120 | col_white = rgb (255, 255, 255, 255, maxColorValue = 255), 121 | col_black = rgb (150, 150, 150, 255, maxColorValue = 255) 122 | ) 123 | } 124 | 125 | set_cols <- function (col_scheme, structures) { 126 | 127 | cols <- rep (col_scheme$col_bg, length (structures)) 128 | cols [structures == "building"] <- col_scheme$col_gray1 129 | cols [structures == "amenity"] <- col_scheme$col_gray2 130 | cols [structures == "waterway"] <- col_scheme$col_blue 131 | cols [structures == "natural"] <- col_scheme$col_green 132 | cols [structures == "park"] <- col_scheme$col_green 133 | cols [structures == "tree"] <- col_scheme$col_green_bright 134 | cols [structures == "grass"] <- col_scheme$col_green_bright 135 | cols [structures == "highway"] <- col_scheme$col_black 136 | cols [structures == "boundary"] <- col_scheme$col_white 137 | 138 | return (cols) 139 | } 140 | 141 | # Extend suffixes until sufficiently many letters are included for entries to 142 | # become unique. 143 | unique_suffixes <- function (sfx, structures, indx_in) { 144 | 145 | matches <- sapply (sfx, function (x) which (sfx %in% x)) 146 | nletts <- rep (2, length (matches)) 147 | # This while loop will always stop because it is only applied to unique 148 | # values 149 | while (max (sapply (matches, length)) > 1) { 150 | 151 | matches_red <- list () 152 | for (i in seq (matches)) { 153 | if (length (matches [[i]]) > 1 && 154 | !all (matches [[i]] %in% unlist (matches_red))) { 155 | matches_red [[length (matches_red) + 1]] <- matches [[i]] 156 | } 157 | } 158 | for (i in seq (matches_red)) { 159 | 160 | repls <- structures [indx_in] [matches_red [[i]]] # nolint 161 | sfx [matches_red [[i]]] <- toupper (substr ( 162 | repls, 1, # nolint 163 | nletts [matches_red [[i]]] 164 | )) # nolint 165 | nletts [matches_red [[i]]] <- nletts [matches_red [[i]]] + 1 # nolint 166 | } 167 | matches <- sapply (sfx, function (x) which (sfx %in% x)) 168 | } 169 | 170 | return (sfx) 171 | } 172 | 173 | # Extend list of unique suffixes to the full structures with duplicates. This 174 | # is a bit tricky, and is done by first creating an index of all duplicates: 175 | extend_suffixes <- function (sfx, structures, indx_in, indx_out) { 176 | 177 | indx <- which (duplicated (structures) | 178 | duplicated (structures, fromLast = TRUE)) 179 | # Then the values of that indx that are not in indx_out 180 | indx <- indx [!indx %in% indx_out] 181 | # And those two can be matched for the desired replacement 182 | suffixes <- rep (NULL, length (structures)) 183 | suffixes [indx_in] <- sfx 184 | for (i in indx) { 185 | 186 | ii <- which (structures == structures [i]) 187 | suffixes [ii] <- suffixes [i] 188 | } 189 | 190 | return (suffixes) 191 | } 192 | -------------------------------------------------------------------------------- /R/osmplotr.R: -------------------------------------------------------------------------------- 1 | #' osmplotr. 2 | #' 3 | #' Produces customisable images of OpenStreetMap (OSM) data and enables data 4 | #' visualisation using OSM objects. Extracts data using the overpass API. 5 | #' Contains the following functions, data, and vignettes. 6 | #' 7 | #' @section Data Functions: 8 | #' \itemize{ 9 | #' \item \code{\link{extract_osm_objects}}: Download arbitrary OSM objects 10 | #' \item \code{\link{connect_highways}}: Returns points sequentially connecting 11 | #' list of named highways 12 | #' } 13 | #' 14 | #' @section Basic Plotting Functions (without data): 15 | #' \itemize{ 16 | #' \item \code{\link{add_axes}}: Overlay longitudinal and latitudinal axes on 17 | #' plot 18 | #' \item \code{\link{add_osm_objects}}: Overlay arbitrary OSM objects 19 | #' \item \code{\link{make_osm_map}}: Automate map production with structures 20 | #' defined in \code{\link{osm_structures}} 21 | #' \item \code{\link{osm_structures}}: Define structures and graphics schemes 22 | #' for automating map production 23 | #' \item \code{\link{osm_basemap}}: Initiate a \code{ggplot2} object for an OSM 24 | #' map 25 | #' \item \code{\link{print_osm_map}}: Print a map to specified graphics 26 | #' device 27 | #' } 28 | #' 29 | #' @section Advanced Plotting Functions (with data): 30 | #' \itemize{ 31 | #' \item \code{\link{add_osm_groups}}: Overlay groups of objects using specified 32 | #' colour scheme 33 | #' \item \code{\link{add_osm_surface}}: Overlay data surface by interpolating 34 | #' given data 35 | #' \item \code{\link{add_colourbar}}: Overlay a scaled colourbar for data added 36 | #' with \code{\link{add_osm_surface}} 37 | #' } 38 | #' 39 | #' @section Colour Manipulation Functions: 40 | #' \itemize{ 41 | #' \item \code{\link{adjust_colours}}: Lighted or darken given colours by 42 | #' specified amount 43 | #' \item \code{\link{colour_mat}}: Generate continuous 2D spatial matrix of 44 | #' colours 45 | #' } 46 | #' 47 | #' @section Other Functions: 48 | #' \itemize{ 49 | #' \item \code{\link{get_bbox}}: return bounding box from input vector 50 | #' } 51 | #' 52 | #' @section Data: 53 | #' \itemize{ 54 | #' \item \code{\link{london}}: OSM Data from a small portion of central London 55 | #' } 56 | #' 57 | #' @section Vignettes: 58 | #' \itemize{ 59 | #' \item \code{basic-maps}: Describes basics of downloading data and making 60 | #' custom maps 61 | #' \item \code{data-maps}: Describes how map elements can be coloured according 62 | #' to user-provided data, whether categorical or continuous 63 | #' } 64 | #' 65 | #' @name osmplotr 66 | #' @docType package 67 | #' @aliases osmplotr-package 68 | #' @family package 69 | #' @importFrom grDevices col2rgb dev.cur dev.new heat.colors rgb rainbow 70 | #' @importFrom graphics lines par plot plot.new rect text 71 | #' @importFrom methods hasArg is slot 72 | #' @importFrom stats runif 73 | #' @importFrom utils combn head setTxtProgressBar tail txtProgressBar 74 | #' @import spatstat 75 | "_PACKAGE" 76 | 77 | #' london 78 | #' 79 | #' A list of \code{Simple Features} (\code{sf}) \code{data.frame} objects 80 | #' containing OpenStreetMap polygons, lines, and points for various 81 | #' OpenStreetMap structures in a small part of central London, U.K. (\code{bbox 82 | #' = -0.13, 51.51, -0.11, 51.52}). The list includes: 83 | #' \enumerate{ 84 | #' \item \code{dat_H}: 974 non-primary highways as linestrings 85 | #' \item \code{dat_HP}: 159 primary highways as linestrings 86 | #' \item \code{dat_BNR}: 1,716 non-residential buildings as polygons 87 | #' \item \code{dat_BR}: 43 residential buildings as polygons 88 | #' \item \code{dat_BC}: 67 commerical buildings as polygons 89 | #' \item \code{dat_A}: 372 amenities as polygons 90 | #' \item \code{dat_P}: 13 parks as polygons 91 | #' \item \code{dat_T}: 688 trees as points 92 | #' \item \code{dat_RFH}: 1 polygon representing Royal Festival Hall 93 | #' \item \code{dat_ST}: 1 polygon representing 150 Stamford Street 94 | #' } 95 | #' 96 | #' The vignette \code{basic-maps} details how these data were downloaded. Note 97 | #' that these internal versions have had all descriptive data removed other than 98 | #' their names, geometries, and their OSM identification numbers. 99 | #' 100 | #' @docType data 101 | #' @keywords datasets 102 | #' @name london 103 | #' @family data 104 | #' @format A list of spatial objects 105 | NULL 106 | -------------------------------------------------------------------------------- /R/print-osm-map.R: -------------------------------------------------------------------------------- 1 | #' print_osm_map 2 | #' 3 | #' Prints an OSM map produced with \code{osmplotr} to a specified graphics 4 | #' device. 5 | #' 6 | #' @param map The map to be printed; a \pkg{ggplot2} object produced by 7 | #' \code{osmplotr}. 8 | #' @param width Desired width of graphics device. 9 | #' @param height Desired height of graphics device. Ignored if width specified. 10 | #' @param filename Name of file to which map is to be printed. 11 | #' @param device Type of graphics device (extracted from filename extension if 12 | #' not explicitly provided). 13 | #' @param units Units for height and width of graphics device. 14 | #' @param dpi Resolution of graphics device (dots-per-inch). 15 | #' @return (Invisibly) the \pkg{ggplot2} map object. 16 | #' 17 | #' @seealso \code{\link{osm_basemap}}, \code{\link{add_osm_objects}}, 18 | #' \code{\link{make_osm_map}}. 19 | #' 20 | #' @examples 21 | #' bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 22 | #' map <- osm_basemap (bbox = bbox, bg = "gray20") 23 | #' map <- add_osm_objects (map, london$dat_BNR, col = "gray40") 24 | #' print_osm_map (map, width = 7) # prints to screen device 25 | #' \donttest{ 26 | #' print_osm_map (map, file = "map.png", width = 500, units = "px") 27 | #' file.remove ("map.png") 28 | #' } 29 | #' @family construction 30 | #' @export 31 | print_osm_map <- function (map, width, height, filename, device, 32 | units = c ("in", "cm", "mm", "px"), 33 | dpi = 300) { 34 | 35 | if (missing (map)) { 36 | stop ("map must be supplied") 37 | } 38 | if (missing (width) && missing (height)) { 39 | width <- 7 40 | } 41 | 42 | xlims <- map$coordinates$limits$x 43 | ylims <- map$coordinates$limits$y 44 | if (!missing (width)) { 45 | height <- width * diff (ylims) / diff (xlims) 46 | } else { 47 | width <- height * diff (xlims) / diff (ylims) 48 | } 49 | 50 | units <- match.arg (units) 51 | if (missing (device) && missing (filename)) { 52 | 53 | dev.new (width = width, height = height) 54 | print (map) 55 | } else { 56 | 57 | dev <- get_graphics_device (device, filename, units, dpi = dpi) 58 | dev (file = filename, width = width, height = height) 59 | print (map) 60 | on.exit (utils::capture.output (grDevices::dev.off ( 61 | which = 62 | dev.cur () 63 | ))) 64 | } 65 | invisible (map) 66 | } 67 | 68 | # code from hadley/ggplot2::save 69 | get_graphics_device <- function (device, filename, units, dpi = 300) { 70 | 71 | devices <- list ( 72 | eps = function (...) { 73 | grDevices::postscript (..., 74 | onefile = FALSE, 75 | horizontal = FALSE, 76 | paper = "special" 77 | ) 78 | }, 79 | ps = function (...) { 80 | grDevices::postscript (..., 81 | onefile = FALSE, 82 | horizontal = FALSE, 83 | paper = "special" 84 | ) 85 | }, 86 | tex = function (...) grDevices::pictex (...), 87 | pdf = function (..., version = "1.4") { 88 | grDevices::pdf (..., version = version) 89 | }, 90 | svg = function (...) grDevices::svg (...), 91 | png = function (...) { 92 | grDevices::png (..., res = dpi, units = units) 93 | }, 94 | jpg = function (...) { 95 | grDevices::jpeg (..., res = dpi, units = units) 96 | }, 97 | jpeg = function (...) { 98 | grDevices::jpeg (..., res = dpi, units = units) 99 | }, 100 | bmp = function (...) { 101 | grDevices::bmp (..., res = dpi, units = units) 102 | }, 103 | tiff = function (...) { 104 | grDevices::tiff (..., res = dpi, units = units) 105 | } 106 | ) 107 | if (missing (device)) { 108 | device <- tolower (tools::file_ext (filename)) 109 | } 110 | if (!is.character (device) || length (device) != 1) { 111 | stop ("`device` must be NULL, a string or a function.", call. = FALSE) 112 | } 113 | 114 | dev <- devices [[device]] 115 | if (is.null (dev)) { 116 | stop ("Unknown graphics device '", device, "'", call. = FALSE) 117 | } 118 | return (dev) 119 | } 120 | -------------------------------------------------------------------------------- /R/test-fns.R: -------------------------------------------------------------------------------- 1 | # --------- lengths of vectors 2 | test_len1 <- function (a, txt) { 3 | 4 | if (length (a) > 1) { 5 | 6 | warning (paste ("Only the first element of", txt, "will be used")) 7 | a <- a [1] 8 | } 9 | return (a) 10 | } 11 | 12 | test_len2 <- function (a, txt) { 13 | 14 | if (length (a) > 2) { 15 | 16 | warning (paste ("Only the first two elements of", txt, "will be used")) 17 | a <- a [1:2] 18 | } 19 | return (a) 20 | } 21 | 22 | # --------- object classes 23 | test_numeric <- function (a, txt, value) { 24 | 25 | if (!is.numeric (a)) { 26 | 27 | if (length (value) == 1) { 28 | vstr <- "value" 29 | } else { 30 | vstr <- "values" 31 | } 32 | w <- simpleWarning (paste (txt, "must be numeric; using default", vstr)) 33 | a <- tryCatch (as.numeric (a), warning = function (c) w) 34 | if (is (a, "warning")) { 35 | 36 | warning (a) 37 | a <- value 38 | } 39 | } 40 | return (a) 41 | } 42 | 43 | test_logical <- function (a, txt, value) { 44 | 45 | if (!is.logical (a)) { 46 | 47 | w <- simpleWarning (paste (txt, "must be logical; using default")) 48 | if (is.na (as.logical (a))) { 49 | 50 | warning (w) 51 | a <- value 52 | } 53 | } 54 | return (a) 55 | } 56 | 57 | # --------- object values 58 | test_pos <- function (a, txt, value) { 59 | 60 | if (a < 0) { 61 | 62 | warning (paste (txt, "must be positive; using default value")) 63 | a <- 3 64 | } 65 | return (a) 66 | } 67 | 68 | test_range <- function (a, txt, rng, value) { 69 | 70 | if (any (a < rng [1]) || any (a > rng [2])) { 71 | 72 | if (length (value) == 1) { 73 | vstr <- "value" 74 | } else { 75 | vstr <- "values" 76 | } 77 | warning (paste0 ( 78 | txt, " not in [", rng [1], ",", rng [2], 79 | "]; using default ", vstr 80 | )) 81 | a <- value 82 | } 83 | return (a) 84 | } 85 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | #' Re-project on to Lambert Azimuthal equal-area projection, centred at center 2 | #' of actual objects. 3 | #' @noRd 4 | reproj_equal_area <- function (x) { 5 | 6 | xy <- sf::st_coordinates (x) 7 | xy <- round (apply (xy, 2, mean)) 8 | 9 | crs <- sf::st_crs (paste0 ( 10 | "+proj=laea +lat_0=", 11 | xy [1], 12 | " +lon_0=", 13 | xy [2], 14 | " +x_0=4321000 +y_0=3210000 +ellps=GRS80 ", 15 | "+towgs84=0,0,0,0,0,0,0 +units=m +no_defs" 16 | )) 17 | 18 | sf::st_transform (x, crs = crs) 19 | } 20 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | .onAttach <- function (libname, pkgname) { # nolint 2 | msg <- paste0 ( 3 | "Data (c) OpenStreetMap contributors, ", 4 | "ODbL 1.0. http://www.openstreetmap.org/copyright" 5 | ) 6 | packageStartupMessage (msg) 7 | } 8 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | title: osmplotr 2 | 3 | templates: 4 | params: 5 | bootswatch: cerulean 6 | 7 | reference: 8 | - title: Package doc and class 9 | contents: 10 | - has_concept("package") 11 | - title: Data extraction 12 | contents: 13 | - has_concept("data-extraction") 14 | - title: Map construction 15 | contents: 16 | - has_concept ("construction") 17 | - title: Additional map elements 18 | contents: 19 | - has_concept("map-extra") 20 | - title: Maps with data 21 | contents: 22 | - has_concept("maps-with-data") 23 | - title: Colours 24 | contents: 25 | - has_concept("colours") 26 | - title: Package data 27 | contents: 28 | - has_concept("data") 29 | 30 | 31 | articles: 32 | - title: The osmplotr package 33 | contents: 34 | - basic-maps 35 | - data-maps 36 | - maps-with-ocean 37 | -------------------------------------------------------------------------------- /codemeta.json: -------------------------------------------------------------------------------- 1 | { 2 | "@context": "https://doi.org/10.5063/schema/codemeta-2.0", 3 | "@type": "SoftwareSourceCode", 4 | "identifier": "osmplotr", 5 | "description": "Bespoke images of 'OpenStreetMap' ('OSM') data and data visualisation using 'OSM' objects.", 6 | "name": "osmplotr: Bespoke Images of 'OpenStreetMap' Data", 7 | "relatedLink": "https://docs.ropensci.org/osmplotr/", 8 | "codeRepository": "https://github.com/ropensci/osmplotr", 9 | "issueTracker": "https://github.com/ropensci/osmplotr/issues", 10 | "license": "https://spdx.org/licenses/GPL-3.0", 11 | "version": "0.3.5.022", 12 | "programmingLanguage": { 13 | "@type": "ComputerLanguage", 14 | "name": "R", 15 | "url": "https://r-project.org" 16 | }, 17 | "runtimePlatform": "R version 4.4.2 (2024-10-31)", 18 | "author": [ 19 | { 20 | "@type": "Person", 21 | "givenName": "Mark", 22 | "familyName": "Padgham", 23 | "email": "mark.padgham@email.com" 24 | }, 25 | { 26 | "@type": "Person", 27 | "givenName": "Richard", 28 | "familyName": "Beare" 29 | } 30 | ], 31 | "contributor": [ 32 | { 33 | "@type": "Person", 34 | "givenName": "Finkelstein", 35 | "familyName": "Noam" 36 | }, 37 | { 38 | "@type": "Person", 39 | "givenName": "Bartnik", 40 | "familyName": "Lukasz" 41 | } 42 | ], 43 | "copyrightHolder": [ 44 | { 45 | "@type": "Person", 46 | "givenName": "Finkelstein", 47 | "familyName": "Noam" 48 | }, 49 | { 50 | "@type": "Person", 51 | "givenName": "Bartnik", 52 | "familyName": "Lukasz" 53 | } 54 | ], 55 | "maintainer": [ 56 | { 57 | "@type": "Person", 58 | "givenName": "Mark", 59 | "familyName": "Padgham", 60 | "email": "mark.padgham@email.com" 61 | } 62 | ], 63 | "softwareSuggestions": [ 64 | { 65 | "@type": "SoftwareApplication", 66 | "identifier": "curl", 67 | "name": "curl", 68 | "provider": { 69 | "@id": "https://cran.r-project.org", 70 | "@type": "Organization", 71 | "name": "Comprehensive R Archive Network (CRAN)", 72 | "url": "https://cran.r-project.org" 73 | }, 74 | "sameAs": "https://CRAN.R-project.org/package=curl" 75 | }, 76 | { 77 | "@type": "SoftwareApplication", 78 | "identifier": "knitr", 79 | "name": "knitr", 80 | "provider": { 81 | "@id": "https://cran.r-project.org", 82 | "@type": "Organization", 83 | "name": "Comprehensive R Archive Network (CRAN)", 84 | "url": "https://cran.r-project.org" 85 | }, 86 | "sameAs": "https://CRAN.R-project.org/package=knitr" 87 | }, 88 | { 89 | "@type": "SoftwareApplication", 90 | "identifier": "magrittr", 91 | "name": "magrittr", 92 | "provider": { 93 | "@id": "https://cran.r-project.org", 94 | "@type": "Organization", 95 | "name": "Comprehensive R Archive Network (CRAN)", 96 | "url": "https://cran.r-project.org" 97 | }, 98 | "sameAs": "https://CRAN.R-project.org/package=magrittr" 99 | }, 100 | { 101 | "@type": "SoftwareApplication", 102 | "identifier": "markdown", 103 | "name": "markdown", 104 | "provider": { 105 | "@id": "https://cran.r-project.org", 106 | "@type": "Organization", 107 | "name": "Comprehensive R Archive Network (CRAN)", 108 | "url": "https://cran.r-project.org" 109 | }, 110 | "sameAs": "https://CRAN.R-project.org/package=markdown" 111 | }, 112 | { 113 | "@type": "SoftwareApplication", 114 | "identifier": "rmarkdown", 115 | "name": "rmarkdown", 116 | "provider": { 117 | "@id": "https://cran.r-project.org", 118 | "@type": "Organization", 119 | "name": "Comprehensive R Archive Network (CRAN)", 120 | "url": "https://cran.r-project.org" 121 | }, 122 | "sameAs": "https://CRAN.R-project.org/package=rmarkdown" 123 | }, 124 | { 125 | "@type": "SoftwareApplication", 126 | "identifier": "testthat", 127 | "name": "testthat", 128 | "provider": { 129 | "@id": "https://cran.r-project.org", 130 | "@type": "Organization", 131 | "name": "Comprehensive R Archive Network (CRAN)", 132 | "url": "https://cran.r-project.org" 133 | }, 134 | "sameAs": "https://CRAN.R-project.org/package=testthat" 135 | } 136 | ], 137 | "softwareRequirements": { 138 | "1": { 139 | "@type": "SoftwareApplication", 140 | "identifier": "R", 141 | "name": "R", 142 | "version": ">= 3.2.3" 143 | }, 144 | "2": { 145 | "@type": "SoftwareApplication", 146 | "identifier": "e1071", 147 | "name": "e1071", 148 | "provider": { 149 | "@id": "https://cran.r-project.org", 150 | "@type": "Organization", 151 | "name": "Comprehensive R Archive Network (CRAN)", 152 | "url": "https://cran.r-project.org" 153 | }, 154 | "sameAs": "https://CRAN.R-project.org/package=e1071" 155 | }, 156 | "3": { 157 | "@type": "SoftwareApplication", 158 | "identifier": "ggm", 159 | "name": "ggm", 160 | "provider": { 161 | "@id": "https://cran.r-project.org", 162 | "@type": "Organization", 163 | "name": "Comprehensive R Archive Network (CRAN)", 164 | "url": "https://cran.r-project.org" 165 | }, 166 | "sameAs": "https://CRAN.R-project.org/package=ggm" 167 | }, 168 | "4": { 169 | "@type": "SoftwareApplication", 170 | "identifier": "ggplot2", 171 | "name": "ggplot2", 172 | "provider": { 173 | "@id": "https://cran.r-project.org", 174 | "@type": "Organization", 175 | "name": "Comprehensive R Archive Network (CRAN)", 176 | "url": "https://cran.r-project.org" 177 | }, 178 | "sameAs": "https://CRAN.R-project.org/package=ggplot2" 179 | }, 180 | "5": { 181 | "@type": "SoftwareApplication", 182 | "identifier": "mapproj", 183 | "name": "mapproj", 184 | "provider": { 185 | "@id": "https://cran.r-project.org", 186 | "@type": "Organization", 187 | "name": "Comprehensive R Archive Network (CRAN)", 188 | "url": "https://cran.r-project.org" 189 | }, 190 | "sameAs": "https://CRAN.R-project.org/package=mapproj" 191 | }, 192 | "6": { 193 | "@type": "SoftwareApplication", 194 | "identifier": "methods", 195 | "name": "methods" 196 | }, 197 | "7": { 198 | "@type": "SoftwareApplication", 199 | "identifier": "osmdata", 200 | "name": "osmdata", 201 | "provider": { 202 | "@id": "https://cran.r-project.org", 203 | "@type": "Organization", 204 | "name": "Comprehensive R Archive Network (CRAN)", 205 | "url": "https://cran.r-project.org" 206 | }, 207 | "sameAs": "https://CRAN.R-project.org/package=osmdata" 208 | }, 209 | "8": { 210 | "@type": "SoftwareApplication", 211 | "identifier": "sf", 212 | "name": "sf", 213 | "provider": { 214 | "@id": "https://cran.r-project.org", 215 | "@type": "Organization", 216 | "name": "Comprehensive R Archive Network (CRAN)", 217 | "url": "https://cran.r-project.org" 218 | }, 219 | "sameAs": "https://CRAN.R-project.org/package=sf" 220 | }, 221 | "9": { 222 | "@type": "SoftwareApplication", 223 | "identifier": "sfheaders", 224 | "name": "sfheaders", 225 | "provider": { 226 | "@id": "https://cran.r-project.org", 227 | "@type": "Organization", 228 | "name": "Comprehensive R Archive Network (CRAN)", 229 | "url": "https://cran.r-project.org" 230 | }, 231 | "sameAs": "https://CRAN.R-project.org/package=sfheaders" 232 | }, 233 | "10": { 234 | "@type": "SoftwareApplication", 235 | "identifier": "sp", 236 | "name": "sp", 237 | "provider": { 238 | "@id": "https://cran.r-project.org", 239 | "@type": "Organization", 240 | "name": "Comprehensive R Archive Network (CRAN)", 241 | "url": "https://cran.r-project.org" 242 | }, 243 | "sameAs": "https://CRAN.R-project.org/package=sp" 244 | }, 245 | "11": { 246 | "@type": "SoftwareApplication", 247 | "identifier": "spatstat", 248 | "name": "spatstat", 249 | "version": ">= 2.0-0", 250 | "provider": { 251 | "@id": "https://cran.r-project.org", 252 | "@type": "Organization", 253 | "name": "Comprehensive R Archive Network (CRAN)", 254 | "url": "https://cran.r-project.org" 255 | }, 256 | "sameAs": "https://CRAN.R-project.org/package=spatstat" 257 | }, 258 | "12": { 259 | "@type": "SoftwareApplication", 260 | "identifier": "spatstat.explore", 261 | "name": "spatstat.explore", 262 | "provider": { 263 | "@id": "https://cran.r-project.org", 264 | "@type": "Organization", 265 | "name": "Comprehensive R Archive Network (CRAN)", 266 | "url": "https://cran.r-project.org" 267 | }, 268 | "sameAs": "https://CRAN.R-project.org/package=spatstat.explore" 269 | }, 270 | "13": { 271 | "@type": "SoftwareApplication", 272 | "identifier": "spatstat.geom", 273 | "name": "spatstat.geom", 274 | "provider": { 275 | "@id": "https://cran.r-project.org", 276 | "@type": "Organization", 277 | "name": "Comprehensive R Archive Network (CRAN)", 278 | "url": "https://cran.r-project.org" 279 | }, 280 | "sameAs": "https://CRAN.R-project.org/package=spatstat.geom" 281 | }, 282 | "SystemRequirements": {} 283 | }, 284 | "fileSize": "1371.45KB", 285 | "releaseNotes": "https://github.com/ropensci/osmplotr/blob/master/NEWS.md", 286 | "readme": "https://github.com/ropensci/osmplotr/blob/main/README.md", 287 | "contIntegration": [ 288 | "https://github.com/ropensci/osmplotr/actions?query=workflow%3AR-CMD-check", 289 | "https://app.codecov.io/gh/ropensci/osmplotr" 290 | ], 291 | "developmentStatus": "https://www.repostatus.org/", 292 | "review": { 293 | "@type": "Review", 294 | "url": "https://github.com/ropensci/software-review/issues/27", 295 | "provider": "https://ropensci.org" 296 | }, 297 | "keywords": [ 298 | "osm", 299 | "openstreetmap", 300 | "overpass-api", 301 | "overpass", 302 | "data-visualisation", 303 | "highlighting-clusters", 304 | "r", 305 | "rstats", 306 | "r-package", 307 | "peer-reviewed" 308 | ] 309 | } 310 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | # CRAN notes for osmplotr_v0.3.6 re-submission 2 | 3 | This is a re-submission of a previously archived package. The submission may generate one single note regarding installed size of ~6MB, which is due to the vignettes. These produce many graphical files illustrating the package's functionality. Every effort has been made to reduce this as much as possible, including reducing the resolution of these images to the coarsest practicable scale. Halving the resolution again (from current 72 to 36 dpi) only decreases the final package size by around 200 kB. 4 | 5 | This re-submission also rectifies several issues pointed out in an email from 7th Feb 2025: 6 | 7 | - Return values have been documented in all functions 8 | - Most `\dontrun` statements have been reduced, and converted to `donttest`. A few nevertheless remain, as the example code makes external API calls to download data. The following functions retain `dontrun` statements only around code which makes external API calls: 9 | - `add_osm_groups()` 10 | - `adjust_colours()`, 11 | - `add_osm_objects()` 12 | - `extract_osm_objects()` 13 | - `osm_line2poly()` 14 | - `connect_highways()`. 15 | - All previous uses of `cat()` have been removed, and replaced with `message()`. 16 | 17 | 18 | ## Test environments 19 | 20 | Other than the above, this submission generates NO notes on: 21 | 22 | - Linux (via github actions): R-release, R-oldrelease 23 | - Windows (via github actions): R-release, R-oldrelease, R-devel 24 | - win-builder: R-oldrelease, R-release, R-devel 25 | -------------------------------------------------------------------------------- /data-raw/pkg-data-scripts.Rmd: -------------------------------------------------------------------------------- 1 | # scrips to generate both `data/london.rda` and `inst/extdata/hwys.rda` 2 | 3 | ```{r load, echo = FALSE} 4 | devtools::load_all (".", export_all = FALSE) 5 | library (magrittr) 6 | ``` 7 | 8 | 9 | ### test data for highway cycles 10 | 11 | These are the `/inst/extdata/hwys.rda` data 12 | 13 | ```{r} 14 | bbox <- get_bbox (c(-0.15, 51.50, -0.10, 51.52)) 15 | highways1 <- c ('Monmouth.St', 'Short.?s.Gardens', 'Endell.St', 'Long.Acre', 16 | 'Upper.Saint.Martin') %>% 17 | osmplotr:::extract_highways (bbox = bbox) 18 | highways2 <- c ('Endell.St', 'High.Holborn', 'Drury.Lane', 'Long.Acre') %>% 19 | osmplotr:::extract_highways (bbox = bbox) 20 | highways3 <- c ('Drury.Lane', 'High.Holborn', 'Kingsway', 'Great.Queen.St') %>% 21 | osmplotr:::extract_highways (bbox = bbox) 22 | highways4 <- c ('Kingsway', 'Holborn', 'Farringdon.St', 'Strand', 23 | 'Fleet.St', 'Aldwych') %>% 24 | osmplotr:::extract_highways (bbox = bbox) 25 | hwys <- list (highways1 = highways1, highways2 = highways2, 26 | highways3 = highways3, highways4 = highways4) 27 | fname <- system.file ('extdata', 'hwys.rda', package = 'osmplotr') 28 | save (hwys, file = fname) 29 | format (file.size (fname), big.mark = ',') 30 | ``` 31 | 32 | 33 | ### The main London data 34 | 35 | 36 | The `london` data are stripped of all columns except the 2 primary ones. The 37 | names can't be stored because they fail `R CMD check` due to non-ASCII strings. 38 | 39 | ```{r} 40 | col_names <- c ('osm_id', 'geometry') 41 | bbox <- get_bbox (c (-0.13, 51.51, -0.11, 51.52)) 42 | dat_H <- extract_osm_objects (key = 'highway', value = '!primary', 43 | bbox = bbox) 44 | indx <- which (names (dat_H) %in% col_names) 45 | dat_H <- dat_H [, indx] 46 | dat_HP <- extract_osm_objects (key = 'highway', value = 'primary', 47 | bbox = bbox) 48 | indx <- which (names (dat_HP) %in% col_names) 49 | dat_HP <- dat_HP [, indx] 50 | dat_BNR <- extract_osm_objects (key = 'building', value = '!residential', 51 | bbox = bbox) 52 | indx <- which (names (dat_BNR) %in% col_names) 53 | dat_BNR <- dat_BNR [, indx] 54 | dat_BR <- extract_osm_objects (key = 'building', value = 'residential', 55 | bbox = bbox) 56 | indx <- which (names (dat_BR) %in% col_names) 57 | dat_BR <- dat_BR [, indx] 58 | dat_BC <- extract_osm_objects (key = 'building', value = 'commercial', 59 | bbox = bbox) 60 | indx <- which (names (dat_BC) %in% col_names) 61 | dat_BC <- dat_BC [, indx] 62 | dat_A <- extract_osm_objects (key = 'amenity', bbox = bbox, 63 | return_type = 'polygon') 64 | indx <- which (names (dat_A) %in% col_names) 65 | dat_A <- dat_A [, indx] 66 | dat_P <- extract_osm_objects (key = 'park', bbox = bbox) 67 | indx <- which (names (dat_P) %in% col_names) 68 | dat_P <- dat_P [, indx] 69 | dat_T <- extract_osm_objects (key = 'tree', bbox = bbox) 70 | indx <- which (names (dat_T) %in% col_names) 71 | dat_T <- dat_T [, indx] 72 | bbox <- get_bbox (c (-0.13, 51.50, -0.11, 51.52)) 73 | dat_RFH <- extract_osm_objects (key = 'building', bbox = bbox, 74 | extra_pairs = c ('name', 75 | 'Royal.Festival.Hall')) 76 | extra_pairs <- list (c ('addr:street', 'Stamford.St'), 77 | c ('addr:housenumber', '150')) 78 | dat_ST <- extract_osm_objects (key = 'building', extra_pairs = extra_pairs, 79 | bbox = bbox) 80 | ``` 81 | ```{r} 82 | london <- list (dat_H = dat_H, dat_HP = dat_HP, dat_BNR = dat_BNR, 83 | dat_BR = dat_BR, dat_BC = dat_BC, dat_A = dat_A, dat_P = dat_P, 84 | dat_T = dat_T, dat_RFH = dat_RFH, dat_ST = dat_ST) 85 | devtools::use_data (london, overwrite = TRUE, compress = 'xz') 86 | format (file.size ('./data/london.rda'), big.mark = ',') # 189,984 87 | ``` 88 | 89 | -------------------------------------------------------------------------------- /data/london.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/data/london.rda -------------------------------------------------------------------------------- /inst/extdata/hwys.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/inst/extdata/hwys.rda -------------------------------------------------------------------------------- /makefile: -------------------------------------------------------------------------------- 1 | LFILE = README 2 | 3 | all: knith open 4 | 5 | knith: $(LFILE).Rmd 6 | echo "rmarkdown::render('$(LFILE).Rmd',output_file='$(LFILE).html')" | R --no-save -q 7 | 8 | knitr: $(LFILE).Rmd 9 | echo "rmarkdown::render('$(LFILE).Rmd',rmarkdown::md_document(variant='gfm'))" | R --no-save -q 10 | 11 | open: $(LFILE).html 12 | xdg-open $(LFILE).html & 13 | 14 | clean: 15 | rm -f *.html 16 | -------------------------------------------------------------------------------- /man/add_axes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add-axes.R 3 | \name{add_axes} 4 | \alias{add_axes} 5 | \title{add_axes} 6 | \usage{ 7 | add_axes( 8 | map, 9 | colour = "black", 10 | pos = c(0.02, 0.03), 11 | alpha = 0.4, 12 | fontsize = 3, 13 | fontface, 14 | fontfamily, 15 | ... 16 | ) 17 | } 18 | \arguments{ 19 | \item{map}{A \code{ggplot2} object to which the axes are to be added.} 20 | 21 | \item{colour}{Colour of axis (determines colour of all elements: lines, 22 | ticks, and labels).} 23 | 24 | \item{pos}{Positions of axes and labels relative to entire plot device.} 25 | 26 | \item{alpha}{alpha value for semi-transparent background surrounding axes and 27 | labels (lower values increase transparency).} 28 | 29 | \item{fontsize}{Size of axis font (in \code{ggplot2} terms; default=3).} 30 | 31 | \item{fontface}{Fontface for axis labels (1:4=plain,bold,italic,bold-italic).} 32 | 33 | \item{fontfamily}{Family of axis font (for example, `\code{Times}').} 34 | 35 | \item{...}{Mechanism to allow many parameters to be passed with alternative 36 | names (\code{color} for \code{colour} and \code{xyz} for \code{fontxyz}.} 37 | } 38 | \value{ 39 | Modified version of \code{map} with axes added. 40 | } 41 | \description{ 42 | Adds axes to the internal region of an OSM plot. 43 | } 44 | \examples{ 45 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 46 | map <- osm_basemap (bbox = bbox, bg = "gray20") 47 | map <- add_osm_objects (map, london$dat_BNR, col = "gray40") 48 | map <- add_axes (map) 49 | print (map) 50 | 51 | # Map items are added sequentially, so adding axes prior to objects will 52 | # produce a different result. 53 | map <- osm_basemap (bbox = bbox, bg = "gray20") 54 | map <- add_axes (map) 55 | map <- add_osm_objects (map, london$dat_BNR, col = "gray40") 56 | print_osm_map (map) 57 | } 58 | \seealso{ 59 | \code{\link{osm_basemap}}. 60 | 61 | Other map-extra: 62 | \code{\link{add_colourbar}()}, 63 | \code{\link{osm_line2poly}()} 64 | } 65 | \concept{map-extra} 66 | -------------------------------------------------------------------------------- /man/add_colourbar.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add-colourbar.R 3 | \name{add_colourbar} 4 | \alias{add_colourbar} 5 | \title{add_colorbar} 6 | \usage{ 7 | add_colourbar( 8 | map, 9 | barwidth = 0.02, 10 | barlength = 0.7, 11 | zlims, 12 | cols, 13 | vertical = TRUE, 14 | alpha = 0.4, 15 | text_col = "black", 16 | fontsize = 3, 17 | fontface, 18 | fontfamily, 19 | ... 20 | ) 21 | } 22 | \arguments{ 23 | \item{map}{A \code{ggplot2} object to which the colourbar is to be added.} 24 | 25 | \item{barwidth}{Relative width of the bar (perpendicular to its direction), 26 | either a single number giving distance from right or upper margin, or two 27 | numbers giving left/right or lower/upper limits.} 28 | 29 | \item{barlength}{Relative length of the bar (parallel to its direction), 30 | either a single number giving total length of centred bar, or two numbers 31 | giving lower/upper or left/right limits.} 32 | 33 | \item{zlims}{Vector of (min,max) values for scale of colourbar. These should 34 | be the values returned from \code{\link{add_osm_surface}}.} 35 | 36 | \item{cols}{Vector of colours.} 37 | 38 | \item{vertical}{If \code{FALSE}, colourbar is aligned horizontally instead of 39 | default vertical alignment.} 40 | 41 | \item{alpha}{Transparency level of region immediately surrounding colourbar, 42 | including behind text. Lower values are more transparent.} 43 | 44 | \item{text_col}{Colour of text, tick marks, and lines on colourbar.} 45 | 46 | \item{fontsize}{Size of text labels (in \code{ggplot2} terms; default=3).} 47 | 48 | \item{fontface}{Fontface for colourbar labels 49 | (1:4=plain,bold,italic,bold-italic).} 50 | 51 | \item{fontfamily}{Family of colourbar font (for example, `\code{Times}').} 52 | 53 | \item{...}{Mechanism to allow many parameters to be passed with alternative 54 | names (such as \code{xyz} for \code{fontxyz}).} 55 | } 56 | \value{ 57 | Modified version of \code{map} with colourbar added. 58 | } 59 | \description{ 60 | Adds a colourbar to an existing map. Intended to be used in combination with 61 | \code{\link{add_osm_surface}}. At present, only plots on right side of map. 62 | } 63 | \examples{ 64 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 65 | map <- osm_basemap (bbox = bbox, bg = "gray20") 66 | # Align volcano data to lat-lon range of bbox 67 | dv <- dim (volcano) 68 | x <- seq (bbox [1, 1], bbox [1, 2], length.out = dv [1]) 69 | y <- seq (bbox [2, 1], bbox [2, 2], length.out = dv [2]) 70 | dat <- data.frame ( 71 | x = rep (x, dv [2]), 72 | y = rep (y, each = dv [1]), 73 | z = as.numeric (volcano) 74 | ) 75 | map <- add_osm_surface (map, 76 | obj = london$dat_BNR, dat = dat, 77 | cols = heat.colors (30) 78 | ) 79 | map <- add_axes (map) 80 | # Note colours of colourbar can be artibrarily set, and need not equal those 81 | # passed to 'add_osm_surface' 82 | map <- add_colourbar (map, 83 | zlims = range (volcano), cols = heat.colors (100), 84 | text_col = "black" 85 | ) 86 | print_osm_map (map) 87 | 88 | # Horizontal colourbar shifted away from margins: 89 | map <- osm_basemap (bbox = bbox, bg = "gray20") 90 | map <- add_osm_surface (map, 91 | obj = london$dat_BNR, dat = dat, 92 | cols = heat.colors (30) 93 | ) 94 | map <- add_colourbar (map, 95 | zlims = range (volcano), cols = heat.colors (100), 96 | barwidth = c (0.1, 0.15), barlength = c (0.5, 0.9), 97 | vertical = FALSE 98 | ) 99 | print_osm_map (map) 100 | } 101 | \seealso{ 102 | \code{\link{osm_basemap}}, \code{\link{add_osm_surface}}. 103 | 104 | Other map-extra: 105 | \code{\link{add_axes}()}, 106 | \code{\link{osm_line2poly}()} 107 | } 108 | \concept{map-extra} 109 | -------------------------------------------------------------------------------- /man/add_osm_groups.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add-osm-groups.R 3 | \name{add_osm_groups} 4 | \alias{add_osm_groups} 5 | \title{add_osm_groups} 6 | \usage{ 7 | add_osm_groups( 8 | map, 9 | obj, 10 | groups, 11 | cols, 12 | bg, 13 | make_hull = FALSE, 14 | boundary = -1, 15 | size, 16 | shape, 17 | border_width = 1, 18 | colmat, 19 | rotate 20 | ) 21 | } 22 | \arguments{ 23 | \item{map}{A \code{ggplot2} object to which the grouped objects are to be 24 | added.} 25 | 26 | \item{obj}{An \code{sp} \code{SpatialPointsDataFrame}, 27 | \code{SpatialPolygonsDataFrame}, or \code{SpatialLinesDataFrame} (list of 28 | polygons or lines) returned by \code{\link{extract_osm_objects}}.} 29 | 30 | \item{groups}{A list of spatial points objects, each of which contains the 31 | coordinates of points defining one group.} 32 | 33 | \item{cols}{Either a vector of >= 4 colours passed to \code{colour_mat} (if 34 | \code{colmat = TRUE}) to arrange as a 2-D map of visually distinct colours 35 | (default uses \code{rainbow} colours), or (if \code{colmat = FALSE}), a 36 | vector of the same length as groups specifying individual colours for each.} 37 | 38 | \item{bg}{If given, then any objects not within groups are coloured this 39 | colour, otherwise (if not given) they are assigned to nearest group and 40 | coloured accordingly (\code{boundary} has no effect in this latter case).} 41 | 42 | \item{make_hull}{Either a single boolean value or a vector of same length as 43 | groups specifying whether convex hulls should be constructed around all 44 | groups (\code{TRUE}), or whether the group already defines a hull (convex or 45 | otherwise; \code{FALSE}).} 46 | 47 | \item{boundary}{(negative, 0, positive) values define whether the boundary of 48 | groups should (exclude, bisect, include) objects which straddle the precise 49 | boundary. (Has no effect if \code{bg} is given).} 50 | 51 | \item{size}{Linewidth argument passed to \code{ggplot2} (polygon, path, 52 | point) functions: determines width of lines for (polygon, line), and sizes of 53 | points. Respective defaults are (0, 0.5, 0.5).} 54 | 55 | \item{shape}{Shape of points or lines (the latter passed as \code{linetype}); 56 | see \code{\link[ggplot2]{shape}}.} 57 | 58 | \item{border_width}{If given, draws convex hull borders around entire groups 59 | in same colours as groups (try values around 1-2).} 60 | 61 | \item{colmat}{If \code{TRUE} generates colours according to 62 | \code{colour_mat}, otherwise the colours of groups are specified directly by 63 | the vector of \code{cols}.} 64 | 65 | \item{rotate}{Passed to \code{colour_mat} to rotate colours by the specified 66 | number of degrees clockwise.} 67 | } 68 | \value{ 69 | Modified version of \code{map} with groups added. 70 | } 71 | \description{ 72 | Plots spatially distinct groups of OSM objects in different colours. 73 | } 74 | \section{Note}{ 75 | 76 | Any group that is entirely contained within any other group is assumed to 77 | represent a hole, such that points internal to the smaller contained group 78 | are *excluded* from the group, while those outside the smaller yet inside the 79 | bigger group are included. 80 | } 81 | 82 | \examples{ 83 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 84 | # Download data using 'extract_osm_objects' 85 | \dontrun{ 86 | dat_HP <- extract_osm_objects ( 87 | key = "highway", 88 | value = "primary", 89 | bbox = bbox 90 | ) 91 | dat_T <- extract_osm_objects (key = "tree", bbox = bbox) 92 | dat_BNR <- extract_osm_objects ( 93 | key = "building", value = "!residential", 94 | bbox = bbox 95 | ) 96 | } 97 | # These data are also provided in 98 | dat_HP <- london$dat_HP 99 | dat_T <- london$dat_T 100 | dat_BNR <- london$dat_BNR 101 | 102 | # Define a function to easily generate a basemap 103 | bmap <- function () { 104 | map <- osm_basemap (bbox = bbox, bg = "gray20") 105 | map <- add_osm_objects (map, dat_HP, col = "gray70", size = 1) 106 | add_osm_objects (map, dat_T, col = "green") 107 | } 108 | 109 | # Highlight a single region using all objects lying partially inside the 110 | # boundary (via the boundary = 1 argument) 111 | pts <- sp::SpatialPoints (cbind ( 112 | c (-0.115, -0.125, -0.125, -0.115), 113 | c (51.505, 51.505, 51.515, 51.515) 114 | )) 115 | \dontrun{ 116 | dat_H <- extract_osm_objects (key = "highway", bbox = bbox) # all highways 117 | map <- bmap () 118 | map <- add_osm_groups (map, dat_BNR, 119 | groups = pts, cols = "gray90", 120 | bg = "gray40", boundary = 1 121 | ) 122 | map <- add_osm_groups (map, dat_H, 123 | groups = pts, cols = "gray80", 124 | bg = "gray30", boundary = 1 125 | ) 126 | print_osm_map (map) 127 | } 128 | 129 | # Generate random points to serve as group centres 130 | set.seed (2) 131 | ngroups <- 6 132 | x <- bbox [1, 1] + runif (ngroups) * diff (bbox [1, ]) 133 | y <- bbox [2, 1] + runif (ngroups) * diff (bbox [2, ]) 134 | groups <- cbind (x, y) 135 | groups <- apply (groups, 1, function (i) { 136 | sp::SpatialPoints ( 137 | matrix (i, nrow = 1, ncol = 2) 138 | ) 139 | }) 140 | # plot a basemap and add groups 141 | map <- bmap () 142 | cols <- rainbow (length (groups)) 143 | \dontrun{ 144 | map <- add_osm_groups ( 145 | map, 146 | obj = london$dat_BNR, 147 | group = groups, 148 | cols = cols 149 | ) 150 | cols <- adjust_colours (cols, -0.2) 151 | map <- add_osm_groups (map, obj = london$dat_H, groups = groups, cols = cols) 152 | print_osm_map (map) 153 | 154 | # Highlight convex hulls containing groups: 155 | map <- bmap () 156 | map <- add_osm_groups ( 157 | map, 158 | obj = london$dat_BNR, 159 | group = groups, 160 | cols = cols, 161 | border_width = 2 162 | ) 163 | print_osm_map (map) 164 | } 165 | } 166 | \seealso{ 167 | \code{\link{colour_mat}}, \code{\link{add_osm_objects}}. 168 | 169 | Other maps-with-data: 170 | \code{\link{add_osm_surface}()} 171 | } 172 | \concept{maps-with-data} 173 | -------------------------------------------------------------------------------- /man/add_osm_objects.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add-osm-objects.R 3 | \name{add_osm_objects} 4 | \alias{add_osm_objects} 5 | \title{add_osm_objects} 6 | \usage{ 7 | add_osm_objects(map, obj, col = "gray40", border = NA, hcol, size, shape) 8 | } 9 | \arguments{ 10 | \item{map}{A \code{ggplot2} object to which the objects are to be added.} 11 | 12 | \item{obj}{A spatial (\code{sp}) data frame of polygons, lines, or points, 13 | typically as returned by \code{\link{extract_osm_objects}}.} 14 | 15 | \item{col}{Colour of lines or points; fill colour of polygons.} 16 | 17 | \item{border}{Border colour of polygons.} 18 | 19 | \item{hcol}{(Multipolygons only) Vector of fill colours for holes} 20 | 21 | \item{size}{Linewidth argument passed to \code{ggplot2} (polygon, path, 22 | point) functions: determines width of lines for (polygon, line), and sizes of 23 | points. Respective defaults are (0, 0.5, 0.5).} 24 | 25 | \item{shape}{Shape of points or lines (the latter passed as \code{linetype}); 26 | see \code{\link[ggplot2]{shape}}.} 27 | } 28 | \value{ 29 | modified version of \code{map} to which objects have been added. 30 | } 31 | \description{ 32 | Adds layers of spatial objects (polygons, lines, or points generated by 33 | \code{\link{extract_osm_objects}}) to a graphics object initialised with 34 | \code{\link{osm_basemap}}. 35 | } 36 | \examples{ 37 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 38 | map <- osm_basemap (bbox = bbox, bg = "gray20") 39 | 40 | \dontrun{ 41 | # The 'london' data used below were downloaded as: 42 | dat_BNR <- extract_osm_objects ( 43 | bbox = bbox, 44 | key = "building", 45 | value = "!residential" 46 | ) 47 | dat_HP <- extract_osm_objects ( 48 | bbox = bbox, 49 | key = "highway", 50 | value = "primary" 51 | ) 52 | dat_T <- extract_osm_objects (bbox = bbox, key = "tree") 53 | } 54 | map <- add_osm_objects ( 55 | map, 56 | obj = london$dat_BNR, 57 | col = "gray40", 58 | border = "yellow" 59 | ) 60 | map <- add_osm_objects ( 61 | map, 62 | obj = london$dat_HP, 63 | col = "gray80", 64 | size = 1, shape = 2 65 | ) 66 | map <- add_osm_objects ( 67 | map, 68 | london$dat_T, 69 | col = "green", 70 | size = 2, shape = 1 71 | ) 72 | print_osm_map (map) 73 | 74 | # Polygons with different coloured borders 75 | map <- osm_basemap (bbox = bbox, bg = "gray20") 76 | map <- add_osm_objects (map, obj = london$dat_HP, col = "gray80") 77 | map <- add_osm_objects (map, london$dat_T, col = "green") 78 | map <- add_osm_objects (map, 79 | obj = london$dat_BNR, col = "gray40", 80 | border = "yellow", size = 0.5 81 | ) 82 | print_osm_map (map) 83 | } 84 | \seealso{ 85 | \code{\link{osm_basemap}}, \code{\link{extract_osm_objects}}. 86 | 87 | Other construction: 88 | \code{\link{make_osm_map}()}, 89 | \code{\link{osm_basemap}()}, 90 | \code{\link{osm_structures}()}, 91 | \code{\link{print_osm_map}()} 92 | } 93 | \concept{construction} 94 | -------------------------------------------------------------------------------- /man/add_osm_surface.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add-osm-surface.R 3 | \name{add_osm_surface} 4 | \alias{add_osm_surface} 5 | \title{add_osm_surface} 6 | \usage{ 7 | add_osm_surface( 8 | map, 9 | obj, 10 | dat, 11 | method = "idw", 12 | grid_size = 100, 13 | cols = heat.colors(30), 14 | bg, 15 | size, 16 | shape 17 | ) 18 | } 19 | \arguments{ 20 | \item{map}{A \code{ggplot2} object to which the surface are to be added} 21 | 22 | \item{obj}{An \code{sp} \code{SpatialPolygonsDataFrame} or 23 | \code{SpatialLinesDataFrame} (list of polygons or lines) returned by 24 | \code{\link{extract_osm_objects}}} 25 | 26 | \item{dat}{A matrix or data frame of 3 columns (x, y, z), where (x, y) are 27 | (longitude, latitude), and z are the values to be interpolated} 28 | 29 | \item{method}{Either \code{idw} (Inverse Distance Weighting as 30 | \code{spatstat.explore::idw}; default), \code{Gaussian} for kernel smoothing 31 | (as \code{spatstat.explore::Smooth.ppp}), or any other value to avoid 32 | interpolation. In this case, \code{dat} must be regularly spaced in \code{x} 33 | and \code{y}.} 34 | 35 | \item{grid_size}{size of interpolation grid} 36 | 37 | \item{cols}{Vector of colours for shading z-values (for example, 38 | \code{terrain.colors (30)})} 39 | 40 | \item{bg}{If specified, OSM objects outside the convex hull surrounding 41 | \code{dat} are plotted in this colour, otherwise they are included in the 42 | interpolation (which will generally be inaccurate for peripheral values)} 43 | 44 | \item{size}{Size argument passed to \code{ggplot2} (polygon, path, point) 45 | functions: determines width of lines for (polygon, line), and sizes of 46 | points. Respective defaults are (0, 0.5, 0.5). If \code{bg} is provided and 47 | \code{size} has 2 elements, the second determines the \code{size} of the 48 | background objects.} 49 | 50 | \item{shape}{Shape of lines or points, for details of which see 51 | \code{?ggplot::shape}. If \code{bg} is provided and \code{shape} has 2 52 | elements, the second determines the \code{shape} of the background objects.} 53 | } 54 | \value{ 55 | modified version of \code{map} to which surface has been added 56 | } 57 | \description{ 58 | Adds a colour-coded surface of spatial objects (polygons, lines, or points 59 | generated by \code{\link{extract_osm_objects}} to a graphics object 60 | initialised with \code{\link{osm_basemap}}. The surface is spatially 61 | interpolated between the values given in \code{dat}, which has to be a matrix 62 | of \code{data.frame} of 3 columns (x, y, z), where (x,y) are (longitude, 63 | latitude), and z are the values to be interpolated. Interpolation uses 64 | \code{spatstat.explore::Smooth.ppp}, which applies a Gaussian kernel smoother 65 | optimised to the given data, and is effectively non-parametric. 66 | } 67 | \note{ 68 | Points beyond the spatial boundary of \code{dat} are included in the surface 69 | if \code{bg} is not given. In such cases, values for these points may exceed 70 | the range of provided data because the surface will be extrapolated beyond 71 | its domain. Actual plotted values are therefore restricted to the range of 72 | given values, so any extrapolated points greater or less than the range of 73 | \code{dat} are simply set to the respective maximum or minimum values. This 74 | allows the limits of \code{dat} to be used precisely when adding colourbars 75 | with \code{\link{add_colourbar}}. 76 | } 77 | \examples{ 78 | # Get some data 79 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 80 | # dat_B <- extract_osm_objects (key = 'building', bbox = bbox) 81 | # These data are also provided in 82 | dat_B <- london$dat_BNR # actuall non-residential buildings 83 | # Make a data surface across the map coordinates, and remove periphery 84 | n <- 5 85 | x <- seq (bbox [1, 1], bbox [1, 2], length.out = n) 86 | y <- seq (bbox [2, 1], bbox [2, 2], length.out = n) 87 | dat <- data.frame ( 88 | x = as.vector (array (x, dim = c (n, n))), 89 | y = as.vector (t (array (y, dim = c (n, n)))), 90 | z = x * y 91 | ) 92 | map <- osm_basemap (bbox = bbox, bg = "gray20") 93 | map <- add_osm_surface (map, dat_B, dat = dat, cols = heat.colors (30)) 94 | \donttest{ 95 | print_osm_map (map) 96 | } 97 | 98 | # If data do not cover the entire map region, then the peripheral remainder 99 | # can be plotted by specifying the 'bg' colour. First remove periphery from 100 | # 'dat': 101 | d <- sqrt ((dat$x - mean (dat$x))^2 + (dat$y - mean (dat$y))^2) 102 | dat <- dat [which (d < 0.01), ] 103 | map <- osm_basemap (bbox = bbox, bg = "gray20") 104 | map <- add_osm_surface ( 105 | map, 106 | dat_B, 107 | dat = dat, 108 | cols = heat.colors (30), 109 | bg = "gray40" 110 | ) 111 | \donttest{ 112 | print_osm_map (map) 113 | } 114 | 115 | # Polygons and (lines/points) can be overlaid as data surfaces with different 116 | # colour schemes. 117 | # dat_HP <- extract_osm_objects (key = 'highway', 118 | # value = 'primary', 119 | # bbox = bbox) 120 | # These data are also provided in 121 | dat_HP <- london$dat_HP 122 | cols <- adjust_colours (heat.colors (30), adj = -0.2) # darken by 20\% 123 | map <- add_osm_surface ( 124 | map, 125 | dat_HP, 126 | dat, 127 | cols = cols, 128 | bg = "gray60", 129 | size = c (1.5, 0.5) 130 | ) 131 | \donttest{ 132 | print_osm_map (map) 133 | } 134 | 135 | # Adding multiple surfaces of either polygons or (lines/points) produces a 136 | # 'ggplot2' warning, and forces the colour gradient to revert to the last 137 | # given value. 138 | dat_T <- london$dat_T # trees 139 | map <- osm_basemap (bbox = bbox, bg = "gray20") 140 | map <- add_osm_surface ( 141 | map, 142 | dat_B, 143 | dat = dat, 144 | cols = heat.colors (30), 145 | bg = "gray40" 146 | ) 147 | map <- add_osm_surface ( 148 | map, 149 | dat_HP, 150 | dat, 151 | cols = heat.colors (30), 152 | bg = "gray60", 153 | size = c (1.5, 0.5) 154 | ) 155 | map <- add_osm_surface ( 156 | map, 157 | dat_T, 158 | dat, 159 | cols = topo.colors (30), 160 | bg = "gray70", 161 | size = c (5, 2), 162 | shape = c (8, 1) 163 | ) 164 | \donttest{ 165 | print_osm_map (map) # 'dat_HP' is in 'topo.colors' not 'heat.colors' 166 | } 167 | 168 | # Add axes and colourbar 169 | map <- add_axes (map) 170 | map <- add_colourbar ( 171 | map, 172 | cols = heat.colors (100), 173 | zlims = range (dat$z), 174 | barwidth = c (0.02), 175 | barlength = c (0.6, 0.99), 176 | vertical = TRUE 177 | ) 178 | \donttest{ 179 | print_osm_map (map) 180 | } 181 | } 182 | \seealso{ 183 | \code{\link{osm_basemap}}, \code{\link{add_colourbar}}. 184 | 185 | Other maps-with-data: 186 | \code{\link{add_osm_groups}()} 187 | } 188 | \concept{maps-with-data} 189 | -------------------------------------------------------------------------------- /man/adjust_colours.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/adjust-colours.R 3 | \name{adjust_colours} 4 | \alias{adjust_colours} 5 | \title{adjust_colours} 6 | \usage{ 7 | adjust_colours(cols, adj = 0, plot = FALSE) 8 | } 9 | \arguments{ 10 | \item{cols}{A vector of \code{R} colours (for allowable formats of which, see 11 | \code{?col2rgb}).} 12 | 13 | \item{adj}{A number between -1 and 1 determining how much to lighten 14 | (positive values) or darken (negative values) the colours.} 15 | 16 | \item{plot}{If \code{TRUE}, generates a plot to allow visual comparison of 17 | original and adjusted colours.} 18 | } 19 | \value{ 20 | Corresponding vector of adjusted colours (as hexadecimal strings). 21 | } 22 | \description{ 23 | Adjusts a given colour by lightening or darkening it by the specified amount 24 | (relative scale of -1 to 1). Adjustments are made in RGB space, for 25 | limitations of which see \code{?convertColor} 26 | } 27 | \examples{ 28 | cols <- adjust_colours (cols = heat.colors (10), adj = -0.2, plot = TRUE) 29 | 30 | # 'adjust_colours' also offers an easy way to adjust the default colour 31 | # schemes provided by 'osm_structures'. The following lines darken the 32 | # highway colour of the 'light' colour scheme by 20\% 33 | structures <- osm_structures ( 34 | structures = c ("building", "highway", "park"), 35 | col_scheme = "light" 36 | ) 37 | structures$cols [2] <- adjust_colours (structures$cols [2], adj = -0.2) 38 | # Plot these structures: 39 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 40 | \dontrun{ 41 | dat_B <- extract_osm_objects (key = "building", bbox = bbox) 42 | dat_H <- extract_osm_objects (key = "highway", bbox = bbox) 43 | dat_P <- extract_osm_objects (key = "park", bbox = bbox) 44 | } 45 | # These data are also included in the 'london' data of 'osmplotr' 46 | osm_data <- list ( 47 | dat_B = london$dat_BNR, 48 | dat_H = london$dat_HP, 49 | dat_P = london$dat_P 50 | ) 51 | dat <- make_osm_map ( 52 | structures = structures, 53 | osm_data = osm_data, 54 | bbox = bbox 55 | ) 56 | print_osm_map (dat$map) 57 | } 58 | \seealso{ 59 | \code{\link{osm_structures}}, \code{?col2rgb}. 60 | 61 | Other colours: 62 | \code{\link{colour_mat}()} 63 | } 64 | \concept{colours} 65 | -------------------------------------------------------------------------------- /man/colour_mat.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/colour-mat.R 3 | \name{colour_mat} 4 | \alias{colour_mat} 5 | \title{colour_mat} 6 | \usage{ 7 | colour_mat(cols, n = c(10, 10), rotate = NULL, plot = FALSE) 8 | } 9 | \arguments{ 10 | \item{cols}{vector of length >= 4 of colors (example, default = \code{rainbow 11 | (4)}, or \code{RColorBrewer::brewer.pal (4, 'Set1')}). 12 | \code{cols} are wrapped clockwise around the corners from top left to bottom 13 | left.} 14 | 15 | \item{n}{number of rows and columns of colour matrix (default = 10; if length 16 | 2, then dimensions of rectangle).} 17 | 18 | \item{rotate}{rotates the entire colour matrix by the specified angle (in 19 | degrees).} 20 | 21 | \item{plot}{plots the colour matrix.} 22 | } 23 | \value{ 24 | \code{Matrix} of colours. 25 | } 26 | \description{ 27 | Generates a 2D matrix of graduated colours by interpolating between the given 28 | colours specifying the four corners. 29 | } 30 | \examples{ 31 | cm <- colour_mat (n = 5, cols = rainbow (4), rotate = 90, plot = TRUE) 32 | 33 | # 'colour_mat' is intended primarily for use in colouring groups added with 34 | # 'add_osm_groups' using the 'colmat = TRUE' option: 35 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 36 | # Generate random points to serve as group centres 37 | set.seed (2) 38 | ngroups <- 6 39 | x <- bbox [1, 1] + runif (ngroups) * diff (bbox [1, ]) 40 | y <- bbox [2, 1] + runif (ngroups) * diff (bbox [2, ]) 41 | groups <- cbind (x, y) 42 | groups <- sfheaders::sf_point (groups) 43 | # plot a basemap and add groups 44 | map <- osm_basemap (bbox = bbox, bg = "gray20") 45 | map <- add_osm_groups (map, 46 | obj = london$dat_BNR, group = groups, 47 | cols = rainbow (4), colmat = TRUE, rotate = 90 48 | ) 49 | print_osm_map (map) 50 | } 51 | \seealso{ 52 | \code{\link{add_osm_groups}}. 53 | 54 | Other colours: 55 | \code{\link{adjust_colours}()} 56 | } 57 | \concept{colours} 58 | -------------------------------------------------------------------------------- /man/connect_highways.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/connect-highways.R 3 | \name{connect_highways} 4 | \alias{connect_highways} 5 | \title{connect_highways} 6 | \usage{ 7 | connect_highways(highways, bbox, plot = FALSE) 8 | } 9 | \arguments{ 10 | \item{highways}{A vector of highway names passed directly to the Overpass 11 | API. Wildcards and whitespaces are `.'; for other options see online help for 12 | the overpass API.} 13 | 14 | \item{bbox}{the bounding box for the map. A 2-by-2 matrix of 4 elements with 15 | columns of min and max values, and rows of x and y values.} 16 | 17 | \item{plot}{If \code{TRUE}, then all OSM data for each highway is plotted and 18 | the final cycle overlaid.} 19 | } 20 | \value{ 21 | A single set of \code{SpatialPoints} containing the lat-lon 22 | coordinates of the cyclic line connecting all given streets. 23 | } 24 | \description{ 25 | Takes a list of highways names which must enclose an internal area, and 26 | returns a \code{SpatialLines} object containing a sequence of OSM nodes which 27 | cyclically connect all highways. Will fail if the streets do not form a 28 | cycle. 29 | } 30 | \note{ 31 | \enumerate{ 32 | \item \code{connect_highways} is primarily intended to provide a means to 33 | define boundaries of groups which can then be highlighted using 34 | \code{\link{add_osm_groups}}. 35 | \item This function can not be guaranteed failsafe owing both to the 36 | inherently unpredictable nature of OpenStreetMap, as well as to the unknown 37 | relationships between named highways. The \code{plot} option enables 38 | problematic cases to be examined and hopefully resolved. The function is 39 | still experimental, so please help further improvements by reporting any 40 | problems! 41 | } 42 | } 43 | \examples{ 44 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 45 | highways <- c ( 46 | "Monmouth.St", "Short.?s.Gardens", "Endell.St", "Long.Acre", 47 | "Upper.Saint.Martin" 48 | ) 49 | # Note that dots signify "anything", including whitespace and apostrophes, 50 | # and that '?' denotes optional previous character and so here matches 51 | # both "Shorts Gardens" and "Short's Gardens" 52 | \dontrun{ 53 | highways1 <- connect_highways (highways = highways, bbox = bbox, plot = TRUE) 54 | highways <- c ("Endell.St", "High.Holborn", "Drury.Lane", "Long.Acre") 55 | highways2 <- connect_highways (highways = highways, bbox = bbox, plot = TRUE) 56 | } 57 | 58 | # Use of 'connect_highways' to highlight a region on a map 59 | map <- osm_basemap (bbox = bbox, bg = "gray20") 60 | # dat_B <- extract_osm_data (key = "building", 61 | # value = "!residential", 62 | # bbox = bbox) 63 | # Those data are part of 'osmplotr': 64 | dat_BNR <- london$dat_BNR # Non-residential buildings 65 | \dontrun{ 66 | groups <- list (highways1, highways2) 67 | map <- add_osm_groups (map, 68 | obj = dat_BNR, groups = groups, 69 | cols = c ("red", "blue"), bg = "gray40" 70 | ) 71 | print_osm_map (map) 72 | } 73 | } 74 | \seealso{ 75 | \code{\link{add_osm_groups}}. 76 | 77 | Other data-extraction: 78 | \code{\link{extract_osm_objects}()}, 79 | \code{\link{get_bbox}()} 80 | } 81 | \concept{data-extraction} 82 | -------------------------------------------------------------------------------- /man/extract_osm_objects.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/extract-osm-objects.R 3 | \name{extract_osm_objects} 4 | \alias{extract_osm_objects} 5 | \title{extract_osm_objects} 6 | \usage{ 7 | extract_osm_objects( 8 | bbox, 9 | key = NULL, 10 | value, 11 | extra_pairs, 12 | return_type, 13 | sf = TRUE, 14 | geom_only = FALSE, 15 | quiet = FALSE 16 | ) 17 | } 18 | \arguments{ 19 | \item{bbox}{the bounding box within which all key-value objects should be 20 | downloaded. A 2-by-2 matrix of 4 elements with columns of min and 21 | max values, and rows of x and y values.} 22 | 23 | \item{key}{OSM key to search for. Useful keys include \code{building}, 24 | \code{waterway}, \code{natural}, \code{grass}, \code{park}, \code{amenity}, 25 | \code{shop}, \code{boundary}, and \code{highway}. Others will be passed 26 | directly to the overpass API and may not necessarily return results.} 27 | 28 | \item{value}{OSM value to match to key. If \code{NULL}, all keys will be 29 | returned. Negation is specified by \code{!value}.} 30 | 31 | \item{extra_pairs}{A list of additional \code{key-value} pairs to be passed 32 | to the overpass API.} 33 | 34 | \item{return_type}{If specified, force return of spatial (\code{point}, 35 | \code{line}, \code{polygon}, \code{multiline}, \code{multipolygon}) objects. 36 | \code{return_type = 'line'} will, for example, always return a 37 | SpatialLinesDataFrame. If not specified, defaults to 'sensible' values (for 38 | example, \code{lines} for highways, \code{points} for trees, \code{polygons} 39 | for buildings).} 40 | 41 | \item{sf}{If \code{TRUE}, return Simple Features (\code{sf}) objects; 42 | otherwise Spatial (\code{sp}) objects.} 43 | 44 | \item{geom_only}{If \code{TRUE}, return only those OSM data describing the 45 | geometric object; otherwise return all data describing each object.} 46 | 47 | \item{quiet}{If \code{FALSE}, provides notification of progress.} 48 | } 49 | \value{ 50 | Either a \code{SpatialPointsDataFrame}, \code{SpatialLinesDataFrame}, 51 | or \code{SpatialPolygonsDataFrame}. 52 | } 53 | \description{ 54 | Downloads OSM XML objects and converts to \code{sp} objects 55 | (\code{SpatialPointsDataFrame}, \code{SpatialLinesDataFrame}, or 56 | \code{SpatialPolygonsDataFrame}). 57 | } 58 | \examples{ 59 | \dontrun{ 60 | bbox <- get_bbox (c (-0.13, 51.50, -0.11, 51.52)) 61 | dat_B <- extract_osm_objects (key = "building", bbox = bbox) 62 | dat_H <- extract_osm_objects (key = "highway", bbox = bbox) 63 | dat_BR <- extract_osm_objects ( 64 | key = "building", 65 | value = "residential", 66 | bbox = bbox 67 | ) 68 | dat_HP <- extract_osm_objects ( 69 | key = "highway", 70 | value = "primary", 71 | bbox = bbox 72 | ) 73 | dat_HNP <- extract_osm_objects ( 74 | key = "highway", 75 | value = "!primary", 76 | bbox = bbox 77 | ) 78 | extra_pairs <- c ("name", "Royal.Festival.Hall") 79 | dat <- extract_osm_objects ( 80 | key = "building", extra_pairs = extra_pairs, 81 | bbox = bbox 82 | ) 83 | } 84 | } 85 | \seealso{ 86 | \code{\link{add_osm_objects}}. 87 | 88 | Other data-extraction: 89 | \code{\link{connect_highways}()}, 90 | \code{\link{get_bbox}()} 91 | } 92 | \concept{data-extraction} 93 | -------------------------------------------------------------------------------- /man/figures/map1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/man/figures/map1.png -------------------------------------------------------------------------------- /man/figures/map2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/man/figures/map2.png -------------------------------------------------------------------------------- /man/figures/map3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/man/figures/map3.png -------------------------------------------------------------------------------- /man/figures/map4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/man/figures/map4.png -------------------------------------------------------------------------------- /man/figures/map5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/man/figures/map5.png -------------------------------------------------------------------------------- /man/figures/map6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/man/figures/map6.png -------------------------------------------------------------------------------- /man/figures/map7.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/man/figures/map7.png -------------------------------------------------------------------------------- /man/get_bbox.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get-bbox.R 3 | \name{get_bbox} 4 | \alias{get_bbox} 5 | \title{get_bbox} 6 | \usage{ 7 | get_bbox(latlon) 8 | } 9 | \arguments{ 10 | \item{latlon}{A vector of (longitude, latitude, longitude, latitude) values.} 11 | } 12 | \value{ 13 | A 2-by-2 matrix of 4 elements with columns of min and max values, and 14 | rows of x and y values. 15 | } 16 | \description{ 17 | Converts a string of latitudes and longitudes into a square matrix to be 18 | passed as a \code{bbox} argument (to \code{\link{extract_osm_objects}}, 19 | \code{\link{osm_basemap}}, or \code{\link{make_osm_map}}). 20 | } 21 | \examples{ 22 | bbox <- get_bbox (c (-0.15, 51.5, -0.1, 51.52)) 23 | } 24 | \seealso{ 25 | Other data-extraction: 26 | \code{\link{connect_highways}()}, 27 | \code{\link{extract_osm_objects}()} 28 | } 29 | \concept{data-extraction} 30 | -------------------------------------------------------------------------------- /man/london.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/osmplotr.R 3 | \docType{data} 4 | \name{london} 5 | \alias{london} 6 | \title{london} 7 | \format{ 8 | A list of spatial objects 9 | } 10 | \description{ 11 | A list of \code{Simple Features} (\code{sf}) \code{data.frame} objects 12 | containing OpenStreetMap polygons, lines, and points for various 13 | OpenStreetMap structures in a small part of central London, U.K. (\code{bbox 14 | = -0.13, 51.51, -0.11, 51.52}). The list includes: 15 | \enumerate{ 16 | \item \code{dat_H}: 974 non-primary highways as linestrings 17 | \item \code{dat_HP}: 159 primary highways as linestrings 18 | \item \code{dat_BNR}: 1,716 non-residential buildings as polygons 19 | \item \code{dat_BR}: 43 residential buildings as polygons 20 | \item \code{dat_BC}: 67 commerical buildings as polygons 21 | \item \code{dat_A}: 372 amenities as polygons 22 | \item \code{dat_P}: 13 parks as polygons 23 | \item \code{dat_T}: 688 trees as points 24 | \item \code{dat_RFH}: 1 polygon representing Royal Festival Hall 25 | \item \code{dat_ST}: 1 polygon representing 150 Stamford Street 26 | } 27 | } 28 | \details{ 29 | The vignette \code{basic-maps} details how these data were downloaded. Note 30 | that these internal versions have had all descriptive data removed other than 31 | their names, geometries, and their OSM identification numbers. 32 | } 33 | \concept{data} 34 | \keyword{datasets} 35 | -------------------------------------------------------------------------------- /man/make_osm_map.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/make-osm-map.R 3 | \name{make_osm_map} 4 | \alias{make_osm_map} 5 | \title{make_osm_map} 6 | \usage{ 7 | make_osm_map( 8 | bbox, 9 | osm_data, 10 | structures = osm_structures(), 11 | dat_prefix = "dat_" 12 | ) 13 | } 14 | \arguments{ 15 | \item{bbox}{The bounding box for the map. A 2-by-2 matrix of 4 elements with 16 | columns of min and max values, and rows of x and y values. If \code{NULL}, 17 | \code{bbox} is taken from the largest extent of OSM objects in 18 | \code{osm_data}.} 19 | 20 | \item{osm_data}{A list of OSM objects as returned from 21 | \code{\link{extract_osm_objects}}. These objects may be included in the plot 22 | without downloading. These should all be named with the stated 23 | \code{dat_prefix} and have suffixes as given in \code{structures}.} 24 | 25 | \item{structures}{A \code{data.frame} specifying types of OSM structures as 26 | returned from \code{\link{osm_structures}}, and potentially modified to alter 27 | lists of structures to be plotted, and their associated colours. Objects are 28 | overlaid on plot according to the order given in \code{structures}.} 29 | 30 | \item{dat_prefix}{Prefix for data structures (default \code{dat_}). Final 31 | data structures are created by appending the suffixes from 32 | \code{\link{osm_structures}}.} 33 | } 34 | \value{ 35 | List of two components: 36 | \enumerate{ 37 | \item List of OSM structures each as 38 | \code{Spatial(Points/Lines/Polygons)DataFrame} and appended to 39 | \code{osm_data} (which is \code{NULL} by default), and 40 | \item The \code{map} as a \code{ggplot2} object 41 | } 42 | } 43 | \description{ 44 | Makes an entire OSM map for the given bbox using the submitted data, or by 45 | downloading data if none submitted. This is a convenience function enabling 46 | an entire map to be produced according to the graphical format specified with 47 | the \code{structures} argument. 48 | } 49 | \section{Note}{ 50 | 51 | If \code{osm_data} is not given, then data will be downloaded, which can take 52 | some time. Progress is dumped to screen. 53 | } 54 | 55 | \examples{ 56 | structures <- c ("highway", "park") 57 | structs <- osm_structures (structures = structures, col_scheme = "light") 58 | # make_osm_map returns potentially modified list of data using the provided 59 | # 'london' data for highways and parks. 60 | dat <- make_osm_map (osm_data = london, structures = structs) 61 | # or download data automatically using a defined bounding boox 62 | bbox <- get_bbox (c (-0.14, 51.51, -0.12, 51.52)) 63 | \donttest{ 64 | dat <- make_osm_map (bbox = bbox, structures = structs) 65 | print_osm_map (dat$map) 66 | } 67 | } 68 | \seealso{ 69 | \code{\link{osm_basemap}}, \code{\link{add_osm_objects}}. 70 | 71 | Other construction: 72 | \code{\link{add_osm_objects}()}, 73 | \code{\link{osm_basemap}()}, 74 | \code{\link{osm_structures}()}, 75 | \code{\link{print_osm_map}()} 76 | } 77 | \concept{construction} 78 | -------------------------------------------------------------------------------- /man/osm_basemap.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/osm-basemap.R 3 | \name{osm_basemap} 4 | \alias{osm_basemap} 5 | \title{osm_basemap} 6 | \usage{ 7 | osm_basemap(bbox, structures, bg = "gray20") 8 | } 9 | \arguments{ 10 | \item{bbox}{bounding box (Latitude-longitude range) to be plotted. A 2-by-2 11 | matrix of 4 elements with columns of min and max values, and rows of x and y 12 | values. Can also be an object of class \code{sf}, for example as returned 13 | from \code{extract_osm_objects} or the \code{osmdata} package, in which case 14 | the bounding box will be extracted from the object coordinates.} 15 | 16 | \item{structures}{Data frame returned by \code{\link{osm_structures}} used 17 | here to specify background colour of plot; if missing, the colour is 18 | specified by \code{bg}.} 19 | 20 | \item{bg}{Background colour of map (default = \code{gray20}) only if 21 | \code{structs} not given).} 22 | } 23 | \value{ 24 | A \code{ggplot2} object containing the base \code{map}. 25 | } 26 | \description{ 27 | Generates a base OSM plot ready for polygon, line, and point objects to be 28 | overlain with \code{\link{add_osm_objects}}. 29 | } 30 | \examples{ 31 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 32 | map <- osm_basemap (bbox = bbox, bg = "gray20") 33 | map <- add_osm_objects (map, london$dat_BNR, col = "gray40") 34 | print_osm_map (map) 35 | } 36 | \seealso{ 37 | \code{\link{add_osm_objects}}, \code{\link{make_osm_map}}. 38 | 39 | Other construction: 40 | \code{\link{add_osm_objects}()}, 41 | \code{\link{make_osm_map}()}, 42 | \code{\link{osm_structures}()}, 43 | \code{\link{print_osm_map}()} 44 | } 45 | \concept{construction} 46 | -------------------------------------------------------------------------------- /man/osm_line2poly.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/line2poly.R 3 | \name{osm_line2poly} 4 | \alias{osm_line2poly} 5 | \title{osm_line2poly} 6 | \usage{ 7 | osm_line2poly(obj, bbox) 8 | } 9 | \arguments{ 10 | \item{obj}{A Simple Features (\code{sf}) data frame of lines, typically as 11 | returned by \code{\link{extract_osm_objects}}, or by 12 | \code{osmdata::osmdata_sf}.} 13 | 14 | \item{bbox}{bounding box (Latitude-longitude range) to be plotted. A 2-by-2 15 | matrix of 4 elements with columns of min and max values, and rows of x and y 16 | values. Can also be an object of class \code{sf}, for example as returned 17 | from \code{extract_osm_objects} or the \code{osmdata} package, in which case 18 | the bounding box will be extracted from the object coordinates.} 19 | } 20 | \value{ 21 | A list of three Simple Features (\code{sf}) data frames, labelled sea 22 | islands and land. 23 | } 24 | \description{ 25 | Converts \code{sf::sfc_LINSTRING} objects to polygons by connecting end 26 | points around the given bounding box. This is particularly useful for 27 | plotting water and land delineated by coastlines. Coastlines in OpenStreetMap 28 | are lines, not polygons, and so there is no directly way to plot ocean water 29 | distinct from land. This function enables that by connecting the end points 30 | of coastline \code{LINESTRING} objects to form closed polygons. 31 | } 32 | \details{ 33 | This is a tricky problem for a number of reasons, and the current 34 | implementation may not be correct, although it does successfully deal with a 35 | few tough situations. Some of the issues are: an osm coastline query returns 36 | a mixture of "ways" and polygons. 37 | 38 | Polygons correspond to islands, but not all islands are polygons. A "way" is 39 | a connected set of points with the land on the left. A piece of coastline in 40 | a bounding box may consist of multiple ways, which need to be connected 41 | together to create a polygon. Also, ways extend outside the query bounding 42 | box, and may join other ways that enter the bounding box (e.g ends of a 43 | peninsula). The degree to which this happens depends on the scale of the 44 | bounding box. Coastlines may enter at any bounding box edge and exit at any 45 | other, including the one they entered from. 46 | } 47 | \examples{ 48 | # This example uses the \code{osmdata} package to extract data from 49 | # a named bounding box 50 | \dontrun{ 51 | library (magrittr) 52 | library (osmdata) 53 | bb <- osmdata::getbb ("melbourne, australia") 54 | coast <- extract_osm_objects ( 55 | bbox = bb, 56 | key = "natural", 57 | value = "coastline", 58 | return_type = "line" 59 | ) 60 | coast <- osm_line2poly (coast, bbox = bb) 61 | # The following map then colours in just the ocean: 62 | map <- osm_basemap (bbox = bb) \%>\% 63 | add_osm_objects (coast$sea, col = "lightsteelblue") \%>\% 64 | print_osm_map () 65 | } 66 | } 67 | \seealso{ 68 | Other map-extra: 69 | \code{\link{add_axes}()}, 70 | \code{\link{add_colourbar}()} 71 | } 72 | \concept{map-extra} 73 | -------------------------------------------------------------------------------- /man/osm_structures.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/osm-structures.R 3 | \name{osm_structures} 4 | \alias{osm_structures} 5 | \title{osm_structures} 6 | \usage{ 7 | osm_structures( 8 | structures = c("building", "amenity", "waterway", "grass", "natural", "park", 9 | "highway", "boundary", "tree"), 10 | col_scheme = "dark" 11 | ) 12 | } 13 | \arguments{ 14 | \item{structures}{The vector of types of structures (defaults listed in 15 | \code{\link{extract_osm_objects}}).} 16 | 17 | \item{col_scheme}{Colour scheme for the plot (current options include 18 | \code{dark} and \code{light}).} 19 | } 20 | \value{ 21 | \code{data.frame} of structures, \code{key-value} pairs, 22 | corresponding prefixes, and colours. 23 | } 24 | \description{ 25 | For the given vector of structure types returns a \code{data.frame} 26 | containing two columns of corresponding OpenStreetMap \code{key-value} pairs, 27 | one column of unambiguous suffixes to be appended to the objects returned by 28 | \code{\link{extract_osm_objects}}, and one column specifying colours. This 29 | \code{data.frame} may be subsequently modified as desired, and ultimately 30 | passed to \code{\link{make_osm_map}} to automate map production. 31 | } 32 | \examples{ 33 | # Default structures: 34 | osm_structures () 35 | # user-defined structures: 36 | structures <- c ("highway", "park", "ameniiy", "tree") 37 | structs <- osm_structures (structures = structures, col_scheme = "light") 38 | # make_osm_map returns potentially modified list of data 39 | dat <- make_osm_map (osm_data = london, structures = structs) 40 | # map contains updated $osm_data and actual map in $map 41 | \donttest{ 42 | print_osm_map (dat$map) 43 | } 44 | } 45 | \seealso{ 46 | \code{\link{make_osm_map}}. 47 | 48 | Other construction: 49 | \code{\link{add_osm_objects}()}, 50 | \code{\link{make_osm_map}()}, 51 | \code{\link{osm_basemap}()}, 52 | \code{\link{print_osm_map}()} 53 | } 54 | \concept{construction} 55 | -------------------------------------------------------------------------------- /man/osmplotr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/osmplotr.R 3 | \docType{package} 4 | \name{osmplotr} 5 | \alias{osmplotr} 6 | \alias{osmplotr-package} 7 | \title{osmplotr.} 8 | \description{ 9 | Produces customisable images of OpenStreetMap (OSM) data and enables data 10 | visualisation using OSM objects. Extracts data using the overpass API. 11 | Contains the following functions, data, and vignettes. 12 | } 13 | \section{Data Functions}{ 14 | 15 | \itemize{ 16 | \item \code{\link{extract_osm_objects}}: Download arbitrary OSM objects 17 | \item \code{\link{connect_highways}}: Returns points sequentially connecting 18 | list of named highways 19 | } 20 | } 21 | 22 | \section{Basic Plotting Functions (without data)}{ 23 | 24 | \itemize{ 25 | \item \code{\link{add_axes}}: Overlay longitudinal and latitudinal axes on 26 | plot 27 | \item \code{\link{add_osm_objects}}: Overlay arbitrary OSM objects 28 | \item \code{\link{make_osm_map}}: Automate map production with structures 29 | defined in \code{\link{osm_structures}} 30 | \item \code{\link{osm_structures}}: Define structures and graphics schemes 31 | for automating map production 32 | \item \code{\link{osm_basemap}}: Initiate a \code{ggplot2} object for an OSM 33 | map 34 | \item \code{\link{print_osm_map}}: Print a map to specified graphics 35 | device 36 | } 37 | } 38 | 39 | \section{Advanced Plotting Functions (with data)}{ 40 | 41 | \itemize{ 42 | \item \code{\link{add_osm_groups}}: Overlay groups of objects using specified 43 | colour scheme 44 | \item \code{\link{add_osm_surface}}: Overlay data surface by interpolating 45 | given data 46 | \item \code{\link{add_colourbar}}: Overlay a scaled colourbar for data added 47 | with \code{\link{add_osm_surface}} 48 | } 49 | } 50 | 51 | \section{Colour Manipulation Functions}{ 52 | 53 | \itemize{ 54 | \item \code{\link{adjust_colours}}: Lighted or darken given colours by 55 | specified amount 56 | \item \code{\link{colour_mat}}: Generate continuous 2D spatial matrix of 57 | colours 58 | } 59 | } 60 | 61 | \section{Other Functions}{ 62 | 63 | \itemize{ 64 | \item \code{\link{get_bbox}}: return bounding box from input vector 65 | } 66 | } 67 | 68 | \section{Data}{ 69 | 70 | \itemize{ 71 | \item \code{\link{london}}: OSM Data from a small portion of central London 72 | } 73 | } 74 | 75 | \section{Vignettes}{ 76 | 77 | \itemize{ 78 | \item \code{basic-maps}: Describes basics of downloading data and making 79 | custom maps 80 | \item \code{data-maps}: Describes how map elements can be coloured according 81 | to user-provided data, whether categorical or continuous 82 | } 83 | } 84 | 85 | \seealso{ 86 | Useful links: 87 | \itemize{ 88 | \item \url{https://docs.ropensci.org/osmplotr/} 89 | \item \url{https://github.com/ropensci/osmplotr} 90 | \item Report bugs at \url{https://github.com/ropensci/osmplotr/issues} 91 | } 92 | 93 | } 94 | \author{ 95 | \strong{Maintainer}: Mark Padgham \email{mark.padgham@email.com} 96 | 97 | Authors: 98 | \itemize{ 99 | \item Richard Beare 100 | } 101 | 102 | Other contributors: 103 | \itemize{ 104 | \item Finkelstein Noam (Author of included stub.R code) [contributor, copyright holder] 105 | \item Bartnik Lukasz (Author of included stub.R code) [contributor, copyright holder] 106 | } 107 | 108 | } 109 | \concept{package} 110 | -------------------------------------------------------------------------------- /man/print_osm_map.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print-osm-map.R 3 | \name{print_osm_map} 4 | \alias{print_osm_map} 5 | \title{print_osm_map} 6 | \usage{ 7 | print_osm_map( 8 | map, 9 | width, 10 | height, 11 | filename, 12 | device, 13 | units = c("in", "cm", "mm", "px"), 14 | dpi = 300 15 | ) 16 | } 17 | \arguments{ 18 | \item{map}{The map to be printed; a \pkg{ggplot2} object produced by 19 | \code{osmplotr}.} 20 | 21 | \item{width}{Desired width of graphics device.} 22 | 23 | \item{height}{Desired height of graphics device. Ignored if width specified.} 24 | 25 | \item{filename}{Name of file to which map is to be printed.} 26 | 27 | \item{device}{Type of graphics device (extracted from filename extension if 28 | not explicitly provided).} 29 | 30 | \item{units}{Units for height and width of graphics device.} 31 | 32 | \item{dpi}{Resolution of graphics device (dots-per-inch).} 33 | } 34 | \value{ 35 | (Invisibly) the \pkg{ggplot2} map object. 36 | } 37 | \description{ 38 | Prints an OSM map produced with \code{osmplotr} to a specified graphics 39 | device. 40 | } 41 | \examples{ 42 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 43 | map <- osm_basemap (bbox = bbox, bg = "gray20") 44 | map <- add_osm_objects (map, london$dat_BNR, col = "gray40") 45 | print_osm_map (map, width = 7) # prints to screen device 46 | \donttest{ 47 | print_osm_map (map, file = "map.png", width = 500, units = "px") 48 | file.remove ("map.png") 49 | } 50 | } 51 | \seealso{ 52 | \code{\link{osm_basemap}}, \code{\link{add_osm_objects}}, 53 | \code{\link{make_osm_map}}. 54 | 55 | Other construction: 56 | \code{\link{add_osm_objects}()}, 57 | \code{\link{make_osm_map}()}, 58 | \code{\link{osm_basemap}()}, 59 | \code{\link{osm_structures}()} 60 | } 61 | \concept{construction} 62 | -------------------------------------------------------------------------------- /tests/stub.R: -------------------------------------------------------------------------------- 1 | # Only used for test/testthat 2 | # https://github.com/n-s-f/mockery/blob/master/R/stub.R 3 | # COPYRIGHT HOLDER: Noam Finkelstein, Lukasz Bartnik 4 | 5 | #' Replace a function with a stub. 6 | #' 7 | #' The result of calling \code{stub} is that, when \code{where} 8 | #' is invoked and when it internally makes a call to \code{what}, 9 | #' \code{how} is going to be called instead. 10 | #' 11 | #' This is much more limited in scope in comparison to 12 | #' \code{\link[testthat]{with_mock}} which effectively replaces 13 | #' \code{what} everywhere. In other words, when using \code{with_mock} 14 | #' and regardless of the number of intermediate calls, \code{how} is 15 | #' always called instead of \code{what}. However, using this API, 16 | #' the replacement takes place only for a single function \code{where} 17 | #' and only for calls originating in that function. 18 | #' 19 | #' 20 | #' @name stub 21 | #' @rdname stub 22 | NULL 23 | 24 | # \code{remote_stub} reverses the effect of \code{stub}. 25 | 26 | 27 | #' @param where Function to be called that will in turn call 28 | #' \code{what}. 29 | #' @param what Name of the function you want to stub out (a 30 | #' \code{character} string). 31 | #' @param how Replacement function (also a \code{mock} function) 32 | #' or a return value for which a function will be created 33 | #' automatically. 34 | #' 35 | #' @export 36 | #' @rdname stub 37 | #' 38 | #' @examples 39 | #' f <- function () TRUE 40 | #' g <- function () f () 41 | #' stub (g, "f", FALSE) 42 | #' 43 | #' # now g() returns FALSE because f() has been stubbed out 44 | #' g () 45 | #' 46 | `stub` <- function (where, what, how) { 47 | 48 | # `where` needs to be a function 49 | where_name <- deparse (substitute (where)) 50 | stopifnot (is.function (where)) 51 | 52 | # `what` needs to be a character value 53 | stopifnot (is.character (what), length (what) == 1) 54 | 55 | # this is where a stub is going to be assigned in 56 | env <- new.env (parent = environment (where)) 57 | 58 | if (grepl ("::", what)) { 59 | elements <- strsplit (what, "::") 60 | what <- paste (elements [[1]] [1], elements [[1]] [2], sep = "XXX") 61 | 62 | stub_list <- c (what) 63 | if ("stub_list" %in% names (attributes (get ("::", env)))) { 64 | stub_list <- c ( 65 | stub_list, 66 | attributes (get ("::", env)) [["stub_list"]] 67 | ) 68 | } 69 | 70 | create_new_name <- create_create_new_name_function (stub_list, env) 71 | assign ("::", create_new_name, env) 72 | } 73 | 74 | if (!is.function (how)) { 75 | assign (what, function (...) how, env) 76 | } else { 77 | assign (what, how, env) 78 | } 79 | 80 | environment (where) <- env 81 | assign (where_name, where, parent.frame ()) 82 | } 83 | 84 | 85 | create_create_new_name_function <- function (stub_list, env) { # nolint 86 | 87 | create_new_name <- function (pkg, func) { 88 | 89 | pkg_name <- deparse (substitute (pkg)) 90 | func_name <- deparse (substitute (func)) 91 | for (stub in stub_list) { 92 | if (paste (pkg_name, func_name, sep = "XXX") == stub) { 93 | return (eval (parse (text = stub), env)) 94 | } 95 | } 96 | return (eval (parse (text = paste (pkg_name, func_name, sep = "::")))) 97 | } 98 | attributes (create_new_name) <- list (stub_list = stub_list) 99 | return (create_new_name) 100 | } 101 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library (testthat) 2 | library (osmplotr) 3 | 4 | test_check ("osmplotr") 5 | -------------------------------------------------------------------------------- /tests/testthat/test-add-axes.R: -------------------------------------------------------------------------------- 1 | context ("add-axes") 2 | 3 | test_that ("basemap object", { 4 | expect_error (add_axes (), "map must be supplied to add_axes") 5 | expect_error (add_axes (NULL), "map must be a ggplot2 object") 6 | expect_error ( 7 | add_axes (colour = "red"), 8 | "map must be supplied to add_axes" 9 | ) 10 | }) 11 | 12 | test_that ("colour", { 13 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 14 | map <- osm_basemap (bbox = bbox, bg = "gray20") 15 | expect_error (add_axes (map, colour = "a"), "Invalid colour: a") 16 | expect_silent (add_axes (map, color = "red")) 17 | }) 18 | 19 | test_that ("pos", { 20 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 21 | map <- osm_basemap (bbox = bbox, bg = "gray20") 22 | expect_warning ( 23 | add_axes (map, pos = 1:3 / 10), 24 | "Only the first two elements of pos will be used" 25 | ) 26 | expect_warning ( 27 | add_axes (map, pos = "a"), 28 | "pos must be numeric; using default values" 29 | ) 30 | expect_silent (add_axes (map, position = 0.1)) 31 | # NOTE: there are grep problems in test_that for this expect_warning 32 | # expect_warning (add_axes (map, pos = c(-0.1,1.2)), 33 | # "pos not in [0,1]; using default values") 34 | }) 35 | 36 | test_that ("alpha values", { 37 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 38 | map <- osm_basemap (bbox = bbox, bg = "gray20") 39 | # NOTE: there are grep problems in test_that for this expect_warning 40 | # expect_warning (add_axes (map, alpha = -1), 41 | # "alpha not in [0,1]; using default of 0.4") 42 | expect_warning ( 43 | add_axes (map, alpha = 1:2), 44 | "Only the first element of alpha will be used" 45 | ) 46 | expect_warning ( 47 | add_axes (map, alpha = "a"), 48 | "alpha must be numeric; using default value" 49 | ) 50 | }) 51 | 52 | test_that ("fontsize", { 53 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 54 | map <- osm_basemap (bbox = bbox, bg = "gray20") 55 | expect_warning ( 56 | add_axes (map, fontsize = -1), 57 | "fontsize must be positive; using default value" 58 | ) 59 | expect_warning ( 60 | add_axes (map, fontsize = 1:2), 61 | "Only the first element of fontsize will be used" 62 | ) 63 | expect_warning ( 64 | add_axes (map, fontsize = "a"), 65 | "fontsize must be numeric; using default value" 66 | ) 67 | expect_silent (add_axes (map, size = 1)) 68 | expect_warning ( 69 | add_axes (map, size = -1), 70 | "fontsize must be positive; using default value" 71 | ) 72 | expect_warning ( 73 | add_axes (map, size = 1:2), 74 | "Only the first element of fontsize will be used" 75 | ) 76 | expect_warning ( 77 | add_axes (map, size = "a"), 78 | "fontsize must be numeric; using default value" 79 | ) 80 | }) 81 | 82 | test_that ("other_font_properties", { 83 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 84 | map <- osm_basemap (bbox = bbox, bg = "gray20") 85 | expect_silent (add_axes (map, face = 1)) 86 | expect_silent (add_axes (map, family = 1)) 87 | }) 88 | -------------------------------------------------------------------------------- /tests/testthat/test-add-colourbar.R: -------------------------------------------------------------------------------- 1 | context ("add-colourbar") 2 | 3 | test_that ("basemap object", { 4 | expect_error (add_colourbar (), "map must be supplied") 5 | expect_error (add_colourbar (NULL), "cols must be specified") 6 | }) 7 | 8 | test_that ("colours", { 9 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 10 | map <- osm_basemap (bbox = bbox, bg = "gray20") 11 | cols <- heat.colors (10) 12 | zlims <- c (1, 10) 13 | expect_error ( 14 | add_colourbar (map), 15 | "cols must be specified in add_colourbar" 16 | ) 17 | expect_silent (add_colourbar (map, colors = cols, zlims = zlims)) 18 | expect_silent (add_colourbar (map, colours = cols, zlims = zlims)) 19 | }) 20 | 21 | test_that ("colourbar width", { 22 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 23 | map <- osm_basemap (bbox = bbox, bg = "gray20") 24 | cols <- heat.colors (10) 25 | zlims <- c (1, 10) 26 | expect_warning ( 27 | add_colourbar (map, 28 | cols = cols, zlims = zlims, 29 | barwidth = 1:3 30 | ), 31 | "Only the first two elements of barwidth will be used" 32 | ) 33 | expect_warning ( 34 | add_colourbar (map, 35 | cols = cols, zlims = zlims, 36 | barwidth = "a" 37 | ), 38 | "barwidth must be numeric; using default value" 39 | ) 40 | # NOTE: there are grep problems in test_that for this expect_warning 41 | # expect_warning (add_colourbar (map, cols = cols, zlims = zlims, 42 | # barwidth = -0.1), 43 | # "barwidth values not in [0,1]; default values will be used") 44 | expect_silent (add_colourbar (map, 45 | cols = cols, zlims = zlims, 46 | width = 0.1 47 | )) 48 | }) 49 | 50 | test_that ("colourbar length", { 51 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 52 | map <- osm_basemap (bbox = bbox, bg = "gray20") 53 | cols <- heat.colors (10) 54 | zlims <- c (1, 10) 55 | expect_warning ( 56 | add_colourbar (map, 57 | cols = cols, zlims = zlims, 58 | barlength = 1:3 / 10 59 | ), 60 | "Only the first two elements of barlength will be used" 61 | ) 62 | expect_warning ( 63 | add_colourbar (map, 64 | cols = cols, zlims = zlims, 65 | barlength = "a" 66 | ), 67 | "barlength must be numeric; using default value" 68 | ) 69 | # NOTE: there are grep problems in test_that for this expect_warning 70 | # expect_warning (add_colourbar (map, cols = cols, zlims = zlims, 71 | # barlength = -0.1), 72 | # "barlength values not in [0,1]; default values will be used") 73 | expect_silent (add_colourbar (map, 74 | cols = cols, zlims = zlims, 75 | length = 0.1 76 | )) 77 | }) 78 | 79 | test_that ("fontsize", { 80 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 81 | map <- osm_basemap (bbox = bbox, bg = "gray20") 82 | cols <- heat.colors (10) 83 | zlims <- c (1, 10) 84 | expect_warning ( 85 | add_colourbar (map, 86 | cols = cols, zlims = zlims, 87 | fontsize = -1 88 | ), 89 | "fontsize must be positive; using default value" 90 | ) 91 | expect_warning ( 92 | add_colourbar (map, 93 | cols = cols, zlims = zlims, 94 | fontsize = 1:2 95 | ), 96 | "Only the first element of fontsize will be used" 97 | ) 98 | expect_warning ( 99 | add_colourbar (map, 100 | cols = cols, zlims = zlims, 101 | fontsize = "a" 102 | ), 103 | "fontsize must be numeric; using default value" 104 | ) 105 | expect_silent (add_colourbar (map, 106 | cols = cols, zlims = zlims, 107 | size = 1 108 | )) 109 | }) 110 | 111 | test_that ("vertical", { 112 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 113 | map <- osm_basemap (bbox = bbox, bg = "gray20") 114 | cols <- heat.colors (10) 115 | zlims <- c (1, 10) 116 | expect_warning ( 117 | add_colourbar (map, 118 | cols = cols, zlims = zlims, 119 | vertical = 1:4 120 | ), 121 | "Only the first element of vertical will be used" 122 | ) 123 | expect_warning ( 124 | add_colourbar (map, 125 | cols = cols, zlims = zlims, 126 | vertical = "a" 127 | ), 128 | "vertical must be logical; using default" 129 | ) 130 | expect_silent (add_colourbar (map, 131 | cols = cols, zlims = zlims, 132 | vertical = TRUE 133 | )) 134 | expect_silent (add_colourbar (map, 135 | cols = cols, zlims = zlims, 136 | vertical = FALSE 137 | )) 138 | }) 139 | 140 | test_that ("alpha values", { 141 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 142 | map <- osm_basemap (bbox = bbox, bg = "gray20") 143 | cols <- heat.colors (10) 144 | zlims <- c (1, 10) 145 | # NOTE: there are grep problems in test_that for this expect_warning 146 | # expect_warning (add_colourbar (map, cols = cols, zlims = zlims, 147 | # alpha = -1), 148 | # "alpha not in [0,1]; using default value") 149 | expect_warning ( 150 | add_colourbar (map, 151 | cols = cols, zlims = zlims, 152 | alpha = 1:2 153 | ), 154 | "Only the first element of alpha will be used" 155 | ) 156 | expect_warning ( 157 | add_colourbar (map, 158 | cols = cols, zlims = zlims, 159 | alpha = "a" 160 | ), 161 | "alpha must be numeric; using default value" 162 | ) 163 | }) 164 | 165 | test_that ("other_font_properties", { 166 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 167 | map <- osm_basemap (bbox = bbox, bg = "gray20") 168 | cols <- heat.colors (10) 169 | zlims <- c (1, 10) 170 | expect_silent (add_colourbar (map, 171 | cols = cols, zlims = zlims, 172 | face = 1 173 | )) 174 | expect_silent (add_colourbar (map, 175 | cols = cols, zlims = zlims, 176 | family = 1 177 | )) 178 | }) 179 | -------------------------------------------------------------------------------- /tests/testthat/test-add-groups.R: -------------------------------------------------------------------------------- 1 | test_that ("basemap", { 2 | expect_error (add_osm_groups (), "map must be supplied") 3 | expect_error (add_osm_groups (NULL), "map must be a ggplot2 object") 4 | expect_error (add_osm_groups (cols = 1:4), "map must be supplied") 5 | }) 6 | 7 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 8 | dat_B <- london$dat_BNR # nolint 9 | dat_H <- london$dat_H # nolint 10 | 11 | pts <- cbind ( 12 | c (-0.115, -0.13, -0.13, -0.115), 13 | c (51.505, 51.505, 51.515, 51.515) 14 | ) 15 | pts1 <- cbind ( 16 | c (-0.115, -0.125, -0.125, -0.115), 17 | c (51.513, 51.513, 51.517, 51.517) 18 | ) 19 | pts2 <- cbind ( 20 | c (-0.111, -0.1145, -0.1145, -0.111), 21 | c (51.517, 51.517, 51.519, 51.519) 22 | ) 23 | grps <- list (pts, pts1, pts2) 24 | 25 | test_that ("obj", { 26 | map <- osm_basemap (bbox = bbox, bg = "gray20") 27 | expect_error (add_osm_groups (map), "obj must be supplied") 28 | expect_error ( 29 | add_osm_groups (map, obj = 1), 30 | "obj must be a spatial object" 31 | ) 32 | 33 | }) 34 | 35 | test_that ("cols", { 36 | map <- osm_basemap (bbox = bbox, bg = "gray20") 37 | expect_error (add_osm_groups (map, dat_B), "groups must be provided") 38 | # expect_silent (add_osm_groups (map, dat_B, groups = pts, bg = 1)) 39 | expect_message ( 40 | add_osm_groups (map, dat_B, 41 | groups = list (pts), 42 | cols = 1 43 | ), 44 | paste0 ( 45 | "Plotting one group only makes sense with bg; ", 46 | "defaulting to gray40" 47 | ) 48 | ) 49 | }) 50 | 51 | test_that ("group errors", { 52 | map <- osm_basemap (bbox = bbox, bg = "gray20") 53 | expect_error ( 54 | add_osm_groups (map, dat_B, bg = 1), 55 | "groups must be provided" 56 | ) 57 | expect_error ( 58 | add_osm_groups (map, dat_B, NULL), 59 | "groups must not be NULL" 60 | ) 61 | expect_error ( 62 | add_osm_groups (map, dat_B, 63 | groups = list (dat_H) 64 | ), 65 | "All groups must be numeric" 66 | ) 67 | grps1 <- list (pts, pts, "a") 68 | expect_error ( 69 | add_osm_groups (map, dat_B, groups = grps1), 70 | "All groups must be numeric" 71 | ) 72 | }) 73 | 74 | test_that ("groups with polygons", { 75 | map <- osm_basemap (bbox = bbox, bg = "gray20") 76 | expect_silent (map <- add_osm_groups (map, dat_B, 77 | groups = grps, 78 | bg = "gray40" 79 | )) 80 | # expect_silent (print_osm_map (map)) 81 | # dev.off (which = dev.cur ()) 82 | 83 | map <- osm_basemap (bbox = bbox, bg = "gray20") 84 | expect_silent (map <- add_osm_groups (map, dat_B, 85 | groups = grps 86 | )) 87 | }) 88 | 89 | test_that ("groups with lines", { 90 | map <- osm_basemap (bbox = bbox, bg = "gray20") 91 | 92 | map <- osm_basemap (bbox = bbox, bg = "gray20") 93 | expect_silent (map <- add_osm_groups (map, dat_H, 94 | groups = grps, 95 | bg = "gray40" 96 | )) 97 | # expect_silent (print_osm_map (map)) 98 | # dev.off (which = dev.cur ()) 99 | 100 | map <- osm_basemap (bbox = bbox, bg = "gray20") 101 | expect_silent (map <- add_osm_groups (map, dat_B, 102 | groups = grps 103 | )) 104 | }) 105 | 106 | test_that ("boundary", { 107 | map <- osm_basemap (bbox = bbox, bg = "gray20") 108 | expect_silent (map <- add_osm_groups (map, dat_B, grps, 1, 2, 109 | boundary = NULL 110 | )) 111 | }) 112 | 113 | test_that ("make_hull", { 114 | map <- osm_basemap (bbox = bbox, bg = "gray20") 115 | expect_warning ( 116 | map <- add_osm_groups (map, dat_B, pts, 1, 117 | bg = 2, 118 | make_hull = 1:2 119 | ), 120 | "make_hull has length > number of groups" 121 | ) 122 | expect_warning ( 123 | add_osm_groups (map, dat_B, grps, 1, 124 | bg = 2, 125 | make_hull = 1:2 126 | ), 127 | "make_hull should have length 1" 128 | ) 129 | expect_silent (map <- add_osm_groups (map, dat_B, grps, 1, 130 | bg = 2, 131 | make_hull = TRUE, 132 | border_width = 2 133 | )) 134 | }) 135 | 136 | test_that ("colourmat", { 137 | map <- osm_basemap (bbox = bbox, bg = "gray20") 138 | expect_silent (add_osm_groups (map, dat_B, grps, 1, 2, colmat = 1)) 139 | expect_error ( 140 | add_osm_groups (map, dat_B, grps, 1, 2, colmat = "a"), 141 | "colmat can not be coerced to logical" 142 | ) 143 | expect_silent (add_osm_groups (map, dat_B, grps, cols = 1:2, 2)) 144 | expect_silent (add_osm_groups (map, dat_B, grps, 145 | cols = 1:2, 2, 146 | rotate = "a" 147 | )) 148 | }) 149 | 150 | test_that ("rotate", { 151 | map <- osm_basemap (bbox = bbox, bg = "gray20") 152 | expect_silent (add_osm_groups (map, dat_B, grps, 1, 2, rotate = 1)) 153 | expect_silent (add_osm_groups (map, dat_B, grps, 1, 2, 154 | rotate = "abc" 155 | )) 156 | }) 157 | -------------------------------------------------------------------------------- /tests/testthat/test-add-objects.R: -------------------------------------------------------------------------------- 1 | context ("add-objects") 2 | 3 | test_that ("basemap", { 4 | expect_error (add_osm_objects (), "a non-null map must be provided") 5 | expect_error (add_osm_objects (NULL), "map must be a ggplot2 object") 6 | expect_error ( 7 | add_osm_objects (col = 1:4), 8 | "a non-null map must be provided" 9 | ) 10 | }) 11 | 12 | test_that ("obj", { 13 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 14 | map <- osm_basemap (bbox = bbox, bg = "gray20") 15 | expect_error (add_osm_objects (map), "obj must be provided") 16 | expect_error ( 17 | add_osm_objects (map, NULL), 18 | "obj must be a spatial object" 19 | ) 20 | }) 21 | 22 | test_that ("col", { 23 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 24 | map <- osm_basemap (bbox = bbox, bg = "gray20") 25 | obj <- london$dat_BNR 26 | expect_silent (add_osm_objects (map, obj)) 27 | expect_error ( 28 | add_osm_objects (map, obj, col = "a"), 29 | "Invalid colour: a" 30 | ) 31 | expect_error ( 32 | add_osm_objects (map, obj, col = -2), 33 | "Invalid colour: -2" 34 | ) 35 | expect_silent (add_osm_objects (map, obj, col = NA)) 36 | expect_error ( 37 | add_osm_objects (map, obj, col = NULL), 38 | "a non-null col must be provided" 39 | ) 40 | }) 41 | 42 | test_that ("border", { 43 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 44 | map <- osm_basemap (bbox = bbox, bg = "gray20") 45 | obj <- london$dat_BNR 46 | expect_silent (add_osm_objects (map, obj, border = NULL)) 47 | expect_error ( 48 | add_osm_objects (map, obj, border = "a"), 49 | "Invalid colour: a" 50 | ) 51 | expect_error ( 52 | add_osm_objects (map, obj, border = -2), 53 | "Invalid colour: -2" 54 | ) 55 | expect_silent (add_osm_objects (map, obj, border = NA)) 56 | }) 57 | 58 | test_that ("size", { 59 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 60 | map <- osm_basemap (bbox = bbox, bg = "gray20") 61 | obj <- london$dat_BNR 62 | expect_warning ( 63 | add_osm_objects (map, obj, size = NULL), 64 | "size should be numeric; defaulting to 0" 65 | ) 66 | expect_warning ( 67 | add_osm_objects (map, obj, size = "a"), 68 | "size should be numeric; defaulting to 0" 69 | ) 70 | expect_warning ( 71 | add_osm_objects (map, obj, size = -2), 72 | "size should be positive; defaulting to 0" 73 | ) 74 | obj <- london$dat_HP 75 | expect_warning ( 76 | add_osm_objects (map, obj, size = NULL), 77 | "size should be numeric; defaulting to 0" 78 | ) 79 | expect_warning ( 80 | add_osm_objects (map, obj, size = "a"), 81 | "size should be numeric; defaulting to 0.5" 82 | ) 83 | expect_warning ( 84 | add_osm_objects (map, obj, size = -2), 85 | "size should be positive; defaulting to 0.5" 86 | ) 87 | obj <- london$dat_T 88 | expect_warning ( 89 | add_osm_objects (map, obj, size = NULL), 90 | "size should be numeric; defaulting to 0" 91 | ) 92 | expect_warning ( 93 | add_osm_objects (map, obj, size = "a"), 94 | "size should be numeric; defaulting to 0.5" 95 | ) 96 | expect_warning ( 97 | add_osm_objects (map, obj, size = -2), 98 | "size should be positive; defaulting to 0.5" 99 | ) 100 | }) 101 | 102 | test_that ("shape", { 103 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 104 | map <- osm_basemap (bbox = bbox, bg = "gray20") 105 | obj <- london$dat_BNR # shape is ignored 106 | expect_silent (add_osm_objects (map, obj, shape = NULL)) 107 | expect_silent (add_osm_objects (map, obj, shape = "a")) 108 | expect_silent (add_osm_objects (map, obj, shape = -2)) 109 | obj <- london$dat_HP 110 | expect_warning ( 111 | add_osm_objects (map, obj, shape = NULL), 112 | "shape should be numeric; defaulting to 1" 113 | ) 114 | expect_warning ( 115 | add_osm_objects (map, obj, shape = "a"), 116 | "shape should be numeric; defaulting to 1" 117 | ) 118 | expect_warning ( 119 | add_osm_objects (map, obj, shape = -2), 120 | "shape should be positive; defaulting to 1" 121 | ) 122 | obj <- london$dat_T 123 | expect_warning ( 124 | add_osm_objects (map, obj, shape = NULL), 125 | "shape should be numeric; defaulting to 19" 126 | ) 127 | expect_warning ( 128 | add_osm_objects (map, obj, shape = "a"), 129 | "shape should be numeric; defaulting to 19" 130 | ) 131 | expect_warning ( 132 | add_osm_objects (map, obj, shape = -2), 133 | "shape should be positive; defaulting to 19" 134 | ) 135 | }) 136 | -------------------------------------------------------------------------------- /tests/testthat/test-add-surface.R: -------------------------------------------------------------------------------- 1 | context ("add-surface") 2 | 3 | test_that ("basemap", { 4 | expect_error (add_osm_surface (), "a non-null map must be provided") 5 | expect_error (add_osm_surface (NULL), "map must be a ggplot2 object") 6 | }) 7 | 8 | test_that ("obj", { 9 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 10 | map <- osm_basemap (bbox = bbox, bg = "gray20") 11 | expect_error (add_osm_surface (map), "obj must be provided") 12 | expect_error ( 13 | add_osm_surface (map, NULL), 14 | "obj must be a spatial object" 15 | ) 16 | }) 17 | 18 | test_that ("add surface", { 19 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 20 | map <- osm_basemap (bbox = bbox, bg = "gray20") 21 | obj <- london$dat_BNR 22 | expect_error (add_osm_surface (map, obj), "dat can not be NULL") 23 | expect_error ( 24 | add_osm_surface (map, obj, NULL), 25 | "'data' must be of a vector type, was 'NULL'" 26 | ) 27 | expect_error ( 28 | add_osm_surface (map, obj, 1), 29 | "dat must have at least 3 columns" 30 | ) 31 | dat <- matrix (runif (12), nrow = 4) 32 | expect_warning ( 33 | add_osm_surface (map, obj, dat), 34 | "dat has no column names" 35 | ) 36 | colnames (dat) <- c ("a", "b", "z") 37 | expect_warning ( 38 | add_osm_surface (map, obj, dat), 39 | "dat should have columns of x/y" 40 | ) 41 | colnames (dat) <- c ("x", "y", "a") 42 | expect_warning ( 43 | add_osm_surface (map, obj, dat), 44 | "dat should have column named z" 45 | ) 46 | 47 | bbdat <- get_bbox (c (-0.128, 51.502, -0.112, 51.518)) 48 | x <- seq (bbdat [1, 1], bbdat [1, 2], length.out = dim (volcano) [1]) 49 | y <- seq (bbdat [2, 1], bbdat [2, 2], length.out = dim (volcano) [2]) 50 | xy <- cbind ( 51 | rep (x, dim (volcano) [2]), 52 | rep (y, each = dim (volcano) [1]) 53 | ) 54 | z <- as.numeric (volcano) 55 | dat <- data.frame (x = xy [, 1], y = xy [, 2], z = z) 56 | cols <- gray (0:50 / 50) 57 | 58 | # polygons--------------------------------- 59 | expect_silent (map <- add_osm_surface (map, 60 | obj = london$dat_BNR, 61 | dat = dat, cols = cols 62 | )) 63 | map <- osm_basemap (bbox = bbox, bg = "gray20") 64 | expect_silent (map <- add_osm_surface (map, 65 | obj = london$dat_BNR, 66 | dat = dat, cols = cols, 67 | bg = "orange" 68 | )) 69 | 70 | # lines------------------------------------ 71 | map <- osm_basemap (bbox = bbox, bg = "gray20") 72 | expect_silent (map <- add_osm_surface (map, 73 | obj = london$dat_H, 74 | dat = dat, cols = cols 75 | )) 76 | map <- osm_basemap (bbox = bbox, bg = "gray20") 77 | expect_silent (map <- add_osm_surface (map, 78 | obj = london$dat_H, 79 | dat = dat, cols = cols, 80 | bg = "orange" 81 | )) 82 | 83 | # points----------------------------------- 84 | map <- osm_basemap (bbox = bbox, bg = "gray20") 85 | expect_silent (map <- add_osm_surface (map, 86 | obj = london$dat_T, 87 | dat = dat, 88 | cols = cols 89 | )) 90 | map <- osm_basemap (bbox = bbox, bg = "gray20") 91 | expect_silent (map <- add_osm_surface (map, 92 | obj = london$dat_T, 93 | dat = dat, 94 | cols = cols, bg = "orange" 95 | )) 96 | }) 97 | -------------------------------------------------------------------------------- /tests/testthat/test-adjust-colours.R: -------------------------------------------------------------------------------- 1 | context ("adjust-colours") 2 | 3 | test_that ("colours", { 4 | expect_error (adjust_colours (), "a non-null col must be provided") 5 | expect_error (adjust_colours (NULL), "cols must be non-null") 6 | expect_error (adjust_colours (cols = -1), "Invalid colour: -1") 7 | expect_error (adjust_colours (cols = "a"), "Invalid colour: a") 8 | expect_silent (adjust_colours (cols = NA)) 9 | expect_silent (adjust_colours (cols = c (1:5, NA))) 10 | expect_silent (adjust_colours (cols = 1:5)) 11 | }) 12 | 13 | test_that ("adj", { 14 | expect_error (adjust_colours (1, -2), "adj must be between -1 and 1") 15 | expect_error (adjust_colours (1, NA), "adj can not be NA") 16 | expect_error (adjust_colours (1, NULL), "adj can not be NULL") 17 | expect_error (adjust_colours (1, "a"), "adj can not be coerced to numeric") 18 | }) 19 | 20 | test_that ("plot", { 21 | expect_error (adjust_colours (1, 0, NA), "plot can not be NA") 22 | expect_error (adjust_colours (1, 0, NULL), "plot can not be NULL") 23 | expect_error ( 24 | adjust_colours (1, 0, "a"), 25 | "plot can not be coerced to logical" 26 | ) 27 | expect_silent (adjust_colours (1, 0, FALSE)) 28 | expect_silent (adjust_colours (1, 0, TRUE)) 29 | }) 30 | -------------------------------------------------------------------------------- /tests/testthat/test-colourmat.R: -------------------------------------------------------------------------------- 1 | context ("colourmat") 2 | 3 | test_that ("colours", { 4 | expect_error (colour_mat (), "cols must be provided") 5 | expect_error (colour_mat (cols = -1), "cols must have length >= 4") 6 | expect_error (colour_mat (cols = "a"), "cols must have length >= 4") 7 | expect_error (colour_mat (cols = NULL), "incorrect number of dimensions") 8 | expect_error ( 9 | colour_mat (cols = letters [1:4]), 10 | "Invalid colours: a" 11 | ) 12 | expect_error ( 13 | colour_mat (cols = c ("red", "blue", letters [1:4])), 14 | "Invalid colours: a" 15 | ) 16 | expect_error ( 17 | colour_mat (cols = rep (NA, 4)), 18 | "One or more cols is NA" 19 | ) 20 | expect_silent (colour_mat (cols = 1:7)) 21 | expect_silent (colour_mat (cols = 1:4, plot = TRUE)) 22 | dev.off (which = dev.cur ()) 23 | }) 24 | 25 | test_that ("n", { 26 | expect_error (colour_mat (cols = 1:4, n = 1), "n must be > 1") 27 | expect_error (colour_mat (cols = 1:4, n = "a"), "n must be numeric") 28 | expect_error (colour_mat (cols = 1:4, n = NA), "n must be numeric") 29 | expect_error (colour_mat (cols = 1:4, n = NULL), "n must be numeric") 30 | expect_error (colour_mat (cols = 1:4, n = 1:2), "n must be > 1") 31 | expect_error ( 32 | colour_mat (cols = 1:4, n = c (2, "a")), 33 | "n must be numeric" 34 | ) 35 | expect_error ( 36 | colour_mat (cols = 1:4, n = c (2, NA)), 37 | "n can not be NA" 38 | ) 39 | }) 40 | 41 | test_that ("rotate", { 42 | expect_error ( 43 | colour_mat (cols = 1:4, rotate = "a"), 44 | "rotate must be numeric" 45 | ) 46 | expect_error ( 47 | colour_mat (cols = 1:4, rotate = NA), 48 | "rotate must be numeric" 49 | ) 50 | expect_warning ( 51 | colour_mat (cols = 1:4, rotate = 1:2), 52 | "rotate has length > 1" 53 | ) 54 | }) 55 | -------------------------------------------------------------------------------- /tests/testthat/test-connect-highways.R: -------------------------------------------------------------------------------- 1 | test_all <- identical (Sys.getenv ("MPADGE_LOCAL"), "true") 2 | 3 | source ("../stub.R") 4 | 5 | if (curl::has_internet ()) { # otherwise all of these return errors not warnings 6 | 7 | test_that ("missing objects", { 8 | expect_error ( 9 | connect_highways (), 10 | "A vector of highway names must be given" 11 | ) 12 | expect_error ( 13 | connect_highways ("aaa"), 14 | "A bounding box must be given" 15 | ) 16 | }) 17 | 18 | if (test_all) { 19 | 20 | test_that ("unrecognised highways", { 21 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 22 | # No error specified because different HTML errors may 23 | # also be generated 24 | expect_error (connect_highways ("aaa", bbox)) 25 | # expect_error (connect_highways ("aaa", bbox), 26 | # "No data able to be extracted") 27 | }) 28 | 29 | bbox <- get_bbox (c (-0.15, 51.5, -0.10, 51.52)) 30 | highways <- c ("Monmouth.St", "Short.?s.Gardens") 31 | 32 | test_that ("extract_highways", { 33 | ways <- extract_highways ( 34 | highway_names = highways, 35 | bbox = bbox 36 | ) 37 | expect_is (ways, "list") 38 | expect_true (length (ways) > 1) # some might fail 39 | nms <- abbreviate_hwy_names (highways) 40 | expect_true (any (nms %in% names (ways))) 41 | }) 42 | } 43 | } # end if has_internet 44 | 45 | # highway tests using internal data 46 | load (system.file ("extdata", "hwys.rda", package = "osmplotr")) 47 | 48 | test_that ("connect highways internal code", { # these all form cycles 49 | for (i in 1:3) { 50 | 51 | expect_silent (ways0 <- connect_single_ways (hwys [[1]])) 52 | expect_true (all (vapply (ways0, is.list, logical (1)))) 53 | expect_silent (ways <- get_highway_cycle (ways0)) 54 | # get_highway_cycle should add nodes: 55 | n0 <- sum (vapply (ways0, function (i) { 56 | nrow (do.call (rbind, i)) 57 | }, numeric (1))) 58 | n <- sum (vapply (ways, function (i) { 59 | nrow (do.call (rbind, i)) 60 | }, numeric (1))) 61 | expect_true (n > n0) 62 | 63 | conmat <- get_conmat (ways) 64 | expect_true (nrow (conmat) == length (ways)) 65 | cyc <- ggm::fundCycles (conmat) [[1]] 66 | paths <- sps_through_cycle (ways, cyc) 67 | # paths should have fewer total nodes: 68 | expect_true (nrow (paths) < n0) 69 | } 70 | }) 71 | -------------------------------------------------------------------------------- /tests/testthat/test-extract-objects.R: -------------------------------------------------------------------------------- 1 | test_all <- (identical (Sys.getenv ("MPADGE_LOCAL"), "true") || 2 | identical (Sys.getenv ("GITHUB_JOB"), "test-coverage")) 3 | 4 | test_that ("missing objects", { 5 | expect_error (extract_osm_objects (), "key can not be NULL") 6 | expect_error ( 7 | extract_osm_objects (key = "aaa"), 8 | "bbox must be provided" 9 | ) 10 | }) 11 | 12 | test_that ("key missing", { 13 | bbox <- get_bbox (c (-0.12, 51.51, -0.11, 51.52)) 14 | expect_error ( 15 | extract_osm_objects (bbox = bbox, key = NULL), 16 | "key can not be NULL" 17 | ) 18 | expect_error ( 19 | extract_osm_objects (bbox = bbox, key = NA), 20 | "key can not be NA" 21 | ) 22 | expect_error ( 23 | extract_osm_objects (bbox = bbox), 24 | "key can not be NULL" 25 | ) 26 | }) 27 | 28 | skip_if (!curl::has_internet ()) 29 | skip_if (!test_all) 30 | 31 | test_that ("invalid key", { 32 | bbox <- get_bbox (c (-0.12, 51.51, -0.11, 51.52)) 33 | expect_warning ( 34 | suppressMessages ( 35 | extract_osm_objects (bbox = bbox, key = "aaa") 36 | ), 37 | "No valid data returned" 38 | ) 39 | }) 40 | 41 | test_that ("valid key", { 42 | bbox <- get_bbox (c (-0.12, 51.518, -0.118, 51.52)) 43 | dat <- extract_osm_objects (bbox = bbox, key = "building") 44 | expect_is (dat, "sf") 45 | dat <- extract_osm_objects ( 46 | bbox = bbox, key = "building", 47 | sf = FALSE 48 | ) 49 | expect_is (dat, "SpatialPolygonsDataFrame") 50 | }) 51 | 52 | test_that ("extra_pairs", { 53 | key <- "route" 54 | value <- "bicycle" 55 | extra_pairs <- c ("name", "London Cycle Network") 56 | bbox <- get_bbox (c (0, 51.5, 0.1, 51.6)) 57 | dat <- extract_osm_objects ( 58 | bbox = bbox, key = key, 59 | value = value, 60 | extra_pairs = extra_pairs 61 | ) 62 | expect_true (nrow (dat) > 0) 63 | expect_is (dat, "sf") 64 | }) 65 | 66 | test_that ("sp objects", { 67 | key <- "route" 68 | value <- "bicycle" 69 | extra_pairs <- c ("name", "London Cycle Network") 70 | bbox <- get_bbox (c (0, 51.5, 0.1, 51.6)) 71 | dat <- extract_osm_objects ( 72 | bbox = bbox, key = key, 73 | value = value, 74 | extra_pairs = extra_pairs, 75 | sf = FALSE 76 | ) 77 | expect_true (nrow (dat) > 0) 78 | expect_is (dat, "Spatial") 79 | }) 80 | -------------------------------------------------------------------------------- /tests/testthat/test-get-bbox.R: -------------------------------------------------------------------------------- 1 | context ("get-bbox") 2 | 3 | test_that ("latlon", { 4 | expect_error (get_bbox (), "latlon must be supplied") 5 | expect_error (get_bbox (-1), "latlon must have length = 4") 6 | expect_error (get_bbox ("a"), "latlon is not numeric") 7 | expect_error (get_bbox (NULL), "latlon is not numeric") 8 | expect_error (get_bbox (NA), "latlon is not numeric") 9 | expect_error (get_bbox (c (1:3, "a")), "latlon is not numeric") 10 | expect_warning (get_bbox (1:5), "latlon has length > 4") 11 | }) 12 | -------------------------------------------------------------------------------- /tests/testthat/test-make-osmmap.R: -------------------------------------------------------------------------------- 1 | context ("make-osm-map") 2 | 3 | source ("../stub.R") 4 | 5 | test_that ("make_osm_map", { 6 | 7 | dat <- list ( 8 | dat_BU = london$dat_BNR, dat_A = london$dat_A, 9 | dat_P = london$dat_P, dat_H = london$dat_H, 10 | dat_T = london$dat_T 11 | ) 12 | structures <- osm_structures () 13 | indx <- which (paste0 ( 14 | "dat_", 15 | structures$suffix 16 | ) %in% names (dat)) 17 | structures <- rbind ( 18 | structures [indx, ], 19 | structures [structures$structure == 20 | "background", ] 21 | ) 22 | 23 | expect_silent (dat <- make_osm_map ( 24 | osm_data = dat, 25 | structures = structures 26 | )) 27 | }) 28 | 29 | test_that ("get_missing_osm_data", { 30 | 31 | structs <- osm_structures () 32 | indx <- which (structs$structure == "building") 33 | structs <- structs [indx, ] 34 | bbox <- get_bbox (c (-0.15, 51.5, -0.10, 51.52)) 35 | stub ( 36 | get_missing_osm_data, "extract_osm_objects", 37 | function (x, ...) london$dat_BNR 38 | ) 39 | dat <- get_missing_osm_data ( 40 | osm_data = list (), 41 | structures = structs, bbox = bbox, 42 | dat_prefix = "dat_" 43 | ) 44 | expect_is (dat, "list") 45 | expect_identical (names (dat), c ("indx", "osm_data")) 46 | expect_is (dat$indx, "integer") 47 | expect_is (dat$osm_data, "list") 48 | expect_equal (length (dat$osm_data), 1) 49 | # TODO: Change that when london data are updated to sf 50 | expect_is (dat$osm_data [[1]], "sf") 51 | }) 52 | -------------------------------------------------------------------------------- /tests/testthat/test-osm-basemap.R: -------------------------------------------------------------------------------- 1 | context ("osm-basemap") 2 | 3 | test_that ("bbox", { 4 | expect_error (osm_basemap (), "bbox must be provided") 5 | expect_error (osm_basemap (-1), "bbox must have length = 4") 6 | expect_error (osm_basemap ("a"), "bbox is not numeric") 7 | expect_error (osm_basemap (NULL), "bbox is not numeric") 8 | expect_error (osm_basemap (NA), "bbox is not numeric") 9 | expect_error (osm_basemap (c (1:3, "a")), "bbox is not numeric") 10 | expect_warning (osm_basemap (1:5), "bbox has length > 4") 11 | }) 12 | 13 | test_that ("structures", { 14 | bb <- get_bbox (1:4) 15 | expect_error ( 16 | osm_basemap (bb, structures = NA), 17 | "structures must be a data frame" 18 | ) 19 | s <- osm_structures (col_scheme = "light") 20 | names (s) [1] <- "x" 21 | expect_error ( 22 | osm_basemap (get_bbox (1:4), structures = s), 23 | "structures not in recognised format" 24 | ) 25 | }) 26 | 27 | test_that ("bg", { 28 | bb <- get_bbox (1:4) 29 | expect_error (osm_basemap (bb, bg = "a"), "Invalid colour: a") 30 | expect_silent (osm_basemap (bb, bg = NA)) 31 | expect_silent (osm_basemap (bb, bg = NULL)) 32 | expect_warning (osm_basemap (bb, bg = 1:2), "bg has length > 1") 33 | }) 34 | -------------------------------------------------------------------------------- /tests/testthat/test-print-map.R: -------------------------------------------------------------------------------- 1 | test_all <- (identical (Sys.getenv ("MPADGE_LOCAL"), "true") || 2 | identical (Sys.getenv ("GITHUB_JOB"), "test-coverage")) 3 | 4 | test_that ("print_osm_map", { 5 | 6 | dat_B <- london$dat_BNR # nolint 7 | bbox <- get_bbox (c (-0.13, 51.5, -0.11, 51.52)) 8 | map <- osm_basemap (bbox = bbox, bg = "gray20") 9 | map <- add_osm_objects (map, dat_B) 10 | 11 | exts <- c ( 12 | "eps", "ps", "tex", "pdf", "svg", "png", 13 | "jpg", "jpeg", "bmp", "tiff" 14 | ) [-3] # text generates a warning from grDevices::pictex 15 | for (e in exts) { 16 | 17 | fname <- paste0 ("map.", e) 18 | # expect_silent ( 19 | print_osm_map ( 20 | map, 21 | width = 5, 22 | height = 4, 23 | filename = fname, 24 | units = "in" 25 | ) 26 | # ) 27 | expect_true (fname %in% list.files ()) 28 | } 29 | if (test_all) { 30 | 31 | for (e in exts) { 32 | file.remove (paste0 ("map.", e)) 33 | } 34 | } 35 | }) 36 | -------------------------------------------------------------------------------- /vignettes/makefile: -------------------------------------------------------------------------------- 1 | MAPFILE = basic-maps 2 | DATFILE = data-maps 3 | OCEANFL = maps-with-ocean 4 | 5 | all: mapsh mapsr datah datar 6 | 7 | mapsr: mapsmaker 8 | 9 | mapsh: mapsmakeh mapsopen 10 | 11 | datar: datamaker 12 | 13 | datah: datamakeh dataopen 14 | 15 | oceanr: oceanmaker 16 | 17 | oceanh: oceanmakeh oceanopen 18 | 19 | mapsmaker: $(MAPFILE).Rmd 20 | echo "rmarkdown::render('$(MAPFILE).Rmd',rmarkdown::md_document(variant='markdown_github'))" | R --no-save -q 21 | 22 | mapsmakeh: $(MAPFILE).Rmd 23 | echo "rmarkdown::render('$(MAPFILE).Rmd',output_file='$(MAPFILE).html')" | R --no-save -q 24 | 25 | datamaker: $(DATFILE).Rmd 26 | echo "rmarkdown::render('$(DATFILE).Rmd',rmarkdown::md_document(variant='markdown_github'))" | R --no-save -q 27 | 28 | datamakeh: $(DATFILE).Rmd 29 | echo "rmarkdown::render('$(DATFILE).Rmd',output_file='$(DATFILE).html')" | R --no-save -q 30 | 31 | oceanmaker: $(OCEANFL).Rmd 32 | echo "rmarkdown::render('$(OCEANFL).Rmd',rmarkdown::md_document(variant='markdown_github'))" | R --no-save -q 33 | 34 | oceanmakeh: $(OCEANFL).Rmd 35 | echo "rmarkdown::render('$(OCEANFL).Rmd',output_file='$(OCEANFL).html')" | R --no-save -q 36 | 37 | mapsopen: $(MAPFILE).html 38 | xdg-open $(MAPFILE).html & 39 | 40 | dataopen: $(DATFILE).html 41 | xdg-open $(DATFILE).html & 42 | 43 | oceanopen: $(OCEANFL).html 44 | xdg-open $(OCEANFL).html & 45 | 46 | clean: 47 | rm -f *.png 48 | -------------------------------------------------------------------------------- /vignettes/maps-with-ocean.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Rendering Ocean" 3 | author: "Richard Beare" 4 | date: "`r Sys.Date()`" 5 | output: 6 | html_document: 7 | toc: true 8 | toc_float: true 9 | #number_sections: true 10 | theme: flatly 11 | vignette: > 12 | %\VignetteIndexEntry{Maps with Ocean} 13 | %\VignetteEngine{knitr::rmarkdown} 14 | %\VignetteEncoding{UTF-8} 15 | --- 16 | 17 | # 1 Introduction 18 | 19 | It may often be desirable to separately colour two or more portions of a map 20 | that are separated by a line object. This is not directly possible because only 21 | polygons can be filled with colour, not lines. The `osm_line2poly()` function 22 | comes to the rescue here by converting a line to a polygon surrounding a given 23 | plotting region. The classic example where this arises is with coastlines. These 24 | are always represented in OpenStreetMap as line objects, preventing any ability 25 | to simply colour land and ocean separately. 26 | 27 | This vignette illustrates the general principles of the `osm_line2poly()` 28 | function, along with several ancillary issues such as plotting coastal islands. 29 | Although this functionality has been primarily developed with coastlines in 30 | mind, the `osm_line2poly()` function has been designed in a sufficiently general 31 | manner to be readily adaptable to any other cases where such line-to-polygon 32 | conversion may be desirable. 33 | 34 | This vignette explores the example of the coastline around Greater Melbourne, 35 | Australia, first demonstrating how to extract coastline and convert it to land 36 | and sea polygons, and then demonstrating how these areas may be delineated on a 37 | plot. 38 | 39 | # 2 Data Extraction and Conversion 40 | 41 | We use [`osmdata`](https://cran.r-project.org/package=osmdata) to extract the 42 | coastline within the bounding box of Greater Melbourne. 43 | ```{r, echo = FALSE} 44 | map_dpi <- 72 # dpi res for all maps 45 | fetch_osm <- FALSE 46 | ``` 47 | ```{r GMFuncs, message=FALSE, eval = fetch_osm} 48 | library (osmplotr) 49 | library (osmdata) 50 | library (magrittr) 51 | 52 | bbox <- osmdata::getbb ("greater melbourne, australia") 53 | coast <- opq (bbox = bbox) %>% 54 | add_osm_feature (key = "natural", value = "coastline") %>% 55 | osmdata_sf (quiet = FALSE) 56 | ``` 57 | This coastline object consists of several types of structure 58 | ```{r, eval = FALSE} 59 | coast 60 | ``` 61 | ```{r, echo = FALSE} 62 | message (paste0 ( 63 | "Object of class 'osmdata' with:\n", 64 | " $bbox : -38.49937,144.44405,-37.40175,146.1925\n", 65 | " $overpass_call : The call submitted to the overpass API\n", 66 | " $timestamp : [ Thurs 5 Oct 2017 10:23:18 ]\n", 67 | " $osm_points : 'sf' Simple Features Collection with 13635 points\n", 68 | " $osm_lines : 'sf' Simple Features Collection with 73 linestrings\n", 69 | " $osm_polygons : 'sf' Simple Features Collection with 12 polygons\n", 70 | " $osm_multilines : 'sf' Simple Features Collection with 0 multilinestrings\n", 71 | " $osm_multipolygons : 'sf' Simple Features Collection with 0 multipolygons" 72 | )) 73 | ``` 74 | Because OpenStreetMap represents coastline as line objects, all coastline data 75 | is contained within the `$osm_lines` object. The `osm_line2poly()` function can 76 | then convert these lines to polygons which can be used to plot filled areas. 77 | ```{r, eval = fetch_osm} 78 | coast_poly <- osm_line2poly (coast$osm_lines, bbox) 79 | names (coast_poly) 80 | ``` 81 | ```{r, echo = FALSE} 82 | c ("sea", "land", "islands") 83 | ``` 84 | Note that reflecting its envisioned primary usage, the function always returns 85 | objects named `"sea"`, `"land"`, and `"islands"`. For usages other than 86 | coastline, these names will of course reflect other kinds of object. The 87 | `"islands"` item contains any polygons which are separate to those originally 88 | queried. Each item of this list is an `sf::data.frame` object: 89 | ```{r, eval = FALSE} 90 | class (coast_poly$sea) 91 | ``` 92 | ```{r, echo = FALSE} 93 | c ("sf", "data.frame") 94 | ``` 95 | 96 | # 3 Plotting 97 | 98 | The `list` items returned by `osm_line2poly()` may then be used to provide a map 99 | background which distinguishes ocean from land. Here we first colour the entire 100 | map using the background colour for the ocean, and overlay the land and island 101 | polygons on top of that. 102 | 103 | ```{r, eval = fetch_osm} 104 | map <- osm_basemap (bbox = bbox, bg = "cadetblue2") %>% 105 | add_osm_objects (coast_poly$land, col = "lightyellow1") %>% 106 | add_osm_objects (coast_poly$islands, col = "orange") %>% 107 | add_osm_objects (coast$osm_polygons, col = "purple", border = "black") %>% 108 | add_osm_objects (coast$osm_lines, col = "black") %>% 109 | print_osm_map () 110 | ``` 111 | ```{r, echo=FALSE, eval = fetch_osm} 112 | print_osm_map (map, 113 | filename = "melb_a1.png", width = 600, 114 | units = "px", dpi = map_dpi 115 | ) 116 | ``` 117 | 118 | ![](melb_a1.png) 119 | 120 | The gaudy colours differentiate the source of polygons. Purple islands were 121 | returned by the original osm query, while the orange ones were constructed from 122 | fragments by `osm_line2poly`. 123 | 124 | # Further Demonstrations 125 | 126 | The `osm_line2poly()` function works by identifying lines which extend at at 127 | least two points beyond a given bounding box. For coastline, OpenStreetMap is 128 | designed so that land always lies to the left side in the direction of the 129 | line, enabling water and land to be systematically distinguished. The following 130 | test cases demonstrate the reliability of this distinction. 131 | 132 | ```{r, echo=FALSE} 133 | getCoast <- function (bbox) { 134 | qry <- opq (bbox) 135 | qry <- add_osm_feature (qry, key = "natural", value = "coastline") 136 | return (osmdata_sf (qry)) 137 | } 138 | testPlot <- function (coast, bbox) { 139 | if (!dev.cur ()) dev.off () 140 | map <- osm_basemap (bbox = bbox) 141 | map <- add_osm_objects (map, coast$osm_lines) 142 | print_osm_map (map) 143 | } 144 | testPlotPoly <- function (coast, bbox, fname) { 145 | ## trouble doing this check properly on Travis 146 | if (nrow (coast$osm_lines) > 0) { 147 | coastp <- osm_line2poly (coast$osm_lines, bbox = bbox) 148 | map <- osm_basemap (bbox = bbox) 149 | map <- add_osm_objects (map, coastp$sea, col = "cadetblue2") 150 | map <- add_osm_objects (map, coastp$land, col = "sienna2") 151 | print_osm_map (map, 152 | filename = fname, width = 200, 153 | units = "px", dpi = map_dpi 154 | ) 155 | } else { 156 | warning ("osm query probably failed - not plotting") 157 | invisible (NULL) 158 | } 159 | 160 | } 161 | ``` 162 | ```{r, eval = fetch_osm} 163 | test_plot <- function (bbox) { 164 | dat <- opq (bbox) %>% 165 | add_osm_feature (key = "natural", value = "coastline") %>% 166 | osmdata_sf (quiet = FALSE) 167 | coast <- osm_line2poly (dat$osm_lines, bbox) 168 | osm_basemap (bbox = bbox) %>% 169 | add_osm_objects (coast$sea, col = "cadetblue2") %>% 170 | add_osm_objects (coast$land, col = "sienna2") 171 | } 172 | ``` 173 | ```{r, eval = fetch_osm, echo = FALSE} 174 | test_plot <- function (bbox, filename, map_dpi) { 175 | dat <- opq (bbox) %>% 176 | add_osm_feature (key = "natural", value = "coastline") %>% 177 | osmdata_sf (quiet = FALSE) 178 | coast <- osm_line2poly (dat$osm_lines, bbox) 179 | osm_basemap (bbox = bbox) %>% 180 | add_osm_objects (coast$sea, col = "cadetblue2") %>% 181 | add_osm_objects (coast$land, col = "sienna2") %>% 182 | print_osm_map ( 183 | file = filename, width = 200, 184 | units = "px", dpi = map_dpi 185 | ) 186 | } 187 | ``` 188 | Fetch the test data. A variable name with `WE` indicates that the coast enters the bounding box 189 | on the western side and exits on the east. The land is on the left when following that path. 190 | ```{r, eval = fetch_osm} 191 | bbWE <- get_bbox (c (142.116906, -38.352713, 142.205162, -38.409661)) 192 | coastWE <- getCoast (bbWE) 193 | 194 | bbEW <- get_bbox (c (144.603127, -38.104003, 144.685557, -38.135596)) 195 | coastEW <- getCoast (bbEW) 196 | 197 | bbNS <- get_bbox (c (143.807998, -39.770986, 143.906494, -39.918643)) 198 | coastNS <- getCoast (bbNS) 199 | 200 | bbSN <- get_bbox (c (144.073544, -39.854586, 144.149318, -39.960047)) 201 | coastSN <- getCoast (bbSN) 202 | 203 | bbWW <- get_bbox (c (144.904865, -37.858295, 144.923679, -37.874367)) 204 | coastWW <- getCoast (bbWW) 205 | 206 | bbEE <- get_bbox (c (144.643383, -38.294671, 144.692197, -38.336022)) 207 | coastEE <- getCoast (bbEE) 208 | 209 | bbNN <- get_bbox (c (145.856321, -38.831642, 146.050920, -38.914031)) 210 | coastNN <- getCoast (bbNN) 211 | 212 | bbSS <- get_bbox (c (146.363768, -38.770345, 146.486389, -38.837287)) 213 | coastSS <- getCoast (bbSS) 214 | 215 | bbEN <- get_bbox (c (144.738212, -38.337690, 144.758053, -38.346966)) 216 | coastEN <- getCoast (bbEN) 217 | 218 | bbEWWS <- get_bbox (c (144.693077, -38.307526, 144.729113, -38.343997)) 219 | coastEWWS <- getCoast (bbEWWS) 220 | 221 | bbWS <- get_bbox (c (143.164906, -38.704885, 143.2075563, -38.7462058)) 222 | coastWS <- getCoast (bbWS) 223 | ``` 224 | 225 | ```{r, eval = fetch_osm} 226 | testPlotPoly (coastWE, bbWE, "testWE.png") 227 | ``` 228 | ![](testWE.png) 229 | ```{r, eval = fetch_osm} 230 | testPlotPoly (coastEW, bbEW, "testEW.png") 231 | ``` 232 | ![](testEW.png) 233 | 234 | ```{r, eval = fetch_osm} 235 | testPlotPoly (coastNS, bbNS, "testNS.png") 236 | ``` 237 | ![](testNS.png) 238 | 239 | ```{r, eval = fetch_osm} 240 | testPlotPoly (coastSN, bbSN, "testSN.png") 241 | ``` 242 | ![](testSN.png) 243 | 244 | ```{r, eval = fetch_osm} 245 | testPlotPoly (coastWW, bbWW, "testWW.png") 246 | ``` 247 | ![](testWW.png) 248 | 249 | ```{r, eval = fetch_osm} 250 | testPlotPoly (coastEE, bbEE, "testEE.png") 251 | ``` 252 | ![](testEE.png) 253 | 254 | ```{r, eval = fetch_osm} 255 | testPlotPoly (coastNN, bbNN, "testNN.png") 256 | ``` 257 | ![](testNN.png) 258 | 259 | ```{r, eval = fetch_osm} 260 | testPlotPoly (coastSS, bbSS, "testSS.png") 261 | ``` 262 | ![](testSS.png) 263 | 264 | ```{r, eval = fetch_osm} 265 | testPlotPoly (coastEN, bbEN, "testEN.png") 266 | ``` 267 | ![](testEN.png) 268 | 269 | ```{r, eval = fetch_osm} 270 | testPlotPoly (coastEWWS, bbEWWS, "testEWWS.png") 271 | ``` 272 | ![](testEWWS.png) 273 | 274 | ```{r, eval = fetch_osm} 275 | testPlotPoly (coastWS, bbWS, "testWS.png") 276 | ``` 277 | ![](testWS.png) 278 | -------------------------------------------------------------------------------- /vignettes/melb_a1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/vignettes/melb_a1.png -------------------------------------------------------------------------------- /vignettes/testEE.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/vignettes/testEE.png -------------------------------------------------------------------------------- /vignettes/testEN.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/vignettes/testEN.png -------------------------------------------------------------------------------- /vignettes/testEW.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/vignettes/testEW.png -------------------------------------------------------------------------------- /vignettes/testEWWS.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/vignettes/testEWWS.png -------------------------------------------------------------------------------- /vignettes/testNN.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/vignettes/testNN.png -------------------------------------------------------------------------------- /vignettes/testNS.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/vignettes/testNS.png -------------------------------------------------------------------------------- /vignettes/testSN.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/vignettes/testSN.png -------------------------------------------------------------------------------- /vignettes/testSS.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/vignettes/testSS.png -------------------------------------------------------------------------------- /vignettes/testWE.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/vignettes/testWE.png -------------------------------------------------------------------------------- /vignettes/testWS.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/vignettes/testWS.png -------------------------------------------------------------------------------- /vignettes/testWW.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ropensci/osmplotr/2e301496a999f3c79d06dc7c9b30e0a78d213448/vignettes/testWW.png --------------------------------------------------------------------------------