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(shiny)
library(bslib)
library(leaflet)
library(sf)
library(htmltools)
library(dplyr)
@@ -64,8 +65,6 @@ ui <- function() {
textOutput("txt_map_selection_stadtteil"),
"2024",
tableOutput("tbl_2024"),
#"2023",
#tableOutput("tbl_2023"),
),
col_widths = c(7, 5),
),
@@ -84,19 +83,9 @@ ui <- function() {
selected = NULL,
multiple = FALSE, # Hier wahrscheinlich nur Einzelauswahl gewünscht
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"
)
)
}
currently_selected_bezirk <- ""
currently_selected_stadtteil <- ""
get_map_layer_prefix <- function(text){
return(substring(text, 0, 4))
@@ -137,72 +123,24 @@ 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){
server <- function(input, output, session) {
currently_selected_bezirk <- reactiveVal("")
currently_selected_stadtteil <- reactiveVal("")
# 1. Aktualisieren der Auswahlmöglichkeiten mit den extrahierten Schlüsselnamen
updateSelectizeInput(
session = session,
inputId = "search",
choices = auswahlmöglichkeiten,
server = FALSE # Da die Liste sehr kurz ist, server=FALSE oder weglassen
selected = ""
)
observeEvent(input$drp_bezirk, {
sel_bezirk <- input$drp_bezirk
if (sel_bezirk != "") {
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$search, {
req(input$search)
currently_selected_bezirk(get_bezirk_by_stadtteil(input$search))
currently_selected_stadtteil(input$search)
})
observeEvent(input$rd_maptype, {
@@ -222,7 +160,7 @@ server <- function(input, output, session){
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 (!is.null(click_event$id)) {
# The ID of the clicked polygon
clicked_polygon_id <- click_event$id
@@ -231,12 +169,12 @@ server <- function(input, output, session){
if (prefix == "bez_") {
currently_selected_bezirk <<- rest_of_name
currently_selected_stadtteil <<- paste("Bezirk", rest_of_name)
currently_selected_bezirk(rest_of_name)
currently_selected_stadtteil(paste("Bezirk", rest_of_name))
}
if(prefix == "std_") {
currently_selected_bezirk <<- get_bezirk_by_stadtteil(rest_of_name)
currently_selected_stadtteil <<- rest_of_name
currently_selected_bezirk(get_bezirk_by_stadtteil(rest_of_name))
currently_selected_stadtteil(rest_of_name)
}
#neues Polygon über die anderen legen, wenn ein bezirk angeklickt wurde
leafletProxy("hhmap") %>%
@@ -250,10 +188,7 @@ server <- function(input, output, session){
weight = 4,
group = "selected"
)
update_selection_text(output)
update_selection_table(output)
#}
}
})
output$hhmap <- renderLeaflet({
@@ -293,7 +228,20 @@ server <- function(input, output, session){
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.port = 8888)