Files
shiny-app/IT Shiny App.R

163 lines
4.1 KiB
R

library(rjson)
library(shiny)
library(bslib)
library(leaflet)
library(sf)
library(htmltools)
crime_json <- fromJSON(file="data.json")
#View(crime_json)
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="")
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 <- names(crime_json)
ui <- page_fillable(
page_sidebar(
layout_columns(
leafletOutput("hhmap"),
card(
textOutput("txt_map_selection"),
"2024",
tableOutput("tbl_2024"),
"2023",
tableOutput("tbl_2023"),
),
col_widths = c(9, 3),
),
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,
),
),
)
)
server <- function(input, output, session){
observeEvent(input$drp_bezirk, {
sel_bezirk <- input$drp_bezirk
if (sel_bezirk != "") {
# Neue Auswahlmöglichkeiten bestimmen
sel_stadtteile <- names(crime_json[[sel_bezirk]])
# Zweites SelectInput-Feld aktualisieren
updateSelectInput(
session,
inputId = "drp_stadtteil",
choices = sel_stadtteile,
selected = sel_stadtteile[1] # Wählt den ersten Eintrag vor
)
}
})
observeEvent(input$rd_maptype, {
maptype <- input$rd_maptype
mapproxy <- leafletProxy("hhmap")
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
output$txt_map_selection <- renderText({
clicked_polygon_id
})
print(paste("Polygon with ID", clicked_polygon_id, "was clicked."))
}
})
output$hhmap <- renderLeaflet({
leaflet() %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addPolygons(
data = geo_bezirke,
layerId = ~leaflet_id,
group = "layer_bezirke",
color = "#7bb5ab",
fillColor = "#bdf0e7",
weight = 1,
fillOpacity = 0.4, # Polygon fill transparency
highlightOptions = highlightOptions(
color = "#103b57",
weight = 4,
bringToFront = TRUE
),
) %>%
addPolygons(
data = geo_stadtteile,
group = "layer_stadtteile",
layerId = ~leaflet_id,
color = "#7bb5ab",
fillColor = "#bdf0e7",
options = pathOptions(pane = "overlayPane"), # Use a leaflet option to ensure it's hidden
weight = 1,
fillOpacity = 0.4, # Polygon fill transparency
highlightOptions = highlightOptions(
color = "#103b57",
weight = 4,
bringToFront = TRUE
),
) %>%
setView(
lng = 9.98716634776887,
lat = 53.5488439196432,
zoom = 11
)
})
Names = c("Raub", "Diebstahl", "BtMG")
Faelle = c(1234, 5678, 9000)
Aufgeklaert = c(687867, 768789, 658)
Relativ = c("15%", "70%", "69%")
fake_data <- data.frame(
Name = Names,
Faelle = Faelle,
Aufgeklärt = Aufgeklaert,
Relativ = Relativ,
stringsAsFactors = FALSE
)
output$tbl_2024 <- renderTable(fake_data, striped = TRUE)
output$tbl_2023 <- renderTable(fake_data, striped = TRUE)
}
options(shiny.host = '0.0.0.0')
options(shiny.port = 8888)
shinyApp(ui = ui, server = server)