Presentation.Rmd

---
title: "Prüfungstutorium QM1"
author: "Tobi, Lukas"
date: "Rendered at `r format(Sys.time(), '%F %H:%M')`"
output:
  ioslides_presentation:
    css: styles.css
    fig_height: 4
    fig_width: 8
    incremental: yes
    logo: RStudio-Ball.png
    self_contained: no
    lib_dir: "assets"
    smaller: yes
    transition: slower
    widescreen: yes
  html_document:
    fig_caption: yes
    fig_width: 9
    number_sections: no
    self_contained: no
    lib_dir: "assets"
    toc: yes
---

```{r global_options, include=FALSE}
knitr::opts_chunk$set(fig.path = "plots/", fig.align = "center", 
                      fig.retina = 2, echo = F, warning = F, message = F)
# Package init script
#suppressWarnings(source("http://stats.jemu.name/qm/tools/package-init.R"))
library(sjPlot)
library(dplyr)
library(knitr)
library(ggplot2)
library(tadaatoolbox)
library(mosaic)
library(magrittr)
library(car)
library(formattable)
library(htmlTable)
library(tidyr)

# NGO & FKV Datensatz einlesen
fkv <- haven::read_sav("./data/fkv.sav")

# 3 digits are enough
options(digits = 3)
```

# Intro

### This is Prüfungstutorium, it tutors Prüfung

## Agenda {.flexbox .vcenter}

<div class = "center">
1. Aufgaben besprechen
2. Fragen klären
3. Angrenzende Theorie besprechen

* Erfahrungsgemäß reicht die Zeit **entweder** für alle Aufgaben, **oder** für alle Fragen.  
* Choose wisely.
</div>

## Aufgabe 1 | Faktorenanalyse

Im Rahmen einer Hauptkomponentenanalyse wurde die folgende Komponenten-Matrix ermittelt:

<div class = "columns-2">
```{r A01_data}
a01 <- data.frame(Merkmal = paste0("A", 1:15),
           K1 = c(-.724, -.294, .665, .639, -.599, .388, .643, -.544,
                  -.274, .571, -.230, .737, .789, .672, .630),
           K2 = c(.351, .642, .310, .2, .622, .39, .398, .429, .407, .334, 
                  .177, 0, .256, -.024, .134),
           K3 = c(.036, -.01, -.311, .053, .001, -.530, -.003, .349, .266,
                  -.323, .412, .389, .104, .520, .366)) 

a01 %>% kable()
```

</div>

## Aufgabe 1 | Faktorenanalyse

a) Was bedeuten die drei Werte innerhalb der zweiten Zeile?
b) Wie groß ist die Kommunalität des durch „A10“ gekennzeichneten Merkmals?
c) Welchen Wert besitzt der drittgrößte Eigenwert?
d) Wie viel Prozent der Gesamtvarianz aller 15 in die Faktorenanalyse einbezogenen (standardisierten)
Merkmale wird durch den 3. Faktor erklärt?
e) Warum enthält die Komponenten-Matrix vermutlich nur drei Spalten?
f) Auf welche Faktoren laden die durch „A1“ bis „A15“ gekennzeichneten Merkmale jeweils am höchsten?
g) Gibt es bei den - im Rahmen der Suche nach einer Einfachstruktur - innerhalb von „f)“ vorgenommenen
Zuordnungen an irgendeiner Stelle ein Problem, sodass es sinnvoll erscheinen könnte, eine Rotation durchzuführen?

## Aufgabe 1

> Was bedeuten die drei Werte innerhalb der zweiten Zeile?

```{r A01_a}
cols <- with(a01, ifelse(Merkmal == "A2", 'green', 'white'))

htmlTable(as.matrix(a01), col.rgroup = cols)
```

## Aufgabe 1

> Wie groß ist die Kommunalität des durch „A10“ gekennzeichneten Merkmals?

* $$ 0.571^2 +  0.334^2 - 0.323^2 = 0.333 $$

* > Welchen Wert besitzt der drittgrößte Eigenwert?

