Review-Tutorial (Multiple) Logistische Regression

TippLernziele

Nach dem Erarbeiten des Tutorials sind Sie in der Lage …

1. die theoretischen Grundlagen der logistischen Regression zu erklären und zu begründen, warum sie für binäre Zielvariablen geeignet ist.
2. die konzeptionelle Interpretation von Null Deviance und Residual Deviance zu erklären.
3. das grundlegene Konzept der Analysis of Deviance zu erklären.
4. eine logistische Regression in R zu implementieren und die Ergebnisse zu interpretieren.
5. verschiedene Modellvarianten zu erstellen und zu vergleichen.
6. Modellgütemaße (\(R^2\)), Pseudo-\(R^2\), AIC, ROC-Kurve/AUC zu erklären und zu interpretieren.
7. potenzielle Probleme, wie Multikollinearität, Signifikanz der Prädiktoren und Overdispersion zu identifizieren und zu analysieren.
8. die Ergebnisse der logistischen Regression in einem praktischen Kontext (hier Mitarbeiterfluktuation) einzuordnen und Schlüsse und Empfehlungen daraus zu ziehen.
9. die erworbenen Kenntnisse und Fertigenkeiten zur logistischen Regression auf ein praktisches Beispiel anwenden.

Laden der benötigten Bibliotheken

library(car)
library(ggplot2)
library(tidyr)
library(pROC)
library(reactable)
library(patchwork)
library(dplyr)
library(htmltools)
library(scales)

Einleitung

Stelle dir vor, du arbeitest in einer Bank und sollst ein Modell aufstellen, welche das Kreditausfallrisiko in Abhängigkeit vom Jahreinkommen der Kreditnehmer modelliert. Das Ausfallrisiko für einen einzelnen Kunden ist entweder 0 oder 1, Ausfall oder kein Ausfall. Angenommen du schaust dir Kredite in Höhe von 75000 CHF an. Die einzigen Daten, die dir zur Verfügung stehen sind alte Daten der letzten Jahre für Kunden mit einem breitgestreuten Jahreseinkommen. Die Daten könnten z.B. so aussehen:

# 1. Für reproduzierbare Ergebnisse einen Seed setzen
set.seed(123)

# 2. Daten für 300 Kunden simulieren (unverändert)
n <- 300
jahreseinkommen <- rlnorm(n, meanlog = log(75000), sdlog = 0.5)
beta_0 <- -6.5 
beta_1 <- 0.00006 
log_odds <- beta_0 + beta_1 * jahreseinkommen
wahrscheinlichkeit_rueckzahlung <- 1 / (1 + exp(-log_odds))
kredit_status <- rbinom(n, 1, wahrscheinlichkeit_rueckzahlung)
kredit_daten <- data.frame(
  Einkommen = jahreseinkommen,
  # Status muss hier numerisch sein für das Modell
  Status = as.numeric(as.character(kredit_status)) 
)

# 3. Das logistische Modell manuell berechnen
logit_modell <- glm(Status ~ Einkommen, data = kredit_daten, family = "binomial")

# 4. Neue Daten für eine glatte Linie von 0 bis zum Maximum erstellen
neue_daten <- data.frame(
  Einkommen = seq(0, max(kredit_daten$Einkommen), length.out = 500)
)

# 5. Wahrscheinlichkeiten für die neuen Daten vorhersagen
neue_daten$Wahrscheinlichkeit <- predict(
  logit_modell, 
  newdata = neue_daten, 
  type = "response" # Wichtig: "response" gibt die Wahrscheinlichkeit (0-1) zurück
)


# 6. Finaler Plot
ggplot(kredit_daten, aes(x = Einkommen, y = Status)) +
  # Die Original-Punkte (Status muss wieder ein Faktor sein für die Farbe)
  geom_jitter(aes(color = as.factor(Status)), width = 0, height = 0.05, alpha = 0.6, size = 2) +
  
  # HIER IST DIE ANPASSUNG:
  # Wir zeichnen unsere manuell erstellte Vorhersage-Linie
  geom_line(
    data = neue_daten, 
    aes(x = Einkommen, y = Wahrscheinlichkeit), 
    color = "black", 
    linewidth = 1 # Bessere Sichtbarkeit
  ) +
  
  scale_color_manual(
    values = c("0" = "firebrick", "1" = "midnightblue"),
    labels = c("0" = "Ausfall", "1" = "Zurückgezahlt")
  ) +
  scale_x_continuous(labels = label_number(big.mark = "'")) +
  scale_y_continuous(breaks = c(0, 1), labels = c("0\n(Ausfall)", "1\n(Zurückgezahlt)")) +
  labs(
    title = "Wahrscheinlichkeit der Kreditrückzahlung nach Jahreseinkommen",
    subtitle = "Manuell berechnete Regressionslinie",
    x = "Jahreseinkommen (CHF)",
    y = "Kreditstatus",
    color = "Legende"
  ) +
  theme_minimal() +
  coord_cartesian(xlim = c(0, NA))

Das logit-Modell

Herleitung der logit-Funktion

Während wir in der linearen Regression nach den Parametern einer Regressionsgeraden suchen, kann eine lineare Funktion offensichtlich unsere Daten nicht beschreiben. Wir suchen nun eine Funktion, welche uns die bedingte Wahrscheinlichkeit (p) gibt einen Kreditausfall zu beobachten in Abhängigkeit vom Jahreseinkommen der Kreditnehmers. Die nahelegenste Idee diese Wahrscheinlichkeit zu berechnen wäre, man fasst die Jahresgehälter (\(X\)) in Klassen zusammen und analysiert für jede Klasse die Wahrscheinlichkeit eines Kreditausfalls. Angenommen es gibt 15 Kreditnehmer die zwischen 70000 und 75000 CHF verdienen, davon haben 10 den Kredit zurückbezahlt und 5 nicht. Somit wäre die bedingte Wahrscheinlichkeit \(P(\textrm{Y=Ja}|\textrm{X=[70000-75000]})= p = 10/15\). Damit bekämen wir eine Stufenfunktion, die sigmoidal oder s-förmig verläuft. Allerdings könnten wir nicht mit ihr zuverlässig rechnen, da in der Praxis in der Regel nicht ausreichend viele Daten für kleine Intervalle vorhanden sind oder die Datenpunkte ungleichmässig verteil sind. Ausserdem möchten wir eine stetige und differenzierbare Funktion als Modell haben. Bereits vor fast hundert Jahren hat Mediziner Berkson vorgeschlagen diese sigmoidale Funktion durch Exponentialfunktionen zu modellieren: \[ p = \frac{e^{\beta \cdot X}}{1 + e^{\beta \cdot X}} \] Die Gegenwahrscheinlichkeit 1-p wäre dann die heute als logistische Funktion bezeichnete Funktion: \[ 1- p = \frac{1}{1 + e^{\beta \cdot X}} \] Warum gerade diese Funktion? Dies hat ganz pragmatische Gründe. Sie besticht im Vergleich zu vielen anderen Modellen durch ihre Einfachheit und wird im weiteren Verlauf auch weitere Vorteile bei der Skalierbarkeit zeigen! Warum interessieren wir uns für 1-p? Weil wir nun etwas aufstellen können, was wir auch im Alltag oft verwenden um einen Eintrittswahrscheinlichkeit zu beschreiben, die sog. Gewinn- oder Eintrittschance, im Englischen “odds”:

\[ \mathrm{odds} = \frac{p}{1-p} = e^{\beta \cdot X} \] Umgangssprachlich würden wir sagen, wenn angenommen 10 Kreditnehmer ein Einkommen von 80000 CHF haben und davon in der Vergangenheit 4 ihren Kredit nicht zurückzahlen konnten, dass die “odds” bei 6 zu 4 stehen, also die Chancen der Zurückzahlen im Verhältnis 3 zu 2 stehen. Diese Odds wären exponentiell vom Jahreseinkommen abhängig. Logarithmiert man beide Seiten erhalten wir einen linearen Zusammenhang: \[ ln(\frac{p}{1-p}) = \beta*X \] Wir nennen dies Funktion logit-Funktion. Statt einer sigmoidalen, stark nicht-linearen Funktion besitzen wir jetzt eine Funktion, die linear von meiner Variablen (hier Jahresgehalt) abhängt. Aufgrund -und hier sehen wir einen weiteren Vorteil- der Eigenschaften der Exponentialfunktion können wir weitere unabhängige Variablen einfach hinzuaddieren: \[ ln(\frac{p}{1-p}) = \beta_0 + \beta_1*X_1 + ... + \beta_j*X_j \] Dies ist unsere endgültige Modellfunktion mit der wir arbeiten werden.

Verständnisfrage 1: Ein Kreditrisikomodell lautet: logit(p) = -3.0 + 0.1*Einkommen, wobei das Einkommen in 1’000 CHF angegeben wird.

