├── .gitignore ├── tests ├── testthat │ ├── .gitignore │ ├── test-s2plot.R │ ├── test-proj.R │ └── test-hemisphere.R └── testthat.R ├── .Rbuildignore ├── man ├── figures │ ├── README-spin-.gif │ └── README-example-1.png ├── s2plot-package.Rd ├── s2plot.Rd └── s2plot_projection_orthographic.Rd ├── R ├── s2plot-package.R ├── proj.R ├── s2plot.R └── hemisphere.R ├── NAMESPACE ├── s2plot.Rproj ├── DESCRIPTION ├── README.md └── README.Rmd /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | -------------------------------------------------------------------------------- /tests/testthat/.gitignore: -------------------------------------------------------------------------------- 1 | Rplots.pdf 2 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^s2plot\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^README\.Rmd$ 4 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(s2plot) 3 | 4 | test_check("s2plot") 5 | -------------------------------------------------------------------------------- /man/figures/README-spin-.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/paleolimbot/s2plot/HEAD/man/figures/README-spin-.gif -------------------------------------------------------------------------------- /man/figures/README-example-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/paleolimbot/s2plot/HEAD/man/figures/README-example-1.png -------------------------------------------------------------------------------- /R/s2plot-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | #' @aliases NULL 3 | "_PACKAGE" 4 | 5 | # The following block is used by usethis to automatically manage 6 | # roxygen namespace tags. Modify with care! 7 | ## usethis namespace: start 8 | ## usethis namespace: end 9 | NULL 10 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(s2plot_prepare,s2plot_projection_orthographic) 4 | S3method(s2plot_project,s2plot_projection_orthographic) 5 | export(s2plot) 6 | export(s2plot_par_default) 7 | export(s2plot_prepare) 8 | export(s2plot_project) 9 | export(s2plot_projection_default) 10 | export(s2plot_projection_orthographic) 11 | -------------------------------------------------------------------------------- /s2plot.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | LineEndingConversion: Posix 18 | 19 | BuildType: Package 20 | PackageUseDevtools: Yes 21 | PackageInstallArgs: --no-multiarch --with-keep.source 22 | PackageRoxygenize: rd,collate,namespace 23 | -------------------------------------------------------------------------------- /tests/testthat/test-s2plot.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("basic plotting works", { 3 | s2plot(s2::s2_data_countries(), col = "grey90") 4 | s2plot(s2::s2_data_cities("London"), pch = 16, add = T) 5 | s2plot("LINESTRING (0 0, 0 45)", add = T) 6 | 7 | expect_true(TRUE) 8 | }) 9 | 10 | test_that("plotting with manual projection works", { 11 | s2plot(s2::s2_data_countries(), projection = s2plot_projection_orthographic("POINT (0 0)")) 12 | s2plot(s2::s2_data_cities("London"), pch = 16, add = T) 13 | s2plot("LINESTRING (0 0, 0 45)", add = T) 14 | 15 | expect_true(TRUE) 16 | }) 17 | -------------------------------------------------------------------------------- /man/s2plot-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/s2plot-package.R 3 | \docType{package} 4 | \name{s2plot-package} 5 | \title{s2plot: Plot spatial objects on a sphere} 6 | \description{ 7 | Experimental spherical plotting of spatial objects. 8 | } 9 | \seealso{ 10 | Useful links: 11 | \itemize{ 12 | \item \url{https://github.com/paleolimbot/s2plot} 13 | \item Report bugs at \url{https://github.com/paleolimbot/s2plot/issues} 14 | } 15 | 16 | } 17 | \author{ 18 | \strong{Maintainer}: Dewey Dunnington \email{dewey@fishandwhistle.net} (\href{https://orcid.org/0000-0002-9415-4582}{ORCID}) 19 | 20 | } 21 | \keyword{internal} 22 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: s2plot 2 | Title: Plot spatial objects on a sphere 3 | Version: 0.0.0.9000 4 | Authors@R: 5 | person(given = "Dewey", 6 | family = "Dunnington", 7 | role = c("aut", "cre"), 8 | email = "dewey@fishandwhistle.net", 9 | comment = c(ORCID = "0000-0002-9415-4582")) 10 | Description: Experimental spherical plotting of spatial objects. 11 | License: GPL-3 12 | Encoding: UTF-8 13 | LazyData: true 14 | Roxygen: list(markdown = TRUE) 15 | RoxygenNote: 7.1.1 16 | Suggests: 17 | testthat 18 | Imports: 19 | s2 (>= 1.0.1), 20 | mapproj, 21 | wk, 22 | wkutils, 23 | withr 24 | Remotes: paleolimbot/wkutils 25 | URL: https://github.com/paleolimbot/s2plot 26 | BugReports: https://github.com/paleolimbot/s2plot/issues 27 | -------------------------------------------------------------------------------- /man/s2plot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/s2plot.R 3 | \name{s2plot} 4 | \alias{s2plot} 5 | \alias{s2plot_par_default} 6 | \title{Plot an object on the sphere} 7 | \usage{ 8 | s2plot( 9 | geog, 10 | ..., 11 | projection = s2plot_projection_default(geog, add), 12 | xlim = NULL, 13 | ylim = NULL, 14 | par = s2plot_par_default(), 15 | add = FALSE 16 | ) 17 | 18 | s2plot_par_default() 19 | } 20 | \arguments{ 21 | \item{geog}{A \code{\link[s2:as_s2_geography]{s2::as_s2_geography()}}} 22 | 23 | \item{...}{Passed to graphics functions.} 24 | 25 | \item{projection}{Right now \code{\link[=s2plot_projection_orthographic]{s2plot_projection_orthographic()}} 26 | is the only projection. The default is either calculated 27 | based on the \code{\link[s2:s2_boundary]{s2::s2_centroid_agg()}} of \code{geog} or the 28 | last used projection if \code{add = TRUE}.} 29 | 30 | \item{xlim, ylim}{Limits in projected space.} 31 | 32 | \item{par}{Graphical \code{\link[graphics:par]{graphics::par()}} to set prior to plotting} 33 | 34 | \item{add}{Add to the current plot? Use \code{FALSE} to create a new plot.} 35 | } 36 | \value{ 37 | \code{x}, invisibly 38 | } 39 | \description{ 40 | Plot an object on the sphere 41 | } 42 | \examples{ 43 | s2plot(s2::s2_data_countries()) 44 | s2plot(s2::s2_data_cities("London"), pch = 16, add = TRUE) 45 | 46 | } 47 | -------------------------------------------------------------------------------- /man/s2plot_projection_orthographic.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/proj.R 3 | \name{s2plot_projection_orthographic} 4 | \alias{s2plot_projection_orthographic} 5 | \alias{s2plot_projection_default} 6 | \alias{s2plot_prepare} 7 | \alias{s2plot_project} 8 | \alias{s2plot_prepare.s2plot_projection_orthographic} 9 | \alias{s2plot_project.s2plot_projection_orthographic} 10 | \title{Define a projection to use with s2plot} 11 | \usage{ 12 | s2plot_projection_orthographic(point, rotation = 0) 13 | 14 | s2plot_projection_default(geog, add = FALSE) 15 | 16 | s2plot_prepare(projection, geog) 17 | 18 | s2plot_project(projection, geog) 19 | 20 | \method{s2plot_prepare}{s2plot_projection_orthographic}(projection, geog) 21 | 22 | \method{s2plot_project}{s2plot_projection_orthographic}(projection, geog) 23 | } 24 | \arguments{ 25 | \item{point}{The centre of the projection} 26 | 27 | \item{rotation}{Rotation} 28 | 29 | \item{geog}{A \code{\link[s2:as_s2_geography]{s2::as_s2_geography()}}} 30 | 31 | \item{add}{Add to the current plot? Use \code{FALSE} to create a new plot.} 32 | 33 | \item{projection}{Right now \code{\link[=s2plot_projection_orthographic]{s2plot_projection_orthographic()}} 34 | is the only projection. The default is either calculated 35 | based on the \code{\link[s2:s2_boundary]{s2::s2_centroid_agg()}} of \code{geog} or the 36 | last used projection if \code{add = TRUE}.} 37 | } 38 | \description{ 39 | Define a projection to use with s2plot 40 | } 41 | -------------------------------------------------------------------------------- /tests/testthat/test-proj.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("orthographic projections can be constructed", { 3 | expect_is(s2plot_projection_orthographic("POINT (1 2)"), "s2plot_projection_orthographic") 4 | expect_equal(s2plot_projection_orthographic("POINT (1 2)")$point, c(1, 2)) 5 | }) 6 | 7 | test_that("default projection is calculated", { 8 | expect_identical( 9 | s2plot_projection_default("POINT (1 2)", add = FALSE), 10 | s2plot_projection_orthographic("POINT (1 2)") 11 | ) 12 | 13 | last_projection_env$last_projection <- s2plot_projection_orthographic("POINT (1 2)") 14 | expect_identical( 15 | s2plot_projection_default("POINT (2 3)", add = TRUE), 16 | s2plot_projection_orthographic("POINT (1 2)") 17 | ) 18 | 19 | rm(last_projection, envir = last_projection_env) 20 | }) 21 | 22 | test_that("orthographic projection projects correctly", { 23 | expect_equal( 24 | s2plot_project(s2plot_projection_orthographic("POINT (1 2)"), "POINT (1 2)"), 25 | list(x = 0, y = 0) 26 | ) 27 | 28 | expect_warning( 29 | s2plot_project(s2plot_projection_orthographic("POINT (0 0)"), "POINT (180 0)"), 30 | "Projection error" 31 | ) 32 | }) 33 | 34 | test_that("orthographic projection prepares correctly", { 35 | expect_identical( 36 | s2::s2_as_text( 37 | s2plot_prepare( 38 | s2plot_projection_orthographic("POINT (0 0)"), 39 | c("POINT (80 0)", "POINT (91 0)") 40 | ) 41 | ), 42 | c("POINT (80 0)", "GEOMETRYCOLLECTION EMPTY") 43 | ) 44 | }) 45 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # s2plot 5 | 6 | 7 | 8 | [![Lifecycle: 9 | experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://www.tidyverse.org/lifecycle/#experimental) 10 | 11 | 12 | The goal of s2plot is to provide a quick plot function for 13 | [s2](https://github.com/r-spatial/s2) geographies to facilitate 14 | development of that package. 15 | 16 | ## Installation 17 | 18 | You can install the development version from 19 | [GitHub](https://github.com/) with: 20 | 21 | ``` r 22 | # install.packages("remotes") 23 | remotes::install_github("paleolimbot/s2plot") 24 | ``` 25 | 26 | ## Example 27 | 28 | Plot s2 geographies\! 29 | 30 | ``` r 31 | library(s2plot) 32 | library(s2) 33 | 34 | s2plot(s2::s2_data_countries(), col = "grey90") 35 | s2plot(s2::s2_data_cities("London"), pch = 16, add = T) 36 | ``` 37 | 38 | 39 | 40 | Make a spinning globe\! 41 | 42 | ``` r 43 | countries <- s2_data_countries() 44 | ocean <- s2_difference( 45 | # make a polygon of the whole earth! 46 | as_s2_geography(TRUE), 47 | s2_union_agg(countries) 48 | ) 49 | 50 | lat <- 0 51 | for (lon in seq(0, -360, length.out = 101)[-1]) { 52 | s2plot( 53 | countries, 54 | col = "white", border = "black", 55 | projection = s2plot_projection_orthographic(sprintf("POINT (%s %s)", lon, lat)), 56 | xlim = c(-1, 1), 57 | ylim = c(-1, 1) 58 | ) 59 | 60 | s2plot(ocean, col = "#0073B8", add = T) 61 | } 62 | ``` 63 | 64 | 65 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | out.width = "100%", 13 | dpi = 300 14 | ) 15 | ``` 16 | 17 | # s2plot 18 | 19 | 20 | [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://www.tidyverse.org/lifecycle/#experimental) 21 | 22 | 23 | The goal of s2plot is to provide a quick plot function for [s2](https://github.com/r-spatial/s2) geographies to facilitate development of that package. 24 | 25 | ## Installation 26 | 27 | You can install the development version from [GitHub](https://github.com/) with: 28 | 29 | ``` r 30 | # install.packages("remotes") 31 | remotes::install_github("paleolimbot/s2plot") 32 | ``` 33 | ## Example 34 | 35 | Plot s2 geographies! 36 | 37 | ```{r example} 38 | library(s2plot) 39 | library(s2) 40 | 41 | s2plot(s2::s2_data_countries(), col = "grey90") 42 | s2plot(s2::s2_data_cities("London"), pch = 16, add = T) 43 | 44 | ``` 45 | 46 | Make a spinning globe! 47 | 48 | ```{r spin, animation.hook='gifski', interval = 1 / 25, dpi = 96} 49 | countries <- s2_data_countries() 50 | ocean <- s2_difference( 51 | # make a polygon of the whole earth! 52 | as_s2_geography(TRUE), 53 | s2_union_agg(countries) 54 | ) 55 | 56 | lat <- 0 57 | for (lon in seq(0, -360, length.out = 101)[-1]) { 58 | s2plot( 59 | countries, 60 | col = "white", border = "black", 61 | projection = s2plot_projection_orthographic(sprintf("POINT (%s %s)", lon, lat)), 62 | xlim = c(-1, 1), 63 | ylim = c(-1, 1) 64 | ) 65 | 66 | s2plot(ocean, col = "#0073B8", add = T) 67 | } 68 | ``` 69 | 70 | -------------------------------------------------------------------------------- /tests/testthat/test-hemisphere.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("great circle math works", { 3 | test_gc <- function(x, y, z, length.out = 431) { 4 | out <- great_circle(x, y, z, length.out = length.out) 5 | # plot(y~x, unit_circle_pv, asp = 1, type = "l") 6 | expect_equal(nrow(out), length.out) 7 | expect_true(all(is.finite(out$x))) 8 | expect_true(all(is.finite(out$y))) 9 | expect_true(all(is.finite(out$z))) 10 | # all vectors should be length 1 11 | expect_true(all(abs(1 - (out$x^2 + out$y^2 + out$z^2)) < 1e-15)) 12 | expect_true(!any(duplicated(out))) 13 | # dot product of all great circle vectors with orthogonal vector is 0 14 | expect_true(all(abs((out$x*x + out$y*y + out$z*z)) < 1e-15)) 15 | } 16 | 17 | test_gc(1, 0, 0) 18 | test_gc(0, 1, 0) 19 | test_gc(0, 0, 1) 20 | test_gc(1, 1, 1) 21 | }) 22 | 23 | test_that("hemisphere generation works", { 24 | hem_front <- make_hemisphere(0, 0, epsilon = 0) 25 | expect_equal(range(hem_front$lng), c(-90, 90)) 26 | expect_true(all(abs(range(hem_front$lat) - c(-90, 90)) < 0.02)) 27 | 28 | hem_top <- make_hemisphere(0, 90, epsilon = 0) 29 | expect_equal(range(hem_top$lng), c(-180, 180)) 30 | expect_true(all(abs(range(hem_top$lat) - c(0, 0)) < 0.0001)) 31 | 32 | hem_bottom <- make_hemisphere(0, -90, epsilon = 0) 33 | expect_equal(range(hem_bottom$lng), c(-180, 180)) 34 | expect_true(all(abs(range(hem_bottom$lat) - c(0, 0)) < 0.0001)) 35 | 36 | hem_kilter <- make_hemisphere(35, 12, epsilon = 0) 37 | expect_true(all(abs(range(hem_kilter$lng) - c(-180, 180)) < 0.16)) 38 | expect_true(all(abs(range(hem_kilter$lat) - c(12 - 90, 90 - 12)) < 0.01)) 39 | 40 | hem_epsilon <- make_hemisphere(0, 0, epsilon = 1) 41 | expect_equal(range(hem_epsilon$lng), c(-45, 45)) 42 | expect_equal(range(hem_epsilon$lat), c(-45, 45)) 43 | 44 | hem_back <- make_hemisphere(180, 0, epsilon = 0) 45 | expect_equal(range(hem_back$lng), c(-90, 90)) 46 | expect_true(all(abs(range(hem_back$lat) - c(-90, 90)) < 0.02)) 47 | }) 48 | -------------------------------------------------------------------------------- /R/proj.R: -------------------------------------------------------------------------------- 1 | 2 | #' Define a projection to use with s2plot 3 | #' 4 | #' @param point The centre of the projection 5 | #' @param rotation Rotation 6 | #' @inheritParams s2plot 7 | #' 8 | #' @export 9 | #' 10 | s2plot_projection_orthographic <- function(point, rotation = 0) { 11 | structure( 12 | list(point = c(s2::s2_x(point), s2::s2_y(point)), rotation = rotation), 13 | class = "s2plot_projection_orthographic" 14 | ) 15 | } 16 | 17 | #' @rdname s2plot_projection_orthographic 18 | #' @export 19 | s2plot_projection_default <- function(geog, add = FALSE) { 20 | if (add) { 21 | last_projection_env$last_projection 22 | } else { 23 | s2plot_projection_orthographic(s2::s2_centroid_agg(geog, na.rm = TRUE)) 24 | } 25 | } 26 | 27 | #' @rdname s2plot_projection_orthographic 28 | #' @export 29 | s2plot_prepare <- function(projection, geog) { 30 | UseMethod("s2plot_prepare") 31 | } 32 | 33 | #' @rdname s2plot_projection_orthographic 34 | #' @export 35 | s2plot_project <- function(projection, geog) { 36 | UseMethod("s2plot_project") 37 | } 38 | 39 | #' @rdname s2plot_projection_orthographic 40 | #' @export 41 | s2plot_prepare.s2plot_projection_orthographic <- function(projection, geog) { 42 | hemisphere <- s2::as_s2_geography(make_hemisphere_wkt(projection$point[1], projection$point[2])) 43 | s2::s2_intersection(geog, hemisphere) 44 | } 45 | 46 | #' @rdname s2plot_projection_orthographic 47 | #' @export 48 | s2plot_project.s2plot_projection_orthographic <- function(projection, geog) { 49 | # realistically this should segmentize first 50 | xy <- wkutils::wkb_coords(s2::s2_as_binary(geog), sep_na = TRUE) 51 | 52 | projected <- mapproj::mapproject( 53 | xy$x, xy$y, 54 | projection = "orthographic", 55 | orientation = c(projection$point[2], projection$point[1], projection$rotation[1]) 56 | ) 57 | 58 | if (projected$error != 0) { 59 | warning(sprintf("Projection error: %s", projected$error)) 60 | } 61 | 62 | projected[c("x", "y")] 63 | } 64 | 65 | # place to keep track of previous env 66 | last_projection_env <- new.env(parent = emptyenv()) 67 | -------------------------------------------------------------------------------- /R/s2plot.R: -------------------------------------------------------------------------------- 1 | 2 | #' Plot an object on the sphere 3 | #' 4 | #' @param geog A [s2::as_s2_geography()] 5 | #' @param add Add to the current plot? Use `FALSE` to create a new plot. 6 | #' @param par Graphical [graphics::par()] to set prior to plotting 7 | #' @param projection Right now [s2plot_projection_orthographic()] 8 | #' is the only projection. The default is either calculated 9 | #' based on the [s2::s2_centroid_agg()] of `geog` or the 10 | #' last used projection if `add = TRUE`. 11 | #' @param xlim,ylim Limits in projected space. 12 | #' @param ... Passed to graphics functions. 13 | #' 14 | #' @return `x`, invisibly 15 | #' @export 16 | #' 17 | #' @examples 18 | #' s2plot(s2::s2_data_countries()) 19 | #' s2plot(s2::s2_data_cities("London"), pch = 16, add = TRUE) 20 | #' 21 | s2plot <- function(geog, ..., projection = s2plot_projection_default(geog, add), 22 | xlim = NULL, ylim = NULL, par = s2plot_par_default(), add = FALSE) { 23 | withr::with_par(par, { 24 | geog <- s2plot_prepare(projection, geog) 25 | 26 | if (!add) { 27 | geog_xy <- s2plot_project(projection, geog) 28 | graphics::plot( 29 | double(), double(), 30 | xlab = "", ylab = "", 31 | xlim = if (is.null(xlim)) range(geog_xy$x, finite = TRUE) else xlim, 32 | ylim = if (is.null(ylim)) range(geog_xy$y, finite = TRUE) else ylim, 33 | asp = 1 34 | ) 35 | 36 | last_projection_env$last_projection <- projection 37 | } 38 | 39 | geog_split <- split( 40 | geog, 41 | factor(s2::s2_dimension(geog), levels = c("0", "1", "2")), 42 | drop = FALSE 43 | ) 44 | 45 | if (length(geog_split[[1]]) > 0) { 46 | xy <- s2plot_project(projection, geog_split[[1]]) 47 | graphics::points(xy$x, xy$y, ...) 48 | } 49 | 50 | if (length(geog_split[[2]]) > 0) { 51 | xy <- s2plot_project(projection, geog_split[[2]]) 52 | graphics::lines(xy$x, xy$y, ...) 53 | } 54 | 55 | if (length(geog_split[[3]]) > 0) { 56 | xy <- s2plot_project(projection, geog_split[[3]]) 57 | graphics::polypath(xy$x, xy$y, ...) 58 | } 59 | }) 60 | } 61 | 62 | #' @rdname s2plot 63 | #' @export 64 | s2plot_par_default <- function() { 65 | list(mai = c(0, 0, 0, 0), omi = c(0, 0, 0, 0)) 66 | } 67 | -------------------------------------------------------------------------------- /R/hemisphere.R: -------------------------------------------------------------------------------- 1 | 2 | # lifted from ggstereo (probably a better way to replicate this in s2) 3 | # this is essentially generating a "cap" but with somewhat irregular 4 | # coordinate spacing 5 | great_circle <- function(x, y, z, length.out = 200) { 6 | stopifnot(length(x) == 1, length(y) == 1, length(z) == 1) 7 | 8 | # dot-product = 0 for orthogonality 9 | # VxU = x v1 + y v2 + z v3 = 0 10 | 11 | theta_out <- seq(-pi, pi, length.out = length.out) 12 | 13 | if(!near_zero(y)) { 14 | # solve for v2 15 | # v2 = (-x * v1 - z * v3) / y 16 | v1 <- cos(theta_out) 17 | v3 <- sin(theta_out) 18 | v2 <- (-x * v1 - z * v3) / y 19 | } else if(!near_zero(x)) { 20 | # solve for v1 21 | # v1 <- (-y * v2 - z * v3) / x 22 | v2 <- cos(theta_out) 23 | v3 <- sin(theta_out) 24 | v1 <- (-y * v2 - z * v3) / x 25 | } else if(!near_zero(z)) { 26 | # solve for v3 27 | # v3 = (-x v1 - y v2) / z 28 | v1 <- cos(theta_out) 29 | v2 <- sin(theta_out) 30 | v3 <- (-x * v1 - y * v2) / z 31 | } else { 32 | stop("Zero-length vector") 33 | } 34 | 35 | r <- sqrt(v1*v1 + v2*v2 + v3*v3) 36 | data.frame(x = v1 / r, y = v2 / r, z = v3 / r) 37 | } 38 | 39 | near_zero <- function(x, epsilon = 1e-8) { 40 | abs(x) < epsilon 41 | } 42 | 43 | make_hemisphere <- function(lng, lat, detail = 10000, epsilon = 0.1, precision = 2) { 44 | 45 | ref_latlng <- s2::s2_lnglat(lng, lat) 46 | ref_point <- as.data.frame(s2::as_s2_point(ref_latlng)) 47 | great_circle_df <- great_circle(ref_point$x, ref_point$y, ref_point$z, length.out = detail) 48 | 49 | # move these all a tiny bit in the direction of ref_point to prevent 50 | # invalid geometries at the edges 51 | great_circle_df <- great_circle_df + (ref_point * epsilon)[rep(1, nrow(great_circle_df)), ] 52 | lengths <- with(great_circle_df, sqrt(x * x + y * y + z * z)) 53 | great_circle_df <- great_circle_df / data.frame(x = lengths, y = lengths, z = lengths) 54 | 55 | great_circle_point <- s2::as_s2_point(as.matrix(great_circle_df)) 56 | great_circle_latlng <- unique(round(as.data.frame(s2::as_s2_lnglat(great_circle_point)), precision)) 57 | 58 | # close the ring 59 | rbind(great_circle_latlng, great_circle_latlng[1, , drop = FALSE])[c("lng", "lat")] 60 | } 61 | 62 | make_hemisphere_wkt <- function(lng, lat, detail = 10000, epsilon = 0.1, precision = 2) { 63 | coord_df <- make_hemisphere(lng, lat, detail = detail, epsilon = epsilon, precision = precision) 64 | coords <- paste0(coord_df$lng, " ", coord_df$lat, collapse = ", ") 65 | sprintf("POLYGON ((%s))", coords) 66 | } 67 | --------------------------------------------------------------------------------