From 6f73d8d22cac9263ca3642b5bb5bf6916b03ba7d Mon Sep 17 00:00:00 2001 From: C0d3v Date: Mon, 8 Dec 2025 15:32:53 +0100 Subject: [PATCH] Add table and fill with data from map selection --- IT Shiny App.R | 172 +++++++++++++++++++++++++++++++++---------------- 1 file changed, 115 insertions(+), 57 deletions(-) diff --git a/IT Shiny App.R b/IT Shiny App.R index 232ba19..841dea1 100644 --- a/IT Shiny App.R +++ b/IT Shiny App.R @@ -4,72 +4,136 @@ 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( - page_sidebar( - layout_columns( - leafletOutput("hhmap"), - card( - textOutput("txt_map_selection"), - "2024", - tableOutput("tbl_2024"), - "2023", - tableOutput("tbl_2023"), + +#User interface definitions +ui <- function() { + page_fillable( + page_sidebar( + layout_columns( + leafletOutput("hhmap"), + card( + textOutput("txt_map_selection_bezirk"), + textOutput("txt_map_selection_stadtteil"), + "2024", + tableOutput("tbl_2024"), + "2023", + tableOutput("tbl_2023"), + ), + col_widths = c(7, 5), ), - col_widths = c(9, 3), - ), - sidebar = sidebar( - radioButtons( - inputId = "rd_maptype", - label = "Kartentyp", - choices = c("Bezirke", "Stadtteile"), - selected = "Bezirke" - ), - selectInput( - inputId = "drp_bezirk", - label = "Bezirk", - choices = bezirke - ), - selectInput( - inputId = "drp_stadtteil", - label = "Stadtteil", - choices = NULL, + sidebar = sidebar( + radioButtons( + inputId = "rd_maptype", + label = "Kartentyp", + choices = c("Bezirke", "Stadtteile"), + selected = "Bezirke" + ), + selectInput( + inputId = "drp_bezirk", + label = "Bezirk", + choices = bezirke + ), + selectInput( + inputId = "drp_stadtteil", + label = "Stadtteil", + 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({ - clicked_polygon_id - }) - print(paste("Polygon with ID", clicked_polygon_id, "was clicked.")) + prefix <- get_map_layer_prefix(clicked_polygon_id) + rest_of_name <- get_map_layer_name(clicked_polygon_id) + if (prefix == "bez_") { + 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 ) }) - - 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) + update_selection_text(output) } options(shiny.host = '0.0.0.0') options(shiny.port = 8888)