Wie hoch ist die geschätzte Wahrscheinlichkeit p für einen Kreditausfall bei einem Kunden mit 40’000 CHF Einkommen (Einkommen = 40)?

a) 1.00
b) 0.73
c) 2.72
d) 0.98

Antwortvorschlag

Die korrekte Antwort ist b).

Hier muss der Weg von der linearen Funktion zurück zur Wahrscheinlichkeit p berechnet werden. Die häufigsten Fehler sind, beim Logit-Wert oder bei den Odds aufzuhören.

Schritt 1: Logit-Wert berechnen logit(p) = -3.0 + 0.1 * 40 = -3.0 + 4.0 = 1.0 (Antwort (a) ist der Logit-Wert, nicht die Wahrscheinlichkeit.)

Schritt 2: Odds berechnen odds = exp(logit) = exp(1.0) ≈ 2.718 (Antwort (c) ist der Wert der Odds, nicht die Wahrscheinlichkeit.)

Schritt 3: Wahrscheinlichkeit berechnen p = odds / (1 + odds) = 2.718 / (1 + 2.718) = 2.718 / 3.718 ≈ 0.731

Die geschätzte Wahrscheinlichkeit beträgt also ca. 73%.

Die Idee der Maximum Likelihood

In der linearen Regression würde jetzt in der Regel die Methode der kleinsten Quadrate kommen um aus den Daten die Parameter des Modells zu berechnen. Bei der logistischen Regression ist es etwas kompliziert, man verwendet die sog. Maximum Likelihood Methode. Diese vollständig zu behandeln würde über den Rahmen dieses Tutorials hinausgehen, deshalb sei an dieser Stelle nur ganz kurz die Idee mit einfacher Rechnung vorgestellt und für die mathematischen Details auf die Literatur verwiesen.

Für unser Modell müssen wir die Parameter \(\beta_j\) schätzen. Nehmen wir ein einfacheres Modell, wo auch ein Parameter geschätzt werden muss, der Münzwurf. Ein fairer Münzwurf würde eine Binomialverteilung mit einer Eintrittswahrscheinlichkeit von \(p = 0.5\) ergeben. Angenommen wir haben 10 Mal gewürfelt und erhalten dabei {K, Z, Z, Z, K, K, Z, Z, K,Z}, also 6 Zahl und 4 Kopf. Wie gross ist bei vorgegebenem p die Wahrscheinlichkeit genau diese Münzwürfe zu erhalten? D.h. (p = Eintrittswahrscheinlichkeit für Kopf):

\[ \begin{align*} P(\mathrm{Daten}|p) &= p \cdot (1-p) \cdot (1-p) \cdot (1-p) \cdot p \cdot p \cdot (1-p) \cdot (1-p) \cdot p \cdot (1-p) \\ &= p^4 \cdot (1-p)^6 \end{align*} \] Ob es tatsächlich p=0.5 mit der höchsten Wahrscheinnlichkeit ist, wissen wir nicht, also rechnen wir für verschiedene Werte von p:

Wir sehen, dass bei bei diesem groben Raster p=0.6 die höchste Wahrscheinlichkeit besitzt. Verringern wir die Schrittgrösse noch weiter, bekämen wir noch eine präzisieren Wert. Wir sehen also, dass wir wieder einen Optimierungsalgorithmus besitzen, wenn wir die sog. Maximum Likelihood bestimmten: \(L(p) = P(\mathrm{Daten}|p)\). Sicher, für Modelle mit mehr als einem Parameter wird es komplexer, aber wir haben die Grundidee verstanden!

Verständnisfrage 2: Was ist die grundlegende Idee der Maximum-Likelihood-Methode (MLE)?

a) Sie sucht jene Modellparameter, bei denen die Wahrscheinlichkeit, die tatsächlich beobachteten Daten zu erhalten, maximal wird.
b) Sie minimiert die Summe der quadrierten Abweichungen zwischen den Vorhersagen und den tatsächlichen Werten.
c) Sie berechnet die Wahrscheinlichkeit, dass ein bestimmtes Modell (z.B. eine Münze mit p=0.5) das einzig richtige ist.
d) Sie beweist anhand der Daten, dass der geschätzte Parameter (z.B. p=0.4) der wahre, exakte Wert ist.

Antwortvorschlag

Die korrekte Antwort ist a). Die MLE kehrt die Frage um: Statt zu fragen “Wie wahrscheinlich sind meine Daten bei einem gegebenen Modell?”, fragt sie “Bei welchem Modell sind meine Daten am wahrscheinlichsten?”. Wie im Münzwurf-Beispiel gezeigt, werden verschiedene Parameterwerte (p=0.4, p=0.5, p=0.6) getestet, um denjenigen zu finden, der die Likelihood P(Daten|Parameter) maximiert. Antwort (b) beschreibt die Methode der kleinsten Quadrate. Die Antworten (c) und (d) sind falsch, da die MLE eine Schätzung liefert und keinen exakten Beweis oder die alleinige Wahrheit eines Modells.

Fallbeispiel

Damit haben wir jetzt die Basis erarbeitet um ein konkretes Fallbeispiel zu modellieren, analysieren und interpretieren.

Beschreibung des Datensatzes

In diesem Fallbeispiel interessieren wir uns für die Mitarbeiterfluktuation in einem Unternehmen und welche Variablen darauf Einflussnehmen könnten.

Die Daten enthalten die folgenden Variablen:

• Attrition: Mitarbeiterfluktuation, ob der Mitarbeiter das Unternehmen verlassen hat (Ja) oder noch angestellt ist (Nein).
• Yrs_Exp: Arbeitserfahrung des Mitarbeiters (in Jahren).
• Work_Challenging: Ob die Arbeit herausfordernd ist (Ja/Nein).
• Work_Envir: Arbeitsumgebung (Hervorragend oder Niedrig).
• Compensation: Vergütung (Hervorragend oder Niedrig).
• Tech_Exper: Technische Expertise des Mitarbeiters (Hervorragend oder Niedrig).

Die Daten umfassen 52 Datensätze von Mitarbeiterinnen und Mitarbeitern, wobei davon 28 das Unternehmen verlassen haben (Attrition = Ja) und 24 noch im Unternehmen tätig sind (Attrition = Nein).

Einlesen der Daten

attrition_data <- read.csv("./data/attr_data.txt") 
summary(attrition_data)

  Attrition            Yrs_Exp      Work_Challenging    Work_Envir       
 Length:52          Min.   :2.000   Length:52          Length:52         
 Class :character   1st Qu.:2.500   Class :character   Class :character  
 Mode  :character   Median :4.000   Mode  :character   Mode  :character  
                    Mean   :3.519                                        
                    3rd Qu.:4.500                                        
                    Max.   :5.000                                        
 Compensation        Tech_Exper       
 Length:52          Length:52         
 Class :character   Class :character  
 Mode  :character   Mode  :character  
                                      
                                      
                                      

(Wer mit dem Datensatz selbst arbeiten möchte: attr_data.txt)

Data Cleaning

Da die kategorialen Variablen im Rohdatenfile nicht als factors dargestellt sind, ist es notwendig, diese umzuwandeln.

attrition_data$Attrition <- as.factor(attrition_data$Attrition)
attrition_data$Work_Challenging <- as.factor(attrition_data$Work_Challenging)
attrition_data$Work_Envir <- as.factor(attrition_data$Work_Envir)
attrition_data$Compensation <- as.factor(attrition_data$Compensation)
attrition_data$Tech_Exper <- as.factor(attrition_data$Tech_Exper)

str(attrition_data)

'data.frame':   52 obs. of  6 variables:
 $ Attrition       : Factor w/ 2 levels "No","Yes": 2 1 1 2 1 2 1 2 2 2 ...
 $ Yrs_Exp         : num  2.5 2 2.5 2 2 2 2 2.5 2 3 ...
 $ Work_Challenging: Factor w/ 2 levels "No","Yes": 1 2 2 1 2 1 1 1 1 2 ...
 $ Work_Envir      : Factor w/ 2 levels "Excellent","Low": 2 1 1 1 2 2 1 2 1 2 ...
 $ Compensation    : Factor w/ 2 levels "Excellent","Low": 2 1 2 2 2 2 1 1 2 1 ...
 $ Tech_Exper      : Factor w/ 2 levels "Excellent","Low": 1 1 1 1 2 1 2 1 1 1 ...

summary(attrition_data)

 Attrition    Yrs_Exp      Work_Challenging     Work_Envir    Compensation
 No :24    Min.   :2.000   No :28           Excellent:28   Excellent:21   
 Yes:28    1st Qu.:2.500   Yes:24           Low      :24   Low      :31   
           Median :4.000                                                  
           Mean   :3.519                                                  
           3rd Qu.:4.500                                                  
           Max.   :5.000                                                  
     Tech_Exper
 Excellent:44  
 Low      : 8  
               
               
               
               

Explorative Datenanalyse

