Eine typische Frage von Studierenden

Freiheitsgrade

Die Werte innerhalb der Kreuztabelle oben werden im wesendlichen durch diese Werte bestimmt. Die außeren Werte sind also unsere Rahmenbedingungen. Dabei ist der Einfluss der sogenannten Randhäufigkeiten (Marginale Häufigkeit) nicht zu unterschätzen. Denn wenn wir diese als fix/gegeben ansehen, können wir nur mit den sechs Werten in der Mitte unserer Kreuztabelle spielen.

Doch sind nicht alle sechs Werte wirklich frei wählbar. Denn um zum Beispiel die Summe 62 in der ersten Zeile zu erhalten haben wir ja die Summe von 29 und 33 gebildet.

Ist nun der Rand, also 62, fest, so kann ich nicht beide Summanden frei wählen, denn

\[62 = 29 + 33\]

impliziert ja, dass allgemein

\[62 = x + y\] gelten muss und somit durch

\[x = 62 - y \qquad\text{ bzw. }\qquad y = 62 - x\] immer maximal eine der Variabeln – \(x\) oder \(y\) – wirklich frei wählen kann.

Da dies für jede Zeile, aber auch für jede Spalte gilt, denn z.B. ist die Summe der ersten Spalte gegeben durch

\[90 = 29 + 34 + 27,\] sind von den sechs Werten in der Kreuztabelle in der Tat nur 2 Werte wirklich frei zu wählen. Wir haben also ein Problem mit 2 Freiheitsgraden, man schreibt das kurz mit \(df=2\) (df steht dabei für degree of freedom).

Unabhängigkeit in der Statistik

Wir sagen, in der Statistik, dass ein gemeinsames Ereignis unabhängig ist wenn sich das Ereignis als Produkt der beiden Einzelereignisse berechnen lässt. Seien \(A\) und \(B\) also zwei Ereignisse, dann gilt im Falle der Unabhängigkeit:

\[P(A \cap B) = P(A) \cdot P(B)\] Oder etwas informeller: Die Wahrscheinlichkeit das beide Ereignisse eintreffen ist das Produkt der Wahrscheinlichkeiten, dass jeweils eines der beiden Ereignisse eintrifft.

Wir können diese Definition aus der Wahrscheinlichkeitstheorie an unser Problem adaptieren, in dem wir die Wahrscheinlichkeiten durch die relativen Häufigkeiten ersetzen.

Der Wert für das gemeinsame Ereignis iphone.tagsüber.unbeachtet = 1xtäglich und das wetter.ist.gut=ja wird im Falle der Unabhägigkeit durch die beiden Randhäufigkeiten bestimmt:

\[62 \cdot 90 = 31.7045455\]

Wir können nun mit eine Kreuztabelle erstellen, wie sie seien müsste, falls wir tatsächlich statitische Unabhängigkeit hätten. Wir nutzen dafür eine sehr allgemein gehaltene, aber selbst programmierte, Funktion expectation.tab(), der wir eine Tabelle mit den Häufigkeiten der Beobachtungen geben und die uns dann die Tabelle liefert, wie sie aussehen würde, falls tatsächlich statitische Unabhängigkeit herrschen würde.

Die Tabelle mit den beobchteten Werten speichern wir in obs.tab, die der erwarteten Werte in exp.tab:

expectation.tab <- function(tab.obs) {
  ret <- tab.obs
  max.i <- dim(tab.obs)[1]
  max.j <- dim(tab.obs)[2]
  
  # Randhäufigkeiten 
  x <- rep(0, max.i)
  for (i in 0:max.i) x[i] = sum(tab.obs[i,])

  y <- rep(0, max.j)
  for (j in 0:max.j) y[j] = sum(tab.obs[,j])

  # Anzahl aller Beobachtungen
  n = sum(tab.obs)
  
  for (i in 0:max.i) {
    for (j in 0:max.j) {
       ret[i,j] <- (x[i] * y[j] / n)
    }
  }

  ret
}

