#' Make a random number generator repeatable #' #' Given a function that generates random data, returns a wrapped version of #' that function that always uses the same seed when called. The seed to use can #' be passed in explicitly if desired; otherwise, a random number is used. #' #' @param rngfunc The function that is affected by the R session's seed. #' @param seed The seed to set every time the resulting function is called. #' @return A repeatable version of the function that was passed in. #' #' @note When called, the returned function attempts to preserve the R session's #' current seed by snapshotting and restoring #' \code{\link[base]{.Random.seed}}. #' #' @examples #' rnormA <- repeatable(rnorm) #' rnormB <- repeatable(rnorm) #' rnormA(3) # [1] 1.8285879 -0.7468041 -0.4639111 #' rnormA(3) # [1] 1.8285879 -0.7468041 -0.4639111 #' rnormA(5) # [1] 1.8285879 -0.7468041 -0.4639111 -1.6510126 -1.4686924 #' rnormB(5) # [1] -0.7946034 0.2568374 -0.6567597 1.2451387 -0.8375699 #' #' @export repeatable <- function(rngfunc, seed = runif(1, 0, .Machine$integer.max)) { force(seed) function(...) { # When we exit, restore the seed to its original state if (exists('.Random.seed', where=globalenv())) { currentSeed <- get('.Random.seed', pos=globalenv()) on.exit(assign('.Random.seed', currentSeed, pos=globalenv())) } else { on.exit(rm('.Random.seed', pos=globalenv())) } set.seed(seed) do.call(rngfunc, list(...)) } } `%OR%` <- function(x, y) { ifelse(is.null(x) || is.na(x), y, x) } `%AND%` <- function(x, y) { if (!is.null(x) && !is.na(x)) if (!is.null(y) && !is.na(y)) return(y) return(NULL) } `%.%` <- function(x, y) { paste(x, y, sep='') } knownContentTypes <- Map$new() knownContentTypes$mset( html='text/html; charset=UTF-8', htm='text/html; charset=UTF-8', js='text/javascript', css='text/css', png='image/png', jpg='image/jpeg', jpeg='image/jpeg', gif='image/gif', svg='image/svg+xml', txt='text/plain', pdf='application/pdf', ps='application/postscript', xml='application/xml', m3u='audio/x-mpegurl', m4a='audio/mp4a-latm', m4b='audio/mp4a-latm', m4p='audio/mp4a-latm', mp3='audio/mpeg', wav='audio/x-wav', m4u='video/vnd.mpegurl', m4v='video/x-m4v', mp4='video/mp4', mpeg='video/mpeg', mpg='video/mpeg', avi='video/x-msvideo', mov='video/quicktime', ogg='application/ogg', swf='application/x-shockwave-flash', doc='application/msword', xls='application/vnd.ms-excel', ppt='application/vnd.ms-powerpoint', xlsx='application/vnd.openxmlformats-officedocument.spreadsheetml.sheet', xltx='application/vnd.openxmlformats-officedocument.spreadsheetml.template', potx='application/vnd.openxmlformats-officedocument.presentationml.template', ppsx='application/vnd.openxmlformats-officedocument.presentationml.slideshow', pptx='application/vnd.openxmlformats-officedocument.presentationml.presentation', sldx='application/vnd.openxmlformats-officedocument.presentationml.slide', docx='application/vnd.openxmlformats-officedocument.wordprocessingml.document', dotx='application/vnd.openxmlformats-officedocument.wordprocessingml.template', xlam='application/vnd.ms-excel.addin.macroEnabled.12', xlsb='application/vnd.ms-excel.sheet.binary.macroEnabled.12') getContentType <- function(ext, defaultType='application/octet-stream') { knownContentTypes$get(tolower(ext)) %OR% defaultType }