基于树叶圆绘制数据(闪亮)
基于树叶圆绘制数据(闪亮)
提问于 2018-05-27 16:48:42
我的数据
# 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))
})
}使用ui服务器(&S)：
shinyApp(ui, server)我的地图：
我做了什么：
基于圆形单击将dataframe id值分配给圆形(层id).Getting id值。
我想要的：
根据点击事件value.Ploting和绝对面板中的x，y图(n，year)过滤我的DF值。
示例:绘制id ==1
我在服务器端的尝试:我有点困惑，并试图将Map Marker in leaflet shiny (@SymbolixAU答案)等几个问题调整为叶子代理圆圈图层(而不是背景地图)
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})
})
}
})
}UI添加
plotOutput(outputId = "plot"))
shinyApp(ui, server)回答 1
Stack Overflow用户
回答已采纳
发布于 2018-05-27 20:31:22
我终于找到了我的问题的答案。下面是完整的代码。基于@SymbolixAU的建议。
library(shiny)
library(leaflet)
library(dplyr)
library(leaflet)
# 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),
plotOutput(outputId = "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),
layerId = ~id) # Assigning df id to layerid
})
# Observe circles from leafletProxy "map"
observe({
leafletProxy("map") %>% clearPopups()
event <- input$map_shape_click
if (is.null(event))
return()
print(event) # Show values on console fort testing
# Filtering and plotting
x <- df[df$id == event$id, ]
x2 <- x %>%
count(id, year)
output$plot <- renderPlot({plot(x2$n, x2$year)
})
})
}
shinyApp(ui, server)页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/50550488
复制相关文章
相似问题