R'de Kısıtlı Probit Regresyonu

Question

Birbirine eşit belirli katsayıları ayarlayan R'de bir probit modeli çalıştırmak istiyorum.

Dört takımın hem evde hem de yolda birbirini oynadığı basit örneği düşünün:

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)

Ev sahibi takım ve deplasman takımı için kukla değişkenler dahil ettiğim bir probit modeli çalıştırmak istediğimi varsayalım.

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

Modelin sonucu, ev sahibi takımların üçü (dışarıda bırakılan bir ev sahibi takıma kıyasla) ve deplasman takımlarının üçü (dışarıda bırakılan bir konuk takımla karşılaştırıldığında) için katsayı tahminleri sağlar. Modeli, NY için ev katsayısı tahmini NY için dışarıda katsayısı tahminine eşit olacak (ve diğer şehirler için aynı olacak şekilde) ayarlamak istediğimi varsayalım. Bunu nasıl yapacağım? Tüm verilerim bu gruplardan 30'unu ve önemli ölçüde daha fazla değişken içerir.

Answer 1

Ben doğru soruyu anlamak, ne gerçekte aradığınız sahip olmaktır homeve awayzıt etkilere sahip olduğu. Örneğin. beta_{home=NY} = - beta_{away=NY}. Ancak tam olarak net değil. Ama bir bunu gerçekleştirmenin en basit yolu, el için bir kukla var, öyle ki, senin kukla değişkenleri tasarlamak olacaktır NY_home_or_awayile home=1ve away=-1. Bu durumda beta_NY_home_or_awayhem ev hem de uzakta temel alınır ancak olumsuz bir işaret vardır.

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

Şimdi işareti ekibi olup olmadığı işareti bağlıdır Not Awayve Homeolarak Away=-1. Ayrıca, yorumlanması ve geçerliliği diğer değişkenlere bağlı olacağından, bu tür bir dönüşümü gerçekleştirdikten sonra herhangi bir istatistiksel test muhtemelen biraz dikkatle yapılmalıdır. Ayrıca NA, aptallar doğrusal olarak bağımlı olduğundan bir takımın tahminler alacağını unutmayın .

Answer 2

Ev veya Dışarıda olarak listelenen her takım adı için kukla değişkenler oluşturabilir ve bu kukla değişkenleri regresyonda kullanabilirsiniz.

(Aşağıdaki örnek, sağladığınız örnek veriler verildiğinde sayısal olarak garip bir şekilde işleyebilir, ancak gerçek verilerle çalışmalıdır.)

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)