R绘制gam 3D表面以显示实际响应值

时间:2019-03-07 15:28:16

标签: r rgl gam

我是R新手,面临以下挑战。 我将在此处共享我的代码,但由于无法共享原始数据帧,因此将其应用于其他数据帧。 这是我的代码:

fit = gam( carb ~ te(cyl, hp,   k=c(3,4)), data = mtcars)
plot(fit,rug=F,pers=T,theta=45,main="test")

使用我公司的数据,这会在Z轴上生成具有预测值的漂亮曲面。 我想将实际响应值添加为Z轴上的红点,以便可以看到预测值低于/高于估计实际响应的位置。 您知道要为此添加什么参数吗? 非常感谢

1 个答案:

答案 0 :(得分:2)

正如@李哲源在评论中指出的,您不应在此处使用plot,因为它不够灵活。这是基于参考问题Rough thin-plate spline fitting (thin-plate spline interpolation) in R with mgcv的版本。

# First, get the fit
library(mgcv)
fit <- gam( carb ~ te(cyl, hp,   k=c(3,4)), data = mtcars)

# Now expand it to a grid so that persp will work
steps <- 30
cyl <- with(mtcars, seq(min(cyl), max(cyl), length = steps) )

hp <-  with(mtcars, seq(min(hp), max(hp), length = steps) )
newdat <- expand.grid(cyl = cyl, hp = hp)
carb <- matrix(predict(fit, newdat), steps, steps)

# Now plot it
p <- persp(cyl, hp, carb, theta = 45, col = "yellow")

# To add the points, you need the same 3d transformation
obs <- with(mtcars, trans3d(cyl, hp, carb, p))
pred <- with(mtcars, trans3d(cyl, hp, fitted(fit), p))
points(obs, col = "red", pch = 16)

# Add segments to show where the points are in 3d
segments(obs$x, obs$y, pred$x, pred$y)

这将产生以下情节:

screen shot

您可能不想根据观察到的数据做出预测。您可以将NA的值放入carb中来避免这种情况。这段代码可以做到:

exclude <- exclude.too.far(rep(cyl,steps), 
                           rep(hp, rep(steps, steps)), 
                           mtcars$cyl, 
                           mtcars$hp, 0.15)  # 0.15 chosen by trial and error
carb[exclude] <- NA
p <- persp(cyl, hp, carb, theta = 45, col = "yellow")
obs <- with(mtcars, trans3d(cyl, hp, carb, p))
pred <- with(mtcars, trans3d(cyl, hp, fitted(fit), p))
points(obs, col = "red", pch = 16)
segments(obs$x, obs$y, pred$x, pred$y)

这将产生以下情节:

screen shot

最后,您可能想使用rgl包来获取动态图。经过与上述相同的操作,使用以下代码进行绘制:

library(rgl)
persp3d(cyl, hp, carb, col="yellow", polygon_offset = 1)
surface3d(cyl, hp, carb, front = "lines", back = "lines")
with(mtcars, points3d(cyl, hp, carb, col = "red"))
with(mtcars, segments3d(rep(cyl, each = 2), 
                        rep(hp, each = 2), 
                        as.numeric(rbind(fitted(fit),
                                   carb))))

这里是一种可能的观点:

screen shot

如果要从另一个角度查看它,可以使用鼠标旋转它。另一个优点是表面应该隐藏的点实际上是隐藏的。在persp中,即使它们位于后面,它们也将位于顶部。