R-график GAM 3D-поверхности, чтобы показать также фактические значения отклика

Question

Я довольно новичок в 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, чтобы я мог видеть, где прогнозируемые значения находятся ниже / выше оценки фактического ответа.Знаете ли вы, какой параметр я должен добавить на график, чтобы сделать это?Большое спасибо

Answer 1

Как отметил @ @ в комментариях, вы не должны использовать plot здесь, потому что он недостаточно гибок.Вот версия, основанная на указанном вопросе Грубый сплайн-фитинг (сплайн-интерполяция тонких пластин) в R с 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)

, который дает следующий график:

Возможно, вы не захотите делать прогнозы так далеко от наблюдаемых данных.Вы можете поместить 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)

, который производит этот график:

Наконец, вы можете использовать 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))))

Вот один из возможных видов:

Вы можете использовать мышь, чтобы повернуть эту, если вы хотите увидеть ее под другим углом.Еще одно преимущество заключается в том, что точки, которые должны быть скрыты поверхностью, действительно скрыты;в persp они начнут рисовать сверху, даже если они должны быть позади него.