Skip to content

Commit

Permalink
Merge branch 'depends' into next
Browse files Browse the repository at this point in the history 
* depends:
  Update DESCRIPTION file
  Add/modify helper functions
  Modify EvalWithOpt
  Modify evalAndDumpToDB to add chunkDigest as option
  Changes from Tobias Abenius: add options function

Conflicts:
	R/SweaveCache.R
  • Loading branch information
@rdpeng
rdpeng committed Jun 29, 2011
2 parents 22f7d64 + c501a2e commit 1940377
Show file tree
Hide file tree
Showing 2 changed files with 142 additions and 27 deletions.
9 changes: 6 additions & 3 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,12 +1,15 @@
Package: cacheSweave
Title: Tools for caching Sweave computations
Version: 0.4-5
Date: 2010-11-24
Version: 0.5-1
Date: 2011-04-19
Depends: R (>= 2.12.0), filehash, stashR
Imports: utils, digest
LazyLoad: yes
Author: Roger D. Peng <rpeng@jhsph.edu>
Maintainer: Roger D. Peng <rpeng@jhsph.edu>
Description: Tools for caching Sweave computations and storing them in key-value databases
Description: Tools for caching Sweave computations and storing them in
key-value databases
License: GPL (>= 2)
URL: https://github.com/rdpeng/cachesweave
Repository: CRAN
Packaged: 2011-04-26 10:29:12 UTC; btobias
160 changes: 136 additions & 24 deletions R/SweaveCache.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,18 +20,26 @@
######################################################################
## Taken/adapted from Sweave code by Friedrich Leisch, along the lines
## of 'weaver' from Bioconductor, but more naive and we use 'stashR'
## databases for the backend. We also don't check dependencies on
## previous chunks.
## databases for the backend.

cacheSweaveDriver <- function() {
list(
setup = cacheSweaveSetup,
runcode = makeRweaveLatexCodeRunner(cacheSweaveEvalWithOpt),
writedoc = utils::RweaveLatexWritedoc,
finish = utils::RweaveLatexFinish,
checkopts = utils::RweaveLatexOptions
checkopts = cacheRweaveLatexOptions
)
}
# tabenius
cacheRweaveLatexOptions <- function(options) {
moreoptions <- c('dependson')
oldoptions <- options[setdiff(names(options),moreoptions)]
newoptions <- options[intersect(names(options),moreoptions)]
Rweaveoptions <- utils::RweaveLatexOptions(oldoptions)
options <- unlist(list(Rweaveoptions,newoptions),recursive=F)
}



