我试着在R中画一个类似于this的图形.基本上X和Y代表坐标(例如lon/lat),Z代表海拔.我想绘制一个三维条形图,以高程作为条形高度,然后显示一条平滑的拟合Z值曲线.我可以用barplot3d获得3d条形图,但我不确定是否可以在上面添加拟合曲线.有人知道怎么做吗?下面是一些示例代码,演示了我迄今为止的try .

library(rgl)
library(barplot3d)
library(tidyverse)

x_mat<- matrix(rep(-1:1, each=3),nrow = 3) #x coordinates
y_mat<- matrix(rev(rep(-1:1, each=3)),nrow = 3, byrow = TRUE) #y coordinates

df<- data.frame(x = as.vector(x_mat), y = as.vector(y_mat)) #dataframe
set.seed(5)
df<- df %>% mutate(z= x^2+ y^2 + rnorm(n = 9, mean = 0, sd = 0.1)) #add elevation values

m<- lm(z ~ I(x^2)+I(y^2)+I(x*y)+x+y, data = df) #fitted curve

rgl.open()
rgl::plot3d(m)
barplot3d(rows=3,cols=3, z=df$z,scalexy=1, gap=0, alpha=0.4,theta=30,phi=50,
          topcolors = "gray", gridlines = TRUE)

enter image description here

Update: More complicated example

曲线似乎与非对称曲线的当前解不正确相交.

library(rgl)
library(barplot3d)
library(tidyverse)

x_mat<- matrix(rep(-1:1, each=3),nrow = 3) #x coordinates
y_mat<- matrix(rev(rep(-1:1, each=3)),nrow = 3, byrow = TRUE) #y coordinates
A<- 0.2
B<- 0.2
C<- 0.4
D<- 0.4
E<- 0

df<- data.frame(x = as.vector(x_mat), y = as.vector(y_mat)) #dataframe
df<- df %>% mutate(z= A*x^2 + B*y^2 + C*x*y + D*x + E*y) #add elevation values
z_mat<- matrix(data = df$z, nrow=3)

m<- lm(z ~ I(x^2)+I(y^2)+I(x*y)+x+y, data = df) #fitted curve
df$zpred<- predict(m, data.frame(x=df$x, y=df$y))
round(df$z-df$zpred,10) #Predictions should fit observations almost exactly (i.e. intersect exactly with bars)
#0 0 0 0 0 0 0 0 0 

n<- 10
xvals <- seq(-1, 1, len = n)
xmat <- replicate(n, seq(1.5, 3.5, len = n))
ymat <- t(xmat)
pred <- expand.grid(x = xvals, y = xvals)
zmat <- matrix(predict(m, pred), nrow = n, ncol = n)

barplot3d(rows=3,cols=3, z=df$z, gap=0, alpha=0.4, phi = 45,
          topcolors = "gray", sidecolors = "cyan", linecolors= "blue", gridlines = FALSE, zlabels = FALSE)
surface3d(x = xmat, y = zmat,  z = ymat-5, color = "purple", alpha = 0.7)
axes3d()

enter image description here

推荐答案

正如你可能知道的,你的3d表面相对于它应该在的位置旋转了90度.这不是你的错;这只是barplot3d的绘制方式与其他rgl个形状之间的差异.你还需要进行一些调整和重新zoom ,以使其适合.

barplot3d(rows=3,cols=3, z=df$z, gap=0, alpha=0.4, phi = 45,
          topcolors = "gray", gridlines = TRUE)

xvals <- seq(-1.5, 1.5, len = 10)
xmat <- replicate(10, seq(1, 4, len = 10))
ymat <- t(xmat)
pred <- expand.grid(x = xvals, y = xvals)
zmat <- matrix(predict(m, pred), 10, 10)

surface3d(xmat, zmat, color = "gold", alpha = 0.5, ymat - 5)

enter image description here


Update

要删除最高条上方的点,只需将其设置为NA.不过,在执行此操作时,您可能希望提高分辨率:

xvals <- seq(-1.5, 1.5, len = 100)
xmat <- replicate(100, seq(1, 4, len = 100))
ymat <- t(xmat) - 5

pred <- expand.grid(x = xvals, y = xvals)
zmat <- matrix(predict(m, pred), 100, 100)

zmat[zmat > 2] <- NA

barplot3d(rows=3,cols=3, z=df$z, gap=0, alpha=0.4, phi = 45,
          topcolors = "gray", gridlines = TRUE)

surface3d(xmat, zmat, color = "gold", alpha = 0.5, ymat)

enter image description here

请注意,这给图形带来了不可避免的参差不齐的边缘

另一种方法是收缩计算z的x、y轴网:

xvals <- seq(-1, 1, len = 100)
xmat <- replicate(100, seq(1.5, 3.5, len = 100))
ymat <- t(xmat) - 5

pred <- expand.grid(x = xvals, y = xvals)
zmat <- matrix(predict(m, pred), 100, 100)

barplot3d(rows=3,cols=3, z=df$z, gap=0, alpha=0.4, phi = 45,
          topcolors = "gray", gridlines = TRUE)

surface3d(xmat, zmat, ymat, color = "gray20", alpha = 0.5)

enter image description here


Further update

看起来我们需要进行双重翻转才能获得正确的z值:

barplot3d(rows=3,cols=3, z=df$z, gap=0, alpha=0.4, phi = 45,
          topcolors = "gray", sidecolors = "cyan", linecolors= "blue", 
          gridlines = FALSE, zlabels = FALSE)
surface3d(x = xmat, y = t(apply(t(apply(zmat, 1, rev)), 2, rev)),  
          z = ymat-5, color = "purple", alpha = 0.7)
axes3d()

enter image description here

R相关问答推荐

提取R中值和列名的所有可能组合

在边界外添加注释或标题

如何计算前一行的值,直到达到标准?

gganimate在使用shadow_mark选项时不保留所有过go 的标记

自动变更列表

在R中将特定列的值向右移动

是否可以创建一个ggplot与整洁判断的交互作用

按多列统计频次

如何使这些react 表对象相互独立?

在gggraph中显示来自不同数据帧的单个值

使用geom_iles在一个切片中包含多个值

如何将一些单元格的内容随机 Select 到一个数据框中?

优化从每个面的栅格中提取值

如何将这个小列表转换为数据帧?

使用来自嵌套列和非嵌套列的输入的PURRR:MAP和dplyr::Mariate

`-`是否也用于数据帧,有时使用引用调用?

如何阻止围堵地理密度图?

填充图例什么时候会有点?

如何将图例文本添加到图例符号中

有没有一种方法可以用非标准参数编写一个定制的ggploy主题函数?