如何將 plot 個向量正交到四邊形網格？

Question

我正在嘗試在 R 到 plot 單位向量中使用rgl package 與四邊形網格中的每個單元格正交。 我已經使用此頁面進行了一些指導，目前已經使用arrow3d繪制了一個四邊形網格表面和一些占位符向量，但我想讓這些向量與它們所包含的單元格正交並且全部相同的長度（例如長度為 1）。 有誰知道如何將正確的端點放入arrow3d以滿足此條件，或者有不同的方法？

library(raster)
library(rgl)
library(quadmesh)

m <- matrix(c(seq(0, 0.5, length = 5), 
              seq(0.375, 0, length = 4)), 3)
x <- seq(1, nrow(m)) - 0.5
y <- seq(1, ncol(m)) - 0.5
r <- raster(list(x = x, y = y, z = m))

qm <- quadmesh(r)
image(r)
op <- par(xpd = NA)
text(t(qm$vb), lab = 1:ncol(qm$vb)) #Plot index numbers for vertices

vrts<- list(c(9,10,14,13),
            c(10,11,15,14),
            c(11,12,16,15),
            c(5,6,10,9),
            c(6,7,11,10),
            c(7,8,12,11),
            c(1,2,6,5),
            c(2,3,7,6),
            c(3,4,8,7)) #Index for vertices of each raster cell starting from bottom left and moving to the right

shade3d(qm, col = "firebrick")
axes3d()
title3d(xlab="X", ylab="Y", zlab="Z")
for (i in 1:9) {
  row_number<- floor((i-1)/3)+1
  col_number<- ((i-1)%%3)+1
  p<- apply(qm$vb[1:3,  vrts[[i]]], mean, MARGIN = 1) #get current xyz position of raster cell
  rgl.spheres(x = p[1], y = p[2], z = p[3], r=0.1) #Plot points
  p0<- c(x[col_number], y[row_number],p[3]) #arrow start point
  p1<- c(x[col_number],y[row_number],p[3]+1) #arrow end point
  arrow3d(p0, p1) #Plot arrow
}

Answer 1

這很棘手。 基本的見解是：

1. 網格中的每個正方形都可以被認為是一個平面
2. 每個平面都可以用公式 z = a x + b y + c來定義
3. 系數a 、 b和c可以通過對位於每個正方形角上的 4 個頂點運行線性回歸來找到。
4. 矢量 [ -a , -b , 1 ] 垂直於平面
5. 向量 [ -a , -b , 1 ] / sqrt( a² + b² + 1² ) 的長度為 1
6. 箭頭底部位於每個正方形的中點
7. 箭頭提示位於每個正方形的底部加上向量 [ -a , -b , 1 ] / sqrt( a² + b² + 1² )

為了實現這一點，我們首先定義了幾個輔助函數：

midpoints <- function(x) diff(x)/2 + x[-length(x)]

centers_from_vertices <- function(v) {
  apply(apply(v, 1, midpoints), 1, midpoints)
}

現在我們可以為頂點和中心點創建 x、y、z 點列表，如下所示：

vertices <- lapply(asplit(qm$vb, 1), `dim<-`, value = dim(m) + 1)
centres  <- lapply(vertices, centers_from_vertices)

不必計算所有頂點並創建屬於每個正方形的列表，我們可以自動化該過程並在列表中為每個正方形提供頂點索引。

index <- matrix(seq(prod(dim(m) + 1)), nrow = nrow(m) + 1, byrow = TRUE)

indices <- unlist(lapply(seq(dim(m)[1]), function(i) {
  lapply(seq(dim(m)[2]), function(j) {
    index[0:1 + i, 0:1 + j]
    })
  }), recursive = FALSE)

現在我們可以使用上面的見解獲得每個箭頭的終點：

ends <- lapply(asplit(sapply(indices, function(i) {
  co <- coef(lm(z~x+y,  as.data.frame(lapply(vertices, c))[c(i),]))
  co <- -c(co[2], co[3], z = -1)
  co/sqrt(sum(co^2))
  }), 1), c)

ends <- Map(`+`, centres[1:3], ends)

最后，我們可以得出結果：

shade3d(qm, col = "firebrick")
axes3d()
title3d(xlab="X", ylab="Y", zlab="Z")
rgl.spheres(x = centres$x, y = centres$y, z = centres$z, r = 0.1)

for(i in 1:9) {
  arrow3d(c(centres$x[i], centres$y[i], centres$z[i]),
          c(ends$x[i], ends$y[i], ends$z[i]))
}

Answer 2

rgl:::showNormals() function 執行此操作。 它是一個內部 function，用於調試，它在每個頂點繪制包含在網格 object 中的法線。

將此 function 與您的數據一起使用存在幾個問題。 首先，作為內部 function，它如有更改，恕不另行通知。 所以我會復制它並使用它。

其次，它繪制網格的normals分量，而您的網格沒有。 您可以使用rgl::addNormals() function 添加法線，然后它就會起作用。 例如，

qmn <- addNormals(qm)
rgl:::showNormals(qmn)

如果你想讓法線向上，你可以在繪圖前說qmn$normals <- -qmn$normals 。

第三個問題是它使用了丑陋的"lines"類型的箭頭。 但是，如果您有 function 的副本，則可以對其進行修改。

第四個問題是箭頭在頂點，而不是中心。 如果你真的想要它們在中心，你需要在那里計算法線。 使用叉積（例如rgl:::xprod() ）計算一對向量的法線，但您必須決定使用哪對向量。 rgl不強制四邊形是平面的； 我不知道quadmesh是否可以。 這意味着對於四邊形的法線，您可能有不止一種選擇。