Move project into different files
This commit is contained in:
387
IT Shiny App.R
387
IT Shiny App.R
@@ -1,4 +1,3 @@
|
||||
library(rjson)
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(leaflet)
|
||||
@@ -10,391 +9,11 @@ library(ggplot2)
|
||||
library(ggthemes)
|
||||
library(stringr)
|
||||
|
||||
# Json of Crime Reports
|
||||
crime_json <- fromJSON(file="data.json")
|
||||
get_bezirk_by_stadtteil <- function(name) {
|
||||
parents <- names(crime_json)[sapply(crime_json, function(item) name %in% names(item))]
|
||||
|
||||
if (length(parents) == 0) return(NULL)
|
||||
parents
|
||||
}
|
||||
|
||||
map_data_to_table <- function(bezirk, stadtteil, year) {
|
||||
year <- as.character(trimws(year))
|
||||
map_df(names(crime_json[[bezirk]][[stadtteil]]), function(crime) {
|
||||
row <- crime_json[[bezirk]][[stadtteil]][[crime]][[year]]
|
||||
|
||||
tibble(
|
||||
Name = crime,
|
||||
`Erfasste Fälle` = as.integer(row[["Erfasste Fälle"]]),
|
||||
`Aufgeklärte Fälle` = as.integer(row[["Aufgeklärte Fälle"]]),
|
||||
`Aufklärung relativ` = paste(row[["Aufklärung relativ"]], "%", sep=""),
|
||||
)
|
||||
})
|
||||
}
|
||||
|
||||
map_data_to_top3_plot <- function(bezirk, stadtteil, year) {
|
||||
year <- as.character(trimws(year))
|
||||
req(bezirk)
|
||||
req(stadtteil)
|
||||
req(year)
|
||||
komplettes_tibble <- map_df(names(crime_json[[bezirk]][[stadtteil]]), function(crime) {
|
||||
row <- crime_json[[bezirk]][[stadtteil]][[crime]][[year]]
|
||||
tibble(
|
||||
Name = str_wrap(crime, width = 25),
|
||||
Erfasst = as.integer(row[["Erfasste Fälle"]]),
|
||||
)
|
||||
})
|
||||
# Sortieren und Beschränken auf die Ränge 2, 3 und 4
|
||||
top_3_tibble <- komplettes_tibble %>%
|
||||
# Sortieren: Absteigend nach "Erfasste Fälle". Der höchste Wert ist nun in Zeile 1.
|
||||
arrange(desc(Erfasst)) %>%
|
||||
# Beschränken: Wählt die Zeilen 2, 3 und 4 aus.
|
||||
# Dies sind die Ränge 2, 3 und 4.
|
||||
slice(2:4)
|
||||
|
||||
return(top_3_tibble)
|
||||
}
|
||||
|
||||
#GeoJson for Bezirke
|
||||
geo_bezirke <- st_read("geobezirke-parsed.json")
|
||||
geo_bezirke <- st_transform(geo_bezirke, crs = 4326)
|
||||
geo_bezirke$leaflet_id <- paste("bez_", geo_bezirke$bezirk, sep="")
|
||||
|
||||
#GeoJson for Stadtteile
|
||||
geo_stadtteile <- st_read("geostadtteile-parsed.json")
|
||||
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(
|
||||
h1("Kriminalstatistik Hamburg",
|
||||
style = "color: #003063; font-weight: bold;",
|
||||
class = "ms-4 display-4"),# ms-4 sorgt für den Abstand links
|
||||
navset_card_tab(
|
||||
nav_panel("Karte",
|
||||
page_sidebar(
|
||||
layout_columns(
|
||||
leafletOutput("hhmap"),
|
||||
card(
|
||||
div(
|
||||
# h3 oder div dient als Block-Element und richtet seinen Inhalt (das span) rechtsbündig aus
|
||||
style = "text-align: right; width: 100%; ",
|
||||
|
||||
# Der Text wird in ein span verpackt und erhält die Border.
|
||||
# Ein span nimmt nur den Platz ein, den der Inhalt benötigt (inline).
|
||||
tags$span(
|
||||
"2024",
|
||||
style = "
|
||||
border: 1px solid rgba(40,70,94,0.1);
|
||||
border-radius: 5px;
|
||||
padding: 5px 10px 5px 10px;
|
||||
background-color: #eeeeee;
|
||||
"
|
||||
# padding ist der abstand an leerer Fläche in der reihenfolge top right bottom left
|
||||
# farbe rgba ist die exakte Farbe der Trennlinien und Card-Umrandungen aus der App
|
||||
)
|
||||
),
|
||||
div(
|
||||
class = "d-flex align-items-end gap-2",
|
||||
h5(strong("Bezirk:"), style = "margin-bottom: 0;"),
|
||||
textOutput("txt_map_selection_bezirk"),
|
||||
),
|
||||
div(
|
||||
class = "d-flex align-items-end gap-2",
|
||||
h5(strong("Stadtteil:"), style = "margin-bottom: 0;"),
|
||||
textOutput("txt_map_selection_stadtteil"),
|
||||
),
|
||||
plotOutput("grph_top3"),
|
||||
#tableOutput("tbl_2024"),
|
||||
),
|
||||
col_widths = c(8, 4),
|
||||
),
|
||||
sidebar = sidebar(
|
||||
radioButtons(
|
||||
inputId = "rd_maptype",
|
||||
label = "Kartentyp",
|
||||
choices = c("Bezirke", "Stadtteile"),
|
||||
selected = "Bezirke"
|
||||
),
|
||||
selectizeInput(
|
||||
inputId = "search",
|
||||
label = tags$span(icon("search"),"Suche"),
|
||||
choices = NULL,
|
||||
selected = NULL,
|
||||
multiple = FALSE, # Hier wahrscheinlich nur Einzelauswahl gewünscht
|
||||
options = list(
|
||||
placeholder = "Anfangen zu tippen...",
|
||||
openOnFocus = FALSE,
|
||||
allowEmptyOption = TRUE,
|
||||
selectOnTab = FALSE
|
||||
)
|
||||
)
|
||||
),
|
||||
)
|
||||
),
|
||||
nav_panel("Vergleich",
|
||||
layout_sidebar(
|
||||
sidebar = sidebar(
|
||||
title = "Vergleichs-Optionen",
|
||||
radioButtons(
|
||||
"vergleichs_modus",
|
||||
"Wählen Sie den Vergleichstyp:",
|
||||
choices = c(
|
||||
"Straftat vs. Orte" = "ort_vergleich",
|
||||
"Ort vs. Straftaten" = "straftat_vergleich"
|
||||
),
|
||||
selected = "ort_vergleich"
|
||||
),
|
||||
|
||||
tags$hr(),
|
||||
|
||||
# 2. Dynamische Input-Felder für die Orte und Straftaten
|
||||
uiOutput("vergleichs_inputs"),
|
||||
|
||||
# 3. Gemeinsamer Input: Das Jahr
|
||||
selectizeInput(
|
||||
"vergleichs_jahr",
|
||||
"Jahr wählen:",
|
||||
choices = c(2024, 2023),
|
||||
selected = 2024
|
||||
),
|
||||
),
|
||||
card(
|
||||
card_header(uiOutput("vergleichs_titel")), # Dynamischer Titel
|
||||
plotOutput("vergleichs_plot")
|
||||
)
|
||||
)
|
||||
),
|
||||
|
||||
|
||||
|
||||
|
||||
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"
|
||||
)
|
||||
)
|
||||
}
|
||||
source("global.R")
|
||||
source("ui.R")
|
||||
source("server.R")
|
||||
|
||||
|
||||
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("")
|
||||
|
||||
# 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$rd_maptype, {
|
||||
maptype <- input$rd_maptype
|
||||
mapproxy <- leafletProxy("hhmap")
|
||||
clearGroup(mapproxy, "selected")
|
||||
|
||||
if (maptype == "Bezirke"){
|
||||
hideGroup(mapproxy, "layer_stadtteile")
|
||||
showGroup(mapproxy, "layer_bezirke")
|
||||
}
|
||||
else {
|
||||
hideGroup(mapproxy, "layer_bezirke")
|
||||
showGroup(mapproxy, "layer_stadtteile")
|
||||
}
|
||||
})
|
||||
|
||||
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,
|
||||
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",
|
||||
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",
|
||||
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
|
||||
)
|
||||
}
|
||||
options(shiny.host = '0.0.0.0')
|
||||
options(shiny.port = 8888)
|
||||
shinyApp(ui = ui, server = server)
|
||||
|
||||
98
global.R
Normal file
98
global.R
Normal file
@@ -0,0 +1,98 @@
|
||||
library(rjson)
|
||||
# Json of Crime Reports
|
||||
crime_json <- fromJSON(file="data.json")
|
||||
get_bezirk_by_stadtteil <- function(name) {
|
||||
parents <- names(crime_json)[sapply(crime_json, function(item) name %in% names(item))]
|
||||
|
||||
if (length(parents) == 0) return(NULL)
|
||||
parents
|
||||
}
|
||||
|
||||
map_data_to_table <- function(bezirk, stadtteil, year) {
|
||||
year <- as.character(trimws(year))
|
||||
map_df(names(crime_json[[bezirk]][[stadtteil]]), function(crime) {
|
||||
row <- crime_json[[bezirk]][[stadtteil]][[crime]][[year]]
|
||||
|
||||
tibble(
|
||||
Name = crime,
|
||||
`Erfasste Fälle` = as.integer(row[["Erfasste Fälle"]]),
|
||||
`Aufgeklärte Fälle` = as.integer(row[["Aufgeklärte Fälle"]]),
|
||||
`Aufklärung relativ` = paste(row[["Aufklärung relativ"]], "%", sep=""),
|
||||
)
|
||||
})
|
||||
}
|
||||
|
||||
map_data_to_top3_plot <- function(bezirk, stadtteil, year) {
|
||||
year <- as.character(trimws(year))
|
||||
req(bezirk)
|
||||
req(stadtteil)
|
||||
req(year)
|
||||
komplettes_tibble <- map_df(names(crime_json[[bezirk]][[stadtteil]]), function(crime) {
|
||||
row <- crime_json[[bezirk]][[stadtteil]][[crime]][[year]]
|
||||
tibble(
|
||||
Name = str_wrap(crime, width = 25),
|
||||
Erfasst = as.integer(row[["Erfasste Fälle"]]),
|
||||
)
|
||||
})
|
||||
# Sortieren und Beschränken auf die Ränge 2, 3 und 4
|
||||
top_3_tibble <- komplettes_tibble %>%
|
||||
# Sortieren: Absteigend nach "Erfasste Fälle". Der höchste Wert ist nun in Zeile 1.
|
||||
arrange(desc(Erfasst)) %>%
|
||||
# Beschränken: Wählt die Zeilen 2, 3 und 4 aus.
|
||||
# Dies sind die Ränge 2, 3 und 4.
|
||||
slice(2:4)
|
||||
|
||||
return(top_3_tibble)
|
||||
}
|
||||
|
||||
get_intensity_df <- function(crime_json, delikt, jahr = "2024", feld = "Erfasste Fälle") {
|
||||
do.call(rbind, lapply(names(crime_json), function(bezirk) {
|
||||
stadtteile <- crime_json[[bezirk]]
|
||||
data.frame(
|
||||
bezirk = bezirk,
|
||||
stadtteil = names(stadtteile),
|
||||
intensity = sapply(stadtteile, function(st) {
|
||||
|
||||
# sicherer Zugriff (verhindert Fehler bei fehlenden Einträgen)
|
||||
val <- st[[delikt]][[jahr]][[feld]]
|
||||
|
||||
if (is.null(val)) NA else val
|
||||
}),
|
||||
row.names = NULL
|
||||
)
|
||||
}))
|
||||
}
|
||||
|
||||
#GeoJson for Bezirke
|
||||
geo_bezirke <- st_read("geobezirke-parsed.json")
|
||||
geo_bezirke <- st_transform(geo_bezirke, crs = 4326)
|
||||
geo_bezirke$leaflet_id <- paste("bez_", geo_bezirke$bezirk, sep="")
|
||||
|
||||
#GeoJson for Stadtteile
|
||||
geo_stadtteile <- st_read("geostadtteile-parsed.json")
|
||||
geo_stadtteile <- st_transform(geo_stadtteile, crs = 4326)
|
||||
geo_stadtteile$leaflet_id <- paste("std_", geo_stadtteile$stadtteil, sep="")
|
||||
bezirke <- sort(names(crime_json))
|
||||
|
||||
list_of_crimes <- sort(c(unique(unlist(
|
||||
lapply(crime_json, function(a) {
|
||||
unlist(
|
||||
lapply(a, function(b) {
|
||||
names(b)
|
||||
}),
|
||||
use.names = FALSE
|
||||
)
|
||||
}),
|
||||
use.names = FALSE
|
||||
)), ""))
|
||||
|
||||
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()
|
||||
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
|
||||
)
|
||||
}
|
||||
138
ui.R
Normal file
138
ui.R
Normal file
@@ -0,0 +1,138 @@
|
||||
ui <- function() {
|
||||
page_fillable(
|
||||
h1("Kriminalstatistik Hamburg",
|
||||
style = "color: #003063; font-weight: bold;",
|
||||
class = "ms-4 display-4"),# ms-4 sorgt für den Abstand links
|
||||
navset_card_tab(
|
||||
nav_panel("Karte",
|
||||
page_sidebar(
|
||||
layout_columns(
|
||||
leafletOutput("hhmap"),
|
||||
card(
|
||||
div(
|
||||
# h3 oder div dient als Block-Element und richtet seinen Inhalt (das span) rechtsbündig aus
|
||||
style = "text-align: right; width: 100%; ",
|
||||
|
||||
# Der Text wird in ein span verpackt und erhält die Border.
|
||||
# Ein span nimmt nur den Platz ein, den der Inhalt benötigt (inline).
|
||||
tags$span(
|
||||
"2024",
|
||||
style = "
|
||||
border: 1px solid rgba(40,70,94,0.1);
|
||||
border-radius: 5px;
|
||||
padding: 5px 10px 5px 10px;
|
||||
background-color: #eeeeee;
|
||||
"
|
||||
# padding ist der abstand an leerer Fläche in der reihenfolge top right bottom left
|
||||
# farbe rgba ist die exakte Farbe der Trennlinien und Card-Umrandungen aus der App
|
||||
)
|
||||
),
|
||||
div(
|
||||
class = "d-flex align-items-end gap-2",
|
||||
h5(strong("Bezirk:"), style = "margin-bottom: 0;"),
|
||||
textOutput("txt_map_selection_bezirk"),
|
||||
),
|
||||
div(
|
||||
class = "d-flex align-items-end gap-2",
|
||||
h5(strong("Stadtteil:"), style = "margin-bottom: 0;"),
|
||||
textOutput("txt_map_selection_stadtteil"),
|
||||
),
|
||||
plotOutput("grph_top3"),
|
||||
#tableOutput("tbl_2024"),
|
||||
),
|
||||
col_widths = c(8, 4),
|
||||
),
|
||||
sidebar = sidebar(
|
||||
radioButtons(
|
||||
inputId = "rd_maptype",
|
||||
label = "Kartentyp",
|
||||
choices = c("Bezirke", "Stadtteile"),
|
||||
selected = "Bezirke"
|
||||
),
|
||||
selectizeInput(
|
||||
inputId = "search",
|
||||
label = tags$span(icon("search"),"Suche"),
|
||||
choices = NULL,
|
||||
selected = NULL,
|
||||
multiple = FALSE, # Hier wahrscheinlich nur Einzelauswahl gewünscht
|
||||
options = list(
|
||||
placeholder = "Anfangen zu tippen...",
|
||||
openOnFocus = FALSE,
|
||||
allowEmptyOption = TRUE,
|
||||
selectOnTab = FALSE,
|
||||
plugins = list('dropdown_header')
|
||||
)
|
||||
),
|
||||
selectizeInput(
|
||||
inputId = "heatmap",
|
||||
label = "Wähle eine Straftat:",
|
||||
choices = list_of_crimes,
|
||||
selected = NULL,
|
||||
options = list(
|
||||
placeholder = "Keine Auswahl",
|
||||
plugins = list('clear_button')
|
||||
)
|
||||
)
|
||||
),
|
||||
)
|
||||
),
|
||||
nav_panel("Vergleich",
|
||||
layout_sidebar(
|
||||
sidebar = sidebar(
|
||||
title = "Vergleichs-Optionen",
|
||||
radioButtons(
|
||||
"vergleichs_modus",
|
||||
"Wählen Sie den Vergleichstyp:",
|
||||
choices = c(
|
||||
"Straftat vs. Orte" = "ort_vergleich",
|
||||
"Ort vs. Straftaten" = "straftat_vergleich"
|
||||
),
|
||||
selected = "ort_vergleich"
|
||||
),
|
||||
|
||||
tags$hr(),
|
||||
|
||||
# 2. Dynamische Input-Felder für die Orte und Straftaten
|
||||
uiOutput("vergleichs_inputs"),
|
||||
|
||||
# 3. Gemeinsamer Input: Das Jahr
|
||||
selectizeInput(
|
||||
"vergleichs_jahr",
|
||||
"Jahr wählen:",
|
||||
choices = c(2024, 2023),
|
||||
selected = 2024
|
||||
),
|
||||
),
|
||||
card(
|
||||
card_header(uiOutput("vergleichs_titel")), # Dynamischer Titel
|
||||
plotOutput("vergleichs_plot")
|
||||
)
|
||||
)
|
||||
),
|
||||
|
||||
|
||||
|
||||
|
||||
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"
|
||||
)
|
||||
)
|
||||
}
|
||||
Reference in New Issue
Block a user