Nothing
R/sgo_transform.R
In sgo: Simple Geographical Operations (with OSGB36)
Defines functions
.add.z
.remove.z
sgo_transform.sgo_points
sgo_transform
Documented in
sgo_transform
#' @include sgo_wgs84.R
NULL
#' @encoding UTF-8
#' @title Coordinate transformation of a set of points
#'
#' @description
#' Transforms the coordinate system of a set of points to any supported
#' coordinate system.
#'
#' @name sgo_transform
#' @usage sgo_transform(x, to = NULL, ...)
#' @param x A \code{sgo_points} object.
#' @param to Specifies the EPSG code to convert the coordinates to. See
#' \code{\link{sgo_points}} for a list of supported EPSG codes.
#' @param ... Additional parameters passed to internal functions. Currently it
#' supports the additional arguments seen in \code{sgo_bng_lonlat} and
#' \code{sgo_lonlat_bng}.
#' @details
#' This function is a wrapper of specific transformation functions
#' (\code{\link{sgo_bng_lonlat}}, \code{\link{sgo_en_wgs84}},
#' \code{\link{sgo_lonlat_bng}}, \code{\link{sgo_wgs84_en}},
#' \code{\link{sgo_laea_etrs}}, \code{\link{sgo_etrs_laea}},
#' \code{\link{sgo_cart_lonlat}}, \code{\link{sgo_lonlat_cart}}) that transforms
#' the coordinate system of a set of points to any of the supported coordinate
#' systems.
#'
#' Please note that this package assumes that the Coordinate Reference Systems
#' (CRS) ETRS89 and WGS84 are the same within the UK, but this shouldn't be a
#' problem for most civilian use of GPS satellites. If a high-precision
#' transformation between WGS84 and ETRS89 is required then it is recommended
#' to use a different package to do the conversion.
#'
#' According to the Transformations and OSGM15 User Guide, p. 8:
#' \emph{"...ETRS89 is a precise version of the better known WGS84 reference
#' system optimised for use in Europe; however, for most purposes it can be
#' considered equivalent to WGS84."} and \emph{"For all navigation, mapping,
#' GIS, and engineering applications within the tectonically stable parts of
#' Europe (including UK and Ireland), the term ETRS89 should be taken as
#' synonymous with WGS84."}.
#'
#' \strong{Warning: }Coordinates defined in the Geodetic Coordinate System
#' EPSG:4277 (with datum OSGB 1936) should only be used to convert to or from
#' BNG coordinates and for historical reasons only.
#' @return
#' An object of class 'sgo_points'.
#' @seealso \code{\link{sgo_points}}, \code{\link{sgo_coordinates}},
#' \code{\link{sgo_set_gcs}}, \code{\link{sgo_bng_ngr}}
#' @examples
#' ln <- c(-4.22472, -2.09908)
#' lt <- c(57.47777, 57.14965)
#' n <- c("Inverness", "Aberdeen")
#' df <- data.frame(n, ln, lt, stringsAsFactors = FALSE)
#' locations <- sgo_points(df, coords=c("ln", "lt"), epsg=4326)
#'
#' locations.bng <- sgo_transform(locations, to=27700)
#' locations.osgb36 <- sgo_transform(locations, to=4277)
#' locations.ngr <- sgo_bng_ngr(sgo_transform(locations, to=27700))
#' locations.wgs84EN <- sgo_transform(locations.bng, to=3857)
#' @export
sgo_transform <- function(x, to=NULL, ...) UseMethod("sgo_transform")
#' @export
sgo_transform.sgo_points <- function(x, to=NULL, ...) {
if (is.null(to)) stop("Parameter 'to' must be specified")
if (x$epsg==to) return(x)
#if ((x$epsg == 4277 && (!to %in% c(27700,7405))) ||
# (to == 4277 && (!x$epsg %in% c(27700,7405)))) {
# warning(paste("Loss of accuracy.",
# "Transformations from or to EPSG:4277",
# "rely on a single Helmert transformation."))
#}
if(x$dimension == "XYZ") {
core.elements <- .sgo_points.3d.core
} else {
core.elements <- .sgo_points.2d.core
}
additional.elements <- !names(x) %in% core.elements
num.elements <- sum(additional.elements, na.rm=TRUE)
lst.additional.elements <- x[additional.elements]
# Don't need all the extra columns it might have while doing calculations
if (num.elements > 0)
x <- structure(x[core.elements], class = "sgo_points")
input.args <- c(list(x=x), list(...))
input.args <- input.args[unique(names(input.args))] # remove repeated args
# Get list of functions and their arguments needed to run this transformation
FUN_list <- .FUNCS[match(x$epsg, .FUNCS$FROM), as.character(to)][[1]]
ARGS_list <- .ARGS[match(x$epsg, .ARGS$FROM), as.character(to)][[1]]
empty_args <- !length(ARGS_list)
# Run functions sequentially over the input
for (i in seq_along(FUN_list)) {
func <- FUN_list[[i]]
args <- input.args[names(input.args) %in% names(formals(func))]
args_list <- if(empty_args) NULL else ARGS_list[[i]]
args <- c(args, args_list)
input.args$x <- do.call(func, args)
}
# Return sgo_points
ret <- input.args$x
if (num.elements > 0) {
ret <- structure(c(ret[setdiff(names(ret), .sgo_points.attr)],
lst.additional.elements,
ret[.sgo_points.attr]), class = "sgo_points")
}
ret
}
# Helper functions to remove or add the Z coordinate (EPSGs 27700 / 7405)
.remove.z <- function(x) {
#x$height.datum <- NULL
x$z <- NULL
x$dimension <- "XY"
x$epsg <- 27700
x
}
.add.z <- function(x) {
x$z <- rep(0, length(x$x))
x$dimension <- "XYZ"
x$epsg <- 7405
structure(x[c(.sgo_points.3d.coords,
names(x)[!names(x) %in% .sgo_points.3d.coords])],
class="sgo_points")
}
#Dataframes of operations and their arguments
#from:4326 to: -, 3857, 4277, 27700, 4258, 4979, 4978, 4937, 4936, 7405, 3035
#from:3857 to:4326, -, 4277, 27700, 4258, 4979, 4978, 4937, 4936, 7405, 3035
#from:4277 to:4326, 3857, -, 27700, 4258, 4979, 4978, 4937, 4936, 7405, 3035
#from:27700 to:4326, 3857, 4277, -, 4258, 4979, 4978, 4937, 4936, 7405, 3035
#from:4258 to:4326, 3857, 4277, 27700, -, 4979, 4978, 4937, 4936, 7405, 3035
#from:4979 to:4326, 3857, 4277, 27700, 4258, -, 4978, 4937, 4936, 7405, 3035
#from:4978 to:4326, 3857, 4277, 27700, 4258, 4979, -, 4937, 4936, 7405, 3035
#from:4937 to:4326, 3857, 4277, 27700, 4258, 4979, 4978, -, 4936, 7405, 3035
#from:4936 to:4326, 3857, 4277, 27700, 4258, 4979, 4978, 4937, -, 7405, 3035
#from:7405 to:4326, 3857, 4277, 27700, 4258, 4979, 4978, 4937, 4936, -, 3035
#from:3035 to:4326, 3857, 4277, 27700, 4258, 4979, 4978, 4937, 4936, 7405, -
.FROM <- list(4326, 3857, 4277, 27700, 4258,
4979 ,4978, 4937, 4936, 7405,
3035)
#FROM:
.FUN_TO_4326 <- list(NULL, #4326
list(sgo_en_wgs84), #3857
list(sgo_lonlat_bng, sgo_bng_lonlat), #4277
list(sgo_bng_lonlat), #27700
list(sgo_set_gcs), #4258
list(sgo_set_gcs), #4979
list(sgo_cart_lonlat, sgo_set_gcs), #4978
list(sgo_set_gcs), #4937
list(sgo_cart_lonlat, sgo_set_gcs), #4936
list(sgo_bng_lonlat), #7405
list(sgo_laea_etrs, sgo_set_gcs) #3035
)
.ARGS_TO_4326 <- list(NULL, #4326
list(to=4326), #3857
list(list(to=27700), list(to=4326)), #4277
list(to=4326), #27700
list(to=4326), #4258
list(to=4326), #4979
list(list(), list(to=4326)), #4978
list(to=4326), #4937
list(list(), list(to=4326)), #4936
list(to=4326), #7405
list(list(), list(to=4326)) #3035
)
#FROM:
.FUN_TO_3857 <- list(list(sgo_wgs84_en), #4326
NULL, #3857
list(sgo_lonlat_bng, sgo_bng_lonlat, sgo_wgs84_en), #4277
list(sgo_bng_lonlat, sgo_wgs84_en),
list(sgo_wgs84_en), #4258
list(sgo_wgs84_en), #4979
list(sgo_cart_lonlat, sgo_wgs84_en), #4978
list(sgo_wgs84_en), #4937
list(sgo_cart_lonlat, sgo_wgs84_en), #4936
list(sgo_bng_lonlat, sgo_wgs84_en), #7405
list(sgo_laea_etrs, sgo_wgs84_en) #3035
)
.ARGS_TO_3857 <- list(list(to=3857),
NULL,
list(list(to=27700), list(to=4326), list(to=3857)),
list(list(to=4326), list(to=3857)),
list(list(to=3857)), #4258
list(to=3857), #4979
list(list(), to=3857), #4978
list(list(to=3857)), #4937
list(list(), list(to=3857)), #4936
list(list(to=4326), list(to=3857)), #7405
list(list(), list(to=3857)) #3035
)
#FROM:
.FUN_TO_4277 <- list(list(sgo_lonlat_bng, sgo_bng_lonlat), #4326
list(sgo_en_wgs84, sgo_lonlat_bng, sgo_bng_lonlat), #3857
NULL, #4277
list(sgo_bng_lonlat), #27700
list(sgo_lonlat_bng, sgo_bng_lonlat), #4258
list(sgo_lonlat_bng, sgo_bng_lonlat), #4979
list(sgo_cart_lonlat, sgo_lonlat_bng, sgo_bng_lonlat),
list(sgo_lonlat_bng, sgo_bng_lonlat), #4937
list(sgo_cart_lonlat, sgo_lonlat_bng, sgo_bng_lonlat),
list(sgo_bng_lonlat), #7405
list(sgo_laea_etrs, sgo_lonlat_bng, sgo_bng_lonlat) #3035
)
.ARGS_TO_4277 <- list(list(list(to=27700),list(to=4277)), #4326
list(list(to=4326), list(to=27700), list(to=4277)), #3857
NULL, #4277
list(to=4277), #27700
list(list(to=27700), list(to=4277)), #4258
list(list(to=27700), list(to=4277)), #4979
list(list(), list(to=27700), list(to=4277)), #4978
list(list(to=27700), list(to=4277)), #4937
list(list(), list(to=27700), list(to=4277)), #4936
list(to=4277), #7405
list(list(), list(to=27700), list(to=4277)) #3035
)
.FUN_TO_27700 <- list(list(sgo_lonlat_bng), #4326
list(sgo_en_wgs84, sgo_lonlat_bng), #3857
list(sgo_lonlat_bng),
NULL, #27700
list(sgo_lonlat_bng), #4258
list(sgo_lonlat_bng), #4979
list(sgo_cart_lonlat, sgo_lonlat_bng), #4978
list(sgo_lonlat_bng), #4937
list(sgo_cart_lonlat, sgo_lonlat_bng), #4936
list(.remove.z), #7405
list(sgo_laea_etrs, sgo_lonlat_bng) #3035
)
.ARGS_TO_27700 <- list(list(to=27700),
list(list(to=4326), list(to=27700)),
list(to=27700),
NULL,
list(to=27700), #4258
list(to=27700), #4979
list(list(), list(to=27700)), #4978
list(to=27700), #4937
list(list(), list(to=27700)), #4936
list(), #7405
list(list(), list(to=27700)) #3035
)
.FUN_TO_4258 <- list(list(sgo_set_gcs),
list(sgo_en_wgs84, sgo_set_gcs), #3857
list(sgo_lonlat_bng, sgo_bng_lonlat), #4277
list(sgo_bng_lonlat),
NULL, #4258
list(sgo_set_gcs), #4979
list(sgo_cart_lonlat, sgo_set_gcs), #4978
list(sgo_set_gcs), #4937
list(sgo_cart_lonlat, sgo_set_gcs), #4936
list(sgo_bng_lonlat), #7405
list(sgo_laea_etrs) #3035
)
.ARGS_TO_4258 <- list(list(to=4258), #4326
list(list(to=4326), list(to=4258)), #3857
list(list(to=27700), list(to=4258)), #4277
list(to=4258), #27700
NULL, #4258
list(to=4258), #4979
list(list(), list(to=4258)), #4978
list(to=4258), #4937
list(list(), list(to=4258)), #4936
list(to=4258), #7405
list(list()) #3035
)
#FROM:
.FUN_TO_4979 <- list(list(sgo_set_gcs), #4326
list(sgo_en_wgs84, sgo_set_gcs), #3857
list(sgo_lonlat_bng, sgo_bng_lonlat), #4277
list(sgo_bng_lonlat), #27700
list(sgo_set_gcs), #4258
NULL, #4979
list(sgo_cart_lonlat), #4978
list(sgo_set_gcs), #4937
list(sgo_cart_lonlat, sgo_set_gcs), #4936
list(sgo_bng_lonlat), #7405
list(sgo_laea_etrs, sgo_set_gcs) #3035
)
.ARGS_TO_4979 <- list(list(to=4979), #4326
list(list(to=4326), list(to=4979)), #3857
list(list(to=27700), list(to=4979)), #4277
list(to=4979), #27700
list(to=4979), #4258
NULL, #4979
list(), #4978
list(to=4979), #4937
list(list(), list(to=4979)), #4936
list(to=4979), #7405
list(list(), list(to=4979)) #3035
)
#FROM:
.FUN_TO_4978 <- list(list(sgo_lonlat_cart), #4326
list(sgo_en_wgs84, sgo_lonlat_cart), #3857
list(sgo_lonlat_bng, sgo_bng_lonlat, sgo_lonlat_cart),#4277
list(sgo_bng_lonlat, sgo_lonlat_cart), #27700
list(sgo_set_gcs, sgo_lonlat_cart), #4258
list(sgo_lonlat_cart), #4979
NULL, #4978
list(sgo_set_gcs, sgo_lonlat_cart), #4937
list(sgo_cart_lonlat, sgo_set_gcs, sgo_lonlat_cart), #4936
list(sgo_bng_lonlat, sgo_lonlat_cart), #7405
list(sgo_laea_etrs, sgo_set_gcs, sgo_lonlat_cart) #3035
)
.ARGS_TO_4978 <- list(list(), #4326
list(list(to=4326), list()), #3857
list(list(to=27700), list(to=4326), list()), #4277
list(list(to=4979), list()), #27700
list(list(to=4326), list()), #4258
list(), #4979
NULL,
list(list(to=4979), list()), #4937
list(list(), list(to=4979), list()), #4936
list(list(to=4979), list()), #7405
list(list(), list(to=4326), list()) #3035
)
.FUN_TO_4937 <- list(list(sgo_set_gcs),
list(sgo_en_wgs84, sgo_set_gcs),
list(sgo_lonlat_bng, sgo_bng_lonlat, sgo_set_gcs), #4277
list(sgo_bng_lonlat), #27700
list(sgo_set_gcs), #4258
list(sgo_set_gcs), #4979
list(sgo_cart_lonlat, sgo_set_gcs), #4978
NULL,
list(sgo_cart_lonlat), #4936
list(sgo_bng_lonlat), #7405
list(sgo_laea_etrs, sgo_set_gcs) #3035
)
.ARGS_TO_4937 <- list(list(to=4937), #4326
list(list(to=4326), list(to=4937)), #3857
list(list(to=27700), list(to=4258), list(to=4937)), #4277
list(list(to=4937)), #27700
list(to=4937), #4258
list(to=4937), #4979
list(list(), list(to=4937)), #4978
NULL, #4937
list(), #4936
list(to=4937), #7405
list(list(), list(to=4937)) #3035
)
.FUN_TO_4936 <- list(list(sgo_set_gcs, sgo_lonlat_cart),
list(sgo_en_wgs84, sgo_set_gcs, sgo_lonlat_cart), #3857
list(sgo_lonlat_bng, sgo_bng_lonlat, sgo_lonlat_cart),#4277
list(sgo_bng_lonlat, sgo_lonlat_cart), #27700
list(sgo_lonlat_cart), #4258
list(sgo_set_gcs, sgo_lonlat_cart), #4979
list(sgo_cart_lonlat, sgo_set_gcs, sgo_lonlat_cart), #4978
list(sgo_lonlat_cart),
NULL,
list(sgo_bng_lonlat,sgo_lonlat_cart), #7405
list(sgo_laea_etrs, sgo_lonlat_cart) #3035
)
.ARGS_TO_4936 <- list(list(list(to=4258), list()),
list(list(to=4326), list(to=4258), list()),
list(list(to=27700), list(to=4258), list()),
list(list(to=4937), list()), #27700
list(), #4258
list(list(to=4937), list()),
list(list(), list(to=4937), list()),
list(),
NULL,
list(list(to=4937), list()), #7405
list(list(), list()) #3035
)
.FUN_TO_7405 <- list(list(sgo_lonlat_bng), #4326
list(sgo_en_wgs84, sgo_lonlat_bng), #3857
list(sgo_lonlat_bng), #4277
list(.add.z), #27700
list(sgo_lonlat_bng), #4258
list(sgo_lonlat_bng), #4979
list(sgo_cart_lonlat, sgo_lonlat_bng), #4978
list(sgo_lonlat_bng), #4937
list(sgo_cart_lonlat, sgo_lonlat_bng), #4936
NULL, #7405
list(sgo_laea_etrs, sgo_lonlat_bng) #3035
)
.ARGS_TO_7405 <- list(list(list(to=7405)), #4326
list(list(to=4326), list(to=7405)),
list(list(to=7405)), #4277
list(), #27700
list(list(to=7405)), #4258
list(to=7405), #4979
list(list(), list(to=7405)), #4978
list(to=7405), #4937
list(list(), list(to=7405)), #4936
NULL, #7405
list(list(), list(to=7405)) #3035
)
.FUN_TO_3035 <- list(list(sgo_set_gcs, sgo_etrs_laea), #4326
list(sgo_en_wgs84, sgo_set_gcs, sgo_etrs_laea), #3857
list(sgo_lonlat_bng, sgo_bng_lonlat, sgo_etrs_laea), #4277
list(sgo_bng_lonlat, sgo_etrs_laea), #27700
list(sgo_etrs_laea), #4258
list(sgo_set_gcs, sgo_etrs_laea), #4979
list(sgo_cart_lonlat, sgo_set_gcs, sgo_etrs_laea), #4978
list(sgo_etrs_laea), #4937
list(sgo_etrs_laea), #4936
list(sgo_bng_lonlat, sgo_etrs_laea), #7405
NULL #3035
)
.ARGS_TO_3035 <- list(list(list(to=4258), list()), #4326
list(list(to=4326), list(to=4258), list()), #3857
list(list(to=27700), list(to=4258), list()), #4277
list(list(to=4258), list()), #27700
list(), #4258
list(list(to=4937), list()), #4979
list(list(), list(to=4937), list()), #4978
list(), #4937
list(), #4936
list(list(to=4937), list()), #7405
NULL #3035
)
# Two dataframes containing those funtions and arguments respectively
.FUNCS <- as.data.frame(cbind("FROM"=.FROM,
"4326"=.FUN_TO_4326,
"3857"=.FUN_TO_3857,
"4277"=.FUN_TO_4277,
"27700"=.FUN_TO_27700,
"4258"=.FUN_TO_4258,
"4979"=.FUN_TO_4979,
"4978"=.FUN_TO_4978,
"4937"=.FUN_TO_4937,
"4936"=.FUN_TO_4936,
"7405"=.FUN_TO_7405,
"3035"=.FUN_TO_3035
))
.ARGS <- as.data.frame(cbind("FROM"=.FROM,
"4326"=.ARGS_TO_4326,
"3857"=.ARGS_TO_3857,
"4277"=.ARGS_TO_4277,
"27700"=.ARGS_TO_27700,
"4258"=.ARGS_TO_4258,
"4979"=.ARGS_TO_4979,
"4978"=.ARGS_TO_4978,
"4937"=.ARGS_TO_4937,
"4936"=.ARGS_TO_4936,
"7405"=.ARGS_TO_7405,
"3035"=.ARGS_TO_3035
))
Try the sgo package in your browser
Any scripts or data that you put into this service are public.
sgo documentation built on Sept. 23, 2022, 5:08 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions .add.z .remove.z sgo_transform.sgo_points sgo_transform
Documented in sgo_transform
#' @include sgo_wgs84.R
NULL
#' @encoding UTF-8
#' @title Coordinate transformation of a set of points
#'
#' @description
#' Transforms the coordinate system of a set of points to any supported
#' coordinate system.
#'
#' @name sgo_transform
#' @usage sgo_transform(x, to = NULL, ...)
#' @param x A \code{sgo_points} object.
#' @param to Specifies the EPSG code to convert the coordinates to. See
#' \code{\link{sgo_points}} for a list of supported EPSG codes.
#' @param ... Additional parameters passed to internal functions. Currently it
#' supports the additional arguments seen in \code{sgo_bng_lonlat} and
#' \code{sgo_lonlat_bng}.
#' @details
#' This function is a wrapper of specific transformation functions
#' (\code{\link{sgo_bng_lonlat}}, \code{\link{sgo_en_wgs84}},
#' \code{\link{sgo_lonlat_bng}}, \code{\link{sgo_wgs84_en}},
#' \code{\link{sgo_laea_etrs}}, \code{\link{sgo_etrs_laea}},
#' \code{\link{sgo_cart_lonlat}}, \code{\link{sgo_lonlat_cart}}) that transforms
#' the coordinate system of a set of points to any of the supported coordinate
#' systems.
#'
#' Please note that this package assumes that the Coordinate Reference Systems
#' (CRS) ETRS89 and WGS84 are the same within the UK, but this shouldn't be a
#' problem for most civilian use of GPS satellites. If a high-precision
#' transformation between WGS84 and ETRS89 is required then it is recommended
#' to use a different package to do the conversion.
#'
#' According to the Transformations and OSGM15 User Guide, p. 8:
#' \emph{"...ETRS89 is a precise version of the better known WGS84 reference
#' system optimised for use in Europe; however, for most purposes it can be
#' considered equivalent to WGS84."} and \emph{"For all navigation, mapping,
#' GIS, and engineering applications within the tectonically stable parts of
#' Europe (including UK and Ireland), the term ETRS89 should be taken as
#' synonymous with WGS84."}.
#'
#' \strong{Warning: }Coordinates defined in the Geodetic Coordinate System
#' EPSG:4277 (with datum OSGB 1936) should only be used to convert to or from
#' BNG coordinates and for historical reasons only.
#' @return
#' An object of class 'sgo_points'.
#' @seealso \code{\link{sgo_points}}, \code{\link{sgo_coordinates}},
#' \code{\link{sgo_set_gcs}}, \code{\link{sgo_bng_ngr}}
#' @examples
#' ln <- c(-4.22472, -2.09908)
#' lt <- c(57.47777, 57.14965)
#' n <- c("Inverness", "Aberdeen")
#' df <- data.frame(n, ln, lt, stringsAsFactors = FALSE)
#' locations <- sgo_points(df, coords=c("ln", "lt"), epsg=4326)
#'
#' locations.bng <- sgo_transform(locations, to=27700)
#' locations.osgb36 <- sgo_transform(locations, to=4277)
#' locations.ngr <- sgo_bng_ngr(sgo_transform(locations, to=27700))
#' locations.wgs84EN <- sgo_transform(locations.bng, to=3857)
#' @export
sgo_transform <- function(x, to=NULL, ...) UseMethod("sgo_transform")
#' @export
sgo_transform.sgo_points <- function(x, to=NULL, ...) {
if (is.null(to)) stop("Parameter 'to' must be specified")
if (x$epsg==to) return(x)
#if ((x$epsg == 4277 && (!to %in% c(27700,7405))) ||
# (to == 4277 && (!x$epsg %in% c(27700,7405)))) {
# warning(paste("Loss of accuracy.",
# "Transformations from or to EPSG:4277",
# "rely on a single Helmert transformation."))
#}
if(x$dimension == "XYZ") {
core.elements <- .sgo_points.3d.core
} else {
core.elements <- .sgo_points.2d.core
}
additional.elements <- !names(x) %in% core.elements
num.elements <- sum(additional.elements, na.rm=TRUE)
lst.additional.elements <- x[additional.elements]
# Don't need all the extra columns it might have while doing calculations
if (num.elements > 0)
x <- structure(x[core.elements], class = "sgo_points")
input.args <- c(list(x=x), list(...))
input.args <- input.args[unique(names(input.args))] # remove repeated args
# Get list of functions and their arguments needed to run this transformation
FUN_list <- .FUNCS[match(x$epsg, .FUNCS$FROM), as.character(to)][[1]]
ARGS_list <- .ARGS[match(x$epsg, .ARGS$FROM), as.character(to)][[1]]
empty_args <- !length(ARGS_list)
# Run functions sequentially over the input
for (i in seq_along(FUN_list)) {
func <- FUN_list[[i]]
args <- input.args[names(input.args) %in% names(formals(func))]
args_list <- if(empty_args) NULL else ARGS_list[[i]]
args <- c(args, args_list)
input.args$x <- do.call(func, args)
}
# Return sgo_points
ret <- input.args$x
if (num.elements > 0) {
ret <- structure(c(ret[setdiff(names(ret), .sgo_points.attr)],
lst.additional.elements,
ret[.sgo_points.attr]), class = "sgo_points")
}
ret
}
# Helper functions to remove or add the Z coordinate (EPSGs 27700 / 7405)
.remove.z <- function(x) {
#x$height.datum <- NULL
x$z <- NULL
x$dimension <- "XY"
x$epsg <- 27700
x
}
.add.z <- function(x) {
x$z <- rep(0, length(x$x))
x$dimension <- "XYZ"
x$epsg <- 7405
structure(x[c(.sgo_points.3d.coords,
names(x)[!names(x) %in% .sgo_points.3d.coords])],
class="sgo_points")
}
#Dataframes of operations and their arguments
#from:4326 to: -, 3857, 4277, 27700, 4258, 4979, 4978, 4937, 4936, 7405, 3035
#from:3857 to:4326, -, 4277, 27700, 4258, 4979, 4978, 4937, 4936, 7405, 3035
#from:4277 to:4326, 3857, -, 27700, 4258, 4979, 4978, 4937, 4936, 7405, 3035
#from:27700 to:4326, 3857, 4277, -, 4258, 4979, 4978, 4937, 4936, 7405, 3035
#from:4258 to:4326, 3857, 4277, 27700, -, 4979, 4978, 4937, 4936, 7405, 3035
#from:4979 to:4326, 3857, 4277, 27700, 4258, -, 4978, 4937, 4936, 7405, 3035
#from:4978 to:4326, 3857, 4277, 27700, 4258, 4979, -, 4937, 4936, 7405, 3035
#from:4937 to:4326, 3857, 4277, 27700, 4258, 4979, 4978, -, 4936, 7405, 3035
#from:4936 to:4326, 3857, 4277, 27700, 4258, 4979, 4978, 4937, -, 7405, 3035
#from:7405 to:4326, 3857, 4277, 27700, 4258, 4979, 4978, 4937, 4936, -, 3035
#from:3035 to:4326, 3857, 4277, 27700, 4258, 4979, 4978, 4937, 4936, 7405, -
.FROM <- list(4326, 3857, 4277, 27700, 4258,
4979 ,4978, 4937, 4936, 7405,
3035)
#FROM:
.FUN_TO_4326 <- list(NULL, #4326
list(sgo_en_wgs84), #3857
list(sgo_lonlat_bng, sgo_bng_lonlat), #4277
list(sgo_bng_lonlat), #27700
list(sgo_set_gcs), #4258
list(sgo_set_gcs), #4979
list(sgo_cart_lonlat, sgo_set_gcs), #4978
list(sgo_set_gcs), #4937
list(sgo_cart_lonlat, sgo_set_gcs), #4936
list(sgo_bng_lonlat), #7405
list(sgo_laea_etrs, sgo_set_gcs) #3035
)
.ARGS_TO_4326 <- list(NULL, #4326
list(to=4326), #3857
list(list(to=27700), list(to=4326)), #4277
list(to=4326), #27700
list(to=4326), #4258
list(to=4326), #4979
list(list(), list(to=4326)), #4978
list(to=4326), #4937
list(list(), list(to=4326)), #4936
list(to=4326), #7405
list(list(), list(to=4326)) #3035
)
#FROM:
.FUN_TO_3857 <- list(list(sgo_wgs84_en), #4326
NULL, #3857
list(sgo_lonlat_bng, sgo_bng_lonlat, sgo_wgs84_en), #4277
list(sgo_bng_lonlat, sgo_wgs84_en),
list(sgo_wgs84_en), #4258
list(sgo_wgs84_en), #4979
list(sgo_cart_lonlat, sgo_wgs84_en), #4978
list(sgo_wgs84_en), #4937
list(sgo_cart_lonlat, sgo_wgs84_en), #4936
list(sgo_bng_lonlat, sgo_wgs84_en), #7405
list(sgo_laea_etrs, sgo_wgs84_en) #3035
)
.ARGS_TO_3857 <- list(list(to=3857),
NULL,
list(list(to=27700), list(to=4326), list(to=3857)),
list(list(to=4326), list(to=3857)),
list(list(to=3857)), #4258
list(to=3857), #4979
list(list(), to=3857), #4978
list(list(to=3857)), #4937
list(list(), list(to=3857)), #4936
list(list(to=4326), list(to=3857)), #7405
list(list(), list(to=3857)) #3035
)
#FROM:
.FUN_TO_4277 <- list(list(sgo_lonlat_bng, sgo_bng_lonlat), #4326
list(sgo_en_wgs84, sgo_lonlat_bng, sgo_bng_lonlat), #3857
NULL, #4277
list(sgo_bng_lonlat), #27700
list(sgo_lonlat_bng, sgo_bng_lonlat), #4258
list(sgo_lonlat_bng, sgo_bng_lonlat), #4979
list(sgo_cart_lonlat, sgo_lonlat_bng, sgo_bng_lonlat),
list(sgo_lonlat_bng, sgo_bng_lonlat), #4937
list(sgo_cart_lonlat, sgo_lonlat_bng, sgo_bng_lonlat),
list(sgo_bng_lonlat), #7405
list(sgo_laea_etrs, sgo_lonlat_bng, sgo_bng_lonlat) #3035
)
.ARGS_TO_4277 <- list(list(list(to=27700),list(to=4277)), #4326
list(list(to=4326), list(to=27700), list(to=4277)), #3857
NULL, #4277
list(to=4277), #27700
list(list(to=27700), list(to=4277)), #4258
list(list(to=27700), list(to=4277)), #4979
list(list(), list(to=27700), list(to=4277)), #4978
list(list(to=27700), list(to=4277)), #4937
list(list(), list(to=27700), list(to=4277)), #4936
list(to=4277), #7405
list(list(), list(to=27700), list(to=4277)) #3035
)
.FUN_TO_27700 <- list(list(sgo_lonlat_bng), #4326
list(sgo_en_wgs84, sgo_lonlat_bng), #3857
list(sgo_lonlat_bng),
NULL, #27700
list(sgo_lonlat_bng), #4258
list(sgo_lonlat_bng), #4979
list(sgo_cart_lonlat, sgo_lonlat_bng), #4978
list(sgo_lonlat_bng), #4937
list(sgo_cart_lonlat, sgo_lonlat_bng), #4936
list(.remove.z), #7405
list(sgo_laea_etrs, sgo_lonlat_bng) #3035
)
.ARGS_TO_27700 <- list(list(to=27700),
list(list(to=4326), list(to=27700)),
list(to=27700),
NULL,
list(to=27700), #4258
list(to=27700), #4979
list(list(), list(to=27700)), #4978
list(to=27700), #4937
list(list(), list(to=27700)), #4936
list(), #7405
list(list(), list(to=27700)) #3035
)
.FUN_TO_4258 <- list(list(sgo_set_gcs),
list(sgo_en_wgs84, sgo_set_gcs), #3857
list(sgo_lonlat_bng, sgo_bng_lonlat), #4277
list(sgo_bng_lonlat),
NULL, #4258
list(sgo_set_gcs), #4979
list(sgo_cart_lonlat, sgo_set_gcs), #4978
list(sgo_set_gcs), #4937
list(sgo_cart_lonlat, sgo_set_gcs), #4936
list(sgo_bng_lonlat), #7405
list(sgo_laea_etrs) #3035
)
.ARGS_TO_4258 <- list(list(to=4258), #4326
list(list(to=4326), list(to=4258)), #3857
list(list(to=27700), list(to=4258)), #4277
list(to=4258), #27700
NULL, #4258
list(to=4258), #4979
list(list(), list(to=4258)), #4978
list(to=4258), #4937
list(list(), list(to=4258)), #4936
list(to=4258), #7405
list(list()) #3035
)
#FROM:
.FUN_TO_4979 <- list(list(sgo_set_gcs), #4326
list(sgo_en_wgs84, sgo_set_gcs), #3857
list(sgo_lonlat_bng, sgo_bng_lonlat), #4277
list(sgo_bng_lonlat), #27700
list(sgo_set_gcs), #4258
NULL, #4979
list(sgo_cart_lonlat), #4978
list(sgo_set_gcs), #4937
list(sgo_cart_lonlat, sgo_set_gcs), #4936
list(sgo_bng_lonlat), #7405
list(sgo_laea_etrs, sgo_set_gcs) #3035
)
.ARGS_TO_4979 <- list(list(to=4979), #4326
list(list(to=4326), list(to=4979)), #3857
list(list(to=27700), list(to=4979)), #4277
list(to=4979), #27700
list(to=4979), #4258
NULL, #4979
list(), #4978
list(to=4979), #4937
list(list(), list(to=4979)), #4936
list(to=4979), #7405
list(list(), list(to=4979)) #3035
)
#FROM:
.FUN_TO_4978 <- list(list(sgo_lonlat_cart), #4326
list(sgo_en_wgs84, sgo_lonlat_cart), #3857
list(sgo_lonlat_bng, sgo_bng_lonlat, sgo_lonlat_cart),#4277
list(sgo_bng_lonlat, sgo_lonlat_cart), #27700
list(sgo_set_gcs, sgo_lonlat_cart), #4258
list(sgo_lonlat_cart), #4979
NULL, #4978
list(sgo_set_gcs, sgo_lonlat_cart), #4937
list(sgo_cart_lonlat, sgo_set_gcs, sgo_lonlat_cart), #4936
list(sgo_bng_lonlat, sgo_lonlat_cart), #7405
list(sgo_laea_etrs, sgo_set_gcs, sgo_lonlat_cart) #3035
)
.ARGS_TO_4978 <- list(list(), #4326
list(list(to=4326), list()), #3857
list(list(to=27700), list(to=4326), list()), #4277
list(list(to=4979), list()), #27700
list(list(to=4326), list()), #4258
list(), #4979
NULL,
list(list(to=4979), list()), #4937
list(list(), list(to=4979), list()), #4936
list(list(to=4979), list()), #7405
list(list(), list(to=4326), list()) #3035
)
.FUN_TO_4937 <- list(list(sgo_set_gcs),
list(sgo_en_wgs84, sgo_set_gcs),
list(sgo_lonlat_bng, sgo_bng_lonlat, sgo_set_gcs), #4277
list(sgo_bng_lonlat), #27700
list(sgo_set_gcs), #4258
list(sgo_set_gcs), #4979
list(sgo_cart_lonlat, sgo_set_gcs), #4978
NULL,
list(sgo_cart_lonlat), #4936
list(sgo_bng_lonlat), #7405
list(sgo_laea_etrs, sgo_set_gcs) #3035
)
.ARGS_TO_4937 <- list(list(to=4937), #4326
list(list(to=4326), list(to=4937)), #3857
list(list(to=27700), list(to=4258), list(to=4937)), #4277
list(list(to=4937)), #27700
list(to=4937), #4258
list(to=4937), #4979
list(list(), list(to=4937)), #4978
NULL, #4937
list(), #4936
list(to=4937), #7405
list(list(), list(to=4937)) #3035
)
.FUN_TO_4936 <- list(list(sgo_set_gcs, sgo_lonlat_cart),
list(sgo_en_wgs84, sgo_set_gcs, sgo_lonlat_cart), #3857
list(sgo_lonlat_bng, sgo_bng_lonlat, sgo_lonlat_cart),#4277
list(sgo_bng_lonlat, sgo_lonlat_cart), #27700
list(sgo_lonlat_cart), #4258
list(sgo_set_gcs, sgo_lonlat_cart), #4979
list(sgo_cart_lonlat, sgo_set_gcs, sgo_lonlat_cart), #4978
list(sgo_lonlat_cart),
NULL,
list(sgo_bng_lonlat,sgo_lonlat_cart), #7405
list(sgo_laea_etrs, sgo_lonlat_cart) #3035
)
.ARGS_TO_4936 <- list(list(list(to=4258), list()),
list(list(to=4326), list(to=4258), list()),
list(list(to=27700), list(to=4258), list()),
list(list(to=4937), list()), #27700
list(), #4258
list(list(to=4937), list()),
list(list(), list(to=4937), list()),
list(),
NULL,
list(list(to=4937), list()), #7405
list(list(), list()) #3035
)
.FUN_TO_7405 <- list(list(sgo_lonlat_bng), #4326
list(sgo_en_wgs84, sgo_lonlat_bng), #3857
list(sgo_lonlat_bng), #4277
list(.add.z), #27700
list(sgo_lonlat_bng), #4258
list(sgo_lonlat_bng), #4979
list(sgo_cart_lonlat, sgo_lonlat_bng), #4978
list(sgo_lonlat_bng), #4937
list(sgo_cart_lonlat, sgo_lonlat_bng), #4936
NULL, #7405
list(sgo_laea_etrs, sgo_lonlat_bng) #3035
)
.ARGS_TO_7405 <- list(list(list(to=7405)), #4326
list(list(to=4326), list(to=7405)),
list(list(to=7405)), #4277
list(), #27700
list(list(to=7405)), #4258
list(to=7405), #4979
list(list(), list(to=7405)), #4978
list(to=7405), #4937
list(list(), list(to=7405)), #4936
NULL, #7405
list(list(), list(to=7405)) #3035
)
.FUN_TO_3035 <- list(list(sgo_set_gcs, sgo_etrs_laea), #4326
list(sgo_en_wgs84, sgo_set_gcs, sgo_etrs_laea), #3857
list(sgo_lonlat_bng, sgo_bng_lonlat, sgo_etrs_laea), #4277
list(sgo_bng_lonlat, sgo_etrs_laea), #27700
list(sgo_etrs_laea), #4258
list(sgo_set_gcs, sgo_etrs_laea), #4979
list(sgo_cart_lonlat, sgo_set_gcs, sgo_etrs_laea), #4978
list(sgo_etrs_laea), #4937
list(sgo_etrs_laea), #4936
list(sgo_bng_lonlat, sgo_etrs_laea), #7405
NULL #3035
)
.ARGS_TO_3035 <- list(list(list(to=4258), list()), #4326
list(list(to=4326), list(to=4258), list()), #3857
list(list(to=27700), list(to=4258), list()), #4277
list(list(to=4258), list()), #27700
list(), #4258
list(list(to=4937), list()), #4979
list(list(), list(to=4937), list()), #4978
list(), #4937
list(), #4936
list(list(to=4937), list()), #7405
NULL #3035
)
# Two dataframes containing those funtions and arguments respectively
.FUNCS <- as.data.frame(cbind("FROM"=.FROM,
"4326"=.FUN_TO_4326,
"3857"=.FUN_TO_3857,
"4277"=.FUN_TO_4277,
"27700"=.FUN_TO_27700,
"4258"=.FUN_TO_4258,
"4979"=.FUN_TO_4979,
"4978"=.FUN_TO_4978,
"4937"=.FUN_TO_4937,
"4936"=.FUN_TO_4936,
"7405"=.FUN_TO_7405,
"3035"=.FUN_TO_3035
))
.ARGS <- as.data.frame(cbind("FROM"=.FROM,
"4326"=.ARGS_TO_4326,
"3857"=.ARGS_TO_3857,
"4277"=.ARGS_TO_4277,
"27700"=.ARGS_TO_27700,
"4258"=.ARGS_TO_4258,
"4979"=.ARGS_TO_4979,
"4978"=.ARGS_TO_4978,
"4937"=.ARGS_TO_4937,
"4936"=.ARGS_TO_4936,
"7405"=.ARGS_TO_7405,
"3035"=.ARGS_TO_3035
))
Try the sgo package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.