Merge pull request #56 from anthonynorth/main

S3 proj_trans() Generic

DESCRIPTION

@@ -31,13 +31,15 @@ Imports:
 LinkingTo: 
     wk
 Suggests:
-    testthat (>= 2.1.0),
+    testthat (>= 3.0.0),
     spelling,
     knitr,
-    rmarkdown
+    rmarkdown,
+    sf
 URL: https://github.com/hypertidy/PROJ, https://hypertidy.github.io/PROJ/
 BugReports: https://github.com/hypertidy/PROJ/issues
 Language: en-US
 VignetteBuilder: knitr
 SystemRequirements: PROJ (>= 6.3.1)
-RoxygenNote: 7.3.0
+RoxygenNote: 7.3.1
+Config/testthat/edition: 3

NAMESPACE

@@ -2,6 +2,11 @@
 
 S3method(format,proj_trans)
 S3method(print,proj_trans)
+S3method(proj_trans,data.frame)
+S3method(proj_trans,matrix)
+S3method(proj_trans,sfc)
+S3method(proj_trans,wk_rcrd)
+S3method(proj_trans,wk_vctr)
 S3method(str,proj_trans)
 S3method(wk_trans_inverse,proj_trans)
 export(ok_proj6)

R/proj_trans.R

@@ -1,60 +1,96 @@
-#' Transform a set of coordinates with 'PROJ'
+#' Transform coordinates
 #'
-#' A raw interface to 'proj_trans' in 'PROJ => 6', if it is available.
+#' Transforms all coordinates in `x` using [wk::wk_handle()] and [proj_trans_create()].
+#' 
+#' Values that are detected out of bounds by library PROJ are allowed, we return `Inf` 
+#' in this case, rather than the error "tolerance condition error".
 #'
-#' Input 'x' is assumed to be 2-columns of "x", then "y" coordinates. If "z" or
-#' "t" is required pass these in as named vectors with "z_" and "t_". For simplifying reasons
-#' `z_` and `t_` must always match the length of `x` `y`. Both default to 0, and are automatically
-#' recycled to the number of rows in `x`.
-#'
-#' Values that are detected out of bounds by library PROJ are allowed, we return `Inf` in this
-#' case, rather than the error "tolerance condition error".
-#'
-#' @param source projection of input coordinates (must be named i.e. 'source = "<some proj string"' can't be used in positional form)
-#' @param target projection for output coordinates
-#' @param x input coordinates (x,y, list or matrix see `z_` and `t_`)
-#' @param ... ignored
-#' @param z_ optional z coordinate vector
-#' @param t_ optional t coordinate vector
-#' @export
-#' @return list of transformed coordinates, with 4- or 2-elements `x_`, `y_`, `z_`, `t_`
+#' @name proj_trans
+#' @inheritParams proj_trans_create
+#' @param x Input geometry/geography. May take any of the following forms:
+#' - A coordinate matrix containing 2, 3 or 4 columns. 
+#'   If named, expects column names "x", "y" and optionally "z" and/or "m". If 
+#'   not named, columns are assumed in xyzm order. Non-coordinate columns are 
+#'   removed.
+#' - A data.frame containing coordinates as columns. Expects names "x", "y" and 
+#'   optionally "z" and/or "m". Non-coordinate columns are retained.
+#' - A data.frame containing a geometry vector which is readable by 
+#'   [wk::wk_handle()], including `sfc` columns.
+#' - A geometry vector which is readable by [wk::wk_handle()], including `sfc` 
+#'   columns.
+#' 
+#' @param ... Additional parameters forwarded to [wk::wk_handle()]
+#' @return Transformed geometries whose format is dependent on input.
+#' 
 #' @references see the [PROJ library documentation](https://proj.org/development/reference/functions.html#coordinate-transformation)
 #' for details on the underlying functionality
+#' 
 #' @examples
-#' proj_trans(cbind(147, -42), "+proj=laea", source = "OGC:CRS84")
-#' proj_trans(cbind(147, -42), z_ = -2, "+proj=laea", source = "OGC:CRS84")
-#' proj_trans(cbind(147, -42), z_ = -2, t_ = 1, "+proj=laea", source = "OGC:CRS84")
-#' @name proj_trans
+#' proj_trans(cbind(147, -42), "+proj=laea +type=crs", "OGC:CRS84")
+#' proj_trans(cbind(147, -42, -2), "+proj=laea +type=crs", "OGC:CRS84")
+#' proj_trans(cbind(147, -42, -2, 1), "+proj=laea +type=crs", "OGC:CRS84")
+#' proj_trans(wk::xy(147, -42, crs = "OGC:CRS84"), "+proj=laea +type=crs")
+#' proj_trans(wk::wkt("POLYGON ((1 1, 0 1, 0 0, 1 0, 1 1))", crs = "OGC:CRS84"), 3112)
+#' 
 #' @export