# Kreuztabelle der beobachtete Werte
obs.tab <- tally(iphones.tagsüber.unbeachtet ~ wetter.ist.gut, data = daten)

# Kreuztabelle der erwarteten Werte auf Grundlage der beobachteten Werte
exp.tab <- expectation.tab(obs.tab)

Schauen wir uns die beiden Tabellen kurz an. Zuerst die der beobachteten Werte:

obs.tab

##                            wetter.ist.gut
## iphones.tagsüber.unbeachtet Ja Nein
##                   1xtäglich 29   33
##                   2xtäglich 34   26
##                   3xtäglich 27   27

Dann die der erwarteten Werte:

exp.tab

##                            wetter.ist.gut
## iphones.tagsüber.unbeachtet       Ja     Nein
##                   1xtäglich 31.70455 30.29545
##                   2xtäglich 30.68182 29.31818
##                   3xtäglich 27.61364 26.38636

Was können wir nun messen?

Unsicherheit und Zufall spielen eine große Rolle. Wir können also nicht erwarten, dass die Werte für die Kreuztabelle in der Realität genau getroffen werden. (Vorallem, weil wir hier ja mit Nachkommastellen arbeiten!) Aber wir können versuchen den Abstand zu diesen Werten zu messen. Je weiter weg die Werte in der Kreuztabelle von den theoretischen Werten liegen, um so unwarscheinlicher ist es, dass die Werte zufällig aus einer unabhängigen Population gezogen wurden. D.h. wir könnten uns für eine Abhägigkeit aussprechen.

sum(abs(obs.tab - exp.tab))

## [1] 13.27273

# Funktion zur Berechnung der absoluten Differenz zwischen
# beobachteten und erwarteten Werte
diffabsobsexp <- function(obs, exp) {
  sum(abs(obs - exp))
}

# Absolute Abweichung der gemessenen Werte
obs.abs <- diffabsobsexp(obs.tab, exp.tab)

# Erzeugen der Nullverteilung
NullVert  <- do(loops) * diffabsobsexp(tally(iphones.tagsüber.unbeachtet ~ shuffle(wetter.ist.gut), data = daten), exp.tab)
gf_histogram(~ diffabsobsexp, data = NullVert) %>%
  gf_vline(xintercept = ~ obs.abs, color = "red")

prop( ~ diffabsobsexp >= obs.abs, data = NullVert)

## prop_TRUE 
##    0.5714

# Funktion zur Berechnung der korrigierten absoluten 
# Differenz zwischen beobachteten und erwarteten Werten
diffabsobsexprel <- function(obs, exp) {
  sum((abs(obs - exp))/exp)
}

# Absolute Abweichung der gemessenen Werte -- korrigiert
obs.abs <- diffabsobsexprel(obs.tab, exp.tab)

# Erzeugen der Nullverteilung
NullVert  <- do(loops) * diffabsobsexprel(tally(iphones.tagsüber.unbeachtet ~ shuffle(wetter.ist.gut), data = daten), exp.tab)
gf_dhistogram(~ diffabsobsexprel, data = NullVert) %>%
  gf_vline(xintercept = ~ obs.abs, color = "red")

prop( ~ diffabsobsexprel >= obs.abs, data = NullVert)

## prop_TRUE 
##    0.5983

# Funktion zur Berechnung der quadratischen 
# Differenz zwischen beobachteten und erwarteten Werten
diffquad <- function(obs, exp) {
  sum((obs - exp)^2)
}

# Quadratische Abweichung der gemessenen Werte
obs.abs <- diffquad(obs.tab, exp.tab)

# Erzeugen der Nullverteilung
NullVert  <- do(loops) * diffquad(tally(iphones.tagsüber.unbeachtet ~ shuffle(wetter.ist.gut), data = daten), exp.tab)
gf_dhistogram(~ diffquad, data = NullVert) %>%
  gf_vline(xintercept = ~ obs.abs, color = "red")

prop( ~ diffquad >= obs.abs, data = NullVert)

