按日期回归循环答案

【问题标题】：Regression Loop By Date按日期回归循环
【发布时间】：2021-10-17 13:53:21
【问题描述】：

下面是我正在处理的数据的 100 行样本：

    structure(list(`Team Code` = c(107, 277, 129, 1320, 27, 694, 
231, 306, 314, 465, 164, 380, 295, 440, 367, 458, 428, 528, 574, 
772, 648, 736, 473, 650, 667, 732, 140, 695, 718, 749, 731, 758, 
490, 786, 14, 86, 153, 688, 156, 157, 244, 416, 327, 674, 204, 
432, 254, 47, 508, 51, 30, 709, 690, 725, 466, 90, 108, 529, 
110, 697, 147, 37, 202, 559, 207, 754, 2, 721, 228, 415, 236, 
726, 255, 67, 257, 457, 277, 418, 290, 392, 331, 539, 355, 742, 
365, 796, 31, 366, 235, 400, 312, 414, 43, 716, 434, 768, 301, 
454, 469, 626), `Opponent Code` = c(277, 107, 1320, 129, 694, 
27, 306, 231, 465, 314, 380, 164, 440, 295, 458, 367, 528, 428, 
772, 574, 736, 648, 650, 473, 732, 667, 695, 140, 749, 718, 758, 
731, 786, 490, 86, 14, 688, 153, 157, 156, 416, 244, 674, 327, 
432, 204, 47, 254, 51, 508, 709, 30, 725, 690, 90, 466, 529, 
108, 697, 110, 37, 147, 559, 202, 754, 207, 721, 2, 415, 228, 
726, 236, 67, 255, 457, 257, 418, 277, 392, 290, 539, 331, 742, 
355, 796, 365, 366, 31, 400, 235, 414, 312, 716, 43, 768, 434, 
454, 301, 626, 469), Year = c(2016, 2016, 2016, 2016, 2016, 2016, 
2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 
2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 
2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 
2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 
2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 
2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 
2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 
2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 2016, 
2016, 2016, 2016, 2016, 2016, 2016), Date = structure(c(17040, 
17040, 17045, 17045, 17045, 17045, 17045, 17045, 17045, 17045, 
17045, 17045, 17045, 17045, 17045, 17045, 17045, 17045, 17045, 
17045, 17045, 17045, 17045, 17045, 17045, 17045, 17045, 17045, 
17045, 17045, 17045, 17045, 17045, 17045, 17046, 17046, 17046, 
17046, 17046, 17046, 17046, 17046, 17046, 17046, 17046, 17046, 
17046, 17046, 17046, 17046, 17046, 17046, 17046, 17046, 17046, 
17046, 17047, 17047, 17047, 17047, 17047, 17047, 17047, 17047, 
17047, 17047, 17047, 17047, 17047, 17047, 17047, 17047, 17047, 
17047, 17047, 17047, 17047, 17047, 17047, 17047, 17047, 17047, 
17047, 17047, 17047, 17047, 17047, 17047, 17047, 17047, 17047, 
17047, 17047, 17047, 17047, 17047, 17047, 17047, 17047, 17047
), class = "Date"), HomeTeam = c(0, 0, 1, 0, 0, 1, 1, 0, 0, 1, 
1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 
0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 
1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 
0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 0, 1, 
0, 1, 1, 0, 0, 1), Points = c(51, 31, 49, 3, 13, 20, 13, 34, 
13, 63, 24, 21, 20, 17, 70, 14, 30, 23, 14, 46, 13, 10, 48, 21, 
0, 24, 28, 7, 3, 7, 45, 6, 48, 14, 22, 16, 7, 33, 7, 44, 13, 
28, 13, 26, 61, 14, 21, 31, 7, 55, 10, 31, 13, 28, 30, 27, 28, 
53, 24, 31, 19, 13, 24, 45, 45, 42, 21, 37, 3, 70, 16, 52, 17, 
14, 33, 24, 3, 63, 13, 52, 13, 33, 13, 36, 14, 16, 21, 20, 24, 
7, 45, 21, 17, 57, 11, 26, 52, 3, 0, 31), OppPoints = c(31, 51, 
3, 49, 20, 13, 34, 13, 63, 13, 21, 24, 17, 20, 14, 70, 23, 30, 
46, 14, 10, 13, 21, 48, 24, 0, 7, 28, 7, 3, 6, 45, 14, 48, 16, 
22, 33, 7, 44, 7, 28, 13, 26, 13, 14, 61, 31, 21, 55, 7, 31, 
10, 28, 13, 27, 30, 53, 28, 31, 24, 13, 19, 45, 24, 42, 45, 37, 
21, 70, 3, 52, 16, 14, 17, 24, 33, 63, 3, 52, 13, 33, 13, 36, 
13, 16, 14, 20, 21, 7, 24, 21, 45, 57, 17, 26, 11, 3, 52, 31, 
0)), row.names = c(1489L, 1490L, 297L, 298L, 1453L, 1454L, 1915L, 
1916L, 2121L, 2122L, 2651L, 2652L, 3425L, 3426L, 3535L, 3536L, 
4759L, 4760L, 5077L, 5078L, 5405L, 5406L, 5421L, 5422L, 5771L, 
5772L, 6239L, 6240L, 6845L, 6846L, 7537L, 7538L, 7813L, 7814L, 
355L, 356L, 489L, 490L, 509L, 510L, 1135L, 1136L, 2175L, 2176L, 
3317L, 3318L, 3755L, 3756L, 4293L, 4294L, 6607L, 6608L, 6993L, 
6994L, 8043L, 8044L, 85L, 86L, 145L, 146L, 381L, 382L, 815L, 
816L, 893L, 894L, 899L, 900L, 909L, 910L, 1129L, 1130L, 1263L, 
1264L, 1353L, 1354L, 1499L, 1500L, 1671L, 1672L, 2301L, 2302L, 
2409L, 2410L, 2469L, 2470L, 2475L, 2476L, 2789L, 2790L, 2933L, 
2934L, 3315L, 3316L, 3415L, 3416L, 3449L, 3450L, 3735L, 3736L
), class = "data.frame")

