Einleitung

In der bivariaten Statistik geht es darum, einen Zusammenhang oder eine Abhängigkeit zwischen zwei Variablen \(x\) und \(y\) zu finden. Die eingesetzte Technik ist primär vom Skalen-Niveau der beteiligten Variablen \(x\) und \(y\) abhängig.

• Sind beide Variablen qualitativ, so erstellt man eine Kontingenztabelle
• Ist eine qualitativ und die andere quantitativ, so erstellt man gruppierte deskriptive Statistiken (zum Beispiel Mittelwerte und Streuungen der quantitativen Variable nach Gruppen der qualitativen Variable)
• Sind beide Variablen quantitativ, so erstellt man Streudiagramme und errechnet Korrelationen und lineare Regressionen

Kontingenztabellen

Sie lassen \(n=100\) Personen eine Vorhersage zu einem Münzwurf machen und erheben das Geschlecht der befragten Person in der Variable geschlecht und das Resultat der Vorhersage (falsch oder richtig) in der Variable wurf.

Beide Variablen sind nominal-skaliert, also qualitativ. Wir wollen nun herausfinden, ob es eine Abhängigkeit zwischen dem Geschlecht und der Qualität zur Vorhersage gibt.

Das Resultat lässt sich mit einer Kontingenztabelle (Kreuztabelle) analysieren. Geben Sie sich die Inhalte der Vektoren wurf und geschlecht aus. Erstellen Sie für die (schon abgespeicherten Vektoren) geschlecht und wurf eine Häufigkeitstabelle und anschliessend obige Kontingenztabelle mit dem Befehl table(wurf,geschlecht)

wurf
geschlecht

table(wurf)
table(geschlecht)

# Kreuztabelle
t<-table(wurf,geschlecht)
t

Offensichtlich wurden insgesamt 50 von 100 Münzwürfen korrekt vorhergesagt, was gerade der erwarteten Häufigkeit von 50% entspricht. Es haben zudem 30 Männer und 70 Frauen am Experiment teilgenommen. Wir wollen nun anaylsieren, ob Männer häufiger richtig raten als Frauen. Hierfür erstellen wir eine Tabelle mit relativen Häufigkeiten über die Spalten (Spaltensummen = 100%). Erstellen Sie nochmals die Kontingenztabelle und anschliessend mit dem Befehl prop.table(t,2) die relativen Häufigkeiten über die Spalten (Das Argument 2 heisst, dass die Proportionen über die Spalten gebildet werden sollen).

# Kreuztabelle
t<-table(wurf,geschlecht)

# Relative Häufigkeiten über Spalten betrachten
prop.table(t,2)

Offensichtlich haben 60% der Männer richtig geraten, bei den Frauen beträgt dieser Anteil 45.7%. Diese Betrachtungsweise kann uns nun bei der Antwort nach einer Abhängigkeit zwischen Vorhersage und Geschlecht helfen: Falls es gar keine Abhängigkeit zwischen Geschlecht und Vorhersagequalität gäbe, so hätten wir innerhalb der Gruppen Mann und Frau die gleichen relativen Häufigkeiten erwartet wie über die Randhäufigkeit von 50:50. Zwar haben 10% mehr Männer auf ein richtig getippt, das Resultat ist aber von zufälliger Natur, da dies nur 3 Personen sind. Es gibt also keine Abhängigkeit zwischen Geschlecht und Vorhersagequalität.

Die gleichen Überlegungen könnten Sie sich auch über die Zeilen der Kreuztabelle machen. Erstellen Sie nochmals die Kontingenztabelle und anschliessend mit dem Befehl prop.table(t,1) die relativen Häufigkeiten über die Spalten (Das Argument 1 heisst, dass die Proportionen über die Zeilen gebildet werden sollen).

# Kreuztabelle
t<-table(wurf,geschlecht)

# Relative Häufigkeiten über Spalten betrachten
prop.table(t,1)

In der Gruppe der falschen Vorhersagen gibt es 24% Männer und 76% Frauen. Erwartet hätten wir gemäss den Randhäufigkeiten bei perfekter Unabhängigkeit eine Aufteilung von 30% : 70%. Die Abweichungen sind also auch über die Zeilen betrachtet gering.

