Regressione probit vincolata in R

Question

Sto cercando di eseguire un modello probit in R impostando determinati coefficienti uguali tra loro.

Considera il semplice esempio in cui quattro squadre si affrontano una volta a casa e una volta in trasferta:

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)

Supponiamo di voler eseguire un modello probit in cui includo variabili fittizie per la squadra di casa e per la squadra in trasferta.

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

Il risultato del modello fornisce stime dei coefficienti per tre delle squadre di casa (rispetto a una squadra di casa esclusa) e tre delle squadre in trasferta (rispetto a una squadra esclusa). Supponiamo di voler impostare il modello in modo tale che la stima del coefficiente di casa per NY sia uguale alla stima del coefficiente di trasferta per NY (e lo stesso per le altre città). Come lo farei? I miei dati completi contengono 30 di questi gruppi e con molte più variabili.

Answer 1

Se ho capito bene la domanda, quello che stai effettivamente cercando è avere homee awayavere effetti opposti. Per esempio. beta_{home=NY} = - beta_{away=NY}. Tuttavia non è del tutto chiaro. Ma un modo semplice per ottenere ciò sarebbe progettare manualmente le variabili fittizie, in modo da avere un fittizio per NY_home_or_awaycon home=1e away=-1. In questo caso beta_NY_home_or_awaysarebbe basato sia in casa che in trasferta ma avrebbe un segno negativo.

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

Nota che ora il segno dipende dal segno se la squadra è Awaye Homecome Away=-1. Inoltre, qualsiasi test statistico dovrebbe probabilmente essere eseguito con una certa cura dopo aver eseguito tale trasformazione, poiché la loro interpretazione e validità dipenderanno da altre variabili. Si noti inoltre che una squadra riceverà delle NAstime, poiché i manichini dipendono in modo lineare.

Answer 2

Puoi creare variabili fittizie per ogni nome squadra elencato come In casa o Trasferta e utilizzare quei manichini nella regressione.

(L'esempio di seguito potrebbe funzionare numericamente in modo strano in base ai dati di esempio forniti ma dovrebbe funzionare con i dati reali.)

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)