---
title: "Korrelation"
author: "Übungsaufgabe zu Analyse und Dokumentation SoSe 2024"
bibliography: 2-Referenzen.bib
lang: de
format:
  pdf:
    include-in-header:
      text: |
       \usepackage[font=small,format=plain,labelfont=bf, labelsep=period,justification=justified,singlelinecheck=false]{caption}
---

Grundlage dieser Übung ist die Studie von @stiles1994. Ziel ist es, mithilfe
von Korrelationen zu quantifizieren, inwieweit die Variabilität der Stärke 
verbaler Psychotherapiekomponenten die Variabilität des Erfolges individueller
Psychotherapien bei Depression erklärt. Zum Zwecke dieser Übung fokussieren
wir dabei auf *General Advisements* seitens der Therapeut:innen und betrachten 
im Kontext der *Kognitiven Verhaltenstherapie* patientenspezifische 
*Beck Depression Inventory (BDI) Change Indices* als Ergebnismaß.

## Datensatz {-}

Der Datensatz `2-Korrelation.csv` enthält als Spalten simulierte *General 
Advisement* und *BDI Change Index* Werte von $n = 21$ Patient:innen als Zeilen. 
@tbl-vrm zeigt exemplarisch die Daten der ersten zehn Patient:innen.

```{r echo = F, eval = T}
#| label: Datensim
library(MASS)                                                                  # Multivariate Normalverteilung
set.seed(3)                                                                    # Seed setzen für Ergebnisreproduzierbarkeit
n           <- 21                                                              # Anzahl Patient:innen
mu          <- rep(c(5, -3))                                                   # Erwartungswertparameter \mu
Sigma       <- matrix(c(2, -.1, -.1, 2), nrow = 2)                             # Kovarianzmatrixparameter \Sigma
Y           <- mvrnorm(n, mu, Sigma)                                           # Realisierungen von GA, CD, BDIC
D           <- data.frame(GeneralAdvisement  = Y[,1],                          # General Advisement Scores
                         BDIChange          = Y[,2])                           # BDI Change Scores
fname       <- file.path("2-Korrelation.csv")                                  # Dateiname
write.csv(D, file = fname, row.names = FALSE)                                  # Speichern
```

```{r echo = F, warning = F}
#| label: tbl-vrm
#| tbl-cap : "Verbal Response Mode und BDI Change Index Werte"
library(knitr)                                                                 # knitr für Tabellen
fname       <- "2-Korrelation.csv"                                             # Dateiname
D           <- read.table(file.path(fname), sep = ",", header = TRUE)          # Laden des Datensatzes
kable(head(D, n = 10L), digits = 2, align = "c")                               # Markdowntabellenoutput für head(D)
```

\newpage
## Programmieraufgaben {-}
\noindent 1. Bestimmmen sie die Stichprobenkorrelation der *General Advisement* und 
*BDI Change Index* Werte. Bestimmen Sie mithilfe von Ausgleichsgeraden 
weiterhin die Explained Sum or Squares $\mbox{SQE}$, die Total Sum of Squares 
$\mbox{SQT}$ sowie das Bestimmheitsmaß $\mbox{R}^2$ beider Korrelationsanalysen.
Sie sollten folgende Ergebnisse erhalten:

