233 lines
7.8 KiB
R
233 lines
7.8 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-")
|
|
|
|
# 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)
|
|
})
|
|
|
|
observe({
|
|
maptype <- currently_selected_maptype()
|
|
heatmap <- currently_selected_heatmap_crime()
|
|
mapproxy <- leafletProxy("hhmap")
|
|
clearGroup(mapproxy, "selected")
|
|
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"
|
|
)
|
|
addPolygons(mapproxy,
|
|
data = heatmap_polygons,
|
|
layerId = ~leaflet_id,
|
|
group = "layer_heatmap",
|
|
label = get_map_layer_name(heatmap_polygons$leaflet_id),
|
|
color = "#003063",
|
|
fillColor = ~pal(heatmap_polygons$intensity),
|
|
weight = 3,
|
|
fillOpacity = 0.8
|
|
)
|
|
#---------------------
|
|
} else {
|
|
print("he")
|
|
clearGroup(mapproxy, "layer_heatmap")
|
|
if (maptype == "Bezirke"){
|
|
hideGroup(mapproxy, "layer_stadtteile")
|
|
showGroup(mapproxy, "layer_bezirke")
|
|
print("ho")
|
|
}
|
|
else {
|
|
hideGroup(mapproxy, "layer_bezirke")
|
|
showGroup(mapproxy, "layer_stadtteile")
|
|
print("hey")
|
|
}
|
|
}
|
|
})
|
|
|
|
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)) {
|
|
|
|
# The ID of the clicked polygon
|
|
clicked_polygon_id <- click_event$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"]] == click_event$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"]] == click_event$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 <- renderText({
|
|
currently_selected_bezirk()
|
|
})
|
|
output$txt_map_selection_stadtteil <- renderText({
|
|
currently_selected_stadtteil()
|
|
})
|
|
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)) +
|
|
geom_col(width = 0.7, fill = "#e10019") + # <-- Festlegen der Farbe direkt an allen Spalten angeknüpft nicht mehr anhand der Kategorie
|
|
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 = "Statistisch am häufigsten polizeilich registrierte Straftaten",
|
|
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.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)
|
|
|
|
output$tbl_2024 <- renderTable(
|
|
map_data_to_table(
|
|
bezirk = currently_selected_bezirk(),
|
|
stadtteil = currently_selected_stadtteil(),
|
|
year = "2024"
|
|
),
|
|
striped = TRUE
|
|
)
|
|
} |