Wir haben eine numerische und mehrere kategoriale Daten. Die kategorialen Daten zeigen wir in einem sogenannten Cleveland-Dotplot. Dieser ordnet die kategorialen Niveaus nach der Grösse der Kündigungsrate. Wenn es Unterschiede in der Verteilung auf die Niveaus gibt, liegen die Punkte (Dots) einer kategorialen Variable distanziert von einander, wenn sie gleich verteilt sind übereinander. Der Cleveland Dotplot ist eine alternative Darstellung zu einer Gruppe von Balkendiagrammen (barplots).

# Gemeinsame Farbpalette und Themen definieren
theme_custom <- theme_minimal() +
  theme(
    panel.grid.minor = element_blank(),
    axis.text = element_text(size = 11),
    axis.title = element_text(size = 12, face = "bold"),
    plot.title = element_text(size = 14, face = "bold"),
    plot.subtitle = element_text(size = 10)
  )

color_palette <- c("No" = "#3366CC", "Yes" = "#CC3366")

# Daten vorbereiten
# 1a. Daten für den Scatter Plot
plot_data <- attrition_data
plot_data$Attrition_Numeric <- as.numeric(plot_data$Attrition == "Yes")

# 1b. Vorbereitung der Daten für den Cleveland-Dotplot
dot_data <- attrition_data %>%
  # Verwenden von pivot_longer für kompaktere Umformung
  pivot_longer(
    cols = c(Work_Challenging, Work_Envir, Compensation, Tech_Exper),
    names_to = "Variable", 
    values_to = "Category"
  ) %>%
  group_by(Variable, Category) %>%
  summarize(
    Attrition_Rate = mean(Attrition == "Yes"), 
    Count = n(), 
    .groups = 'drop'
  )

# Umwandeln der Variablen in Faktoren mit gewünschter Reihenfolge
dot_data$Variable <- factor(dot_data$Variable, 
                          levels = c("Work_Challenging", "Work_Envir", 
                                     "Compensation", "Tech_Exper"))

# TEIL 2: Plots erstellen
# 2a. Scatter-Plot
p1 <- ggplot(plot_data, aes(x = Yrs_Exp, y = Attrition_Numeric)) +
  geom_jitter(height = 0.05, alpha = 0.8, aes(color = Attrition), size = 3) +
  scale_y_continuous(breaks = c(0, 1), labels = c("No", "Yes"), 
                     limits = c(-0.2, 1.2)) +
  scale_color_manual(values = color_palette) +
  labs(
    title = "Berufserfahrung vs. Fluktuation",
    x = "Berufserfahrung (Jahre)",
    y = "Mitarbeiterflukt."
  ) +
  theme_custom +
  theme(legend.position = "bottom")

# 2b. Cleveland-Dotplot
p2 <- ggplot(dot_data, aes(x = Attrition_Rate, y = reorder(paste(Variable, Category, sep = ": "), Attrition_Rate))) +
  geom_point(aes(size = Count, color = Variable), alpha = 0.8) +
  scale_size_continuous(range = c(3, 10)) +
  scale_color_brewer(palette = "Set1") +
  geom_text(aes(label = sprintf("%.1f%%", Attrition_Rate*100)), 
            hjust = -0.5, size = 3.5) +
  labs(
    title = "Kündigungsraten nach Kategorien",
    subtitle = "Größe der Punkte zeigt die Anzahl der Mitarbeiter",
    x = "Kündigungsrate",
    y = ""
  ) +
  scale_x_continuous(labels = scales::percent, limits = c(0, max(dot_data$Attrition_Rate) * 1.2)) +
  theme_custom +
  theme(legend.position = "none")

# TEIL 3: Plots kombinieren mit patchwork
combined_plot <- p1 + p2 + 
  plot_layout(ncol = 1, heights = c(1, 4)) +  # p2 etwas breiter für die Beschriftungen
  plot_annotation(
    title = "Analyse der Einflussfaktoren auf Mitarbeiterfluktuation",
    theme = theme(plot.title = element_text(size = 16, face = "bold"))
  )

# Plot anzeigen
combined_plot

** Interpretation**: Bei den Berufsjahren sehen wir keine Abhängigkeit der Mitarbeiterfluktuation. Die Yes/No sind gleichmässig ohne Abhängigkeit verteilt. Damit erwarten wir, dass diese Variable/Merkmal in der Modellierung keine Rolle spielen wird. Dies schauen wir uns ab noch genauer an.

Im Gegensatz dazu sehen wir im Cleveland Dotplot Unterschiede in der Verteilungen für die verschiedenen Niveaus/Levels der kategorialen Variablen. Somit verwenden wir alle kategorialen Variablen für unsere Modellierung.

Kategoriale Prädiktoren: Dummy-Variablen

Zum Abschluss müssen wir noch einen wichtigen Punkt ansprechen, den wir bisher ignoriert haben. Unsere einführndes Kreditbeispiel besass einen numerischen Prädiktor, aber in unserem aktuellen Datensatz sind mehrere Prädiktoren kategorial. Das logit-Modell setzt aber numerische Daten voraus.

Wie gehen wir vor, wenn wir kategoriale Variablen im Datensatz haben, wie hier Work_Envir mit den Werten “Excellent” und “Poor”?

• Wir können nicht einfach Work_Envir = "Excellent" in die Gleichung einsetzen
• Mathematischen Operationen wie (\(\beta_1 \cdot\) “Excellent”) sind nicht definiert

Die Idee: Wir brauchen eine numerische Repräsentation für kategoriale Daten \(\rightarrow\) Einführung von Dummy-Variablen

Dummy-Variablen (Indikatorvariablen)

Dummy-Variablen sind binäre Variablen (0 oder 1), die angeben, ob eine Beobachtung zu einer bestimmten Kategorie gehört. Wir wandeln als “levels” der kategorialen Variablen, die häufig strings sind, in Zahlen um!

Beispiel mit Work_Envir:

Original	Work_Envir_Poor
Excellent	0
Poor	1

• Work_Envir_Poor = 1 → Arbeitsumgebung ist schlecht
• Work_Envir_Poor = 0 → Arbeitsumgebung ist exzellent (Referenzkategorie)

Die k-1 Regel: Warum nur eine Dummy-Variable?

Bisher hatten wir nur zwei Kategorien (levels), was aber machen wir, wenn es mehr Kategorien gibt?

TippWichtig

Wichtige Regel: Für eine kategoriale Variable mit k Kategorien erstellen wir nur k-1 Dummy-Variablen. ::

D.h., bei unseren zwei Kategorien wie “Excellent” und “Poor”:

Work_Envir_Poor = 0 → impliziert "Excellent"
Work_Envir_Poor = 1 → bedeutet "Poor"  

Warum diese Regel k-1 sinnvoll ist sehen wir daran, dass wenn wir jede Kategorie mit 0 oder 1 codieren, dann hätte das zur Folge, dass immer gelten würde:

Work_Envir_Excellent + Work_Envir_Poor = 1 

Damit wären die beiden -als unabhängig angenommenen Perfekte Multikollinearität (eine Variable ist vollständig durch die andere bestimmbar)

• Richtig: Nur eine Dummy-Variable erstellen

Erstellen des Logistischen Regressionsmodells

Bevor wir mit der Modellierung beginnen, noch eine grundlagende Frage.

Frage 1: Warum ist die logistische Regression hier überhaupt ein geeigneter methodischer Ansatz?

Antwortvorschlag

• Die logistische Regression ist hier die geeignete Wahl, da wir eine binäre Zielvariable haben (Attrition: Yes/Ja oder No/Nein).
• Interpretierbarkeit: Die Koeffizienten können als log-Odds interpretiert werden, was hilft, den Einfluss einzelner Variablen auf die Wahrscheinlichkeit der Zielvariable zu verstehen.
  
• Wahrscheinlichkeitsvorhersagen: Anstatt nur eine Klassenzuordnung zu treffen, liefert das Modell Wahrscheinlichkeiten, mit denen man z. B. Schwellenwerte anpassen kann.

Logistisches Regressionsmodell erstellen

# Für spätere Vergleiche nehmen wir Yrs_Exp in ein eigenes Modell
attri_logit_model_1 <- glm(Attrition ~ Yrs_Exp + Work_Challenging + Work_Envir + Compensation + Tech_Exper,
                         data = attrition_data,
                         family = binomial(link = "logit"))
attri_logit_model_2 <- glm(Attrition ~ Work_Challenging + Work_Envir + Compensation + Tech_Exper,
                         data = attrition_data,
                         family = binomial(link = "logit"))

# Summarys extrahieren
summary1 <- summary(attri_logit_model_1)$coefficients
summary2 <- summary(attri_logit_model_2)$coefficients

# In Dataframes umwandeln und Spaltennamen anpassen
df1 <- as.data.frame(summary1) %>% mutate(Variable = rownames(summary1))
df2 <- as.data.frame(summary2) %>% mutate(Variable = rownames(summary2))