\small
```{r echo = F}
#| label: Korrelation (Theorem)
# Datenanalyse
fname    <- "2-Korrelation.csv"                                                # Dateiname
D        <- read.table(file.path(fname), sep = ",", header = TRUE)             # Laden des Datensatzes
n        <- nrow(D)                                                            # Anzahl Patient:innen
r        <- cor(D[,1], D[,2])                                                  # Korrelation
x        <- D[,1]                                                              # Regressionsprädiktorwerte
X        <- matrix(c(rep(1,n),x), nrow = n)                                    # Designmatrix 
y        <- as.matrix(D[,2])                                                   # Datensatz
beta_hat <- solve(t(X) %*% X) %*% t(X) %*% y                                   # Ausgleichsgeradenparameter
y_bar    <- mean(y)                                                            # Stichprobenmittel
y_hat    <- X %*% beta_hat                                                     # erklärte Werte
SQT      <- t(y-y_bar) %*% (y - y_bar)                                         # Total Sum of Squares
SQE      <- t(y_hat - y_bar) %*% (y_hat - y_bar)                               # Explained Sum of Squares
Rsquare  <- SQE/SQT                                                            # Bestimmheitsmaß

# Ausgabe
cat("     Korrelation von General Advisement und BDI Change Index             : ",   round(r,        digits = 3),
    "\n     Quadrierte Korrelation von General Advisement und BDI Change Index  : ", round(r ** 2,   digits = 3),
    "\n     SQT bei General Advisement und BDI Change Index                     : ", round(SQT,      digits = 2),
    "\n     SQE bei General Advisement und BDI Change Index                     : ", round(SQE,      digits = 3),
    "\n     Bestimmheitsmaß bei General Advisement und BDI Change Index         : ", round(Rsquare,  digits = 3))
```


\noindent 2. Visualisieren Sie die Daten, die Ausgleichsgerade und die 
Korrelationsanalysergebnisse in einer Abbildung. Die Abbildung sollte in 
etwa aussehen wie @fig-abbildung.

```{r echo = F, eval = F}
#| label: Visualisierung (low-level)
# Datenanalysevisualisierung
pdf(
  file        = file.path("2-Korrelation-Abbildung.pdf"),
  width       = 4.5,
  height      = 4.5)
  library(latex2exp)
  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         = .7
)

# Datenwerte
plot(
  D[, 1], 
  D[, 2],
  pch     = 16,
  xlab    = "General Advisement",
  ylab    = "BDI Change",
  ylim    = c(-6,0),
  xlim    = c(2,8),
  cex     = 1.2,
  main    = TeX(sprintf("r = %.2f, SQE = %.2f, SQT = %.2f, $R^2=$ %.2f", r, SQE, SQT, Rsquare))
)

# Ausgleichsgerade
abline(
  coef    = c(beta_hat[1], beta_hat[2]),
  lty     = 1,
  col     = "gray"
)

# Legende
legend(
  "bottomleft",
  c("Messwerte", "Ausgleichsgerade"),
  lty = c(0,1),
  pch = c(16, NA),
  col = c("black", "gray"),
  bty = "n"
)

dev.off()
```

