Fix utm_convert()

NEWS.md

@@ -2,6 +2,9 @@
 
 * In the `cded_()` functions, the `ask` argument, which controls if
   if the user is consulted to store data in the cache, was ignored. It is now respected (#147).
+* `utm_convert()` now respects `tibble` classes ([#143](https://github.com/bcgov/bcmaps/issues/143), #148).
+* Fixed a bug in `utm_convert()` where new coordinates could be mismatched with the wrong rows from the 
+  input data frame. ([#146](https://github.com/bcgov/bcmaps/issues/146), #148)
 
 # bcmaps 2.2.0
 

R/utm-convert.R

@@ -53,23 +53,23 @@ utm_convert <- function(x, easting, northing, zone, crs = "EPSG:3005",
 
   if (one_zone) {
     res <- convert_from_zone(x, zone, easting, northing, crs, datum, xycols)
-    return(cbind(res, x[, setdiff(names(x), names(res))]))
+    return(res)
   }
-
-  x_split <- split(x, x[zone])
+  
+  x_split <- split(x, as.character(x[[zone]]))
 
   x_split <- lapply(x_split, function(z) {
     zone <- z[[zone]][1]
     convert_from_zone(z, zone, easting, northing, crs, datum, xycols)
   })
-
   res <- do.call("rbind", x_split)
-  cbind(res, x[, setdiff(names(x), names(res))])
+
+  restore_tibble(res, x)
 }
 
 convert_from_zone <- function(x, zone, easting, northing, crs, datum, xycols) {
   epsg <- lookup_epsg_code(zone, datum)
-  x <- sf::st_as_sf(x, coords = c(easting, northing), crs = epsg)
+  x <- sf::st_as_sf(x, coords = c(easting, northing), crs = epsg, remove = FALSE)
   res <- sf::st_transform(x, crs = crs)
   if (xycols) {
     res <- cbind(res, sf::st_coordinates(res))
@@ -101,3 +101,12 @@ format_zone <- function(x) {
   }
   ret
 }
+
+restore_tibble <- function(new, original) {
+  if (inherits(original, c("tbl_df", "tbl"))) {
+    class(new) <- c(setdiff(class(new), class(original)), class(original))
+  } else {
+    rownames(new) <- rownames(original)
+  }
+  new
+}

tests/testthat/test-utm-convert.R

@@ -95,3 +95,91 @@ test_that("utm_convert errors expectedly", {
   expect_error(utm_convert(df, "easting", "northing", "zone"), "Invalid zone")
 })
 
+test_that("Output minus sf stuff is same as input (#146)", {
+  data <- data.frame(
+    Row_ID = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10),
+    NotSure = c(9608, 9609, 9610, 9611, 9612, 9613, 9614, 9615, 9616, 9617),
+    Zone = c(10, 10, 10, 10, 10, 10, 9, 9, 9, 9),
+    UTMe = c(
+      361775,
+      361775,
+      307196,
+      307196,
+      328213,
+      328213,
+      636424,
+      636648,
+      636795,
+      637401
+    ),
+    UTMn = c(
+      6011950,
+      6011950,
+      5979777,
+      5979777,
+      5984261,
+      5984261,
+      6161177,
+      6161270,
+      6161127,
+      6160851
+    ),
+    UTMe1 = c(
+      361775,
+      361775,
+      307196,
+      307196,
+      328213,
+      328213,
+      636424,
+      636648,
+      636795,
+      637401
+    ),
+    UTMn1 = c(
+      6011950,
+      6011950,
+      5979777,
+      5979777,
+      5984261,
+      5984261,
+      6161177,
+      6161270,
+      6161127,
+      6160851
+    )
+  )
+  rownames(data) <- letters[seq_len(nrow(data))]
+
+  out_df <- utm_convert(
+    data,
+    easting = "UTMe",
+    northing = "UTMn",
+    zone = "Zone"
+  )
+
+  expect_equal(
+    data, 
+    sf::st_drop_geometry(out_df)[, setdiff(names(out_df), c("X", "Y", "geometry")), drop = FALSE]
+  )
+
+  # Check with tibble
+  data_tbl <- structure(data, class = c("tbl_df", "tbl", "data.frame"))
+  rownames(data_tbl) <- NULL
+
+  out_tbl <- utm_convert(
+    data_tbl,
+    easting = "UTMe",
+    northing = "UTMn",
+    zone = "Zone"
+  )
+
+  expect_s3_class(out_tbl, "tbl_df")
+
+  expect_equal(
+    data_tbl, 
+    sf::st_drop_geometry(out_tbl)[, setdiff(names(out_tbl), c("X", "Y", "geometry")), drop = FALSE],
+    check.attributes = FALSE
+  )
+
+})