# You need these libraries to run this template:
library(rmarkdown) # install.packages("rmarkdown")
library(epuRate) # devtools::install_github("holtzy/epuRate", force=TRUE)
# Soft-wrap code in knitting
::opts_chunk$set(tidy.opts = list(width.cutoff = 60), tidy = TRUE) knitr
Evolution of the likelihood function as we go from 1 to 100 coin flips
# Simulate 10 coin flips - with 0.5 probability of heads
set.seed(12345)
= rbinom(n = 100, size = 1, prob = 0.5)
cn
# Make 100 plots of the likelihood, each time adding 1 data
# point
for (iii in 1:length(cn)) {
= sum(cn[1:iii])
nheads png(filename = paste0("LK_coinToss_", sprintf("%03d", iii),
".png"), width = 10, height = 8, units = "cm", res = 300)
par(mar = c(4, 4, 3, 1))
curve((x^nheads) * ((1 - x)^(iii - nheads)), xlab = "Theta",
ylab = "Likelihood")
dev.off()
}
# Combine all plots into a GIF
library(magick)
<- list.files(path = "./", pattern = "LK_coinToss_", full.names = TRUE)
imgs <- lapply(imgs, image_read)
img_list ## join the images together
<- image_join(img_list)
img_joined ## animate at 5 frames per second
<- image_animate(img_joined, fps = 5, loop = 0)
img_animated ## save to disk
image_write(image = img_animated, path = "LK_coinToss.gif")
# Plots showing ML estimate for each iteration
set.seed(12345)
= rbinom(n = 100, size = 1, prob = 0.5)
cn = NULL
resC for (iii in 1:length(cn)) {
= sum(cn[1:iii])
nheads png(filename = paste0("LK_coinToss_MLE_", sprintf("%03d",
".png"), width = 12, height = 8, units = "cm",
iii), res = 300)
par(mar = c(2, 4, 2, 1))
= runif(100, 0, 1)
xx = (xx^nheads) * ((1 - xx)^(iii - nheads))
yy = c(resC, xx[which(yy == max(yy))])
resC plot(1:length(cn), c(resC, rep(NA, length(cn) - iii)), ylab = "ML estimate",
pch = 20, ylim = c(0, 1))
lines(1:length(cn), c(resC, rep(NA, length(cn) - iii)))
abline(h = 0.5)
dev.off()
}
# Make gif
library(magick)
<- list.files(path = "./", pattern = "LK_coinToss_MLE_",
imgs full.names = TRUE)
<- lapply(imgs, image_read)
img_list ## join the images together
<- image_join(img_list)
img_joined ## animate at 2 frames per second
<- image_animate(img_joined, fps = 5, loop = 0)
img_animated ## save to disk
image_write(image = img_animated, path = "LK_coinToss_MLE.gif")
# We simulate X and Y for linear model
set.seed(12345)
= rnorm(100, mean = 0, sd = 1)
Y = scale(0.2 * Y + rnorm(100, mean = 0, sd = 0.2))
X
# Some checks
plot(Y, X)
cor(Y, X)
# Fitting the regression
lm(Y[1:30] ~ X[1:30])
var(residuals(lm(Y[1:30] ~ X[1:30])))
var(Y[1:30]) - (cor(Y[1:30], X[1:30])^2) * var(X[1:30])
# Storing the 'true' (simulated) values of the parameters
= c(0.6455, 0.5132638) TRUEVAL
# We create the likelihood functions f1 - f30 progressively
# adding rows of the data I have not found a way to
# simplify the notation or loop it, I would love to hear if
# you find a better way.
<- function(x, y) (2 * pi * y)^(-1/2) * exp(-1/(2 * y) * ((Y[1] -
f1 1] * x)^2))
X[<- function(x, y) (2 * pi * y)^(-2/2) * exp(-1/(2 * y) * ((Y[1] -
f2 1] * x)^2 + (Y[2] - X[2] * x)^2))
X[<- function(x, y) (2 * pi * y)^(-3/2) * exp(-1/(2 * y) * ((Y[1] -
f3 1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] * x)^2))
X[<- function(x, y) (2 * pi * y)^(-4/2) * exp(-1/(2 * y) * ((Y[1] -
f4 1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] * x)^2 +
X[4] - X[4] * x)^2))
(Y[
# Etc
<- function(x, y) (2 * pi * y)^(-5/2) * exp(-1/(2 * y) * ((Y[1] -
f5 1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] * x)^2 +
X[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2))
(Y[<- function(x, y) (2 * pi * y)^(-6/2) * exp(-1/(2 * y) * ((Y[1] -
f6 1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] * x)^2 +
X[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] - X[6] *
(Y[^2))
x)
<- function(x, y) (2 * pi * y)^(-7/2) * exp(-1/(2 * y) * ((Y[1] -
f7 1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] * x)^2 +
X[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] - X[6] *
(Y[^2 + (Y[7] - X[7] * x)^2))
x)<- function(x, y) (2 * pi * y)^(-8/2) * exp(-1/(2 * y) * ((Y[1] -
f8 1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] * x)^2 +
X[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] - X[6] *
(Y[^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2))
x)<- function(x, y) (2 * pi * y)^(-9/2) * exp(-1/(2 * y) * ((Y[1] -
f9 1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] * x)^2 +
X[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] - X[6] *
(Y[^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 + (Y[9] -
x)9] * x)^2))
X[<- function(x, y) (2 * pi * y)^(-10/2) * exp(-1/(2 * y) *
f10 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2))
(Y[
<- function(x, y) (2 * pi * y)^(-11/2) * exp(-1/(2 * y) *
f11 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2))
X[<- function(x, y) (2 * pi * y)^(-12/2) * exp(-1/(2 * y) *
f12 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2 + (Y[12] - X[12] * x)^2))
X[<- function(x, y) (2 * pi * y)^(-13/2) * exp(-1/(2 * y) *
f13 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
X[^2))
x)<- function(x, y) (2 * pi * y)^(-14/2) * exp(-1/(2 * y) *
f14 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
X[^2 + (Y[14] - X[14] * x)^2))
x)<- function(x, y) (2 * pi * y)^(-15/2) * exp(-1/(2 * y) *
f15 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
X[^2 + (Y[14] - X[14] * x)^2 + (Y[15] - X[15] * x)^2))
x)<- function(x, y) (2 * pi * y)^(-16/2) * exp(-1/(2 * y) *
f16 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
X[^2 + (Y[14] - X[14] * x)^2 + (Y[15] - X[15] * x)^2 +
x)16] - X[16] * x)^2))
(Y[<- function(x, y) (2 * pi * y)^(-17/2) * exp(-1/(2 * y) *
f17 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
X[^2 + (Y[14] - X[14] * x)^2 + (Y[15] - X[15] * x)^2 +
x)16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2))
(Y[<- function(x, y) (2 * pi * y)^(-18/2) * exp(-1/(2 * y) *
f18 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
X[^2 + (Y[14] - X[14] * x)^2 + (Y[15] - X[15] * x)^2 +
x)16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
(Y[18] * x)^2))
X[
<- function(x, y) (2 * pi * y)^(-19/2) * exp(-1/(2 * y) *
f19 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
X[^2 + (Y[14] - X[14] * x)^2 + (Y[15] - X[15] * x)^2 +
x)16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
(Y[18] * x)^2 + (Y[19] - X[19] * x)^2))
X[
<- function(x, y) (2 * pi * y)^(-20/2) * exp(-1/(2 * y) *
f20 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
X[^2 + (Y[14] - X[14] * x)^2 + (Y[15] - X[15] * x)^2 +
x)16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
(Y[18] * x)^2 + (Y[19] - X[19] * x)^2 + (Y[20] - X[20] *
X[^2))
x)
<- function(x, y) (2 * pi * y)^(-21/2) * exp(-1/(2 * y) *
f21 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
X[^2 + (Y[14] - X[14] * x)^2 + (Y[15] - X[15] * x)^2 +
x)16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
(Y[18] * x)^2 + (Y[19] - X[19] * x)^2 + (Y[20] - X[20] *
X[^2 + (Y[21] - X[21] * x)^2))
x)
<- function(x, y) (2 * pi * y)^(-22/2) * exp(-1/(2 * y) *
f22 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
X[^2 + (Y[14] - X[14] * x)^2 + (Y[15] - X[15] * x)^2 +
x)16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
(Y[18] * x)^2 + (Y[19] - X[19] * x)^2 + (Y[20] - X[20] *
X[^2 + (Y[21] - X[21] * x)^2 + (Y[22] - X[22] * x)^2))
x)
<- function(x, y) (2 * pi * y)^(-23/2) * exp(-1/(2 * y) *
f23 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
X[^2 + (Y[14] - X[14] * x)^2 + (Y[15] - X[15] * x)^2 +
x)16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
(Y[18] * x)^2 + (Y[19] - X[19] * x)^2 + (Y[20] - X[20] *
X[^2 + (Y[21] - X[21] * x)^2 + (Y[22] - X[22] * x)^2 +
x)23] - X[23] * x)^2))
(Y[
<- function(x, y) (2 * pi * y)^(-24/2) * exp(-1/(2 * y) *
f24 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
X[^2 + (Y[14] - X[14] * x)^2 + (Y[15] - X[15] * x)^2 +
x)16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
(Y[18] * x)^2 + (Y[19] - X[19] * x)^2 + (Y[20] - X[20] *
X[^2 + (Y[21] - X[21] * x)^2 + (Y[22] - X[22] * x)^2 +
x)23] - X[23] * x)^2 + (Y[24] - X[24] * x)^2))
(Y[
<- function(x, y) (2 * pi * y)^(-25/2) * exp(-1/(2 * y) *
f25 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
X[^2 + (Y[14] - X[14] * x)^2 + (Y[15] - X[15] * x)^2 +
x)16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
(Y[18] * x)^2 + (Y[19] - X[19] * x)^2 + (Y[20] - X[20] *
X[^2 + (Y[21] - X[21] * x)^2 + (Y[22] - X[22] * x)^2 +
x)23] - X[23] * x)^2 + (Y[24] - X[24] * x)^2 + (Y[25] -
(Y[25] * x)^2))
X[
<- function(x, y) (2 * pi * y)^(-26/2) * exp(-1/(2 * y) *
f26 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
X[^2 + (Y[14] - X[14] * x)^2 + (Y[15] - X[15] * x)^2 +
x)16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
(Y[18] * x)^2 + (Y[19] - X[19] * x)^2 + (Y[20] - X[20] *
X[^2 + (Y[21] - X[21] * x)^2 + (Y[22] - X[22] * x)^2 +
x)23] - X[23] * x)^2 + (Y[24] - X[24] * x)^2 + (Y[25] -
(Y[25] * x)^2 + (Y[26] - X[26] * x)^2))
X[
<- function(x, y) (2 * pi * y)^(-27/2) * exp(-1/(2 * y) *
f27 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
X[^2 + (Y[14] - X[14] * x)^2 + (Y[15] - X[15] * x)^2 +
x)16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
(Y[18] * x)^2 + (Y[19] - X[19] * x)^2 + (Y[20] - X[20] *
X[^2 + (Y[21] - X[21] * x)^2 + (Y[22] - X[22] * x)^2 +
x)23] - X[23] * x)^2 + (Y[24] - X[24] * x)^2 + (Y[25] -
(Y[25] * x)^2 + (Y[26] - X[26] * x)^2 + (Y[27] - X[27] *
X[^2))
x)
<- function(x, y) (2 * pi * y)^(-28/2) * exp(-1/(2 * y) *
f28 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
X[^2 + (Y[14] - X[14] * x)^2 + (Y[15] - X[15] * x)^2 +
x)16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
(Y[18] * x)^2 + (Y[19] - X[19] * x)^2 + (Y[20] - X[20] *
X[^2 + (Y[21] - X[21] * x)^2 + (Y[22] - X[22] * x)^2 +
x)23] - X[23] * x)^2 + (Y[24] - X[24] * x)^2 + (Y[25] -
(Y[25] * x)^2 + (Y[26] - X[26] * x)^2 + (Y[27] - X[27] *
X[^2 + (Y[28] - X[28] * x)^2))
x)
<- function(x, y) (2 * pi * y)^(-29/2) * exp(-1/(2 * y) *
f29 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
X[^2 + (Y[14] - X[14] * x)^2 + (Y[15] - X[15] * x)^2 +
x)16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
(Y[18] * x)^2 + (Y[19] - X[19] * x)^2 + (Y[20] - X[20] *
X[^2 + (Y[21] - X[21] * x)^2 + (Y[22] - X[22] * x)^2 +
x)23] - X[23] * x)^2 + (Y[24] - X[24] * x)^2 + (Y[25] -
(Y[25] * x)^2 + (Y[26] - X[26] * x)^2 + (Y[27] - X[27] *
X[^2 + (Y[28] - X[28] * x)^2 + (Y[29] - X[29] * x)^2))
x)
<- function(x, y) (2 * pi * y)^(-30/2) * exp(-1/(2 * y) *
f30 1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
((Y[^2 + (Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] -
x)6] * x)^2 + (Y[7] - X[7] * x)^2 + (Y[8] - X[8] * x)^2 +
X[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
(Y[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
X[^2 + (Y[14] - X[14] * x)^2 + (Y[15] - X[15] * x)^2 +
x)16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
(Y[18] * x)^2 + (Y[19] - X[19] * x)^2 + (Y[20] - X[20] *
X[^2 + (Y[21] - X[21] * x)^2 + (Y[22] - X[22] * x)^2 +
x)23] - X[23] * x)^2 + (Y[24] - X[24] * x)^2 + (Y[25] -
(Y[25] * x)^2 + (Y[26] - X[26] * x)^2 + (Y[27] - X[27] *
X[^2 + (Y[28] - X[28] * x)^2 + (Y[29] - X[29] * x)^2 +
x)30] - X[30] * x)^2)) (Y[
# Making 3d plot with snapshots
library(rgl)
= curve_3d <- function(ff, x_range = c(-3, 3), y_range = c(0,
res 3), iii) {
# if (!require(rgl) ) {stop('load rgl')}
<- seq(x_range[1], x_range[2], len = 100)
xvec <- seq(y_range[1], y_range[2], len = 100)
yvec <- outer(xvec, yvec, FUN = ff)
fz <- colorRampPalette(c("red", "yellow"))
rbPal <- rbPal(10)[as.numeric(cut(fz, breaks = 10))]
Col open3d()
par3d(windowRect = c(0, 0, 800, 800) * 1.5, zoom = 0.8)
persp3d(xvec, yvec, fz, col = Col)
# view3d(theta = -45)
view3d(userMatrix = um, zoom = 0.8)
rgl.snapshot(paste0("Likelihood_lm_", sprintf("%03d", iii),
".png"))
rgl.close()
}
# Make plots for each iteration
curve_3d(ff = f1, iii = iii)
= iii + 1
iii curve_3d(ff = f2, iii = iii)
= iii + 1
iii curve_3d(ff = f3, iii = iii)
= iii + 1
iii curve_3d(ff = f4, iii = iii)
= iii + 1
iii curve_3d(ff = f5, iii = iii)
= iii + 1
iii curve_3d(ff = f6, iii = iii)
= iii + 1
iii curve_3d(ff = f7, iii = iii)
= iii + 1
iii curve_3d(ff = f8, iii = iii)
= iii + 1
iii curve_3d(ff = f9, iii = iii)
= iii + 1
iii curve_3d(ff = f10, iii = iii)
= iii + 1
iii curve_3d(ff = f11, iii = iii)
= iii + 1
iii curve_3d(ff = f12, iii = iii)
= iii + 1
iii curve_3d(ff = f13, iii = iii)
= iii + 1
iii curve_3d(ff = f14, iii = iii)
= iii + 1
iii curve_3d(ff = f15, iii = iii)
= iii + 1
iii curve_3d(ff = f16, iii = iii)
= iii + 1
iii curve_3d(ff = f17, iii = iii)
= iii + 1
iii curve_3d(ff = f18, iii = iii)
= iii + 1
iii curve_3d(ff = f19, iii = iii)
= iii + 1
iii curve_3d(ff = f20, iii = iii)
= iii + 1
iii curve_3d(ff = f21, iii = iii)
= iii + 1
iii curve_3d(ff = f22, iii = iii)
= iii + 1
iii curve_3d(ff = f23, iii = iii)
= iii + 1
iii curve_3d(ff = f24, iii = iii)
= iii + 1
iii curve_3d(ff = f25, iii = iii)
= iii + 1
iii curve_3d(ff = f26, iii = iii)
= iii + 1
iii curve_3d(ff = f27, iii = iii)
= iii + 1
iii curve_3d(ff = f28, iii = iii)
= iii + 1
iii curve_3d(ff = f29, iii = iii)
= iii + 1
iii curve_3d(ff = f30, iii = iii)
= iii + 1 iii
library(magick)
<- list.files(path = "./", pattern = "Likelihood_lm_", full.names = TRUE)
imgs <- lapply(imgs, image_read)
img_list ## join the images together
<- image_join(img_list)
img_joined ## animate at 2 frames per second
<- image_animate(img_joined, fps = 5, loop = 0)
img_animated ## save to disk
image_write(image = img_animated, path = "Likelihood_lm.gif")
# Plot maximum likelihood values as we increase the sample
# size
= c(0, 0)
res # Function to extract ML estimates from model
<- function(ff, x_range = c(-3, 3), y_range = c(0, 3),
MLest
iii, res) {# if (!require(rgl) ) {stop('load rgl')}
<- seq(x_range[1], x_range[2], len = 100)
xvec <- seq(y_range[1], y_range[2], len = 100)
yvec <- outer(xvec, yvec, FUN = ff)
fz which(fz == max(fz, na.rm = T), arr.ind = T)]
fz[= which(fz == max(fz, na.rm = T), arr.ind = T)
MLP = xvec[MLP[1]]
MLEx = yvec[MLP[2]]
MLEy = rbind(res, c(MLEx, MLEy))
res return(res)
}
# Get all values for all iteration steps
= 1
iii = MLest(ff = f1, iii = iii, res = c(0, 0))
res = iii + 1
iii = MLest(ff = f2, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f3, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f4, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f5, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f6, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f7, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f8, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f9, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f10, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f11, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f12, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f13, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f14, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f15, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f16, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f17, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f18, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f19, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f20, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f21, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f22, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f23, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f24, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f25, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f26, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f27, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f28, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f29, iii = iii, res = res)
res = iii + 1
iii = MLest(ff = f30, iii = iii, res = res)
res = iii + 1
iii = res[-1, ]
res = res resPlot
# Make plots, adding a new row of data, every time
for (iii in c(30:1)) {
= c(NA, NA)
resPlot[iii, ] png(paste0("MLE_linearModel_full_", sprintf("%03d", iii),
".png"), width = 20, height = 12, units = "cm", res = 400)
par(mfrow = c(2, 1), mar = c(2, 4, 2, 1))
plot(c(1:30), resPlot[, 1], ylab = "ML estimate", ylim = c(-1,
2))
lines(c(1:30), resPlot[, 1])
abline(h = TRUEVAL[1], lwd = 3)
plot(c(1:30), resPlot[, 2], ylab = "ML estimate", ylim = c(0,
1))
lines(c(1:30), resPlot[, 2])
abline(h = TRUEVAL[2], lwd = 3)
dev.off()
}
# Combine images into a gif
library(magick)
<- list.files(path = "./", pattern = "MLE_linearModel_full_",
imgs full.names = TRUE)
<- lapply(imgs, image_read)
img_list ## join the images together
<- image_join(img_list)
img_joined ## animate at 2 frames per second
<- image_animate(img_joined, fps = 5, loop = 0)
img_animated ## save to disk
image_write(image = img_animated, path = "MLE_linearModel_full.gif")
A work by by [Baptiste Couvy-Duchesne] - 06 March 2024