Add table and fill with data from map selection

IT Shiny App.R

@@ -4,33 +4,60 @@ library(bslib)
 library(leaflet)
 library(sf)
 library(htmltools)
+library(dplyr)
+library(tidyr)
+library(purrr)
 
-
+# Json of Crime Reports
 crime_json <- fromJSON(file="data.json")
-#View(crime_json)
+get_bezirk_by_stadtteil <- function(name) {
+  parents <- names(crime_json)[sapply(crime_json, function(item) name %in% names(item))]
   
+  if (length(parents) == 0) return(NULL)
+  parents
+}
+
+map_data_to_table <- function(bezirk, stadtteil, year) {
+  year <- as.character(trimws(year))
+  map_df(names(crime_json[[bezirk]][[stadtteil]]), function(crime) {
+    row <- crime_json[[bezirk]][[stadtteil]][[crime]][[year]]
+    
+    tibble(
+      Name = crime,
+      `Erfasste Fälle`      = row[["Erfasste Fälle"]],
+      `Aufgeklärte Fälle`   = row[["Aufgeklärte Fälle"]],
+      `Aufklärung relativ`  = row[["Aufklärung relativ"]]
+    )
+  })
+}
+
+#GeoJson for Bezirke
 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
 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="")
 bezirke <- names(crime_json)
 
-ui <- page_fillable(
+
+#User interface definitions
+ui <- function() {
+  page_fillable(
     page_sidebar(
       layout_columns(
         leafletOutput("hhmap"),
         card(
-        textOutput("txt_map_selection"),
+          textOutput("txt_map_selection_bezirk"),
+          textOutput("txt_map_selection_stadtteil"),
           "2024",
           tableOutput("tbl_2024"),
           "2023",
           tableOutput("tbl_2023"),
         ),
-      col_widths = c(9, 3),
+        col_widths = c(7, 5),
       ),
       sidebar = sidebar(
         radioButtons(
@@ -50,26 +77,63 @@ ui <- page_fillable(
           choices = NULL,
         ),
       ),
+    ),
   )
-)
+}
+
+currently_selected_bezirk <- ""
+currently_selected_stadtteil <- ""
+
+get_map_layer_prefix <- function(text){
+  return(substring(text, 0, 4))
+}
+
+get_map_layer_name <- function(text) {
+  return(substring(text, 5))
+}
+
+update_selection_text <- function(output) {
+  output$txt_map_selection_bezirk <- renderText({
+    paste("Bezirk:", currently_selected_bezirk)
+  })
+  output$txt_map_selection_stadtteil <- renderText({
+    paste("Stadtteil:", currently_selected_stadtteil)
+  })
+}
+
+update_selection_table <- function(output) {
+  output$tbl_2024 <- renderTable(
+    map_data_to_table(
+      bezirk = currently_selected_bezirk,
+      stadtteil = currently_selected_stadtteil,
+      year = "2024"
+    ),
+    striped = TRUE
+  )
+  output$tbl_2023 <- renderTable(
+    map_data_to_table(
+      bezirk = currently_selected_bezirk,
+      stadtteil = currently_selected_stadtteil,
+      year = "2023"
+    ),
+    striped = TRUE
+  )
+}
+
+#Server handling user input and processing of data
 server <- function(input, output, session){
   
   observeEvent(input$drp_bezirk, {
     sel_bezirk <- input$drp_bezirk
     
     if (sel_bezirk != "") {
-      
-      # Neue Auswahlmöglichkeiten bestimmen
       sel_stadtteile <- names(crime_json[[sel_bezirk]])
-      
-      # Zweites SelectInput-Feld aktualisieren
       updateSelectInput(
         session, 
         inputId = "drp_stadtteil", 
         choices = sel_stadtteile,
-        selected = sel_stadtteile[1] # Wählt den ersten Eintrag vor
+        selected = sel_stadtteile[1]
       )
-      
     }
   })
   
@@ -84,7 +148,6 @@ server <- function(input, output, session){
     else {
       hideGroup(mapproxy, "layer_bezirke")
       showGroup(mapproxy, "layer_stadtteile")
-      
     }
   })
   
@@ -95,10 +158,18 @@ server <- function(input, output, session){
       
       # The ID of the clicked polygon
       clicked_polygon_id <- click_event$id
-      output$txt_map_selection <- renderText({
+      prefix <- get_map_layer_prefix(clicked_polygon_id)
-        clicked_polygon_id
+      rest_of_name <- get_map_layer_name(clicked_polygon_id)
-      })
+      if (prefix == "bez_") {
-      print(paste("Polygon with ID", clicked_polygon_id, "was clicked."))
+        currently_selected_bezirk <<- rest_of_name
+        currently_selected_stadtteil <<- "Alle"
+      }
+      if(prefix == "std_") {
+        currently_selected_bezirk <<- get_bezirk_by_stadtteil(rest_of_name)
+        currently_selected_stadtteil <<- rest_of_name
+      }
+      update_selection_text(output)
+      update_selection_table(output)
     }
   })
   
@@ -141,20 +212,7 @@ server <- function(input, output, session){
         zoom = 11
       )
   })
-
+  update_selection_text(output)
-  Names = c("Raub", "Diebstahl", "BtMG")
-  Faelle = c(1234, 5678, 9000)
-  Aufgeklaert = c(687867, 768789, 658)
-  Relativ = c("15%", "70%", "69%")
-  fake_data <- data.frame(
-    Name = Names,
-    Faelle = Faelle,
-    Aufgeklärt = Aufgeklaert,
-    Relativ = Relativ,
-    stringsAsFactors = FALSE
-  )
-  output$tbl_2024 <- renderTable(fake_data, striped = TRUE)
-  output$tbl_2023 <- renderTable(fake_data, striped = TRUE)
 }
 options(shiny.host = '0.0.0.0')
 options(shiny.port = 8888)