完整的数据集包含大约 8000 个观察结果，其中列出了游戏中大约 500 个不同的统计数据。我正在尝试为给定时间点的每个团队统计数据获取调整后的累积平均值。例如，10/1 的球队在 5 场比赛中每场比赛得分的累积平均值可能为 45.0；但是，我想使用岭回归来调整这个数字以获得日程安排的强度。这背后的理论来自以下article。我基本上需要一个执行以下操作的循环：

对于数据集中的每个唯一日期，我们会针对之前的每个日期以及一次一个统计数据过滤数据集。我们还需要按季节（年份列）对数据进行分组，因此我们只引入该季节的数据。（我们可以为每一行运行一个循环，但由于日期是重复的，我认为按日期而不是按行循环会产生更快的结果）。 Points 和 2016-09-02 的示例数据（温度）示例。
```
temp <- filter(temp, temp$Date < "2016-09-02")
temp <- select(temp, c(-OppPoints))
```
然后，循环需要为“团队代码”和“对手代码”列创建虚拟变量，并对所有虚拟变量运行岭回归模型，并将 HomeTeam 作为自变量，将相关统计数据作为因变量多变的。继续 2016-09-02 示例：
```
temp <- dummy_cols(temp, select_columns = 'Team Code')
temp <- dummy_cols(temp, select_columns = 'Opponent Code')
temp <- subset(temp, select = -c(`Team Code`,`Opponent Code`, Year, Date))
temp_Ridge <- lm.ridge(Points ~ ., temp)
```
然后是我们循环播放的日期（2016-09-02）。我们现在有每个团队代码和对手代码的系数值。我现在可以通过获取每个团队的特定系数并将截距添加到其中来获得每个团队的调整后累积积分统计数据。然后，我需要循环创建一个数据框，其中包含以下列：日期、Stat_Name、团队代码、Ridge_Regression_Coefficient、Adjusted_“Stat Name”。 2016-09-02 团队代码 27 的示例将是调整后的统计数据 19.1395541（截距 = 23.08317512 + 团队代码 27 系数 -3.30332078）。所以表格是 2016-09-02,Points,27,-3.30332078, 19.1395541。
那么循环当然会返回并为 2016-09-02 这次 OppPoints 执行相同的操作，添加到表中，然后移动到下一个日期以获取所有统计信息，并将它们添加到表中，等等

我知道这可能令人困惑，所以请随时在 cmets 中提出任何问题。非常感谢大家提前提供的帮助。

【问题讨论】：

标签： r loops regression

【解决方案1】：

终于搞定了。代码如下：

Data$Date <- as.Date(Data$Date)
    Data$Stat_Name <- colnames(Data[,6:7])
    Season_Stats <- unique(subset(Data, select = c(Year,Date,Stat_Name)))
    reg_results_collection <- data.frame(Coef_Name = character(),
                                         Year = numeric(),
                                         Date = as.Date(character()),
                                         Stat_Name = character(),
                                         Ridge_Reg_Coef = numeric(),
                                         Adj_Stat_Value = numeric())
    
    for (i in 1:nrow(Season_Stats)) {
      tryCatch({
      date <- Season_Stats[i, "Date"]
      year <- Season_Stats[i, "Year"]
      stat_name1 <- Season_Stats[i, "Stat_Name"]
      this_season_game_stat <- filter(Data, Data$Year == year, Data$Date < date)
      this_season_game_stat <- dplyr::select(this_season_game_stat, c("Team Code","Opponent Code","HomeTeam",stat_name1))
      this_season_game_stat <- dummy_columns(this_season_game_stat, select_columns = c("Team Code","Opponent Code"), remove_selected_columns = TRUE)
      this_season_game_stat <- na.omit(this_season_game_stat)
      reg.fit <- lm.ridge(paste(stat_name1, "~ ."), this_season_game_stat)
      this_reg_results <- data.frame(Year = year,
                                     Date = date,
                                     Stat_Name = stat_name1,
                                     Ridge_Reg_Coef = coef(reg.fit))
      this_reg_results <- setDT(this_reg_results, keep.rownames = TRUE)
      this_reg_results_intercept <- as.numeric(this_reg_results[1,5])
      this_reg_results$Adj_Stat_Value <- this_reg_results$Ridge_Reg_Coef + this_reg_results_intercept
      this_reg_results <- this_reg_results[-c(1,2)]
      colnames(this_reg_results)[1] <- "Coef_Name"
      reg_results_collection <- unique(rbind(reg_results_collection,this_reg_results))
    },error=function(e){cat("ERROR :",conditionMessage(e), "\n")})
    }

【讨论】：