如何使用 gganimate 创建带有风动画的轮廓？
num*_*ers 2 r contour ggplot2 gganimate
我为特定一天的每个小时创建了风动画（单击播放动画视频）。我不想显示 19 个点，而是想创建一个在整个区域每小时使用这 19 个点进行插值/外推的等高线图 - 就像使用 ArcGIS 和样条插值工具生成的等高线图一样。
以下代码显示了我用来创建每小时风动画的 ggplot 和 gganimate。我只创建了一个小数据框作为完整 24 小时数据的子样本，因为我不熟悉将 csv 附加到此论坛中。有没有办法包含覆盖该区域的轮廓而不是geom_point？
library(ggplot2)
library(ggmap)
library(gganimate)
site <- c(1:18, 1:18)
date <- data.frame(date=c(rep(as.POSIXct("2018-06-07 00:00:00"),18),rep(as.POSIXct("2018-06-07 01:00:00"),18)))
long <- c(171.2496,171.1985, 171.2076, 171.2236,171.2165,171.2473,171.2448,171.2416,171.2243,171.2282,171.2344,171.2153,171.2532,171.2444,171.2443,171.2330,171.2356,171.2243)
lati <- c(-44.40450,-44.38520,-44.38530,-44.38750,-44.39195,-44.41436,-44.38798,-44.38934,-44.37958,-44.37836,-44.37336,-44.37909,-44.40801, -44.40472,-44.39558,-44.40971,-44.39577,-44.39780)
PM <- c(57,33,25,48,34,31,52,48,31,51,44,21,61,53,49,34,60,18,41,26,28,26,26,18,32,28,27,29,22,16,34,42,37,28,33,9)
ws <- c(0.8, 0.1, 0.4, 0.4, 0.2, 0.1, 0.4, 0.2, 0.3, 0.3, 0.2, 0.7, NaN, 0.4, 0.3, 0.4, 0.3, 0.3, 0.8, 0.2, 0.4, 0.4, 0.1, 0.5, 0.5, 0.2, 0.3, 0.3, 0.3, 0.4, NaN, 0.5, 0.5, 0.4, 0.3, 0.2)
wd <- c(243, 274, 227, 253, 199, 327, 257, 270, 209, 225, 230, 329, NaN, 219, 189, 272, 239, 237, 237, 273, 249, 261, 233, 306, 259, 273, 218, 242, 237, 348, NaN, 221, 198, 249, 236,252 )
PMwind <- cbind(site,date,long,lati,PM, ws, wd)
tmlat <- c(-44.425, -44.365)
tmlon <- c(171.175, 171.285)
tim <- get_map(location = c(lon = mean(tmlon), lat = mean(tmlat)),
zoom = 14,
maptype = "terrain")
ggmap(tim) +
geom_point(aes(x=long, y = lati, colour=PM), data=PMwind,
size=3,alpha = .8, position="dodge", na.rm = TRUE) +
geom_spoke(aes(x=long, y = lati, angle = ((270 - wd) %% 360) * pi / 180), data=PMwind,
radius = -PMwind$ws * .01, colour="yellow",
arrow = arrow(ends = "first", length = unit(0.2, "cm"))) +
transition_states(date, transition_length = 20, state_length = 60) +
labs(title = "{closest_state}") +
ease_aes('linear', interval = 0.1) +
scale_color_gradient(low = "green", high = "red")+
theme_minimal()+
theme(axis.text.x=element_blank(), axis.title.x=element_blank()) +
theme(axis.text.y=element_blank(), axis.title.y=element_blank()) +
shadow_wake(wake_length = 0.01)
这是可以做到的，但我想说，使用当前的工具远非如此简单。要从问题中的数据集转换为动画轮廓，我们需要解决以下障碍：
我们只有几个数据点，不规则地分布在给定区域。轮廓生成通常需要规则的点网格。
geom_contourggplot2 中的/stat_contour不能很好地处理边缘处的开放轮廓。请参阅此处GH 讨论，了解当我们尝试使用填充多边形的轮廓线时会发生什么。与轮廓相关的多边形不一定会随着时间的推移而持续存在：它们出现、消失、分裂成多个较小的多边形、合并成更大的多边形等。这使得 gganimate 中的事情变得困难，它需要知道帧 T 中的哪些元素对应于哪些元素T+1 帧中的元素，以便正确插入它们。
前两个障碍可以通过现有的解决方法来解决。第三个需要一些非正统的黑客攻击。
第 1 部分：插值不规则点
获取每个日期值的 PMwind 的经度/纬度/PM 值，并使用interpakima 包将它们插入到常规网格中。外插设置为 的双三次样条插值TRUE将为您提供 40 x 40 的规则网格（默认情况下，如果您希望网格更粗/更细，则更改/参数值）点以及插值 PM 值nx。ny
library(dplyr)
PMwind2 <- PMwind %>%
select(date, long, lati, PM) %>%
tidyr::nest(-date) %>%
mutate(data = purrr::map(data,
~ akima::interp(x = .$long, y = .$lati, z = .$PM,
linear = FALSE, # use spline interpolation
extrap = TRUE) %>%
akima::interp2xyz(data.frame = TRUE))) %>%
tidyr::unnest()
> str(PMwind2) # there are 2 x 40 x 40 observations, corresponding to 2 dates
'data.frame': 3200 obs. of 4 variables:
$ date: POSIXct, format: "2018-06-07" "2018-06-07" "2018-06-07" ...
$ x : num 171 171 171 171 171 ...
$ y : num -44.4 -44.4 -44.4 -44.4 -44.4 ...
$ z : num 31.8 31.4 31 30.6 30.3 ...
第 2 部分：使用替代包生成边缘具有闭合多边形的轮廓。
在这里，我使用了geom_contour_fillmetR包，这是 GH 线程中讨论的修复程序之一。（isoband 包方法看起来也很有趣，但它是较新的，而且我还没有测试过。）
library(ggplot2)
library(metR)
# define scale breaks to make sure the scale would be consistent across animated frames
scale.breaks = scales::fullseq(range(PMwind2$z), size = 10)
# define annotation layer & appropriate coord limits for map (metR's contour polygons
# don't go nicely with alpha < 1 in animation, as the order of layers could change,
# but we can overlay the map as a semi-transparent annotation layer over the contour
# polygons, instead of having ggmap layer beneath semi-transparent contour polygons.)
map.annotation <- list(
annotation_raster(tim %>% unlist() %>%
alpha(0.4) %>% # change alpha setting for map here
matrix(nrow = dim(tim)[1],
byrow = TRUE),
xmin = attr(tim, "bb")$ll.lon,
xmax = attr(tim, "bb")$ur.lon,
ymin = attr(tim, "bb")$ll.lat,
ymax = attr(tim, "bb")$ur.lat),
coord_quickmap(xlim = c(attr(tim, "bb")$ll.lon, attr(tim, "bb")$ur.lon),
ylim = c(attr(tim, "bb")$ll.lat, attr(tim, "bb")$ur.lat),
expand = FALSE))
p.base <- ggplot(PMwind2, aes(x = x, y = y, z = z))
# check static version of plot to verify that the geom layer works as expected
p.base +
geom_contour_fill(breaks = scale.breaks) +
facet_wrap(~date) +
map.annotation +
scale_fill_gradient(low = "green", high = "red",
aesthetics = c("colour", "fill"),
limits = range(scale.breaks)) +
theme_minimal()
第 3 部分：不是对轮廓线/多边形进行动画处理，而是对点值进行动画处理
生成动画绘图的每一帧后（但在将其打印/绘制到图形设备之前），获取其数据，创建一个新绘图（我们实际想要的绘图），并将其发送到图形设备。plot_frame我们可以通过将一些代码插入到ggproto 对象中的一个函数（gganimate:::Scene绘图发生的地方）来实现。
Scene2 <- ggproto(
"Scene2", gganimate:::Scene,
plot_frame = function(self, plot, i, newpage = is.null(vp), vp = NULL,
widths = NULL, heights = NULL, ...) {
plot <- self$get_frame(plot, i)
# for each frame, use the plot data interpolated by gganimate to create a new plot
new.plot <- ggplot(data = plot[["data"]][[1]],
aes(x = x, y = y, z = z)) +
geom_contour_fill(breaks = scale.breaks) +
ggtitle(plot[["plot"]][["labels"]][["title"]]) +
map.annotation +
scale_fill_gradient(low = "green", high = "red",
limits = range(scale.breaks)) +
theme_minimal()
plot <- ggplotGrob(new.plot)
# no change below
if (!is.null(widths)) plot$widths <- widths
if (!is.null(heights)) plot$heights <- heights
if (newpage) grid::grid.newpage()
grDevices::recordGraphics(
requireNamespace("gganimate", quietly = TRUE),
list(),
getNamespace("gganimate")
)
if (is.null(vp)) {
grid::grid.draw(plot)
} else {
if (is.character(vp)) seekViewport(vp)
else pushViewport(vp)
grid::grid.draw(plot)
upViewport()
}
invisible(NULL)
})
我们还需要定义一系列中间函数，以便动画使用 thisScene2而不是原来的gganimate:::Scene. 我之前在这里用同样的方法回答过另一个问题，并对这样做的利弊进行了一些讨论。
library(magrittr)
create_scene2 <- function(transition, view, shadow, ease, transmuters, nframes) {
if (is.null(nframes)) nframes <- 100
ggproto(NULL, Scene2, transition = transition,
view = view, shadow = shadow, ease = ease,
transmuters = transmuters, nframes = nframes)
}
ggplot_build2 <- gganimate:::ggplot_build.gganim
body(ggplot_build2) <- body(ggplot_build2) %>%
as.list() %>%
inset2(4,
quote(scene <- create_scene2(plot$transition, plot$view, plot$shadow,
plot$ease, plot$transmuters, plot$nframes))) %>%
as.call()
prerender2 <- gganimate:::prerender
body(prerender2) <- body(prerender2) %>%
as.list() %>%
inset2(3,
quote(ggplot_build2(plot))) %>%
as.call()
animate2 <- gganimate:::animate.gganim
body(animate2) <- body(animate2) %>%
as.list() %>%
inset2(7,
quote(plot <- prerender2(plot, nframes_total))) %>%
as.call()
最后，结果如下：
library(gganimate)
animate2(p.base +
geom_point(aes(color = z)) + # this layer will be replaced by geom_contour_fill in
# the final plot; it's here as the placeholder in
# order for gganimate to interpolate the relevant data
transition_time(date) +
ggtitle("{frame_time}"),
nframes = 30, fps = 10) # you can increase nframes for smoother transition
# (which would also be much bigger in file size)
