将 3D 表面拟合到点数据集 [R]

Question

我一直在尝试将多项式曲面拟合到一组具有 3 个坐标的点。

设数据为：

DATA <- with(mtcars, as.data.frame(cbind(1:32, wt,disp,mpg)))

我一直在尝试使用以下方法绘制表面：

1. plot3d 来自 rgl 包，
2. 使用rsm包，
3. scatterplot3d 包。

例如：

library(scatterplot3d)
attach(mtcars)
DATA <- as.data.frame(cbind(1:32, wt,disp,mpg))
scatterplot3d(wt,disp,mpg, main="3D Scatterplot")
model <- loess(mpg ~wt + disp, data=DATA)
x <-range(DATA$wt)
x <- seq(x[1], x[2], length.out=50)    
y <- range(DATA$disp)
y <- seq(y[1], y[2], length.out=50)
z <- outer(x,y, 
       function(wt,disp)
         predict(model, data.frame(wt,disp)))
z
p <- persp(x,y,z, theta=30, phi=30, 
       col="lightblue",expand = 0.5,shade = 0.2,
       xlab="wt", ylab="disp", zlab="mpg")

我也尝试过使用 surf.ls 功能：

surf.ls(2,DATA[,2],DATA[,3],DATA[,4])

但是我得到的看起来像这样： 我真的不知道如何将其转换为 3D 图，更重要的是，如何获得最佳拟合曲面的公式。

我非常感谢您的帮助。

PS 我已经删除了上一篇文章，并在这篇文章中包含了更多详细信息。

Answer 1

试试这个：

attach(mtcars)
DATA <- as.data.frame(cbind(1:32, wt,disp,mpg))

x_wt <- DATA$wt
y_disp <- DATA$disp
z_mpg <- DATA$mpg

fit <- lm(z_mpg ~ poly(x_wt, y_disp, degree = 2), data = DATA)

要使用 rsm 绘图，请使用以下命令：

library(rsm)
image(fit, y_disp ~ x_wt)
contour(fit, y_disp ~ x_wt)
persp(fit, y_disp ~ x_wt, zlab = "z_mpg")

要使用 ggplot 进行绘图，请使用以下命令：

## ggplot
# Use rsm package to create surface model.
library(rsm)
SurfMod <- contour(fit, y_disp ~ x_wt)

# extract list values from rsm Surface Model 
Xvals <- SurfMod$`x_wt ~ y_disp`[1]
Yvals <- SurfMod$`x_wt ~ y_disp`[2]
Zvals <- SurfMod$`x_wt ~ y_disp`[3]

# Construct matrix with col and row names 
SurfMatrix <- Zvals$z
colnames(SurfMatrix) <- Yvals$y
rownames(SurfMatrix) <- Xvals$x

# Convert matrix to data frame
library(reshape2)
SurfDF <- melt(SurfMatrix)

library(ggplot2)
gg <- ggplot(data = SurfDF) +
      geom_tile(data = SurfDF, aes(Var1, Var2,z = value, fill = value)) +
      stat_contour(data = SurfDF, aes(Var1, Var2, z = value, color = ..level..)) +
      scale_colour_gradient(low = "green", high = "red") +
      geom_point(data = DATA, aes(wt, disp, z = mpg, color = mpg)) +
      geom_text(data = DATA, aes(wt, disp,label=mpg),hjust=0, vjust=0) +
      scale_fill_continuous(name="mpg") +
      xlab("x_wt") +
      ylab("y_disp")
library(directlabels)
direct.label.ggplot(gg, "angled.endpoints")

要查看所有可用的 direct.label 方法，请访问 http://directlabels.r-forge.r-project.org/docs/index.html

Answer 2

您也可以使用

plotly

绘制拟合曲面：

dat <- data.frame(ChickWeight) %>%
  mutate(Chick = as.numeric(Chick))

# polynomial (curvy) surfaces:
fit <- lm(weight ~ factor(Diet)*poly(Time, Chick, degree=2), data=dat)

dat$predicted3d <- predict(fit, data=dat)

# points.... 
p <- plot_ly(data = dat, x = ~Time, y = ~Chick, z = ~weight, color = ~Diet, type = "scatter3d", mode="markers", alpha=.95)
# surface 1
p <- add_trace(p, data = dat %>% filter(Diet == 1), x = ~Time, y = ~Chick, z = ~weight, color = ~Diet, type = "mesh3d", opacity=.95)
# surface 2
p <- add_trace(p, data = dat %>% filter(Diet == 2), x = ~Time, y = ~Chick, z = ~weight, color = ~Diet, type = "mesh3d", opacity=.95)
# surface 3
p <- add_trace(p, data = dat %>% filter(Diet == 3), x = ~Time, y = ~Chick, z = ~weight, color = ~Diet, type = "mesh3d", opacity=.95)
# surface 4
p <- add_trace(p, data = dat %>% filter(Diet == 4), x = ~Time, y = ~Chick, z = ~weight, color = ~Diet, type = "mesh3d", opacity=.95)

p