Deskriptive Statistiken nach Gruppen

Sie haben \(n=90\) Personen nach dem Einkommen und dem Ausbildungsstand befragt (codiert als tief, mittel, hoch). Das monatliche Einkommen (gemessen in Dollar) haben Sie ebenfalls erhoben.

Da die Variable einkommen quantitativ und die Variable ausbildung qualitativ ist, bietet es sich an, eine deskritpive Statistik nach Gruppen zu machen.

Erstellen Sie eine univariate Statistik zu den Variablen ausbildung und einkommen:

table(ausbildung)
summary(einkommen)

Um nun zu entscheiden, ob es innerhalb der Gruppen der Variable ausbildung Unterschiede bezüglich der Variable einkommen gibt, erstellen wir nun eine gruppierte deskriptive Statistik mit dem Befehl by(data,indices,fun). Das Argument data steht hierbei für die auszuwertende Variable (hier einkommen), indices steht für die gruppierende Variable (hier ausbildung) und fun steht für die anzuwendende Funktion (hier zum Beispiel mean, oder sd oder summary).

#Mittelwerte nach Gruppen
by(einkommen, ausbildung, mean)

#Streuungen nach Gruppen
by(einkommen, ausbildung, sd)

#Deskr. Statistiken nach Gruppen
by(einkommen, ausbildung, summary)

Es ist einzusehen, dass die Mittelwerte der Einkommen mit erhöhten Ausbildungs-level markant zunehmen, es gibt also eine Abhängigkeit zwischen den Variablen ausbildung und einkommen.

Zeichnen Sie einen gruppierten Boxplot der Variable einkommen nach Gruppen der Variable ausbildung:

boxplot(einkommen~ausbildung,col=c("steelblue","green","red"),ylim=c(0,max(einkommen)),xlab="Ausbildung",ylab="Einkommen")

Korrelation

Sie erheben die Wohnfläche \(x\) in Quadratmeter von \(n=20\) Mietwohnungen und den monatlichen Mietpreis \(y\) in CHF. Da beide Variablen quantitativ sind kann man versuchen, einen Zusammenhang der beiden Variablen mittels eines Streudiagrammes aufzuzeigen.

Die Variablen x (Fläche) und y (Preis) sind schon abgespeichert. Geben Sie von diesen Variablen den Mittelwert und die Streuung an und erstellen Sie ein Streudiagramm:

print("Fläche")
mean(x)
sd(x)

print("Preis")
mean(y)
sd(y)

plot(x,y)

Von einer rein visuellen Betrachtung scheint es so zu sein, als dass eine Erhöhung der Wohnflächen \(x\) zu einer Erhöhung der Mietpreise \(y\) führen (und umgekehrt). In diesem Fall sprechen wir von einer positiven linearen Abhängigkeit. Die Stärke der linearen Abhängigkeit kann man in einer Masszahl ausdrücken, der Korrelation \(r\). Diese Masszahl liegt innerhalb der Grenzen:

\[-1 \leq r \leq +1\]

Wobei \(r=-1\) für eine perfekte negative lineare Abhängigkeit und \(r=+1\) für eine perfekte positive lineare Abhängigkeit steht. Eine Korrelation von \(r=0\) bedeutet, dass es keine lineare Abhängigkeit gibt.

Berechnen Sie nun die Korrelation zwischen Mietpreis \(y\) und Wohnfläche \(x\) mit dem Befehl cor(x,y).

cor(x,y)

Die Korrelation ist unabhängig von der Masseinheit (z.B. hätte man die Miete anstatt in CHF in Tausend CHF erheben können, das Resultat bliebe dasselbe). Eine (gerundete) Korrelation von \(r=0.4\) deutet auf eine moderate positive lineare Abhängigkeit zwischen Mietpreis und Fläche hin.

Um ein Gefühl für die Korrelation zu erlangen, können Sie mit untenstehendem Schieberegler die Korrelation zwischen \(-1 \leq r \leq +1\) verschieben und das Schaubild (simulierte Daten) betrachten.

Lineare Trends und Regression

Eine Trendgerade bildet den “besten” Fit durch die Punktwolke des Streudiagramms ab. Beispielsweise können wir durch die vorhin erhobenen Punktwolke eine Trendgerade legen.

