Chris/MA-223
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

pushing final oblig

Browse Source
This commit is contained in:
Chris Sanden
2026-04-28 15:30:52 +02:00
parent a4403bb53f
commit 321df5a296
43 changed files with 1540 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
Oblig/3c/latex/main.tex Normal file
View File

@@ -0,0 +1,36 @@
\documentclass[11pt,a4paper]{article}
\usepackage[norsk]{babel}
\usepackage[T1]{fontenc}
\usepackage[utf8]{inputenc}
\usepackage{amsmath, amssymb}
\usepackage{graphicx}
\usepackage{booktabs}
\usepackage{geometry}
\usepackage{float}
\usepackage{hyperref}
\usepackage[newfloat]{minted}
\geometry{margin=2.5cm}
\setminted{
fontsize=\small,
linenos,
breaklines,
frame=lines
}
\title{Oblig 3c\\Lineær regresjon med usikkerhet}
\author{Navn: \underline{\hspace{6cm}}}
\date{\today}
\begin{document}
\maketitle
\tableofcontents
\newpage
\input{sections/task1_kap17_1c}
\input{sections/task2_kap17_1d}
\input{sections/task3_terningdropp}
\input{sections/task4_utvalgsforsok}
\end{document}

18
Oblig/3c/latex/sections/innledning.tex Normal file
View File

@@ -0,0 +1,18 @@
\section{Innledning}
I denne rapporten ser vi på lineær regresjon med usikkerhet i en Bayesiansk ramme.
Målet er å bruke teorien fra kapittel 17 til å beskrive både selve regresjonslinjen og
usikkerheten rundt den. Det innebærer at vi ikke bare finner ett enkelt uttrykk for en
linje, men også undersøker hvordan usikkerheten i dataene påvirker stigningstall,
standardavvik, posteriorfordelinger og intervallestimater.
Rapporten er delt i to hoveddeler. Først løses to bokoppgaver fra kapittel 17, der vi
bruker de generelle formlene for posterior- og prediktive fordelinger i lineær regresjon.
Deretter brukes de samme ideene på terningdropp-dataene fra oppgavesettet, hvor vi
analyserer sammenhengen mellom dropphøyde og sprettlengde. Til slutt undersøker vi
hvordan regresjonslinjer og intervallestimater varierer når vi bare bruker tilfeldige
delutvalg av observasjonene.
I arbeidet brukes R til å beregne regresjonslinjer, posteriorfordelinger, kredibilitetsintervall
og figurer. Figurene brukes videre for å synliggjøre både mønsteret i dataene og hvordan
usikkerheten endrer seg når datagrunnlaget blir større eller mindre.

103
Oblig/3c/latex/sections/task1_kap17_1c.tex Normal file
View File

@@ -0,0 +1,103 @@
\section{Oppgave 1: Kapittel 17, oppgave 1c}
I denne oppgaven bruker vi observasjonene
\[
\{(2,10), (3,8), (4,8), (6,7)\},
\]
og vi er gitt \(\sigma_0 = 0.5\) og \(n_0 = 4\).
\subsection{Tema}
Temaet er Bayesiansk lineær regresjon med informativ prior for usikkerheten. Vi skal
finne posteriorfordelingen til \(\tau\), posteriorfordelingen til \(y(x)\),
prediktiv fordeling for \(Y_+(x)\), samt tilhørende intervallestimater.
\subsection{Prior og hyperparametre}
Siden \(\sigma_0 = 0.5\) og \(n_0 = 4\), får vi
\[
\nu_0 = n_0 - 2 = 2,
\qquad
SS_0 = \sigma_0^2 \nu_0 = 0.5^2 \cdot 2 = 0.5.
\]
Dette brukes videre sammen med regresjonsstatistikkene fra datasettet.
\subsection{Posterior for \(\tau\)}
Når regresjonslinjen er estimert, får vi posteriorfordelingen
\[
\tau \mid \text{data} \sim \Gamma\!\left(\frac{\nu_1}{2}, \frac{SS_1}{2}\right).
\]
Her settes de konkrete tallene inn fra R-skriptet.
\subsection{Posterior for \(y(x)\)}
For en vilkårlig verdi \(x\) får vi
\[
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).
\]
De konkrete parameterverdiene kan hentes fra skriptet og settes inn her.
\subsection{Prediktiv fordeling for \(Y_+(x)\)}
Den prediktive fordelingen for en ny observasjon er
\[
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).
\]
\subsection{Intervallestimater}
Et \(95\%\)-kredibilitetsintervall for regresjonslinjen er
\[
I_{0.05}(x)
=
\alpha_0 + \beta x
\pm
t_{\nu_1,0.025}\,
s_1\sqrt{\frac{1}{n} + \frac{(x-\bar{x})^2}{SS_x}}.
\]
Et \(95\%\)-prediktivt intervall fås tilsvarende ved å legge til \(1\) inne i roten.
\subsection{Kommentar}
Denne oppgaven er en direkte anvendelse av formlene i kapittel 17. Hovedpoenget er
at vi kombinerer observasjonene med en svak informativ prior for usikkerheten, og
deretter leser av posterior- og prediktive fordelinger fra de oppdaterte hyperparametrene.
\subsection{R-kode}
Listing~\ref{lst:task12-r} viser delen av R-skriptet som løser bokoppgavene 1c og 1d.
\begin{listing}[H]
\begin{minted}{r}
task_1c <- data.frame(
x = c(2, 3, 4, 6),
y = c(10, 8, 8, 7)
)
fit_1c <- fit_simple_regression(task_1c$x, task_1c$y, nu0 = 4 - 2, SS0 = 0.5^2 * (4 - 2))
print_regression_summary(
label = "Task 1: Chapter 17, problem 1c",
fit = fit_1c,
x_eval = mean(task_1c$x),
level_y = 0.95,
level_pred = 0.95
)
task_1d <- data.frame(
x = c(0, 1, 2, 3),
y = c(0, 2, 7, 5)
)
fit_1d <- fit_simple_regression(task_1d$x, task_1d$y, nu0 = -2, SS0 = 0)
print_regression_summary(
label = "Task 2: Chapter 17, problem 1d",
fit = fit_1d,
x_eval = mean(task_1d$x),
level_y = 0.90,
level_pred = 0.95
)
\end{minted}
\caption{R-kode for bokoppgavene 17.1c og 17.1d}
\label{lst:task12-r}
\end{listing}