# Beide Modelle zusammenführen (full join, um alle Koeffizienten zu behalten)
merged_summary <- full_join(df1, df2, by = "Variable", suffix = c("_Model1", "_Model2"))

# Tabelle formatieren und ausgeben
kable(merged_summary, caption = "Vergleich der Modell-Summarys") %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover")) %>%
  scroll_box(width = "100%", height = "400px")

Vergleich der Modell-Summarys

Estimate_Model1	Std. Error_Model1	z value_Model1	Pr(>|z|)_Model1	Variable	Estimate_Model2	Std. Error_Model2	z value_Model2	Pr(>|z|)_Model2
-1.1963849	2.4076947	-0.4969006	0.6192592	(Intercept)	-0.6215815	0.9101017	-0.6829803	0.4946193
0.1319531	0.5101708	0.2586449	0.7959092	Yrs_Exp	NA	NA	NA	NA
-3.4180432	1.4091076	-2.4256793	0.0152798	Work_ChallengingYes	-3.4632331	1.4024788	-2.4693658	0.0135353
4.6117916	1.6783028	2.7478900	0.0059980	Work_EnvirLow	4.5215090	1.5994641	2.8268900	0.0047002
2.8159746	1.3513206	2.0838687	0.0371721	CompensationLow	2.7089540	1.2542230	2.1598662	0.0307830
-3.9598009	1.7030127	-2.3251740	0.0200627	Tech_ExperLow	-3.8547410	1.6064518	-2.3995372	0.0164158

Frage 2: Warum wird im Summary des Modells von jeder kategorialen Variablen nur ein Niveau (level) ausgewiesen?

Antwortvorschlag

Der Grund hierfür ist das Konzept der Dummy-Variablen. Wir haben binäre kategoriales Variablen in unserem Modell. R muss aus allg. \(k\) Werte (levels) \(k-1\) Dummy-Variablen machen, die jeweils die Werte \(0\) oder \(1\) annehmen. Hierbei muss ein Wert (level) als Referenz genommen werden. In der Regel wählt man jenen mit der grössten Anzahl Beobachtungen und der kleinsten Varianz. Dies begründet man mit dem Einfluss der Wahl der Referenz auf die die sog. Fisher Informations-Matrix im Rahmen der Maximum Likelihood Schätzung. Für die mathematischen Details sei hier auf Chapt. 2 des ausgezeichneten Buches von Hosmer et al. [@hosmer2013] verwiesen. Weitere Beispiel zu Dummy-Variablen findet man im Blog von Prof. Anderson https://statorials.org/de/regressions-dummy-variablen/

Modellvoraussetzung:

Von der linearen Regression wissen wir, dass das bestimmte Modellvoraussetzung geprüft werden müssen. Welche müssen wir bei der (multiplen) logistischen Regression testen? # Modellvoraussetzungen der logistischen Regression

Prüfung in R: Component-Plus-Residual Plots (crPlots)

Für generalisierte lineare Modelle wie die logistische Regression ist die einfachste und gängigste Methode zur Überprüfung der Linearität eine grafische Analyse mit sogenannten Component-Plus-Residual Plots (oder auch Partial-Residual Plots).

• Was wird getestet? 🎯 Diese Plots visualisieren die Beziehung zwischen einem stetigen Prädiktor und dem Logit der Antwortvariablen, nachdem der Einfluss der anderen Prädiktoren im Modell herausgerechnet wurde.

• Funktionsweise und Interpretation: 📈 Der Plot zeigt die Datenpunkte zusammen mit zwei Linien:

• Eine rote, gestrichelte Linie, die den vom Modell angenommenen linearen Zusammenhang darstellt.

• Eine grüne, durchgezogene Linie, die einen geglätteten, nicht-parametrischen Trend zeigt (Loess-Kurve).

2. Unabhängigkeit der Beobachtungen

Annahme: Jede Beobachtung muss unabhängig von allen anderen Beobachtungen sein.

Begründung: Abhängige Beobachtungen (z.B. durch Clustering, Zeitreihen, räumliche Nähe) verletzen die Annahmen der Maximum-Likelihood-Schätzung und führen zu verzerrten Standardfehlern und p-Werten.

Prüfung in R:

Grafische Residuen-Analyse

Was wird gezeigt: Zeitliche oder räumliche Muster in den Residuen Funktionsweise: Residuen werden gegen Zeitpunkt/Reihenfolge geplottet Interpretation: Keine erkennbaren Muster → Unabhängigkeit gegeben; Trends/Zyklen → Abhängigkeit

# Deviance-Residuen gegen Reihenfolge
dev_res <- residuals(model, type = "deviance")
plot(dev_res, main = "Residuen über Zeit/Reihenfolge",
     ylab = "Deviance Residuals", xlab = "Beobachtung")
abline(h = 0, col = "red")

Durbin-Watson Test

Was wird getestet: Autokorrelation erster Ordnung in den Residuen Funktionsweise: Misst Korrelation zwischen aufeinanderfolgenden Residuen

Interpretation: DW ≈ 2 → keine Autokorrelation; DW < 1.5 oder > 2.5 → Autokorrelation vorhanden

library(lmtest)
dw_test <- dwtest(model)
print(dw_test)
# p > 0.05 → keine signifikante Autokorrelation

Bei geclusterten Daten

Lösung: Mixed-Effects Modelle verwenden, die Clustering berücksichtigen

library(lme4)
mixed_model <- glmer(y ~ x1 + x2 + (1|cluster), 
                    family = binomial, data = mydata)

3. Keine perfekte Multikollinearität

Annahme: Die Prädiktoren dürfen nicht vollständig linear voneinander abhängen.

Begründung: Perfekte Multikollinearität macht die Matrix-Inversion unmöglich und führt zu instabilen Koeffizientenschätzungen. Hohe Multikollinearität führt zu aufgeblähten Standardfehlern.

Prüfung in R:

Variance Inflation Factor (VIF)

Was wird gemessen: Wie stark ein Prädiktor durch andere Prädiktoren vorhersagbar ist Funktionsweise: VIF = 1/(1-R²), wobei R² aus der Regression des Prädiktors auf alle anderen stammt Interpretation: VIF = 1 → keine Korrelation; VIF > 5 → bedenklich; VIF > 10 → problematisch

library(car)
vif_values <- vif(model)
print(vif_values)

# Grafische Darstellung
barplot(vif_values, main = "Variance Inflation Factors",
        horiz = TRUE, col = ifelse(vif_values > 5, "red", "lightblue"))
abline(v = 5, col = "orange", lwd = 2)
abline(v = 10, col = "red", lwd = 2)

Korrelationsmatrix

Was wird gezeigt: Paarweise Korrelationen zwischen Prädiktoren Interpretation: |r| > 0.8 → hohe Korrelation problematisch; |r| > 0.9 → sehr problematisch

# Korrelationsmatrix der Prädiktoren
pred_cors <- cor(mydata[, c("x1", "x2", "x3")])
print(round(pred_cors, 3))

# Grafische Darstellung
library(corrplot)
corrplot(pred_cors, method = "color", type = "upper", 
         addCoef.col = "black", tl.cex = 0.8)

Condition Index

Was wird gemessen: Konditionszahl der Design-Matrix (Stabilität der Matrix-Inversion) Funktionsweise: Verhältnis des größten zum kleinsten Eigenwert der X’X-Matrix Interpretation: CI < 15 → kein Problem; CI > 30 → starke Multikollinearität

# Condition Index berechnen
library(perturb)
cond_diag <- colldiag(model)
print(cond_diag)

# Condition Index extrahieren
max_ci <- max(cond_diag$condindx)
cat("Maximaler Condition Index:", round(max_ci, 2))

4. Ausreichende Stichprobengröße

Annahme: Mindestens 10-15 Ereignisse pro Prädiktor in der kleineren Outcome-Kategorie.

Begründung: Bei zu kleinen Stichproben können die Maximum-Likelihood-Schätzer instabil werden oder nicht konvergieren. Dies führt zu verzerrten Koeffizienten und aufgeblähten Standardfehlern.

Prüfung in R:

Events per Variable (EPV) Berechnung

Was wird gemessen: Verhältnis von Ereignissen zu Anzahl der Prädiktoren Begründung: Jeder Parameter braucht genügend “Information” (Ereignisse) für stabile Schätzung Interpretation: EPV < 10 → instabile Schätzungen möglich; EPV < 5 → kritisch

# Ereignisse pro Outcome-Kategorie zählen
outcome_table <- table(mydata$outcome)
print(outcome_table)

# Events per Variable berechnen
n_predictors <- length(coef(model)) - 1  # ohne Intercept
min_events <- min(outcome_table)
epv <- min_events / n_predictors

cat("Anzahl Prädiktoren:", n_predictors, "\n")
cat("Minimum Ereignisse:", min_events, "\n")
cat("Events per Variable (EPV):", round(epv, 2), "\n")

