diff --git a/NEWS.md b/NEWS.md index d49dde2..7b8263c 100644 --- a/NEWS.md +++ b/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 diff --git a/R/utm-convert.R b/R/utm-convert.R index c8190e9..314fa96 100644 --- a/R/utm-convert.R +++ b/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 +} diff --git a/tests/testthat/test-utm-convert.R b/tests/testthat/test-utm-convert.R index 3db899b..8576d29 100644 --- a/tests/testthat/test-utm-convert.R +++ b/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 + ) + +})