[英]Prevent flyTo within a leaflet in shiny from refreshing map
我想添加一个easyButton
有flyTo
一个内功能shiny
的应用R
当用户按下按钮时,它会飞到当前位置(纬度/经度)。 我使用的是reactivePoll
轮询船仪器模拟器每5秒( NMEA模拟器),这是在纬度/长从何而来。 还使用addCircleMarkers
绘制路径。 我想保持绘制这条路径,并使用flyTo
按钮平移和缩放到当前位置而不刷新地图,即删除绘制的路径。
在我当前带有flyTo
按钮的代码中,每次轮询都会刷新地图。 如果我删除此代码,地图不会刷新,所以我认为我如何在此按钮中使用反应是问题所在,但我不确定为什么。 这可能是因为我在反应性内部有反应性(在All_NMEA()
renderleaflet()
)。 对 reprex 感兴趣的代码是:
addEasyButton(easyButton(
icon = "fa-crosshairs", title = "Locate Vessel",
onClick = JS("
function(btn, map) {
map.flyTo([", paste(as.numeric(All_NMEA()["lat"]) / 100), ",", paste(as.numeric(All_NMEA()["long"]) / -100), "], zoom = 10);
}
")
))
NMEA 模拟器需要生成上面链接的轮询数据。 可重现的例子:
# https://chrome.google.com/webstore/detail/nmea-simulator/dfhcgoinjchfcfnnkecjpjcnknlipcll?hl=en
# needs an NMEA simulator to generate the poll data
#
library(shiny)
library(leaflet)
connect <- function() {
s_con <<- socketConnection("127.0.0.1", port = 55555, open = "a+")
Sys.sleep(1)
NMEA_poll <<- readLines(s_con, n = 18)
close(s_con)
return(NMEA_poll)
}
pollGPRMC <- function(data) {
gps_ans <- list(rmc = NULL, rest = data)
rxp <-
"\\$GPRMC(,[^,]*){12}\\*[0-9,A-F]{2}"
beg <- regexpr(rxp, data)
if (beg == -1)
return(gps_ans)
end <-
beg + attr(beg, "match.length")
sub <-
substr(data, beg, end - 6)
gps_ans$rmc <-
strsplit(sub, ",")[[1]]
names(gps_ans$rmc) <- c(
"id_rmc",
"UTC",
"status",
"lat",
"N/S",
"long",
"E/W",
"boat speed (knots)",
"cog (deg)",
"date (ddmmyy)" # ddmmyy
)
gps_ans$rest <- substr(data, end, nchar(data))
return(gps_ans)
}
map_data <- data.frame(lat = c(36.05, 36.25), lon = c(-132.13, -132.33))
ui <- fluidPage(
# Application title
titlePanel("Map"),
mainPanel(tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}"),
leafletOutput("map"))
)
server <- function(input, output, session) {
All_NMEA <- shiny::reactivePoll(
5000,
session,
checkFunc = Sys.time,
valueFunc = function() {
connect()
NMEA_data <- toString(NMEA_poll)
GPS_dat <- pollGPRMC(NMEA_data)
lat_deg <- substr(GPS_dat$rmc["lat"], 1, 2)
lat_mins <- substr(GPS_dat$rmc["lat"], 3, 9)
lat_for_dist <- as.numeric(lat_deg) + (as.numeric(lat_mins) / 60)
print(lat_for_dist)
lon_deg <- substr(GPS_dat$rmc["long"], 1, 3)
lon_mins <- substr(GPS_dat$rmc["long"], 4, 9)
lon_for_dist <- (as.numeric(lon_deg) + (as.numeric(lon_mins) / 60))*-1
print(lon_for_dist)
leafletProxy("map", session = session) %>%
addCircleMarkers(
lng = lon_for_dist,
lat = lat_for_dist,
radius = 1,
fillOpacity = 1, color = "red"
)
NMEA_out <- c(GPS_dat$rmc)
return(NMEA_out)
}
)
ord <- function(data) {
print(data)
}
observe(ord(All_NMEA()))
output$map <- renderLeaflet({
map <- leaflet(map_data) %>%
addProviderTiles(providers$Esri.OceanBasemap, group = "ocean basemap (default)") %>%
addTiles(group = "Basic") %>%
fitBounds( ~ min(lon), ~ min(lat), ~ max(lon), ~ max(lat)) %>%
addLayersControl(
baseGroups = c("ocean basemap (default)", "Basic"),
options = layersControlOptions(collapsed = FALSE)) %>%
fitBounds( ~ min(lon), ~ min(lat), ~ max(lon), ~ max(lat)) %>%
addEasyButton(easyButton(
icon = "fa-crosshairs", title = "Locate Vessel",
onClick = JS("
function(btn, map) {
map.flyTo([", paste(as.numeric(All_NMEA()["lat"]) / 100), ",", paste(as.numeric(All_NMEA()["long"]) / -100), "], zoom = 10);
}
")
))
})
}
shinyApp(ui = ui, server = server)
你在最后一句话中自己回答了这个问题。 每当反应式All_NMEA
更改时,地图将始终重绘。 为了防止这种情况,您通常会使用leafletProxy
但显然您不能添加这样的easyButton
,所以我为您提供了另一种解决方案。
单击easyButton
将触发另一个名为my_easy_button
闪亮输入。 在observeEvent
您会收听此事件并在flyTo
中执行leafletProxy
。
library(shiny)
library(leaflet)
map_data <- data.frame(lat = c(36.05, 36.25), lon = c(-132.13, -132.33))
ui <- fluidPage(
titlePanel("Map"),
mainPanel(tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}"),
leafletOutput("map"))
)
server <- function(input, output, session) {
All_NMEA <- shiny::reactivePoll(
intervalMillis = 5000,
session = session,
checkFunc = Sys.time,
valueFunc = function() {
NMEA_out <- data.frame(lat = runif(1, 0, 20),
long = runif(1, 0, 20))
leafletProxy("map", session = session) %>%
addCircleMarkers(
lng = NMEA_out$long,
lat = NMEA_out$lat,
radius = 1,
fillOpacity = 1, color = "red"
)
return(NMEA_out)
}
)
observe({All_NMEA()})
output$map <- renderLeaflet({
map <- leaflet(map_data) %>%
addProviderTiles(providers$Esri.OceanBasemap, group = "ocean basemap (default)") %>%
addTiles(group = "Basic") %>%
addLayersControl(
baseGroups = c("ocean basemap (default)", "Basic"),
options = layersControlOptions(collapsed = FALSE)) %>%
addEasyButton(
easyButton(id = "buttonid",
icon = "fa-crosshairs", title = "Locate Vessel",
onClick = JS("function(btn, map) {
Shiny.onInputChange('my_easy_button', 'clicked', {priority: 'event'});
}")
))
})
observeEvent(input$my_easy_button, {
print("easyButton is clicked")
allnmea <- req(All_NMEA())
leafletProxy("map", session = session) %>%
flyTo(lng = allnmea$long, lat = allnmea$lat, zoom = 5)
})
}
shinyApp(ui = ui, server = server)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.