---
fontsize: 8pt
format:
    beamer:
        include-in-header: "Header.tex"
bibliography: Referenzen.bib
---

```{r, include = F}
source("R_common.R")
fdir  = file.path(getwd(), "Abbildungen")                                
```

#  {.plain}
\center
```{r, echo = FALSE, out.width = "20%"}
knitr::include_graphics("Abbildungen/reg_otto.png")
```

\vspace{2mm}

\huge
Allgemeines Lineares Modell
\vspace{6mm}

\large
BSc Psychologie SoSe 2023

\vspace{6mm}
\normalsize
Prof. Dr. Dirk Ostwald


#  {.plain}
\center
\huge
\vfill
\noindent (1) Regression
\vfill

#
\setstretch{3}
\vfill
\large

Methode der kleinsten Quadrate

Literaturhinweise

Referenzen

\vfill


#
\setstretch{3}
\vfill
\large

**Methode der kleinsten Quadrate**

Einfache lineare Regression

Selbstkontrollfragen

\vfill

# Methode der kleinsten Quadrate
\large
Anwendungsszenario
\vspace{2mm}

```{r, echo = FALSE, out.width = "80%"}
knitr::include_graphics("Abbildungen/reg_beispielszenario.pdf")
```

# Methode der kleinsten Quadrate
Beispieldatensatz

\center
\footnotesize
$i = 1,...,20$ Patient:innen, $y_i$ Symptomreduktion bei Patient:in $i$,  $x_i$ Anzahl Therapiestunden  von Patient:in $i$

\setstretch{1}
```{r, echo = F}
library(MASS)                                         # Normalverteilungen
set.seed(0)                                           # Ergebnisreproduzierbarkeit
n           = 20                                      # Anzahl Datenpunkte
p           = 3                                       # Anzahl Regressionskoeffizienten
x           = seq(1,n,len = n)                        # Kontrollvariable
X           = matrix(c(rep(1,n), x, x^2), ncol = 3)   # Designmatrix
beta        = matrix(c(.5,.2,.06), ncol = 1)          # Wahre, unbekannte, Regressionskoeffizientenwerte
mu          = X %*% beta                              # Erwartungswertparameter
sigsqr      = 10                                      # Varianzparameter
Sigma       = sigsqr*diag(n)                          # Kovarianzmatrixparameter
y           = as.matrix(mvrnorm(1,mu,Sigma))          # Datengeneration
D           = data.frame(y_i = y, x_i = x)            # Dataframe

# Datensicherung
fname       = file.path("./Daten/Regression.csv")
write.csv(D, file = fname, row.names = FALSE)

# Tabelle
knitr::kable(D, "pipe")
```

# Methode der kleinsten Quadrate
Beispieldatensatz

```{r, echo = F, eval = F}
graphics.off()
dev.new()
par(
family      = "sans",
mfcol       = c(1,1),
pty         = "s",
bty         = "l",
lwd         = 1,
las         = 1,
mgp         = c(2,1,0),
xaxs        = "i",
yaxs        = "i",
font.main   = 1,
cex         = 1,
cex.main    = 1)
plot(
x,
y,
pch        = 16,
xlab       = "Anzahl Therapiestunden (x)",
ylab       = "Symptomreduktion (y)",
xlim       = c(0,21),
ylim       = c(-10, 40))

legend(
"topleft",
TeX("$(x_i,y_i)$"),
lty         = 0,
pch         = 16,
col         = "black",
bty         = "n",
cex         = 1,
x.intersp   = 1)

dev.copy2pdf(
file        = file.path(fdir, "reg_beispieldatensatz.pdf"),
width       = 4,
height      = 4)
```

```{r, echo = FALSE, out.width = "55%"}
knitr::include_graphics("Abbildungen/reg_beispieldatensatz.pdf")
```

\center
\textcolor{darkblue}{Welcher funktionale Zusammenhang zwischen $x$ und $y$ liegt den Daten zugrunde?}

# Methode der kleinsten Quadrate
\footnotesize
\begin{definition}[Ausgleichsgerade]
\justifying
Für $\beta := (\beta_0,\beta_1)^T \in \mathbb{R}^2$ heißt die linear-affine Funktion
\begin{equation}
f_\beta : \mathbb{R} \to \mathbb{R}, x \mapsto f_\beta(x) := \beta_0 + \beta_1 x,
\end{equation}
für die für einen Datensatz  $\{(x_1,y_1),...,(x_n,y_n)\} \subset \mathbb{R}^2$ die Funktion
\begin{equation}
q : \mathbb{R}^2 \to \mathbb{R}_{\ge 0}, \beta \mapsto q(\beta)
:= \sum_{i=1}^n (y_i-f_\beta(x_i))^2
 = \sum_{i=1}^n (y_i- (\beta_0 + \beta_1x_i))^2
\end{equation}
der quadrierten vertikalen Abweichungen der $y_i$ von den Funktionswerten $f_{\beta}(x_i)$
ihr Minimum annimt, die \textit{Ausgleichsgerade für den Datensatz $\{(x_1,y_1),...,(x_n,y_n)\}$}.
\end{definition}

