обновить данные из HTML в блестящем приложении, не перезапуская его? - PullRequest
0 голосов
/ 03 февраля 2019

Мне нужно постоянно обновлять данные, например = 60 секунд [приложение в режиме реального времени] и выражать их на карте через invalidlater ().

Основная цель - обновить глобальные данные, которые загружаются с использованиемэти данные каждый раз, когда сервер запускается без перезапуска самого сервера или с помощью другой функции [реактивныйPoll или invalidateLater].

  server <- function(input, output, session) {

  ##########UP DATE DATA #############
  url <- "http://ds.iris.edu/seismon/eventlist/index.phtml"

  data <- read_html(url) %>% 
    html_node("table") %>% 
    html_table(fill = TRUE)



    #Pallete group
  data$mag_group <- cut(data$MAG,c(0,3.9,4.9,5.9,6.9,7.9,10),labels = c(c("0 a 3.9", ">3.9 a 4.9", ">4.9 a 5.9", ">5.9 a 6.9", ">6.9 a 7.9",">7.9 a 10")))
  #### Pop up de los sismos y placas ##################
      pu <- paste("<b>Magnitud:</b>", as.character(data$MAG), "<br>",
          "<b>Profunidad:</b>", as.character(data$DEPTHkm), "km<br>",
          "<b>Fecha y hora:</b>", as.character(data$`DATE and TIME (UTC)`), "NST",
          "<br>","<b>Evento (ID):</b>", data$`IRIS ID  (Other info)`,"<br>",
          "<b>Lugar:</b>", data$`LOCATION   
                       (Shows interactive map)`)

  pop <- paste("<b>Tipo de falla:</b>", as.character(plates$HAZ_PLATES), "<br>",
           "<b>Nombre:</b>",as.character(plates$HAZ_PLAT_1), "km<br>")

  #Creacion de paletas de colores para los sismos
  pallet <- colorFactor(c("aquamarine","palegoldenrod", "slateblue4", "indianred1", "red1","yellow"),
                    domain = data$mag_group)

  #render de mapa, añadido de opciones de mapas, situar vista predeterminada,repeticion de datos
  output$quakemap <- renderLeaflet({
invalidateLater(120000, session)# se recargue el mapa, revisar
leaflet(data$mag,options = list(worldCopyJump = T,maxBounds = list(
  list(-90, -360),
  list(90, 360)))) %>%
      addScaleBar(position = c("bottomleft"),options = scaleBarOptions(maxWidth =100, metric = T ))%>%
      addProviderTiles(providers$CartoDB.Positron, group = 'Positron Carto')  %>%
  addProviderTiles(providers$CartoDB.DarkMatter, group = 'Dark Matter') %>%
  addProviderTiles(providers$OpenStreetMap, group = 'Open SM')  %>%
  addProviderTiles(providers$Stamen.Toner, group = 'Toner')  %>%
  addProviderTiles(providers$Esri.NatGeoWorldMap, group = 'NG World') %>%
  setView((80.000 + 88.183)/2, (25.767 + 30.450)/2,  zoom = 4) %>%

  addCircles(data = data,
             lng = ~LON,
             lat = ~LAT,
             radius = ~MAG*5000,
             fillOpacity = 0.7,
             opacity = 0.2,
             weight = 1,
             color = ~pallet(mag_group),
             popup=pu,
             group = "Sismos (magnitudes)",
             highlight = highlightOptions(
               weight = 2,
               fillColor = "#235d72",
               bringToFront = TRUE,
               sendToBack = TRUE))%>%
  addLegend(
    "bottomright", pal = pallet,
    values = sort(data$mag_group),
    title = "Magnitud"
    # labFormat = labelFormat()
  )%>%

  addPolylines(data=plates,
               color = "#e34f6f",
               weight = 2,
               popup =pop,
               group = "Placas tectonicas",
               highlight = highlightOptions(
                 weight = 4,
                 color = "blue",
                 bringToFront = TRUE,
                 sendToBack = TRUE))%>%
  #add de panel de control de mapas y capas
  addLayersControl(
    baseGroups = c('Positron Carto','Dark Matter','Open SM', 'Toner', 'NG World'),
    overlayGroups = c('Sismos (magnitudes)',
                      'Placas tectonicas'),
    options =layersControlOptions(collapsed = T))
  })


  #render de tabla debajo de mapa
  output$table <- DT::renderDataTable({
invalidateLater(120000, session)#se recargue la tabla, revisar.
DT::datatable(
  data = data,
  colnames = c('Fecha y hora', 'Latitud','Longitud', 'Magnitud','Profundidad (km)','Localización','Evento (ID)','Rango en simbología'),
  extensions = "Scroller",
  width = "100%",options = list(
    autoWidth = TRUE, pageLength = 5)
    )
  })
}
shinyApp(ui, server)
...