![Korrelation von General Advisement und BDI Change Index](2-Korrelation-Abbildung.pdf){#fig-abbildung fig-align="center" width=70%} 

\noindent 3. Zeigen Sie in einer R-Übung, wie Sie die Abbildung aus Aufgabe 2 mit dem **R** Paket `ggplot2` generieren können. Hierfür können sie Beispiel können Sie die Funktionen `ggplot2::geom_point()` und `ggplot2::geom_smooth()` verwenden. Konsultieren Sie dazu auch die Einführung zu Visualisierungen in \href{https://r4ds.hadley.nz/data-visualize}{R for Data Science}.

```{r echo = F, eval = F}
#| label: tidyverse style
library(tidyverse)                                                             # Für Pipe (%>%), mutate(), filter()
library(corrr)                                                                 # Für correlate()
library(ggplot2)                                                               # Für ggplot()
library(httpgd)                                                                # Für hgd() und hgd_browse()
library(latex2exp)                                                             # Für TeX

# Daten vorbereiten
fname    <- "6_Übungen/2_Korrelation/2-Korrelation.csv"                        # Dateiname
fname    <- "2-Korrelation.csv"                                                # Dateiname
D        <- read.table(fname, sep = ",", header = TRUE)                        # Laden des Datensatzes

# Korrelation evaluieren
gen_adv_cor <- D %>%
  select(GeneralAdvisement, BDIChange) %>%                                     # Spalten für Korrelation wählen (Bei 21 x 2 dataframe überflüssig)
  correlate()
gen_adv                                                                        # Korrelationsmatrix ausgeben
r <- round(gen_adv_cor$BDIChange[1], digits = 2)                               # Stichprobenkorrelation extrahieren
cat(                                                                           # Ausgabe
  "Korrelation von General Advisement und BDI Change Index: ",
  round(r,        digits = 3)
  )

# Visualisierung Ausgleichsgerade
# Quadratsummen und Bestimmtheitsmaß bestimmen
n        <- nrow(D)                                                            # Anzahl Patient:innen
x        <- D[, 1]                                                             # Regressionsprädiktorwerte
X        <- matrix(c(rep(1, n), x), nrow = n)                                  # Designmatrix 
y        <- as.matrix(D[, 2])                                                  # Datensatz
beta_hat <- solve(t(X) %*% X) %*% t(X) %*% y                                   # Ausgleichsgeradenparameter
y_bar    <- mean(y)                                                            # Stichprobenmittel
y_hat    <- X %*% beta_hat                                                     # erklärte Werte
SQT      <- t(y-y_bar) %*% (y - y_bar)                                         # Total Sum of Squares
SQE      <- t(y_hat - y_bar) %*% (y_hat - y_bar)                               # Explained Sum of Squares
Rsquare  <- SQE / SQT                                                          # Bestimmheitsmaß

# # Start plot viewer
# hgd()
# hgd_browse()
ggplot(
  data = D,                                                                    # Daten
  mapping = aes(x = GeneralAdvisement, y = BDIChange)) +                       # Daten-Axen-mapping
  coord_cartesian(xlim = c(2, 8), ylim = c(-6, 0)) +                           # Achsen-limits anpassen
  labs(x = "General Advisement", y = "BDI Change") +                           # Achsenlabel anpassen
  geom_point() +                                                               # Datenpunkte zeichnen
  geom_smooth(method = "lm", color = "gray", se = F) +                         # Ausgleichsgerade zeichnen
  ggtitle(
    TeX(
      sprintf(
        "r = %.2f, SQE = %.2f, SQT = %.2f, $R^2=$ %.2f", r, SQE, SQT, Rsquare  # Titel
      )
    )
  )

ggsave(                                                                        # Abbildung speichern
  filename = "2-Korrelation-ggplot.pdf",
  height = 5, width = 5
)
```


\newpage
## Dokumentation

Bitte beachten Sie bei der Erstellung Ihre Dokumentation folgende Vorgaben und 
orientieren Sie sich in der Darstellung Ihrer datenanalytischer Ergebnisse an
den Empfehlungen des [APA Publication Manuals 7th Edition](https://apastyle.apa.org/products/publication-manual-7th-edition), insbesondere Kapitel 6. 

### Einleitung {-}

Stellen Sie die Ausgangsfrage von  @stiles1994 dar und erläutern Sie die 
*Medikamentenmetapher (drug metaphor)*. Erläutern Sie weiterhin Sinn und Zweck 
des *Verbal Response Mode (VRM)* Kodiersystems und erläutern Sie die Begriffe der 
verbalen *Psychotherapiekomponenten* und des *General Advisements*. Konsultieren 
Sie dazu auch @stiles1986.

### Methoden {-}

Erläutern Sie kurz die Ideen der *Kognitiven Verhaltenstherapie*
und der *Psychodynamischen Therapie* bei Depression sowie die Bestimmung des 
Depressionszustandes mithilfe des *Beck Depression Inventory*; 
konsultieren Sie dazu auch @beck1961. Beschreiben Sie die Patient:innen- 
und Therapeut:innengruppen. Erläutern Sie Sinn und Zweck der Korrelationsanalyse.
Dokumentieren Sie Ihre Datenanalye in Form kommentierten **R** Codes zur Lösung
von Programmieraufgabe 1.

### Resultate {-}

Berichten Sie die nach Programmieraufgabe 1 zu bestimmenden Statistiken und skizzieren
sie jeweils kurz ihre jeweilige intuitive Bedeutung. Erläutern Sie die im Rahmen
von Programmieraufgabe 2 erstellte Abbildung. Ordnen Sie die erhaltene Korrelation
anhand ihrer Stärke ein.

### Schlußfolgerung {-}

Fassen Sie die von Ihnen erstellte Dokumentation in drei Sätzen zusammen und
erläutern Sie drei mögliche Gründe für den beobachteten schwachen Zusammenhang von
*General Advisement* und *BDI Change Index*.

## Referenzen
\footnotesize