visualizing the optimization path till convergence in R

Question

I am using "optim" package to maximize the log-likelihood function. and I would like to visualize the optimization path till convergence with animation such as this graph: link below.

https://florarblog.files.wordpress.com/2018/08/optimization_path2.gif?w=740&h=507&zoom=2)

Here is the log-likelihood function and optim:

  x = runif(500)
  x = model.matrix( ~ x)
  y = rbinom(500,1,0.5)
  theta= c(-0.1,2)

  logll <- function(theta)
    {
    p <- exp(x%*%theta) 
    p[p >=1] <- 1- 1e-5 ; p[p<=0] <- 1e-5 
    LL <- sum(y*log(p) + (1-y)*log(1 - p))
    return(-LL)
    }

  optim(theta,logll)

  l.grid <- 200
  grid.b <- as.matrix(expand.grid(b0=seq(-3,0.5,length.out=l.grid), b1=seq(-6,6,length.out=l.grid)))
  grid.f <-apply(grid.b,1,logll)
  grid.b <- as.data.frame(grid.b)
  contourplot(grid.f~b0+b1,data=grid.b,cuts=15)

Thanks in advance for your help

Answer 1

We need to run the optimizer one step at a time, so we get the solution for each time step. Then doing the animation is almost trivial using gganimate.

grid.b$f <- grid.f

op <- sapply(
  seq_len(optim(theta,logll)$counts['function']), 
  function(i) { 
    set.seed(1234)
    optim(theta, logll, control = list(maxit = i))$par
  }
)
op_df <- data.frame(b0 = op[1,], b1 = op[2,])
op_df$step <- 1:nrow(op_df)

p <- ggplot(grid.b, aes(b0, b1)) + 
  geom_raster(aes(fill = f)) +
  geom_contour(aes(z = f), col = 'grey40') +
  geom_path(data = op_df, col = 'white') +
  geom_point(data = op_df, col = 'white') +
  scale_fill_viridis_c() +
  coord_cartesian(expand = FALSE)


library(gganimate)
a <- p + transition_reveal(step)

anim_save(
  '~/Desktop/anim.gif', a, height = 400, width = 400, 
  nframes = nrow(op_df), fps = 30, duration = nrow(op_df) / 30
)

One frame is one step. You could smooth out the transitions, but the discrete nature is informative.