Logistic regression

Packages

Loading relevant packages:

library(lme4) # Hierarchical models
library(stargazer) # Regression tables
library(dplyr) # Data wrangling and pipes
library(ggplot2) # Graphics
library(ggeffects) # ggpredict

---

Data

Loading the relevant data:

load('/Users/davidhamad/Documents/Cand.Scient.Pol/2. Semester/Statistical models beyond linear regression - applied statistics for political scientists/6-7) Logistic regression/Data.rda')

df <- Reappointments

---

Exercise 1

Q1: Replicate model 2.

A1: I have replicated both models.

mod1 <- glm(exit ~ free_economy_diff 
            + performance,
            family = binomial(link = "logit"),
            df)

mod2 <- glm(exit ~ free_economy_diff 
           + performance
           + age
           + tenure
           + attendance
           + court,
           family = binomial(link = "logit"), 
           df)

stargazer(mod1, mod2, type = "text")

==============================================
                      Dependent variable:     
                  ----------------------------
                              exit            
                       (1)            (2)     
----------------------------------------------
free_economy_diff    1.505***      1.490***   
                     (0.386)        (0.443)   
                                              
performance           -0.184        -0.556*   
                     (0.272)        (0.307)   
                                              
age                                0.132***   
                                    (0.027)   
                                              
tenure                               0.045    
                                    (0.036)   
                                              
attendance                          -0.015*   
                                    (0.009)   
                                              
courtGC                             0.809**   
                                    (0.376)   
                                              
Constant            -1.383***      -9.746***  
                     (0.308)        (1.759)   
                                              
----------------------------------------------
Observations           250            235     
Log Likelihood       -137.610      -110.922   
Akaike Inf. Crit.    281.220        235.844   
==============================================
Note:              *p<0.1; **p<0.05; ***p<0.01

---

Q2: What is the marginal effect of a one-unit increase in the following predictors on the probab the probability that a judge is replaced (exit == 1)? Ideology: free_economy_diff. Past performance/influence: performance

A2: The coefficient for free_economy_diff is positive (1.490) and highly significant (p < 0.01), indicating that greater political distance between appointing and reappointing governments increases the likelihood of a judge being replaced. The coefficient for performance is negative (-0.556) and weakly significant (p < 0.1), suggesting that higher-performing judges are somewhat less likely to be replaced.

A one-unit increase in political distance (free_economy_diff) multiplies the odds of a judge being replaced by a factor of 4.4. A one-unit increase in judge performance reduces the odds of replacement by approximately 43%.

coefficients(mod2)[2] * 1

free_economy_diff 
         1.489554 

exp(1.490)

[1] 4.437096

coefficients(mod2)[3] * 1

performance 
 -0.5558463 

exp(-0.556)

[1] 0.5734985

(exp(-0.556) - 1) * 100

[1] -42.65015

---

Q3: What would you say is a good increment for a “high-performing” judge? Can you make a partial scenario and report the marginal effect of judges’ performance on governments’ decision to replace a judge?

A3: The interquartile range (the difference between Q3 and Q1 –> Q3 - Q1) of performance (≈ 0.38) represents a reasonable increment for comparing a low-performing to a high-performing judge. Moving from Q1 to Q3 in performance reduces the odds of being replaced by approximately 19%. While this is a meaningful relative effect, it is considerably smaller than the effect of political distance, suggesting that merit offers some protection, but ideology matters more.

change_perf <- IQR(df$performance, na.rm = TRUE)
change_perf

[1] 0.3779062

coefficients(mod2)["performance"] * change_perf

performance 
 -0.2100578 

exp(coefficients(mod2)["performance"] * change_perf)

performance 
  0.8105374 

(exp(coefficients(mod2)["performance"] * change_perf) - 1) * 100

performance 
  -18.94626 

---

Q4: Can you illustrate the two effects graphically?

A4: Illustration is seen below.

eff_ideology <- ggpredict(mod2, terms = "free_economy_diff[all]")
plot(eff_ideology) +
  ylab("Probability of replacing the judge") +
  xlab("Political distance between governments") +
  ggtitle("Effect of political distance on judge replacement")

eff_performance <- ggpredict(mod2, terms = "performance[all]")
plot(eff_performance) +
  ylab("Probability of replacing the judge") +
  xlab("Judge performance (relative to court average)") +
  ggtitle("Effect of performance on judge replacement")

---

