diff --git a/IT Shiny App.R b/IT Shiny App.R index c9f509a..0bfe279 100644 --- a/IT Shiny App.R +++ b/IT Shiny App.R @@ -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 + choices = auswahlmöglichkeiten, + 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)