R 中的受限 Probit 回归

Question

我希望在 R 中运行一个概率模型，将某些系数设置为彼此相等。

考虑一个简单的例子，四支球队在主场和客场比赛一次：

Home <- c('NY','NY','NY','LA','LA','LA','BOS','BOS','BOS','CHI','CHI','CHI')
Away <- c('LA','CHI','BOS','NY','CHI','BOS','LA','CHI','NY','LA','NY','BOS')
HomeWin <- c(1,1,0,1,0,1,0,1,0,0,0,1)
results <- data.frame(Home,Away,HomeWin)

假设我想运行一个概率模型，其中包含主队和客队的虚拟变量。

model <- glm(HomeWin ~ as.factor(Home) + as.factor(Away), family = binomial(link="probit"), data = results)

该模型的结果提供了三支主队（与排除的主队相比）和三支客队（与排除的客队相比）的系数估计值。 假设我想设置模型，使得纽约的家庭系数估计值等于纽约的客场系数估计值（其他城市也是如此）。 我该怎么做？ 我的完整数据包含 30 个这样的组，并且有更多的变量。

Answer 1

如果我正确理解了这个问题，那么您实际上正在寻找的是home和away产生相反的效果。 例如。 beta_{home=NY} = - beta_{away=NY} 。 然而，它并不完全清楚。 但是实现这一目标的一种简单方法是手动设计您的虚拟变量，这样您就NY_home_or_away使用home=1和away=-1为NY_home_or_away设置一个虚拟变量。 在这种情况下beta_NY_home_or_away将基于主场和客场，但有一个负号。

library(dplyr)

competitors <- unique(unlist(results[, c('Home', 'Away')]))
new_cols <- lapply(competitors, function(x){
  home <- results[['Home']] == x
  away <- results[['Away']] == x
  case_when(home ~ 1, 
            away ~ -1,
            TRUE ~ 0)
})
names(new_cols) <- competitors
results_wide <- bind_cols(results, new_cols)

fit <- glm(HomeWin ~ NY + LA + CHI + BOS, data = results_wide, family = binomial('probit'))
summary(fit)

Call:
glm(formula = HomeWin ~ NY + LA + CHI + BOS, family = binomial("probit"), 
    data = results_wide)

Deviance Residuals: 
     Min        1Q    Median        3Q       Max  
-1.64597  -0.73997   0.01633   1.19731   1.19731  

Coefficients: (1 not defined because of singularities)
              Estimate Std. Error z value Pr(>|z|)
(Intercept) -2.927e-02  3.823e-01  -0.077    0.939
NY           6.786e-01  6.676e-01   1.017    0.309
LA           6.786e-01  6.676e-01   1.017    0.309
CHI         -2.898e-16  6.527e-01   0.000    1.000
BOS                 NA         NA      NA       NA

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 16.636  on 11  degrees of freedom
Residual deviance: 14.537  on  8  degrees of freedom
AIC: 22.537

Number of Fisher Scoring iterations: 5

请注意，现在该标志取决于球队是否为Away=-1 Away和Home标志。 此外，在执行此类转换后，任何统计测试都应谨慎进行，因为它们的解释和有效性将取决于其他变量。 另请注意，一个团队将获得NA估计值，因为虚拟变量是线性相关的。

Answer 2

您可以为每个被列为主场或客场的球队名称创建虚拟变量，并在回归中使用这些虚拟变量。

（鉴于您提供的示例数据，下面的示例可能在数值上表现奇怪，但它应该适用于真实数据。）

library(dplyr)
library(fastDummies)

teams <- results$Home %>% unique()

# function to add a dummy for a given team is either Home or Away 
add_HoA <- function(df, team) {
  HoA_str <- paste0('HoA_',team)
  HoA <- ensym(HoA_str)
  
  df <- df %>% mutate(!!HoA := (Home ==team | Away==team) %>% as.integer())
  return (df)
}

for (team in teams) {
  results <- add_HoA(results, team)
}

# using HoA_ variables for all teams  
model2 <- glm(HomeWin ~ ., family = binomial(link="probit"), 
              data = results %>% dplyr::select(HomeWin, starts_with('HoA_')))
summary(model2)

results <- fastDummies::dummy_cols(results, select_columns = c('Home','Away'))

# using HoA_ variables for NY
model3 <- glm(HomeWin ~ ., family = binomial(link="probit"), 
              data = results %>%
                dplyr::select(HomeWin, HoA_NY, starts_with('Home_'), starts_with('Away_')) %>%
                dplyr::select(-Home_NY, -Away_NY))
summary(model3)

# using HoA_ variables for BOS
model4 <- glm(HomeWin ~ ., family = binomial(link="probit"), 
              data = results %>%
                dplyr::select(HomeWin, HoA_BOS, starts_with('Home_'), starts_with('Away_')) %>%
                dplyr::select(-Home_BOS, -Away_BOS))
summary(model4)