Q5: What is the marginal effect of a left-right overturn in government during a judge’s mandate on their probability of being replaced? To find a good increment, draw on the descriptive statistics.

A5: When a left-wing government replaces a right-wing one (or vice versa), the odds that the incumbent judge is replaced more than double (a 126% increase in odds), suggesting that political turnover has substantial consequences for judicial tenure at the CJEU.

df %>%
  group_by(family_id, family_id_ren) %>%
  reframe(
    n = n(),
    mean_dist = mean(free_economy_diff, na.rm = TRUE),
    median_dist = median(free_economy_diff, na.rm = TRUE)
  )

left_right_shift <- df %>%
  filter(
    (family_id == "Social democracy" & family_id_ren == "Conservative") |
    (family_id == "Conservative" & family_id_ren == "Social democracy")
  )

left_right_shift %>%
  group_by(family_id, family_id_ren) %>%
  reframe(
    n = n(),
    median_dist = median(free_economy_diff, na.rm = TRUE)
  )

left_right_shift %>%
  reframe(
    n = n(),
    mean_dist = mean(free_economy_diff, na.rm = TRUE),
    median_dist = median(free_economy_diff, na.rm = TRUE)
  )

change <- median(left_right_shift$free_economy_diff, na.rm = TRUE)
change

[1] 0.5485304

coefficients(mod2)["free_economy_diff"] * change

free_economy_diff 
        0.8170654 

exp(coefficients(mod2)["free_economy_diff"] * change)

free_economy_diff 
         2.263847 

(exp(coefficients(mod2)["free_economy_diff"] * change) - 1) * 100

free_economy_diff 
         126.3847 

---

Q6: Calculate the first difference: Consider four scenarios and compare the predicted probabilities that a judge exits the Court for high and low levels of both performance and political distance.

1. what are the predicted probabilities for the two groups?
2. What is the effect of ideology among high-performing judges?
3. What is the effect among low-performing judges?
4. Who stands the most to win by performing better?

A6: See the text below.

1. Predicted probabilities for the four scenarios: A low-performing judge (Q1 = 0.71) facing a politically aligned government (Q1 = 0.07) has a 13.9% probability of being replaced. The same judge facing a politically distant government (Q3 = 0.46) has a 22.4% probability. A high-performing judge (Q3 = 1.09) facing an aligned government has an 11.6% probability of exit, rising to 19.0% when facing a distant government.

2. Effect of ideology among high-performing judges: Among high-performing judges, moving from low to high political distance increases the probability of exit by 7.4 percentage points (from 11.6% to 19.0%).

3. Effect of ideology among low-performing judges: Among low-performing judges, the same shift in political distance increases the probability of exit by 8.5 percentage points (from 13.9% to 22.4%). The effect of ideology is thus somewhat larger for low-performing judges, illustrating the built-in interaction effect in the logistic model.

4. Who stands the most to win by performing better? Judges facing politically distant governments benefit the most from higher performance: their probability of exit drops by 3.4 percentage points (from 22.4% to 19.0%), compared to 2.3 percentage points for judges facing aligned governments (from 13.9% to 11.6%). Politically exposed judges thus have the most to gain from strong performance, though the protection it offers remains modest.

summary(df$free_economy_diff)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
0.00000 0.07139 0.24067 0.34545 0.46069 2.58621      17 

summary(df$performance)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
 0.0000  0.7144  0.9745  0.9251  1.0923  3.8537       1 

scenarios <- data.frame(
  free_economy_diff = rep(
    quantile(df$free_economy_diff, probs = c(0.25, 0.75), na.rm = TRUE), 
    2),
  performance = c(
    rep(quantile(df$performance, probs = 0.25, na.rm = TRUE), 2),
    rep(quantile(df$performance, probs = 0.75, na.rm = TRUE), 2)
  ),
  age = median(df$age),
  tenure = 6,
  attendance = 0,
  court = "CJ"
)

scenarios

scenarios <- scenarios %>%
  mutate(
    preds = predict(mod2, scenarios, type = "response")
  )

scenarios

scenarios <- scenarios %>%
  group_by(performance) %>%
  mutate(
    effect_ideology = preds - lag(preds)
  )

scenarios

scenarios <- scenarios %>%
  group_by(free_economy_diff) %>%
  mutate(
    effect_performance = preds - lag(preds)
  )

scenarios

---

Q7: Explore the compensation threshold: How much better must a judge perform to compensate for a median political distance in government preferences (i.e. free_economy_diff == 0.24)? Given the distribution of performance, how realistic is it for judges to survive based on merit alone?