if(epv < 5) {
  cat("WARNUNG: EPV < 5 - Modell möglicherweise instabil!\n")
} else if(epv < 10) {
  cat("ACHTUNG: EPV < 10 - Vorsicht bei Interpretation!\n")
} else {
  cat("OK: EPV >= 10 - Ausreichende Stichprobengröße\n")
}

Alternative bei kleinen Stichproben: Penalized Regression

Was macht das: Fügt Regularisierung hinzu, um Overfitting zu vermeiden Funktionsweise: LASSO oder Ridge Regression bestraft große Koeffizienten Vorteil: Stabilere Schätzungen bei kleinen Stichproben

library(glmnet)

# Design-Matrix erstellen (ohne Intercept, wird automatisch hinzugefügt)
X <- model.matrix(~ x1 + x2 + x3, data = mydata)[,-1]
y <- mydata$outcome

# Cross-Validation für optimales Lambda
cv_model <- cv.glmnet(x = X, y = y, family = "binomial", alpha = 1)
plot(cv_model)

# Modell mit optimalem Lambda
best_lambda <- cv_model$lambda.min
penalized_model <- glmnet(x = X, y = y, family = "binomial", 
                         lambda = best_lambda, alpha = 1)

5. Keine einflussreichen Ausreißer

Annahme: Einzelne Beobachtungen sollten das Modell nicht übermäßig stark beeinflussen.

Begründung: Einflussreiche Ausreißer können Koeffizientenschätzungen dramatisch verändern und zu falschen Schlussfolgerungen führen. Die logistische Regression ist anfälliger für Ausreißer als die lineare Regression.

Prüfung in R:

Cook’s Distance

Was wird gemessen: Einfluss einer Beobachtung auf die Gesamtschätzung aller Koeffizienten Funktionsweise: Misst Veränderung in den Koeffizienten, wenn eine Beobachtung entfernt wird Interpretation: Cook’s D > 4/n → einflussreich; Cook’s D > 1 → sehr einflussreich

# Cook's Distance berechnen und plotten
cooksd <- cooks.distance(model)
n <- nrow(mydata)
threshold <- 4/n

plot(cooksd, main = "Cook's Distance", 
     ylab = "Cook's Distance", xlab = "Beobachtung")
abline(h = threshold, col = "red", lty = 2)
abline(h = 1, col = "orange", lty = 2)

# Einflussreiche Punkte identifizieren
influential_cook <- which(cooksd > threshold)
cat("Einflussreiche Beobachtungen (Cook's D):", influential_cook, "\n")

Leverage-Werte (Hat Values)

Was wird gemessen: Hebelwirkung einer Beobachtung im Prädiktor-Raum Funktionsweise: Diagonalelemente der Hat-Matrix; zeigt “Extremheit” in den X-Werten Interpretation: Leverage > 2p/n → hohe Hebelwirkung (p = Anzahl Parameter)

# Leverage-Werte berechnen
hatvals <- hatvalues(model)
p <- length(coef(model))
leverage_threshold <- 2 * p / n

plot(hatvals, main = "Leverage Values",
     ylab = "Leverage", xlab = "Beobachtung")
abline(h = leverage_threshold, col = "red", lty = 2)

# Hohe Leverage identifizieren
high_leverage <- which(hatvals > leverage_threshold)
cat("Beobachtungen mit hoher Hebelwirkung:", high_leverage, "\n")

Standardisierte Residuen

Was wird gemessen: Größe der Vorhersagefehler (standardisiert) Funktionsweise: Residuen dividiert durch ihre Standardfehler Interpretation: |std. Residuum| > 2 → Ausreißer; |std. Residuum| > 3 → extremer Ausreißer

# Standardisierte Residuen
std_res <- rstandard(model)

plot(std_res, main = "Standardisierte Residuen",
     ylab = "Standardisierte Residuen", xlab = "Beobachtung")
abline(h = c(-2, 2), col = "orange", lty = 2)
abline(h = c(-3, 3), col = "red", lty = 2)

# Ausreißer identifizieren
outliers <- which(abs(std_res) > 2)
extreme_outliers <- which(abs(std_res) > 3)
cat("Ausreißer (|std.res| > 2):", outliers, "\n")
cat("Extreme Ausreißer (|std.res| > 3):", extreme_outliers, "\n")

Kombinierte Diagnostik

Vorgehen: Beobachtungen, die sowohl hohe Hebelwirkung als auch hohe Residuen haben, sind am problematischsten

# Einflussreiche Beobachtungen kombiniert identifizieren
problematic <- unique(c(influential_cook, 
                       intersect(high_leverage, outliers)))

if(length(problematic) > 0) {
  cat("Problematische Beobachtungen:", problematic, "\n")
  
  # Modell ohne diese Beobachtungen fitten
  model_robust <- glm(outcome ~ x1 + x2 + x3, 
                     data = mydata[-problematic, ], 
                     family = binomial)
  
  # Koeffizienten vergleichen
  coef_comparison <- data.frame(
    Original = coef(model),
    Robust = c(coef(model_robust), rep(NA, length(coef(model)) - length(coef(model_robust))))
  )
  print(coef_comparison)
} else {
  cat("Keine problematischen Beobachtungen gefunden.\n")
}

Was NICHT geprüft werden muss

Im Gegensatz zur linearen Regression müssen bei der logistischen Regression nicht geprüft werden:

• Normalverteilung der Residuen (nicht erforderlich)
• Homoskedastizität (Varianzhomogenität nicht erforderlich)
• Normalverteilung der abhängigen Variable (ist binär)

Zusammenfassende Prüfung

Modell-Gütemaße

McFadden’s Pseudo-R²: Vergleicht Log-Likelihood des Modells mit Null-Modell Nagelkerke’s R²: Normalisierte Version, die Werte zwischen 0 und 1 erreichen kann Interpretation: Pseudo-R² > 0.2 → akzeptabel; > 0.4 → gut; > 0.6 → sehr gut

library(broom)
library(DescTools)

# Modell-Zusammenfassung
model_summary <- glance(model)
print(model_summary)

# Verschiedene Pseudo-R² Maße
pseudo_r2 <- PseudoR2(model, which = c("McFadden", "Nagelkerke", "CoxSnell"))
print(round(pseudo_r2, 3))

Residuen-Plots für Gesamtbild

Was zeigen die Standard-Plots: - Plot 1: Residuals vs Fitted → Zeigt Muster in Residuen - Plot 2: Q-Q Plot → Normalität der Residuen (bei logistischer Regression weniger relevant) - Plot 3: Scale-Location → Varianzhomogenität - Plot 4: Residuals vs Leverage → Kombiniert Leverage und Residuen

# Standard-Residuen-Plots
par(mfrow = c(2, 2))
plot(model, which = c(1, 2, 3, 5))  # Plot 4 (Cook's distance) statt Plot 2

# Zurück zu einzelnen Plots
par(mfrow = c(1, 1))

Vollständige Diagnose-Funktion

# Funktion für umfassende Modelldiagnose
diagnose_logistic <- function(model, data) {
  cat("=== LOGISTISCHE REGRESSION DIAGNOSE ===\n\n")
  
  # 1. Stichprobengröße
  n_pred <- length(coef(model)) - 1
  min_events <- min(table(data[[all.vars(formula(model))[1]]]))
  epv <- min_events / n_pred
  cat("1. STICHPROBENGRÖSSE:\n")
  cat("   Events per Variable:", round(epv, 2), 
      ifelse(epv >= 10, "(OK)", "(KRITISCH)"), "\n\n")
  
  # 2. Multikollinearität
  vif_vals <- vif(model)
  max_vif <- max(vif_vals)
  cat("2. MULTIKOLLINEARITÄT:\n")
  cat("   Maximaler VIF:", round(max_vif, 2), 
      ifelse(max_vif <= 5, "(OK)", "(PROBLEMATISCH)"), "\n\n")
  
  # 3. Ausreißer
  cooksd <- cooks.distance(model)
  n_influential <- sum(cooksd > 4/nrow(data))
  cat("3. EINFLUSSREICHE BEOBACHTUNGEN:\n")
  cat("   Anzahl einflussreicher Punkte:", n_influential, "\n\n")
  
  # 4. Modellgüte
  pseudo_r2 <- PseudoR2(model, which = "McFadden")
  cat("4. MODELLGÜTE:\n")
  cat("   McFadden's Pseudo-R²:", round(pseudo_r2, 3), "\n\n")
  
  cat("=== EMPFEHLUNG ===\n")
  if(epv >= 10 & max_vif <= 5 & n_influential <= 0.05*nrow(data)) {
    cat("Modell erfüllt alle wichtigen Voraussetzungen.\n")
  } else {
    cat("Modell weist Verletzungen auf - bitte einzelne Diagnosen prüfen.\n")
  }
}

