Cleanup and add search functionality

This commit is contained in:
2025-12-14 12:39:20 +01:00
parent 3d8ab2d70f
commit 361c56fa36

View File

@@ -1,6 +1,7 @@
library(rjson) library(rjson)
library(shiny) library(shiny)
library(bslib) library(bslib)
library(leaflet)
library(sf) library(sf)
library(htmltools) library(htmltools)
library(dplyr) library(dplyr)
@@ -64,8 +65,6 @@ ui <- function() {
textOutput("txt_map_selection_stadtteil"), textOutput("txt_map_selection_stadtteil"),
"2024", "2024",
tableOutput("tbl_2024"), tableOutput("tbl_2024"),
#"2023",
#tableOutput("tbl_2023"),
), ),
col_widths = c(7, 5), col_widths = c(7, 5),
), ),
@@ -84,19 +83,9 @@ ui <- function() {
selected = NULL, selected = NULL,
multiple = FALSE, # Hier wahrscheinlich nur Einzelauswahl gewünscht multiple = FALSE, # Hier wahrscheinlich nur Einzelauswahl gewünscht
options = list( options = list(
placeholder = 'Wählen Sie einen Schlüssel (z.B. tags)...' placeholder = "Start typing..."
) )
) )
# selectInput(
# inputId = "drp_bezirk",
# label = "Bezirk",
# choices = bezirke
# ),
# selectInput(
# inputId = "drp_stadtteil",
# label = "Stadtteil",
# choices = NULL,
# ),
), ),
) )
), ),
@@ -122,12 +111,9 @@ ui <- function() {
), ),
id = "tab" id = "tab"
) )
) )
} }
currently_selected_bezirk <- ""
currently_selected_stadtteil <- ""
get_map_layer_prefix <- function(text){ get_map_layer_prefix <- function(text){
return(substring(text, 0, 4)) return(substring(text, 0, 4))
@@ -137,72 +123,24 @@ get_map_layer_name <- function(text) {
return(substring(text, 5)) 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 handling user input and processing of data
server <- function(input, output, session) { server <- function(input, output, session) {
currently_selected_bezirk <- reactiveVal("")
currently_selected_stadtteil <- reactiveVal("")
# 1. Aktualisieren der Auswahlmöglichkeiten mit den extrahierten Schlüsselnamen # 1. Aktualisieren der Auswahlmöglichkeiten mit den extrahierten Schlüsselnamen
updateSelectizeInput( updateSelectizeInput(
session = session, session = session,
inputId = "search", inputId = "search",
choices = auswahlmöglichkeiten, choices = auswahlmöglichkeiten,
server = FALSE # Da die Liste sehr kurz ist, server=FALSE oder weglassen selected = ""
) )
observeEvent(input$drp_bezirk, { observeEvent(input$search, {
sel_bezirk <- input$drp_bezirk req(input$search)
currently_selected_bezirk(get_bezirk_by_stadtteil(input$search))
if (sel_bezirk != "") { currently_selected_stadtteil(input$search)
sel_stadtteile <- names(crime_json[[sel_bezirk]])
selected_stadtteil <- paste("Bezirk", sel_bezirk)
updateSelectInput(
session,
inputId = "drp_stadtteil",
choices = sort(sel_stadtteile),
selected = selected_stadtteil,
)
currently_selected_bezirk <<- sel_bezirk
currently_selected_stadtteil <<- selected_stadtteil
update_selection_text(output)
update_selection_table(output)
}
})
observeEvent(input$drp_stadtteil, {
sel_stadtteil <- input$drp_stadtteil
if (sel_stadtteil != "") {
currently_selected_stadtteil <<- sel_stadtteil
update_selection_text(output)
update_selection_table(output)
}
}) })
observeEvent(input$rd_maptype, { observeEvent(input$rd_maptype, {
@@ -222,7 +160,7 @@ server <- function(input, output, session){
observeEvent(input$hhmap_shape_click, { observeEvent(input$hhmap_shape_click, {
click_event <- input$hhmap_shape_click click_event <- input$hhmap_shape_click
# Check if an ID was returned (meaning a polygon was clicked) # Check if an ID was returned (meaning a polygon was clicked)
#if (!is.null(click_event$id)) { if (!is.null(click_event$id)) {
# The ID of the clicked polygon # The ID of the clicked polygon
clicked_polygon_id <- click_event$id clicked_polygon_id <- click_event$id
@@ -231,12 +169,12 @@ server <- function(input, output, session){
if (prefix == "bez_") { if (prefix == "bez_") {
currently_selected_bezirk <<- rest_of_name currently_selected_bezirk(rest_of_name)
currently_selected_stadtteil <<- paste("Bezirk", rest_of_name) currently_selected_stadtteil(paste("Bezirk", rest_of_name))
} }
if(prefix == "std_") { if(prefix == "std_") {
currently_selected_bezirk <<- get_bezirk_by_stadtteil(rest_of_name) currently_selected_bezirk(get_bezirk_by_stadtteil(rest_of_name))
currently_selected_stadtteil <<- rest_of_name currently_selected_stadtteil(rest_of_name)
} }
#neues Polygon über die anderen legen, wenn ein bezirk angeklickt wurde #neues Polygon über die anderen legen, wenn ein bezirk angeklickt wurde
leafletProxy("hhmap") %>% leafletProxy("hhmap") %>%
@@ -250,10 +188,7 @@ server <- function(input, output, session){
weight = 4, weight = 4,
group = "selected" group = "selected"
) )
}
update_selection_text(output)
update_selection_table(output)
#}
}) })
output$hhmap <- renderLeaflet({ output$hhmap <- renderLeaflet({
@@ -293,7 +228,20 @@ server <- function(input, output, session){
zoom = 11 zoom = 11
) )
}) })
update_selection_text(output) output$txt_map_selection_bezirk <- renderText({
paste("Bezirk:", currently_selected_bezirk())
})
output$txt_map_selection_stadtteil <- renderText({
paste("Stadtteil:", currently_selected_stadtteil())
})
output$tbl_2024 <- renderTable(
map_data_to_table(
bezirk = currently_selected_bezirk(),
stadtteil = currently_selected_stadtteil(),
year = "2024"
),
striped = TRUE
)
} }
options(shiny.host = '0.0.0.0') options(shiny.host = '0.0.0.0')
options(shiny.port = 8888) options(shiny.port = 8888)