r - 如何在传单地图上添加文字?
问题描述
每天我都需要在地图上画一条路径并添加一个文本,比如 4、5 或 8 分钟。表示从起点到目的地的车程(见下图)。我认为在 R 中使用 Leaflet 创建一个闪亮的应用程序会很有帮助(代码如下所示)。
我使用 Leaflet.extras 包中的 addDrawToolbar 来绘制路径,如所附地图所示。但我不知道也找不到如何以与绘制路径相同的方式添加文本。解决方案不一定必须在 R 中。我的目标是为那些想做这些事情但同时不知道如何编码的人创建一个应用程序。
library(shiny)
library(leaflet)
library(leaflet.extras)
ui = fluidPage(
tags$style(type = "text/css", "#map {height: calc(100vh - 20px)
!important;}"),
leafletOutput("map")
)
server = function(input,output,session){
output$map = renderLeaflet(
leaflet()%>%
addTiles(urlTemplate = "http://mt0.google.com/vt/lyrs=m&hl=en&x=
{x}&y={y}&z={z}&s=Ga")%>%
addMeasure(
primaryLengthUnit = "kilometers",
secondaryAreaUnit = FALSE
)%>%
addDrawToolbar(
targetGroup='draw',
editOptions = editToolbarOptions(selectedPathOptions =
selectedPathOptions()),
polylineOptions = filterNULL(list(shapeOptions =
drawShapeOptions(lineJoin = "round", weight = 8))),
circleOptions = filterNULL(list(shapeOptions =
drawShapeOptions(),
repeatMode = F,
showRadius = T,
metric = T,
feet = F,
nautic = F))) %>%
setView(lat = 45, lng = 9, zoom = 3) %>%
addStyleEditor(position = "bottomleft",
openOnLeafletDraw = TRUE)
)
}
shinyApp(ui,server)
解决方案
这样做的一种方法是在双击传单地图时提示用户添加文本。双击坐标处理放置文本的位置,弹出提示处理文本应该说的内容。
library(shiny)
library(leaflet)
library(leaflet.extras)
server = function(input,output,session){
# Create reactive boolean value that indicates a double-click on the leaflet widget
react_list <- reactiveValues(doubleClick = FALSE, lastClick = NA)
observeEvent(input$map_click$.nonce, {
react_list$doubleClick <- identical(react_list$lastClick, input$map_click[1:2])
react_list$lastClick <- input$map_click[1:2]
})
# Upon double-click, create pop-up prompt allowing user to enter text
observeEvent(input$map_click[1:2], {
if (react_list$doubleClick) {
shinyWidgets::inputSweetAlert(session, "addText", title = "Add text:")
}
})
# Upon entering the text, place the text on leaflet widget at the location of the double-click
observeEvent(input$addText, {
leafletProxy("map") %>%
addLabelOnlyMarkers(
input$map_click$lng, input$map_click$lat, label = input$addText,
labelOptions = labelOptions(noHide = TRUE, direction = "right", textOnly = TRUE,
textsize = "15px"))
})
# Clear out all text if user clears all layers via the toolbar
observeEvent(input$map_draw_deletestop, {
if ( length(input$map_draw_all_features$features) < 1 ) {
leafletProxy("map") %>% clearMarkers()
}
})
output$map <- renderLeaflet({
leaflet(options = leafletOptions(doubleClickZoom = FALSE)) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addMeasure(
primaryLengthUnit = "kilometers",
secondaryAreaUnit = FALSE) %>%
addDrawToolbar(
targetGroup ='draw',
editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions()),
polylineOptions = filterNULL(list(shapeOptions = drawShapeOptions(lineJoin = "round", weight = 8))),
circleOptions = filterNULL(list(shapeOptions = drawShapeOptions(), repeatMode = F, showRadius = T,
metric = T, feet = F, nautic = F))) %>%
setView(lng = -73.97721, lat = 40.7640, zoom = 15)
})
}
shinyApp(ui = fluidPage( leafletOutput("map") ) , server)
推荐阅读
- python-3.x - 使用 task.forget() 时 Redis 内存使用量继续攀升
- laravel - 如何从关系模型中检索隐藏属性
- java - 在单击按钮时创建的项目在 JFrame 中不可见
- python - 尽管加载了最佳权重,但 EarlyStopping 并未停止模型
- logistic-regression - scikit-learn 和 dask-ml LogisticRegression 的不同结果
- deep-learning - 点云数据集的归一化(特征缩放)
- grep - 为什么 grep 返回部分匹配列表,然后退出,将文件的其余部分视为二进制文件?
- python - 如何在 python 中使用 x、y 和 z 制作强度图?
- javascript - JS拆分字符串和每个拆分的返回索引
- android - 如何使用 Dagger2 将自定义对象从活动类传递到存储库类?