Skip to content
New issue

Have a question about this project? # for a free GitHub account to open an issue and contact its maintainers and the community.

#

By clicking “#”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? # to your account

Fix key modifications for non-valid column names in osmdata_* functions #303

Merged
merged 7 commits into from
Jan 31, 2023
Merged

Fix key modifications for non-valid column names in osmdata_* functions #303

Show file tree
Hide file tree
Changes from 5 commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
8c27fc7
Fix key modifications for non-valid characters in osmdata_sf
jmaspons Jan 27, 2023
9ced955
Handle keys that clash with id or metadata columns
jmaspons Jan 27, 2023
fafe3a0
Merge branch 'main' into fix_strange_keys
jmaspons Jan 27, 2023
730f02c
fix code sytle
jmaspons Jan 30, 2023
a75f713
reuse already present var
jmaspons Jan 30, 2023
33dbe4b
Fix tests
jmaspons Jan 31, 2023
e4a220e
Update NEWS and version
jmaspons Jan 31, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
143 changes: 97 additions & 46 deletions R/get-osmdata.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -137,6 +137,41 @@ check_not_implemented_queries <- function (obj) {
}
}


fix_duplicated_columns <- function (x) {
dup <- duplicated (x)
i <- 1
while (any (dup)) {
x[dup] <- paste0 (x[dup], ".", i)
i <- i + 1
dup <- duplicated (x)
}

return (x)
}

fix_columns_list <- function (l) {
cols <- lapply (l, names)
cols_no_dup <- lapply (cols, fix_duplicated_columns)
if (!identical (cols, cols_no_dup)) {
warning (
"Feature keys clash with id or metadata columns and will be ",
"renamed by appending `.n`:\n\t",
paste (
unique (setdiff (unlist (cols_no_dup), unlist(cols))),
collapse = ", "
)
)
l <- mapply (function (x, col) {
suppressWarnings (names (x) <- col)
x
}, x = l, col = cols_no_dup, SIMPLIFY = FALSE)
}

return (l)
}