72
Oblig/3c/latex/sections/task2_kap17_1d.tex Normal file
View File

@@ -0,0 +1,72 @@
\section{Oppgave 2: Kapittel 17, oppgave 1d}
I denne oppgaven bruker vi observasjonene
\[
\{(0,0), (1,2), (2,7), (3,5)\},
\]
og vi antar nøytral prior for usikkerheten.
\subsection{Tema}
Temaet er Bayesiansk lineær regresjon når \(\sigma\) er ukjent. Da bruker vi de nøytrale
hyperparametrene fra boka.
\subsection{Prior og hyperparametre}
Ved nøytral prior setter vi
\[
\nu_0 = -2,
\qquad
SS_0 = 0.
\]
Dermed er det dataene alene som bestemmer posterioren.
\subsection{Posterior for \(\tau\)}
Posteriorfordelingen blir igjen
\[
\tau \mid \text{data} \sim \Gamma\!\left(\frac{\nu_1}{2}, \frac{SS_1}{2}\right),
\]
der \(\nu_1 = \nu_0 + n\) og \(SS_1 = SS_0 + SSe\).
\subsection{Posterior for \(y(x)\)}
For regresjonslinjen får vi
\[
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).
\]
\subsection{Prediktiv fordeling for \(Y_+(x)\)}
For en ny observasjon får vi
\[
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).
\]
\subsection{Intervallestimater}
Oppgaven ber om \(90\%\)-kredibilitetsintervall og \(95\%\)-prediktivt intervall. Disse blir
\[
I_{0.10}(x)
=
\alpha_0 + \beta x
\pm
t_{\nu_1,0.05}\,
s_1\sqrt{\frac{1}{n} + \frac{(x-\bar{x})^2}{SS_x}},
\]
og
\[
I^+_{0.05}(x)
=
\alpha_0 + \beta x
\pm
t_{\nu_1,0.025}\,
s_1\sqrt{1 + \frac{1}{n} + \frac{(x-\bar{x})^2}{SS_x}}.
\]
\subsection{Kommentar}
Forskjellen fra oppgave 1c er at vi nå ikke legger inn noen forhåndsinformasjon om
usikkerheten. Det gir en mer datadrevet analyse, og intervallene blir derfor bestemt av
spredningen i observasjonene alene.

197
Oblig/3c/latex/sections/task3_terningdropp.tex Normal file
View 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}

131
Oblig/3c/latex/sections/task4_utvalgsforsok.tex Normal file
View File

