#' Split a merged adres field ("Huisstraat 1A 12") and join with BAG
#' @description Takes a dataframe with an adres column, and joins selected columns
#' from a provided BAG extract (typically for a gemeente).
#' `r lifecycle::badge('experimental')`
#' @param data A dataframe with an adres column
#' @param adres_column Name (char) of the adres column in data
#' @param bag A BAG extract with columns addresseerbaarobject_id,huisnummer,huisletter,
#' huisnummertoevoeging
#' @param bag_columns Which columns to join onto data
#' @importFrom tidyr replace_na
#' @export
#' @rdname validate_address
validate_address <- function(data, adres_column, bag,
bag_columns = c("adresseerbaarobject_id",
"openbareruimtenaam",
"huisnummer","huisletter",
"huisnummertoevoeging")){
if(!adres_column %in% names(data)){
stop(paste("Column",adres_column,"not found."))
}
adres <- unique(data[[adres_column]])
adres <- adres[!is.na(adres)]
# make UTF8
adres <- iconv(adres, to = "UTF-8")
#adres <- stringi::stri_enc_toutf8(adres)
adres_out <- cbind(adres, split_adres_field(adres, bag))
names(adres_out)[1] <- adres_column
adres_out <- merge_bag_columns(adres_out, bag, bag_columns) %>%
dplyr::distinct(!!sym(adres_column), .keep_all = TRUE) # soms dubbele match
adres_out <- adres_out[,c(adres_column, bag_columns)]
out <- dplyr::left_join(data, adres_out, by = adres_column)
if(nrow(out) != nrow(data)){
stop("Probleem in validate_address, aantal rijen output niet gelijk aan input!")
}
out
}
merge_bag_columns <- function(data, bag, bag_columns = "adresseerbaarobject_id"){
adres_columns <- c("openbareruimtenaam","huisnummer","huisletter","huisnummertoevoeging")
# nog ca. 100 panden met meer dan 1 rij per bag_adres.
# deze hebben meerdere pandid per adres (geen idee waarom).
bag <- distinct(bag, adresseerbaarobject_id, .keep_all = TRUE) %>%
mutate(huisnummer = as.character(huisnummer), # was vroeger char
huisletter = tidyr::replace_na(huisletter, ""),
huisnummer = tidyr::replace_na(huisnummer, ""),
huisnummertoevoeging = tidyr::replace_na(huisnummertoevoeging, ""))
bag_columns <- union(adres_columns, bag_columns)
bag <- dplyr::select(bag,dplyr::all_of(bag_columns))
dplyr::left_join(data, bag, by = adres_columns)
}
#---- Utils
# add space between number and letter in huisnummer ("12A" --> "12 A")
space_huisnummer_huisletter <- function(x){
gsub("([0-9])([A-Z])", "\\1 \\2", x, perl = TRUE)
}
# gsub("([0-9])([A-Z])", "\\1 \\2", "Huisstraat 12A", perl = TRUE)
# gsub("([0-9])([A-Z])", "\\1 \\2", "12A", perl = TRUE)
# gsub("([0-9])([A-Z])", "\\1 \\2", "12A 220", perl = TRUE)
# gsub("([0-9])([A-Z])", "\\1 \\2", "12 A", perl = TRUE)
#grep("([0-9])([A-Z])", "12A")
#gsub("([0-9])([A-Z])", "\\1 \\2", "12A 220", perl = TRUE)
#adres_huisnummer_etc("1e Lieven de Keylaan 20A 10")
adres_huisnummer_etc <- function(x){
out <- strsplit(x, "[a-z|A-Z]{2,}")
vapply(out, function(x)x[length(x)], FUN.VALUE = character(1)) %>%
stringr::str_trim(.)
}
adres_openbareruimtenaam <- function(x){
out <- vapply(x, function(txt){
tryCatch(stringi::stri_replace_last_fixed(txt, adres_huisnummer_etc(txt), ""),
error = function(e)NA_character_,
warning = function(w)"")
}, FUN.VALUE = character(1))
stringr::str_trim(out)
}
#
# adres_huisnummer_etc("Huisstraat 12A") %>%
# space_huisnummer_huisletter()
find_abbr <- function(x, m){
if(x == "")return(NA_character_)
x <- gsub("[(]|[)]|[*]|[+]|[?]", " ", x)
y <- strsplit(x, "")[[1]]
reg <- paste(paste0(".*",y),collapse="")
out <- try(grep(reg, m, value = TRUE))
#if(inherits(out, "try-error"))browser()
if(length(out) == 0){
return(NA_character_)
} else {
return(out)
}
}
#s <- sapply(straat_mis, function(x)find_abbr(x,unique(bag_eindhoven$openbareruimtenaam) ))
fix_openbareruimtenaam <- function(x, bag){
u <- unique(x[!x %in% bag$openbareruimtenaam])
out <- fix_openbareruimtenaam_v(u, bag)
lookup <- tibble(value = u, fixed = out)
m <- match(x, lookup$value)
fix <- lookup$fixed[m]
x[!is.na(fix)] <- fix[!is.na(fix)]
return(x)
}
fix_openbareruimtenaam_v <- function(x, bag){
out <- x
b_s <- unique(bag$openbareruimtenaam)
for(i in seq_along(x)){
if(!x[i] %in% b_s){
if(x[i] == ""){
next
}
# de straat is een afkorting
a <- find_abbr(x[i], b_s)
if(!all(is.na(a))){
if(length(a) == 1){
out[i] <- a
next
}
}
# Straat zoeken op approx. grep.
g <- agrep(x[i], b_s, max.distance = 1, value = TRUE)
if(length(g) > 0){ # minstens 1 resultaat
# Meer dan 1 match:
if(length(g) > 1){
nc <- nchar(g)
nx <- nchar(x[i])
# Kies resultaat met zelfde lengte, dit is vaak enkele
# substituut (bv. Aida --> Aïda)
if(any(nc == nx)){
g <- g[which(nc == nx)[1]]
} else {
# Meerdere resultaten, pak de eerste.
# Hopelijk gaat dit vaak goed :)
g <- g[1]
}
}
out[i] <- g
}
}
}
out
}
#' @export
#' @rdname validate_address
split_adres_field <- function(x, bag){
hh <- adres_huisnummer_etc(x) %>%
space_huisnummer_huisletter()
h <- strsplit(hh, " ")
is_txt <- function(x){
grepl("[a-z]", x, ignore.case = TRUE)
}
out <- cbind(tibble(openbareruimtenaam = adres_openbareruimtenaam(x)),
as_tibble(
do.call(rbind, lapply(h, function(l){
c(huisnummer = l[1],
huisletter = if(is_txt(l[2]))l[2] else NA_character_,
huisnummertoevoeging = if(is_txt(l[2]))l[3] else l[2])
})))
)
# fix huisletter = "R-500"
i_fix <- grep("-", out$huisletter)
fix_lis <- strsplit(out[i_fix,"huisletter"],"-")
# huisletter in eerste veld
# TODO als dit geen letter is, moet het een huisnummertoevoeging zijn?
out$huisletter[i_fix] <- sapply(fix_lis, "[[", 1)
# huisnummertoevoeging in tweede
i_twofields <- which(sapply(fix_lis, length) == 2)
if(length(i_twofields)){
out$huisnummertoevoeging[i_fix[i_twofields]] <- sapply(fix_lis[i_twofields], "[[", 2)
}
out[is.na(out)] <- ""
out$openbareruimtenaam <- fix_openbareruimtenaam(out$openbareruimtenaam, bag)
out$huisnummertoevoeging[out$huisnummertoevoeging == "-"] <- ""
out$huisnummertoevoeging[nchar(out$huisnummertoevoeging) > 6] <- ""
out
}
# split_adres_field("Nuenenseweg 1", bag_eindhoven)
# split_adres_field("Nuenenseweg 1A", bag_eindhoven)
# split_adres_field("Nuenenseweg 1 A", bag_eindhoven)
# split_adres_field("Nuenenseweg 1 67", bag_eindhoven)
# split_adres_field("Nuenenseweg 1A 67", bag_eindhoven)
# split_adres_field("Nuenenseweg 1 A 67", bag_eindhoven)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.