Test and fix tags_list2wide() with only 1 tag per object

Also add tests for tags_wide2list()

R/tags_list-wide.r

@@ -54,10 +54,14 @@ tags_list2wide <- function(x) {
   cols <- sort(unique(unlist(lapply(x$tags, function(y) y$key))))
   # WARNING: sort different than API ([A-Z][a-z][0-9] vs [0-9][a-z][A-Z])
 
-  tags_wide <- structure(
-    t(vapply(x$tags, function(y) structure(y$value, names = y$key)[cols], FUN.VALUE = character(length(cols)))),
-    dimnames = list(NULL, cols)
-  )
+  tags_wide <- vapply(x$tags, function(y) structure(y$value, names = y$key)[cols], FUN.VALUE = character(length(cols)))
+  # deal with vapply always simplifying result
+  if (length(cols) == 1) {
+    tags_wide <- as.matrix(tags_wide)
+  } else {
+    tags_wide <- t(tags_wide)
+  }
+  dimnames(tags_wide) <- list(NULL, cols)
 
   out <- x[, setdiff(names(x), "tags"), drop = FALSE]
   if (inherits(x, "osmapi_objects")) {

tests/testthat/test-tags_list-wide.R

@@ -30,6 +30,30 @@ test_that("OSM objects tags_list-wide works", {
     tags_list$rel[, setdiff(names(tags_list$rel), "tags")]
   )
 
+
+  ## Test one tag only
+
+  tag1_list <- lapply(tags_list, function(x) {
+    x$tags <- lapply(x$tags, function(y) structure(y[y$key == "name", ], row.names = 1L))
+    x
+  })
+  tag1_wide <- lapply(tags_wide, function(x) {
+    tags <- attr(x, "tag_columns")
+    rm_cols <- tags[names(tags) != "name"]
+    x <- x[, -rm_cols]
+    attr(x, "tag_columns") <- c(name = which(names(x) == "name"))
+    x
+  })
+
+  tag1_2wide <- lapply(tag1_list, tags_list2wide)
+  tag1_2list <- lapply(tag1_wide, tags_wide2list)
+
+  mapply(expect_identical, object = tag1_2wide, expected = tag1_wide)
+  mapply(expect_identical, object = tag1_2list, expected = tag1_list)
+
+
+  ## Test messages and errors
+
   expect_message(tags_list2wide(tags_wide[[1]]), "x is already in a tags wide format.")
   expect_message(tags_wide2list(tags_list[[1]]), "x is already in a tags list column format.")