mirror of
https://github.com/rstudio/shiny.git
synced 2026-01-29 00:38:19 -05:00
104 lines
3.4 KiB
R
104 lines
3.4 KiB
R
#' 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
|
|
} |