######################################################################
Expand Down Expand Up @@ -107,7 +115,7 @@ checkNewSymbols <- function(e1, e2) {
## with a digest of the expression. Return a character vector of keys
## that were dumped

evalAndDumpToDB <- function(db, expr, exprDigest) {
evalAndDumpToDB <- function(db, expr, exprDigest, chunkDigest) { #tabenius
env <- new.env(parent = globalenv())
global1 <- copyEnv(globalenv())

Expand All @@ -122,6 +130,9 @@ evalAndDumpToDB <- function(db, expr, exprDigest) {

## Get newly assigned object names
keys <- ls(env, all.names = TRUE)
newkey <- paste('.cacheSweave.creation.time.',chunkDigest,sep='') # tabenius
keys <- c(keys, newkey) # tabenius
assign(newkey, Sys.time(), envir=env) # tabenius

## Associate the newly created keys with the digest of
## the expression
Expand All @@ -136,7 +147,7 @@ evalAndDumpToDB <- function(db, expr, exprDigest) {
}

makeChunkDatabaseName <- function(cachedir, options, chunkDigest) {
file.path(cachedir, paste(options$label, chunkDigest, sep = "_"))
file.path(cachedir, paste('cacheSweaveStorage',options$label, chunkDigest, sep = "_"))
}

mangleDigest <- function(x) {
Expand Down Expand Up @@ -174,56 +185,157 @@ cacheSweaveEvalWithOpt <- function (expr, options) {
res <- NULL

if(!options$eval)
return(res)
if(options$cache) {
cachedir <- getCacheDir()

## Create database name from chunk label and MD5
## digest
dbName <- makeChunkDatabaseName(cachedir, options, chunkDigest)
exprDigest <- mangleDigest(hashExpr(expr))

## Create 'stashR' database
db <- new("localDB", dir = dbName, name = basename(dbName))
return(list(res=res, updated=F))

# tabenius
cachedir <- getCacheDir()
## Create database name from chunk label and MD5
## digest
dbName <- makeChunkDatabaseName(cachedir, options, chunkDigest)
exprDigest <- mangleDigest(hashExpr(expr))

## Create 'stashR' database
db <- new("localDB", dir = dbName, name = basename(dbName))

trace <- options$trace & as.logical(options$trace)

chunkName <- metaChunkName(options)
dbMetaName <- makeMetaDatabaseName(cachedir)
dbMeta <- new("localDB", dir = dbMetaName, name = basename(dbMetaName))
creationTimes <- metaGetCreationTime(dbMeta)
fresh = dbExists(db, exprDigest)

# NOTE: Currently doesn't cache un-labeled chunks
if (!is.null(creationTimes[[chunkName]])) {
chunkCreationTime <- creationTimes[[chunkName]]
if(trace) cat("%",chunkName,"has creationTime:",format.Date(chunkCreationTime),"\n")
} else
chunkCreationTime <- NULL

flush(tmpcon)

fresh = fresh & !is.null(chunkCreationTime)
if (!is.null(options$dependson)){
depends <- unlist(strsplit(options$dependson,';'))
if (fresh)
for (dep in depends) {
dirty1 = is.null(creationTimes[[dep]])
if(!dirty1)
dirty1 = creationTimes[[dep]] > chunkCreationTime
if (trace)
if (dirty1)
cat("% in",chunkName,"dependency",dep,"is newer\n")
else
cat("% in",chunkName,"dependency",dep,"is older\n")
fresh = fresh & !dirty1
}
} else {
depends = NULL
}
if (trace)
if (fresh) {
cat("%",chunkName,"is fresh\n")
} else {
cat("%",chunkName,"is dirty\n")
}
updated <- FALSE
##### /tabenius

if(options$cache) {
## If the current expression is not cached, then
## evaluate the expression and dump the resulting
## objects to the database. Otherwise, just read the
## vector of keys from the database

if(!dbExists(db, exprDigest)) {
if(!fresh) {
keys <- try({
evalAndDumpToDB(db, expr, exprDigest)
evalAndDumpToDB(db, expr, exprDigest, chunkDigest)
}, silent = TRUE)

if(trace) { # tabenius
out <- "% evaluating and storing"
out <- paste(out,chunkName)
if (!is.null(depends)) {
out <- paste(out," depends (",sep='')
out <- paste(out, paste(depends,collapse=', '),sep='')
out <- paste(out,")",sep='')
}
out <- paste(out,Sys.time())
cat(out,"\n")
}
#### /tabenius

## If there was an error then just return the
## condition object and let Sweave deal with it.
if(inherits(keys, "try-error"))
return(keys)
return(list(res=keys,updated=F))

updated <- TRUE # tabenius
}
else {
keys <- dbFetch(db, exprDigest)
if(trace) { # tabenius
cat("% fetching object",chunkName)
}
keys <- dbFetch(db, exprDigest)
dbLazyLoad(db, globalenv(), keys)
if(trace) { # tabenius
if (!is.null(depends)) {
cat(" depending on",paste(depends,collapse=', '))
}
cat("\n")
}
}
keys
res <- keys
}
else {
## If caching is turned off, just evaluate the expression
## in the global environment
res <- utils::RweaveEvalWithOpt(expr, options)
}
res
list(res=res,updated=updated)
}

## Need to add the 'cache', 'filename' option to the list
cacheSweaveSetup <- function(..., cache = FALSE) {
makeMetaDatabaseName <- function(cachedir) {
file.path(cachedir, "cacheSweaveStorage_metadata")
}

metaGetCreationTime <- function(dbMeta) {
if(dbExists(dbMeta,"creationTimes")) {
creationTimes <- dbFetch(dbMeta, "creationTimes")
} else {
creationTimes <- list()
}
creationTimes
}

metaSetCreationTime <- function(label) {
cachedir <- getCacheDir()
dbMetaName <- makeMetaDatabaseName(cachedir)
dbMeta <- new("localDB", dir = dbMetaName, name = basename(dbMetaName))
creationTimes <- metaGetCreationTime(dbMeta)
creationTimes[[label]] =Sys.time()
dbInsert(dbMeta, "creationTimes", creationTimes)
creationTimes
}
metaChunkName <- function(options) {
if(!is.null(options$label))
chunkName <- options$label
else
chunkName <- paste("c",options$chunkDigest,sep='')
#cat("(chunkname=",chunkName))
chunkName
}

## Need to add the 'cache', 'filename' option to the list
cacheSweaveSetup <- function(..., cache = FALSE, trace=F, dependson=NULL) {
out <- utils::RweaveLatexSetup(...)

######################################################################
## Additions here [RDP]
## Add the (non-standard) options for code chunks with caching
out$options[["cache"]] <- cache
out$options[["dependson"]] <- dependson # tabenius
out$options[["trace"]] <- trace # tabenius

## End additions [RDP]
######################################################################
Expand Down

0 comments on commit 1940377

Please sign in to comment.