# Diagnose ausführen
diagnose_logistic(model, mydata)

Deviance

Wichtige Metriken sind die “null deviance” und “residual deviance”.

Nochmals zur Erinnerung, wie diese Metriken definiert sind und was sie bedeuten.

In der logistischen Regression sind Null Deviance und Residual Deviance wichtige Metriken, die verwendet werden, um die Güte eines Modells zu bewerten. Diese Begriffe stammen aus der Maximum-Likelihood-Schätzung, auf der die logistische Regression basiert . Auf den theoretischen Hintergrund der Maximum-Liklihood-Schätzung gehen wir hier aus Platzgründen nicht weiter ein und verweisen nur auf die einschlägige Literatur [hosmer2013].

1. Null Deviance

Die Null Deviance ist ein Mass dafür, wie gut ein Modell, das keine Prädiktoren enthält, die Zielvariable erklärt. Das Modell, auf dem die Null Deviance basiert, schätzt nur den globalen Mittelwert der Zielvariable (bei binären Modellen die Wahrscheinlichkeit, dass die Zielvariable 1 ist). Es betrachtet keine der erklärenden Variablen und verwendet lediglich die intercept-only-Version des Modells.

• Formel: Die Null Deviance wird berechnet als: \[ \mathrm{Null Deviance} = -2 \cdot \log(L(\hat{p})) \]Hierbei ist \(L(\hat{p})\) die Likelihood des Modells, das nur den globalen Mittelwert als Schätzung verwendet.

• Interpretation: Eine hohe Null Deviance deutet darauf hin, dass das Nullmodell (nur mit Interzept) die Zielvariable schlecht erklärt. Sie bietet eine Basis, um zu sehen, wie viel Verbesserung das vollständige Modell bringt.

2. Residual Deviance

Die Residual Deviance zeigt, wie gut das vollständige Modell mit den Prädiktoren die Zielvariable erklärt. Es misst die Abweichung zwischen dem Modell mit den Prädiktoren und den tatsächlichen Daten. Die Residual Deviance wird verwendet, um zu bewerten, wie gut das angepasste Modell im Vergleich zum Nullmodell ist.

• Formel: Die Residual Deviance wird berechnet als: \[ \mathrm{Residual Deviance} = -2 \cdot \log(L(\hat{\beta})) \] Hierbei ist \(L(\hat{\beta})\) die Likelihood des Modells mit den geschätzten Parametern \(\beta\), also das vollständige Modell.

• Interpretation: Eine niedrigere Residual Deviance bedeutet, dass das Modell mit Prädiktoren die Daten besser erklärt. Wenn die Residual Deviance nur wenig geringer ist als die Null Deviance, bedeutet das, dass die Prädiktoren wenig zur Erklärung der Zielvariable beitragen.

• Testen der Modellgüte: Man kann einen Likelihood-Ratio-Test verwenden, um zu testen, ob die Reduktion der Deviance durch das vollständige Modell signifikant ist: \[ D = \mathrm{Null Deviance} - \mathrm{Residual Deviance} \] Wenn diese Differenz signifikant ist (mit einem \(\chi^2\)-Test überprüft), dann zeigt das an, dass die Prädiktoren des Modells hilfreich sind, um die Zielvariable zu erklären.

3. Zusammenfassung

• Null Deviance: Misst, wie gut ein Modell ohne Prädiktoren (nur mit dem Interzept) die Zielvariable erklärt.
• Residual Deviance: Misst, wie gut das Modell mit Prädiktoren die Zielvariable erklärt.
• Vergleich: Eine signifikante Verringerung der Deviance vom Nullmodell zum vollständigen Modell zeigt an, dass die Prädiktoren nützlich sind, um die Zielvariable zu erklären.

In unserem Modell:

Null deviance: 71.779 on 51 degrees of freedom Residual deviance: 26.086 on 47 degrees of freedom

ist die Residual deviance sehr viel niedriger als die Null deviance. Wie signifikant ist die Differenz?

# Fit des Nullmodells (nur Intercept)
null_model <- glm(Attrition ~ 1, data = attrition_data, family = binomial)

# Fit des vollständigen Modells (mit allen Prädiktoren)
full_model <- glm(Attrition ~ Work_Challenging + Work_Envir + Compensation + Tech_Exper,
                  data = attrition_data, family = binomial)

# Null Deviance und Residual Deviance
null_deviance <- null_model$deviance
residual_deviance <- full_model$deviance

# Differenz der Deviancen (Nullmodell - Vollmodell)
chi_squared <- null_deviance - residual_deviance

# Freiheitsgrade (Differenz der Anzahl der Parameter)
df <- null_model$df.residual - full_model$df.residual

# p-Wert basierend auf der Chi-Quadrat-Verteilung
p_value <- pchisq(chi_squared, df = df, lower.tail = FALSE)

# Ausgabe der Ergebnisse
cat("Chi-squared value:", chi_squared, "\n")

Chi-squared value: 45.6934 

cat("Degrees of freedom:", df, "\n")

Degrees of freedom: 4 

cat("p-value:", p_value, "\n")

p-value: 2.852542e-09 

Wir sehen mit p-value: 2.852542e-09, dass die Nullhypothese klar abgelehnt wird (Prädiktoren haben keinen Einfluss), unser Modell scheint also sinnvoll zu sein.

Analysis of Deviance

Analysis of Deviance in der Logistischen Regression

In der klassischen ANOVA (Analysis of Variance) wird die Varianz der abhängigen Variable aufgeteilt, um den Anteil der Varianz zu bestimmen, der durch das Modell erklärt wird und den Anteil, der unerklärt bleibt (Fehler). In der logistischen Regression wird jedoch aufgrund der binären Natur der Zielvariable nicht direkt mit der Varianz gearbeitet, sondern mit der Deviance. Die Deviance ist ein Mass für die Abweichung des Modells von den tatsächlichen Daten und ähnelt der Varianz in der linearen Regression.

Verbindung zur Varianz

In der linearen Regression wird die Varianz wie folgt aufgeteilt:

1. Gesamtvarianz (Total Sum of Squares, SST): Dies ist die gesamte Streuung der Daten um ihren Mittelwert:

   \[ SST = \sum_{i=1}^{n} (y_i - \bar{y})^2 \]

2. Erklärte Varianz (Regression Sum of Squares, SSR): Der Anteil der Varianz, der durch das Modell erklärt wird:

   \[ SSR = \sum_{i=1}^{n} (\hat{y}_i - \bar{y})^2 \]

3. Varianz der Residuen (Residual Sum of Squares, SSE): Der Anteil der Varianz, der durch das Modell nicht erklärt wird (Fehler):

   \[ SSE = \sum_{i=1}^{n} (y_i - \hat{y}_i)^2 \]

Deviance in der Logistischen Regression

In der logistischen Regression wird die Deviance verwendet, um das Äquivalent zur Varianz zu messen. Die Deviance basiert auf der Log-Likelihood-Funktion, die angibt, wie wahrscheinlich es ist, die beobachteten Daten zu erhalten, gegeben die Parameter des Modells.

Vergleich der Deviance (Analysis of Deviance)

Die Differenz zwischen der Null Deviance und der Residual Deviance gibt die Verbesserung des Modells durch die Einbeziehung der Prädiktoren an, ähnlich wie die erklärte Varianz in der klassischen ANOVA:

\[ \mathrm{Reduktion der Deviance} = \mathrm{Null Deviance} - \mathrm{Residual Deviance} \]

Diese Differenz misst, wie viel besser das Modell mit Prädiktoren die Daten erklärt im Vergleich zum Nullmodell.

\(\chi^2\)-Test für die Modellverbesserung

Um zu testen, ob die Verbesserung signifikant ist, wird ein Chi-Quadrat-Test verwendet. Die Teststatistik basiert auf der Differenz der Deviance:

\[ \chi^2 = \mathrm{Null Deviance} - \mathrm{Residual Deviance} \]

Diese Teststatistik folgt einer Chi-Quadrat-Verteilung mit Freiheitsgraden:

\[ df = p_{\mathrm{Full}} - p_{\mathrm{Null}} \]

wobei \(p_{\mathrm{Full}}\) die Anzahl der Parameter im vollständigen Modell und \(p_{\mathrm{Null}}\) die Anzahl der Parameter im Nullmodell ist.

Entscheidungsregel

• Ein kleiner p-Wert (typischerweise < 0.05) zeigt, dass das Hinzufügen von Prädiktoren zu einer signifikanten Verbesserung des Modells geführt hat.
• Wenn der Chi-Quadrat-Wert hoch ist und der p-Wert niedrig, zeigt dies an, dass die Prädiktoren einen signifikanten Beitrag zur Vorhersage der Zielvariable leisten.

Fazit