Bemerkungen

* Wir nehmen hier ohne Beweis an, dass das Minimum von $q$ eindeutig ist.

# Methode der kleinsten Quadrate

Linear-affine Funktionen $f_\beta(x) := \beta_0 + \beta_1 x$

\small
* $\beta_0$: Schnittpunkt von Gerade und $y$-Achse ("Offset Parameter")
* $\beta_1$: $y$-Differenz pro $x$-Einheitsdifferenz ("Steigungsparameter")

\vspace{1cm}

```{r, echo = F, eval = F}
# Ausgleichs- und weitere Geraden
X           = matrix(c(rep(1,n), x), ncol = 2)              # Designmatrix
beta_hat    = solve(t(X) %*% X) %*% t(X) %*% y                # OLS Schätzer
beta_set    = matrix(c(5,.5, -20,3,beta_hat), nrow = 2)     # Weitere Geraden


# Visualisierung
lab         = c(TeX("$\\beta_0 =   5.0, \\beta_1 = 0.5$"),  # Labels
                TeX("$\\beta_0 = -20.0, \\beta_1 = 3.0$"),
                TeX("$\\beta_0 =  -6.2, \\beta_1 = 1.7$"))
graphics.off()
dev.new()
par(
family      = "sans",
mfcol       = c(1,3),
pty         = "s",
bty         = "l",
lwd         = 1,
las         = 1,
mgp         = c(2,1,0),
xaxs        = "i",
yaxs        = "i",
font.main   = 1,
cex         = 1,
cex.main    = 1.2)
for(i in 1:3){
  plot(
  x,
  y,
  pch         = 16,
  xlab        = "Anzahl Therapiestunden (x)",
  ylab        = "Symptomreduktion (y)",
  xlim        = c(0,21),
  ylim        = c(-10, 40),
  main        = lab[i])
  abline(coef = beta_set[,i], lty = 1, col = "black")
}
dev.copy2pdf(
file        = file.path(fdir, "reg_ausgleichsgerade_1.pdf"),
width       = 12,
height      = 4)
```

```{r, echo = FALSE, out.width = "100%"}
knitr::include_graphics("Abbildungen/reg_ausgleichsgerade_1.pdf")
```

# Methode der kleinsten Quadrate
\small
Funktion der quadrierten vertikalen Abweichungen
\begin{equation}
q(\beta) := \sum_{i=1}^n (y_i - (\beta_0 + \beta_1x_i))^2
\end{equation}

```{r, echo = F, eval = F}
# q Funktionswerte
q1          = t(y - X %*% beta_set[,1]) %*% (y - X %*% beta_set[,1])
q2          = t(y - X %*% beta_set[,2]) %*% (y - X %*% beta_set[,2])
q3          = t(y - X %*% beta_set[,3]) %*% (y - X %*% beta_set[,3])

# Visualisierung
graphics.off()
dev.new()
par(
family      = "sans",
mfcol       = c(1,3),
pty         = "s",
bty         = "l",
lwd         = 1,
las         = 1,
mgp         = c(2,1,0),
xaxs        = "i",
yaxs        = "i",
font.main   = 1,
cex         = 1,
cex.main    = 1.2)
lab         = c(TeX("$q(\\beta) = 1159$"),
                TeX("$q(\\beta) = 1451$"),
                TeX("$q(\\beta) = 250$"))

for(i in 1:3){
  plot(
  x,
  y,
  pch         = 16,
  xlab        = "Anzahl Therapiestunden (x)",
  ylab        = "Symptomreduktion (y)",
  xlim        = c(0,21),
  ylim        = c(-10, 40),
  main        = lab[i])
  abline(coef = beta_set[,i], lty = 1, col = "black")
  arrows(
  x0        = x,
  y0        = y,
  x1        = x,
  y1        = X %*% beta_set[,i],
  length    = 0,
  col       = "orange")
}
dev.copy2pdf(
file        = file.path(fdir, "reg_ausgleichsgerade_2.pdf"),
width       = 12,
height      = 4)
```

```{r, echo = FALSE, out.width = "100%"}
knitr::include_graphics("Abbildungen/reg_ausgleichsgerade_2.pdf")
```
\center
\textcolor{orange}{\textbf{------}} $y_i - (\beta_0 + \beta_1x_i)$ für $i = 1,...,n$

# Methode der kleinsten Quadrate
\footnotesize
\begin{theorem}[Ausgleichsgerade]
\justifying
\normalfont
Für einen Datensatz $\{(x_1,y_1),...,(x_n,y_n)\}\subset\mathbb{R}^2$ hat die Ausgleichsgerade die Form
\begin{equation}
f_\beta : \mathbb{R} \to \mathbb{R}, x \mapsto f_\beta(x) := \hat{\beta}_0 + \hat{\beta}_1 x,
\end{equation}
wobei mit der Stichprobenkovarianz $c_{xy}$ der $(x_i,y_i)$-Werte, der
Stichprobenvarianz $s_x^2$ der $x_i$-Werte und den Stichprobenmitteln $\bar{x}$
und $\bar{y}$ der $x_i$- und $y_i$-Werte, respektive, gilt, dass
\begin{equation}
\hat{\beta}_1 = \frac{c_{xy}}{s_x^2} \mbox{ und } \hat{\beta}_0 = \bar{y} - \hat{\beta}_1\bar{x}
\end{equation}
\end{theorem}
Bemerkungen

