Deal with 0 row input in osmapi_objects() and osmchange_*()

R/osmapiR_objects.R

@@ -64,6 +64,12 @@ osmapi_objects <- function(x, tag_columns, keep_na_tags = FALSE) {
       names(tag_columns) <- names(x)[tag_columns]
     }
 
+    if (nrow(x) == 0) {
+      x <- x[, -tag_columns]
+      x$tags <- list()
+      return(new_osmapi_objects(x))
+    }
+
     tags_list <- apply(x[, tag_columns, drop = FALSE], 1, function(y) {
       out <- data.frame(key = names(tag_columns), value = y, row.names = NULL)
       if (!keep_na_tags) {

R/osmchange.R

@@ -38,6 +38,11 @@
 osmchange_modify <- function(x, tag_keys, members = FALSE, lat_lon = FALSE, format = c("R", "osc", "xml")) {
   format <- match.arg(format)
   stopifnot(inherits(x, "osmapi_objects"))
+
+  if (nrow(x) == 0) {
+    return(osmchange_empty(format = format))
+  }
+
   if (inherits(x, "tags_wide")) {
     x <- tags_wide2list(x)
   }
@@ -153,6 +158,11 @@ osmchange_modify <- function(x, tag_keys, members = FALSE, lat_lon = FALSE, form
 #' }
 osmchange_delete <- function(x, delete_if_unused = FALSE, format = c("R", "osc", "xml")) {
   format <- match.arg(format)
+
+  if (nrow(x) == 0) {
+    return(osmchange_empty(format = format))
+  }
+
   if (inherits(x, "tags_wide")) {
     x <- tags_wide2list(x)
   }
@@ -218,6 +228,11 @@ osmchange_delete <- function(x, delete_if_unused = FALSE, format = c("R", "osc",
 osmchange_create <- function(x, format = c("R", "osc", "xml")) {
   format <- match.arg(format)
   stopifnot(inherits(x, "osmapi_objects"))
+
+  if (nrow(x) == 0) {
+    return(osmchange_create_empty(format = format))
+  }
+
   if (inherits(x, "tags_wide")) {
     x <- tags_wide2list(x)
   }
@@ -239,3 +254,34 @@ osmchange_create <- function(x, format = c("R", "osc", "xml")) {
 
   return(osmchange)
 }
+
+
+osmchange_create_empty <- function(format = "R") {
+  out <- list2DF(list(
+    action_type = character(), type = character(), id = character(),
+    lat = character(), lon = character(), members = list(), tags = list()
+  ))
+  class(out) <- c("osmapi_OsmChange", "osmapi_objects", "data.frame")
+
+  if (format != "R") {
+    out <- osmcha_DF2xml(out)
+  }
+
+  return(out)
+}
+
+
+osmchange_empty <- function(format = "R") {
+  out <- list2DF(list(
+    action_type = character(), type = character(), id = character(), visible = logical(), version = integer(),
+    changeset = character(), timestamp = as.POSIXct(character()), user = character(), uid = character(),
+    lat = character(), lon = character(), members = list(), tags = list()
+  ))
+  class(out) <- c("osmapi_OsmChange", "osmapi_objects", "data.frame")
+
+  if (format != "R") {
+    out <- osmcha_DF2xml(out)
+  }
+
+  return(out)
+}

inst/WORDLIST

@@ -141,6 +141,7 @@ GPX
 gpxs
 GqUECukGP
 gravatar
+grepl
 gsub
 Gvw
 gz

tests/testthat/test-osmapiR_objects.R

@@ -41,7 +41,9 @@ test_that("osmapi_objects works", {
     lapply(x$tags, function(y) expect_false(any(is.na(y$value))))
   })
 
+
   # keep_na_tags = TRUE
+
   objs_na <- list()
   objs_na$tag_ch <- osmapi_objects(x, tag_columns = c("type.1", "name"), keep_na_tags = TRUE)
   objs_na$tag_num <- osmapi_objects(x, tag_columns = 6:5, keep_na_tags = TRUE)
@@ -59,4 +61,26 @@ test_that("osmapi_objects works", {
     )
     expect_true(any(vapply(x$tags, function(y) any(is.na(y$value)), FUN.VALUE = logical(1))))
   })
+
+
+  # 0 row input
+
+  x_empty <- x[logical(), ]
+  objs_empty <- list()
+  objs_empty$tag_ch <- osmapi_objects(x_empty, tag_columns = c("type.1", "name"))
+  objs_empty$tag_bool <- osmapi_objects(x_empty, tag_columns = c(FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE))
+  objs_empty$tag_ch_named <- osmapi_objects(x_empty, tag_columns = c(type = "type.1"))
+  objs_empty$mis <- osmapi_objects(x_empty)
+
+  x_empty$tags <- list()
+  objs_empty$tags <- osmapi_objects(x_empty)
+
+  lapply(objs_empty, function(x) {
+    expect_s3_class(
+      validate_osmapi_objects(x, commited = FALSE),
+      class = c("osmapi_objects", "data.frame"),
+      exact = TRUE
+    )
+    expect_identical(nrow(x), 0L)
+  })
 })

tests/testthat/test-osmchange.R

@@ -32,6 +32,7 @@ test_that("osmchange_create works", {
   osmchange_crea$osmapi_obj <- osmchange_create(obj)
   obj_wide <- tags_list2wide(obj)
   osmchange_crea$osmapi_obj_wide <- osmchange_create(obj_wide)
+  osmchange_crea$osmapi_obj_empty <- osmchange_create(obj[logical(), ])
 
   lapply(osmchange_crea, expect_s3_class, class = c("osmapi_OsmChange", "osmapi_objects", "data.frame"), exact = TRUE)
   lapply(osmchange_crea, function(x) expect_true(all(names(x) %in% column_osmchange)))
@@ -43,7 +44,7 @@ test_that("osmchange_create works", {
     )
   })
 
-  lapply(osmchange_crea, function(x) expect_equal(nrow(x), nrow(obj)))
+  lapply(osmchange_crea[!grepl("empty", names(osmchange_crea))], function(x) expect_equal(nrow(x), nrow(obj)))
 
   ## osmcha_DF2xml
   lapply(osmchange_crea, function(x) expect_s3_class(osmcha_DF2xml(x), "xml_document"))
@@ -84,6 +85,8 @@ test_that("osmchange_modify works", {
 
     # TODO: test update of tags, members and lat_lon only with and without actual changes
   })
+  osmchange_mod$empty <- osmchange_modify(obj_current[logical(), ])
+  osmchange_mod$empty_name <- osmchange_modify(obj_current[logical(), ], tag_keys = "name")
 
   lapply(osmchange_mod, function(x) {
     expect_s3_class(x, class = c("osmapi_OsmChange", "osmapi_objects", "data.frame"), exact = TRUE)
@@ -124,6 +127,7 @@ test_that("osmchange_delete works", {
     osmchange_del$del <- osmchange_delete(obj_id, delete_if_unused = FALSE)
     osmchange_del$if_unused <- osmchange_delete(obj_id, delete_if_unused = TRUE)
   })
+  osmchange_del$empty <- osmchange_delete(obj_id[logical(), ])
 
   lapply(osmchange_del, function(x) {
     expect_s3_class(x, class = c("osmapi_OsmChange", "osmapi_objects", "data.frame"), exact = TRUE)
@@ -137,7 +141,7 @@ test_that("osmchange_delete works", {
     )
   })
 
-  lapply(osmchange_del, function(x) expect_equal(nrow(x), nrow(obj_id)))
+  lapply(osmchange_del[!grepl("empty", names(osmchange_del))], function(x) expect_equal(nrow(x), nrow(obj_id)))
 
   ## osmcha_DF2xml
   lapply(osmchange_del, function(x) expect_s3_class(osmcha_DF2xml(x), "xml_document"))