## prop_TRUE 
##    0.5389

# Funktion zur Berechnung der korrigierten quadratischen 
# Differenz zwischen beobachteten und erwarteten Werten
diffquadrel <- function(obs, exp) {
  sum(((obs - exp)^2)/exp)
}

# Quadratische Abweichung der gemessenen Werte -- korrigiert
obs.abs <- diffquadrel(obs.tab, exp.tab)

# Erzeugen der Nullverteilung
NullVert  <- do(loops) * diffquadrel(tally(iphones.tagsüber.unbeachtet ~ shuffle(wetter.ist.gut), data = daten), exp.tab)
gf_histogram(~ diffquadrel, binwidth = 0.5, center = 0.25, data = NullVert) %>%
  gf_vline(xintercept = ~ obs.abs, color = "red")

prop( ~ diffquadrel >= obs.abs, data = NullVert)

## prop_TRUE 
##    0.5599

Was sagt die klassische Statistik?

In der klassischen Statistik könnte man hier den \(\chi^2\)-Unabhängigkeitstest anwenden:

xchisq.test(iphones.tagsüber.unbeachtet ~ wetter.ist.gut, data = daten)

## 
##  Pearson's Chi-squared test
## 
## data:  x
## X-squared = 1.2345, df = 2, p-value = 0.5394
## 
##    29       33   
## (31.70)  (30.30) 
## [0.231]  [0.241] 
## <-0.48>  < 0.49> 
##    
##    34       26   
## (30.68)  (29.32) 
## [0.359]  [0.376] 
## < 0.60>  <-0.61> 
##    
##    27       27   
## (27.61)  (26.39) 
## [0.014]  [0.014] 
## <-0.12>  < 0.12> 
##    
## key:
##  observed
##  (expected)
##  [contribution to X-squared]
##  <Pearson residual>

Vergleichen wir nun die beiden Ansätze, SBI auf der einen und der klassische Ansatz auf der anderern Seite, einmal in einem Diagramm. Das (Dichte-)Histogramm sind die Daten aus der Nullverteilung für die quadratische, korrigierte Differenz. Die rote Linie ist der gemessene Abweichungswert. Die schwarze Linie ist der Graph der \(\chi^2\)-Verteilung mit zwei Freiheitsgraden:

gf_dhistogram(~ diffquadrel, binwidth = 0.5, center = 0.25, data = NullVert) %>%
  gf_fun(dchisq(x, df=2) ~ x, xlim = c(0:20), color = "blue") %>% 
  gf_vline(xintercept = ~ obs.abs, color = "red")

Aber es gibt auch den (exakten) Fisher-Test:

fisher.test(obs.tab, alternative = "greater")

## 
##  Fisher's Exact Test for Count Data
## 
## data:  obs.tab
## p-value = 0.5609
## alternative hypothesis: greater

Fazit

Wir können die p-Werte der einzelnen Tests nun gegenüber stellen:

## Scale for 'y' is already present. Adding another scale for 'y', which will
## replace the existing scale.

Gewöhnlich haben wir ein Signifikanznivau von \(5\% = 0{,}05\) angenommen. Die rote Linie zeigt diese Grenze. Liegt der Balken links vor dieser Linie, so sprechen wir davon, dass der gemessene Wert selten bei unabhänigen Daten vorliegt und würden uns gegen die Nullhypothese und damit quasi für die Alternativhypothese entscheiden. Liegt der Balken recht der roten Linie, so haben wir übliche Werte für unabhängige Daten und keinen Grund gefunden, der gegen die Nullhypothese spricht. Warum wir sie dann, auf Grundlage unserer Daten, auch nicht ablehnen können.

Bleibt Sie Frage, gibt es Situationen in denen die Entscheidung über die Nullhypothese bei den einzelen betrachteten Verfahren unterschiedlichen ist? Und wenn ja, wann und wieoft?

Diese Fragen sind nicht Thema dieses Beitrags, aber vielleicht habe ich Zeit und betrachte das später einmal.