* \justifying Mit den Definitionen von $c_{xy}$ und $s_x^2$ gilt also
\begin{equation}
\hat{\beta}_1 = \frac{\sum_{i=1}^n (x_i - \bar{x})(y_i - \bar{y})}{\sum_{i=1}^n (x_i - \bar{x})^2}
\end{equation}
* Man spricht hier von der Stichprobenkovarianz $c_{xy}$, auch wenn die Werte 
$x_1,...,x_n$ oft nicht als Realisierungen einer Stichprobe $\xi_1,...,\xi_n$ 
verstanden werden, sondern als gegebene Zahlen.


# Methode der kleinsten Quadrate
Beispieldatensatz Analyse
\vspace{2mm}
\setstretch{1.2}
\footnotesize
```{r, echo = T}
# Einlesen des Beispieldatensatzes
fname       = file.path("./Daten/Regression.csv")
D           = read.table(fname, sep = ",", header = TRUE)

# Stichprobenstatistiken
x_bar       = mean(D$x_i)               # Stichprobenmittel der x_i-Werte
y_bar       = mean(D$y_i)               # Stichprobenmittel der y_i-Werte
s2x         = var(D$x_i)                # Stichprobenvarianz der  x_i-Werte
cxy         = cov(D$x_i, D$y_i)         # Stichprobenkovarianz der (x_i,y_i)-Werte

# Ausgleichsgeradenparameter
beta_1_hat  = cxy/s2x                   # \hat{\beta}_1, Steigungsparameter
beta_0_hat  = y_bar - beta_1_hat*x_bar  # \hat{\beta}_0, Offset Parameter

# Ausgabe
cat("beta_0_hat:", beta_0_hat,
    "\nbeta_1_hat:", beta_1_hat)
```


# Methode der kleinsten Quadrate
Beispieldatensatz Visualisierung
\vspace{1mm}
\setstretch{1.2}

```{r, echo = F, eval = F}
graphics.off()
dev.new()
par(
family      = "sans",
mfcol       = c(1,1),
pty         = "s",
bty         = "l",
lwd         = 1,
las         = 1,
mgp         = c(2,1,0),
xaxs        = "i",
yaxs        = "i",
font.main   = 1,
cex         = 1,
cex.main    = 1.2)

# Datenwerte
plot(
D$x_i,
D$y_i,
pch         = 16,
xlab        = "Anzahl Therapiestunden (x)",
ylab        = "Symptomreduktion (y)",
xlim        = c(0,21),
ylim        = c(-10, 40),
main        = TeX("$\\hat{\\beta}_0 =  -6.19, \\hat{\\beta}_1 = 1.66$"))

# Ausgleichsgerade
abline(
coef        = c(beta_0_hat, beta_1_hat),
lty         = 1,
col         = "black")

# Legende
legend(
"topleft",
c(TeX("$(x_i,y_i)$"), TeX("$f(x) = \\hat{\\beta}_0 + \\hat{\\beta}_1x$")),
lty = c(0,1),
pch = c(16, NA),
bty = "n")

# Speichern
dev.copy2pdf(
file        = file.path(fdir, "reg_ausgleichsgerade_3.pdf"),
width       = 4,
height      = 4)
```

\tiny
```{r, eval = F}
# Datenwerte
plot(
D$x_i,
D$y_i,
pch         = 16,
xlab        = "Anzahl Therapiestunden (x)",
ylab        = "Symptomreduktion (y)",
xlim        = c(0,21),
ylim        = c(-10, 40),
main        = TeX("$\\hat{\\beta}_0 =  -6.19, \\hat{\\beta}_1 = 1.66$"))

# Ausgleichsgerade
abline(
coef        = c(beta_0_hat, beta_1_hat),
lty         = 1,
col         = "black")

# Legende
legend(
"topleft",
c(TeX("$(x_i,y_i)$"), TeX("$f(x) = \\hat{\\beta}_0 + \\hat{\\beta}_1x$")),
lty        = c(0,1),
pch        = c(16, NA),
bty        = "n")
```

```{r, echo = FALSE, out.width = "55%"}
knitr::include_graphics("Abbildungen/reg_ausgleichsgerade_3.pdf")
```

# Literaturhinweise

Die Idee der Minimierung einer Summe von quadrierten Abweichungen bei der Anpassung
einer Polynomfunktion an beobachtete Werte geht auf die Arbeiten von @legendre1805 
und @gauss1809 im Kontext der Bestimmung von Planetenbahnen zurück. Eine historische
Einordnung dazu gibt @stigler1981. Der Begriff der Regression geht zurück 
auf @galton1886. @stigler1986 gibt dazu einen ausführlichen historischen Überblick.  

# Referenzen
\setstretch{2}
\footnotesize