Die blaue Punktwolke zeigt offensichtlich die vorherig illustrierte Stichprobe der 20 Wohnungen. Diese Gerade versucht nun, einen Zusammenhang zwischen den Wohnungsflächen \(x\) in \(m^2\) und den Mietpreisen \(y\) in \(CHF\) darzustellen, formal also:

\[y = a\cdot x + b\]

Ein derartiger funktionaler Zusammenhang ist linear. Der Koeffizient \(b\) gibt dabei den Mietpreis einer Wohnung an, welche die Wohnfläche \(x=0m^2\) hat. Daher heisst der Parameter \(b\) auch y-Achsenabschnitt. Wird in obigem Diagramm für die blaue Punktwolke die Trendgerade angezeigt, so sieht man, dass diese die \(y\)-Achse bei \(y=500\). Dies bedeutet, dass für die blaue Trendgerade \(b=500\) gilt.

Der Koeffizient \(a\) heisst Steigung der Gerade und gibt den Wertzuwachs der Mieten \(y\) an, wenn sich \(x\) um eine Einheit ändert. Formal gilt:

\[a = \frac{\Delta y}{\Delta x}\]

Der obige Graph eignet sich aber schlecht, um Veränderungen der Trendgerade über \(\Delta x=1m^2\) Wohnfläche zu betrachten. Fixieren wir zwei Punkte auf der Gerade: Den y-Abschnitt haben wir schon mit \((x=0\texttt{m}^2, y=500\texttt{CHF})\). Einen zweiten Punkt wählen wir willkürlich bei zum Beispiel \(x=100m^2\) und können den Preis ungefähr bei \(y=1400\texttt{CHF}\) ablesen. Der Parameter \(a\) berechnet sich dann über

\[a = \frac{\Delta y}{\Delta x} = \frac{1400\texttt{CHF} - 500\texttt{CHF}}{100m^2-0m^2} = 10\frac{\texttt{CHF}}{m^2}\]

Somit haben wir den funktionalen Zusammenhang der blauen Gerade durch die Punktwolke gefunden, er lautet (ungefähr):

\[y = 10\cdot x + 500\]

Dies bedeutet nun:

• Eine Wohnung mit Wohnfläche \(x=0m^2\) kostet monatlich \(y=b=500)\) CHF. Erwartet würde ein Wert von 0 CHF. Da es sich hier aber nur um eine Stichprobe von Wohnungen handelt, ist dieser Wert mit Unsicherheit behaftet.
• Wir bewerten den Wert eines Quadratmeters Wohnfläche mit \(a = 10\) CHF. Auch dieser Wert ist mit einer Unsicherheit behaftet.

Sie können das Zeichnen der Gerade für eine neue Stichprobe wiederholen und sehen, dass die Gerade immer in einem gewissen Bereich schwankt (Schätzunsicherheit von \(a\) und \(b\), je nach Stichprobe erhalten wir leicht andere Werte).

Wir Fassen die deskriptiven Statistiken der \(n=20\) Wohnflächen \(x\) und Mietpreisen \(y\) nochmals zusammen:

Mit diesen Grössen lassen sich die Steigung \(a\) und der Achsenabschnitt \(b\) der Trendgeraden oder Regressionsgeraden direkt berechnen, die Formeln lauten:

\[a = r\cdot \frac{s_y}{s_x} \texttt{ und } b = \bar{y}-a\cdot \bar{x}\]

Mit unseren Angaben erhält man:

\[a = 0.412\cdot \frac{617.6}{26.1} = 9.8\] \[b = 1319.2-9.8\cdot 86.7 = 473\]

Der funktionale Zusammenhang lautet somit:

\[\hat{y} = 9.8\cdot x + 473\]

Wie oben zu sehen haben wir mit \(\hat{y}\) eine neue Bezeichnung eingeführt:

• \(\hat{y}\) bezeichnen die durch die Regressions-Gerade vorhergesagten Mietpreise
• \(y\) sind die wahren Mietpreise.
• Mit \(e\) bezeichnen wir den Vorhersagefehler \(e=y-\hat{y}\).