Faktor 1 | Faktor 2 | Faktor 3 
---------|----------|---------
`r sum(a01$K1^2)` | `r sum(a01$K2^2)` | `r sum(a01$K3^2)`


* > Wie viel Prozent der Gesamtvarianz aller 15 in die Faktorenanalyse einbezogenen (standardisierten) Merkmale wird durch den 3. Faktor erklärt?

  + $$ .036^2 - 0.1^2 - 0.311^2 + 0.053^2 + ... = `r sum(a01$K3^2)` $$

## Aufgabe 1

> Warum enthält die Komponenten-Matrix vermutlich nur drei Spalten?

## Aufgabe 1

> Auf welche Faktoren laden die durch „A1“ bis „A15“ gekennzeichneten Merkmale jeweils am höchsten?

<div>
![](plots/ladungen.png)
</div> 

## Aufgabe 1

> Auf welche Faktoren laden die durch „A1“ bis „A15“ gekennzeichneten Merkmale jeweils am höchsten?

<div>
![](plots/ladungen_max.png)
</div> 

## Aufgabe 1

> Gibt es bei den - im Rahmen der Suche nach einer Einfachstruktur - innerhalb von „f)“ vorgenommenen Zuordnungen an irgendeiner Stelle ein Problem, sodass es sinnvoll erscheinen könnte, eine Rotation durchzuführen?

<div>
![](plots/ladungen.png)
</div> 

## Aufgabe 1

> Gibt es bei den - im Rahmen der Suche nach einer Einfachstruktur - innerhalb von „f)“ vorgenommenen Zuordnungen an irgendeiner Stelle ein Problem, sodass es sinnvoll erscheinen könnte, eine Rotation durchzuführen?

<div>
![](plots/ladungen_pcor.png)
</div>  

## Aufgabe 2 | Faktorenanalyse

Führen Sie eine Hauptkomponentenanalyse für den FKV- Datensatz durch. Prüfen Sie, welche Faktoren Sie zuvor inhaltlich angedacht hatten und welche Faktoren die Testautoren benannt haben. Stimmen die statistischen Daten damit überein?

## Aufgabe 2

```{r A02_pca}
pca <- sjt.pca(data = fkv[-1], nmbr.fctr = 5,
               use.viewer = F, no.output = T)
```

<div class="columns-2">
`r pca$knitr`
</div>

## Aufgabe 3 | Zentral- & Variabilitätsmaße {.flexbox .vcenter}

Sie haben Werte des Merkmals „Unterrichtsstunden“ u.a. zur Berechnung der Variabilitätsmaße und Zentralmaße verwendet. Reflektieren Sie die Zentral- und Variabilitätsmaße. Sind alle Statistiken gut geeignet?

* Variation = `r var(ngo$stunzahl) * (length(ngo$stunzahl) + 1)` — Varianz = `r var(ngo$stunzahl)` — Standardabweichung = `r sd(ngo$stunzahl)`

```{r a03}
mvalues <- data.frame(Zentralmaß = factor(c("Mittelwert", "Median", "Modus")),
                      Wert = c(mean(ngo$stunzahl), median(ngo$stunzahl), modus(ngo$stunzahl)))

# ggplot(data = ngo, aes(x = stunzahl)) +
#   geom_histogram(binwidth = 1) +
#   geom_vline(data = mvalues, aes(xintercept = Wert, colour = Zentralmaß), size = 2) +
#   labs(x = "Unterrsichtsstunden", y = "Häufigkeit")
```

## Aufgabe 4 | Standardabweichung (s.a.: trololol)

Sie haben folgende Zahlen vorliegen: `7, 9, 10, 11, 11, 14, 15, 16`. Berechnen Sie für diese Werte die Standardabweichung per Hand.

Standardabweichung: $$\sigma = \sqrt{\frac{1}{n-1} \sum^n_{i = 1} (x_i - \bar{x})^2}$$

