繪制 GAM model 的 output

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

我想 plot output 的 model ，基本上是擬合曲線。 當我做

# 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") )

我得到了所需的 output 圖（對原始標簽表示歉意）：

[

但是，兩條繪制的曲線並不完全相同，我沒有設法找到要調整的參數以消除差異。 因此我想手動 plot 曲線。 這是我目前的嘗試。

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?

和錯誤的 output 圖

我似乎無法修復最后一張圖（似乎錯誤在geom_point()中）並添加置信區間，也無法找到調整前兩個以使其完全相同的位置。

Answer 1

差異可能是由於您使用了不同的擬合算法。 gam()中的默認值是（當前） method = "GCV.Cp"即使推薦的選項是使用method = "REML" 。 stat_smooth()使用method = "REML" 。 眾所周知，基於 GCV 的平滑度選擇在某些情況下會不夠平滑，這似乎是這里的情況，REML 解決方案是一條更平滑的曲線。

如果您在gam()調用中更改為method = "REML" ，則差異應該會消失。

也就是說，你真的不應該像這樣從 model 對象中提取東西 - 因為抵消$residuals不是你認為的那樣 - 在這種情況下它沒有用，因為這些是 PIRLS 算法的工作殘差。 使用提取器函數，如fitted() 、 residuals()等。

The easiest way to plot your own version of that drawn by plot.gam() is to capture the object returned by plot.gam() and then use that object to draw what you need.

通過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} package 或 Matteo Fasiolo 的 {mgcViz} package 作為可以為您完成這一切的選項。

{感謝}示例

例如 {gratia}

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

產生

Answer 2

@Gavin Simpson在這里提供的解決方案部分解決了這個問題，這意味着要使兩條曲線相等，需要添加method = "REML" 。 兩條曲線則具有相同的斜率。

但是，由於某種原因，當使用plot()或plot.gam()繪制gam() model 的 output 時，它應該不正確地擬合原始數據。 通過從plot.gam()返回的 object 中提取元素來手動繪制圖形也會發生同樣的情況。 我不確定為什么會這樣。 就我而言，擬合曲線向下移動，顯然“丟失”了它應該擬合的數據點。 在代碼下方和相應的 output 圖表下方，后者與您在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 function 使 plot 正確。 因此，我無知的猜測是，這可能是繪圖方法的問題。

工作解決方案

我無法證明問題出在繪圖功能上，但事實證明這與此問題中的問題相同，並且 OP 提供的部分解決方案在仍然使用gam() function 的同時修復了繪圖。 下面（他的）代碼適用於我的案例和相應的 output 圖。 如您所見，圖表繪制正確，曲線符合預期的數據。 我想說這可能會證實我的假設，即使我無法證明它，因為我知識不夠。

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")