Skip to content

fix: Umlaut & _blank links #24

New issue

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

Sign up for GitHub

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

Already on GitHub? Sign in to your account

Merged
philbosch merged 1 commit into from
Jan 8, 2026
Merged

fix: Umlaut & _blank links #24

Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
212 changes: 105 additions & 107 deletions R/create_geo_output.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@
#' @param gpkg_file The name of the .gpkg-file. For example `baupub.gpkg`.
#' @param sf_liegenschaften A shapefile containing the Liegenschaften-data
#' geometry and metadata.
#'
#'
#' @return Writes data to a GeoPackage file. Returns nothing.
#'
#' @export
Expand Down Expand Up @@ -47,8 +47,6 @@ create_gpkg <- function(gpkg_file, df_bp, sf_liegenschaften) {
}
}



#' Prepare Building Permit Data for Export as Spatial Features
#'
#' Converts building permit data into a spatial format with Swiss coordinate
Expand Down Expand Up @@ -80,22 +78,20 @@ add_spatial_information <- function(df_bp, sf_liegenschaften) {
return(sf_bp_geo)
}



#' Calculate Share of Non-Georeferenced Building Permits
#'
#' Computes the percentage of building permit applications within a given date
#' range that do not contain valid geometries. This is useful for assessing
#' the completeness of spatial information in the dataset.
#' Computes the percentage of building permit applications within a given date
#' range that do not contain valid geometries. This is useful for assessing
#' the completeness of spatial information in the dataset.
#'
#' @param sf_bp_geo An `sf` object containing building permit applications,
#' @param sf_bp_geo An `sf` object containing building permit applications,
#' including a geometry column and a `publicationDate` attribute.
#' @param start_date A character string in the format "yyyy-mm-dd" specifying
#' @param start_date A character string in the format "yyyy-mm-dd" specifying
#' the first day to include in the calculation.
#' @param end_date A character string in the format "yyyy-mm-dd" specifying
#' @param end_date A character string in the format "yyyy-mm-dd" specifying
#' the last day to include in the calculation.
#'
#' @return A numeric value representing the percentage of permits without valid
#' @return A numeric value representing the percentage of permits without valid
#' geometries, rounded to two decimal places.
#'
#'
Expand All @@ -104,19 +100,17 @@ add_spatial_information <- function(df_bp, sf_liegenschaften) {
#' calc_geo_availability(sf_bp_geo, start_date = "2025-01-01", end_date = "2025-07-15")
#' }
calc_geo_availability <- function(sf_bp_geo, start_date, end_date) {
sf_bp_geo <- sf_bp_geo |>
dplyr::mutate(publicationDate = as.Date(publicationDate)) |>
dplyr::filter(publicationDate >= as.Date(start_date) &
publicationDate <= as.Date(end_date))

sf_bp_geo <- sf_bp_geo |>
dplyr::mutate(publicationDate = as.Date(publicationDate)) |>
dplyr::filter(publicationDate >= as.Date(start_date) &
publicationDate <= as.Date(end_date))

share <- sum(!sf::st_is_empty(sf_bp_geo)) / nrow(sf_bp_geo)
share <- round(share * 100, 2)

return(share)
}


}