* $\bar{x} = 11.625$
* $\sigma = \sqrt{\frac{1}{8-1} \cdot (7-11.625)^2 + (9-11.625)^2 + \ldots + (16-11.625)^2}$
* $\sigma = \sqrt{\frac{1}{7} \cdot 21.39 + 6.89 + \ldots + 19.14} = \sqrt{\frac{1}{7} \cdot 67.875}$
* $\sigma = \sqrt{9.696} \approx 3.114$

## Aufgabe 5 | z-Transformation

Berechnen Sie für die Werte `23, 27` und `31` von „stunzahl“ (Auswahl der Schülerinnen der 13. Klasse) die standardisierten Werte per Hand.

```{r a05}
values <- ngo %>% filter(jahrgang == "13", geschl == "Weiblich") %>% 
  summarize(mean = mean(stunzahl), sd = sd(stunzahl))
```

z-Standardisierung: $$z_i = \frac{x_i - \bar{x}}{\sigma}$$

* Werte: $\bar{x} = `r values$mean`$ und $\sigma = `r values$sd`$
* $23 \rightarrow \frac{23 - 29.52}{5.78158} \approx -1.1277194$
* $27 \rightarrow \frac{27 - 29.52}{5.78158} \approx -0.4358670$
* $31 \rightarrow \frac{31 - 29.52}{5.78158} \approx 0.2559854$

## Aufgabe 6 | Normalverteilung & Wahrscheinlichkeiten

Ein Merkmal ist $N(3, 2)$- verteilt. Berechnen Sie die Wahrscheinlichkeit dafür, dass Merkmalsträger Werte zwischen 2 und 4,5 besitzen und die Wahrscheinlichkeit dafür, dass Merkmalsträger Werte besitzen, die kleiner als 4 sind.

* $P(2 < x < 4.5) = `r pnorm(4.5, mean = 3, sd = 2) - pnorm(2, mean = 3, sd = 2)`$
* $P(x < 4) = `r pnorm(4, mean = 3, sd = 2)`$

```{r a06, fig.height=3, fig.width=5, fig.show='hold'}
xpnorm(2, mean = 3, sd = 2, verbose = F, invisible = T)
xpnorm(4.5, mean = 3, sd = 2, verbose = F, invisible = T)
```


## Aufgabe 7 | Vergleichbarkeit

Eine Person hat in drei Tests (T1, T2 und T3) folgende drei Punktzahlen erreicht:
  
`T1=10 T2=10 T3=10`

Als Mittelwert wurde für T1 der Wert 10, für T2 der Wert 15 und für T3 der Wert 20 ermittelt. Die Standardabweichungen betragen bei T1=2, T2=1 und bei T3=1,5.

a) In welchem der Tests hat die Person am besten abgeschnitten? Und warum?
b) Welchen Wert könnte man der Person als Gesamttestwert sinnvoll zuordnen? Und welche Informationen sind wichtig für Sie, um eine geeignete Zuordnung zu wählen?

* $z_{T1} = \frac{(10 - 10)}{2} = 0$
* $z_{T2} = \frac{(10 - 15)}{1} = -5$
* $z_{T3} = \frac{(10 - 20)}{1.5} = -6.\bar{6}$

## Aufgabe 8 | nominale Zusammenhänge

Erstellen Sie eine Kontingenztabelle mit dem Zeilenmerkmal „abschalt“ (Abschalten“) und dem Spaltenmerkmal „jahrgang“ („Jahrgangsstufe“). Berechnen Sie die Indifferenztabelle und den Chi-Quadrat Wert sowie C und V per Hand. Interpretieren Sie diese Ergebnisse.

```{r a08}
tabelle <- sjt.xtab(ngo$abschalt, ngo$jahrgang, 
                    show.row.prc = T, show.exp = T, show.legend = F, show.summary = F,
                    use.viewer = F, no.output = T)
```

`r tabelle$knitr`

## Aufgabe 8 | Chi-Quadrat und darauf basierende Statistiken {.flexbox .vcenter}

$$\chi^2 = \sum_{\text{Alle Zellen}} \frac{(f_b - f_e)^2}{f_e}$$

