我正在研究shinydashboard（使用leaflet）获取国家气象局 (NWS) 多普勒雷达数据（通过 WMS）、NWS 危险 shapefile 数据和 NWS 警告 shapefile 数据。
我有一个反应性民意调查，每 60 秒刷新一次雷达、危险和警告数据。我将所有数据存储在一个临时目录中，并在每次刷新周期后清除临时目录，然后再摄取最新数据。我将系统时间附加到每个文件以防止数据缓存。
我遇到的问题是，每当我放大某个位置时，反应式轮询刷新也会重置缩放级别和缩放位置。如何在数据刷新期间保持缩放级别/缩放位置？
下面附上我的 Server.R 脚本
library(shiny)
library(ggplot2)
library(leaflet)
library(maptools)
library(RColorBrewer)
library(readr)
library(rgeos)
library(RMySQL)
library(rangeMapper)
library(rgdal)
library(utils)
tmpdir <- tempdir()
subDir <- paste(tmpdir,'shapefile',sep = '/')
if (dir.exists(subDir) == FALSE){
dir.create(subDir, showWarnings = FALSE)
}
wgs84 <-"+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs "
#Location of NWS hazard/warning polygons I want to download
baseurl <- 'http://www.srh.noaa.gov/ridge2/shapefiles/'
#Shiny Server start: the server represents the computational side of a shiny app.
server <- function(input, output, session) {
# reactive poll will refresh all data every 60 seconds.
pollData <- reactivePoll(60000, session,
checkFunc = function() {
#I clear out the temp directory with every reactive data refresh.
i <- 0
del <- list.files(subDir)
delcount <- length(del)
if(delcount > 0){
for (i in 1:delcount){
delfile <- del[i]
delfile <- paste(subDir,delfile,sep = '/')
if (file.exists(delfile)){
file.remove(delfile)
}
}
}
#The two NWS compressed shapefiles I want to download.
tar.files <- c('CurrentWarnings.tar.gz', 'CurrentHazards.tar.gz')
tar.count <- length(tar.files)
i <- 0
for (i in 1:tar.count){
#Downloads and untars the NWS shapefiles.
tar.file <- tar.files[i]
url <- paste(baseurl,tar.file,sep = '/')
tempfile <- paste(subDir,tar.file, sep = '/')
download.file(url, tempfile)
untar(tarfile = tempfile, exdir = subDir)
}
file.string <- 'current'
all.files <- list.files(path=subDir, pattern = paste(file.string,'_*',sep = ''))
all.files.no <- length(all.files)
system.time <- Sys.time()
i <- 0
for (i in 1:all.files.no){
#What I do here is append the system time to each NWS shapefile, for both the hazard shapefile and the warning shapefile.
file.name.ch <- all.files[i]
file.replace <- paste(file.string,system.time,sep = '_')
file.name.new <- gsub(file.string,file.replace,file.name.ch)
file.name.ch <- paste(subDir,file.name.ch,sep = '/')
file.name.new <- paste(subDir,file.name.new,sep = '/')
file.rename(file.name.ch,file.name.new)
}
layer.warning <- paste('current', system.time,'warnings',sep = '_')
layer.hazard <- paste('current', system.time,'hazards',sep = '_')
#I query the information behind the hazard and warning shapefiles, to extract a row count.
warning.rowc <- ogrInfo(dsn=subDir,layer= layer.warning)[[1]]
hazard.rowc <- ogrInfo(dsn=subDir,layer= layer.hazard)[[1]]
#If the shapefile is empty (no active warning polygons), then this is skipped. ReadOGR generates an error with an empty shapefile.
if (warning.rowc > 0){
warning.shape <- readOGR(dsn=subDir,layer=layer.warning)
warning.popup <- paste0("<strong>Warning Type: </strong>",
warning.shape$PROD_TYPE,
"<br><strong>Warning Issue Time: </strong>",
warning.shape$ISSUANCE,
"<br><strong>Warning Expiration: </strong>",
warning.shape$EXPIRATION)
}
#If the shapefile is empty (no active hazard polygons), then this is skipped. ReadOGR generates an error with an empty shapefile.
if (hazard.rowc > 0){
hazard.shape <- readOGR(dsn=subDir,layer= layer.hazard)
hazard.popup <- paste0("<strong>Hazard Type: </strong>",
hazard.shape$PROD_TYPE,
"<br><strong>Hazard Issue Time: </strong>",
hazard.shape$ISSUANCE,
"<br><strong>Hazard Expiration: </strong>",
hazard.shape$EXPIRATION)
}
#WMS tiling source is from Iowa State's agronomy department, and is rendering a nexrad radar image.
#If both the hazard and the warning shapefiles are non-empty, run this option.
output$map <- renderLeaflet({
if(warning.rowc > 0 & hazard.rowc > 0){
leaflet() %>% addTiles() %>% #setView(-75.75, 43.7, zoom = 8) %>%
addPolygons(data = hazard.shape, color = 'orange',opacity = 0.30, fillOpacity = 0.30, popup = hazard.popup) %>%
addPolygons(data = warning.shape, color = 'red',opacity = 1.0, fillOpacity = 0.30, popup = warning.popup) %>%
addWMSTiles(
paste("http://mesonet.agron.iastate.edu/cgi-bin/wms/nexrad/n0r.cgi",system.time,sep = ''),
layers = "nexrad-n0r-900913",
options = tileOptions(format = "image/png", transparent = TRUE,reuseTiles = FALSE),
attribution = "Weather data © 2017 IEM Nexrad",)
#If the hazard shapefile is non-empty and the wanring shapefile is empty, run this option.
}else if(warning.rowc < 1 & hazard.rowc > 0){
leaflet() %>% addTiles() %>% #setView(-75.75, 43.7, zoom = 8) %>%
addPolygons(data = hazard.shape, color = 'orange',opacity = 0.30, fillOpacity = 0.30, popup = hazard.popup) %>%
addWMSTiles(
paste("http://mesonet.agron.iastate.edu/cgi-bin/wms/nexrad/n0r.cgi",system.time,sep = ''),
layers = "nexrad-n0r-900913",
options = tileOptions(format = "image/png", transparent = TRUE,reuseTiles = FALSE),
attribution = "Weather data © 2017 IEM Nexrad",)
#If the hazard shapefile is empty and the warning shapefile is non-empty, run this option.
}else if(warning.rowc > 0 & hazard.rowc < 1){
leaflet() %>% addTiles() %>% #setView(-75.75, 43.7, zoom = 8) %>%
addPolygons(data = warning.shape, color = 'red',opacity = 1.0, fillOpacity = 0.30, popup = warning.popup) %>%
addWMSTiles(
paste("http://mesonet.agron.iastate.edu/cgi-bin/wms/nexrad/n0r.cgi",system.time,sep = ''),
layers = "nexrad-n0r-900913",
options = tileOptions(format = "image/png", transparent = TRUE,reuseTiles = FALSE),
attribution = "Weather data © 2017 IEM Nexrad",)
#If both the hazard and the warning shapefile are empty, run this option.
}else{
leaflet() %>% addTiles() %>% #setView(-75.75, 43.7, zoom = 8) %>%
addWMSTiles(
paste("http://mesonet.agron.iastate.edu/cgi-bin/wms/nexrad/n0r.cgi",system.time,sep = ''),
layers = "nexrad-n0r-900913",
options = tileOptions(format = "image/png", transparent = TRUE,reuseTiles = FALSE),
attribution = "Weather data © 2017 IEM Nexrad")
}
})
})
}
还有我的 ui.R 脚本：
library(shiny)
library(leaflet)
library(RColorBrewer)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10, right = 10
)
)