防止在闪亮的传单中的 flyTo 刷新地图

Question

I am trying to add an easyButton with a flyTo function within a shiny app in R .

When the user presses the button, it will fly to the current location (lat/long). I am using a reactivePoll to poll a boat instrument simulator every 5 seconds ( NMEA simulator ), which is where the lat/long come from. A path is also drawn by using addCircleMarkers . I want to keep this path drawn, and the flyTo button to pan and zoom to the current location without refreshing the map, ie removing the path that was drawn.

In my current code with the flyTo button, with every poll the map refreshes. If I remove this code, the map does not refresh, so I think how I'm using the reactive within this button is the issue, but I'm not sure why. It may be because I have a reactive inside a reactive ( All_NMEA() inside of renderleaflet() ). The code of interest in the reprex is:

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);
             }
             ")
    ))

The NMEA simulator is required to produce data that is polled, linked above. Reproducible example:

# 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

You answered the question yourself in your last sentence. The map will always be redrawn whenever the reactive All_NMEA changes. To prevent that, you would normally use leafletProxy but apparently you cannot add an easyButton like that, so I offer you another solution.

A click on the easyButton will trigger another shiny input that is called my_easy_button . In an observeEvent you listen to this event and do the flyTo there within a 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)