#' Return an OSM Overpass query as an \link{osmdata} object in \pkg{sp}
#' format.
#'
Expand Down Expand Up @@ -209,6 +244,8 @@ osmdata_sp <- function (q, doc, quiet = TRUE) {
obj$osm_multilines <- res$multilines
obj$osm_multipolygons <- res$multipolygons

osm_items <- grep ("^osm_", names (obj))
obj[osm_items] <- fix_columns_list (obj[osm_items])
class (obj) <- c (class (obj), "osmdata_sp")

return (obj)
Expand Down Expand Up @@ -395,7 +432,8 @@ make_sf <- function (..., stringsAsFactors = FALSE) { # nolint
} else { # create a data.frame from list:
data.frame (x [-sf_column],
row.names = row_names,
stringsAsFactors = stringsAsFactors
stringsAsFactors = stringsAsFactors,
check.names = FALSE
)
}

Expand Down Expand Up @@ -475,13 +513,15 @@ osmdata_sf <- function (q, doc, quiet = TRUE, stringsAsFactors = FALSE) { # noli
res <- rcpp_osmdata_sf (paste0 (doc))
# some objects don't have names. As explained in
# src/osm_convert::restructure_kv_mat, these instances do not get an osm_id
# column, so this is appended here:
if (!"osm_id" %in% names (res$points_kv)) {
# column (the first one), so this is appended here:
if (!"osm_id" %in% names (res$points_kv)[1]) {
res <- fill_kv (res, "points_kv", "points", stringsAsFactors)
}
if (!"osm_id" %in% names (res$polygons_kv)) {
if (!"osm_id" %in% names (res$polygons_kv)[1]) {
res <- fill_kv (res, "polygons_kv", "polygons", stringsAsFactors)
}
kv_df <- grep ("_kv$", names (res))
res[kv_df] <- fix_columns_list (res[kv_df])

if (missing (q)) {
obj$bbox <- paste (res$bbox, collapse = " ")
Expand All @@ -508,13 +548,15 @@ fill_kv <- function (res, kv_name, g_name, stringsAsFactors) { # nolint
if (nrow (res [[kv_name]]) == 0) {
res [[kv_name]] <- data.frame (
osm_id = names (res [[g_name]]),
stringsAsFactors = stringsAsFactors
stringsAsFactors = stringsAsFactors,
check.names = FALSE
)
} else {
res [[kv_name]] <- data.frame (
osm_id = rownames (res [[kv_name]]),
res [[kv_name]],
stringsAsFactors = stringsAsFactors
stringsAsFactors = stringsAsFactors,
check.names = FALSE
)
}
}
Expand Down Expand Up @@ -750,54 +792,63 @@ xml_to_df <- function (doc, stringsAsFactors = FALSE) {

res <- rcpp_osmdata_df (paste0 (doc))

if (nrow (res$points_kv) > 0L) {
res$points_kv$osm_type <- "node"
res$points_kv <- cbind (
get_meta_from_cpp_output (res, "points"),
res$points_kv
)
}
if (nrow (res$ways_kv) > 0L) {
res$ways_kv$osm_type <- "way"
res$ways_kv$osm_id <- rownames (res$ways_kv)
res$ways_kv <- cbind (
get_meta_from_cpp_output (res, "ways"),
res$ways_kv
)
}
if (nrow (res$rels_kv) > 0L) {
res$rels_kv$osm_type <- "relation"
res$rels_kv$osm_id <- rownames (res$rels_kv)
res$rels_kv <- cbind (
get_meta_from_cpp_output (res, "rels"),
res$rels_kv
)
}

nms <- sort (unique (unlist (lapply (res [1:3], names))))
nms1 <- c (
"osm_type", "osm_id",
paste0 (
"osm_",
c ("version", "timestamp", "changeset", "uid", "user")
)
)
nms1 <- intersect (nms1, nms)
nms <- c (nms1, setdiff (nms, nms1))
keysL <- lapply ( c ("points_kv", "ways_kv", "rels_kv"), function (x) {
out <- names (res[[x]])
if (isTRUE (out[1] == "osm_id")) {
out <- out[-1] # remove osm_id. Not always present
}
out
})
keys <- sort (unique (unlist(keysL)))

df <- lapply (res [1:3], function (i) {
tags <- mapply (function (i, k) {
i <- i[, k] # remove osm_id column if exists
out <- data.frame (
matrix (nrow = nrow (i), ncol = length (nms)),
stringsAsFactors = stringsAsFactors
matrix (
nrow = nrow (i), ncol = length (keys),
dimnames = list (NULL, keys)
),
stringsAsFactors = stringsAsFactors,
check.names = FALSE
)
names (out) <- nms
out [, names (i)] <- i
rownames (out) <- rownames (i)
return (out)
}, i = res[1:3], k = keysL, SIMPLIFY = FALSE)

meta <- lapply (c ("points", "ways", "rels"), function (type) {
get_meta_from_cpp_output (res, type)
})
df <- do.call (rbind, df)
metaCols<- unique (unlist (lapply (meta, names)))

df <- lapply(1:3, function (i) {
osm_type <- if (nrow (res[[i]]) > 0) {
c ("node", "way", "relation")[i]
} else {
character ()
}
data.frame(
osm_type,
osm_id = rownames (res[[i]]),
meta[[i]],
tags[[i]],
stringsAsFactors = stringsAsFactors,
check.names = FALSE
)
})

df <- do.call (rbind, c (df, list(deparse.level = 0)))
rownames (df) <- NULL

cols_no_dup <- fix_duplicated_columns (names (df))
if (!identical (names (df), cols_no_dup)) {
warning (
"Feature keys clash with id or metadata columns and will be ",
"renamed by appending `.n`:\n\t",
paste (setdiff (cols_no_dup, names (df)), collapse = ", ")
)
names (df) <- cols_no_dup
}

if (nrow (df) == 0) {
df <- data.frame (
osm_type = character (),
Expand Down
106 changes: 106 additions & 0 deletions tests/testthat/fixtures/osm-key_clashes.osm
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,106 @@
<?xml version="1.0" encoding="UTF-8"?>
<osm version="0.6" generator="Overpass API">
<note>The data included in this document is from www.openstreetmap.org. The data is made available under ODbL.</note>
<meta osm_base="2017-01-25T10:52:05Z"/>
<node id="1" lat="1" lon="1"/>
<node id="2" lat="1" lon="2"/>
<node id="3" lat="1" lon="3"/>
<node id="4" lat="1" lon="4"/>
<node id="5" lat="1" lon="5"/>
<node id="6" lat="2" lon="1"/>
<node id="7" lat="2" lon="2"/>
<node id="8" lat="2" lon="3"/>
<node id="9" lat="2" lon="4"/>
<node id="10" lat="2" lon="5"/>
<node id="11" lat="3" lon="1">
<tag k="stuff" v="yes"/>
<tag k="junk" v="some"/>
<tag k="name:ca" v="Ni idea"/>
<tag k="osm_id" v="Why to use this tag?"/>
<!-- test comment for rapidxml.h tests -->
</node>
<node id="12" lat="3" lon="2"/>
<node id="13" lat="3" lon="3"/>
<node id="14" lat="3" lon="4"/>
<node id="15" lat="3" lon="5"/>
<node id="16" lat="4" lon="1"/>
<node id="17" lat="4" lon="2"/>
<node id="18" lat="4" lon="3">
<tag k="stuff" v="nope"/>
<tag k="like" v="lots"/>
<tag k="name:ca" v="Ves a saber"/>
</node>
<node id="19" lat="4" lon="4"/>
<node id="20" lat="4" lon="5"/>
<node id="21" lat="5" lon="1"/>
<node id="22" lat="5" lon="2"/>
<node id="23" lat="5" lon="3"/>
<node id="24" lat="5" lon="4"/>
<node id="25" lat="5" lon="5"/>
<way id="100">
<nd ref="1"/>
<nd ref="2"/>
<nd ref="3"/>
<nd ref="4"/>
<tag k="highway" v="footway"/>
<tag k="layer" v="0"/>
<tag k="name:ca" v="Qui sap"/>
</way>
<way id="101">
<nd ref="4"/>
<nd ref="10"/>
<nd ref="15"/>
<nd ref="19"/>
<tag k="highway" v="maybe"/>
<tag k="name" v="blue&lt;this&gt;"/>
<tag k="name:ca" v="No ho se pas"/>
<tag k="osm_id" v="Why to use this tag?"/>
</way>
<way id="102">
<nd ref="19"/>
<nd ref="18"/>
<nd ref="22"/>
<nd ref="16"/>
<tag k="boat" v="yes"/>
<tag k="name" v="River Thames"/>
<tag k="name:ca" v="Riu Tàmesi"/>
<tag k="osm_id" v="Why to use this tag?"/>
</way>
<way id="103">
<nd ref="16"/>
<nd ref="11"/>
<nd ref="7"/>
<nd ref="1"/>
<tag k="foot" v="yes"/>
<tag k="highway" v="cycleway"/>
</way>
<way id="104">
<nd ref="8"/>
<nd ref="9"/>
<nd ref="14"/>
<nd ref="13"/>
<nd ref="8"/>
</way>
<relation id="1000">
<member type="way" ref="100" role="outer"/>
<member type="way" ref="101" role="outer"/>
<member type="way" ref="102" role="outer"/>
<member type="way" ref="103" role="outer"/>
<member type="way" ref="104" role="inner"/>
<tag k="name" v="big loop"/>
<tag k="name:ca" v="bucle gran"/>
<tag k="osm_id" v="Why to use this tag?"/>
<tag k="type" v="multipolygon"/>
<tag k="something" v="stuff&amp;junk&apos;andthenwhat"/>
</relation>
<relation id="2000">
<member type="way" ref="100" role=""/>
<member type="way" ref="101" role=""/>
<member type="way" ref="102" role=""/>
<tag k="name" v="big loop"/>
<tag k="name:ca" v="bucle gran"/>
<tag k="osm_id" v="Why to use this tag?"/>
<tag k="type" v="route"/>
<tag k="something" v="stuff&apos;&quot;aa&quot;"/>
</relation>
</osm>
7 changes: 7 additions & 0 deletions tests/testthat/fixtures/osm-multi.osm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,7 @@
<node id="11" lat="3" lon="1">
<tag k="stuff" v="yes"/>
<tag k="junk" v="some"/>
<tag k="name:ca" v="Ni idea"/>
<!-- test comment for rapidxml.h tests -->
</node>
<node id="12" lat="3" lon="2"/>
Expand All @@ -26,6 +27,7 @@
<node id="18" lat="4" lon="3">
<tag k="stuff" v="nope"/>
<tag k="like" v="lots"/>
<tag k="name:ca" v="Ves a saber"/>
</node>
<node id="19" lat="4" lon="4"/>
<node id="20" lat="4" lon="5"/>
Expand All @@ -41,6 +43,7 @@
<nd ref="4"/>
<tag k="highway" v="footway"/>
<tag k="layer" v="0"/>
<tag k="name:ca" v="Qui sap"/>
</way>
<way id="101">
<nd ref="4"/>
Expand All @@ -49,6 +52,7 @@
<nd ref="19"/>
<tag k="highway" v="maybe"/>
<tag k="name" v="blue&lt;this&gt;"/>
<tag k="name:ca" v="No ho se pas"/>
</way>
<way id="102">
<nd ref="19"/>
Expand All @@ -57,6 +61,7 @@
<nd ref="16"/>
<tag k="boat" v="yes"/>
<tag k="name" v="River Thames"/>
<tag k="name:ca" v="Riu Tàmesi"/>
</way>
<way id="103">
<nd ref="16"/>
Expand All @@ -80,6 +85,7 @@
<member type="way" ref="103" role="outer"/>
<member type="way" ref="104" role="inner"/>
<tag k="name" v="big loop"/>
<tag k="name:ca" v="bucle gran"/>
<tag k="type" v="multipolygon"/>
<tag k="something" v="stuff&amp;junk&apos;andthenwhat"/>
</relation>
Expand All @@ -88,6 +94,7 @@
<member type="way" ref="101" role=""/>
<member type="way" ref="102" role=""/>
<tag k="name" v="big loop"/>
<tag k="name:ca" v="bucle gran"/>
<tag k="type" v="route"/>
<tag k="something" v="stuff&apos;&quot;aa&quot;"/>
</relation>
Expand Down
20 changes: 20 additions & 0 deletions tests/testthat/test-data_frame-osm.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -326,3 +326,23 @@ test_that ("adiff2", {
expect_identical (metaL$meta_overpass_call, metaL$meta_opq)
expect_identical (metaL$meta_overpass_call$datetime_from, attr (q, "datetime"))
})

test_that ("non-valid key names", {
osm_multi <- test_path ("fixtures", "osm-multi.osm")
q0 <- opq (bbox = c (1, 1, 5, 5))
x <- osmdata_data_frame (q0, osm_multi)

expect_true ("name:ca" %in% names(x))
})

test_that ("clashes in key names", {
osm_multi_key_clashes <- test_path ("fixtures", "osm-key_clashes.osm")
q0 <- opq (bbox = c (1, 1, 5, 5))
expect_warning (
x <- osmdata_data_frame (q0, osm_multi_key_clashes),
"Feature keys clash with id or metadata columns and will be renamed by "
)

expect_true (all (c ("osm_id", "osm_id.1") %in% names(x)))
expect_false (any (duplicated (names (x))))
})
Loading