[英]Adding reactive popup graphs/plots to a Leaflet map with Shiny R
I have built a Shiny dashboard.我已经构建了一个 Shiny 仪表板。 The user can select a municipality from a dropdown menu, after which a range of data from that municipality are downloaded and visualized with Leaflet.
用户可以从下拉菜单中 select 一个城市,然后下载该城市的一系列数据并使用 Leaflet 进行可视化。 A main user requirement is that clicking an area on the map generates a popup graph with all the scores for that area (see image below)
一个主要的用户要求是单击 map 上的一个区域会生成一个包含该区域所有分数的弹出图(见下图)
This was my general approach:这是我的一般方法:
This shouldn't be so hard, but I have been stuck for days.这不应该那么难,但我已经被困了好几天了。 I have also attempted to generate a list of graphs (one for each area in the municipality), since I believe that is how leafpop works.
我还尝试生成一个图表列表(市政当局的每个区域一个),因为我相信这就是 leafpop 的工作原理。 However, once again to success.
然而,再次走向成功。 Does anyone have a solution to my struggle?
有没有人可以解决我的挣扎?
Reproducable example:可重现的例子:
library(sf)
library(dplyr)
library(shiny)
library(shinydashboard)
library(leaflet)
library(leafpop)
library(ggplot2)
library(reshape2)
# Let's use this municipality in the example
inputMunicipality = "Landgraaf"
# Download municipality geometry
df <-st_read(URLencode(sprintf("https://geo.leefbaarometer.nl/leefbaarometer/wfs?version=1.0.0&cql_filter=gemeente=%s%s%s&request=GetFeature&typeName=leefbaarometer:wijken_2018&srsName=epsg:4326&outputFormat=json",
"'", inputMunicipality, "'")))[c("WK_NAAM", "WK_CODE")]
# Add some fake scores
df$environmentScore <- sample(10, size = nrow(df), replace = TRUE)
df$facilitiesScore <- sample(10, size = nrow(df), replace = TRUE)
df$housingScore <- sample(10, size = nrow(df), replace = TRUE)
df$safetyScore <- sample(10, size = nrow(df), replace = TRUE)
# Define dashboard UI
ui <- dashboardPage(
dashboardHeader(title = "Testing reactive popup on click event!"),
dashboardSidebar(),
dashboardBody(
fluidRow(leafletOutput("myMap")
)
)
)
# Define server logic
server <- function(input, output) {
# When a person clicks the map, the name of the clicked area is saved in this reactive value
clickValue <- reactiveValues(areaName=NULL)
# I then want to use the reactive "clickValue$areaName" in this function to generate a reactive ggplot
# The reactive ggplot should then be shown as a popup with the addPopupGraphs function
reactivePopup <- reactive ({
makePopupPlot(clickValue$areaName, df)
})
output$myMap <- renderLeaflet({
leaflet() %>%
addProviderTiles(providers$nlmaps.grijs) %>%
addPolygons(data = df, weight = 1, fillOpacity = 0.3,
group = "test", layerId = ~WK_CODE, popup = df$WK_NAAM) %>%
addPopupGraphs(list(nonReactiveExamplePopup), group = "test", width = 500, height = 200)
})
# Save the name of a clicked area in a reactive variable
observeEvent(input$map_shape_click, {
event <- input$map_shape_click
clickAreaName <- df$WK_NAAM[df$WK_CODE == event$id]
clickValue$areaName <- clickAreaName
})
}
# Run the application
shinyApp(ui = ui, server = server)
# Function for generation a popup based on the area clicked by the user
makePopupPlot <- function (clickedArea, df) {
# prepare the df for ggplot
noGeom <- st_drop_geometry(df)
plotData <- noGeom[c("WK_NAAM", "environmentScore", "facilitiesScore","housingScore", "safetyScore")]
plotDataSubset <- subset(plotData, plotData['WK_NAAM'] == clickedArea)
plotDataMelt = melt(plotDataSubset, id.vars = "WK_NAAM")
popupPlot <- ggplot(data = plotDataMelt, aes(x = variable, y = value, fill=value)) +
geom_bar(position="stack", stat="identity", width = 0.9) +
scale_fill_steps2(
low = "#ff0000",
mid = "#fff2cc",
high = "#70ad47",
midpoint = 5) +
coord_flip() +
ggtitle(paste0("Score overview in ", clickedArea)) +
theme(legend.position = "none")
return (popupPlot)
}
# Add this graph to addPopupGraphs(list() to see how I want it to work
nonReactiveExamplePopup <- makePopupPlot("Wijk 00 Schaesberg", df)
If I understood correctly:如果我理解正确:
library(sf)
library(dplyr)
library(shiny)
library(shinydashboard)
library(leaflet)
library(leafpop)
library(ggplot2)
library(reshape2)
set.seed(1)
# Let's use this municipality in the example
inputMunicipality = "Landgraaf"
# Download municipality geometry
df <-st_read(URLencode(sprintf("https://geo.leefbaarometer.nl/leefbaarometer/wfs?version=1.0.0&cql_filter=gemeente=%s%s%s&request=GetFeature&typeName=leefbaarometer:wijken_2018&srsName=epsg:4326&outputFormat=json",
"'", inputMunicipality, "'")))[c("WK_NAAM", "WK_CODE")]
# Add some fake scores
df$environmentScore <- sample(10, size = nrow(df), replace = TRUE)
df$facilitiesScore <- sample(10, size = nrow(df), replace = TRUE)
df$housingScore <- sample(10, size = nrow(df), replace = TRUE)
df$safetyScore <- sample(10, size = nrow(df), replace = TRUE)
# Define dashboard UI
ui <- dashboardPage(
dashboardHeader(title = "Testing reactive popup on click event!"),
dashboardSidebar(),
dashboardBody(
fluidRow(leafletOutput("myMap")
)
)
)
# Define server logic
server <- function(input, output) {
# Function for generation a popup based on the area clicked by the user
makePopupPlot <- function (clickedArea, df) {
# prepare the df for ggplot
noGeom <- st_drop_geometry(df)
plotData <- noGeom[c("WK_NAAM", "environmentScore", "facilitiesScore","housingScore", "safetyScore")]
plotDataSubset <- subset(plotData, plotData['WK_NAAM'] == clickedArea)
plotDataMelt = melt(plotDataSubset, id.vars = "WK_NAAM")
popupPlot <- ggplot(data = plotDataMelt, aes(x = variable, y = value, fill=value)) +
geom_bar(position="stack", stat="identity", width = 0.9) +
scale_fill_steps2(
low = "#ff0000",
mid = "#fff2cc",
high = "#70ad47",
midpoint = 5) +
coord_flip() +
ggtitle(paste0("Score overview in ", clickedArea)) +
theme(legend.position = "none") +
theme(plot.margin = unit(c(0,0.5,0,0), "cm"), plot.title = element_text(size = 10))
return (popupPlot)
}
# chart list
p <- as.list(NULL)
p <- lapply(1:nrow(df), function(i) {
p[[i]] <- makePopupPlot(df$WK_NAAM[i], df)
})
output$myMap <- renderLeaflet({
leaflet() %>%
addProviderTiles(providers$nlmaps.grijs) %>%
addPolygons(data = df, popup = popupGraph(p, type = "svg"))
})
}
# Run the application
shinyApp(ui = ui, server = server)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.