From ross at biostat.ucsf.edu  Sat Jan  7 02:44:22 2006
From: ross at biostat.ucsf.edu (Ross Boylan)
Date: Fri, 06 Jan 2006 17:44:22 -0800
Subject: [Rd] checkpointing
In-Reply-To: <971536df0601030521u4377de72jfbd1ff4499e7deed@mail.gmail.com>
References: <Pine.GSO.4.31.0601030832230.5822-100000@markov.stats>
	<BCA2993F-D89F-4054-BB33-495B2EA8B74F@stat.berkeley.edu>
	<971536df0601030521u4377de72jfbd1ff4499e7deed@mail.gmail.com>
Message-ID: <1136598262.5639.202.camel@iron.psg.net>

Here's some code I put together for checkpointing a function being
optimized. Hooking directly into optim would require modifying its C
code, so this seemed the easiest route.  I've wanted more information on
the iterations than is currently provided, so this stuff some info back
in the calling environment (by default).

# wrapper to do checkpointing

# Ross Boylan ross at biostat.ucsf.edu
# 06-Jan-2006
# (C) 2006 Regents of University of California
# Distributed under the Gnu Public License v2 or later at your option

# If you want to checkpoint the optimization of a function f
# Use checkpoint(f) instead.  See below for other possible arguments.

# default operation for checkpoint(fnfoo) is to record the iterations
# in fnfoo.trace in the calling environment

# WARNING: Any existing variable with name in argument name
# will be deleted from the indicated frame
checkpoint <- function(f,
                       name = paste(substitute(f), ".trace", sep=""),
                       fileName = substitute(f),
                       nCalls = 1,
                       nTime = 60*15,
                       frame = parent.frame()) {
  # f is the objective function
  # frame is where to put the variable name
  # name will be a data.frame with rows containing
  #   iteration, time, value, parameters
  # fileName is the stem of the name to save for checkpointing
  #  saving will alternate between files with 0 and 1 appended
  # Saving to disk will happen every nCalls or nTime seconds,
  # whichever comes first
  if (exists(name, where=frame))
      rm(list=name, pos=frame)
  ckpt.lastSave <- 0 # alternate 0/1 for file to write to
  ckpt.lastTime <- Sys.time()  # last time saved
  function(params, ...) {
    p <- as.list(params)
    names(p) <- seq(length(params))
    if (exists(name, where=frame, inherits=FALSE)) {
      progress <- get(name, pos=frame)
      progress <- rbind(progress,
                        data.frame(row.names=dim(progress)[1]+1,
time=Sys.time(),
                        val=NA, p), deparse.level=0)
    } else
        progress <- data.frame(row.names=1, time=Sys.time(), val=NA, p)
    n <- dim(progress)[1]
    # write to disk
    if (n%%nCalls == 0 || progress[n, 1]- ckpt.lastTime > nTime) {
      ckpt.lastSave <<- (ckpt.lastSave+1) %% 2
      save(progress, file=paste(fileName, ckpt.lastSave, sep=""))
      ckpt.lastTime <<- progress[n, 1]
    }
    v <- f(params, ...)
    progress[n, 2] <- v
    assign(name, progress, pos=frame)
    v
  }
}



[Rd] checkpointing
Ross Boylan