get_map_layer_prefix <- function(text){ return(substring(text, 0, 4)) } get_map_layer_name <- function(text) { return(substring(text, 5)) } #Server: Verarbeitung von Benutzereingaben und Daten 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("")) currently_compared_year <- reactiveVal(c("2024", "2023")) #Aktualisieren der Auswahlmöglichkeiten bei Änderungen in den Daten? 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) }) #Hamburg Karte in leaflet #Info über Bezirk und Stadtteil je nach ausgewählter Ebene #Heatmap Polygone mit bestimmter Farbpalette #Polygone auf Heatmap Ebene hinzufügen #Legende in Heatmap hinzufügen, falls Heatmap ausgewählt #Stadtteil und Bezirk Ebenen verbergen falls Heatmap Polygone und Ebene ausgewählt sind #Stadtteil Ebene verbergen, falls Bezirk ausgewählt ist #Bezirk Ebene verbergen, falls Stadtteil ausgewählt ist observe({ maptype <- currently_selected_maptype() heatmap <- currently_selected_heatmap_crime() mapproxy <- leafletProxy("hhmap") clearGroup(mapproxy, "selected") clearGroup(mapproxy, "layer_heatmap") removeControl(mapproxy, "heatmap_legend") if (heatmap != "") { hideGroup(mapproxy, "layer_bezirke") hideGroup(mapproxy, "layer_stadtteile") 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 ), ) pal_legend <- colorNumeric( palette = "YlOrRd", domain = heatmap_polygons$intensity ) addLegend(mapproxy, pal = pal_legend, opacity = 0.8, values = heatmap_polygons$intensity, title = paste("Fallzahlen:", heatmap), position = "bottomright", layerId = "heatmap_legend" ) } else { if (maptype == "Bezirke"){ hideGroup(mapproxy, "layer_stadtteile") showGroup(mapproxy, "layer_bezirke") } else { hideGroup(mapproxy, "layer_bezirke") showGroup(mapproxy, "layer_stadtteile") } } }) #Überprüfen, ob ein Polygon angeklickt wurde #Eine bereits ausgewählte Ebene (durch Mausklick) abwählen, indem die Ebene auf die Auswahl hin überprüft wird #Pipe Operator %>% nutzen um besseren Lesefluss und keine Verschachtelung zu haben #Überprüfen, ob die ausgewählte Ebene ein Bezirk oder Stadtteil ist, indem die Präfixe bez_ und std_ auf Übereinstimmung abgeglichen werden und die id, also den Namen des Stadtteils oder Bezirks zurückgeben? #mit req(slected_polygon_data) ein neues Polygon über die anderen legen, wenn ein Bezirk angeklickt wurde? observeEvent(input$hhmap_shape_click, { click_event <- input$hhmap_shape_click if (!is.null(click_event$id)) { if(click_event$group == "selected") { currently_selected_bezirk("") currently_selected_stadtteil("") leafletProxy("hhmap") %>% clearGroup("selected") return() } 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) 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" ) } }) #Hier wird die richtige Hamburg-Karte als output ausgewiesen, wir nutzen die CartoDB.Positron #Es müssen separate Polygone für die Bezirke und Stadtteil Koordinaten angelegt werden #die erste Color Option färbt die Fläche der Polygone #die zweite Color Option färbt die Konturen (daher highlightoptions) der Polygone #overlaypane sorgt für das Darüberlegen der Stadtteil Ebene auf die Bezirk Ebene #setview ist der Kartenausschnitt, der voreingestellt sein soll, also hier Hamburg als Zentrum #div() steht für division und sorgt für das Styling oder Layout von Inhalten, hier: die Inhalte "Bezirk:" und "Stadtteil:" #bez und req(bez) sowie sdt und req(sdt) (müsste es nicht auch std sein, so wie oben? Nur wegen der Einheitlichkeit und so) führen dazu, dass der richtige Bezirk bzw. Stadtteil, die angeklickt wurden, auch als Auswahl neben der Karte rechts auftauchen 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, 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"), weight = 3, fillOpacity = 0.2, 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( style = "margin-top: 5px; margin-bottom: 0px; display: flex; align-items: center; gap: 8px;", tags$span("Bezirk:", style = "font-weight: 700; font-size: 0.95rem;"), tags$span(bez, style = "font-weight: 400; font-size: 0.95rem;") ) }) output$txt_map_selection_stadtteil <- renderUI({ sdt <- currently_selected_stadtteil() req(sdt) div( style = "margin-top: 2px; margin-bottom: 15px; display: flex; align-items: center; gap: 8px;", tags$span("Stadtteil:", style = "font-weight: 700; font-size: 0.95rem;"), tags$span(sdt, style = "font-weight: 400; font-size: 0.95rem;") ) }) #Hier geht das Balkendiagramm auf dem Tab der Hamburg Karte los #Wir nutzen ein tibble, um es etwas zu vereinfachen #In diesem Diagramm bilden wir nur das Jahr 2024 ab, um es übersichtlich und prägnant zu halten #Da bei allen Stadtteilen und Bezirken die Straftat "Straftaten insgesamt" am höchsten ist, ignorieren wir diesen Eintrag, der bei allen Orten auf der 1. Ebene, bzw bei Computern der 0. Ebene ist, also die Ebenen > 0 #Wir benutzen nicht mehr ggplot, sondern plotly, weil wir dort mehr Möglichkeiten haben und das Diagramm nicht so starr ist wie bei ggplot #str_wrap sorgt für einen Zeielnumbruch, bei der Starftat falls, eine bestimmte Breite, hier von 15, überschritten wurde #wir haben vorfedinierte Farben für bessere Übersichtlichkeit #die Anzahl der erfassten Fälle machen wir als label außerhalb der Balken besser sichtbar #mit
suggerieren wir Zeilenumbrüche, um kein Problem mit den Abständen nach oben oder unten zu bekommen output$grph_top3 <- renderPlotly({ data_tibble <- map_data_to_top3_plot( bezirk = currently_selected_bezirk(), stadtteil = currently_selected_stadtteil(), year = "2024" ) req(nrow(data_tibble) > 0) plot_ly( data = data_tibble, x = ~factor( str_wrap(Name, width = 15), levels = str_wrap(Name[order(-Erfasst)], width = 15) ), y = ~Erfasst, name = "Top 3", text = format(data_tibble$Erfasst, big.mark = ".", decimal.mark = ","), textposition = "outside", type = "bar", marker = list( color = c("#698eb5", "#a2c1e0", "#cfe5fa") ) ) %>% layout( xaxis = list( title = "

Straftat", tickangle = 0, ticklabeloverflow = "allow" ), yaxis = list( title = "Anzahl erfasster Fälle" ), margin = list(b = 160, r = 60, pad = 5) ) %>% config( staticPlot = TRUE ) }) observeEvent(input$vergleich_location, { currently_compared_location(c(input$vergleich_location)) }) observeEvent(input$vergleich_straftat, { currently_compared_crimes(input$vergleich_straftat) }) #Hier geht das größere Balkendiagramm auf der Vergleichsseite los #Auswahlmöglichkeiten bei den Vergleichsoptionen verknüpfen #Farbpalette für die Balken, um nur Blautöne zu verwenden und die Aufmerksamkeit nicht abzulenken #Kompromisslösung bei mehr als 6 Balken pro Ort, also mehr als 6 Straftaten im Vergleich: dann gehen die Fraben von vorne los #Sortierung innerhalb des ausgewählten Orten absteigend und generell zwischen den Orten absteiegnd für gute Übersicht output$vergleich_balkendiagramm <- renderPlotly({ data_tibble <- map_data_to_plot( locations = currently_compared_location(), crimes = currently_compared_crimes(), year = currently_compared_year() ) location_totals <- data_tibble %>% group_by(Location) %>% summarise(Total = sum(Erfasst)) %>% arrange(Total) data_tibble <- data_tibble %>% mutate(Location = factor(Location, levels = location_totals$Location)) wide_data <- data_tibble %>% pivot_wider(names_from = Name, values_from = Erfasst, values_fill = 0) first_loc <- levels(data_tibble$Location)[length(levels(data_tibble$Location))] crime_order <- wide_data %>% filter(Location == first_loc) %>% select(-Location) %>% t() %>% as.data.frame() %>% arrange(V1) %>% rownames() wide_data <- wide_data %>% select(Location, all_of(crime_order)) blue_palette <- colorRampPalette(tail(RColorBrewer::brewer.pal(8, "Blues"), 6)) plot <- plot_ly() %>% layout( barmode = 'group', colorway = blue_palette(6), xaxis = list( title = "Anzahl erfasster Fälle" ), yaxis = list( title = "Straftat", tickangle = "-90" ), legend = list( orientation = "h", x = 0.5, itemwidth = 40, xanchor = "center", yanchor = "top", valign = "top" ) ) %>% config( staticPlot = TRUE ) for(i in seq_along(crime_order)) { crime <- crime_order[i] plot <- plot %>% add_trace( x = wide_data[[crime]], y = wide_data$Location, name = crime, text = format(wide_data[[crime]], big.mark = ".", decimal.mark = ","), textposition = "outside", type = "bar", orientation = "h", legendrank = length(crime_order) - i ) } plot }) }