绘制 GAM 模型的输出

Question

编辑：根据以下回复中的交互，我相信plot() 或plot.gam() 函数在处理gam 输出时可能存在一些问题。请参阅下面的回复。

---

我正在运行非参数回归 model <- gam(y ~ x, bs = "cs", data = data)。

我的数据如下所示，其中 x 在日志中。我有 273 个观察结果

          y         x
[1,] 0.010234756 10.87952
[2,] 0.009165001 10.98407
[3,] 0.001330975 11.26850
[4,] 0.008000957 10.97803
[5,] 0.008579472 10.94924
[6,] 0.009746714 11.01823

我想绘制模型的输出，基本上是拟合曲线。当我这样做时

# graph
plot(model)

或

ggplot(data = data, mapping = aes(x = x y = y)) +
  geom_point(size = 0.5, alpha = 0.5) +
  geom_smooth(method="gam", formula= y~s(x, bs = "cs") )

我得到了所需的输出图（对原始标签表示歉意）：

[

但是，两条绘制的曲线并不完全相同，我没有设法找到要调整的参数以消除差异。因此我想手动绘制曲线。 这是我目前的尝试。

model <- gam(y~ s(x), bs = "cs", data = data)
names(model)
# summary(model)
model_fit <- as.data.frame(cbind(model$y, model$fitted.values, 
                                   model$linear.predictors, data$x, 
                                   model$residuals))
names(model_fit) <- c("y", "y_fit", "linear_pred", "x", "res")


### here the plotting
ggplot(model_fit) +
  geom_point(aes(x = x, y = y_fit), size = 0.5, alpha = 0.5) +
  geom_line(aes(x = x, y = y_fit))
  

但是我收到以下警告

geom_path: Each group consists of only one observation. Do you need to adjust the group aesthetic?

和错误的输出图

我似乎无法修复最后一张图（似乎错误在 geom_point() 中）并添加置信区间，也无法找到调整前两个以使其完全相同的位置。

Answer 1

差异可能是由于您使用了不同的拟合算法。 gam() 中的默认值是（当前）method = "GCV.Cp"，即使推荐的选项是使用 method = "REML"。 stat_smooth() 使用 method = "REML"。众所周知，基于 GCV 的平滑度选择在某些情况下会不够平滑，而这里的情况似乎就是这种情况，REML 解决方案的曲线更加平滑。

如果您在gam() 调用中更改为method = "REML"，差异应该会消失。

也就是说，你真的不应该像那样从模型对象中剥离东西 - 因为 $residuals 不是你认为的那样 - 在这种情况下它没有用，因为这些是 PIRLS 的工作残差算法。使用fitted()、residuals()等提取函数。

绘制您自己的plot.gam() 绘制的版本的最简单方法是捕获plot.gam() 返回的对象，然后使用该对象绘制您需要的对象。

通过plot.gam()

df <- data_sim("eg1", seed = 2)
m <- gam(y ~ s(x2), data = df, method = "REML")
p_obj <- plot(m, residuals = TRUE)
p_obj <- p_obj[[1]] # just one smooth so select the first component
sm_df <- as.data.frame(p_obj[c("x", "se", "fit")])
data_df <- as.data.frame(p_obj[c("raw", "p.resid")])

## plot
ggplot(sm_df, aes(x = x, y = fit)) +
  geom_rug(data = data_df, mapping = aes(x = raw, y = NULL),
           sides = "b") +
  geom_point(data = data_df, mapping = aes(x = raw, y = p.resid)) +
  geom_ribbon(aes(ymin = fit - se, ymax = fit + se, y = NULL),
              alpha = 0.3) +
  geom_line() +
  labs(x = p_obj$xlab, y = p_obj$ylab)

哪个产生

或者，您可以查看我的 {gratia} 包或 Matteo Fasiolo 的 {mgcViz} 包，这些选项将为您完成这一切。

{gratia} 示例

例如 {gratia}

library('gratia')
draw(m, residuals = TRUE)

产生

Answer 2

@Gavin Simpson here 提供的解决方案部分解决了这个问题，这意味着要使两条曲线相等，需要添加method = "REML"。则两条曲线具有相同的斜率。

但是，由于某种原因，当使用plot() 或plot.gam() 绘制gam() 模型的输出时，曲线无法正确拟合原始数据。通过从plot.gam() 返回的对象中提取元素来手动绘制图形也会发生同样的情况。我不确定为什么会这样。就我而言，拟合曲线向下移动，显然“丢失”了它应该拟合的数据点。在代码和相应的输出图下方，后者与您在plot() 或plot.gam() 中得到的相同，只是将原始数据点添加到图中。

plot(model_1)
# or plot.gam(model_1)


data.plot = as.data.frame(cbind(b[[1]]$x, b[[1]]$fit, b[[1]]$se))
ggplot(data=data.plot, mapping = aes(x= data.plot$V1, y= data.plot$V2)) +
  geom_line(aes(x = V1, y = V2)) +
  geom_line(aes(x= V1, y = V2 + V3 ), linetype="dashed") +
  geom_line(aes(x= V1, y = V2 - V3 ), linetype ="dashed") +
  geom_point(data= df_abs, aes(x= log(prd_l_1999), y=prd_gr), size = 0.5, alpha = 0.5) 

错位的图表

要注意ggplot 函数可以正确绘制绘图。因此，我无知的猜测是，这可能是绘图方法的问题。

工作解决方案

我无法证明问题出在绘图功能上，但事实证明这与question 中的问题相同，并且 OP 提供的部分解决方案在仍然使用 @ 时修复了绘图987654338@函数。下面（他的）代码适用于我的案例和相应的输出图。如您所见，图表绘制正确，曲线符合预期的数据。我想说这可能会证实我的假设，即使我无法证明它，因为我的知识不够。

library(data.table)

model_1 <- gam(prd_gr ~ s(log(prd_l_1999)), bs = "cs",  data = df_abs, method = "REML")    


preds <- predict(model_1,se.fit=TRUE)
my_data <- data.frame(mu=preds$fit, low =(preds$fit - 1.96 * preds$se.fit), high = (preds$fit + 1.96 * preds$se.fit))

ggplot()+
  geom_line(data = my_data, aes(x=log(df_abs$prd_l_1999), y=mu), size=1, col="blue")+
  geom_smooth(data=my_data,aes(ymin = low, ymax = high, x=log(df_abs$prd_l_1999), y = mu), stat = "identity", col="green")