Zum Beispiel können wir für den Datenpunkt mit Wohnfläche \(x=40\) eine Vorhersage rechnen: Wir erhalten die vorhergesagte Miete bei \(\hat{y}=9.8\cdot 40+473 = 864\). Der tatsächliche Mietpreis ist aber gemäss Tabelle bei \(y=1025\). Das heisst, der Vorhersagefehler \(e\) liegt bei \(e=y-\hat{y} = 1025-864 = 161.1\).

Wir können nun noch für sämtliche Daten die Vorhersage \(\hat{y}\) (machnmal auch \(y_p\) genannt, wobei p für prediction steht), und den Vorhersagefehler berechnen:

Wir rechnen für eine finale Analyse unseres Regressions-Modell die deskriptiven Statistiken zu \(y\), \(\hat{y}\) und \(e\) aus:

Wir erhalten:

Zwei Punkte sind hier wichtig:

Erstens beträgt der mittlere Vorhersagefehler gerade 0. Die Regressionsgerade verläuft somit exakt durch den Mittelwert der Punktwolke, also durch den Punkt \((\bar{x}|\bar{y})\).

Die Varianz in den zu erklärenden Preisen \(y\) kann zerlegt werden in eine Varianz, welche durch das Modell erklärt wird und eine Rest-Varianz in den Fehlertermen. Offensichtlich gilt:

\[s_y^2 = s_{\hat{y}}^2 + s_e^2\]

oder (abgesehen von minimalen Rundungsfehlern)

\[381390 = 64814+316575\]

Das Verhältnis der durch das Modell erklärten Varianz zur totalen Varianz nennt sich Bestimmtheitsmass \(R^2\), man erhält hier:

\[R^2 = \frac{s_{\hat{y}}^2}{s_y^2} = \frac{64814}{381390} = 0.17= 17\%\]

Dies bedeutet also, dass wir mit einem linearen Modell über die Wohnflächen 17% der Variation in den Mieten \(y\) erklären können.

Wichtig: Das Bestimmtheitsmass ist identisch mit der quadrierten Korrelation: \(R^2 = r^2\), oder

\[R^2 = r^2 = (0.412)^2 = 17\%\]

r<-cor(x,y)
sy<-sd(y)
sx<-sd(x)
my<-mean(y)
mx<-mean(x)

a<-r*sy/sx
b<-my-a*mx

a
b

r<-cor(x,y)
sy<-sd(y)
sx<-sd(x)
my<-mean(y)
mx<-mean(x)

a<-r*sy/sx
b<-my-a*mx

a
b

r<-cor(x,y)
sy<-sd(y)
sx<-sd(x)
my<-mean(y)
mx<-mean(x)

a<-r*sy/sx
b<-my-a*mx

a
b

yp<-a*x+b
e<-y-yp

sd(y)^2-sd(yp)^2-sd(e)^2

lm(y~x)
summary(lm(y~x))

lm(y~x)
summary(lm(y~x))

Quizz zu Geradengleichungen

Hier haben Sie die Gelegenheit, das Aufstellen von Geradengleichungen der Form \(y=a\cdot x + b\) zu üben.

Errechnen Sie die Funktion anhand der zwei eingezeichneten Punkte \(A\) und \(B\). Geben Sie die Geradengleichung in der Form von zum Beispiel y=3/4*x+3.5 an.

Übungs-Generator für schriftliche Aufgaben

Hier können Sie sich Lehrkräfte und Studierende schriftliche Übungen nach Zufallsprinzip generieren lassen. Die Übungen werden in ein Word-Dokument mit Lösungen geschrieben und dieses kann dann zum Zweck eigener Formatierungen noch angepasst werden. Diese Übungen beinhalten (fast) keine R-basierten Aufgaben sondern nur solche, die im Rahmen einer schriftlichen Aufgabe lösbar sind. Die Aufgabensätze werden als Word-Dokument generiert und können nach eigenen Bedürfnissen formatiert werden.

Aufgabenblatt bivariate Statistik Version 1

Drucken Sie sich die Übung Version 1 unter Übungsgenerator für schriftliche Aufgaben aus oder öffnen Sie diese in einem zweiten Fenster.

