353 lines
12 KiB
R
353 lines
12 KiB
R
get_map_layer_prefix <- function(text){
|
|
return(substring(text, 0, 4))
|
|
}
|
|
|
|
get_map_layer_name <- function(text) {
|
|
return(substring(text, 5))
|
|
}
|
|
|
|
|
|
#Server handling user input and processing of data
|
|
server <- function(input, output, session) {
|
|
currently_selected_bezirk <- reactiveVal("")
|
|
currently_selected_stadtteil <- reactiveVal("")
|
|
currently_selected_maptype <- reactiveVal("Bezirke")
|
|
currently_selected_heatmap_crime <- reactiveVal("Allgemeine Verstöße gem. § 29 BtMG -Konsumentendelikte-")
|
|
|
|
|
|
currently_compared_location <- reactiveVal(c(""))
|
|
currently_compared_crimes <- reactiveVal(c(""))
|
|
|
|
# 1. Aktualisieren der Auswahlmöglichkeiten mit den extrahierten Schlüsselnamen
|
|
updateSelectizeInput(
|
|
session = session,
|
|
inputId = "search",
|
|
choices = auswahlmöglichkeiten,
|
|
selected = ""
|
|
)
|
|
|
|
observeEvent(input$search, {
|
|
req(input$search)
|
|
currently_selected_bezirk(get_bezirk_by_stadtteil(input$search))
|
|
currently_selected_stadtteil(input$search)
|
|
})
|
|
observeEvent(input$heatmap, {
|
|
currently_selected_heatmap_crime(input$heatmap)
|
|
})
|
|
|
|
observeEvent(input$rd_maptype, {
|
|
currently_selected_maptype(input$rd_maptype)
|
|
})
|
|
|
|
observeEvent(input$vergleichs_jahr, {
|
|
currently_compared_year(input$vergleichs_jahr)
|
|
})
|
|
|
|
observe({
|
|
maptype <- currently_selected_maptype()
|
|
heatmap <- currently_selected_heatmap_crime()
|
|
mapproxy <- leafletProxy("hhmap")
|
|
clearGroup(mapproxy, "selected")
|
|
clearGroup(mapproxy, "layer_heatmap")
|
|
# Entfernt eine eventuell existierende Legende vom vorherigen Durchlauf
|
|
removeControl(mapproxy, "heatmap_legend")
|
|
|
|
if (heatmap != "") {
|
|
hideGroup(mapproxy, "layer_bezirke")
|
|
hideGroup(mapproxy, "layer_stadtteile")
|
|
#---Create heatmap----
|
|
heatmap_polygons <- if(maptype == "Bezirke") {
|
|
geo_bezirke %>%
|
|
mutate(bezirke_join = paste("Bezirk", bezirk)) %>%
|
|
left_join(get_intensity_df(crime_json, heatmap), by = c("bezirke_join" = "stadtteil"))
|
|
} else {
|
|
geo_stadtteile %>%
|
|
left_join(get_intensity_df(crime_json, heatmap), by = "stadtteil")
|
|
}
|
|
pal <- colorNumeric(
|
|
palette = "YlOrRd",
|
|
domain = heatmap_polygons$intensity,
|
|
na.color = "transparent",
|
|
alpha = 1
|
|
)
|
|
addPolygons(mapproxy,
|
|
data = heatmap_polygons,
|
|
layerId = paste("heat_", heatmap_polygons$leaflet_id, sep = ""),
|
|
group = "layer_heatmap",
|
|
label = get_map_layer_name(heatmap_polygons$leaflet_id),
|
|
color = "#003063",
|
|
fillColor = ~pal(heatmap_polygons$intensity),
|
|
weight = 3,
|
|
fillOpacity = 0.8,
|
|
highlightOptions = highlightOptions(
|
|
weight = 6,
|
|
bringToFront = TRUE
|
|
),
|
|
)
|
|
# Legende hinzufügen
|
|
addLegend(mapproxy,
|
|
pal = pal,
|
|
values = heatmap_polygons$intensity,
|
|
title = paste("Intensität:", heatmap),
|
|
position = "bottomright",
|
|
layerId = "heatmap_legend" # Wichtig zum gezielten Entfernen
|
|
)
|
|
#---------------------
|
|
} else {
|
|
if (maptype == "Bezirke"){
|
|
hideGroup(mapproxy, "layer_stadtteile")
|
|
showGroup(mapproxy, "layer_bezirke")
|
|
}
|
|
else {
|
|
hideGroup(mapproxy, "layer_bezirke")
|
|
showGroup(mapproxy, "layer_stadtteile")
|
|
}
|
|
}
|
|
})
|
|
|
|
observeEvent(input$hhmap_shape_click, {
|
|
click_event <- input$hhmap_shape_click
|
|
# Check if an ID was returned (meaning a polygon was clicked)
|
|
if (!is.null(click_event$id)) {
|
|
if(click_event$group == "selected") {
|
|
# Clicked on an already selected area of the map therefore we unselect.
|
|
currently_selected_bezirk("")
|
|
currently_selected_stadtteil("")
|
|
leafletProxy("hhmap") %>%
|
|
clearGroup("selected")
|
|
return()
|
|
}
|
|
|
|
# The ID of the clicked polygon
|
|
clicked_polygon_id <- click_event$id
|
|
clicked_polygon_id <- sub("^heat_", "", clicked_polygon_id)
|
|
prefix <- get_map_layer_prefix(clicked_polygon_id)
|
|
rest_of_name <- get_map_layer_name(clicked_polygon_id)
|
|
selected_polygon_data <- NULL
|
|
if (prefix == "bez_") {
|
|
currently_selected_bezirk(rest_of_name)
|
|
currently_selected_stadtteil(paste("Bezirk", rest_of_name))
|
|
selected_polygon_data <- geo_bezirke[geo_bezirke[["leaflet_id"]] == clicked_polygon_id,]
|
|
}
|
|
if(prefix == "std_") {
|
|
currently_selected_bezirk(get_bezirk_by_stadtteil(rest_of_name))
|
|
currently_selected_stadtteil(rest_of_name)
|
|
selected_polygon_data <- geo_stadtteile[geo_stadtteile[["leaflet_id"]] == clicked_polygon_id,]
|
|
}
|
|
req(selected_polygon_data)
|
|
#neues Polygon über die anderen legen, wenn ein bezirk angeklickt wurde
|
|
leafletProxy("hhmap") %>%
|
|
clearGroup("selected") %>%
|
|
addPolygons(
|
|
data = selected_polygon_data,
|
|
layerId = id,
|
|
label = selected_polygon_data$bezirk,
|
|
color = "#003063",
|
|
fillOpacity = 0.2,
|
|
weight = 4,
|
|
group = "selected"
|
|
)
|
|
}
|
|
})
|
|
|
|
output$hhmap <- renderLeaflet({
|
|
leaflet() %>%
|
|
addProviderTiles(providers$CartoDB.Positron) %>%
|
|
addPolygons(
|
|
data = geo_bezirke,
|
|
layerId = ~leaflet_id,
|
|
group = "layer_bezirke",
|
|
label = get_map_layer_name(geo_bezirke$leaflet_id),
|
|
color = "#003063",
|
|
fillOpacity = 0.2, # Polygon fill transparency
|
|
highlightOptions = highlightOptions(
|
|
fillOpacity = 0.4,
|
|
color = "#003063",
|
|
weight = 4,
|
|
bringToFront = TRUE
|
|
),
|
|
) %>%
|
|
addPolygons(
|
|
data = geo_stadtteile,
|
|
group = "layer_stadtteile",
|
|
label = get_map_layer_name(geo_stadtteile$leaflet_id),
|
|
layerId = ~leaflet_id,
|
|
color = "#003063",
|
|
options = pathOptions(pane = "overlayPane"), # Use a leaflet option to ensure it's hidden
|
|
weight = 3,
|
|
fillOpacity = 0.2, # Polygon fill transparency
|
|
highlightOptions = highlightOptions(
|
|
fillOpacity = 0.4,
|
|
color = "#003063",
|
|
weight = 4,
|
|
bringToFront = TRUE
|
|
),
|
|
) %>%
|
|
|
|
setView(
|
|
lng = 9.98716634776887,
|
|
lat = 53.5488439196432,
|
|
zoom = 11
|
|
)
|
|
})
|
|
output$txt_map_selection_bezirk <- renderUI({
|
|
bez <- currently_selected_bezirk()
|
|
req(bez)
|
|
div(# Überschrift einfügen
|
|
class = "d-flex align-items-baseline gap-2",
|
|
style = "margin-bottom: 2px;", # Ganz wenig Abstand zum nächsten Element
|
|
tags$b("Bezirk:", style = "font-size: 1.1rem;"), # 'b' ist kompakter als 'h5'
|
|
tags$span(bez, style = "font-size: 1.1rem;")
|
|
)
|
|
|
|
})
|
|
output$txt_map_selection_stadtteil <- renderUI({
|
|
sdt <- currently_selected_stadtteil()
|
|
req(sdt)
|
|
div(
|
|
class = "d-flex align-items-end gap-2",
|
|
h5(strong("Stadtteil:"), style = "margin-bottom: 0;"),
|
|
p(sdt)
|
|
)
|
|
|
|
})
|
|
output$grph_top3 <- renderPlot({
|
|
data_tibble <- map_data_to_top3_plot(
|
|
bezirk = currently_selected_bezirk(),
|
|
stadtteil = currently_selected_stadtteil(),
|
|
year = "2024"
|
|
)
|
|
req(nrow(data_tibble) > 0)
|
|
ggplot(data_tibble, aes(x = Name, y = Erfasst, fill = Name)) +
|
|
geom_col(width = 0.7) +
|
|
scale_x_discrete(
|
|
labels = function(x) str_wrap(x, width = 15)) +
|
|
scale_fill_manual(values = c(
|
|
"#b8ecff",
|
|
"#d5f4ff",
|
|
"#e6f9ff"
|
|
)) +
|
|
geom_text(
|
|
# Die Text-Ästhetik soll der Wert aus der Spalte 'Erfasst' sein
|
|
aes(label = format(Erfasst, big.mark = ".", decimal.mark = ",")),
|
|
# Platzierung: Y-Wert des Textes = Wert der Spalte + Offset
|
|
# Wir verwenden den Offset, um den Text knapp über den Balken zu platzieren
|
|
# Wenn Sie den Text IN den Balken setzen möchten, setzen Sie y=Erfasst/2
|
|
vjust = -0.5, # Vertikale Ausrichtung: Negativer Wert platziert Text über dem Punkt
|
|
size = 4,
|
|
fontface = "bold"
|
|
) +
|
|
labs(
|
|
title = NULL,
|
|
x = "Straftatbestand",
|
|
y = "Anzahl erfasster Fälle"
|
|
) +
|
|
theme_pander() + #neues theme aus ggthemes packages
|
|
# NEUE ANPASSUNG: Drehen der X-Achsen-Beschriftungen
|
|
theme(
|
|
plot.background = element_rect(
|
|
color = "darkgrey", # Farbe des Rahmens
|
|
linewidth = 0.4, # Dicke des Rahmens
|
|
fill = NA # Füllung: NA = transparent
|
|
),
|
|
plot.margin = margin(t = 20, r = 20, b = 20, l = 20, unit = "pt"),
|
|
legend.position = "none",
|
|
panel.grid.major.x = element_blank(),
|
|
panel.grid.minor.x = element_blank(), # vertikale grid lines entfernen
|
|
# X-Achsen-Titel (z.B. "Straftatbestand")
|
|
axis.text.x = element_text(
|
|
angle = 0,
|
|
size = 9
|
|
),
|
|
axis.title.x = element_text(
|
|
face = "bold",
|
|
family = "sans",
|
|
# Fügen Sie hier einen Abstand nach OBEN hinzu
|
|
margin = margin(t = 15) # t = top (oben) in Pixeln
|
|
),
|
|
|
|
# Y-Achsen-Titel (z.B. "Anzahl erfasster Fälle")
|
|
axis.title.y = element_text(
|
|
face = "bold",
|
|
family = "sans",
|
|
# Fügen Sie hier einen Abstand nach RECHTS hinzu
|
|
margin = margin(r = 15) # r = right (rechts) in Pixeln
|
|
),
|
|
)
|
|
|
|
}, res = 100)
|
|
|
|
observeEvent(input$vergleich_location, {
|
|
currently_compared_location(c(input$vergleich_location))
|
|
})
|
|
observeEvent(input$vergleich_straftat, {
|
|
currently_compared_crimes(input$vergleich_straftat)
|
|
})
|
|
|
|
output$vergleich_balkendiagramm <- renderPlot({
|
|
data_tibble <- map_data_to_plot(
|
|
locations = currently_compared_location(),
|
|
crimes = currently_compared_crimes(),
|
|
year = currently_compared_year()
|
|
)
|
|
|
|
ggplot(data_tibble, aes(x = Erfasst, y = reorder(Location, Erfasst, FUN = sum), group = Name, fill = Name)) + #reorder macht die höchsten Werte nach oben, und sortiert nach Gesamtwert
|
|
geom_col(position = position_dodge(width = 0.9)) +
|
|
scale_fill_brewer(palette = "Blues") +
|
|
geom_text(
|
|
# Die Text-Ästhetik soll der Wert aus der Spalte 'Erfasst' sein
|
|
aes(label = format(Erfasst, big.mark = ".", decimal.mark = ",")),
|
|
# Platzierung: Y-Wert des Textes = Wert der Spalte + Offset
|
|
# Wir verwenden den Offset, um den Text knapp über den Balken zu platzieren
|
|
# Wenn Sie den Text IN den Balken setzen möchten, setzen Sie y=Erfasst/2
|
|
position = position_dodge(width = 0.9),
|
|
hjust = -0.3, #schiebt die Zahl nach rechts
|
|
vjust = 0.5, #schiebt Zahlen mittig hinter Balken
|
|
size = 4,
|
|
fontface = "bold"
|
|
) +
|
|
labs(
|
|
title = "Polizeilich registrierte Straftaten",
|
|
x = "Anzahl erfasster Fälle",
|
|
y = NULL
|
|
) +
|
|
scale_x_continuous(expand = expansion(mult = c(0, 0.15))) +
|
|
theme_classic() + #neues theme aus ggthemes packages
|
|
# NEUE ANPASSUNG: Drehen der X-Achsen-Beschriftungen
|
|
theme(
|
|
plot.background = element_rect(
|
|
color = "darkgrey", # Farbe des Rahmens
|
|
linewidth = 0.4, # Dicke des Rahmens
|
|
fill = NA # Füllung: NA = transparent
|
|
),
|
|
plot.margin = margin(t = 20, r = 20, b = 20, l = 20, unit = "pt"),
|
|
legend.position = "bottom",
|
|
legend.text = element_text(size = 13),
|
|
legend.title = element_blank(),
|
|
# X-Achsen-Titel (z.B. "Straftatbestand")
|
|
axis.text.x = element_text(
|
|
vjust = 1,
|
|
hjust = 1,
|
|
size = 12
|
|
),
|
|
axis.title.x = element_text(
|
|
face = "bold",
|
|
family = "sans",
|
|
# Fügt Abstand nach OBEN hinzu
|
|
margin = margin(t = 15), # t = top (oben) in Pixeln
|
|
size = 12
|
|
),
|
|
axis.text.y = element_text(
|
|
size = 13
|
|
),
|
|
# Y-Achsen-Titel (z.B. "Anzahl erfasster Fälle")
|
|
axis.title.y = element_text(
|
|
face = "bold",
|
|
family = "sans",
|
|
# Fügen Sie hier einen Abstand nach RECHTS hinzu
|
|
margin = margin(r = 15) # r = right (rechts) in Pixeln
|
|
)
|
|
)
|
|
}, res = 100)
|
|
|
|
} |