├── .github ├── .gitignore └── workflows │ ├── pkgdown.yaml │ └── R-CMD-check.yaml ├── .gitignore ├── data └── world.rda ├── man ├── readmefigs │ ├── README-xx-1.png │ ├── README-aeqd-1.png │ ├── README-omerc-1.png │ ├── README-sinu-1.png │ ├── README-utm54-1.png │ ├── README-eckhert-1.png │ ├── README-minimal-1.png │ ├── README-minimal-2.png │ ├── README-minimal-3.png │ ├── README-vicgrid-1.png │ ├── README-mollweide-1.png │ ├── README-polar-laea-1.png │ ├── README-polar-stereo-1.png │ ├── README-bigger-example-1.png │ └── README-bigger-example-2.png ├── ti_ellipse.Rd ├── world.Rd ├── tissot-package.Rd ├── tissot_map.Rd ├── indicatrix.Rd └── tissot.Rd ├── .Rbuildignore ├── data-raw └── DATASET.R ├── tissot.Rproj ├── NEWS.md ├── R ├── tissot-package.R ├── tissot_map.R └── tissot.R ├── cran-comments.md ├── NAMESPACE ├── DESCRIPTION ├── CODE_OF_CONDUCT.md ├── README.md └── README.Rmd /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | *.Rproj$ 5 | gdalwmscache 6 | -------------------------------------------------------------------------------- /data/world.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hypertidy/tissot/HEAD/data/world.rda -------------------------------------------------------------------------------- /man/readmefigs/README-xx-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hypertidy/tissot/HEAD/man/readmefigs/README-xx-1.png -------------------------------------------------------------------------------- /man/readmefigs/README-aeqd-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hypertidy/tissot/HEAD/man/readmefigs/README-aeqd-1.png -------------------------------------------------------------------------------- /man/readmefigs/README-omerc-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hypertidy/tissot/HEAD/man/readmefigs/README-omerc-1.png -------------------------------------------------------------------------------- /man/readmefigs/README-sinu-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hypertidy/tissot/HEAD/man/readmefigs/README-sinu-1.png -------------------------------------------------------------------------------- /man/readmefigs/README-utm54-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hypertidy/tissot/HEAD/man/readmefigs/README-utm54-1.png -------------------------------------------------------------------------------- /man/readmefigs/README-eckhert-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hypertidy/tissot/HEAD/man/readmefigs/README-eckhert-1.png -------------------------------------------------------------------------------- /man/readmefigs/README-minimal-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hypertidy/tissot/HEAD/man/readmefigs/README-minimal-1.png -------------------------------------------------------------------------------- /man/readmefigs/README-minimal-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hypertidy/tissot/HEAD/man/readmefigs/README-minimal-2.png -------------------------------------------------------------------------------- /man/readmefigs/README-minimal-3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hypertidy/tissot/HEAD/man/readmefigs/README-minimal-3.png -------------------------------------------------------------------------------- /man/readmefigs/README-vicgrid-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hypertidy/tissot/HEAD/man/readmefigs/README-vicgrid-1.png -------------------------------------------------------------------------------- /man/readmefigs/README-mollweide-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hypertidy/tissot/HEAD/man/readmefigs/README-mollweide-1.png -------------------------------------------------------------------------------- /man/readmefigs/README-polar-laea-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hypertidy/tissot/HEAD/man/readmefigs/README-polar-laea-1.png -------------------------------------------------------------------------------- /man/readmefigs/README-polar-stereo-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hypertidy/tissot/HEAD/man/readmefigs/README-polar-stereo-1.png -------------------------------------------------------------------------------- /man/readmefigs/README-bigger-example-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hypertidy/tissot/HEAD/man/readmefigs/README-bigger-example-1.png -------------------------------------------------------------------------------- /man/readmefigs/README-bigger-example-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hypertidy/tissot/HEAD/man/readmefigs/README-bigger-example-2.png -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^README\.Rmd$ 4 | ^README-.*\.png$ 5 | ^man/readmefigs/* 6 | ^cran-comments\.md$ 7 | ^\.travis\.yml$ 8 | ^CODE_OF_CONDUCT\.md$ 9 | ^\.github$ 10 | ^data-raw$ 11 | ^gdalwmscache$ 12 | -------------------------------------------------------------------------------- /data-raw/DATASET.R: -------------------------------------------------------------------------------- 1 | ## code to prepare `DATASET` dataset goes here 2 | 3 | w <- do.call(cbind, maps::map(plot = FALSE)[1:2]) 4 | w[!w[,1] > -180, 1] <- -179.9 5 | w[!w[,1] < 180, 1] <- 179.9 6 | world <- w 7 | usethis::use_data(world, overwrite = FALSE, compress = "xz") 8 | -------------------------------------------------------------------------------- /tissot.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: knitr 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace,vignette 22 | -------------------------------------------------------------------------------- /man/ti_ellipse.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tissot.R 3 | \name{ti_ellipse} 4 | \alias{ti_ellipse} 5 | \title{Ellipse} 6 | \usage{ 7 | ti_ellipse(center, axes, scale = 1, n = 36, from = 0, to = 2 * pi) 8 | } 9 | \arguments{ 10 | \item{center}{center} 11 | 12 | \item{axes}{axes} 13 | 14 | \item{scale}{scale} 15 | 16 | \item{n}{n} 17 | 18 | \item{from}{from} 19 | 20 | \item{to}{to} 21 | } 22 | \value{ 23 | matrix 24 | } 25 | \description{ 26 | Ellipse 27 | } 28 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # tissot dev 2 | 3 | * New functions `tissot_map()` and `tissot_abline()` to easily add contextual world map 4 | data and location lines. 5 | 6 | * Improved ability to build more than one tissot and to easily plot multiple indicatrixes. 7 | 8 | * New function `tissot_get_proj()` with no arguments, just gets the last value of a plot projection 9 | registred by plot.indicatrixes. 10 | 11 | 12 | # tissot 0.0.1 13 | 14 | * Removed some old stuff. 15 | 16 | * Using PROJ and libproj, dev only versions. 17 | 18 | -------------------------------------------------------------------------------- /man/world.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tissot-package.R 3 | \docType{data} 4 | \name{world} 5 | \alias{world} 6 | \title{world coastline} 7 | \format{ 8 | An object of class \code{matrix} (inherits from \code{array}) with 82403 rows and 2 columns. 9 | } 10 | \usage{ 11 | world 12 | } 13 | \description{ 14 | A modified matrix version of data from the maps package. 15 | } 16 | \details{ 17 | Basically longitudes have been smooshed to 'abs(lon) < 180' 18 | } 19 | \keyword{datasets} 20 | -------------------------------------------------------------------------------- /R/tissot-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | #' @aliases tissot-package 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 | 11 | globalVariables("world") 12 | #' world coastline 13 | #' 14 | #' A modified matrix version of data from the maps package. 15 | #' 16 | #' Basically longitudes have been smooshed to 'abs(lon) < 180' 17 | #' @docType data 18 | #' @name world 19 | 'world' 20 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | # Release summary 2 | 3 | This is a first time submission. 4 | 5 | ## Test environments 6 | 7 | * Win builder dev 8 | * Windows release 9 | * Ubuntu release 10 | 11 | ## R CMD check results 12 | 13 | There were no ERRORs or WARNINGs. 14 | 15 | There was 1 NOTE: 16 | 17 | * checking CRAN incoming feasibility ... NOTE 18 | 19 | This is a first time submission. 20 | 21 | The package uses the words "Tissot" and "Indicatrix" which refer to the inventor and the invention: 22 | 23 | https://en.wikipedia.org/wiki/Tissot%27s_indicatrix 24 | 25 | 26 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(plot,indicatrix0) 4 | S3method(plot,indicatrixes) 5 | export(indicatrix) 6 | export(indicatrix0) 7 | export(ti_ellipse) 8 | export(tissot) 9 | export(tissot_abline) 10 | export(tissot_get_proj) 11 | export(tissot_map) 12 | importFrom(grDevices,grey) 13 | importFrom(grDevices,rgb) 14 | importFrom(grDevices,xy.coords) 15 | importFrom(graphics,abline) 16 | importFrom(graphics,lines) 17 | importFrom(graphics,plot) 18 | importFrom(graphics,polygon) 19 | importFrom(stats,numericDeriv) 20 | importFrom(tibble,tibble) 21 | -------------------------------------------------------------------------------- /man/tissot-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tissot-package.R 3 | \docType{package} 4 | \name{tissot-package} 5 | \alias{tissot-package} 6 | \alias{_PACKAGE} 7 | \title{tissot: The Tissot Indicatrix} 8 | \description{ 9 | Create and plot the Tissot Indicatrix. 10 | } 11 | \seealso{ 12 | Useful links: 13 | \itemize{ 14 | \item \url{https://github.com/hypertidy/tissot} 15 | \item Report bugs at \url{https://github.com/hypertidy/tissot/issues} 16 | } 17 | 18 | } 19 | \author{ 20 | \strong{Maintainer}: Michael D. Sumner \email{mdsumner@gmail.com} 21 | 22 | Authors: 23 | \itemize{ 24 | \item Bill Huber 25 | } 26 | 27 | } 28 | \keyword{internal} 29 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: tissot 2 | Type: Package 3 | Title: The Tissot Indicatrix 4 | Version: 0.0.1.9006 5 | Authors@R: c(person("Michael D.","Sumner", role = c("aut", "cre"), email = "mdsumner@gmail.com"), 6 | person("Bill", "Huber", role = "aut")) 7 | Description: Create and plot the Tissot Indicatrix. 8 | License: GPL-3 9 | Depends: 10 | R (>= 4.0.0) 11 | Imports: 12 | tibble, 13 | reproj (>= 0.6.0) 14 | RoxygenNote: 7.2.3 15 | LazyData: true 16 | LazyDataCompression: xz 17 | Encoding: UTF-8 18 | Additional_repositories: https://hypertidy.r-universe.dev 19 | URL: https://github.com/hypertidy/tissot, https://hypertidy.github.io/tissot/ 20 | BugReports: https://github.com/hypertidy/tissot/issues 21 | -------------------------------------------------------------------------------- /man/tissot_map.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tissot_map.R 3 | \name{tissot_map} 4 | \alias{tissot_map} 5 | \alias{tissot_abline} 6 | \alias{tissot_get_proj} 7 | \title{Get last plot projection} 8 | \usage{ 9 | tissot_map(..., add = TRUE) 10 | 11 | tissot_abline(lambda, phi = NULL, ..., proj.in = NULL) 12 | 13 | tissot_get_proj() 14 | } 15 | \arguments{ 16 | \item{...}{graphical parameters for [lines()] if 'add = TRUE', or for [plot()] if 'add = FALSE'} 17 | 18 | \item{add}{logical, default 'TRUE' add to existing plot or create new} 19 | 20 | \item{lambda}{longitude at which to draw a vertical line} 21 | 22 | \item{phi}{latitude at which to draw a horizontal line} 23 | 24 | \item{proj.in}{projection for expert use} 25 | } 26 | \value{ 27 | 'tissot_map()' returns the internal world map data (projected if one is current) as a matrix 28 | 29 | 'tissot_abline()' called for its side effect of drawing on the plot 30 | 31 | 'tissot_get_proj()' returns the value of the current projection, or NULL 32 | } 33 | \description{ 34 | 'tissot_map()' will add the [world] coastline to any map. 35 | } 36 | \details{ 37 | 'tissot_get_proj()' When the indicatrix is plotted it registers its projection. This string 38 | can be obtained with this getter function. 39 | 40 | 'tissot_abline()' will draw a vertical and horizontal line at a give longitude latitude (where 41 | they intersect is the actual lon,lat location) 42 | } 43 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: 4 | - main 5 | - master 6 | tags: 7 | -'*' 8 | 9 | name: pkgdown 10 | 11 | jobs: 12 | pkgdown: 13 | runs-on: macOS-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | steps: 17 | - uses: actions/checkout@v2 18 | 19 | - uses: r-lib/actions/setup-r@v1 20 | 21 | - uses: r-lib/actions/setup-pandoc@v1 22 | 23 | - name: Query dependencies 24 | run: | 25 | install.packages('remotes') 26 | saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) 27 | writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") 28 | shell: Rscript {0} 29 | 30 | - name: Restore R package cache 31 | uses: actions/cache@v2 32 | with: 33 | path: ${{ env.R_LIBS_USER }} 34 | key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} 35 | restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- 36 | 37 | - name: Install dependencies 38 | run: | 39 | remotes::install_deps(dependencies = TRUE) 40 | install.packages("pkgdown", type = "binary") 41 | shell: Rscript {0} 42 | 43 | - name: Install package 44 | run: R CMD INSTALL . 45 | 46 | - name: Deploy package 47 | run: | 48 | git config --local user.email "actions@github.com" 49 | git config --local user.name "GitHub Actions" 50 | Rscript -e 'pkgdown::deploy_to_branch(new_process = FALSE)' 51 | -------------------------------------------------------------------------------- /man/indicatrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tissot.R 3 | \name{indicatrix} 4 | \alias{indicatrix} 5 | \alias{plot.indicatrixes} 6 | \alias{indicatrix0} 7 | \alias{plot.indicatrix0} 8 | \title{Indicatrix} 9 | \usage{ 10 | indicatrix(x, scale = 1, ...) 11 | 12 | \method{plot}{indicatrixes}( 13 | x, 14 | asp = 1, 15 | xlab = "x", 16 | ylab = "y", 17 | add = FALSE, 18 | ..., 19 | col.base = rgb(0, 0, 0, 0.1), 20 | col.lambda = grey(0.75), 21 | col.phi = "#1b9e77", 22 | col.major = "#7570b3", 23 | col.minor = "#d95f02", 24 | col.outline = "black" 25 | ) 26 | 27 | indicatrix0(x, scale = 1, ...) 28 | 29 | \method{plot}{indicatrix0}( 30 | x, 31 | asp = 1, 32 | xlab = "Easting", 33 | ylab = "Northing", 34 | add = FALSE, 35 | ..., 36 | col.base = rgb(0, 0, 0, 0.1), 37 | col.lambda = grey(0.75), 38 | col.phi = "#45A271", 39 | col.major = "#A782C3", 40 | col.minor = "#C87A8A", 41 | col.outline = "black" 42 | ) 43 | } 44 | \arguments{ 45 | \item{x}{object from \code{tissot}} 46 | 47 | \item{scale}{scaling} 48 | 49 | \item{...}{arguments \code{n}, \code{from} and \code{to} passed to \code{ti_ellipse} function} 50 | 51 | \item{asp}{aspect ratio} 52 | 53 | \item{xlab}{x-axis labels} 54 | 55 | \item{ylab}{y-axis labels} 56 | 57 | \item{add}{add to existing plot} 58 | 59 | \item{col.base}{colour of base} 60 | 61 | \item{col.lambda}{colour of lambda} 62 | 63 | \item{col.phi}{colour of phi} 64 | 65 | \item{col.major}{major axis colour} 66 | 67 | \item{col.minor}{minor axis colour} 68 | 69 | \item{col.outline}{outline colour} 70 | } 71 | \description{ 72 | Indicatrix 73 | 74 | plot indicatrix 75 | } 76 | \details{ 77 | Reprocesses the output of \code{tissot} into convenient geometrical data. 78 | } 79 | -------------------------------------------------------------------------------- /man/tissot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tissot.R 3 | \name{tissot} 4 | \alias{tissot} 5 | \title{Tissot} 6 | \usage{ 7 | tissot( 8 | lambda, 9 | phi = NULL, 10 | degrees = TRUE, 11 | A = 6378137, 12 | f.inv = 298.257223563, 13 | ..., 14 | proj.in, 15 | proj.out 16 | ) 17 | } 18 | \arguments{ 19 | \item{lambda}{longitude} 20 | 21 | \item{phi}{latitude} 22 | 23 | \item{degrees}{logical, work in degrees or radians} 24 | 25 | \item{A}{ellipsoidal semi-major axis (meters)} 26 | 27 | \item{f.inv}{the inverse flattening} 28 | 29 | \item{...}{passed to internal function} 30 | 31 | \item{proj.in}{projection of input} 32 | 33 | \item{proj.out}{projection of context} 34 | } 35 | \value{ 36 | list with stuff as per below 37 | } 38 | \description{ 39 | Create the Tissot Indicatrix. 40 | } 41 | \details{ 42 | Compute properties of scale distortion and Tissot's indicatrix at location x = c(lambda, phi) 43 | using prj as the projection. A is the ellipsoidal semi-major axis (in meters) and f.inv is 44 | the inverse flattening. The projection must return a vector (x, y) when given a vector (lambda, phi). 45 | (Not vectorized.) Optional arguments ... are passed to prj. 46 | Source: Snyder pp 20-26 (WGS 84 defaults for the ellipsoidal parameters). 47 | All input and output angles are in degrees. 48 | } 49 | \examples{ 50 | x <- seq(-175, 175, by = 15) 51 | y <- seq(-82.5, 82.5, by = 15) 52 | xy <- expand.grid(x, y) 53 | r <- tissot(xy, 54 | proj.in= "OGC:CRS84", 55 | proj.out= "+proj=robin") 56 | 57 | j <- which.min(abs(135 - r$lon) + abs(54 - r$lat)) 58 | idx0 <- indicatrix0(r[j, ], scale=10^4, n=71) 59 | op <- par(mfrow = c(2, 1)) 60 | plot(idx0, add = FALSE) 61 | idx <- indicatrix(r, scale=3e5, n=71) 62 | plot(idx, add = FALSE) 63 | tissot_abline(r$lon[j], r$lat[j]) 64 | par(op) 65 | 66 | 67 | } 68 | -------------------------------------------------------------------------------- /R/tissot_map.R: -------------------------------------------------------------------------------- 1 | #' Get last plot projection 2 | #' 3 | #' 4 | #' 'tissot_map()' will add the [world] coastline to any map. 5 | #' 6 | #' 'tissot_get_proj()' When the indicatrix is plotted it registers its projection. This string 7 | #' can be obtained with this getter function. 8 | #' 9 | #' 'tissot_abline()' will draw a vertical and horizontal line at a give longitude latitude (where 10 | #' they intersect is the actual lon,lat location) 11 | #' 12 | #' @param add logical, default 'TRUE' add to existing plot or create new 13 | #' @param ... graphical parameters for [lines()] if 'add = TRUE', or for [plot()] if 'add = FALSE' 14 | #' @param lambda longitude at which to draw a vertical line 15 | #' @param phi latitude at which to draw a horizontal line 16 | #' @param proj.in projection for expert use 17 | #' @return 'tissot_map()' returns the internal world map data (projected if one is current) as a matrix 18 | #' @export 19 | tissot_map <- function(..., add = TRUE) { 20 | ## we might catch list(...) and see if something can project them? (one day) 21 | props <- list(...) 22 | w <- .project_world() 23 | if (is.null(props$col)) props$col <- rgb(.7, .7, .7) 24 | if (add) { 25 | props$x <- w 26 | do.call(lines, props) 27 | } else { 28 | props$x <- w 29 | if (is.null(props$pch)) props$pch <- "." 30 | 31 | do.call(plot, props) 32 | } 33 | invisible(w) 34 | } 35 | #' @name tissot_map 36 | #' @export 37 | #' @importFrom graphics abline 38 | #' @return 'tissot_abline()' called for its side effect of drawing on the plot 39 | tissot_abline <- function(lambda, phi = NULL, ..., proj.in = NULL) { 40 | xy <- do.call(cbind, xy.coords(lambda, phi)[1:2]) 41 | 42 | target <- tissot_get_proj() 43 | if (!is.null(target)) { 44 | xy <- .prj(xy, target, proj.in = proj.in) 45 | } 46 | graphics::abline(v = xy[,1L], h = xy[,2L]) 47 | } 48 | #' @name tissot_map 49 | #' @return 'tissot_get_proj()' returns the value of the current projection, or NULL 50 | #' @export 51 | tissot_get_proj <- function() { 52 | getOption("tissot.last.plot.proj") 53 | } 54 | 55 | .project_world <- function() { 56 | target <- tissot_get_proj() 57 | if (is.null(target)) return(world) ## no projection in effect 58 | .prj(world, target, proj.in = "OGC:CRS84") 59 | } 60 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # For help debugging build failures open an issue on the RStudio community with the 'github-actions' tag. 2 | # https://community.rstudio.com/new-topic?category=Package%20development&tags=github-actions 3 | on: 4 | push: 5 | branches: 6 | - main 7 | - master 8 | pull_request: 9 | branches: 10 | - main 11 | - master 12 | 13 | name: R-CMD-check 14 | 15 | jobs: 16 | R-CMD-check: 17 | runs-on: ${{ matrix.config.os }} 18 | 19 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 20 | 21 | strategy: 22 | fail-fast: false 23 | matrix: 24 | config: 25 | - {os: windows-latest, r: 'release'} 26 | - {os: macOS-latest, r: 'release'} 27 | - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} 28 | - {os: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest", http-user-agent: "R/4.1.0 (ubuntu-20.04) R (4.1.0 x86_64-pc-linux-gnu x86_64 linux-gnu) on GitHub Actions" } 29 | 30 | env: 31 | R_REMOTES_NO_ERRORS_FROM_WARNINGS: true 32 | RSPM: ${{ matrix.config.rspm }} 33 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 34 | 35 | steps: 36 | - uses: actions/checkout@v2 37 | 38 | - uses: r-lib/actions/setup-r@v1 39 | with: 40 | r-version: ${{ matrix.config.r }} 41 | 42 | - uses: r-lib/actions/setup-pandoc@v1 43 | 44 | - name: Query dependencies 45 | run: | 46 | install.packages('remotes') 47 | saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) 48 | writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") 49 | shell: Rscript {0} 50 | 51 | - name: Restore R package cache 52 | uses: actions/cache@v2 53 | with: 54 | path: ${{ env.R_LIBS_USER }} 55 | key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} 56 | restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- 57 | 58 | - name: Install system dependencies 59 | if: runner.os == 'Linux' 60 | run: | 61 | while read -r cmd 62 | do 63 | eval sudo $cmd 64 | done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))') 65 | 66 | - name: Install dependencies 67 | run: | 68 | remotes::install_deps(dependencies = TRUE) 69 | remotes::install_cran("rcmdcheck") 70 | shell: Rscript {0} 71 | 72 | - name: Check 73 | env: 74 | _R_CHECK_CRAN_INCOMING_REMOTE_: false 75 | run: | 76 | options(crayon.enabled = TRUE) 77 | rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check") 78 | shell: Rscript {0} 79 | 80 | - name: Upload check results 81 | if: failure() 82 | uses: actions/upload-artifact@main 83 | with: 84 | name: ${{ runner.os }}-r${{ matrix.config.r }}-results 85 | path: check 86 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | We as members, contributors, and leaders pledge to make participation in our 6 | community a harassment-free experience for everyone, regardless of age, body 7 | size, visible or invisible disability, ethnicity, sex characteristics, gender 8 | identity and expression, level of experience, education, socio-economic status, 9 | nationality, personal appearance, race, religion, or sexual identity and 10 | orientation. 11 | 12 | We pledge to act and interact in ways that contribute to an open, welcoming, 13 | diverse, inclusive, and healthy community. 14 | 15 | ## Our Standards 16 | 17 | Examples of behavior that contributes to a positive environment for our 18 | community include: 19 | 20 | * Demonstrating empathy and kindness toward other people 21 | * Being respectful of differing opinions, viewpoints, and experiences 22 | * Giving and gracefully accepting constructive feedback 23 | * Accepting responsibility and apologizing to those affected by our mistakes, 24 | and learning from the experience 25 | * Focusing on what is best not just for us as individuals, but for the overall 26 | community 27 | 28 | Examples of unacceptable behavior include: 29 | 30 | * The use of sexualized language or imagery, and sexual attention or 31 | advances of any kind 32 | * Trolling, insulting or derogatory comments, and personal or political attacks 33 | * Public or private harassment 34 | * Publishing others' private information, such as a physical or email 35 | address, without their explicit permission 36 | * Other conduct which could reasonably be considered inappropriate in a 37 | professional setting 38 | 39 | ## Enforcement Responsibilities 40 | 41 | Community leaders are responsible for clarifying and enforcing our standards 42 | of acceptable behavior and will take appropriate and fair corrective action in 43 | response to any behavior that they deem inappropriate, threatening, offensive, 44 | or harmful. 45 | 46 | Community leaders have the right and responsibility to remove, edit, or reject 47 | comments, commits, code, wiki edits, issues, and other contributions that are 48 | not aligned to this Code of Conduct, and will communicate reasons for moderation 49 | decisions when appropriate. 50 | 51 | ## Scope 52 | 53 | This Code of Conduct applies within all community spaces, and also applies 54 | when an individual is officially representing the community in public spaces. 55 | Examples of representing our community include using an official e-mail 56 | address, posting via an official social media account, or acting as an appointed 57 | representative at an online or offline event. 58 | 59 | ## Enforcement 60 | 61 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 62 | reported to the community leaders responsible for enforcement at [INSERT CONTACT 63 | METHOD]. All complaints will be reviewed and investigated promptly and fairly. 64 | 65 | All community leaders are obligated to respect the privacy and security of the 66 | reporter of any incident. 67 | 68 | ## Enforcement Guidelines 69 | 70 | Community leaders will follow these Community Impact Guidelines in determining 71 | the consequences for any action they deem in violation of this Code of Conduct: 72 | 73 | ### 1. Correction 74 | 75 | **Community Impact**: Use of inappropriate language or other behavior deemed 76 | unprofessional or unwelcome in the community. 77 | 78 | **Consequence**: A private, written warning from community leaders, providing 79 | clarity around the nature of the violation and an explanation of why the 80 | behavior was inappropriate. A public apology may be requested. 81 | 82 | ### 2. Warning 83 | 84 | **Community Impact**: A violation through a single incident or series of 85 | actions. 86 | 87 | **Consequence**: A warning with consequences for continued behavior. No 88 | interaction with the people involved, including unsolicited interaction with 89 | those enforcing the Code of Conduct, for a specified period of time. This 90 | includes avoiding interactions in community spaces as well as external channels 91 | like social media. Violating these terms may lead to a temporary or permanent 92 | ban. 93 | 94 | ### 3. Temporary Ban 95 | 96 | **Community Impact**: A serious violation of community standards, including 97 | sustained inappropriate behavior. 98 | 99 | **Consequence**: A temporary ban from any sort of interaction or public 100 | communication with the community for a specified period of time. No public or 101 | private interaction with the people involved, including unsolicited interaction 102 | with those enforcing the Code of Conduct, is allowed during this period. 103 | Violating these terms may lead to a permanent ban. 104 | 105 | ### 4. Permanent Ban 106 | 107 | **Community Impact**: Demonstrating a pattern of violation of community 108 | standards, including sustained inappropriate behavior, harassment of an 109 | individual, or aggression toward or disparagement of classes of individuals. 110 | 111 | **Consequence**: A permanent ban from any sort of public interaction within the 112 | community. 113 | 114 | ## Attribution 115 | 116 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], 117 | version 2.0, 118 | available at https://www.contributor-covenant.org/version/2/0/ 119 | code_of_conduct.html. 120 | 121 | Community Impact Guidelines were inspired by [Mozilla's code of conduct 122 | enforcement ladder](https://github.com/mozilla/diversity). 123 | 124 | [homepage]: https://www.contributor-covenant.org 125 | 126 | For answers to common questions about this code of conduct, see the FAQ at 127 | https://www.contributor-covenant.org/faq. Translations are available at https:// 128 | www.contributor-covenant.org/translations. 129 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | [![R-CMD-check](https://github.com/hypertidy/tissot/workflows/R-CMD-check/badge.svg)](https://github.com/hypertidy/tissot/actions) 5 | 6 | 7 | # The Tissot Indicatrix 8 | 9 | The [Tissot 10 | Indicatrix](https://en.wikipedia.org/wiki/Tissot%27s_indicatrix) is used 11 | to characterize local distortions within map projections. 12 | 13 | I have derived the code in this package (with permission) from Bill 14 | Huber’s wonderful online answer here: 15 | 16 | 17 | 18 | Also see 19 | 20 | 21 | 22 | # Installation 23 | 24 | Can be installed with 25 | 26 | ``` r 27 | remotes::install_github("hypertidy/tissot") 28 | ``` 29 | 30 | # Minimal example 31 | 32 | ``` r 33 | library(tissot) 34 | # NAD 27 in 35 | # World Robinson projection out 36 | r <- tissot(130, 54, 37 | proj.in= "EPSG:4267", 38 | proj.out= "ESRI:54030") 39 | i0 <- indicatrix(r, scale=1e2, n=71) 40 | plot(i0) 41 | ``` 42 | 43 | ![](man/readmefigs/README-minimal-1.png) 44 | 45 | ``` r 46 | plot(tissot:::.prj(earthcircle::earthcircle(130, 54, scale = 5e2), tissot_get_proj())) 47 | #> assuming WGS84 for unprojected angular coordinates 48 | tissot_abline(130, 54) 49 | #> assuming WGS84 for unprojected angular coordinates 50 | ``` 51 | 52 | ![](man/readmefigs/README-minimal-2.png) 53 | 54 | ``` r 55 | tissot_map(add = FALSE, xlim = c(8.5e6, 1.3e7), ylim = c(4e6, 7e6)) 56 | i1 <- indicatrix(r, scale=1e6, n=71) 57 | plot(i1, add = T) 58 | tissot_abline(130, 54) 59 | #> assuming WGS84 for unprojected angular coordinates 60 | lines(tissot:::.prj(earthcircle::earthcircle(130, 54, scale = 2e6), tissot_get_proj()) %*% (diag(2) * 2)) 61 | #> assuming WGS84 for unprojected angular coordinates 62 | ``` 63 | 64 | ![](man/readmefigs/README-minimal-3.png) 65 | 66 | Since an original port of whuber’s code we have now made it much easier 67 | to create many indicatrixes and plot them in one step. Or we can still 68 | just grab one and plot it on its own. Note that the scale is quite 69 | different in these plots. 70 | 71 | ``` r 72 | x <- seq(-172.5, 172.5, by = 15) 73 | y <- seq(-82.5, 82.5, by = 15) 74 | xy <- expand.grid(x, y) 75 | r <- tissot(xy, 76 | proj.in= "OGC:CRS84", 77 | proj.out= "+proj=robin") 78 | 79 | j <- which.min(abs(135 - r$lon) + abs(54 - r$lat)) 80 | i <- indicatrix0(r[j, ], scale= 1e4, n=71) 81 | plot(i, add = FALSE) 82 | ``` 83 | 84 | ![](man/readmefigs/README-bigger-example-1.png) 85 | 86 | ``` r 87 | ii <- indicatrix(r, scale=4e5, n=71) 88 | tissot_map(add = FALSE) 89 | plot(ii, add = TRUE) 90 | tissot_abline(xy[j, 1], xy[j, 2]) 91 | #> assuming WGS84 for unprojected angular coordinates 92 | ``` 93 | 94 | ![](man/readmefigs/README-bigger-example-2.png) 95 | 96 | Mollweide. 97 | 98 | ``` r 99 | m <- tissot(xy, 100 | proj.in= "OGC:CRS84", 101 | proj.out= "+proj=moll") 102 | 103 | 104 | plot(indicatrix(m, scale=4e5, n=71), add = FALSE) 105 | tissot_map() 106 | ``` 107 | 108 | ![](man/readmefigs/README-mollweide-1.png) 109 | 110 | Eckhert III 111 | 112 | ``` r 113 | e <- tissot(xy, 114 | proj.in= "OGC:CRS84", 115 | proj.out= "+proj=eck3") 116 | 117 | 118 | plot(indicatrix(e, scale=4e5, n=71), add = FALSE) 119 | ``` 120 | 121 | ![](man/readmefigs/README-eckhert-1.png) 122 | 123 | Equidistant 124 | 125 | ``` r 126 | aeqd <- tissot(xy, 127 | proj.in= "OGC:CRS84", 128 | proj.out= "+proj=aeqd") 129 | 130 | 131 | plot(indicatrix(aeqd, scale=4e5, n=71), add = FALSE) 132 | ``` 133 | 134 | ![](man/readmefigs/README-aeqd-1.png) 135 | 136 | Cassini-Soldner (spherical because ellipsoidal seems broken) 137 | 138 | ``` r 139 | xx <- tissot(xy, 140 | proj.in= "OGC:CRS84", 141 | proj.out= "+proj=cass +R=6378137") 142 | 143 | 144 | plot(indicatrix(xx, scale=4e5, n=71), add = FALSE) 145 | points(tissot_map(col = "transparent"), pch = ".") 146 | ``` 147 | 148 | ![](man/readmefigs/README-xx-1.png) 149 | 150 | Sinusoidal 151 | 152 | ``` r 153 | s <- tissot(xy, 154 | proj.in= "OGC:CRS84", 155 | proj.out= "+proj=sinu") 156 | 157 | 158 | plot(indicatrix(s, scale=3e5, n=71), add = FALSE) 159 | tissot_map() 160 | ``` 161 | 162 | ![](man/readmefigs/README-sinu-1.png) 163 | 164 | # Polar example 165 | 166 | ``` r 167 | p <- tissot(xy[xy[,2] < -30, ], 168 | proj.in= "OGC:CRS84", 169 | proj.out= "+proj=stere +lon_0=147 +lat_ts-71 +lat_0=-90 +datum=WGS84") 170 | 171 | plot(indicatrix(p, scale = 3e5)) 172 | tissot_map() 173 | tissot_abline(147, -42) 174 | #> assuming WGS84 for unprojected angular coordinates 175 | ``` 176 | 177 | ![](man/readmefigs/README-polar-stereo-1.png) 178 | 179 | ``` r 180 | laea <- tissot(xy[xy[,2] < 20, ], 181 | proj.in= "OGC:CRS84", 182 | proj.out= "+proj=laea +lon_0=147 +lat_0=-90 +datum=WGS84") 183 | 184 | plot(indicatrix(laea, scale = 3e5)) 185 | ``` 186 | 187 | ![](man/readmefigs/README-polar-laea-1.png) 188 | 189 | Oblique Mercator 190 | 191 | You get the idea … many projections need extra attention for real data. 192 | 193 | ``` r 194 | mp0 <- do.call(cbind, maps::map(plot = FALSE)[1:2]) 195 | omerc <- "+proj=omerc +lonc=147 +gamma=9 +alpha=9 +lat_0=-80 +ellps=WGS84" 196 | mp <- tissot:::.prj(mp0, omerc, proj.in = "OGC:CRS84") 197 | o <- tissot(xy, 198 | proj.in= "OGC:CRS84", 199 | proj.out= omerc) 200 | 201 | plot(indicatrix(o, scale = 3e5)) 202 | lines(mp) 203 | ``` 204 | 205 | ![](man/readmefigs/README-omerc-1.png) 206 | 207 | VicGrid 208 | 209 | ``` r 210 | vgrid <- "+proj=lcc +lat_1=-36 +lat_2=-38 +lat_0=-37 +lon_0=145 +x_0=2500000 +y_0=2500000 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs" 211 | mp <- tissot:::.prj(mp0, vgrid, proj.in = "OGC:CRS84") 212 | v <- tissot(as.matrix(expand.grid(seq(120, 165, by =5 ), 213 | seq(-45, -35, by = 5))), 214 | proj.in= "OGC:CRS84", 215 | proj.out= vgrid) 216 | 217 | plot(indicatrix(v, scale = 2e5)) 218 | lines(mp) 219 | ``` 220 | 221 | ![](man/readmefigs/README-vicgrid-1.png) 222 | 223 | UTM Zone 54 (Hobart) 224 | 225 | ``` r 226 | utm <- "+proj=utm +zone=54 +south" 227 | mp <- tissot:::.prj(mp0, utm, proj.in = "OGC:CRS84") 228 | u <- tissot(as.matrix(expand.grid(seq(108, 162, by =6 ), 229 | seq(-65, 55, by = 15))), 230 | proj.in= "OGC:CRS84", 231 | proj.out= utm) 232 | 233 | plot(indicatrix(u, scale = 2e5)) 234 | lines(mp) 235 | ``` 236 | 237 | ![](man/readmefigs/README-utm54-1.png) 238 | 239 | ## Code of Conduct 240 | 241 | Please note that the tissot project is released with a [Contributor Code 242 | of 243 | Conduct](https://contributor-covenant.org/version/2/0/CODE_OF_CONDUCT.html). 244 | By contributing to this project, you agree to abide by its terms. 245 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: 3 | md_document: 4 | variant: markdown_github 5 | editor_options: 6 | chunk_output_type: console 7 | --- 8 | 9 | 10 | 11 | 12 | ```{r, echo = FALSE} 13 | knitr::opts_chunk$set( 14 | collapse = TRUE, 15 | comment = "#>", 16 | fig.path = "man/readmefigs/README-", 17 | fig.height = 7, 18 | fig.width = 7 19 | ) 20 | 21 | 22 | ``` 23 | 24 | 25 | [![R-CMD-check](https://github.com/hypertidy/tissot/workflows/R-CMD-check/badge.svg)](https://github.com/hypertidy/tissot/actions) 26 | 27 | 28 | # The Tissot Indicatrix 29 | 30 | The [Tissot Indicatrix](https://en.wikipedia.org/wiki/Tissot%27s_indicatrix) is used to characterize local distortions within map projections. 31 | 32 | 33 | I have derived the code in this package (with permission) from Bill Huber's wonderful online answer here: 34 | 35 | http://gis.stackexchange.com/questions/31651/an-example-tissot-ellipse-for-an-equirectangular-projection 36 | 37 | Also see 38 | 39 | https://gis.stackexchange.com/questions/5068/how-to-create-an-accurate-tissot-indicatrix 40 | 41 | 42 | 43 | # Installation 44 | 45 | Can be installed with 46 | 47 | ```R 48 | remotes::install_github("hypertidy/tissot") 49 | ``` 50 | 51 | # Minimal example 52 | 53 | ```{r minimal} 54 | library(tissot) 55 | # NAD 27 in 56 | # World Robinson projection out 57 | r <- tissot(130, 54, 58 | proj.in= "EPSG:4267", 59 | proj.out= "ESRI:54030") 60 | i0 <- indicatrix(r, scale=1e2, n=71) 61 | plot(i0) 62 | plot(tissot:::.prj(earthcircle::earthcircle(130, 54, scale = 5e2), tissot_get_proj())) 63 | tissot_abline(130, 54) 64 | 65 | tissot_map(add = FALSE, xlim = c(8.5e6, 1.3e7), ylim = c(4e6, 7e6)) 66 | i1 <- indicatrix(r, scale=1e6, n=71) 67 | plot(i1, add = T) 68 | tissot_abline(130, 54) 69 | lines(tissot:::.prj(earthcircle::earthcircle(130, 54, scale = 2e6), tissot_get_proj()) %*% (diag(2) * 2)) 70 | 71 | ``` 72 | 73 | 74 | Since an original port of whuber's code we have now made it much easier to create many indicatrixes and plot them in one step. Or we can still just grab one and plot it on its own. Note that the scale is quite different in these plots. 75 | 76 | 77 | ```{r bigger-example} 78 | x <- seq(-172.5, 172.5, by = 15) 79 | y <- seq(-82.5, 82.5, by = 15) 80 | xy <- expand.grid(x, y) 81 | r <- tissot(xy, 82 | proj.in= "OGC:CRS84", 83 | proj.out= "+proj=robin") 84 | 85 | j <- which.min(abs(135 - r$lon) + abs(54 - r$lat)) 86 | i <- indicatrix0(r[j, ], scale= 1e4, n=71) 87 | plot(i, add = FALSE) 88 | 89 | ii <- indicatrix(r, scale=4e5, n=71) 90 | tissot_map(add = FALSE) 91 | plot(ii, add = TRUE) 92 | tissot_abline(xy[j, 1], xy[j, 2]) 93 | ``` 94 | 95 | Mollweide. 96 | 97 | ```{r mollweide} 98 | m <- tissot(xy, 99 | proj.in= "OGC:CRS84", 100 | proj.out= "+proj=moll") 101 | 102 | 103 | plot(indicatrix(m, scale=4e5, n=71), add = FALSE) 104 | tissot_map() 105 | ``` 106 | 107 | 108 | Eckhert III 109 | 110 | ```{r eckhert} 111 | e <- tissot(xy, 112 | proj.in= "OGC:CRS84", 113 | proj.out= "+proj=eck3") 114 | 115 | 116 | plot(indicatrix(e, scale=4e5, n=71), add = FALSE) 117 | ``` 118 | 119 | Equidistant 120 | 121 | ```{r aeqd} 122 | aeqd <- tissot(xy, 123 | proj.in= "OGC:CRS84", 124 | proj.out= "+proj=aeqd") 125 | 126 | 127 | plot(indicatrix(aeqd, scale=4e5, n=71), add = FALSE) 128 | ``` 129 | 130 | Cassini-Soldner (spherical because ellipsoidal seems broken) 131 | 132 | ```{r xx} 133 | xx <- tissot(xy, 134 | proj.in= "OGC:CRS84", 135 | proj.out= "+proj=cass +R=6378137") 136 | 137 | 138 | plot(indicatrix(xx, scale=4e5, n=71), add = FALSE) 139 | points(tissot_map(col = "transparent"), pch = ".") 140 | 141 | ``` 142 | 143 | 144 | Sinusoidal 145 | 146 | ```{r sinu} 147 | s <- tissot(xy, 148 | proj.in= "OGC:CRS84", 149 | proj.out= "+proj=sinu") 150 | 151 | 152 | plot(indicatrix(s, scale=3e5, n=71), add = FALSE) 153 | tissot_map() 154 | 155 | ``` 156 | 157 | 158 | 159 | # Polar example 160 | 161 | 162 | ```{r polar-stereo} 163 | p <- tissot(xy[xy[,2] < -30, ], 164 | proj.in= "OGC:CRS84", 165 | proj.out= "+proj=stere +lon_0=147 +lat_ts-71 +lat_0=-90 +datum=WGS84") 166 | 167 | plot(indicatrix(p, scale = 3e5)) 168 | tissot_map() 169 | tissot_abline(147, -42) 170 | ``` 171 | 172 | ```{r polar-laea} 173 | laea <- tissot(xy[xy[,2] < 20, ], 174 | proj.in= "OGC:CRS84", 175 | proj.out= "+proj=laea +lon_0=147 +lat_0=-90 +datum=WGS84") 176 | 177 | plot(indicatrix(laea, scale = 3e5)) 178 | 179 | ``` 180 | 181 | 182 | Oblique Mercator 183 | 184 | You get the idea ... many projections need extra attention for real data. 185 | 186 | 187 | ```{r omerc} 188 | mp0 <- do.call(cbind, maps::map(plot = FALSE)[1:2]) 189 | omerc <- "+proj=omerc +lonc=147 +gamma=9 +alpha=9 +lat_0=-80 +ellps=WGS84" 190 | mp <- tissot:::.prj(mp0, omerc, proj.in = "OGC:CRS84") 191 | o <- tissot(xy, 192 | proj.in= "OGC:CRS84", 193 | proj.out= omerc) 194 | 195 | plot(indicatrix(o, scale = 3e5)) 196 | lines(mp) 197 | 198 | ``` 199 | 200 | 201 | VicGrid 202 | 203 | ```{r vicgrid} 204 | 205 | vgrid <- "+proj=lcc +lat_1=-36 +lat_2=-38 +lat_0=-37 +lon_0=145 +x_0=2500000 +y_0=2500000 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs" 206 | mp <- tissot:::.prj(mp0, vgrid, proj.in = "OGC:CRS84") 207 | v <- tissot(as.matrix(expand.grid(seq(120, 165, by =5 ), 208 | seq(-45, -35, by = 5))), 209 | proj.in= "OGC:CRS84", 210 | proj.out= vgrid) 211 | 212 | plot(indicatrix(v, scale = 2e5)) 213 | lines(mp) 214 | ``` 215 | 216 | UTM Zone 54 (Hobart) 217 | 218 | 219 | ```{r utm54} 220 | 221 | utm <- "+proj=utm +zone=54 +south" 222 | mp <- tissot:::.prj(mp0, utm, proj.in = "OGC:CRS84") 223 | u <- tissot(as.matrix(expand.grid(seq(108, 162, by =6 ), 224 | seq(-65, 55, by = 15))), 225 | proj.in= "OGC:CRS84", 226 | proj.out= utm) 227 | 228 | plot(indicatrix(u, scale = 2e5)) 229 | lines(mp) 230 | ``` 231 | 232 | ```{r, warning=FALSE,eval=F,include=FALSE} 233 | library(tissot) 234 | library(maptools) 235 | library(raster) 236 | buildandplot <- function(data, scale = 5e5, ...) { 237 | ## grid of points 238 | gr <- rasterToPoints(raster(data, nrow = 7, ncol = 7), spatial = FALSE) 239 | ## relying on dev {PROJ} that links to unreleased {libproj} 240 | grll <- reproj::reproj_xy(gr, "OGC:CRS84", source = projection(data) )) 241 | sp::plot(data, ...) 242 | grll <- grll[!is.na(grll[,1]), ] 243 | for (i in seq_len(nrow(grll))) { 244 | tis <- tissot(grll[i, 1], grll[i, 2], 245 | proj.in = projection(wrld_simpl), proj.out = projection(data)) 246 | ind <- indicatrix(tis, scale = scale, n = 71) 247 | plot(ind, add = TRUE) 248 | } 249 | invisible(NULL) 250 | } 251 | 252 | 253 | ## choose a projection 254 | ptarget1 <- "+proj=stere +lon_0=147 +lat_ts-71 +lat_0=-90 +ellps=WGS84" 255 | w1 <- spTransform(subset(wrld_simpl, coordinates(wrld_simpl)[,2] < 10), CRS(ptarget1)) 256 | 257 | ptarget2 <- "+proj=laea +lon_0=147 +lat_0=-90 +ellps=WGS84" 258 | w2 <- spTransform(subset(wrld_simpl, coordinates(wrld_simpl)[,2] < 10), CRS(ptarget2)) 259 | 260 | ptarget3 <- "+proj=omerc +lonc=147 +gamma=9 +alpha=9 +lat_0=-80 +ellps=WGS84" 261 | w3 <- spTransform(subset(wrld_simpl, coordinates(wrld_simpl)[,2] < -12), CRS(ptarget3), scale = 3e5) 262 | 263 | 264 | buildandplot(w1, main = "Polar Stereographic") 265 | buildandplot(w2, main = "Lambert Azimuthal Equal Area") 266 | 267 | buildandplot(w3, main = "Oblique Mercator") 268 | 269 | 270 | 271 | ``` 272 | 273 | 274 | ```{r, message=FALSE, warning=FALSE, include=F, eval=F} 275 | 276 | 277 | ## doesn't look right 278 | # ptarget8 <- "+proj=laea +lat_0=-90" 279 | # w8 <- spTransform(wrld_simpl, CRS(ptarget8)) 280 | # buildandplot(w8) 281 | 282 | 283 | 284 | 285 | library(raster) 286 | ptarget4 <- "+proj=merc +ellps=WGS84" 287 | w4 <- spTransform(raster::intersect(disaggregate(wrld_simpl), as(extent(-180, 180, -85, 90), "SpatialPolygons")), ptarget4) 288 | buildandplot(w4, main = "Mercator") 289 | 290 | ptarget5 <- "+proj=lcc +ellps=WGS84 +lon_0=134 +lat_0=-30 +lat_1=-50 +lat_2=-20" 291 | w5 <- spTransform(raster::intersect(disaggregate(wrld_simpl), as(extent(80, 180, -65, -10), "SpatialPolygons")), ptarget5) 292 | buildandplot(w5, main = "Lambert Conformal Conic", scale = 3.5e5) 293 | 294 | 295 | ptarget6 <- "+proj=utm +zone=50 +south +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs " 296 | 297 | w6 <- spTransform(raster::intersect(disaggregate(wrld_simpl), as(extent(80, 160, -65, -10), "SpatialPolygons")), ptarget6) 298 | buildandplot(w6, main = "UTM South Zone 50 ", col = "grey", scale = 2.5e5) 299 | 300 | 301 | 302 | buildandplot(wrld_simpl, main = "Longitude / Latitude") 303 | degAxis(1) 304 | degAxis(2) 305 | 306 | ``` 307 | 308 | 309 | ```{r, eval = F, include=F} 310 | ## changes in spatial break this old hack 311 | library(dplyr) 312 | ex <- extent(c(20891678, 40158321, -13438415, 10618277)) 313 | target7 <- "+proj=lsat +lsat=5 +path=188" 314 | library(spbabel) 315 | tab <- sptable(spTransform(disaggregate(wrld_simpl), target7)) %>% filter(x_ >= xmin(ex), x_ <= xmax(ex), y_ >= ymin(ex), y_ <= ymax(ex)) 316 | ## egregiously naive crop here, but good enough for the task 317 | w7 <- sp(tab %>% group_by(branch_) %>% summarize(n = n()) %>% filter(n > 2) %>% inner_join(tab), crs = target7) 318 | library(graticule) 319 | g <- graticule(seq(-180, 165, by = 15), seq(-85, -20, by = 5), proj = target7, xlim = c(-180, 180), ylim = c(-85, -5)) 320 | buildandplot(w7, main = "Space Oblique Mercator, lsat=5, path=188 ", col = "grey", scale = 5e5) 321 | plot(g, add = TRUE, lty = 2) 322 | ``` 323 | 324 | 325 | ## Code of Conduct 326 | 327 | Please note that the tissot project is released with a [Contributor Code of Conduct](https://contributor-covenant.org/version/2/0/CODE_OF_CONDUCT.html). By contributing to this project, you agree to abide by its terms. 328 | -------------------------------------------------------------------------------- /R/tissot.R: -------------------------------------------------------------------------------- 1 | .prj <- function(z, proj.out, ..., proj.in = NULL) { 2 | if (is.null(proj.in)) { 3 | message("assuming WGS84 for unprojected angular coordinates") 4 | proj.in <- "OGC:CRS84" 5 | } 6 | 7 | reproj::reproj_xy(matrix(z, ncol = 2L), proj.out, source = proj.in) 8 | 9 | } 10 | .to.degrees <- function(x) x * 180 / pi 11 | .to.radians <- function(x) x * pi / 180 12 | .clamp <- function(x) min(max(x, -1), 1) # Avoids invalid args to asin 13 | .norm <- function(x) sqrt(sum(x*x)) 14 | 15 | 16 | #' Tissot 17 | #' 18 | #' Create the Tissot Indicatrix. 19 | #' 20 | #' Compute properties of scale distortion and Tissot's indicatrix at location x = c(lambda, phi) 21 | #' using prj as the projection. A is the ellipsoidal semi-major axis (in meters) and f.inv is 22 | #' the inverse flattening. The projection must return a vector (x, y) when given a vector (lambda, phi). 23 | #' (Not vectorized.) Optional arguments ... are passed to prj. 24 | #' Source: Snyder pp 20-26 (WGS 84 defaults for the ellipsoidal parameters). 25 | #' All input and output angles are in degrees. 26 | #' @param lambda longitude 27 | #' @param phi latitude 28 | #' @param degrees logical, work in degrees or radians 29 | #' @param A ellipsoidal semi-major axis (meters) 30 | #' @param f.inv the inverse flattening 31 | #' @param ... passed to internal function 32 | #' @param proj.in projection of input 33 | #' @param proj.out projection of context 34 | #' @return list with stuff as per below 35 | #' @export 36 | #' @examples 37 | #' x <- seq(-175, 175, by = 15) 38 | #' y <- seq(-82.5, 82.5, by = 15) 39 | #' xy <- expand.grid(x, y) 40 | #' r <- tissot(xy, 41 | #' proj.in= "OGC:CRS84", 42 | #' proj.out= "+proj=robin") 43 | #' 44 | #' j <- which.min(abs(135 - r$lon) + abs(54 - r$lat)) 45 | #' idx0 <- indicatrix0(r[j, ], scale=10^4, n=71) 46 | #' op <- par(mfrow = c(2, 1)) 47 | #' plot(idx0, add = FALSE) 48 | 49 | #' idx <- indicatrix(r, scale=3e5, n=71) 50 | #' plot(idx, add = FALSE) 51 | #' tissot_abline(r$lon[j], r$lat[j]) 52 | #' par(op) 53 | #' 54 | #' 55 | #' @importFrom grDevices grey rgb 56 | #' @importFrom graphics lines plot polygon 57 | #' @importFrom stats numericDeriv 58 | #' @importFrom grDevices xy.coords 59 | tissot <- function(lambda, phi = NULL, degrees=TRUE, A = 6378137, f.inv=298.257223563, ..., proj.in, proj.out) { 60 | xy <- xy.coords(lambda, phi) 61 | lam <- xy[[1L]] 62 | phi <- xy[[2L]] 63 | out <- vector("list", length(lam)) 64 | 65 | # cl <- parallel::makeForkCluster(parallel::detectCores() - 1) 66 | # on.exit(parallel::stopCluster(cl), add = TRUE) 67 | # out <- parallel::parLapply(cl, seq_along(lam), function(i) { 68 | # tissot0(lam[i], phi[i], degrees = degrees, A = A, f.inv = f.inv, proj.in = proj.in, proj.out = proj.out, ...) 69 | # }) 70 | for (i in seq_along(lam)) { 71 | out[[i]] <- tissot0(lam[i], phi[i], degrees = degrees, A = A, f.inv = f.inv, proj.in = proj.in, proj.out = proj.out, ...) 72 | } 73 | 74 | do.call(rbind, out) 75 | } 76 | #' @importFrom tibble tibble 77 | tissot0 <- function(lambda, phi, degrees=TRUE, A = 6378137, f.inv=298.257223563, proj.out = NULL, 78 | ..., proj.in = NULL) { 79 | if (is.null(proj.in)) { 80 | proj.in <- "OGC:CRS84" 81 | } 82 | if (is.null(proj.out)) { 83 | stop("'proj.out' must be specified") 84 | } 85 | # 86 | # Precomputation. 87 | # 88 | if (f.inv==0) { # Use f.inv==0 to indicate a sphere 89 | e2 <- 0 90 | } else { 91 | e2 <- (2 - 1/f.inv) / f.inv # Squared eccentricity 92 | } 93 | if (degrees) phi.r <- .to.radians(phi) else phi.r <- phi 94 | cos.phi <- cos(phi.r) # Convenience term 95 | e2.sinphi <- 1 - e2 * sin(phi.r)^2 # Convenience term 96 | e2.sinphi2 <- sqrt(e2.sinphi) # Convenience term 97 | if (degrees) units <- 180 / pi else units <- 1 # Angle measurement units per radian 98 | # 99 | # Lengths (the metric). 100 | # 101 | radius.meridian <- A * (1 - e2) / e2.sinphi2^3 # (4-18) 102 | length.meridian <- radius.meridian # (4-19) 103 | radius.normal <- A / e2.sinphi2 # (4-20) 104 | length.normal <- radius.normal * cos.phi # (4-21) 105 | # 106 | # The projection and its first derivatives, normalized to unit lengths. 107 | # 108 | x <- c(lambda, phi) 109 | 110 | d <- numericDeriv(quote(.prj(x, proj.out = proj.out, proj.in = proj.in)[1L,, drop = TRUE]), theta="x") 111 | z <- d[1:2] # Projected coordinates 112 | names(z) <- c("x", "y") 113 | g <- attr(d, "gradient") # First derivative (matrix) 114 | g <- g %*% diag(units / c(length.normal, length.meridian)) # Unit derivatives 115 | dimnames(g) <- list(c("x", "y"), c("lambda", "phi")) 116 | g.det <- det(g) # Equivalent to (4-15) 117 | # 118 | # Computation. 119 | # 120 | h <- .norm(g[, "phi"]) # (4-27) 121 | k <- .norm(g[, "lambda"]) # (4-28) 122 | a.p <- sqrt(max(0, h^2 + k^2 + 2 * g.det)) # (4-12) (intermediate) 123 | b.p <- sqrt(max(0, h^2 + k^2 - 2 * g.det)) # (4-13) (intermediate) 124 | a <- (a.p + b.p)/2 # (4-12a) 125 | b <- (a.p - b.p)/2 # (4-13a) 126 | omega <- 2 * asin(.clamp(b.p / a.p)) # (4-1a) 127 | theta.p <- asin(.clamp(g.det / (h * k))) # (4-14) 128 | conv <- (atan2(g["y", "phi"], g["x","phi"]) + pi / 2) %% (2 * pi) - pi # Middle of p. 21 129 | # 130 | # The indicatrix itself. 131 | # "svd" essentially redoes the preceding computation of "h", "k", and "theta.p". 132 | # 133 | m <- svd(g) 134 | axes <- zapsmall(diag(m$d) %*% apply(m$v, 1, function(x) x / .norm(x))) 135 | dimnames(axes) <- list(c("major", "minor"), NULL) 136 | 137 | # list(location=c(lambda, phi), projected=z, 138 | # meridian_radius=radius.meridian, meridian_length=length.meridian, 139 | # normal_radius=radius.normal, normal_length=length.normal, 140 | # scale.meridian=h, scale.parallel=k, scale.area=g.det, max.scale=a, min.scale=b, 141 | # .to.degrees(zapsmall(c(angle_deformation=omega, convergence=conv, intersection_angle=theta.p))), 142 | # axes=axes, derivatives=g) 143 | 144 | dfconint <- .to.degrees(zapsmall(c(omega, conv, theta.p))) 145 | tibble::tibble(lon = lambda, lat = phi, x = z[1L], y = z[2L], 146 | meridian_radius=radius.meridian, meridian_length=length.meridian, 147 | normal_radius=radius.normal, normal_length=length.normal, 148 | scale.meridian=h, scale.parallel=k, scale.area=g.det, max.scale=a, min.scale=b, 149 | angle_deformation= dfconint[1L], convergence= dfconint[2L], intersection_angle= dfconint[3L], 150 | axes_x_major = axes[1L,1L, drop = TRUE], axes_x_minor = axes[2L,1L, drop = TRUE], 151 | axes_y_major = axes[1L,2L, drop = TRUE], axes_y_minor = axes[2L,2L, drop = TRUE], 152 | lambda_dx = g[1L, 1L, drop = TRUE], lambda_dy = g[2L, 1L, drop = TRUE], 153 | phi_dx = g[1L, 2L, drop = TRUE], phi_dy = g[2L, 2L, drop = TRUE], 154 | proj.in = proj.in, proj.out = proj.out) 155 | 156 | } 157 | 158 | #' Indicatrix 159 | #' 160 | #' Indicatrix 161 | #' 162 | #' Reprocesses the output of \code{tissot} into convenient geometrical data. 163 | #' @param x object from \code{tissot} 164 | #' 165 | #' @param scale scaling 166 | #' @param ... arguments \code{n}, \code{from} and \code{to} passed to \code{ti_ellipse} function 167 | #' 168 | #' @export 169 | #' 170 | indicatrix <- function(x, scale = 1, ...) { 171 | structure(lapply(split(x, 1:nrow(x)), indicatrix0, scale = scale, ...), 172 | class = c("indicatrixes", "list")) 173 | } 174 | 175 | #' @name indicatrix 176 | #' @export 177 | plot.indicatrixes <- function(x, asp=1, xlab="x", ylab="y", add = FALSE, ..., 178 | col.base = rgb(0, 0, 0, .1), 179 | col.lambda = grey(0.75), 180 | #col.phi = "#45A271", ## #5CBD92", #rgb(.25, .7, .25), ## green 181 | #col.major = "#A782C3", ##"#7DB0DD", #rgb(.25, .25, .7), ## purple 182 | #col.minor = "#C87A8A", ##"#C7A76C", #rgb(.7, .25, .25), ## red 183 | col.phi = "#1b9e77", ## colorbrewer, qualitative, color friendly 184 | col.major = "#7570b3", 185 | col.minor = "#d95f02", 186 | col.outline = "black") { 187 | if (!add) { 188 | center <- do.call(rbind, lapply(x, function(a) a$center)) 189 | major <- do.call(rbind, lapply(x, function(a) a$axis.major)) 190 | minor <- do.call(rbind, lapply(x, function(a) a$axis.minor)) 191 | props <- list(x = center, type = "n", asp = asp, xlab = xlab, ylab = ylab, ...) 192 | if (is.null(props$xlim)) props$xlim <-range(c(major[,1L], minor[,1L])) 193 | if (is.null(props$ylim)) props$ylim <- range(c(major[,2L], minor[,2L])) 194 | 195 | do.call(plot, props) 196 | options(tissot.last.plot.proj = x[[1]]$proj.out) 197 | } 198 | lapply(x, plot, add = TRUE, 199 | col.base = col.base, 200 | col.lambda = col.lambda, 201 | col.phi = col.phi, 202 | col.major = col.major, 203 | col.minor = col.minor, 204 | col.outline = col.outline 205 | ) 206 | invisible(NULL) 207 | } 208 | #' @name indicatrix 209 | #' @export 210 | indicatrix0 <- function(x, scale=1, ...) { 211 | o <- unlist(x[c("x", "y")]) 212 | base <- ti_ellipse(o, matrix(c(1,0,0,1), 2), scale=scale, ...) # A reference circle 213 | axes_major <- unlist(x[c("axes_x_major", "axes_y_major")]) 214 | axis.major <- rbind(o + scale * axes_major, o - scale * axes_major) 215 | axes_minor <- unlist(x[c("axes_x_minor", "axes_y_minor")]) 216 | axis.minor <- rbind(o + scale * axes_minor, o - scale * axes_minor) 217 | outline <- ti_ellipse(o, matrix(c(axes_major, axes_minor), 2L, byrow = T), scale=scale, ...) 218 | #dimnames(g) <- list(c("x", "y"), c("lambda", "phi")) 219 | lambda_d <- unlist(x[c("lambda_dx", "lambda_dy")]) 220 | d.lambda <- rbind(o + scale * lambda_d, o - scale * lambda_d) 221 | phi_d <- unlist(x[c("phi_dx", "phi_dy")]) 222 | d.phi <- rbind(o + scale * phi_d, o - scale * phi_d) 223 | 224 | i <- list(center=o, base = base, outline = outline, 225 | axis.major = axis.major, axis.minor = axis.minor, 226 | d.lambda = d.lambda, d.phi = d.phi, 227 | proj.in = x$proj.in, proj.out = x$proj.out) 228 | class(i) <- c("indicatrix0", "list") 229 | i 230 | } 231 | 232 | 233 | #' Methods for indicatrix 234 | #' 235 | #' plot indicatrix 236 | #' 237 | #' @param asp aspect ratio 238 | #' @param xlab x-axis labels 239 | #' @param ylab y-axis labels 240 | #' @param add add to existing plot 241 | #' @param col.base colour of base 242 | #' @param col.lambda colour of lambda 243 | #' @param col.phi colour of phi 244 | #' @param col.major major axis colour 245 | #' @param col.minor minor axis colour 246 | #' @param col.outline outline colour 247 | #' 248 | #' @rdname indicatrix 249 | #' @export 250 | plot.indicatrix0 <- function(x, asp=1, xlab="Easting", ylab="Northing", add = FALSE, ..., 251 | col.base = rgb(0, 0, 0, .1), 252 | col.lambda = grey(0.75), 253 | col.phi = "#45A271", ## #5CBD92", #rgb(.25, .7, .25), 254 | col.major = "#A782C3", ##"#7DB0DD", #rgb(.25, .25, .7), 255 | col.minor = "#C87A8A", ##"#C7A76C", #rgb(.7, .25, .25), 256 | col.outline = "black") { 257 | if (!add) plot(x$outline, type="n", asp = asp, xlab = xlab, ylab = ylab, ...) 258 | polygon(x$base, col= col.base, border="Gray") 259 | lines(x$d.lambda, lwd=2, col= col.lambda, lty=2) 260 | lines(x$d.phi, lwd=2, col= col.phi, lty=2) 261 | lines(x$axis.major, lwd=2, col= col.major) 262 | lines(x$axis.minor, lwd=2, col = col.minor) 263 | lines(x$outline, asp=1, lwd=1, col = col.outline) 264 | invisible(NULL) 265 | } 266 | #' Ellipse 267 | #' 268 | #' @param center center 269 | #' @param axes axes 270 | #' @param scale scale 271 | #' @param n n 272 | #' @param from from 273 | #' @param to to 274 | #' 275 | #' @return matrix 276 | #' @export 277 | ti_ellipse <- function(center, axes, scale=1, n=36, from=0, to=2*pi) { 278 | # Vector representation of an ellipse at "center" with axes in the *rows* of "axes". 279 | # Returns an "n" by 2 array of points, one per row. 280 | theta <- seq(from=from, to=to, length.out=n) 281 | t((scale * t(axes)) %*% rbind(cos(theta), sin(theta)) + center) 282 | } 283 | 284 | # plot.indicatrix <- function(x, y, ...) { 285 | # add <- list(...)$add 286 | # if (is.null(add) || !add) { 287 | # plot(x$outline, type="n", asp=1, xlab="x", ylab="y") 288 | # } 289 | # polygon(x$base, col=rgb(0, 0, 0, .025), border="Gray") 290 | # lines(x$d.lambda, lwd=2, col="Gray", lty=2) 291 | # lines(x$d.phi, lwd=2, col=rgb(.25, .7, .25), lty=2) 292 | # lines(x$axis.major, lwd=2, col=rgb(.25, .25, .7)) 293 | # lines(x$axis.minor, lwd=2, col=rgb(.7, .25, .25)) 294 | # lines(x$outline, asp=1, lwd=2) 295 | # } 296 | --------------------------------------------------------------------------------