* $\chi^2 = \frac{(57 - 54)^2}{54} + \frac{(53 - 56)^2}{56} + \frac{(28 - 28)^2}{28} + \ldots + \frac{(22 - 22)^2}{22}$
* $\chi^2 = 0.1\bar{6} + 0.161 + 0 + \ldots + 0$
* $\chi^2 \approx 0.544$

## Aufgabe 8 | Chi-Quadrat und darauf basierende Statistiken {.flexbox .vcenter}

### Kontingenzkoeffizient C

$$C = +\sqrt{\frac{\chi^2}{\chi^2 + n}}$$

* $C = \sqrt{\frac{0.544}{0.544 + 246}} \approx 0.047$

## Aufgabe 8 | Cramer's V {.flexbox .vcenter}

$$\text{Cramer's V} = +\sqrt{\frac{\chi^2}{n \cdot min(r-1, c-1)}}$$

* $r = 2$ und $c = 3 \rightarrow min(1, 2) = 1$
* $V = \sqrt{\frac{0.544}{246 \cdot 1}} \approx 0.047$


## Aufgabe 9 | Ordinale Zusammenhänge {.flexbox .vcenter}

Sie haben die Werte der Variablen „Begabung“ klassiert, indem die Werte 1, 2 und 3 in den neuen Wert 1, die Werte 4, 5 und 6 in den neuen Wert 2 und die Werte 7, 8 und 9 in den neuen Wert 3 rekodiert wurden. Berechnen Sie auf Basis einer Kontingenztabelle der rekodierten Variablen „Begabung“ und „Jahrgang“ Folgendes per Hand:

a) Die Anzahl der konkordanten Paare 
b) Die Anzahl der diskordanten Paare 
c) Die Anzahl der Bindungen
d) Welche Schlüsse kann man nur aufgrund a) und b) und c) bzgl. der statistischen Beziehung ziehen? 
e) Berechnen Sie aufgrund a) und b) den Wert für Gamma. Besteht ein statistischer Zusammenhang? 
f) Wäre eine andere Statistik geeigneter?

## Aufgabe 9 | Kontingenztabelle {.flexbox .vcenter}

```{r a09}
ngo %<>% mutate(begabung_k = car::recode(begabung, "1:3=1; 4:6=2; 7:9=3"))

tabelle <- sjt.xtab(ngo$begabung_k, ngo$jahrgang, 
                    var.labels = c("Begabung (klassiert)", "Jahrgang"),
                    show.row.prc = F, show.exp = F, show.legend = F, show.summary = F,
                    use.viewer = F, no.output = T)
```

`r tabelle$knitr`

<br \>

* **Konkordant**: $1 \cdot (46+26+54+24) + 63 \cdot (54+24) + 46 \cdot (24) = 6168$
* **Diskordant**: $26 \cdot (54 + 36) + 46 \cdot (36) = 3996$
* **Bindungen**: $1 \cdot (0 + 0) + 63 \cdot (46 + 26) + 46 \cdot 26 + 36 \cdot (54 + 24) + 54 \cdot 24  = 9836$

## Aufgabe 9 | Gamma und verwandte Statistiken {.flexbox .vcenter}

$$\text{Gamma} = \frac{N_c - N_d}{N_c + N_d}$$

* $\gamma = \frac{6168 - 3996}{6168 + 3996} \approx 0.214$

* > Wäre eine andere Statistik geeigneter?

## Aufgabe 9 | Gamma und verwandte Statistiken {.flexbox .vcenter}

### Somer's d

$$\text{Somer's d} = \frac{N_c - N_d}{N_c + N_d + t}$$

* Somer's d $= \frac{6168 - 3996}{6168 + 3996 + 9836} = 0.1086$


## Aufgabe 10 | lineare Einfachregression

Beantworten Sie folgende Fragen:

a) Was versteht man unter einem Residuum, der Niveaukonstante und dem Steigungskoeffizienten?
b) Welche formale Beziehung besteht zwischen der Kovarianz und dem Steigungskoeffizienten?
c) Was bedeutet es, wenn die Regressionsgerade parallel zur X-Achse verläuft?
d) Welche Eigenschaften besitzt die Regressionsgerade?

