198 lines
6.2 KiB
TeX
198 lines
6.2 KiB
TeX
\section{Oppgave 3: Terningdropp}
|
|
|
|
\subsection{Tema}
|
|
Her studerer vi sammenhengen mellom dropphøyde \(x\) og hvor langt terningen spretter
|
|
ut fra veggen \(y\). Vi bruker nøytrale priorhyperparametre og analyserer datasettet med
|
|
Bayesiansk lineær regresjon.
|
|
|
|
\subsection{Datagrunnlag}
|
|
Dataene er hentet fra alle CSV-filene i mappen \texttt{terningDroppFiler}. Siden filene
|
|
bruker litt ulike kolonnenavn, er de først normalisert i R-skriptet slik at vi får felles
|
|
variabler for dropphøyde \(x\), sprettlengde \(y\) og terningverdi \(z\).
|
|
|
|
Listing~\ref{lst:task3-import} viser delen av skriptet som leser inn filene og standardiserer
|
|
kolonnenavnene før analysen.
|
|
|
|
\begin{listing}[H]
|
|
\begin{minted}{r}
|
|
read_dice_file <- function(path) {
|
|
raw_df <- read.csv(path, check.names = FALSE, fileEncoding = "UTF-8-BOM")
|
|
raw_df <- raw_df[, colSums(!is.na(raw_df)) > 0, drop = FALSE]
|
|
|
|
original_names <- names(raw_df)
|
|
clean_names <- vapply(original_names, standardize_name, character(1))
|
|
|
|
rename_map <- c(
|
|
"k" = "k",
|
|
"dropp" = "x",
|
|
"dropphoyde" = "x",
|
|
"x" = "x",
|
|
"lengde" = "y",
|
|
"sprettlengde" = "y",
|
|
"y" = "y",
|
|
"verdi" = "z",
|
|
"terningverdi" = "z",
|
|
"z" = "z",
|
|
"tid" = "t",
|
|
"t" = "t"
|
|
)
|
|
|
|
mapped_names <- rename_map[clean_names]
|
|
names(raw_df) <- ifelse(is.na(mapped_names), clean_names, mapped_names)
|
|
|
|
keep <- intersect(c("k", "x", "y", "z", "t"), names(raw_df))
|
|
out <- raw_df[, keep, drop = FALSE]
|
|
out$source_file <- basename(path)
|
|
|
|
for (name in setdiff(names(out), "source_file")) {
|
|
out[[name]] <- suppressWarnings(as.numeric(out[[name]]))
|
|
}
|
|
|
|
out
|
|
}
|
|
|
|
read_all_dice_data <- function(folder) {
|
|
files <- list.files(folder, pattern = "\\.csv$", full.names = TRUE)
|
|
df_list <- lapply(files, read_dice_file)
|
|
combined <- do.call(rbind, df_list)
|
|
rownames(combined) <- NULL
|
|
combined
|
|
}
|
|
\end{minted}
|
|
\caption{R-kode for innlesing og standardisering av terningdropp-data}
|
|
\label{lst:task3-import}
|
|
\end{listing}
|
|
|
|
\subsection{a) Punktsky og regresjonslinje}
|
|
Først tegnes alle datapunktene i et spredningsdiagram, og den lineære regresjonslinjen
|
|
legges oppå.
|
|
|
|
\begin{figure}[H]
|
|
\centering
|
|
\includegraphics[width=0.8\textwidth]{images/task3_scatter_regression.png}
|
|
\caption{Punktsky for terningdropp med regresjonslinje.}
|
|
\end{figure}
|
|
|
|
\subsection{b) Posterior- og prediktive fordelinger}
|
|
Med nøytral prior setter vi
|
|
\[
|
|
\nu_0 = -2,
|
|
\qquad
|
|
SS_0 = 0.
|
|
\]
|
|
Da får vi posteriorfordelingene
|
|
\[
|
|
\tau \mid \text{data} \sim \Gamma\!\left(\frac{\nu_1}{2}, \frac{SS_1}{2}\right),
|
|
\]
|
|
\[
|
|
b \mid \text{data}
|
|
\sim
|
|
t\!\left(\beta,\; s_1 \sqrt{\frac{1}{SS_x}},\; \nu_1\right),
|
|
\]
|
|
\[
|
|
y(x)\mid \text{data}
|
|
\sim
|
|
t\!\left(\alpha_0 + \beta x,\;
|
|
s_1\sqrt{\frac{1}{n} + \frac{(x-\bar{x})^2}{SS_x}},\; \nu_1\right),
|
|
\]
|
|
og
|
|
\[
|
|
Y_+(x)\mid \text{data}
|
|
\sim
|
|
t\!\left(\alpha_0 + \beta x,\;
|
|
s_1\sqrt{1 + \frac{1}{n} + \frac{(x-\bar{x})^2}{SS_x}},\; \nu_1\right).
|
|
\]
|
|
Siden \(\sigma = 1/\sqrt{\tau}\), kan vi også utlede posterior usikkerhet for \(\sigma\).
|
|
|
|
\subsection{c) 80\% kredibilitetsintervall for stigningstallet \(b\)}
|
|
Intervallestimatet finnes fra posteriorfordelingen til \(b\):
|
|
\[
|
|
b \in
|
|
\left[
|
|
\beta - t_{\nu_1,0.1}\, s_1 \sqrt{\frac{1}{SS_x}},
|
|
\;
|
|
\beta + t_{\nu_1,0.1}\, s_1 \sqrt{\frac{1}{SS_x}}
|
|
\right].
|
|
\]
|
|
De numeriske verdiene leses ut fra R-skriptet.
|
|
|
|
\subsection{d) 80\% kredibilitetsintervall for standardavviket \(\sigma\)}
|
|
Her bruker vi sammenhengen mellom \(\sigma^2\) og \(\chi^2\)-fordelingen. Intervallet
|
|
kan beregnes direkte i R ut fra \(SS_1\) og \(\nu_1\).
|
|
|
|
\subsection{e) 80\% kredibilitetsintervall for \(y(x)\)}
|
|
For hver verdi av \(x\) får vi
|
|
\[
|
|
I_{0.20}(x)
|
|
=
|
|
\alpha_0 + \beta x
|
|
\pm
|
|
t_{\nu_1,0.1}\,
|
|
s_1\sqrt{\frac{1}{n} + \frac{(x-\bar{x})^2}{SS_x}}.
|
|
\]
|
|
|
|
\subsection{f) Kurver over og under regresjonslinjen}
|
|
Intervallet i punkt e) gir to kurver: en øvre og en nedre. Disse plottes sammen med
|
|
regresjonslinjen.
|
|
|
|
\begin{figure}[H]
|
|
\centering
|
|
\includegraphics[width=0.8\textwidth]{images/task3_credible_band.png}
|
|
\caption{80\% kredibilitetsbånd for \(y(x)\).}
|
|
\end{figure}
|
|
|
|
\subsection{g) Forklaringsgrad \(R^2\)}
|
|
Forklaringsgraden
|
|
\[
|
|
R^2 = 1 - \frac{SSe}{SS_y}
|
|
\]
|
|
forteller hvor stor del av variasjonen i \(y\) som forklares av regresjonslinjen. Denne
|
|
kan enten beregnes direkte fra sums of squares eller hentes fra \texttt{lm()} i R.
|
|
|
|
\subsection{h) Regresjon mellom \(z\) og \(x\), og mellom \(t\) og \(x\)}
|
|
Oppgaven ber om en sammenligning av \(R^2\) for
|
|
\[
|
|
z \text{ mot } x
|
|
\qquad \text{og} \qquad
|
|
t \text{ mot } x.
|
|
\]
|
|
I de tilgjengelige CSV-filene finnes det tydelige kolonner for \(x\), \(y\) og \(z\), men
|
|
ingen entydig kolonne for \(t\). Derfor kan analysen for \(z\) gjennomføres direkte, mens
|
|
delen om \(t\) må enten utelates eller suppleres dersom tidsmålingene finnes i en annen fil.
|
|
|
|
\subsection{R-kode}
|
|
Listing~\ref{lst:task3-r} viser delen av skriptet som utfører regresjonen, skriver ut
|
|
intervallene og lager figurene til oppgave 3.
|
|
|
|
\begin{listing}[H]
|
|
\begin{minted}{r}
|
|
dice_df <- read_all_dice_data(file.path(script_dir, "terningDroppFiler"))
|
|
dice_df <- dice_df[complete.cases(dice_df[, intersect(c("x", "y", "z"), names(dice_df)), drop = FALSE]), ]
|
|
|
|
dice_fit <- fit_simple_regression(dice_df$x, dice_df$y, nu0 = -2, SS0 = 0)
|
|
x_grid <- seq(min(dice_df$x), max(dice_df$x), length.out = 300)
|
|
cred_band_80 <- credible_band(dice_fit, x_grid, level = 0.80)
|
|
pred_band_80 <- predictive_band(dice_fit, x_grid, level = 0.80)
|
|
|
|
cat("\nTask 3: Dice drop data\n")
|
|
cat("----------------------\n")
|
|
cat("Number of observations =", nrow(dice_df), "\n")
|
|
cat("Regression line: y =", round(dice_fit$alpha0, 4), "+", round(dice_fit$beta, 4), "* x\n")
|
|
cat("80% interval for b:", paste(round(b_interval(dice_fit, 0.80), 4), collapse = " to "), "\n")
|
|
cat("80% interval for sigma:", paste(round(sigma_interval(dice_fit, 0.80), 4), collapse = " to "), "\n")
|
|
cat("R^2 for y on x =", round(r_squared(dice_df$x, dice_df$y), 4), "\n")
|
|
cat("R^2 for z on x =", round(r_squared(dice_df$x, dice_df$z), 4), "\n")
|
|
|
|
plot_regression_with_band(
|
|
df = dice_df,
|
|
fit = dice_fit,
|
|
band_df = cred_band_80,
|
|
file_name = "task3_credible_band.png",
|
|
ylab = "Sprettlengde",
|
|
band_label = "Dice drop data with 80% credible band"
|
|
)
|
|
\end{minted}
|
|
\caption{R-kode for analyse og figurer i terningdropp-oppgaven}
|
|
\label{lst:task3-r}
|
|
\end{listing}
|