--- title: "Likelihood plots - coin flip and linear model" author: "by [Baptiste Couvy-Duchesne] - `r format(Sys.time(), '%d %B %Y')`" output: epuRate::ISGW: toc: TRUE code_folding: "show" --- ```{r, echo=TRUE, message=FALSE, warning=FALSE} # 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) ``` # Likelihood function - coin flip Evolution of the likelihood function as we go from 1 to 100 coin flips ```{R, echo=T, eval=F} # 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" ) ``` ```{R, echo=FALSE, message=FALSE, hide=T, fig.show="hold",out.width="80%"} library(knitr) include_graphics(path = "LK_coinToss.gif") ``` # Maximum likelihood estimates ```{R, echo=T, eval=F} # 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" ) ``` ```{R, echo=FALSE, message=FALSE, hide=T, fig.show="hold",out.width="80%"} library(knitr) include_graphics(path = "LK_coinToss_MLE.gif") ``` # Likelihood plot - linear regression ```{R, echo=TRUE, eval=F} # 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) ``` ## Write likelihood functions ```{R, echo=TRUE, eval=F} # 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) ) ``` ## Make 3d plot and export snapshots ```{R, echo=TRUE, eval=F} # 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+1 ``` ## Combine images into a gif ```{R, echo=TRUE, eval=F} library(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" ) ``` ```{R, echo=F , message=FALSE, hide=T,fig.show="hold",out.width="80%"} library(knitr) include_graphics(path = paste0("Likelihood_lm.gif")) ``` # Maximum likelihood estimators of linear model ## Function to extract ML estimate ```{R, echo=TRUE, eval=F} # 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 values from all likelihood functions ```{R, echo=T, hide=T, fold=T, eval=F} # 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 and gif ```{R, echo=T, eval=F} # 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" ) ``` ```{R, echo=F , message=FALSE, hide=T,fig.show="hold",out.width="80%"} library(knitr) include_graphics(path = paste0("MLE_linearModel_full.gif")) ```