From b6dc8c28d53947b6b05589f9fdaf35e89bf15aba Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 28 Nov 2024 12:38:35 -0800 Subject: [PATCH 1/6] Add test for #146 --- tests/testthat/test-utm-convert.R | 67 +++++++++++++++++++++++++++++++ 1 file changed, 67 insertions(+) diff --git a/tests/testthat/test-utm-convert.R b/tests/testthat/test-utm-convert.R index 3db899b..d75073e 100644 --- a/tests/testthat/test-utm-convert.R +++ b/tests/testthat/test-utm-convert.R @@ -95,3 +95,70 @@ 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 <- tibble::tibble( + 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 + ) + ) + + out <- utm_convert( + data, + easting = "UTMe", + northing = "UTMn", + zone = "Zone" + ) + + expect_equal( + data, + sf::st_drop_geometry(out)[, setdiff(names(out), c("X", "Y", "geometry")), drop = FALSE] + ) +}) From 533fbc0e3a090b4e2bd0c513b4f870abc0eb727b Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 28 Nov 2024 12:41:37 -0800 Subject: [PATCH 2/6] Ensure output is same as input (except new sf and X, Y columns) * restore original class * Supply character vector to `split` to ensure order remains the same * Less cbind()ing --- R/utm-convert.R | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/R/utm-convert.R b/R/utm-convert.R index c8190e9..196d861 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,10 @@ 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)) + } + new +} From a6f8fe8f5e95875c127429c71d578a108bce7448 Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 28 Nov 2024 12:45:06 -0800 Subject: [PATCH 3/6] Test for df as well as tibble --- tests/testthat/test-utm-convert.R | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-utm-convert.R b/tests/testthat/test-utm-convert.R index d75073e..49ea264 100644 --- a/tests/testthat/test-utm-convert.R +++ b/tests/testthat/test-utm-convert.R @@ -150,7 +150,7 @@ test_that("Output minus sf stuff is same as input (#146)", { ) ) - out <- utm_convert( + out_tbl <- utm_convert( data, easting = "UTMe", northing = "UTMn", @@ -159,6 +159,19 @@ test_that("Output minus sf stuff is same as input (#146)", { expect_equal( data, - sf::st_drop_geometry(out)[, setdiff(names(out), c("X", "Y", "geometry")), drop = FALSE] + sf::st_drop_geometry(out_tbl)[, setdiff(names(out_tbl), c("X", "Y", "geometry")), drop = FALSE] ) + + out_df <- utm_convert( + as.data.frame(data), + easting = "UTMe", + northing = "UTMn", + zone = "Zone" + ) + + expect_equal( + as.data.frame(data), + sf::st_drop_geometry(out_df)[, setdiff(names(out_df), c("X", "Y", "geometry")), drop = FALSE] + ) + }) From db02c199f75c11c70cf53a331dd5199c3cf4b44e Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 28 Nov 2024 12:58:39 -0800 Subject: [PATCH 4/6] restore rownames for regular data.frames --- R/utm-convert.R | 2 ++ tests/testthat/test-utm-convert.R | 10 +++++++--- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/R/utm-convert.R b/R/utm-convert.R index 196d861..314fa96 100644 --- a/R/utm-convert.R +++ b/R/utm-convert.R @@ -105,6 +105,8 @@ format_zone <- function(x) { 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 49ea264..f90003b 100644 --- a/tests/testthat/test-utm-convert.R +++ b/tests/testthat/test-utm-convert.R @@ -162,15 +162,19 @@ test_that("Output minus sf stuff is same as input (#146)", { sf::st_drop_geometry(out_tbl)[, setdiff(names(out_tbl), c("X", "Y", "geometry")), drop = FALSE] ) + # Check with bare data frame with row names + data_df <- as.data.frame(data) + rownames(data_df) <- letters[seq_len(nrow(data_df))] + out_df <- utm_convert( - as.data.frame(data), + data_df, easting = "UTMe", northing = "UTMn", zone = "Zone" ) - + expect_equal( - as.data.frame(data), + data_df, sf::st_drop_geometry(out_df)[, setdiff(names(out_df), c("X", "Y", "geometry")), drop = FALSE] ) From 0254c0943a332db064a465b1d36cbc1985199160 Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 28 Nov 2024 14:35:04 -0800 Subject: [PATCH 5/6] Remove test dependence on tibble --- tests/testthat/test-utm-convert.R | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/tests/testthat/test-utm-convert.R b/tests/testthat/test-utm-convert.R index f90003b..8576d29 100644 --- a/tests/testthat/test-utm-convert.R +++ b/tests/testthat/test-utm-convert.R @@ -96,7 +96,7 @@ test_that("utm_convert errors expectedly", { }) test_that("Output minus sf stuff is same as input (#146)", { - data <- tibble::tibble( + 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), @@ -149,8 +149,9 @@ test_that("Output minus sf stuff is same as input (#146)", { 6160851 ) ) + rownames(data) <- letters[seq_len(nrow(data))] - out_tbl <- utm_convert( + out_df <- utm_convert( data, easting = "UTMe", northing = "UTMn", @@ -159,23 +160,26 @@ test_that("Output minus sf stuff is same as input (#146)", { expect_equal( data, - sf::st_drop_geometry(out_tbl)[, setdiff(names(out_tbl), c("X", "Y", "geometry")), drop = FALSE] + sf::st_drop_geometry(out_df)[, setdiff(names(out_df), c("X", "Y", "geometry")), drop = FALSE] ) - # Check with bare data frame with row names - data_df <- as.data.frame(data) - rownames(data_df) <- letters[seq_len(nrow(data_df))] + # Check with tibble + data_tbl <- structure(data, class = c("tbl_df", "tbl", "data.frame")) + rownames(data_tbl) <- NULL - out_df <- utm_convert( - data_df, + out_tbl <- utm_convert( + data_tbl, easting = "UTMe", northing = "UTMn", zone = "Zone" ) + expect_s3_class(out_tbl, "tbl_df") + expect_equal( - data_df, - sf::st_drop_geometry(out_df)[, setdiff(names(out_df), c("X", "Y", "geometry")), drop = FALSE] + data_tbl, + sf::st_drop_geometry(out_tbl)[, setdiff(names(out_tbl), c("X", "Y", "geometry")), drop = FALSE], + check.attributes = FALSE ) }) From 73f2b7e54d44ab3826e318bb4227ce3999e9e6f3 Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 28 Nov 2024 15:01:03 -0800 Subject: [PATCH 6/6] Update NEWS --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) 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