geschlecht <- c(0,0,1,1,1,1,1,1,1,1,1,1,0,1,0,0,1,1,1,1,1,1,1,1,1,0,1,0,0,1)
ausbildung <- c(1,1,3,3,1,2,2,2,3,1,3,1,2,1,1,3,3,1,2,1,2,3,2,2,1,2,3,3,3,3)

geschlecht<-factor(geschlecht,levels=c(0,1),labels=c("w","m"), ordered=F)
ausbildung<-factor(ausbildung,levels=c(1,2,3),labels=c("HAS","ABI","HOS"),ordered=TRUE)

geschlecht
ausbildung

geschlecht <- c(0,0,1,1,1,1,1,1,1,1,1,1,0,1,0,0,1,1,1,1,1,1,1,1,1,0,1,0,0,1)
ausbildung <- c(1,1,3,3,1,2,2,2,3,1,3,1,2,1,1,3,3,1,2,1,2,3,2,2,1,2,3,3,3,3)

geschlecht<-factor(geschlecht,levels=c(0,1),labels=c("w","m"), ordered=F)
ausbildung<-factor(ausbildung,levels=c(1,2,3),labels=c("HAS","ABI","HOS"),ordered=TRUE)

geschlecht <- c(0,0,1,1,1,1,1,1,1,1,1,1,0,1,0,0,1,1,1,1,1,1,1,1,1,0,1,0,0,1)
ausbildung <- c(1,1,3,3,1,2,2,2,3,1,3,1,2,1,1,3,3,1,2,1,2,3,2,2,1,2,3,3,3,3)

geschlecht<-factor(geschlecht,levels=c(0,1),labels=c("w","m"), ordered=F)
ausbildung<-factor(ausbildung,levels=c(1,2,3),labels=c("HAS","ABI","HOS"),ordered=TRUE)

t<-table(geschlecht,ausbildung)
t

rowSums(t)
colSums(t)

geschlecht <- c(0,0,1,1,1,1,1,1,1,1,1,1,0,1,0,0,1,1,1,1,1,1,1,1,1,0,1,0,0,1)
ausbildung <- c(1,1,3,3,1,2,2,2,3,1,3,1,2,1,1,3,3,1,2,1,2,3,2,2,1,2,3,3,3,3)

geschlecht<-factor(geschlecht,levels=c(0,1),labels=c("w","m"), ordered=F)
ausbildung<-factor(ausbildung,levels=c(1,2,3),labels=c("HAS","ABI","HOS"),ordered=TRUE)

t<-table(geschlecht,ausbildung)
t

geschlecht <- c(0,0,1,1,1,1,1,1,1,1,1,1,0,1,0,0,1,1,1,1,1,1,1,1,1,0,1,0,0,1)
ausbildung <- c(1,1,3,3,1,2,2,2,3,1,3,1,2,1,1,3,3,1,2,1,2,3,2,2,1,2,3,3,3,3)

geschlecht<-factor(geschlecht,levels=c(0,1),labels=c("w","m"), ordered=F)
ausbildung<-factor(ausbildung,levels=c(1,2,3),labels=c("HAS","ABI","HOS"),ordered=TRUE)

t<-table(geschlecht,ausbildung)

prop.table(t,1)

# Vergleich mit relativen Spaltenhäufigkeiten
prop.table(table(ausbildung))

geschlecht <- c(0,0,1,1,1,1,1,1,1,1,1,1,0,1,0,0,1,1,1,1,1,1,1,1,1,0,1,0,0,1)
ausbildung <- c(1,1,3,3,1,2,2,2,3,1,3,1,2,1,1,3,3,1,2,1,2,3,2,2,1,2,3,3,3,3)

geschlecht<-factor(geschlecht,levels=c(0,1),labels=c("w","m"), ordered=F)
ausbildung<-factor(ausbildung,levels=c(1,2,3),labels=c("HAS","ABI","HOS"),ordered=TRUE)

t<-table(geschlecht,ausbildung)
t

geschlecht <- c(0,0,1,1,1,1,1,1,1,1,1,1,0,1,0,0,1,1,1,1,1,1,1,1,1,0,1,0,0,1)
ausbildung <- c(1,1,3,3,1,2,2,2,3,1,3,1,2,1,1,3,3,1,2,1,2,3,2,2,1,2,3,3,3,3)

