diff --git a/IT Shiny App.R b/IT Shiny App.R index 4c36e1e..c9f509a 100644 --- a/IT Shiny App.R +++ b/IT Shiny App.R @@ -1,7 +1,6 @@ library(rjson) library(shiny) library(bslib) -library(leaflet) library(sf) library(htmltools) library(dplyr) @@ -41,42 +40,89 @@ geo_stadtteile <- st_transform(geo_stadtteile, crs = 4326) geo_stadtteile$leaflet_id <- paste("std_", geo_stadtteile$stadtteil, sep="") bezirke <- sort(names(crime_json)) +auswahlmöglichkeiten <- crime_json %>% + # 1. map(names) wendet names() auf jedes Element der ersten Ebene, wie Bezirke ("A", "B", "C") an. + # Ergebnis: Eine Liste von Vektoren (z.B. list(c("aa1", "aa2"), c("bb1", "bb2"), c("cc1"))), hier: Stadtteile + map(names) %>% + # 2. unlist() vereint alle diese Vektoren zu einem einzigen Vektor. + # Ergebnis: c("aa1", "aa2", "bb1", "bb2", "cc1") + unlist() %>% + # 3. unique(): auf Nummer sicher gehen, dass die Stadtteile alle eindeutig sind. + unique() %>% + sort() #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), + navset_card_tab( + nav_panel("Karte", + 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), + ), + sidebar = sidebar( + radioButtons( + inputId = "rd_maptype", + label = "Kartentyp", + choices = c("Bezirke", "Stadtteile"), + selected = "Bezirke" + ), + ###selectizeInput ist was wir wollen, wahrscheinlich + selectizeInput( + inputId = "search", + label = "Wählen Sie ein Feld (Schlüssel) aus:", + choices = NULL, + selected = NULL, + multiple = FALSE, # Hier wahrscheinlich nur Einzelauswahl gewünscht + options = list( + placeholder = 'Wählen Sie einen Schlüssel (z.B. tags)...' + ) + ) + # 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, - ), + nav_panel("Statistik", "Statistik_inhalt"), + nav_panel("Wiki", + accordion( + accordion_panel( + title = "Diebstahl", + #icon = + "Unter Diebstahl sind alle Diebsthal-Delikte nach §239." + ), + accordion_panel( + title = "Gewaltkriminalität", + #icon = + "Gewaltkriminalität ist doof." + ), + accordion_panel( + title = "Was ganz langes.", + #icon + "Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet." + ) + ) ), - ), + id = "tab" + ) + ) } @@ -122,6 +168,14 @@ update_selection_table <- function(output) { #Server handling user input and processing of data server <- function(input, output, session){ + # 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 + ) + observeEvent(input$drp_bezirk, { sel_bezirk <- input$drp_bezirk @@ -168,12 +222,14 @@ 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 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 <<- paste("Bezirk", rest_of_name) @@ -182,9 +238,22 @@ server <- function(input, output, session){ 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") %>% + clearGroup("selected") %>% + addPolygons( + data = geo_bezirke[geo_bezirke[["leaflet_id"]] == click_event$id, ], + layerId = id, + fillColor = "#51968b", + color = "#7bb5ab", + fillOpacity = 0.1, + weight = 4, + group = "selected" + ) + update_selection_text(output) update_selection_table(output) - } + #} }) output$hhmap <- renderLeaflet({ @@ -195,8 +264,6 @@ server <- function(input, output, session){ layerId = ~leaflet_id, group = "layer_bezirke", color = "#7bb5ab", - fillColor = "#bdf0e7", - weight = 1, fillOpacity = 0.4, # Polygon fill transparency highlightOptions = highlightOptions( color = "#103b57", @@ -211,7 +278,7 @@ server <- function(input, output, session){ color = "#7bb5ab", fillColor = "#bdf0e7", options = pathOptions(pane = "overlayPane"), # Use a leaflet option to ensure it's hidden - weight = 1, + weight = 4, fillOpacity = 0.4, # Polygon fill transparency highlightOptions = highlightOptions( color = "#103b57",