-proj_trans <- function(x, target, ..., source = NULL, z_ = NULL, t_ = NULL) {
-  if (missing(target) || !is.character(target)) stop("target must be a string")
-  if (is.null(source) || !is.character(source)) stop("source must be provided as a string")
-  if (is.list(x) || is.data.frame(x)) x <- cbind(x[[1L]], x[[2L]])
-
-  if (!is.null(z_) || !is.null(t_)) {
-    if (is.null(t_)) t_ <- 0
-    if (is.null(z_)) z_ <- 0
-    x <- cbind(x, z_, t_)
-  }
+proj_trans <- function(x, target_crs, source_crs = NULL, ..., use_z = NA, use_m = NA) {
+  UseMethod("proj_trans")
+}
 
-  nd <- dim(x)
-
-  if (!nd[2L] %in% c(2, 4)) stop("x coordinates must be 2-column, with z_ and t_ provided separately")
-
-  if (!is.numeric(x)) stop("input coordinates must be numeric")
-  if (nd[1L] < 1) stop("must be at least one coordinate")
-  if (nd[2L] == 2L) {
-    out <- .Call("C_proj_trans_xy", x_ = as.double(x[,1L]), y_ = as.double(x[,2L]), src_ = source, tgt_ = target, PACKAGE = "PROJ")
-    if (is.null(out)) stop(sprintf("transformation failed for xy coordinates '%s' -> '%s'", source, target))
-    names(out) <- c("x_", "y_")
-  } else {
-    xx <- split(x, rep(seq_len(nd[2L]), each = nd[1L]))
-    xx <- lapply(xx, as.numeric)  ## no integer
-    out <- .Call("C_proj_trans_list", x = xx, src_ = source, tgt_ = target, PACKAGE = "PROJ")
-    if (is.null(out)) stop(sprintf("transformation failed for xyzt coordinates '%s' -> '%s'", source, target))
-    names(out) <- c("x_", "y_", "z_", "t_")
-  }
+proj_trans_handleable <- function(x, target_crs, source_crs = NULL, ..., use_z = NA, use_m = NA) {
+  source_crs <- source_crs %||% wk::wk_crs(x) %||% wk::wk_crs_longlat()
+  trans <- proj_trans_create(source_crs, target_crs, use_z = use_z, use_m = use_m)
+
+  wk::wk_set_crs(wk::wk_transform(x, trans, ...), target_crs)
+}
+
+#' @export
+proj_trans.wk_vctr <- proj_trans_handleable
 
+#' @export
+proj_trans.wk_rcrd <- proj_trans_handleable
+
+#' @export
+proj_trans.sfc <- proj_trans_handleable
+
+#' @export
+proj_trans.matrix <- function(x, target_crs, source_crs = NULL, ..., use_z = NA, use_m = NA) {
+  if (!is.numeric(x)) stop("`x` coordinates must be a numeric matrix")
+
+  x_trans <- proj_trans_handleable(
+    wk::as_xy(x),
+    target_crs, source_crs,
+    ..., use_z = use_z, use_m = use_m
+  )
+
+  as.matrix(x_trans)
+}
+
+#' @export
+proj_trans.data.frame <- function(x, target_crs, source_crs = NULL, ..., use_z = NA, use_m = NA) {
+  if (!wk::is_handleable(x)) {
+    x_trans <- as.data.frame(
+      proj_trans_handleable(
+        wk::as_xy(x), 
+        target_crs, source_crs, 
+        ..., use_z = use_z, use_m = use_m
+      )
+    )
+
+    nms <- names(x)
+    xyzm <- c("x", "y", "z", "m")
+    dims <- names(x_trans)
+
+    x_res <- cbind(x[, setdiff(nms, xyzm), drop = FALSE], x_trans)
+
+    # reset column order
+    out_nms <- union(setdiff(nms, setdiff(xyzm, dims)), dims)
+    return(x_res[, out_nms, drop = FALSE])
+  }
 
-  out
+  proj_trans_handleable(
+    x, 
+    target_crs, source_crs, 
+    ..., use_z = use_z, use_m = use_m
+  )
 }

R/utils.R

@@ -1,3 +1,7 @@
+`%||%` <- function(x, y) {
+  if (is.null(x)) y else x
+}
+
 paste_line <- function(...) {
   paste0(c(...), collapse = "\n")
 }

configure

@@ -585,7 +585,7 @@ PACKAGE_STRING='PROJ 1.0'
 PACKAGE_BUGREPORT='[email protected]'
 PACKAGE_URL=''
 
-ac_unique_file="src/C_proj_trans.c"
+ac_unique_file="src/C_proj_version.c"
 # Factoring default headers for most tests.
 ac_includes_default="\
 #include <stdio.h>