geschlecht<-factor(geschlecht,levels=c(0,1),labels=c("w","m"), ordered=F)
ausbildung<-factor(ausbildung,levels=c(1,2,3),labels=c("HAS","ABI","HOS"),ordered=TRUE)

t<-table(geschlecht,ausbildung)

prop.table(t,2)

# Vergleich mit relativen Zeilenhäufigkeiten
prop.table(table(geschlecht))

bildung <- c(rep(1,627),rep(2,864),rep(3,609))

einkommen <- c(rep(1,397),rep(2,162),rep(3,68),
               rep(1,343),rep(2,322),rep(3,199),
               rep(1,125),rep(2,303),rep(3,181))

bildung <- c(rep(1,627),rep(2,864),rep(3,609))

einkommen <- c(rep(1,397),rep(2,162),rep(3,68),
               rep(1,343),rep(2,322),rep(3,199),
               rep(1,125),rep(2,303),rep(3,181))

bildung <- c(rep(1,627),rep(2,864),rep(3,609))

einkommen <- c(rep(1,397),rep(2,162),rep(3,68),
               rep(1,343),rep(2,322),rep(3,199),
               rep(1,125),rep(2,303),rep(3,181))

bildung <- factor(bildung,levels=1:3,labels=c("Tief","Mittel","Hoch"),ordered=TRUE)
einkommen <- factor(einkommen,levels=1:3,labels=c("Tief","Mittel","Hoch"),ordered=TRUE)

t<-table(bildung,einkommen)
prop.table(t,1)

# Vergleich mit Randhäufigkeiten
prop.table(table(einkommen))

x<-c(11,15,9,9,15,11,10,12,10,8,12,11,10)
y<-c(0,5,2,-2,8,5,4,0,1,0,5,3,-1)

x<-c(11,15,9,9,15,11,10,12,10,8,12,11,10)
y<-c(0,5,2,-2,8,5,4,0,1,0,5,3,-1)

plot(x,y,xlim=c(-3,16),ylim=c(-3,16),col="steelblue")
abline(lm(y~x))
points(mean(x),mean(y),col="red")

x<-c(11,15,9,9,15,11,10,12,10,8,12,11,10)
y<-c(0,5,2,-2,8,5,4,0,1,0,5,3,-1)

x<-c(11,15,9,9,15,11,10,12,10,8,12,11,10)
y<-c(0,5,2,-2,8,5,4,0,1,0,5,3,-1)

mx<-mean(x); sx<-sd(x)
my<-mean(y); sy<-sd(y)
r<-cor(x,y)

print(paste("MW von x: ",round(mx,3)," MW von y: ", round(my,3),sep=""))
print(paste("SD von x: ",round(sx,3)," SD von y: ", round(sy,3),sep=""))
print(paste("Corr x y: ",round(r,3),sep=""))

a<-r*sy/sx
b<-my-a*mx

print(paste("Gleichung der Regressionsgeraden: y = ",round(a,3),"*x + ",round(b,3),sep=""))

x<-c(11,15,9,9,15,11,10,12,10,8,12,11,10)
y<-c(0,5,2,-2,8,5,4,0,1,0,5,3,-1)

x<-c(11,15,9,9,15,11,10,12,10,8,12,11,10)
y<-c(0,5,2,-2,8,5,4,0,1,0,5,3,-1)

mx<-mean(x); sx<-sd(x)
my<-mean(y); sy<-sd(y)
r<-cor(x,y)

a<-r*sy/sx; b<-my-a*mx

yp <- a*x+b
e <- y-yp

sy2=sy^2
syp2=sd(yp)^2
se2=sd(e)^2

sy2-syp2-se2

R2<-syp2/sy2
R2
r^2

x<-c(11,15,9,9,15,11,10,12,10,8,12,11,10)
y<-c(0,5,2,-2,8,5,4,0,1,0,5,3,-1)

x<-c(11,15,9,9,15,11,10,12,10,8,12,11,10)
y<-c(0,5,2,-2,8,5,4,0,1,0,5,3,-1)

lm(y~x)
model<-lm(y~x)
summary(model)