计算和绘制任意 rasterLayer 的矢量场

Ric*_*loo 8 r geospatial ggplot2 r-raster

问题陈述:

随着ggquiver::geom_quiver()我们就可以绘制矢量场,只要我们知道xyxend,和yend

  1. 如何计算任意RasterLayer海拔的这些参数?
  2. 我如何确保这些箭头的大小表示该特定向量的斜率,以便箭头显示的长度与该位置的梯度成正比(例如,下面的第一个图)?

背景:

# ggquiver example

library(tidyverse)
library(ggquiver)
expand.grid(x=seq(0,pi,pi/12), y=seq(0,pi,pi/12)) %>%
  ggplot(aes(x=x,y=y,u=cos(x),v=sin(y))) +
  geom_quiver()
Run Code Online (Sandbox Code Playgroud)

在此处输入图片说明

一个相关的方法使用rasterVis::vectorplot,它依赖于raster::terrain(提供场单位 == CRS 单位)来计算和绘制矢量场。源代码在这里

library(raster)
library(rasterVis)
r <- getData('alt', country='FRA', mask=TRUE)
r <- aggregate(r, 20)
vectorplot(r, par.settings=RdBuTheme())
Run Code Online (Sandbox Code Playgroud)

在此处输入图片说明


结论:

到的综述,我想采取任意的rasterLayer海拔,将其转换为一个data.frame,计算xyxmax,和ymax的正视矢量场的组件尺寸的箭头,使得它们显示出在该点的相对倾斜(如在图1和 2 以上),并用ggquiver. 就像是:

names(r) <- "z"
rd <- as.data.frame(r, xy=TRUE)

# calculate x, y, xend, yend for gradient vectors, add to rd, then plot

ggplot(rd) + 
  geom_raster(aes(x, y, fill = z)) + 
  geom_quiver(aes(x, y, xend, yend))
Run Code Online (Sandbox Code Playgroud)

All*_*ron 6

实际上,您要问的是将 2D标量场转换为向量场。有几种不同的方法可以做到这一点。

raster 包包含函数terrain,它创建新的栅格层,这些层将为您提供每个点(即aspect)所需矢量的角度及其大小(斜率)。我们可以使用一点三角函数将它们转换为 所使用的南北和东西基本向量ggquiver,并将它们添加到我们的原始栅格中,然后再将整个事物转换为数据框。*

terrain_raster <- terrain(r, opt = c('slope', 'aspect'))
r$u <- terrain_raster$slope[] * sin(terrain_raster$aspect[])
r$v <- terr$slope[] * cos(terr$aspect[])
rd <- as.data.frame(r, xy = TRUE)
Run Code Online (Sandbox Code Playgroud)

然而,在大多数情况下,这不会成为一个好的情节。如果您不先聚合栅格,则图像上的每个像素都会有一个渐变,这将不会很好地绘制。另一方面,如果您进行聚合,您将拥有一个不错的矢量场,但您的栅格将看起来“块状”。因此,为您的绘图使用单个数据框可能不是最好的方法。

以下函数将获取一个栅格并使用叠加的矢量场对其进行绘制。您可以在不影响栅格的情况下调整矢量场的聚合量,并且可以为栅格指定任意颜色矢量。

raster2quiver <- function(rast, aggregate = 50, colours = terrain.colors(6))
{
  names(rast) <- "z"
  quiv <- aggregate(rast, aggregate)
  terr <- terrain(quiv, opt = c('slope', 'aspect'))
  quiv$u <- terr$slope[] * sin(terr$aspect[])
  quiv$v <- terr$slope[] * cos(terr$aspect[])
  quiv_df <- as.data.frame(quiv, xy = TRUE)
  rast_df <- as.data.frame(rast, xy = TRUE)

  print(ggplot(mapping = aes(x = x, y = y, fill = z)) + 
          geom_raster(data = rast_df, na.rm = TRUE) + 
          geom_quiver(data = quiv_df, aes(u = u, v = v), vecsize = 1.5) +
          scale_fill_gradientn(colours = colours, na.value = "transparent") +
          theme_bw())

  return(quiv_df)
}
Run Code Online (Sandbox Code Playgroud)

因此,在您的 France 示例中尝试一下,在首先定义类似的调色板之后,我们得到

pal <- c("#B2182B", "#E68469", "#D9E9F1", "#ACD2E5", "#539DC8", "#3C8ABE", "#2E78B5")

raster2quiver(getData('alt', country = 'FRA', mask = TRUE), colours = pal)
Run Code Online (Sandbox Code Playgroud)

在此处输入图片说明

现在为了证明它适用于任意光栅(前提是它分配了投影),让我们在转换为光栅的图像上测试它。这一次,我们有一个较低的分辨率,所以我们选择了一个较小的聚合值。我们还将为最低值选择透明颜色以提供更好的绘图:

在此处输入图片说明

rast <- raster::raster("https://i.stack.imgur.com/tXUXO.png")

# Add a fake arbitrary projection otherwise "terrain()" doesn't work:
projection(rast) <- "+proj=lcc +lat_1=48 +lat_2=33 +lon_0=-100 +ellps=WGS84"

raster2quiver(rast, aggregate = 20, colours = c("#FFFFFF00", "red"))
Run Code Online (Sandbox Code Playgroud)

在此处输入图片说明

*我应该指出,映射美学采用名为and 的参数,它们代表指向北和东的基向量。包使用 将它们转换为如果您更喜欢使用值,您可以只使用它来绘制矢量场,但这会使控制箭头的外观变得更加复杂。因此,此解决方案将找到的大小 geom_quiveruvggquiverxendyendstat_quiverxendyendgeom_segmentuv