我正在寻找在 R 中绘制一系列绘图的定格动画。这些将显示点在轨迹上移动。我想在背景中显示一张地图，以便移动点的位置与地图坐标相对应。我一直这样做的方式是通过 RgoogleMaps，我在其中创建了一个地图对象，然后将其存储为 png 文件，然后使用 rasterImage 函数将其设置为绘图的背景。最终我试图让它成为一个闪亮的应用程序（下面的代码）。问题是我在闪亮时的动画速度太快（我可以放慢速度，但看起来不太好），所以情节变得不透明，因为它不能足够快地处理它。
基本上我想在每次迭代中显示一组具有相同背景的点。有没有更有效的方法来做到这一点？有没有办法，比如说，永久设置背景图像而不必每次都绘制它。我通过使用 recordPlot() 然后重播它节省了一些时间，但它仍然不能完全解决问题。我也试过看看我是否可以让光栅降低分辨率，但 as.raster 中的 maxpixels 和 col 参数似乎对我没有任何作用。
如果有一个类似的替代方案更有效并且可以实现大致相同的目标，我不会 100% 地使用 GoogleMaps。
library(shiny)
library(colorspace)
library(raster)
library(grDevices)
library(png)
#a png from Google Maps of the area above
bc_longlat_map_img <- png::readPNG("BC_googlemaps_point.png")
bc_longlat_map_img_ras <- grDevices::as.raster(bc_longlat_map_img, maxpixels=100)
bbox <- matrix(c(33.68208, -118.0554, 33.70493, -118.0279), byrow=TRUE, ncol=2)
rownames(bbox) <- c("lon","lat")
colnames(bbox) <- c("min","max")
#make some fake data
pt_data <- matrix(NA,nrow=1000, ncol=2)
colnames(pt_data) <- c("lon","lat")
#length of each side
plot_dims <- apply(bbox,1,diff)
pt_data[1:250,"lon"] <- bbox["lon","min"] + 0.2*plot_dims["lon"]
pt_data[1:250,"lat"] <- seq(bbox["lat","min"]+0.2*plot_dims["lat"], bbox["lat","max"]-0.2*plot_dims["lat"], length.out=250)
pt_data[251:500,"lon"] <- seq(bbox["lon","min"]+0.2*plot_dims["lon"], bbox["lon","max"]-0.2*plot_dims["lon"], length.out=250)
pt_data[251:500,"lat"] <- bbox["lat","max"] - 0.2*plot_dims["lat"]
pt_data[501:750,"lon"] <- bbox["lon","max"] - 0.2*plot_dims["lon"]
pt_data[501:750,"lat"] <- seq(bbox["lat","max"]-0.2*plot_dims["lat"], bbox["lat","min"]+0.2*plot_dims["lat"], length.out=250)
pt_data[751:1000,"lon"] <- seq(bbox["lon","max"]-0.2*plot_dims["lon"], bbox["lon","min"]+0.2*plot_dims["lon"], length.out=250)
pt_data[751:1000,"lat"] <- bbox["lat","min"] + 0.2*plot_dims["lat"]
#this is the slowest, have to replot the whole thing each time
for (ii in 1:1000) {
plot(bbox["lon",1]-1000, bbox["lat",1]-1000, xlim=bbox["lon",], ylim=bbox["lat",], xlab="Longitude", ylab="Latitude", las=1)
#read in current plots limits to fit Raster Image to
lims <- par()$usr
rasterImage(bc_longlat_map_img_ras, xleft=lims[1], ybottom=lims[3], xright=lims[2], ytop=lims[4])
points(x=pt_data[ii,"lon"], y=pt_data[ii,"lat"], pch=19, cex=3)
}
#plot first, then record, and only replay each time
#seems to be a bit faster
plot(bbox["lon",1]-1000, bbox["lat",1]-1000, xlim=bbox["lon",], ylim=bbox["lat",], xlab="Longitude", ylab="Latitude", las=1)
#read in current plots limits to fit Raster Image to
lims <- par()$usr
rasterImage(bc_longlat_map_img_ras, xleft=lims[1], ybottom=lims[3], xright=lims[2], ytop=lims[4])
plot_back <- recordPlot()
for (ii in 1:1000) {
replayPlot(plot_back)
points(x=pt_data[ii,"lon"], y=pt_data[ii,"lat"], pch=19, cex=3)
}
#example without the map background. very fast.
for (ii in 1:1000) {
plot(bbox["lon",1]-1000, bbox["lat",1]-1000, xlim=bbox["lon",], ylim=bbox["lat",], xlab="Longitude", ylab="Latitude", las=1)
points(x=pt_data[ii,"lon"], y=pt_data[ii,"lat"], pch=19, cex=3)
}
我试图实现的闪亮应用程序看起来像这样（代码是重复的）：
shark_vis <- shinyApp(
ui= shinyUI(
fluidPage(
sidebarLayout(
sidebarPanel("Inputs",
sliderInput("iter","Progress of simulation",value=1, min=1, max=1000, round=TRUE, step=1,
animate=animationOptions(interval=100, loop=FALSE))),
mainPanel(plotOutput("plot"))
)
)
),
server=shinyServer(
function(input, output) {
#current image dimensions
bbox <- matrix(c(33.68208, -118.0554, 33.70493, -118.0279), byrow=TRUE, ncol=2)
rownames(bbox) <- c("lon","lat")
colnames(bbox) <- c("min","max")
#make some fake data
pt_data <- matrix(NA,nrow=1000, ncol=2)
colnames(pt_data) <- c("lon","lat")
#length of each side
plot_dims <- apply(bbox,1,diff)
pt_data[1:250,"lon"] <- bbox["lon","min"] + 0.2*plot_dims["lon"]
pt_data[1:250,"lat"] <- seq(bbox["lat","min"]+0.2*plot_dims["lat"], bbox["lat","max"]-0.2*plot_dims["lat"], length.out=250)
pt_data[251:500,"lon"] <- seq(bbox["lon","min"]+0.2*plot_dims["lon"], bbox["lon","max"]-0.2*plot_dims["lon"], length.out=250)
pt_data[251:500,"lat"] <- bbox["lat","max"] - 0.2*plot_dims["lat"]
pt_data[501:750,"lon"] <- bbox["lon","max"] - 0.2*plot_dims["lon"]
pt_data[501:750,"lat"] <- seq(bbox["lat","max"]-0.2*plot_dims["lat"], bbox["lat","min"]+0.2*plot_dims["lat"], length.out=250)
pt_data[751:1000,"lon"] <- seq(bbox["lon","max"]-0.2*plot_dims["lon"], bbox["lon","min"]+0.2*plot_dims["lon"], length.out=250)
pt_data[751:1000,"lat"] <- bbox["lat","min"] + 0.2*plot_dims["lat"]
#plot and store
plot(bbox["lon",1]-1000, bbox["lat",1]-1000, xlim=bbox["lon",], ylim=bbox["lat",], xlab="Longitude", ylab="Latitude", las=1)
#read in current plots limits to fit Raster Image to
lims <- par()$usr
rasterImage(bc_longlat_map_img_ras, xleft=lims[1], ybottom=lims[3], xright=lims[2], ytop=lims[4])
plot_back <- recordPlot()
output$plot <- renderPlot({
replayPlot(plot_back)
points(x=pt_data[input$iter,"lon"], y=pt_data[input$iter,"lat"], pch=19, cex=3, col=1:2)
})
}
)
)
runApp(shark_vis)