A7: The compensation equation gives us: performance = -(β₁/β₂) × free_economy_diff = 0.64. This means a judge must increase their performance by 0.64 units to fully offset a median level of political distance. Given that the interquartile range of performance is only about 0.38 (from 0.71 to 1.09), a compensating increase of 0.64 far exceeds the variation we typically observe among judges. It is therefore unrealistic for most judges to survive based on merit alone when facing even a moderate level of political misalignment.

beta1 <- coefficients(mod2)["free_economy_diff"]

beta2 <- coefficients(mod2)["performance"]

compensation <- -(beta1/beta2) * 0.24

compensation

free_economy_diff 
        0.6431506 

summary(df$performance)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
 0.0000  0.7144  0.9745  0.9251  1.0923  3.8537       1 

---

Exercise 2

Q1: Calculate the probability, then the odds, then the logodds that a judge will exit (exit).

A1: To calculate the intercept of an intercept-only logistic regression, we work through the logit transformation step by step. In the data, 75 judges exited the court (successes) and 193 remained (failures). The probability of exit is therefore 75/268 = 0.280. The odds of exit are 75/193 = 0.389; meaning that for roughly every judge who exits, about 2.6 remain (193/75 = 2.57). Taking the natural logarithm of the odds gives us the log-odds: log(0.389) = -0.945. This value corresponds exactly to the intercept in an intercept-only logistic regression, confirming that the intercept simply represents the overall log-odds of the event in the data when no predictors are included.

successes <- sum(df$exit == 1)
successes

[1] 75

failures <- sum(df$exit == 0)
failures

[1] 193

p <- successes / (successes + failures)
p

[1] 0.2798507

odds <- successes / failures
odds

[1] 0.388601

logodds <- log(odds)
logodds

[1] -0.9452021

---

Q2: Run a binomial regression with only an intercept.

A2: See below.

mod0 <- glm(exit ~ 1,
            family = "binomial",
            df)

summary(mod0)

Call:
glm(formula = exit ~ 1, family = "binomial", data = df)

Coefficients:
            Estimate Std. Error z value Pr(>|z|)    
(Intercept)  -0.9452     0.1361  -6.947 3.74e-12 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 317.75  on 267  degrees of freedom
Residual deviance: 317.75  on 267  degrees of freedom
AIC: 319.75

Number of Fisher Scoring iterations: 4

---

Exercise 3

Q1: Calculate the odds of exiting the court among young and old judges

A1: Among young judges (under 60), 23 exited the court and 109 remained, giving odds of 23/109 = 0.211. Among older judges (60+), 52 exited and 84 remained, giving odds of 52/84 = 0.619. The odds of exiting are thus roughly three times higher for older judges than for younger ones, consistent with the expectation that older judges are more likely to leave: whether voluntarily (retirement) or because governments see an opportunity to appoint a replacement.

successes_young <- sum(df$exit[df$age60 == 0] == 1)
successes_young

[1] 23

failures_young <- sum(df$exit[df$age60 == 0] == 0)
failures_young

[1] 109

odds_young <- successes_young / failures_young
odds_young

[1] 0.2110092

successes_old <- sum(df$exit[df$age60 == 1] == 1)
successes_old

[1] 52

failures_old <- sum(df$exit[df$age60 == 1] == 0)
failures_old

[1] 84

odds_old <- successes_old / failures_old
odds_old

[1] 0.6190476

---

Q2: Calculate the intercept.

A2: See below.

alpha <- log(odds_young)
alpha

[1] -1.555854

---

Q3: Calculate the slope parameter.

A3: See below.

odds_ratio <- odds_old / odds_young
odds_ratio

[1] 2.933747

beta <- log(odds_ratio)
beta

[1] 1.076281

---

Q4: Run the model in R and compare. Did you find the same thing?

A4: Yes.

mod3 <- glm(exit ~
age60,
family = "binomial",
df)

summary(mod3)

Call:
glm(formula = exit ~ age60, family = "binomial", data = df)

Coefficients:
            Estimate Std. Error z value Pr(>|z|)    
(Intercept)  -1.5559     0.2295  -6.780  1.2e-11 ***
age60         1.0763     0.2895   3.718 0.000201 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 317.75  on 267  degrees of freedom
Residual deviance: 303.05  on 266  degrees of freedom
AIC: 307.05

Number of Fisher Scoring iterations: 4