## Aufgabe 10 

> **Was versteht man unter einem Residuum, der Niveaukonstante und dem Steigungskoeffizienten?**

* **Residuum**:  
    + Der Abstand zwischen einem beobachteten Wert und der Regressionsgeraden
* **Niveaukonstante**:  
    + der Wert, bei dem die Regressionsgerade die y-Achse schneidet
    + (oder wie früher in Mathe: der *y-Achsenabschnitt*)
* **Steigungskoeffizient**:  
    + gibt an, um wieviele Einheiten sich y verändert, wenn sich x um *eine* Einheit ändert

## Aufgabe 10 - Beispiel

<img src="http://stats.jemu.name/qm/meta/Teilnehmer_files/figure-html/plots_byWeek-2.png" width="80%">

## Aufgabe 10 | Residuen

<img src="http://dump.jemu.name/tI7Hc.png" width="80%">

## Aufgabe 10 | Residuenquadrate

<img src="http://dump.jemu.name/8XUJb.png" width="80%">

## Aufgabe 10 

> **Welche formale Beziehung besteht zwischen der Kovarianz und dem Steigungskoeffizienten?**

#### Kovarianz

$$Cov_{x, y} = s_{x, y} = \sum_{i=1}^{n} \frac { (x_i - \bar{x})(y_i - \bar{y}) }{ n - 1 }$$

#### Steigungskoeffizient

$$ b = \frac { s_{x, y} }{ s_{x}^2 } $$

#### Reminder: z-Transformation

$$ z_i = \frac {x_i - \bar{x} }{ \sigma_x }$$

## Aufgabe 10 

> **Was bedeutet es, wenn die Regressionsgerade parallel zur X-Achse verläuft?**

```{r A10_c1}
a10c <- data.frame("x" = c(1:100),
                   "y" = rep(6, 100))

ggplot(a10c, aes(x = x, y = y)) +
  geom_smooth(method = "lm", se = F) +
  scale_y_continuous(limits = c(5.6, 6.4)) +
  labs(x = "", y = "") + theme_bw()
```

## Aufgabe 10

> **Was bedeutet es, wenn die Regressionsgerade parallel zur X-Achse verläuft?**

```{r A10_c2}
a10c <- data.frame("x" = c(1:100),
                   "y" = rep(6, 100))

ggplot(a10c, aes(x = x, y = y)) +
  geom_smooth(method = "lm", se = F) +
  geom_point(position = "jitter") +
  scale_y_continuous(limits = c(5.6, 6.4)) +
  labs(x = "", y = "") + theme_bw()
```

## Aufgabe 10 

> **Welche Eigenschaften besitzt die Regressionsgerade?**

- ...ist die Gerade mit den geringsten Residuenquadraten
- verläuft **immer** durch $P( \bar{x} | \bar{y} )$

## Aufgabe 11 | intervallskalierte Zusammenhänge

Geben Sie die Formel des Korrelationskoeffizienten von Pearson an. Reflektieren Sie nochmals die Herleitung. Berechnen Sie die Korrelation aus folgenden Diät-Daten von Männern:

Gewicht erster Messzeitpunkt: 120, 95, 100, 110, 90  
Gewicht zweiter Messzeitpunkt: 110, 90, 110, 115, 100

## Aufgabe 11

> **Geben Sie die Formel des Korrelationskoeffizienten von Pearson an. Reflektieren Sie nochmals die Herleitung.**

#### Pearson's r

in kurz:
$$r = \frac { s_{x, y} }{ \sigma_{x} \cdot \sigma_{y} }$$

in lang:
$$ r = \frac 
        { \sum_{i=1}^n \frac { \left( y_{i} - \bar{y}\right) \left( x_{i} - \bar{x}\right) }{ n-1} }
        { \sum_{i=1}^n \sqrt{ \frac {\left( {x_i} - \bar{x} \right)^2}{n-1} } 
          \cdot 
          \sum_{i=1}^n \sqrt{ \frac {\left( {y_i} - \bar{y} \right)^2}{n-1} } }$$

