我想撰寫一個滑動視窗函式，以便使用從 t、t 1 和 t 2 年訓練的模型來預測 t 3 年的結果。這意味著對于 10 年的資料，所需的滑動視窗函式應該創建 7 個訓練測驗拆分并進行 7 個預測（對于 t 3、t 4、t 5、t 6、t 7、t 8，t 9 年）。
我想出了以下代碼，但結果沒有響鈴。不僅生成的物件長度不同，而且即使我嘗試手動完成預測任務，該predict函式實際上也會為一年的結果生成 3 個預測值，這沒有任何意義。如果有人能指出錯誤的來源，將不勝感激。
# generate the data
set.seed(123)
df <- data.frame(year = 2000:2009, # T = 10
y = c(1, 1, 1, 1, 0, 0, 1, 0, 0, 0),
var1 = runif(10, min=0, max=1),
var2 = runif(10, min=1, max=2))
# store predicted values in a list
pred <- list()
# loop from the 1st year to the T-3 year
for(i in 2000:2007){
df_sub1 <- subset(df, year == c(i, i 1, i 2))
mod <- glm(y~var1 var2, data=df_sub1, family=binomial())
df_sub2 <- subset(df, year == i 3)
pred[[i]] <- predict(mod, data=df_sub2, type = "response")
}
# error message
Error in family$linkfun(mustart) :
Argument mu must be a nonempty numeric vector
In addition: Warning messages:
1: In year == c(i, i 1, i 2) :
longer object length is not a multiple of shorter object length
2: In year == c(i, i 1, i 2) :
longer object length is not a multiple of shorter object lengthuj5u.com熱心網友回復：
==當 rhs 的長度 > 1 時，錯誤/警告來自使用。使用%in%
pred <- vector('list', 8)
names(pred) <- 2000:2007
for(i in 2000:2007){
df_sub1 <- subset(df, year %in% c(i, i 1, i 2))
mod <- glm(y~var1 var2, data=df_sub1, family=binomial())
df_sub2 <- subset(df, year == (i 3))
pred[[as.character(i)]] <- tryCatch(predict(mod,
newdata=df_sub2, type = "response"), error = function(e) NA_real_)
}
-輸出
> pred
$`2000`
4
1
$`2001`
5
1
$`2002`
6
1
$`2003`
7
2.220446e-16
$`2004`
8
0.1467543
$`2005`
9
0.001408577
$`2006`
10
2.220446e-16
$`2007`
[1] NA
uj5u.com熱心網友回復：
這是使用 packagezoo的功能之一將功能應用于滾動視窗的另一種方法。要應用的功能，roll_pred幾乎是akrun 的復制粘貼，只是子集的創建不同。
# generate the data
set.seed(123)
df <- data.frame(year = 2000:2009, # T = 10
y = c(1, 1, 1, 1, 0, 0, 1, 0, 0, 0),
var1 = runif(10, min=0, max=1),
var2 = runif(10, min=1, max=2))
library(zoo, quietly = TRUE)
#>
#> Attaching package: 'zoo'
#> The following objects are masked from 'package:base':
#>
#> as.Date, as.Date.numeric
roll_pred <- function(year, X) {
i <- match(year, X$year)
df_sub1 <- X[i, ]
mod <- glm(y ~ var1 var2, data = df_sub1, family = binomial())
df_sub2 <- X[ i[length(year)] 1, ]
tryCatch(predict(mod, newdata = df_sub2, type = "response"),
error = function(e) NA_real_)
}
rollapplyr(df$year, 3, roll_pred, X = df)
#> 4 5 6 7 8 9
#> 1.000000e 00 1.000000e 00 1.000000e 00 2.220446e-16 1.467543e-01 1.408577e-03
#> 10 NA
#> 2.220446e-16 NA
由reprex 包(v2.0.1)創建于 2022-06-05
轉載請註明出處，本文鏈接：https://www.uj5u.com/qianduan/487219.html