防止在閃亮的傳單中的 flyTo 刷新地圖

Question

我想添加一個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)

Answer 1

你在最后一句話中自己回答了這個問題。 每當反應式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)