R 防止传单中的flyTo在“闪亮从刷新”地图中出现
我正在尝试在R 防止传单中的flyTo在“闪亮从刷新”地图中出现,r,shiny,leaflet,R,Shiny,Leaflet,我正在尝试在R中的闪亮的应用程序中添加一个带有flyTo功能的easyButton 当用户按下按钮时，它将飞到当前位置（lat/long）。我使用reactivePoll每5秒轮询一次船用仪器模拟器（），这就是lat/long的来源。还可以使用addCircleMarkers绘制路径。我希望保持绘制此路径，并使用flyTo按钮平移和缩放到当前位置，而不刷新地图，即删除绘制的路径 在我当前的代码中，使用flyTo按钮，每次轮询地图都会刷新。如果我删除此代码，映射不会刷新，因此我认为如何使用此按钮内
R闪亮的应用程序中添加一个带有flyTo
功能的easyButton
当用户按下按钮时，它将飞到当前位置（lat/long）。我使用reactivePoll
每5秒轮询一次船用仪器模拟器（），这就是lat/long的来源。还可以使用addCircleMarkers
绘制路径。我希望保持绘制此路径，并使用flyTo
按钮平移和缩放到当前位置，而不刷新地图，即删除绘制的路径
在我当前的代码中，使用flyTo
按钮，每次轮询地图都会刷新。如果我删除此代码，映射不会刷新，因此我认为如何使用此按钮内的反应是问题所在，但我不确定原因。这可能是因为我在一个reactive中有一个reactive（All\u 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)
#https://chrome.google.com/webstore/detail/nmea-simulator/dfhcgoinjchfcfnnkecjpjcnknlipcll?hl=en
#需要NMEA模拟器来生成轮询数据
#
图书馆（闪亮）
图书馆（单张）
连接你在最后一句中自己回答了这个问题。当反应所有NMEA
更改时，地图将始终重新绘制。为了防止出现这种情况，您通常会使用proxy
，但显然您无法添加这样的easyButton
，因此我为您提供了另一种解决方案
点击easyButton
将触发另一个闪亮的输入，称为my_easy_按钮
。在observeEvent
中，您收听此事件，并在proxy
中执行flyTo
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)
库（闪亮）
图书馆（单张）
映射数据我在运行你的应用程序时出现此错误：警告：socketConnection中的错误：无法打开连接
，这是你可以修复的还是我特有的？好问题。我不确定这是许可还是网络问题。这是立即发生的，还是在尝试连接一段时间后发生的？一旦应用程序运行，它会立即崩溃。将“127.0.0.1”更改为“localhost”是否会产生影响？不，同样的问题非常感谢。我根本找不到像这样简单的按钮。所以任何时候我想在地图上使用一个反应元素，它都应该进入一个代理。显然，我应该学会如何更好地使用JS和shiny。