pushing final oblig
This commit is contained in:
Chris Sanden
197
Oblig/3c/latex/sections/task3_terningdropp.tex
Normal file
197
Oblig/3c/latex/sections/task3_terningdropp.tex
Normal file
@@ -0,0 +1,197 @@
|
||||
\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}
|
||||
Reference in New Issue
Block a user