diff --git a/.lintr b/.lintr index 2c5b56d..abc0ecd 100644 --- a/.lintr +++ b/.lintr @@ -11,6 +11,7 @@ linters: linters_with_defaults( expect_true_false_linter(), expect_type_linter(), implicit_integer_linter(allow_colon = TRUE), + indentation_linter(hanging_indent_style = "never"), infix_spaces_linter(exclude_operators = c("=", "*", "/")), line_length_linter(120), quotes_linter("'"), @@ -20,6 +21,5 @@ linters: linters_with_defaults( )), assignment_linter = NULL, commented_code_linter = NULL, - indentation_linter = NULL, object_name_linter = NULL ) diff --git a/R/gh_decode.R b/R/gh_decode.R index 020ceab..23dde82 100644 --- a/R/gh_decode.R +++ b/R/gh_decode.R @@ -1,7 +1,9 @@ gh_decode = function(geohashes, include_delta = FALSE, coord_loc = 'c') { if (is.factor(geohashes)) { - return(lapply(gh_decode(levels(geohashes), include_delta, coord_loc), - function(z) z[geohashes])) + return(lapply( + gh_decode(levels(geohashes), include_delta, coord_loc), + function(z) z[geohashes] + )) } if (length(coord_loc) > 1L) stop("Please provide only one value for 'coord_loc'") @@ -16,8 +18,7 @@ gh_decode = function(geohashes, include_delta = FALSE, coord_loc = 'c') { 'northwest' = , 'nw' = 6L, 'north' = , 'n' = 7L, 'northeast' = , 'ne' = 8L, - stop('Unrecognized coordinate location; please use ', - "'c' for centroid or a cardinal direction; see ?gh_decode") + stop("Unrecognized coordinate location; please use 'c' for centroid or a cardinal direction; see ?gh_decode") ) .Call(Cgh_decode, geohashes, include_delta, coord_loc) } diff --git a/R/gh_encode.R b/R/gh_encode.R index 2992f38..f3d1ff8 100644 --- a/R/gh_encode.R +++ b/R/gh_encode.R @@ -1,11 +1,10 @@ gh_encode = function(latitude, longitude, precision = 6L) { if (length(precision) != 1L) stop('More than one precision value detected; precision is fixed on input (for now)') - if (precision < 1L) stop('Invalid precision. Precision is measured in ', - 'number of characters, must be at least 1.') + if (precision < 1L) + stop('Invalid precision. Precision is measured in number of characters, must be at least 1.') if (precision > .global$GH_MAX_PRECISION) { - warning('Precision is limited to ', .global$GH_MAX_PRECISION, - ' characters; truncating') + warning('Precision is limited to ', .global$GH_MAX_PRECISION, ' characters; truncating') precision = .global$GH_MAX_PRECISION } diff --git a/R/gis_tools.R b/R/gis_tools.R index c237f12..501b5b1 100644 --- a/R/gis_tools.R +++ b/R/gis_tools.R @@ -4,8 +4,7 @@ wgs = function() sp::CRS('+proj=longlat +datum=WGS84', doCheckCRSArgs = FALSE) # nocov start check_suggested = function(pkg) { if (!requireNamespace(pkg, quietly = TRUE)) { - stop('This function requires an installation of ', pkg, - "; install.packages('", pkg, "') to proceed.") + stop('This function requires an installation of ', pkg, "; install.packages('", pkg, "') to proceed.") } } # nocov end @@ -48,8 +47,7 @@ gh_to_spdf.default = function(geohashes, ...) { gh_to_spdf.data.frame = function(gh_df, gh_col = 'gh', ...) { if (is.na(idx <- match(gh_col, names(gh_df)))) - stop('Searched for geohashes at a column named "', - gh_col, '", but found nothing.') + stop('Searched for geohashes at a column named "', gh_col, '", but found nothing.') gh = gh_df[[idx]] if (anyDuplicated(gh) > 0L) { idx = which(duplicated(gh)) diff --git a/tests/testthat/test-decode.R b/tests/testthat/test-decode.R index 44f825f..0565fb7 100644 --- a/tests/testthat/test-decode.R +++ b/tests/testthat/test-decode.R @@ -131,10 +131,10 @@ test_that('geohash decoder works', { tolerance = 1e-8 ) # be sure adjacent geohashes interlock - expect_identical(lapply(c('nw', 'n', 'ne'), - function(l) gh_decode('m', coord_loc = l)), - lapply(c('sw', 's', 'se'), - function(l) gh_decode('t', coord_loc = l))) + expect_identical( + lapply(c('nw', 'n', 'ne'), function(l) gh_decode('m', coord_loc = l)), + lapply(c('sw', 's', 'se'), function(l) gh_decode('t', coord_loc = l)) + ) expect_error( gh_decode(c(borobudur, neum), coord_loc = c('n', 's')), @@ -148,28 +148,43 @@ test_that('geohash decoder works', { ) # invalid geohash characters: - expect_error(gh_decode('a'), fixed = TRUE, - "Invalid geohash; check 'a' at index 1.") - expect_error(gh_decode(c('b', 'a')), fixed = TRUE, - "Invalid geohash; check 'a' at index 2.") + expect_error( + gh_decode('a'), + "Invalid geohash; check 'a' at index 1.", + fixed = TRUE + ) + expect_error( + gh_decode(c('b', 'a')), + "Invalid geohash; check 'a' at index 2.", + fixed = TRUE + ) # missing input - expect_identical(gh_decode(c(neum, NA_character_)), - list(latitude = c(42.91259765625, NA), - longitude = c(17.60009765625, NA))) - expect_identical(gh_decode(c(neum, NA_character_), include_delta = TRUE), - list(latitude = c(42.91259765625, NA), - longitude = c(17.60009765625, NA), - delta_latitude = c(0.02197265625, NA), - delta_longitude = c(0.02197265625, NA))) + expect_identical( + gh_decode(c(neum, NA_character_)), + list(latitude = c(42.91259765625, NA), longitude = c(17.60009765625, NA)) + ) + expect_identical( + gh_decode(c(neum, NA_character_), include_delta = TRUE), + list( + latitude = c(42.91259765625, NA), + longitude = c(17.60009765625, NA), + delta_latitude = c(0.02197265625, NA), + delta_longitude = c(0.02197265625, NA) + ) + ) # stress testing ## empty input - expect_identical(gh_decode(character(0L)), - list(latitude = numeric(0L), longitude = numeric(0L))) + expect_identical( + gh_decode(character(0L)), + list(latitude = numeric(0L), longitude = numeric(0L)) + ) ## !nzchar input - expect_identical(gh_decode(''), - list(latitude = NA_real_, longitude = NA_real_)) + expect_identical( + gh_decode(''), + list(latitude = NA_real_, longitude = NA_real_) + ) ## long input [intr_length > 8 in geohash_decode_impl] expect_identical( gh_decode(strrep('1', 26L)), @@ -181,7 +196,9 @@ test_that('geohash decoder works', { ## useBytes needed a bit strangely -- that the error returns with _any_ ## non-ASCII character throws off the string matching even when only ## attempting to match ASCII-only characters. - expect_error(gh_decode(rawToChar(as.raw(128L))), - fixed = TRUE, useBytes = TRUE, - 'Non-ASCII character at index 1') + expect_error( + gh_decode(rawToChar(as.raw(128L))), + 'Non-ASCII character at index 1', + fixed = TRUE, useBytes = TRUE + ) }) diff --git a/tests/testthat/test-encode.R b/tests/testthat/test-encode.R index 7369c3f..bde9aa3 100644 --- a/tests/testthat/test-encode.R +++ b/tests/testthat/test-encode.R @@ -9,20 +9,16 @@ test_that('geohash encoder works', { expect_identical(gh_encode(y, x), gh_encode(y, x - 360.0)) # all level-1 centroids to be sure my manual logic for precision = 1 works - expect_identical(gh_encode(c(-67.5, -67.5, -22.5, -22.5, -67.5, -67.5, -22.5, - -22.5, 22.5, 22.5, 67.5, 67.5, 22.5, 22.5, 67.5, - 67.5, -67.5, -67.5, -22.5, -22.5, -67.5, -67.5, - -22.5, -22.5, 22.5, 22.5, 67.5, 67.5, 22.5, 22.5, - 67.5, 67.5), - c(-157.5, -112.5, -157.5, -112.5, -67.5, -22.5, - -67.5, -22.5, -157.5, -112.5, -157.5, -112.5, - -67.5, -22.5, -67.5, -22.5, 22.5, 67.5, 22.5, - 67.5, 112.5, 157.5, 112.5, 157.5, 22.5, 67.5, - 22.5, 67.5, 112.5, 157.5, 112.5, 157.5), - precision = 1L), - c('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'b', 'c', - 'd', 'e', 'f', 'g', 'h', 'j', 'k', 'm', 'n', 'p', 'q', 'r', - 's', 't', 'u', 'v', 'w', 'x', 'y', 'z')) + # nolint start: line_length_linter. + expect_identical( + gh_encode( + c(-067.5, -67.5, -22.5, -22.5, -67.5, -67.5, -22.5, -22.5, 22.5, 22.5, 67.5, 67.5, 22.5, 22.5, 67.5, 67.5, -67.5, -67.5, -22.5, -22.5, -67.5, -67.5, -22.5, -22.5, 22.5, 22.5, 67.5, 67.5, 22.5, 22.5, 67.5, 67.5), + c(-157.5, -112.5, -157.5, -112.5, -67.5, -22.5, -67.5, -22.5, -157.5, -112.5, -157.5, -112.5, -67.5, -22.5, -67.5, -22.5, 22.5, 67.5, 22.5, 67.5, 112.5, 157.5, 112.5, 157.5, 22.5, 67.5, 22.5, 67.5, 112.5, 157.5, 112.5, 157.5), + precision = 1L + ), + c('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'j', 'k', 'm', 'n', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z') + ) + # nolint end: line_length_linter. # geohash cells are _left closed, right open_: [x1, x2) x [y1, y2), see: # http://geohash.org/s000 @@ -31,23 +27,31 @@ test_that('geohash encoder works', { # boundary cases # need to balloon eps so that adding .5 doesn't obliterate sig figs eps = 1000.0*.Machine$double.eps - expect_identical(gh_encode(c(eps, eps, -eps, -eps, - 90.0 - eps, 90.0 - eps, eps - 90.0, eps - 90.0), - c(eps, -eps, eps, -eps, - eps - 180.0, 180.0 - eps, eps - 180.0, 180.0 - eps)), - c('s00000', 'ebpbpb', 'kpbpbp', '7zzzzz', - 'bpbpbp', 'zzzzzz', '000000', 'pbpbpb')) + expect_identical( + gh_encode( + c(eps, eps, -eps, -eps, 90.0 - eps, 90.0 - eps, eps - 90.0, eps - 90.0), + c(eps, -eps, eps, -eps, eps - 180.0, 180.0 - eps, eps - 180.0, 180.0 - eps) + ), + c('s00000', 'ebpbpb', 'kpbpbp', '7zzzzz', 'bpbpbp', 'zzzzzz', '000000', 'pbpbpb') + ) # test precision argument expect_identical(gh_encode(y, x, 12L), 's0h09nrnzgqv') # maximum precision n = 25L - expect_identical(gh_encode(y, x, n), - substring('s0h09nrnzgqv8je0f4jpd0000', 1L, n)) + expect_identical( + gh_encode(y, x, n), + substring('s0h09nrnzgqv8je0f4jpd0000', 1L, n) + ) # truncation beyond there - expect_warning(out <- gh_encode(y, x, n + 5L), - 'Precision is limited', fixed = TRUE) - expect_identical(out, substring('s0h09nrnzgqv8je0f4jpd0000', 1L, n)) + expect_warning( + expect_identical( + gh_encode(y, x, n + 5L), + substring('s0h09nrnzgqv8je0f4jpd0000', 1L, n) + ), + 'Precision is limited', + fixed = TRUE + ) # implicit integer truncation expect_identical(gh_encode(y, x, 1.04), 's') @@ -58,12 +62,21 @@ test_that('geohash encoder works', { # invalid input expect_error(gh_encode(100.0, x), 'Invalid latitude at index 1', fixed = TRUE) expect_error(gh_encode(-91.0, x), 'Invalid latitude at index 1', fixed = TRUE) - expect_error(gh_encode(c(y, 90.0), c(x, x)), - 'Invalid latitude at index 2', fixed = TRUE) - expect_error(gh_encode(y, x, c(5L, 6L)), - 'More than one precision value', fixed = TRUE) - expect_error(gh_encode(c(y, y), x), - 'Inputs must be the same size', fixed = TRUE) + expect_error( + gh_encode(c(y, 90.0), c(x, x)), + 'Invalid latitude at index 2', + fixed = TRUE + ) + expect_error( + gh_encode(y, x, c(5L, 6L)), + 'More than one precision value', + fixed = TRUE + ) + expect_error( + gh_encode(c(y, y), x), + 'Inputs must be the same size', + fixed = TRUE + ) # semi-valid auto-corrected input -- 180 --> -180 by wrapping expect_identical(gh_encode(y, 180.0), '80008n') @@ -71,12 +84,17 @@ test_that('geohash encoder works', { # missing/infinite input expect_identical(gh_encode(c(y, NA), c(x, NA)), c('s0h09n', NA_character_)) - expect_identical(gh_encode(c(NaN, Inf, -Inf, 1:3), c(1:3, NaN, Inf, -Inf)), - rep(NA_character_, 6L)) + expect_identical( + gh_encode(c(NaN, Inf, -Inf, 1:3), c(1:3, NaN, Inf, -Inf)), + rep(NA_character_, 6L) + ) # different branch for precision=1 of the above errors - expect_error(gh_encode(100.0, x, 1L), - 'Invalid latitude at index 1', fixed = TRUE) + expect_error( + gh_encode(100.0, x, 1L), + 'Invalid latitude at index 1', + fixed = TRUE + ) expect_identical(gh_encode(y, 180.0, 1L), '8') expect_identical(gh_encode(NA, NA, 1L), NA_character_) diff --git a/tests/testthat/test-gis-tools.R b/tests/testthat/test-gis-tools.R index d5922b4..1e06aa2 100644 --- a/tests/testthat/test-gis-tools.R +++ b/tests/testthat/test-gis-tools.R @@ -1,57 +1,74 @@ test_that('gh_to_sp works', { skip_if_not_installed('sp') - mauritius = c('mk2u', 'mk2e', 'mk2g', 'mk35', 'mk3h', - 'mk3j', 'mk2v', 'mk2t', 'mk2s') + mauritius = c('mk2u', 'mk2e', 'mk2g', 'mk35', 'mk3h', 'mk3j', 'mk2v', 'mk2t', 'mk2s') ghSP = gh_to_sp(mauritius) expect_s4_class(ghSP, 'SpatialPolygons') expect_length(ghSP, 9L) expect_identical(vapply(ghSP@polygons, slot, 'ID', FUN.VALUE = character(1L)), mauritius) - expect_identical(ghSP['mk2u', ]@polygons[[1L]]@Polygons[[1L]]@coords, - matrix(c(57.3046875, 57.3046875, 57.65625, 57.65625, - 57.3046875, -20.390625, -20.21484375, - -20.21484375, -20.390625, -20.390625), - nrow = 5L, ncol = 2L)) + expect_identical( + ghSP['mk2u', ]@polygons[[1L]]@Polygons[[1L]]@coords, + matrix( + c( + 57.3046875, -20.39062500, + 57.3046875, -20.21484375, + 57.6562500, -20.21484375, + 57.6562500, -20.39062500, + 57.3046875, -20.39062500 + ), + byrow = TRUE, ncol = 2L + ) + ) wgs = sp::CRS('+proj=longlat +datum=WGS84', doCheckCRSArgs = FALSE) expect_identical(ghSP@proj4string, wgs) # duplicate inputs dropped - expect_warning(ghSP2 <- gh_to_sp(rep(mauritius, 2L)), - 'duplicate input geohashes', fixed = TRUE) - expect_identical(ghSP, ghSP2) + expect_warning( + expect_identical(gh_to_sp(rep(mauritius, 2L)), ghSP), + 'duplicate input geohashes', + fixed = TRUE + ) }) test_that('gh_to_spdf.default works', { skip_if_not_installed('sp') - urumqi = c('tzy3', 'tzy0', 'tzy2', 'tzy8', 'tzy9', - 'tzyd', 'tzy6', 'tzy4', 'tzy1') + urumqi = c('tzy3', 'tzy0', 'tzy2', 'tzy8', 'tzy9', 'tzyd', 'tzy6', 'tzy4', 'tzy1') ghSPDF = gh_to_spdf(urumqi) expect_s4_class(ghSPDF, 'SpatialPolygonsDataFrame') expect_length(ghSPDF, 9L) expect_identical(vapply(ghSPDF@polygons, slot, 'ID', FUN.VALUE = character(1L)), urumqi) - expect_identical(ghSPDF['tzy2', ]@polygons[[1L]]@Polygons[[1L]]@coords, - matrix(c(87.5390625, 87.5390625, 87.890625, - 87.890625, 87.5390625, 43.59375, 43.76953125, - 43.76953125, 43.59375, 43.59375), - nrow = 5L, ncol = 2L)) + expect_identical( + ghSPDF['tzy2', ]@polygons[[1L]]@Polygons[[1L]]@coords, + matrix( + c( + 87.5390625, 43.59375000, + 87.5390625, 43.76953125, + 87.8906250, 43.76953125, + 87.8906250, 43.59375000, + 87.5390625, 43.59375000 + ), + byrow = TRUE, ncol = 2L + ) + ) wgs = sp::CRS('+proj=longlat +datum=WGS84', doCheckCRSArgs = FALSE) expect_identical(ghSPDF@proj4string, wgs) DF = data.frame(ID = 1:9, row.names = urumqi) expect_identical(ghSPDF@data, DF) # check also duplicated input (#8) - expect_warning(ghSPDF2 <- gh_to_spdf(rep(urumqi, 2L)), - 'Detected 9 duplicate input geohashes; removing', fixed = TRUE) - expect_identical(ghSPDF2@data, DF) + expect_warning( + expect_identical(gh_to_spdf(rep(urumqi, 2L))@data, DF), + 'Detected 9 duplicate input geohashes; removing', + fixed = TRUE + ) }) test_that('gh_to_spdf.data.frame works', { skip_if_not_installed('sp') - urumqi = c('tzy3', 'tzy0', 'tzy2', 'tzy8', 'tzy9', - 'tzyd', 'tzy6', 'tzy4', 'tzy1') + urumqi = c('tzy3', 'tzy0', 'tzy2', 'tzy8', 'tzy9', 'tzyd', 'tzy6', 'tzy4', 'tzy1') DF = data.frame( gh = urumqi, V = c(-1.08, 0.03, -0.68, -2.59, -0.02, 0.72, 0.68, 1.14, 0.47) @@ -61,19 +78,29 @@ test_that('gh_to_spdf.data.frame works', { expect_s4_class(ghSPDF, 'SpatialPolygonsDataFrame') expect_length(ghSPDF, 9L) expect_identical(vapply(ghSPDF@polygons, slot, 'ID', FUN.VALUE = character(1L)), urumqi) - expect_identical(ghSPDF['tzy2', ]@polygons[[1L]]@Polygons[[1L]]@coords, - matrix(c(87.5390625, 87.5390625, 87.890625, - 87.890625, 87.5390625, 43.59375, 43.76953125, - 43.76953125, 43.59375, 43.59375), - nrow = 5L, ncol = 2L)) + expect_identical( + ghSPDF['tzy2', ]@polygons[[1L]]@Polygons[[1L]]@coords, + matrix( + c( + 87.5390625, 43.59375000, + 87.5390625, 43.76953125, + 87.8906250, 43.76953125, + 87.8906250, 43.59375000, + 87.5390625, 43.59375000 + ), + byrow = TRUE, ncol = 2L + ) + ) wgs = sp::CRS('+proj=longlat +datum=WGS84', doCheckCRSArgs = FALSE) expect_identical(ghSPDF@proj4string, wgs) expect_identical(ghSPDF@data, DF) # duplicated inputs (#8) - expect_warning(ghSPDF2 <- gh_to_spdf(rbind(DF, DF)), - 'Detected 9 duplicate input geohashes; removing', fixed = TRUE) - expect_identical(ghSPDF2@data, DF) + expect_warning( + expect_identical(gh_to_spdf(rbind(DF, DF))@data, DF), + 'Detected 9 duplicate input geohashes; removing', + fixed = TRUE + ) # different gh_col names(DF) = c('geohash', 'V') @@ -87,8 +114,7 @@ test_that('gh_to_spdf.data.frame works', { test_that('gh_to_sf works', { skip_if_not_installed('sf') - baku = c('tp5my', 'tp5mt', 'tp5mw', 'tp5mx', 'tp5mz', - 'tp5qp', 'tp5qn', 'tp5qj', 'tp5mv') + baku = c('tp5my', 'tp5mt', 'tp5mw', 'tp5mx', 'tp5mz', 'tp5qp', 'tp5qn', 'tp5qj', 'tp5mv') ghSF = gh_to_sf(baku) @@ -98,11 +124,19 @@ test_that('gh_to_sf works', { expect_s3_class(ghSF$geometry[1L], 'sfc') expect_s3_class(ghSF$geometry[1L][[1L]], 'sfg') - expect_identical(ghSF$geometry[1L][[1L]][[1L]], - matrix(c(49.833984375, 49.833984375, 49.8779296875, - 49.8779296875, 49.833984375, 40.3857421875, - 40.4296875, 40.4296875, 40.3857421875, 40.3857421875), - nrow = 5L, ncol = 2L)) + expect_identical( + ghSF$geometry[1L][[1L]][[1L]], + matrix( + c( + 49.8339843750, 40.3857421875, + 49.8339843750, 40.4296875000, + 49.8779296875, 40.4296875000, + 49.8779296875, 40.3857421875, + 49.8339843750, 40.3857421875 + ), + byrow = TRUE, ncol = 2L + ) + ) }) test_that('gh_covering works', { @@ -120,17 +154,19 @@ test_that('gh_covering works', { sp::proj4string(banjarmasin) = wgs # use gUnaryUnion to overcome rgeos bug as reported 2019-08-16 expect_false(anyNA(sp::over(banjarmasin, banjarmasin_cover))) - expect_identical(sort(rownames(banjarmasin_cover@data))[1:10], - c('qx3kzj', 'qx3kzm', 'qx3kzn', 'qx3kzp', 'qx3kzq', - 'qx3kzr', 'qx3kzt', 'qx3kzv', 'qx3kzw', 'qx3kzx')) + expect_identical( + sort(rownames(banjarmasin_cover@data))[1:10], + c('qx3kzj', 'qx3kzm', 'qx3kzn', 'qx3kzp', 'qx3kzq', 'qx3kzr', 'qx3kzt', 'qx3kzv', 'qx3kzw', 'qx3kzx') + ) expect_length(banjarmasin_cover, 112L) # arguments expect_length(gh_covering(banjarmasin, 5L), 9L) banjarmasin_tight = gh_covering(banjarmasin, minimal = TRUE) - expect_identical(sort(rownames(banjarmasin_tight@data))[1:10], - c('qx3kzm', 'qx3kzx', 'qx3mp3', 'qx3mpb', 'qx3mpu', - 'qx3mpz', 'qx3mr5', 'qx3sbt', 'qx3t06', 'qx3t22')) + expect_identical( + sort(rownames(banjarmasin_tight@data))[1:10], + c('qx3kzm', 'qx3kzx', 'qx3mp3', 'qx3mpb', 'qx3mpu', 'qx3mpz', 'qx3mr5', 'qx3sbt', 'qx3t06', 'qx3t22') + ) expect_length(banjarmasin_tight, 10L) # #13 -- proj4string<- doesn't mutate object, but proj4string() <- does? sp::proj4string(banjarmasin) = NA_character_ @@ -152,10 +188,8 @@ test_that('gh_covering_sf works', { skip_if_not_installed('sp') skip_if_not_installed('sf') banjarmasin = sf::st_as_sf(sp::SpatialPoints(cbind( - c(114.605, 114.5716, 114.627, 114.5922, 114.6321, - 114.5804, 114.6046, 114.6028, 114.6232, 114.5792), - c(-3.3346, -3.2746, -3.2948, -3.3424, -3.3523, - -3.3304, -3.3005, -3.3141, -3.326, -3.3552) + c(114.6050, 114.5716, 114.627, 114.5922, 114.6321, 114.5804, 114.6046, 114.6028, 114.6232, 114.5792), + c(-03.3346, -3.2746, -3.2948, -3.3424, -3.3523, -3.3304, -3.3005, -3.3141, -3.3260, -3.3552) ))) # core @@ -163,20 +197,26 @@ test_that('gh_covering_sf works', { sf::st_crs(banjarmasin) = sf::st_crs(4326L) banjarmasin = sf::st_transform(banjarmasin, sf::st_crs(banjarmasin_cover)) # use gUnaryUnion to overcome rgeos bug as reported 2019-08-16 - expect_false(anyNA(vapply(sf::st_intersects(banjarmasin, banjarmasin_cover), - function(z) if (length(z) == 0L) NA_integer_ else z[1L], - integer(1L)))) - expect_identical(sort(rownames(banjarmasin_cover))[1:10], - c('qx3kzj', 'qx3kzm', 'qx3kzn', 'qx3kzp', 'qx3kzq', - 'qx3kzr', 'qx3kzt', 'qx3kzv', 'qx3kzw', 'qx3kzx')) + expect_false(anyNA( + vapply( + sf::st_intersects(banjarmasin, banjarmasin_cover), + function(z) if (length(z) == 0L) NA_integer_ else z[1L], + integer(1L) + ) + )) + expect_identical( + sort(rownames(banjarmasin_cover))[1:10], + c('qx3kzj', 'qx3kzm', 'qx3kzn', 'qx3kzp', 'qx3kzq', 'qx3kzr', 'qx3kzt', 'qx3kzv', 'qx3kzw', 'qx3kzx') + ) expect_length(banjarmasin_cover$geometry, 112L) # arguments expect_identical(nrow(gh_covering(banjarmasin, 5L)), 9L) banjarmasin_tight = gh_covering(banjarmasin, minimal = TRUE) - expect_identical(sort(rownames(banjarmasin_tight))[1:10], - c('qx3kzm', 'qx3kzx', 'qx3mp3', 'qx3mpb', 'qx3mpu', - 'qx3mpz', 'qx3mr5', 'qx3sbt', 'qx3t06', 'qx3t22')) + expect_identical( + sort(rownames(banjarmasin_tight))[1:10], + c('qx3kzm', 'qx3kzx', 'qx3mp3', 'qx3mpb', 'qx3mpu', 'qx3mpz', 'qx3mr5', 'qx3sbt', 'qx3t06', 'qx3t22') + ) expect_identical(nrow(banjarmasin_tight), 10L) # errors diff --git a/tests/testthat/test-neighbors.R b/tests/testthat/test-neighbors.R index 29f13e9..a2cf9ce 100644 --- a/tests/testthat/test-neighbors.R +++ b/tests/testthat/test-neighbors.R @@ -3,56 +3,96 @@ test_that('geohash adjacency list works', { ty_turtle_beach = 'sws374' xunantunich = 'd5095x0' - expect_identical(gh_neighbors(my_turtle_beach, self = FALSE), - list(southwest = 'w0znzr', south = 'w0znzx', - southeast = 'w0znzz', west = 'w0zpp2', - east = 'w0zppb', northwest = 'w0zpp3', - north = 'w0zpp9', northeast = 'w0zppc')) + expect_identical( + gh_neighbors(my_turtle_beach, self = FALSE), + list( + southwest = 'w0znzr', + south = 'w0znzx', + southeast = 'w0znzz', + west = 'w0zpp2', + east = 'w0zppb', + northwest = 'w0zpp3', + north = 'w0zpp9', + northeast = 'w0zppc' + ) + ) # commonwealthers *shakes fist* - expect_identical(gh_neighbours(my_turtle_beach, self = FALSE), - list(southwest = 'w0znzr', south = 'w0znzx', - southeast = 'w0znzz', west = 'w0zpp2', - east = 'w0zppb', northwest = 'w0zpp3', - north = 'w0zpp9', northeast = 'w0zppc')) + expect_identical( + gh_neighbours(my_turtle_beach, self = FALSE), + list( + southwest = 'w0znzr', + south = 'w0znzx', + southeast = 'w0znzz', + west = 'w0zpp2', + east = 'w0zppb', + northwest = 'w0zpp3', + north = 'w0zpp9', + northeast = 'w0zppc' + ) + ) # input precision doesn't matter; vectors work - expect_identical(gh_neighbors(c(my_turtle_beach, ty_turtle_beach, xunantunich), - self = FALSE), - list(southwest = c('w0znzr', 'sws36c', 'd5095qz'), - south = c('w0znzx', 'sws371', 'd5095wb'), - southeast = c('w0znzz', 'sws373', 'd5095wc'), - west = c('w0zpp2', 'sws36f', 'd5095rp'), - east = c('w0zppb', 'sws376', 'd5095x1'), - northwest = c('w0zpp3', 'sws36g', 'd5095rr'), - north = c('w0zpp9', 'sws375', 'd5095x2'), - northeast = c('w0zppc', 'sws377', 'd5095x3'))) + expect_identical( + gh_neighbors(c(my_turtle_beach, ty_turtle_beach, xunantunich), self = FALSE), + list( + southwest = c('w0znzr', 'sws36c', 'd5095qz'), + south = c('w0znzx', 'sws371', 'd5095wb'), + southeast = c('w0znzz', 'sws373', 'd5095wc'), + west = c('w0zpp2', 'sws36f', 'd5095rp'), + east = c('w0zppb', 'sws376', 'd5095x1'), + northwest = c('w0zpp3', 'sws36g', 'd5095rr'), + north = c('w0zpp9', 'sws375', 'd5095x2'), + northeast = c('w0zppc', 'sws377', 'd5095x3') + ) + ) # global boundary geohashes # include a northern geohash whose top-level parent has no neighbor but # which has a neighbor at that precision, #14 - expect_identical(gh_neighbors(c('5', 'u', 'pv', 'zry', 'z0'), self = FALSE), - list(southwest = c(NA, 'e', 'ps', 'zrt', 'wz'), - south = c(NA, 's', 'pu', 'zrw', 'xp'), - southeast = c(NA, 't', '0h', 'zrx', 'xr'), - west = c('4', 'g', 'pt', 'zrv', 'yb'), - east = c('h', 'v', '0j', 'zrz', 'z2'), - northwest = c('6', NA, 'pw', NA, 'yc'), - north = c('7', NA, 'py', NA, 'z1'), - northeast = c('k', NA, '0n', NA, 'z3'))) + expect_identical( + gh_neighbors(c('5', 'u', 'pv', 'zry', 'z0'), self = FALSE), + list( + southwest = c(NA, 'e', 'ps', 'zrt', 'wz'), + south = c(NA, 's', 'pu', 'zrw', 'xp'), + southeast = c(NA, 't', '0h', 'zrx', 'xr'), + west = c('4', 'g', 'pt', 'zrv', 'yb'), + east = c('h', 'v', '0j', 'zrz', 'z2'), + northwest = c('6', NA, 'pw', NA, 'yc'), + north = c('7', NA, 'py', NA, 'z1'), + northeast = c('k', NA, '0n', NA, 'z3') + ) + ) # option self = TRUE - expect_identical(gh_neighbors(my_turtle_beach), - list(self = my_turtle_beach, - southwest = 'w0znzr', south = 'w0znzx', - southeast = 'w0znzz', west = 'w0zpp2', - east = 'w0zppb', northwest = 'w0zpp3', - north = 'w0zpp9', northeast = 'w0zppc')) + expect_identical( + gh_neighbors(my_turtle_beach), + list( + self = my_turtle_beach, + southwest = 'w0znzr', + south = 'w0znzx', + southeast = 'w0znzz', + west = 'w0zpp2', + east = 'w0zppb', + northwest = 'w0zpp3', + north = 'w0zpp9', + northeast = 'w0zppc' + ) + ) # edge cases: invalid input expect_error(gh_neighbors('a'), 'Invalid geohash', fixed = TRUE) - expect_identical(gh_neighbors(''), - list(self='', southwest=NA_character_, south=NA_character_, - southeast=NA_character_, west=NA_character_, - east=NA_character_, northwest=NA_character_, - north=NA_character_, northeast=NA_character_)) + expect_identical( + gh_neighbors(''), + list( + self='', + southwest=NA_character_, + south=NA_character_, + southeast=NA_character_, + west=NA_character_, + east=NA_character_, + northwest=NA_character_, + north=NA_character_, + northeast=NA_character_ + ) + ) }) diff --git a/vignettes/geohashTools.Rmd b/vignettes/geohashTools.Rmd index c0ad992..6208250 100644 --- a/vignettes/geohashTools.Rmd +++ b/vignettes/geohashTools.Rmd @@ -114,8 +114,10 @@ merlion_nbhd <- gh_to_sf(merlion_ghs) # Example plot of geohashes neighbouring w21z74 plot(merlion_nbhd, col = NA, reset = FALSE, key.pos = NULL) -text(st_coordinates(st_centroid(merlion_nbhd)), - labels = row.names(merlion_nbhd)) +text( + st_coordinates(st_centroid(merlion_nbhd)), + labels = row.names(merlion_nbhd) +) ``` ### gh_covering