отображать карту только один раз (листовка и блеск)

Question

Я новичок в Shiny, у меня есть данные GPS и я хотел бы отобразить их на карте.Мне нужно сделать анимацию, которая зависит от времени - в основном, отслеживать человека с течением времени на карте.Проблема, с которой я здесь сталкиваюсь, заключается в том, что когда я нажимаю на бегунок времени для запуска (анимация), карта перезагружается каждый раз, когда появляется новый момент времени.Я хотел бы, чтобы карта загружалась только один раз, когда я открываю приложение, и точки появляются с течением времени для выбранного идентификатора пользователя.Надеюсь, это понятно.

library(shiny)
library(leaflet)
library(lubridate)
library(shinydashboard)
library(tidyverse)

latitude=c(37.4218, 37.4063)
longitude=c(-124.0831, -124.1190)
userid=c(1704, 1704)
time=c("2017-09-15 14:40:58", "2017-09-15 14:53:35")

## reproducible data 
geo<- as.data.frame(cbind(latitude,
        longitude, 
        userid, 
        time))

## data manipulation
geo<- geo %>% 
mutate(time = ymd_hms(time))%>% 
mutate(longitude=as.numeric(longitude), 
     latitude=as.numeric(latitude), 
     userid=as.numeric(userid))


region<- "US" ##"US" / "Boston" select region of initial view

if (region=="US") {
  lngset = -93.85
  latset = 37.45
  zoomset = 4
}
if (region=="Boston") {
  lngset = ## update
  latset = ## update
  zoomset = ## update
}

mindate<-min(geo$time)
maxdate<-max(geo$time)

IDS<-unique(geo$userid)

ui=fluidPage(
   titlePanel("title"),
   leafletOutput("mymap",height = 500),
   selectInput(inputId = "userid", 
          label="user id", 
          choices = IDS),
    sliderInput("date_range", 
          "Choose Date:", 
          min = mindate, 
          max = maxdate, 
          step = 1, ## by minute 
          value = mindate,
          animate = animationOptions(loop = TRUE, interval = 1000))
)




server <- function(input,output){

 display only location for an hour for a chosen used
 data <- reactive({
   x <- geo %>% ## 
     filter(time<=input$date_range & time>=input$date_range-hours(1), 
userid==input$userid)
 })


  output$mymap <- renderLeaflet({
   df <- data()

    m <- leaflet(data = df) %>%
     setView(lng = lngset, lat = latset, zoom = zoomset) %>% ## center 
     addTiles() %>%
     addCircles(lng = ~longitude,
                lat = ~latitude,
                 popup = paste("User", df$userid, "<br>",
                              "Year:", df$time))
    m


  })



}

## deploy the app
shinyApp(ui=ui, server=server)

Answer 1

Я попробую это:

library(shiny)
library(leaflet)
library(lubridate)
library(shinydashboard)
library(tidyverse)

latitude=c(37.4218, 37.4063)
longitude=c(-124.0831, -124.1190)
userid=c(1704, 1704)
time=c("2017-09-15 14:40:58", "2017-09-15 14:41:03")

## reproducible data 
geo<- as.data.frame(cbind(latitude,
                          longitude, 
                          userid, 
                          time),stringsAsFactors = F)

## data manipulation
geo<- geo %>% 
   mutate(time = ymd_hms(time)) %>%
   mutate(longitude=as.numeric(longitude), 
          latitude=as.numeric(latitude), 
       userid=as.numeric(userid))


region<- "US" ##"US" / "Boston" select region of initial view

if (region=="US") {
  lngset = -93.85
  latset = 37.45
  zoomset = 4
}
olddf <- data.frame()

mindate<-min(geo$time)
maxdate<-max(geo$time)+hours(1)

IDS<-unique(geo$userid)

ui=fluidPage(
  titlePanel("title"),
  leafletOutput("mymap",height = 500),
  selectInput(inputId = "userid", 
              label="user id", 
              choices = IDS),
  sliderInput("date_range", 
              "Choose Date:", 
              min = mindate, 
              max = maxdate, 
              step = 1, ## by minute 
              value = mindate,
              animate = animationOptions(loop = TRUE, interval = 1000))
)




server <- function(input,output){

  #display only location for an hour for a chosen used
  data <- reactive({
    x <- geo %>% ## 
      filter(time<=input$date_range & time>=input$date_range-hours(1), 
             userid==input$userid)
  })

 observe({
    df <- data()
    print(df)
    leafletProxy("mymap",data = df) %>%
    #  setView(lng = lngset, lat = latset) %>% ## center 
      addTiles() %>%
      addCircles(lng = ~longitude,
                 lat = ~latitude,
                 popup = paste("User", df$userid, "<br>",
                               "Year:", df$time))
  })
  output$mymap <- renderLeaflet({
    m <- leaflet() %>%
      setView(lng = lngset, lat = latset, zoom = zoomset) %>% ## center 
      addTiles() 
    m


   # m <- leaflet() %>%
    # #  setView(lng = lngset, lat = latset, zoom = zoomset) %>% ## center 
    #  addTiles() %>%
    #    addCircles(lng = ~longitude,
    #            lat = ~latitude,
                 #               #              popup = paste("User", df$userid, "<br>",
    #                     "Year:", df$time))
# 
#  m

  })



}

## deploy the app
shinyApp(ui=ui, server=server)

1. Будьте осторожны при конвертации из factor в numeric.Обратите внимание на различия между

geo <- as.data.frame (cbind (широта, долгота, идентификатор пользователя, время)) </p>

## data manipulation
geo<- geo %>% 
mutate(time = ymd_hms(time))%>% 
mutate(longitude=as.numeric(longitude), 
     latitude=as.numeric(latitude), 
     userid=as.numeric(userid))

и

## reproducible data 
geo<- as.data.frame(cbind(latitude,
                          longitude, 
                          userid, 
                          time),stringsAsFactors = F)

## data manipulation
geo<- geo %>% 
   mutate(time = ymd_hms(time)) %>%
   mutate(longitude=as.numeric(longitude), 
          latitude=as.numeric(latitude), 
       userid=as.numeric(userid))

Для изменения в реальном времени leaflet используйте leafletProxy (https://rstudio.github.io/leaflet/shiny.html).. Я установил setView(lng = lngset, lat = latset) %>% ## center в качестве прокомментированного кода, потому что мы не хотим перерисовывать карту каждый раз, когда пользователь масштабирует или перемещается.

Лучший!