Cleanup and add search functionality
This commit is contained in:
112
IT Shiny App.R
112
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
|
||||
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)
|
||||
|
||||
Reference in New Issue
Block a user