R中的多層多項式回歸

Question

我一直在嘗試在R中擬合順序多項式回歸模型，並遇到以下問題：雖然poly(x)提供了一種快速的方法，但此函數不遵守分層原則，該原則粗略地指出在移至更高階之前，所有模型中應包含低階項。

這里的一種解決方案可能是像我對下面的玩具數據集所做的那樣自己親自選擇進入模型的順序

pred<-matrix(c(rnorm(30),rnorm(30)),ncol=2)
y<-rnorm(30)

polys<-poly(pred,degree=4,raw=T)
z<-matrix(c(
#order 2
polys[,2],polys[,6],polys[,9],
#order 3
polys[,3],polys[,7],polys[,10],polys[,12],
#order 4
polys[,4],polys[,8],polys[,11],polys[,13],polys[,14]),
ncol=12)

polyreg3<-function(x){
BICm<-rep(0,dim(x)[2])
for(i in 1:dim(x)[2]){
model<-lm(y~pred[,1]+pred[,2]+x[,1:i]) #include one additional term each time
BICm[i]<-BIC(model)
}
list(BICm=BICm)
}

polyreg3(z)
which.min(polyreg3(z)$BICm)

但這對於較大次數的多項式來說在很大程度上是不切實際的。 我當時在想，是否有辦法最好地通過修改我的代碼來解決這個問題？

Answer 1

如果我理解正確，那么您不僅需要原始的獨立變量，還需要可以在一定程度下創建的所有變量組合。

數據除以三個因變量，原始自變量和由model.frame()創建的給定度數的額外變量（為簡單起見，這里為2）。

然后，通過combn()和Map()獲得額外變量的所有組合，因為選擇列的方式是可變的（1到＃列）。

要擬合的數據集由cbind()創建，它們是自變量（ ind ）和原始自變量（ original ）以及變量的額外組合（ extra ）。

最終lm() BIC()獲得BIC()值。

如果希望獲得更高的學位，則必須進行多次試驗。 例如，如果度為3，則應同時應用2度和3度。

set.seed(1237)
# independent variable
des <- data.frame(y = rnorm(30))
# dependent variables
pred<-matrix(c(rnorm(30), rnorm(30)), ncol=2)
# model frame given degree, 4095 combinations when degree = 4, set degree = 2 for simplicity
polys <- as.data.frame(poly(pred, degree = 2, raw = T))
# original independent variables
original <- polys[,c(names(polys)[names(polys) == "1.0" | names(polys) == "0.1"])]
# extra variables made by model.frame()
extra <- polys[,c(names(polys)[names(polys) != "1.0" & names(polys) != "0.1"])]
# all combinations of extra variables
# Map() for variable q in nCq, do.call() to make list neat
com <- do.call(c, Map(combn, ncol(extra), 1:ncol(extra), simplify = FALSE))
com
[[1]]
[1] 1

[[2]]
[1] 2

[[3]]
[1] 3

[[4]]
[1] 1 2

[[5]]
[1] 1 3

[[6]]
[1] 2 3

[[7]]
[1] 1 2 3

# data combined, followed by fitting lm()
bic <- lapply(com, function(x) {
  data <- cbind(des, original, extra[, x, drop = FALSE])
  BIC(lm(y ~ ., data))
})

do.call(c, bic)
[1] 100.3057 104.6485 104.8768 103.6572 103.4162 108.0270 106.7262