#' Create an Interactive Leaflet Map of Building Permits
#'
Expand All @@ -132,7 +126,7 @@ calc_geo_availability <- function(sf_bp_geo, start_date, end_date) {
#' @param start_date A character date in the format "yyyy-mm-dd" representing the
#' first day for which data should be included.
#' first day for which data should be included.
#' @param end_date A character date in the format "yyyy-mm-dd" representing the
#' @param end_date A character date in the format "yyyy-mm-dd" representing the
#' the last day for which data should be included.
#' @return A Leaflet map widget displaying the building permit polygons and
#' associated information.
Expand All @@ -143,34 +137,33 @@ calc_geo_availability <- function(sf_bp_geo, start_date, end_date) {
#' \dontrun{
#' # creating a map of the last 20 days
#' create_map(sf_bp_geo)
#'
#'
#' # customize period of retrieval
#' sf_bp_geo |>
#' sf_bp_geo |>
#' create_map(start_date = "20205-01-01", end_date = "2025-07-15")
#' }
create_map <- function(sf_bp_geo,
start_date = as.character(Sys.Date()-20),
create_map <- function(sf_bp_geo,
start_date = as.character(Sys.Date() - 20),
end_date = as.character(Sys.Date())) {


# Warnings
if (start_date < "2025-01-01") {
cli::cli_warn("There are no geo-referenced building permit applications before 2025-01-01.")
}

sf_bp_geo <- sf_bp_geo |>
sf_bp_geo <- sf_bp_geo |>
dplyr::filter(publicationDate >= start_date & publicationDate <= end_date)

if (nrow(sf_bp_geo) == 0) {
cli::cli_abort("There are no building permit application for this period.")
}

# find polygons that overlap (indexes of polygons)
intersected_poly <- sf_bp_geo |>
sf::st_intersects()

# isolate the overlapping polygons that do not have the same index
# --> making sure publication 1 is not categorized as "overlapping with
# --> making sure publication 1 is not categorized as "overlapping with
# publication 1"
intersected_poly <- purrr::map(seq_along(intersected_poly), ~ {
intersected_poly[[.x]][intersected_poly[[.x]] != .x]
Expand All @@ -180,27 +173,27 @@ create_map <- function(sf_bp_geo,
publicationNumber_intersected_poly <- purrr::map(intersected_poly, ~ {
sf_bp_geo$publicationNumber[.x]
})

# isolte url of overlapping polygons
url_intersected_poly <- purrr::map(intersected_poly, ~ {
sf_bp_geo$url[.x]
})

# create hyperlinks
url_intersected_poly_merged <- purrr::map2_chr(publicationNumber_intersected_poly, url_intersected_poly, ~ {
paste("<a href='", .y, "' target = '_blank'>", .x, "</a></b>", collapse = "<br/>")
})

url_intersected_poly_merged <- ifelse(url_intersected_poly_merged == "<a href=' ' target = 'blank'> </a></b>",
"-",
url_intersected_poly_merged
url_intersected_poly_merged <- ifelse(url_intersected_poly_merged == "<a href=' ' target = '_blank'> </a></b>",
"-",
url_intersected_poly_merged
)

# define enriched input for leaflet map
sf_bp_geo_wgs84 <- sf_bp_geo |>
sf::st_transform(crs = 4326) |>
dplyr::mutate(popup_text = paste0(
"<b> Meldungsnummer: </b><a href='", url, "' target = 'blank'>", publicationNumber, "</a>",
"<b> Meldungsnummer: </b><a href='", url, "' target = '_blank'>", publicationNumber, "</a>",
"<br/>",
"<b>Publikationsdatum: </b>", publicationDate,
"<br/>",
Expand All @@ -212,85 +205,91 @@ create_map <- function(sf_bp_geo,
"<br/>",
url_intersected_poly_merged
))

# calculate share of liegenschaften that could not be linked to a polygon
available_share <- calc_geo_availability(sf_bp_geo, start_date, end_date) |>
as.character() |> gsub(pattern = "\\.", replacement = ",")
observed_period <- paste0(format(as.Date(start_date), "%d.%m.%Y"),
" - " ,
format(as.Date(end_date), "%d.%m.%Y"))

available_share <- calc_geo_availability(sf_bp_geo, start_date, end_date) |>
as.character() |>
gsub(pattern = "\\.", replacement = ",")
observed_period <- paste0(
format(as.Date(start_date), "%d.%m.%Y"),
" - ",
format(as.Date(end_date), "%d.%m.%Y")
)

# Define HTML for the infobox
info.box <- htmltools::HTML(paste0(
htmltools::HTML(
'<div class="modal fade" id="infobox" role="dialog">
<div class="modal-dialog"><!-- Modal content-->
<div class="modal-content">
<div class="modal-header">
<button type="button" class="close" data-dismiss="modal">&times;</button>'
<div class="modal-dialog"><!-- Modal content-->
<div class="modal-content">
<div class="modal-header">
<button type="button" class="close" data-dismiss="modal">&times;</button>'
),

# Body
htmltools::HTML(paste0('<h3>Nutzungshinweise</h3>
<hr>

<h4>Beobachtungszeitraum (', observed_period,')</h4>
Die Karte zeigt alle Baugesuche der letzten 20 Tage im Kanton Z\u00FCrich,
die eindeutig einer Liegenschaft zugeordnet werden k&oumlnnen. W\u00E4hrend der
20-t\u00E4gigen Auflagefrist k&oumlnnen bei der Baubeh&oumlrde Baurechtsentscheide verlangt
werden, die Grundlage f\u00FCr m&oumlgliche Rekurse sind. Die Karte wird t\u00E4glich
aktualisiert.

<br/>
<br/>
<hr>


<h4>Georeferenzierung</h4>
<p>Aus Gr\u00FCnden der Datenqualit\u00E4t lassen sich nicht alle
Baugesuche eindeutig den entsprechenden Liegenschaften zuordnen. Im aktuellen
Beobachtungszeitraum konnten rund ', available_share, '% aller Baugesuche
mindestens einer Liegenschaft zugeordnet werden.

<br/>
<br/>

<b>Diese Visualisierung der laufenden Baugesuche dient als erg\u00E4nzende
Informationsquelle. Rechtsverbindlich sind ausschliesslich die Publikationen im
<a href="https://amtsblatt.zh.ch/#!/gazette">Amtsblatt des Kantons Z\u00FCrich</a>.</b>
<h4>Beobachtungszeitraum (', observed_period, ')</h4>
Die Karte zeigt alle Baugesuche der letzten 20 Tage im Kanton Z&uuml;rich,
die eindeutig einer Liegenschaft zugeordnet werden k&ouml;nnen. W&auml;hrend der
20-t&auml;gigen Auflagefrist k&ouml;nnen bei der Baubeh&ouml;rde Baurechtsentscheide verlangt
werden, die Grundlage f&uuml;r m&ouml;gliche Rekurse sind. Die Karte wird t&auml;glich
aktualisiert.

<br/>
<br/>

<h4>Datenquelle und weiterf\u00FChrende Informationen</h4>

Die verbindliche Hauptquelle ist das
<a href="https://amtsblatt.zh.ch/#!/gazette">Amtsblatt des Kantons Z\u00FCrich</a>,
in dem s\u00E4mtliche Baugesuche publiziert werden. Die hier dargestellten Daten
werden von der Fach- und Koordinationsstelle OGD des Kantons Z\u00FCrich aufbereitet
und zur Verf\u00FCgung gestellt.

<br/>
<br/>

Weitere Datens\u00E4tze und Informationen zu Baugesuchen im Kanton Z\u00FCrich
(z.B. ein Datensatz, der auch die nicht georeferenzierbaren Baugesuche umfasst)
sind in unserem
<a href="https://www.zh.ch/de/politik-staat/statistik-daten/datenkatalog.html#/datasets/2982@statistisches-amt-kanton-zuerich">Datenkatalog</a>
zu finden.</p>'
)
),
<br/>
<br/>

<h4>Georeferenzierung</h4>
<p>Aus Gr&uuml;nden der Datenqualit&auml;t lassen sich nicht alle
Baugesuche eindeutig den entsprechenden Liegenschaften zuordnen. Im aktuellen
Beobachtungszeitraum konnten rund ', available_share, '% aller Baugesuche
mindestens einer Liegenschaft zugeordnet werden.

<br/>
<br/>

<b>Diese Visualisierung der laufenden Baugesuche dient als erg&auml;nzende
Informationsquelle. Rechtsverbindlich sind ausschliesslich die Publikationen im
<a href="https://amtsblatt.zh.ch/#!/gazette" target="_blank" rel="noopener noreferrer">
Amtsblatt des Kantons Z&uuml;rich
</a>.</b>

<br/>
<br/>

<h4>Datenquelle und weiterf&uuml;hrende Informationen</h4>

Die verbindliche Hauptquelle ist das
<a href="https://amtsblatt.zh.ch/#!/gazette" target="_blank" rel="noopener noreferrer">
Amtsblatt des Kantons Z&uuml;rich
</a>,
in dem s&auml;mtliche Baugesuche publiziert werden. Die hier dargestellten Daten
werden von der Fach- und Koordinationsstelle OGD des Kantons Z&uuml;rich aufbereitet
und zur Verf&uuml;gung gestellt.

<br/>
<br/>

Weitere Datens&auml;tze und Informationen zu Baugesuchen im Kanton Z&uuml;rich
(z.B. ein Datensatz, der auch die nicht georeferenzierbaren Baugesuche umfasst)
sind in unserem
<a href="https://www.zh.ch/de/politik-staat/statistik-daten/datenkatalog.html#/datasets/2982@statistisches-amt-kanton-zuerich"
target="_blank" rel="noopener noreferrer">
Datenkatalog
</a>
zu finden.</p>'
)),

# Closing divs
htmltools::HTML('</div><div class="modal-footer"></div></div>')
htmltools::HTML("</div><div class='modal-footer'></div></div>")
))


leaflet::leaflet(sf_bp_geo_wgs84) |>
leaflet::addTiles("https://{s}.basemaps.cartocdn.com/light_all/{z}/{x}/{y}.png",
attribution = paste(
'&copy; <a href="https://openstreetmap.org">OpenStreetMap</a> contributors',
'&copy; <a href="https://cartodb.com/attributions">CartoDB</a>'
)
attribution = paste(
'&copy; <a href="https://openstreetmap.org">OpenStreetMap</a> contributors',
'&copy; <a href="https://cartodb.com/attributions">CartoDB</a>'
)
) |>
leaflet::addPolygons(
fillColor = "blue",
Expand All @@ -305,12 +304,11 @@ create_map <- function(sf_bp_geo,
lat1 = min(sf::st_bbox(sf_bp_geo_wgs84)["ymin"]),
lng2 = max(sf::st_bbox(sf_bp_geo_wgs84)["xmax"]),
lat2 = max(sf::st_bbox(sf_bp_geo_wgs84)["ymax"])
) |>
leaflet.extras::addBootstrapDependency() |>
) |>
leaflet.extras::addBootstrapDependency() |>
leaflet::addEasyButton(leaflet::easyButton(
icon = "fa-info-circle", title = "Map Information",
onClick = htmlwidgets::JS("function(btn, map){ $('#infobox').modal('show'); }")
)) |> # Trigger the infobox
)) |>
htmlwidgets::appendContent(info.box)

}
}