Die Deviance in der logistischen Regression erfüllt eine ähnliche Rolle wie die Varianz in der klassischen ANOVA. Die Analysis of Deviance vergleicht verschiedene Modelle und prüft, ob das Hinzufügen von Prädiktoren zu einer signifikanten Verbesserung der Modellanpassung führt, basierend auf der Reduktion der Deviance und der Chi-Quadrat-Verteilung.

Mit der anova() Funktion in R können wir für jeden Prädiktor die Deviance und Residual Deviance berechnen.

anova(attri_logit_model_2, "PChiSq")

Analysis of Deviance Table

Model: binomial, link: logit

Response: Attrition

Terms added sequentially (first to last)

                 Df Deviance Resid. Df Resid. Dev  Pr(>Chi)    
NULL                                51     71.779              
Work_Challenging  1  15.6908        50     56.089 7.459e-05 ***
Work_Envir        1  17.4619        49     38.627 2.931e-05 ***
Compensation      1   3.3265        48     35.300  0.068171 .  
Tech_Exper        1   9.2142        47     26.086  0.002401 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Vergleichen wir nun den Einfluss der beiden Modelle (mit und ohne Yrs_Exp):

anova(attri_logit_model_1, attri_logit_model_2, test="Chisq")

Analysis of Deviance Table

Model 1: Attrition ~ Yrs_Exp + Work_Challenging + Work_Envir + Compensation + 
    Tech_Exper
Model 2: Attrition ~ Work_Challenging + Work_Envir + Compensation + Tech_Exper
  Resid. Df Resid. Dev Df  Deviance Pr(>Chi)
1        46     26.018                      
2        47     26.086 -1 -0.067459   0.7951

Der Unterschied ist nicht sehr gross, d.h. aber auch, wir können Yrs_Exp guten Gewissens vernachlässigen.

Interpretation der Modell-Koeffizienten Wir haben gereits einiges über das Modell und seine Gültigkeit gelernt. Wie interpretieren wir nun die einzelnen Koeffiziente? Sehen wir nochmals die Übersicht an:

summary(attri_logit_model_2)

Call:
glm(formula = Attrition ~ Work_Challenging + Work_Envir + Compensation + 
    Tech_Exper, family = binomial(link = "logit"), data = attrition_data)

Coefficients:
                    Estimate Std. Error z value Pr(>|z|)   
(Intercept)          -0.6216     0.9101  -0.683   0.4946   
Work_ChallengingYes  -3.4632     1.4025  -2.469   0.0135 * 
Work_EnvirLow         4.5215     1.5995   2.827   0.0047 **
CompensationLow       2.7090     1.2542   2.160   0.0308 * 
Tech_ExperLow        -3.8547     1.6065  -2.400   0.0164 * 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 71.779  on 51  degrees of freedom
Residual deviance: 26.086  on 47  degrees of freedom
AIC: 36.086

Number of Fisher Scoring iterations: 7

Erinnern wir daran, dass die Koeffzienten dem Logarithmus des odds ratio entsprechen: \[ \log \left( \frac{p}{1 - p} \right) = \beta_0 + \beta_1 X_1 + \beta_2 X_2 + \dots + \beta_k X_k \] Jeder Koeffizient repräsentiert die Änderung des odds ratio, wenn sich der Prädiktor um die Einheit 1 erhöht. D.h. : \[ \log \left( \frac{p}{1 - p} \right) = \beta_j X_j \] In der Praxis bedeutet dies z.B. bei unserem Modell mit: \[ \log \left(\frac{p}{1-p}\right) = −3.4632\cdot \mathrm{Work_ChallengingYes} \] Wenn sich der Prädiktor Work_ChallengingYes um eine Einheit erhöht, wir der odds ratio sich erniedrigen (= geringere Wahrscheinlichkeit einer Kündigung). Umgekehrt erhöht sich die Wahrscheinlichkeit einer Kündigung, wenn sich die Arbeitsumgebung verschlechter (Word_EnvirLow).Wir können mit unserem Modell also auch etwas über die Richtung des Einflusses sagen!

Pseudo R-Squared

TippExkurs: Pseudo-R² in der Logistischen Regression

In der logistischen Regression gibt es kein direktes Pendant zum klassischen R² aus der linearen Regression, da das Modell nicht auf der Minimierung der quadratischen Fehler basiert, sondern auf der Maximierung der Likelihood-Funktion. Daher wurden sogenannte Pseudo-R²-Maße entwickelt, um eine ähnliche Einschätzung der Modellgüte zu ermöglichen.

Typische Pseudo-R²-Maße:

1. McFadden’s R²: Eine der am häufigsten verwendeten Pseudo-R²-Masse.Definiert als: \[ R^2_{\mathrm{McFadden}} = 1 - \frac{\log L_{\mathrm{full}}}{\log L_{\mathrm{null}}} \] Hierbei ist \(\log L_{\mathrm{full}}\) der Log-Likelihood-Wert des Modells mit allen Prädiktoren und \(\log L_{mathrm{null}}\) der Log-Likelihood-Wert des Modells ohne Prädiktoren (nur mit dem Interzept).

   • Werte von 0.2 bis 0.4 gelten oft als ein gutes Modell, wobei die Werte kleiner sind als das klassische R².

2. Cox & Snell R²:

   • Basiert auf der Likelihood und nähert sich dem klassischen R² an, kann jedoch nie den Maximalwert 1 erreichen: \[ R^2_{\mathrm{Cox/Snell}} = 1 - \left( \frac{L_0}{L_1} \right)^{\frac{2}{n}} \] Wobei \(L_0\) die Likelihood des Nullmodells und \(L_1\) die Likelihood des vollständigen Modells ist.

3. Nagelkerke R²:

   • Eine angepasste Version des Cox & Snell R², die den Wertebereich von 0 bis 1 abdeckt: \[ R^2_{\mathrm{Nagelkerke}} = \frac{R^2_{\mathrm{Cox/Snell}}}{1 - L_0^{\frac{2}{n}}} \] Dadurch wird das R² vergleichbar mit dem R² aus der linearen Regression.

Bedeutung und Anwendung:

• Modellgüte: Ein höherer Pseudo-R²-Wert zeigt an, dass das Modell die Daten besser erklärt, ähnlich wie beim klassischen R². Allerdings sind Pseudo-R²-Werte in der logistischen Regression tendenziell kleiner.

• Vergleich von Modellen: Pseudo-R²-Werte eignen sich gut, um Modelle miteinander zu vergleichen. Wenn mehrere logistische Modelle geschätzt werden, kann das Modell mit dem höchsten Pseudo-R² als dasjenige betrachtet werden, das die Daten am besten beschreibt.

• Einschränkungen: Pseudo-R² ist nicht direkt vergleichbar mit dem R² aus der linearen Regression. Werte, die in der linearen Regression als “gut” gelten (z.B. 0.7 oder höher), sind in der logistischen Regression selten erreichbar.

Fazit

Insgesamt ist das Pseudo-R² ein hilfreiches Maß zur Bewertung der Modellgüte in der logistischen Regression, jedoch sollte es immer in Kombination mit anderen Modellauswertungen (wie AIC, ROC-Kurve, s. unten) betrachtet werden.

Nun berechnen wir pseudo R-Squared mit der McFadden Formel:

pseudo_R_Squared <- 1 - (attri_logit_model_2$deviance)/(attri_logit_model_2$null.deviance)
pseudo_R_Squared

[1] 0.6365818

Das Modell ist folglich in der Lage ca. \(64\%\) der deviance zu erklären. Dies ist für pseudo R-Squared schon ein ganz guter Wert, d.h. die Reduktion der Deviance durch die Prädiktoren ist (man kann es auch mit einem \(\chi^2\)-Test zeigen) ausreichend gross.

Multikollinearität

Bei der multiplen linearen Regression haben wir schon hochkorrelierte Prädiktoren betrachtet. Auch hier bestimmen wir VIG (variance inflation factor) um zu sehen, ob dieser grösser als 5 ist.

vif(attri_logit_model_2)

Work_Challenging       Work_Envir     Compensation       Tech_Exper 
        1.984868         2.461992         1.611694         1.562850 

Zusammengenommen kommen wir in jedem Fall über 5, Kollinearität sollte also kein Problem unseres Modells sein.

Dispersion (Varianz der abhängigen Variablen)

Sogenannte Overdispersion liegt vor, wenn die beobachtete Varianz der abhängigen Variable (hier die binäre Variable Attrition) größer ist als die Varianz, die durch das logistische Regressionsmodell vorhergesagt wird. Das Modell geht davon aus, dass die Varianz durch die Bernoulli-Verteilung (bei binären Daten) beschrieben wird, also: \[ Var(Y)=p(1−p) \] wobei \(p\) die Wahrscheinlichkeit des Auftretens des Ereignisses ist. Wenn die Varianz der Residuen in den Daten deutlich größer als diese erwartete Varianz ist, spricht man von Overdispersion**.

Warum tritt Overdispersion in der Logistischen Regression auf?