## Aufgabe 11

> **Berechnen Sie die Korrelation aus folgenden Diät-Daten von Männern:**

```{r A11}
Diaet <- data.frame("Messung_1" = c(120, 95, 100, 110, 90),
                    "Messung_2" = c(110, 90, 110, 115, 100))

```

Zeitpunkt | Mittelwert | Standardabweichung
----------|------------|--------------------
Messung 1 | `r mean(Diaet$Messung_1)` | `r round(sd(Diaet$Messung_1), 0)`
Messung 2 | `r mean(Diaet$Messung_2)` | `r sd(Diaet$Messung_2)`

$$Cov_{x, y} = `r cov(Diaet$Messung_1, Diaet$Messung_2)`$$

- also ist **r** gleich:  
$$ \frac 
      {`r cov(Diaet$Messung_1, Diaet$Messung_2)`}
      {`r round(sd(Diaet$Messung_1), 0)` \cdot `r sd(Diaet$Messung_2)`}
  = `r cor(Diaet$Messung_1, Diaet$Messung_2)`$$


## Aufgabe 12 | Beurteilerübereinstimmung

27 Patienten sind von zwei Ärzten untersucht und im Hinblick auf ihren Gesundheitszustand in der folgenden Form als krank bzw. gesund eingestuft worden:

<img src='http://dump.jemu.name/zGrB9.png' width='90%'>

Es ist die Statistik „Kappa“ -ohne Software- zu ermitteln und anschließend zu interpretieren.

## Aufgabe 12 | Kappa

$$ Kappa = \frac{h_b - h_e}{1 - h_e} $$
$$ h_b = \frac{1}{n} \sum^m_{j = 1} f_{j,j} $$
$$ h_e = \frac{1}{n} \sum^m_{j = 1} f_{e_{j,j}} $$

## Aufgabe 12 | Berechnung Kappa

$$ n = 27 $$
$$ h_b = \frac{1}{27} \cdot (8 + 12) \approx 0,741 $$
$$ h_e = \frac{1}{27} \cdot (4,\bar{8} + 8,\bar{8}) \approx 0,51 $$
$$ Kappa = \frac{h_b - h_e}{1 - h_e} = \frac{0,741 - 0,51}{1 - 0,51} \approx 0,47 $$

## Aufgabe 13 | lineare Einfachregression

> Wie fällt die Kovariation in den Streudiagrammen 1 bis 3 tendenziell aus (im Vergleich zu dem Wert 0):

![](http://dump.jemu.name/Ar5MX.png)

## Aufgabe 14 | lineare Einfachregression

> Versuchen Sie das Prinzip der Kovariation grafisch in einem Streudiagramm zu veranschaulichen. Zeichnen Sie hierfür ein beliebiges Streudiagramm.

## Aufgabe 15 | lineare Mehrfachregressionen

> Erläutern Sie die Probleme, die im Rahmen einer multiplen Regression auftreten können. 

- Verwirrung
- Kopfschmerzen
- tiefer Hass auf die Welt und all ihre Bewohnenden
- Jucken im Schritt

![](http://i.giphy.com/705UedqNZtIDm.gif)

## Aufgabe 15

> Erläutern Sie die Probleme, die im Rahmen einer multiplen Regression auftreten können. 

- (Multi-)Kolinearität
- Partialkorrelationen


## Aufgabe 16 | lineare Mehrfachregressionen

> Was versteht man unter dem Begriff „Partialkorrelation“? Geben Sie ein Beispiel.

<div class="columns-2">

### Korrelationsmatrix

```{r a15_cor}
cor(ngo[c("deutsch", "mathe", "englisch")]) %>% kable
```

### Partialkorrelation

```{r a16_pcor}
ppcor::pcor(ngo[c("deutsch", "mathe", "englisch")])$estimate %>% kable
```

</div>

# Abschluss

### Noch Fragen?

#### stats.jemu.name/qm/QM1/Presentation.html

#### stats.jemu.name/qm/QM1/Presentation_web.html