@@ -0,0 +1,131 @@
\section{Oppgave 4: Utvalgsforsøk}
\subsection{Tema}
I denne delen undersøker vi hvordan regresjonslinjen og intervallestimatene endrer seg
når vi bare bruker tilfeldige delutvalg av observasjonene.
\subsection{a) 50 runder med \(N = 5\)}
Vi trekker 50 tilfeldige utvalg med \(N = 5\), finner regresjonslinjen for hvert utvalg,
og tegner alle linjene i samme figur.
\begin{figure}[H]
\centering
\includegraphics[width=0.8\textwidth]{images/task4a_lines_N5.png}
\caption{50 regresjonslinjer basert på utvalg med \(N=5\).}
\end{figure}
Det vi forventer å se, er stor variasjon fra linje til linje fordi utvalgene er små.
\subsection{b) 50 runder med \(N = 15, 50, 200\)}
Vi gjentar samme prosedyre for større utvalg. Når \(N\) øker, bør linjene samle seg mer
rundt regresjonslinjen for hele datasettet.
\begin{figure}[H]
\centering
\includegraphics[width=0.8\textwidth]{images/task4b_lines_N15.png}
\caption{Regresjonslinjer for \(N=15\).}
\end{figure}
\begin{figure}[H]
\centering
\includegraphics[width=0.8\textwidth]{images/task4b_lines_N50.png}
\caption{Regresjonslinjer for \(N=50\).}
\end{figure}
\begin{figure}[H]
\centering
\includegraphics[width=0.8\textwidth]{images/task4b_lines_N200.png}
\caption{Regresjonslinjer for \(N=200\).}
\end{figure}
\subsection{c) Oppgave 3c gjentatt 50 ganger med \(N = 5\)}
Her beregner vi 80\%-intervallestimatet for stigningstallet \(b\) i 50 runder med
\(N=5\), og tegner intervallene samlet i én figur.
\begin{figure}[H]
\centering
\includegraphics[width=0.8\textwidth]{images/task4c_b_intervals_N5.png}
\caption{50 intervallestimater for \(b\) når \(N=5\).}
\end{figure}
Små utvalg vil typisk gi brede intervaller og stor variasjon mellom rundene.
\subsection{d) Samme analyse for \(N = 15, 50, 200\)}
Når vi øker \(N\), blir intervallene vanligvis smalere, og estimatene for \(b\) blir mer
stabile.
\begin{figure}[H]
\centering
\includegraphics[width=0.8\textwidth]{images/task4d_b_intervals_N15.png}
\caption{Intervallestimater for \(b\) når \(N=15\).}
\end{figure}
\begin{figure}[H]
\centering
\includegraphics[width=0.8\textwidth]{images/task4d_b_intervals_N50.png}
\caption{Intervallestimater for \(b\) når \(N=50\).}
\end{figure}
\begin{figure}[H]
\centering
\includegraphics[width=0.8\textwidth]{images/task4d_b_intervals_N200.png}
\caption{Intervallestimater for \(b\) når \(N=200\).}
\end{figure}
\subsection{e) Illustrasjoner som i oppgave 3f}
Til slutt lager vi figurer med regresjonslinje og tilhørende 80\%-kredibilitetsbånd for
utvalg med \(N = 5, 15, 50\) og \(200\).
\begin{figure}[H]
\centering
\includegraphics[width=0.8\textwidth]{images/task4e_bands_N5.png}
\caption{Kredibilitetsbånd for \(N=5\).}
\end{figure}
\begin{figure}[H]
\centering
\includegraphics[width=0.8\textwidth]{images/task4e_bands_N15.png}
\caption{Kredibilitetsbånd for \(N=15\).}
\end{figure}
\begin{figure}[H]
\centering
\includegraphics[width=0.8\textwidth]{images/task4e_bands_N50.png}
\caption{Kredibilitetsbånd for \(N=50\).}
\end{figure}
\begin{figure}[H]
\centering
\includegraphics[width=0.8\textwidth]{images/task4e_bands_N200.png}
\caption{Kredibilitetsbånd for \(N=200\).}
\end{figure}
\subsection{Kommentar}
Hovedpoenget i denne oppgaven er å se hvordan usikkerheten minker når utvalgsstørrelsen
øker. Små utvalg gir mer ustabile linjer og bredere intervaller, mens store utvalg gir mer
presise estimater og tydeligere mønstre.
\subsection{R-kode}
Listing~\ref{lst:task4-r} viser delen av skriptet som trekker delutvalg og lager figurene
for oppgave 4.
\begin{listing}[H]
\begin{minted}{r}
plot_many_sample_lines(dice_df, sample_size = 5, rounds = 50, file_name = "task4a_lines_N5.png")
plot_many_sample_lines(dice_df, sample_size = 15, rounds = 50, file_name = "task4b_lines_N15.png")
plot_many_sample_lines(dice_df, sample_size = 50, rounds = 50, file_name = "task4b_lines_N50.png")
plot_many_sample_lines(dice_df, sample_size = 200, rounds = 50, file_name = "task4b_lines_N200.png")
plot_many_b_intervals(dice_df, sample_size = 5, rounds = 50, level = 0.80, file_name = "task4c_b_intervals_N5.png")
plot_many_b_intervals(dice_df, sample_size = 15, rounds = 50, level = 0.80, file_name = "task4d_b_intervals_N15.png")
plot_many_b_intervals(dice_df, sample_size = 50, rounds = 50, level = 0.80, file_name = "task4d_b_intervals_N50.png")
plot_many_b_intervals(dice_df, sample_size = 200, rounds = 50, level = 0.80, file_name = "task4d_b_intervals_N200.png")
plot_many_credible_bands(dice_df, sample_size = 5, rounds = 50, level = 0.80, file_name = "task4e_bands_N5.png")
plot_many_credible_bands(dice_df, sample_size = 15, rounds = 50, level = 0.80, file_name = "task4e_bands_N15.png")
plot_many_credible_bands(dice_df, sample_size = 50, rounds = 50, level = 0.80, file_name = "task4e_bands_N50.png")
plot_many_credible_bands(dice_df, sample_size = 200, rounds = 50, level = 0.80, file_name = "task4e_bands_N200.png")
\end{minted}
\caption{R-kode for gjentatte delutvalg og intervallillustrasjoner}
\label{lst:task4-r}
\end{listing}