Предотвратите полет в листовке на блестящей и освежающей карте - PullRequest
Новая
       5

Предотвратите полет в листовке на блестящей и освежающей карте

1 голос
/ 30 марта 2020

Я пытаюсь добавить easyButton с функцией flyTo в приложении shiny в R.

Когда пользователь нажимает кнопку, он летит в текущее местоположение ( широта / долгота). Я использую reactivePoll для опроса симулятора лодочных инструментов каждые 5 секунд ( NMEA simulator ), отсюда и широта / долгота. Путь также рисуется с помощью addCircleMarkers. Я хочу, чтобы этот путь был нарисован, и кнопку flyTo для панорамирования и увеличения текущего местоположения без обновления карты, т. Е. Удаления нарисованного пути.

В моем текущем коде с flyTo кнопка, при каждом опросе карта обновляется. Если я удаляю этот код, карта не refre sh, поэтому я думаю, как я использую реактив в этой кнопке, проблема, но я не уверен, почему. Это может быть потому, что у меня есть реактив внутри реактива (All_NMEA() внутри renderleaflet()). Интересующий код в представлении: 

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)

1 Ответ

1 голос
/ 03 апреля 2020

Вы сами ответили на вопрос в своем последнем предложении. Карта всегда будет перерисовываться всякий раз, когда реактивный 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)
...