# 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
knitr::opts_chunk$set(tidy.opts = list(width.cutoff = 60), tidy = TRUE)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)
cn = rbinom(n = 100, size = 1, prob = 0.5)
# Make 100 plots of the likelihood, each time adding 1 data
# point
for (iii in 1:length(cn)) {
nheads = sum(cn[1:iii])
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)
imgs <- list.files(path = "./", pattern = "LK_coinToss_", full.names = TRUE)
img_list <- lapply(imgs, image_read)
## join the images together
img_joined <- image_join(img_list)
## animate at 5 frames per second
img_animated <- image_animate(img_joined, fps = 5, loop = 0)
## save to disk
image_write(image = img_animated, path = "LK_coinToss.gif")# Plots showing ML estimate for each iteration
set.seed(12345)
cn = rbinom(n = 100, size = 1, prob = 0.5)
resC = NULL
for (iii in 1:length(cn)) {
nheads = sum(cn[1:iii])
png(filename = paste0("LK_coinToss_MLE_", sprintf("%03d",
iii), ".png"), width = 12, height = 8, units = "cm",
res = 300)
par(mar = c(2, 4, 2, 1))
xx = runif(100, 0, 1)
yy = (xx^nheads) * ((1 - xx)^(iii - nheads))
resC = c(resC, xx[which(yy == max(yy))])
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)
imgs <- list.files(path = "./", pattern = "LK_coinToss_MLE_",
full.names = TRUE)
img_list <- lapply(imgs, image_read)
## join the images together
img_joined <- image_join(img_list)
## animate at 2 frames per second
img_animated <- image_animate(img_joined, fps = 5, loop = 0)
## save to disk
image_write(image = img_animated, path = "LK_coinToss_MLE.gif")# We simulate X and Y for linear model
set.seed(12345)
Y = rnorm(100, mean = 0, sd = 1)
X = scale(0.2 * Y + rnorm(100, mean = 0, sd = 0.2))
# 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
TRUEVAL = c(0.6455, 0.5132638)# 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.
f1 <- function(x, y) (2 * pi * y)^(-1/2) * exp(-1/(2 * y) * ((Y[1] -
X[1] * x)^2))
f2 <- function(x, y) (2 * pi * y)^(-2/2) * exp(-1/(2 * y) * ((Y[1] -
X[1] * x)^2 + (Y[2] - X[2] * x)^2))
f3 <- function(x, y) (2 * pi * y)^(-3/2) * exp(-1/(2 * y) * ((Y[1] -
X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] * x)^2))
f4 <- function(x, y) (2 * pi * y)^(-4/2) * exp(-1/(2 * y) * ((Y[1] -
X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] * x)^2 +
(Y[4] - X[4] * x)^2))
# Etc
f5 <- function(x, y) (2 * pi * y)^(-5/2) * exp(-1/(2 * y) * ((Y[1] -
X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] * x)^2 +
(Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2))
f6 <- function(x, y) (2 * pi * y)^(-6/2) * exp(-1/(2 * y) * ((Y[1] -
X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] * x)^2 +
(Y[4] - X[4] * x)^2 + (Y[5] - X[5] * x)^2 + (Y[6] - X[6] *
x)^2))
f7 <- function(x, y) (2 * pi * y)^(-7/2) * exp(-1/(2 * y) * ((Y[1] -
X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] * x)^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))
f8 <- function(x, y) (2 * pi * y)^(-8/2) * exp(-1/(2 * y) * ((Y[1] -
X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] * x)^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))
f9 <- function(x, y) (2 * pi * y)^(-9/2) * exp(-1/(2 * y) * ((Y[1] -
X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] * x)^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 + (Y[9] -
X[9] * x)^2))
f10 <- function(x, y) (2 * pi * y)^(-10/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2))
f11 <- function(x, y) (2 * pi * y)^(-11/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[11] * x)^2))
f12 <- function(x, y) (2 * pi * y)^(-12/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[11] * x)^2 + (Y[12] - X[12] * x)^2))
f13 <- function(x, y) (2 * pi * y)^(-13/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
x)^2))
f14 <- function(x, y) (2 * pi * y)^(-14/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[11] * x)^2 + (Y[12] - X[12] * x)^2 + (Y[13] - X[13] *
x)^2 + (Y[14] - X[14] * x)^2))
f15 <- function(x, y) (2 * pi * y)^(-15/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[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))
f16 <- function(x, y) (2 * pi * y)^(-16/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[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 +
(Y[16] - X[16] * x)^2))
f17 <- function(x, y) (2 * pi * y)^(-17/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[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 +
(Y[16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2))
f18 <- function(x, y) (2 * pi * y)^(-18/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[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 +
(Y[16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
X[18] * x)^2))
f19 <- function(x, y) (2 * pi * y)^(-19/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[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 +
(Y[16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
X[18] * x)^2 + (Y[19] - X[19] * x)^2))
f20 <- function(x, y) (2 * pi * y)^(-20/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[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 +
(Y[16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
X[18] * x)^2 + (Y[19] - X[19] * x)^2 + (Y[20] - X[20] *
x)^2))
f21 <- function(x, y) (2 * pi * y)^(-21/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[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 +
(Y[16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
X[18] * x)^2 + (Y[19] - X[19] * x)^2 + (Y[20] - X[20] *
x)^2 + (Y[21] - X[21] * x)^2))
f22 <- function(x, y) (2 * pi * y)^(-22/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[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 +
(Y[16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
X[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))
f23 <- function(x, y) (2 * pi * y)^(-23/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[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 +
(Y[16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
X[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 +
(Y[23] - X[23] * x)^2))
f24 <- function(x, y) (2 * pi * y)^(-24/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[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 +
(Y[16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
X[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 +
(Y[23] - X[23] * x)^2 + (Y[24] - X[24] * x)^2))
f25 <- function(x, y) (2 * pi * y)^(-25/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[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 +
(Y[16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
X[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 +
(Y[23] - X[23] * x)^2 + (Y[24] - X[24] * x)^2 + (Y[25] -
X[25] * x)^2))
f26 <- function(x, y) (2 * pi * y)^(-26/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[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 +
(Y[16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
X[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 +
(Y[23] - X[23] * x)^2 + (Y[24] - X[24] * x)^2 + (Y[25] -
X[25] * x)^2 + (Y[26] - X[26] * x)^2))
f27 <- function(x, y) (2 * pi * y)^(-27/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[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 +
(Y[16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
X[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 +
(Y[23] - X[23] * x)^2 + (Y[24] - X[24] * x)^2 + (Y[25] -
X[25] * x)^2 + (Y[26] - X[26] * x)^2 + (Y[27] - X[27] *
x)^2))
f28 <- function(x, y) (2 * pi * y)^(-28/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[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 +
(Y[16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
X[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 +
(Y[23] - X[23] * x)^2 + (Y[24] - X[24] * x)^2 + (Y[25] -
X[25] * x)^2 + (Y[26] - X[26] * x)^2 + (Y[27] - X[27] *
x)^2 + (Y[28] - X[28] * x)^2))
f29 <- function(x, y) (2 * pi * y)^(-29/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[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 +
(Y[16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
X[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 +
(Y[23] - X[23] * x)^2 + (Y[24] - X[24] * x)^2 + (Y[25] -
X[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))
f30 <- function(x, y) (2 * pi * y)^(-30/2) * exp(-1/(2 * y) *
((Y[1] - X[1] * x)^2 + (Y[2] - X[2] * x)^2 + (Y[3] - X[3] *
x)^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 +
(Y[9] - X[9] * x)^2 + (Y[10] - X[10] * x)^2 + (Y[11] -
X[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 +
(Y[16] - X[16] * x)^2 + (Y[17] - X[17] * x)^2 + (Y[18] -
X[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 +
(Y[23] - X[23] * x)^2 + (Y[24] - X[24] * x)^2 + (Y[25] -
X[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 +
(Y[30] - X[30] * x)^2))# Making 3d plot with snapshots
library(rgl)
res = curve_3d <- function(ff, x_range = c(-3, 3), y_range = c(0,
3), iii) {
# if (!require(rgl) ) {stop('load rgl')}
xvec <- seq(x_range[1], x_range[2], len = 100)
yvec <- seq(y_range[1], y_range[2], len = 100)
fz <- outer(xvec, yvec, FUN = ff)
rbPal <- colorRampPalette(c("red", "yellow"))
Col <- rbPal(10)[as.numeric(cut(fz, breaks = 10))]
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 = iii + 1
curve_3d(ff = f2, iii = iii)
iii = iii + 1
curve_3d(ff = f3, iii = iii)
iii = iii + 1
curve_3d(ff = f4, iii = iii)
iii = iii + 1
curve_3d(ff = f5, iii = iii)
iii = iii + 1
curve_3d(ff = f6, iii = iii)
iii = iii + 1
curve_3d(ff = f7, iii = iii)
iii = iii + 1
curve_3d(ff = f8, iii = iii)
iii = iii + 1
curve_3d(ff = f9, iii = iii)
iii = iii + 1
curve_3d(ff = f10, iii = iii)
iii = iii + 1
curve_3d(ff = f11, iii = iii)
iii = iii + 1
curve_3d(ff = f12, iii = iii)
iii = iii + 1
curve_3d(ff = f13, iii = iii)
iii = iii + 1
curve_3d(ff = f14, iii = iii)
iii = iii + 1
curve_3d(ff = f15, iii = iii)
iii = iii + 1
curve_3d(ff = f16, iii = iii)
iii = iii + 1
curve_3d(ff = f17, iii = iii)
iii = iii + 1
curve_3d(ff = f18, iii = iii)
iii = iii + 1
curve_3d(ff = f19, iii = iii)
iii = iii + 1
curve_3d(ff = f20, iii = iii)
iii = iii + 1
curve_3d(ff = f21, iii = iii)
iii = iii + 1
curve_3d(ff = f22, iii = iii)
iii = iii + 1
curve_3d(ff = f23, iii = iii)
iii = iii + 1
curve_3d(ff = f24, iii = iii)
iii = iii + 1
curve_3d(ff = f25, iii = iii)
iii = iii + 1
curve_3d(ff = f26, iii = iii)
iii = iii + 1
curve_3d(ff = f27, iii = iii)
iii = iii + 1
curve_3d(ff = f28, iii = iii)
iii = iii + 1
curve_3d(ff = f29, iii = iii)
iii = iii + 1
curve_3d(ff = f30, iii = iii)
iii = iii + 1library(magick)
imgs <- list.files(path = "./", pattern = "Likelihood_lm_", full.names = TRUE)
img_list <- lapply(imgs, image_read)
## join the images together
img_joined <- image_join(img_list)
## animate at 2 frames per second
img_animated <- image_animate(img_joined, fps = 5, loop = 0)
## save to disk
image_write(image = img_animated, path = "Likelihood_lm.gif")# Plot maximum likelihood values as we increase the sample
# size
res = c(0, 0)
# Function to extract ML estimates from model
MLest <- function(ff, x_range = c(-3, 3), y_range = c(0, 3),
iii, res) {
# if (!require(rgl) ) {stop('load rgl')}
xvec <- seq(x_range[1], x_range[2], len = 100)
yvec <- seq(y_range[1], y_range[2], len = 100)
fz <- outer(xvec, yvec, FUN = ff)
fz[which(fz == max(fz, na.rm = T), arr.ind = T)]
MLP = which(fz == max(fz, na.rm = T), arr.ind = T)
MLEx = xvec[MLP[1]]
MLEy = yvec[MLP[2]]
res = rbind(res, c(MLEx, MLEy))
return(res)
}# Get all values for all iteration steps
iii = 1
res = MLest(ff = f1, iii = iii, res = c(0, 0))
iii = iii + 1
res = MLest(ff = f2, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f3, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f4, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f5, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f6, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f7, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f8, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f9, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f10, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f11, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f12, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f13, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f14, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f15, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f16, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f17, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f18, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f19, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f20, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f21, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f22, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f23, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f24, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f25, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f26, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f27, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f28, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f29, iii = iii, res = res)
iii = iii + 1
res = MLest(ff = f30, iii = iii, res = res)
iii = iii + 1
res = res[-1, ]
resPlot = res# Make plots, adding a new row of data, every time
for (iii in c(30:1)) {
resPlot[iii, ] = c(NA, NA)
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)
imgs <- list.files(path = "./", pattern = "MLE_linearModel_full_",
full.names = TRUE)
img_list <- lapply(imgs, image_read)
## join the images together
img_joined <- image_join(img_list)
## animate at 2 frames per second
img_animated <- image_animate(img_joined, fps = 5, loop = 0)
## save to disk
image_write(image = img_animated, path = "MLE_linearModel_full.gif")A work by by [Baptiste Couvy-Duchesne] - 06 March 2024