可视化优化路径直到在 R 中收敛

Question

我正在使用“优化”包来最大化对数似然函数。我想可视化优化路径，直到与动画收敛，例如这个图：下面的链接。

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

这是对数似然函数和优化：

  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)

提前感谢您的帮助

Answer 1

我们需要一次一步运行优化器，因此我们得到每个时间步的解决方案。然后使用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
)

一帧是一步。您可以平滑过渡，但离散的性质提供了丰富的信息。