Move project into different files
This commit is contained in:
233
server.R
Normal file
233
server.R
Normal file
@@ -0,0 +1,233 @@
|
||||
get_map_layer_prefix <- function(text){
|
||||
return(substring(text, 0, 4))
|
||||
}
|
||||
|
||||
get_map_layer_name <- function(text) {
|
||||
return(substring(text, 5))
|
||||
}
|
||||
|
||||
|
||||
#Server handling user input and processing of data
|
||||
server <- function(input, output, session) {
|
||||
currently_selected_bezirk <- reactiveVal("")
|
||||
currently_selected_stadtteil <- reactiveVal("")
|
||||
currently_selected_maptype <- reactiveVal("Bezirke")
|
||||
currently_selected_heatmap_crime <- reactiveVal("Allgemeine Verstöße gem. § 29 BtMG -Konsumentendelikte-")
|
||||
|
||||
# 1. Aktualisieren der Auswahlmöglichkeiten mit den extrahierten Schlüsselnamen
|
||||
updateSelectizeInput(
|
||||
session = session,
|
||||
inputId = "search",
|
||||
choices = auswahlmöglichkeiten,
|
||||
selected = ""
|
||||
)
|
||||
|
||||
observeEvent(input$search, {
|
||||
req(input$search)
|
||||
currently_selected_bezirk(get_bezirk_by_stadtteil(input$search))
|
||||
currently_selected_stadtteil(input$search)
|
||||
})
|
||||
observeEvent(input$heatmap, {
|
||||
currently_selected_heatmap_crime(input$heatmap)
|
||||
})
|
||||
|
||||
observeEvent(input$rd_maptype, {
|
||||
currently_selected_maptype(input$rd_maptype)
|
||||
})
|
||||
|
||||
observe({
|
||||
maptype <- currently_selected_maptype()
|
||||
heatmap <- currently_selected_heatmap_crime()
|
||||
mapproxy <- leafletProxy("hhmap")
|
||||
clearGroup(mapproxy, "selected")
|
||||
if (heatmap != "") {
|
||||
hideGroup(mapproxy, "layer_bezirke")
|
||||
hideGroup(mapproxy, "layer_stadtteile")
|
||||
#---Create heatmap----
|
||||
heatmap_polygons <- if(maptype == "Bezirke") {
|
||||
geo_bezirke %>%
|
||||
mutate(bezirke_join = paste("Bezirk", bezirk)) %>%
|
||||
left_join(get_intensity_df(crime_json, heatmap), by = c("bezirke_join" = "stadtteil"))
|
||||
} else {
|
||||
geo_stadtteile %>%
|
||||
left_join(get_intensity_df(crime_json, heatmap), by = "stadtteil")
|
||||
}
|
||||
pal <- colorNumeric(
|
||||
palette = "YlOrRd",
|
||||
domain = heatmap_polygons$intensity,
|
||||
na.color = "transparent"
|
||||
)
|
||||
addPolygons(mapproxy,
|
||||
data = heatmap_polygons,
|
||||
layerId = ~leaflet_id,
|
||||
group = "layer_heatmap",
|
||||
label = get_map_layer_name(heatmap_polygons$leaflet_id),
|
||||
color = "#003063",
|
||||
fillColor = ~pal(heatmap_polygons$intensity),
|
||||
weight = 3,
|
||||
fillOpacity = 0.8
|
||||
)
|
||||
#---------------------
|
||||
} else {
|
||||
print("he")
|
||||
clearGroup(mapproxy, "layer_heatmap")
|
||||
if (maptype == "Bezirke"){
|
||||
hideGroup(mapproxy, "layer_stadtteile")
|
||||
showGroup(mapproxy, "layer_bezirke")
|
||||
print("ho")
|
||||
}
|
||||
else {
|
||||
hideGroup(mapproxy, "layer_bezirke")
|
||||
showGroup(mapproxy, "layer_stadtteile")
|
||||
print("hey")
|
||||
}
|
||||
}
|
||||
})
|
||||
|
||||
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)) {
|
||||
|
||||
# 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)
|
||||
|
||||
selected_polygon_data <- NULL
|
||||
if (prefix == "bez_") {
|
||||
currently_selected_bezirk(rest_of_name)
|
||||
currently_selected_stadtteil(paste("Bezirk", rest_of_name))
|
||||
selected_polygon_data <- geo_bezirke[geo_bezirke[["leaflet_id"]] == click_event$id,]
|
||||
}
|
||||
if(prefix == "std_") {
|
||||
currently_selected_bezirk(get_bezirk_by_stadtteil(rest_of_name))
|
||||
currently_selected_stadtteil(rest_of_name)
|
||||
selected_polygon_data <- geo_stadtteile[geo_stadtteile[["leaflet_id"]] == click_event$id,]
|
||||
}
|
||||
req(selected_polygon_data)
|
||||
#neues Polygon über die anderen legen, wenn ein bezirk angeklickt wurde
|
||||
leafletProxy("hhmap") %>%
|
||||
clearGroup("selected") %>%
|
||||
addPolygons(
|
||||
data = selected_polygon_data,
|
||||
layerId = id,
|
||||
label = selected_polygon_data$bezirk,
|
||||
color = "#003063",
|
||||
fillOpacity = 0.2,
|
||||
weight = 4,
|
||||
group = "selected"
|
||||
)
|
||||
}
|
||||
})
|
||||
|
||||
output$hhmap <- renderLeaflet({
|
||||
leaflet() %>%
|
||||
addProviderTiles(providers$CartoDB.Positron) %>%
|
||||
addPolygons(
|
||||
data = geo_bezirke,
|
||||
layerId = ~leaflet_id,
|
||||
group = "layer_bezirke",
|
||||
label = get_map_layer_name(geo_bezirke$leaflet_id),
|
||||
color = "#003063",
|
||||
fillOpacity = 0.2, # Polygon fill transparency
|
||||
highlightOptions = highlightOptions(
|
||||
fillOpacity = 0.4,
|
||||
color = "#003063",
|
||||
weight = 4,
|
||||
bringToFront = TRUE
|
||||
),
|
||||
) %>%
|
||||
addPolygons(
|
||||
data = geo_stadtteile,
|
||||
group = "layer_stadtteile",
|
||||
label = get_map_layer_name(geo_stadtteile$leaflet_id),
|
||||
layerId = ~leaflet_id,
|
||||
color = "#003063",
|
||||
options = pathOptions(pane = "overlayPane"), # Use a leaflet option to ensure it's hidden
|
||||
weight = 3,
|
||||
fillOpacity = 0.2, # Polygon fill transparency
|
||||
highlightOptions = highlightOptions(
|
||||
fillOpacity = 0.4,
|
||||
color = "#003063",
|
||||
weight = 4,
|
||||
bringToFront = TRUE
|
||||
),
|
||||
) %>%
|
||||
|
||||
setView(
|
||||
lng = 9.98716634776887,
|
||||
lat = 53.5488439196432,
|
||||
zoom = 11
|
||||
)
|
||||
})
|
||||
output$txt_map_selection_bezirk <- renderText({
|
||||
currently_selected_bezirk()
|
||||
})
|
||||
output$txt_map_selection_stadtteil <- renderText({
|
||||
currently_selected_stadtteil()
|
||||
})
|
||||
output$grph_top3 <- renderPlot({
|
||||
data_tibble <- map_data_to_top3_plot(
|
||||
bezirk = currently_selected_bezirk(),
|
||||
stadtteil = currently_selected_stadtteil(),
|
||||
year = "2024"
|
||||
)
|
||||
req(nrow(data_tibble) > 0)
|
||||
ggplot(data_tibble, aes(x = Name, y = Erfasst)) +
|
||||
geom_col(width = 0.7, fill = "#e10019") + # <-- Festlegen der Farbe direkt an allen Spalten angeknüpft nicht mehr anhand der Kategorie
|
||||
geom_text(
|
||||
# Die Text-Ästhetik soll der Wert aus der Spalte 'Erfasst' sein
|
||||
aes(label = format(Erfasst, big.mark = ".", decimal.mark = ",")),
|
||||
# Platzierung: Y-Wert des Textes = Wert der Spalte + Offset
|
||||
# Wir verwenden den Offset, um den Text knapp über den Balken zu platzieren
|
||||
# Wenn Sie den Text IN den Balken setzen möchten, setzen Sie y=Erfasst/2
|
||||
vjust = -0.5, # Vertikale Ausrichtung: Negativer Wert platziert Text über dem Punkt
|
||||
size = 4,
|
||||
fontface = "bold"
|
||||
) +
|
||||
labs(
|
||||
title = "Statistisch am häufigsten polizeilich registrierte Straftaten",
|
||||
x = "Straftatbestand",
|
||||
y = "Anzahl erfasster Fälle"
|
||||
) +
|
||||
theme_pander() + #neues theme aus ggthemes packages
|
||||
# NEUE ANPASSUNG: Drehen der X-Achsen-Beschriftungen
|
||||
theme(
|
||||
plot.background = element_rect(
|
||||
color = "darkgrey", # Farbe des Rahmens
|
||||
linewidth = 0.4, # Dicke des Rahmens
|
||||
fill = NA # Füllung: NA = transparent
|
||||
),
|
||||
plot.margin = margin(t = 20, r = 20, b = 20, l = 20, unit = "pt"),
|
||||
legend.position = "none",
|
||||
panel.grid.major.x = element_blank(),
|
||||
panel.grid.minor.x = element_blank(), # vertikale grid lines entfernen
|
||||
# X-Achsen-Titel (z.B. "Straftatbestand")
|
||||
axis.title.x = element_text(
|
||||
face = "bold",
|
||||
family = "sans",
|
||||
# Fügen Sie hier einen Abstand nach OBEN hinzu
|
||||
margin = margin(t = 15) # t = top (oben) in Pixeln
|
||||
),
|
||||
|
||||
# Y-Achsen-Titel (z.B. "Anzahl erfasster Fälle")
|
||||
axis.title.y = element_text(
|
||||
face = "bold",
|
||||
family = "sans",
|
||||
# Fügen Sie hier einen Abstand nach RECHTS hinzu
|
||||
margin = margin(r = 15) # r = right (rechts) in Pixeln
|
||||
),
|
||||
)
|
||||
|
||||
}, res = 100)
|
||||
|
||||
output$tbl_2024 <- renderTable(
|
||||
map_data_to_table(
|
||||
bezirk = currently_selected_bezirk(),
|
||||
stadtteil = currently_selected_stadtteil(),
|
||||
year = "2024"
|
||||
),
|
||||
striped = TRUE
|
||||
)
|
||||
}
|
||||
Reference in New Issue
Block a user