【发布时间】：2018-05-28 09:44:27
【问题描述】：
我的数据
# Fake data
df <- data.frame(lng = c(-5, -5, -5, -5, -15, -15, -10),
lat = c(8, 8, 8, 8, 33, 33, 20),
year = c(2018, 2018, 2018, 2017, 2017, 2017, 2016),
type = c('A', 'A', 'A', 'A', 'B', 'B', 'A'),
id =c("1", "1", "1", "1", "2", "2", "3"),
place =c("somewhere1", "somewhere1", "somewhere1", "somewhere1", "somewhere3", "somewhere2", "somewhere3"),
stringsAsFactors = FALSE)
映射我的数据：
我的用户界面方面：
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10, right = 10,
style="z-index:500;", # legend over my map (map z = 400)
tags$h3("map"),
sliderInput("periode", "Chronology",
min(df$year),
max(df$year),
value = range(df$year),
step = 1,
sep = ""
),
checkboxGroupInput("choice",
"type",
choices = list("type A" = "A",
"type B" = "B"),
selected = 1))
# todo plot()
)
我的服务器端：
server <- function(input, output, session) {
# reactive filtering data from UI
reactive_data_chrono <- reactive({
df %>%
filter(year >= input$periode[1] & year <= input$periode[2]) %>%
filter(type %in% input$choice) %>%
count(place,lng, lat, type, id) %>%
arrange(desc(n))
})
# colors
pal <- colorFactor(
palette = c('red', 'blue'),
domain = df$type
)
# static backround map
output$map <- renderLeaflet({
leaflet(df) %>%
addTiles() %>%
fitBounds(~min(lng), ~min(lat), ~max(lng), ~max(lat))
})
# reactive circles map
observe({
leafletProxy("map", data = reactive_data_chrono()) %>%
clearShapes() %>%
addCircles(lng=~lng,
lat=~lat,
weight = 5,
radius = ~(n*50000),
color = ~pal(type))
})
}
使用用户界面和服务器：
shinyApp(ui, server)
我的地图：
我做了什么：
1. 将数据框 id 值分配给圆（图层 id）。
2. 根据圆圈点击获取id值。
我想要什么：
3. 根据点击事件值过滤我的 df 值。
4. 在绝对面板中绘制 x,y 图 (n, year)。
示例：绘制 id ==1
我在服务器端尝试了什么： 我有点困惑，并试图适应几个问题，比如 Map Marker in leaflet shiny（@SymbolixAU 回答）到 leaftleproxy 圈层（而不是背景图）
server <- function(input, output, session) {
# reactive filtering data from UI
reactive_data_chrono <- reactive({
df %>%
filter(year >= input$periode[1] & year <= input$periode[2]) %>%
filter(type %in% input$choice) %>%
count(place,lng, lat, type, id) %>%
arrange(desc(n))
})
# colors
pal <- colorFactor(
palette = c('red', 'blue'),
domain = df$type
)
# static backround map
output$map <- renderLeaflet({
leaflet(df) %>%
addTiles() %>%
fitBounds(~min(lng), ~min(lat), ~max(lng), ~max(lat))
})
# reactive circles map
observe({
leafletProxy("map", data = reactive_data_chrono()) %>%
clearShapes() %>%
addCircles(lng=~lng,
lat=~lat,
weight = 5,
radius = ~(n*50000),
color = ~pal(type),
layerId = ~id) ### Assigning df id to layerid
})
observe circles from leafletProxy "map"
#############################################
observe({
leafletProxy("map") %>% clearPopups()
event <- input$map_shape_click
print(event)
# print(event) returns $id in console
#############################################
# what I want : filtering and plotting
# using dplyr not woeking
#############################################
x <- df[df$id == event$id, ]
x2 <- xtabs(formula =place~year, x)
output$plot <- renderPlot({x2})
})
}
})
}
界面添加
plotOutput(outputId = "plot"))
shinyApp(ui, server)
【问题讨论】：
-
应该
filter(id == event$click)是filter(id == event$id)吗？ -
this question 也可能有帮助
-
@ SymbolixAU 我正在尝试使您的帖子适应 leafletProxy("map") 的情况。你认为第一步还好吗？
-
我觉得关键是通过
observeEvent(input$map_shape_click, {观察点击 -
@ SymbolixAU 是真的。