From f2fe7d105c2ca3be57b79a8727c509c338eb85d2 Mon Sep 17 00:00:00 2001 From: Millicool Date: Sat, 7 Feb 2026 19:25:58 +0100 Subject: [PATCH] Add comments --- global.R | 45 +++++++++++++++++++++++----------- server.R | 75 ++++++++++++++++++++++++++++++++++++-------------------- 2 files changed, 79 insertions(+), 41 deletions(-) diff --git a/global.R b/global.R index 43ec4a2..96153c3 100644 --- a/global.R +++ b/global.R @@ -5,12 +5,14 @@ library(leaflet) library(sf) library(htmltools) library(dplyr) +library(tidyr) library(purrr) library(ggplot2) library(ggthemes) library(stringr) library(plotly) -# Json of Crime Reports + +#große JSON Datei lesen crime_json <- fromJSON(file="data.json") get_bezirk_by_stadtteil <- function(name) { parents <- names(crime_json)[sapply(crime_json, function(item) name %in% names(item))] @@ -19,6 +21,10 @@ get_bezirk_by_stadtteil <- function(name) { parents } +#Wichtige Informationen aus passender Ebene/Row von der JSON Datei holen, um sie für das tibble zu nutzen +#trimws steht für trim whitespace, sorgt für sauberen string beim Jahr +#map_df steht für map dataframe +#aufgekärte Fälle sind auch im tibble drin, hätten wir also bei mehr Zeit oder für ,ehr Funktionen auch direkt nutzen können map_data_to_table <- function(bezirk, stadtteil, year) { year <- as.character(trimws(year)) map_df(names(crime_json[[bezirk]][[stadtteil]]), function(crime) { @@ -33,6 +39,10 @@ map_data_to_table <- function(bezirk, stadtteil, year) { }) } +#Vorbereitung für Balkendiagram top3 Straftaten +#Sortieren und Beschränken auf die Ränge 2, 3 und 4 +#Sortieren: Absteigend nach "Erfasste Fälle". Der höchste Wert ist nun in Zeile 1. +#mit slice sind explizit die Ränge 2, 3 und 4 gemeint map_data_to_top3_plot <- function(bezirk, stadtteil, year) { year <- as.character(trimws(year)) req(bezirk) @@ -45,17 +55,17 @@ map_data_to_top3_plot <- function(bezirk, stadtteil, year) { Erfasst = as.integer(row[["Erfasste Fälle"]]), ) }) - # Sortieren und Beschränken auf die Ränge 2, 3 und 4 top_3_tibble <- komplettes_tibble %>% - # Sortieren: Absteigend nach "Erfasste Fälle". Der höchste Wert ist nun in Zeile 1. arrange(desc(Erfasst)) %>% - # Beschränken: Wählt die Zeilen 2, 3 und 4 aus. - # Dies sind die Ränge 2, 3 und 4. slice(2:4) - return(top_3_tibble) } +#Vorbereitung für Balkendiagramm auf Vergleichs-tab +#Location beinhaltet Stadtteile und Bezirke, um alle Auswahlmöglichkeiten in einem drop down zu haben +#die App weiß, wann es sich um einen Bezirk handelt, wenn die ersten 7 Stellen mit dem Wort "Bezirk" übereinstimmen? +#Erfasste Fälle als Zahl (integer) angeben, die Straftaten (crimes) mit Zeilenumbruch bei bestimmter Breite angeben +#Sortierung nach Anzhal der erfassten Fälle absteigend map_data_to_plot <- function(locations, crimes, year) { year <- as.character(trimws(year)) req(locations) @@ -87,6 +97,9 @@ map_data_to_plot <- function(locations, crimes, year) { ) } +#lass mal hier statt delikt crime nehmen oder eben die anderen crimes delikt, oder gibt es einen Grund dass es anders heißt/auf deutsch ist? +#Mit dieser Funktion entnehmen wir die gewünschten Einträge, Straftat, Jahr, Erfasste Fälle direkt aus der JSON Datei und erhalten so unseren dataframe, den wir wofür nutzen können? +#sicherer Zugriff (verhindert Fehler bei fehlenden Einträgen) get_intensity_df <- function(crime_json, delikt, jahr = "2024", feld = "Erfasste Fälle") { do.call(rbind, lapply(names(crime_json), function(bezirk) { stadtteile <- crime_json[[bezirk]] @@ -95,7 +108,7 @@ get_intensity_df <- function(crime_json, delikt, jahr = "2024", feld = "Erfasste stadtteil = names(stadtteile), intensity = sapply(stadtteile, function(st) { - # sicherer Zugriff (verhindert Fehler bei fehlenden Einträgen) + val <- st[[delikt]][[jahr]][[feld]] if (is.null(val)) NA else val @@ -105,12 +118,14 @@ get_intensity_df <- function(crime_json, delikt, jahr = "2024", feld = "Erfasste })) } -#GeoJson for Bezirke +#GeoJson für Bezirke +#st_transform sorgt für die Umwandlung der Geo-Daten in das Standard-Koordinatensystem WGS 84, csr bedeutet Koordinatenreferenzsystem +#mit paste("bez_") bilden wir die jeweiligen Präfixe für Stadtteil und Bezirk, damit aufgrund dieses Merkmals die app die beiden Typen voneinander unterscheiden kann geo_bezirke <- st_read("geobezirke-parsed.json") geo_bezirke <- st_transform(geo_bezirke, crs = 4326) geo_bezirke$leaflet_id <- paste("bez_", geo_bezirke$bezirk, sep="") -#GeoJson for Stadtteile +#GeoJson für Stadtteile geo_stadtteile <- st_read("geostadtteile-parsed.json") geo_stadtteile <- st_transform(geo_stadtteile, crs = 4326) geo_stadtteile$leaflet_id <- paste("std_", geo_stadtteile$stadtteil, sep="") @@ -128,14 +143,16 @@ list_of_crimes <- sort(c(unique(unlist( use.names = FALSE )), "")) + +#map(names) wendet names() auf jedes Element der ersten Ebene, wie Bezirke ("A", "B", "C") an. +#Ergebnis: Eine Liste von Vektoren (z.B. list(c("aa1", "aa2"), c("bb1", "bb2"), c("cc1"))), hier: Stadtteile +#unlist() vereint alle diese Vektoren zu einem einzigen Vektor. +#Ergebnis: c("aa1", "aa2", "bb1", "bb2", "cc1") +#unique(): auf Nummer sicher gehen, dass die Stadtteile alle eindeutig sind. auswahlmöglichkeiten <- crime_json %>% - # 1. map(names) wendet names() auf jedes Element der ersten Ebene, wie Bezirke ("A", "B", "C") an. - # Ergebnis: Eine Liste von Vektoren (z.B. list(c("aa1", "aa2"), c("bb1", "bb2"), c("cc1"))), hier: Stadtteile + map(names) %>% - # 2. unlist() vereint alle diese Vektoren zu einem einzigen Vektor. - # Ergebnis: c("aa1", "aa2", "bb1", "bb2", "cc1") unlist() %>% - # 3. unique(): auf Nummer sicher gehen, dass die Stadtteile alle eindeutig sind. unique() %>% sort() %>% setdiff("Alle") \ No newline at end of file diff --git a/server.R b/server.R index 20f1a92..61315b9 100644 --- a/server.R +++ b/server.R @@ -7,7 +7,7 @@ get_map_layer_name <- function(text) { } -#Server handling user input and processing of data +#Server: Verarbeitung von Benutzereingaben und Daten server <- function(input, output, session) { currently_selected_bezirk <- reactiveVal("") currently_selected_stadtteil <- reactiveVal("") @@ -19,7 +19,7 @@ server <- function(input, output, session) { currently_compared_crimes <- reactiveVal(c("")) currently_compared_year <- reactiveVal(c("2024", "2023")) - # 1. Aktualisieren der Auswahlmöglichkeiten mit den extrahierten Schlüsselnamen + #Aktualisieren der Auswahlmöglichkeiten bei Änderungen in den Daten? updateSelectizeInput( session = session, inputId = "search", @@ -44,19 +44,25 @@ server <- function(input, output, session) { 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") - # 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)) %>% @@ -88,16 +94,15 @@ server <- function(input, output, session) { pal_legend <- colorNumeric( palette = "YlOrRd", domain = heatmap_polygons$intensity - )# Legende hinzufügen + ) addLegend(mapproxy, pal = pal_legend, opacity = 0.8, values = heatmap_polygons$intensity, title = paste("Fallzahlen:", heatmap), position = "bottomright", - layerId = "heatmap_legend" # Wichtig zum gezielten Entfernen + layerId = "heatmap_legend" ) - #--------------------- } else { if (maptype == "Bezirke"){ hideGroup(mapproxy, "layer_stadtteile") @@ -110,20 +115,21 @@ server <- function(input, output, session) { } }) + #Ü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 - # 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) @@ -140,7 +146,7 @@ server <- function(input, output, session) { 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( @@ -155,6 +161,14 @@ server <- function(input, output, session) { } }) + #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) %>% @@ -164,7 +178,7 @@ server <- function(input, output, session) { group = "layer_bezirke", label = get_map_layer_name(geo_bezirke$leaflet_id), color = "#003063", - fillOpacity = 0.2, # Polygon fill transparency + fillOpacity = 0.2, highlightOptions = highlightOptions( fillOpacity = 0.4, color = "#003063", @@ -178,9 +192,9 @@ server <- function(input, output, session) { 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 + options = pathOptions(pane = "overlayPane"), weight = 3, - fillOpacity = 0.2, # Polygon fill transparency + fillOpacity = 0.2, highlightOptions = highlightOptions( fillOpacity = 0.4, color = "#003063", @@ -198,13 +212,8 @@ server <- function(input, output, session) { output$txt_map_selection_bezirk <- renderUI({ bez <- currently_selected_bezirk() req(bez) - # tags$h5( - # style = "margin-top: 10px; margin-bottom: 2px; font-weight: 400;", - # tags$strong("Bezirk:"), - # tags$span(bez, style = "font-weight: 400;") - # ) - div(# Überschrift einfügen - style = "margin-top: 5px; margin-bottom: 0px; display: flex; align-items: center; gap: 8px;", # Ganz wenig Abstand zum nächsten Element + 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;") ) @@ -213,11 +222,6 @@ server <- function(input, output, session) { output$txt_map_selection_stadtteil <- renderUI({ sdt <- currently_selected_stadtteil() req(sdt) - # tags$h5( - # style = "margin-top: 0px; margin-bottom: 20px; font-weight: 400;", - # tags$strong("Stadtteil:"), - # tags$span(sdt, style = "font-weight: 400;") - # ) 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;"), @@ -225,6 +229,17 @@ server <- function(input, output, session) { ) }) + + + #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(), @@ -271,6 +286,12 @@ server <- function(input, output, session) { 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(),