In der logistischen Regression geht das Modell davon aus, dass die Antwortvariable eine binäre Variable (z.B. 0 oder 1) ist und dass die Varianz des Modells vollständig durch die geschätzten Wahrscheinlichkeiten erklärt wird. Wenn jedoch zusätzliche unberücksichtigte Faktoren (z.B. unberücksichtigte Heterogenität) in den Daten vorliegen oder die Annahmen des Modells verletzt sind, kann Overdispersion auftreten.

Eine Metrik für die Overdispersion beruht auf dem \(\chi^2\)-Test. Man vergleicht den \(\chi^2\)-Wert mit der Anzahl Freiheitsgrade. Dieser sollte nicht über \(1\) liegen. Liegt Overdipersion vor, überschreitet der Indikator den Wert \(1\).

\[ \mathrm{Overdispersion_Indicator} = \frac{\mathrm{Deviance}}{Residual~Degress~of~Freedom} > 1 \]

Overdispersion-Check: Der Wert der Overdispersion wird berechnet, indem die Deviance durch die Residual Degrees of Freedom geteilt wird. Dieser Quotient sollte unter normalen Umständen etwa 1 sein.

• Wenn der Wert > 1: Dies deutet auf Overdispersion hin, d.h., die Varianz der Residuen ist höher als erwartet. Ein deutlich höherer Wert zeigt eine systematische Abweichung an, die durch das Modell nicht gut erklart wird.

• Wenn der Wert ≈ 1: Dies deutet auf ein gut angepasstes Modell hin, ohne dass Overdispersion ein Problem darstellt.

• Wenn der Wert < 1: Dies kann auf Underdispersion hinweisen, was in der logistischen Regression jedoch selten vorkommt.

Berechnet:

overdisp_indicator <- attri_logit_model_2$deviance / attri_logit_model_2$df.residual
overdisp_indicator

[1] 0.5550193

Mit \(0.5550193\) liegt er deutlich unter 1. Overdispersion spielt also keine Rolle.

Validierung der Güte

AIC

# Fit the logistic regression model
attri_logit_model_1 <- glm(Attrition ~ Work_Challenging + Compensation, 
                           family = binomial(link = "logit"), data = attrition_data)
attri_logit_model_2 <- glm(Attrition ~ Work_Challenging + Work_Envir + Compensation + Tech_Exper, 
                           family = binomial(link = "logit"), data = attrition_data)
attri_logit_model_3 <- glm(Attrition ~ Work_Challenging + Work_Envir , 
                           family = binomial(link = "logit"), data = attrition_data)
attri_logit_model_4 <- glm(Attrition ~ Work_Challenging + Work_Envir + Tech_Exper, 
                           family = binomial(link = "logit"), data = attrition_data)
attri_logit_model_5 <- glm(Attrition ~ Work_Challenging + Work_Envir + Compensation , 
                           family = binomial(link = "logit"), data = attrition_data)
attri_logit_model_6 <- glm(Attrition ~ Work_Challenging * Compensation + Work_Envir * Tech_Exper, 
                           family = binomial(link = "logit"), data = attrition_data) # Mit Interaktion zwischen Prädiktoren
# AIC Werte
AIC(attri_logit_model_1, attri_logit_model_2, attri_logit_model_3, attri_logit_model_4,attri_logit_model_5, attri_logit_model_6 )

                    df      AIC
attri_logit_model_1  3 56.00748
attri_logit_model_2  5 36.08591
attri_logit_model_3  3 44.62667
attri_logit_model_4  4 40.58805
attri_logit_model_5  4 43.30014
attri_logit_model_6  7 36.42888

Wir sehen also, dass unser Modell Nr. 2 hinsichtlich Güte und Komplexität die besten Werte liefert. Hinsichtlich Interaktion könnte man diese Evaluation noch erweitern.

ROC-Kurve (Receiver Operating Characteristic)

Erinnerung an das Machine Learning:

Die ROC-Kurve zeigt die Leistung des Modells, indem die True Positive Rate (Sensitivität) gegen die False Positive Rate (1-Spezifität) bei verschiedenen Schwellenwerten für die Klassifikation geplottet wird.

Ziel:

Einen hohen AUC (Area Under the Curve) zu erreichen. Die AUC-Werte reichen von 0.5 (zufällige Vorhersage) bis 1.0 (perfekte Vorhersage). ROC-Kurve misst die Fähigkeit des Modells, zwischen den Klassen zu unterscheiden.

Überprüfung unausgewogenen (imbalanced)

Daten

# Klassenverteilung überprüfen
class_dist <- table(attrition_data$Attrition)
class_props <- prop.table(class_dist)

# Ausgabe der Verteilung
print("Absolute Häufigkeiten:")

[1] "Absolute Häufigkeiten:"

print(class_dist)

 No Yes 
 24  28 

print("Relative Häufigkeiten (in %):")

[1] "Relative Häufigkeiten (in %):"

print(round(class_props * 100, 2))

   No   Yes 
46.15 53.85 

# Imbalance Ratio berechnen
imbalance_ratio <- max(class_dist) / min(class_dist)
print(paste("Imbalance Ratio:", round(imbalance_ratio, 2)))

[1] "Imbalance Ratio: 1.17"

# Visualisierung der Klassenverteilung
library(ggplot2)
ggplot(data.frame(Attrition = attrition_data$Attrition), aes(x = Attrition)) +
  geom_bar(fill = "steelblue") +
  geom_text(stat = 'count', aes(label = ..count..), vjust = -0.5) +
  labs(title = "Verteilung der Attrition",
       x = "Attrition",
       y = "Anzahl") +
  theme_minimal()

Wir haben also ungefähr gleich grosse Gruppen vorliegen \(\rightarrow\) keine unausgewogenen Daten.

Berechnung der ROC-Kurve für unsere Modelle:

# Predict the probabilities for the model
probabilities1 <- predict(attri_logit_model_1, type = "response")
probabilities2 <- predict(attri_logit_model_2, type = "response")
probabilities3 <- predict(attri_logit_model_3, type = "response")
probabilities4 <- predict(attri_logit_model_4, type = "response")
probabilities5 <- predict(attri_logit_model_5, type = "response")
probabilities6 <- predict(attri_logit_model_6, type = "response")

# Generiereung der ROC Kurven
roc_curve1 <- roc(attrition_data$Attrition, probabilities1)
roc_curve2 <- roc(attrition_data$Attrition, probabilities2)
roc_curve3 <- roc(attrition_data$Attrition, probabilities3)
roc_curve4 <- roc(attrition_data$Attrition, probabilities4)
roc_curve5 <- roc(attrition_data$Attrition, probabilities5)
roc_curve6 <- roc(attrition_data$Attrition, probabilities6)

# Plot ROC Kurven in eine Diagramm
# Plot der ersten ROC-Kurve
plot(roc_curve1, main = "ROC Curves for Attrition Models", col = "blue", lwd = 2)

# Hinzufügen der weiteren ROC-Kurven
lines(roc_curve2, col = "red", lwd = 2)
lines(roc_curve3, col = "green", lwd = 2)
lines(roc_curve4, col = "purple", lwd = 2)
lines(roc_curve5, col = "orange", lwd = 2)
lines(roc_curve6, col = "brown", lwd = 2)

# Legende hinzufügen
legend("bottomright", legend = c("Model 1", "Model 2", "Model 3", "Model 4", "Model 5", "Model 6"), 
       col = c("blue", "red", "green", "purple", "orange", "brown"), lwd = 2)

# Berechne die AUC-Werte für jedes Modell
auc_values <- data.frame(
  Model = c("Model 1", "Model 2", "Model 3", "Model 4", "Model 5", "Model 6"),
  AUC = c(auc(roc_curve1), auc(roc_curve2), auc(roc_curve3),
          auc(roc_curve4), auc(roc_curve5), auc(roc_curve6))
)

# Tabelle anzeigen
cat("### AUC-Werte der Modelle\n")

### AUC-Werte der Modelle

reactable(
  auc_values,
  columns = list(
    Model = colDef(name = "Modell", align = "left"),
    AUC = colDef(name = "AUC-Wert", align = "center", format = colFormat(digits = 3))
  ),
  bordered = TRUE,
  striped = TRUE,
  highlight = TRUE,
  theme = reactableTheme(
    headerStyle = list(
      backgroundColor = "#C8102E",
      color = "white",
      fontWeight = "bold"
    )
  )
)

Hier sehen wir wieder, dass unser komplexeste Modell mit am besten abschneidet. Interaktionen könnten in der Tat eine weiterführende Untersuchung sein.

Gesamtfazit

Unser Modell 2 schneidet im Vergleich zu den anderen Modell am besten ab. Wir haben auf Signifikanz und Goodness of Fit getestet und unser Modell leidet weder an Multikollinearität, noch an Overdispersion. Wir könnten das Testen noch ausweiten und den Datensatz in Trainings- und Testdaten unterteilen.