# NOT RUN {
# parsing several lines of R code
txt <- readLines(textConnection('x <- rnorm(100)
runif(10)
warning('Lorem ipsum foo-bar-foo!')
plot(1:10)
qplot(rating, data = movies, geom = 'histogram')
y <- round(runif(100))
cor.test(x, y)
crl <- cor.test(runif(10), runif(10))
table(mtcars$am, mtcars$cyl)
ggplot(mtcars) + geom_point(aes(x = hp, y = mpg))'))
evals(txt)
## parsing a list of commands
txt <- list('df <- mtcars',
c('plot(mtcars$hp, pch = 19)','text(mtcars$hp, label = rownames(mtcars), pos = 4)'),
'ggplot(mtcars) + geom_point(aes(x = hp, y = mpg))')
evals(txt)
## the same commands in one string but also evaluating the `plot` with `text`
## (note the leading '+' on the beginning of `text...` line)
txt <- 'df <- mtcars
plot(mtcars$hp, pch = 19)
+text(mtcars$hp, label = rownames(mtcars), pos = 4)
ggplot(mtcars) + geom_point(aes(x = hp, y = mpg))'
evals(txt)
## but it would fail without parsing
evals(txt, parse = FALSE)
## handling messages
evals('message(20)')
evals('message(20);message(20)', parse = FALSE)
## adding a caption to a plot
evals('set.caption("FOO"); plot(1:10)')
## `plot` is started with a `+` to eval the codes in the same chunk
## (no extra chunk with NULL result)
evals('set.caption("FOO"); +plot(1:10)')
## handling warnings
evals('chisq.test(mtcars$gear, mtcars$hp)')
evals(list(c('chisq.test(mtcars$gear, mtcars$am)', 'pi',
'chisq.test(mtcars$gear, mtcars$hp)')), parse = FALSE)
evals(c('chisq.test(mtcars$gear, mtcars$am)',
'pi',
'chisq.test(mtcars$gear, mtcars$hp)'))
## handling errors
evals('runiff(20)')
evals('Old MacDonald had a farm\\dots')
evals('## Some comment')
evals(c('runiff(20)', 'Old MacDonald had a farm?'))
evals(list(c('runiff(20)', 'Old MacDonald had a farm?')), parse = FALSE)
evals(c('mean(1:10)', 'no.R.function()'))
evals(list(c('mean(1:10)', 'no.R.function()')), parse = FALSE)
evals(c('no.R.object', 'no.R.function()', 'very.mixed.up(stuff)'))
evals(list(c('no.R.object', 'no.R.function()', 'very.mixed.up(stuff)')), parse = FALSE)
evals(c('no.R.object', 'Old MacDonald had a farm\\dots', 'pi'))
evals('no.R.object;Old MacDonald had a farm\\dots;pi', parse = FALSE)
evals(list(c('no.R.object', 'Old MacDonald had a farm\\dots', 'pi')), parse = FALSE)
## graph options
evals('plot(1:10)')
evals('plot(1:10);plot(2:20)')
evals('plot(1:10)', graph.output = 'jpg')
evals('plot(1:10)', height = 800)
evals('plot(1:10)', height = 800, hi.res = TRUE)
evals('plot(1:10)', graph.output = 'pdf', hi.res = TRUE)
evals('plot(1:10)', res = 30)
evals('plot(1:10)', graph.name = 'myplot')
evals(list('plot(1:10)', 'plot(2:20)'), graph.name = 'myplots-%d')
evals('plot(1:10)', graph.env = TRUE)
evals('x <- runif(100);plot(x)', graph.env = TRUE)
evals(c('plot(1:10)', 'plot(2:20)'), graph.env = TRUE)
evals(c('x <- runif(100)', 'plot(x)','y <- runif(100)', 'plot(y)'), graph.env = TRUE)
evals(list(
c('x <- runif(100)', 'plot(x)'),
c('y <- runif(100)', 'plot(y)')),
graph.env = TRUE, parse = FALSE)
evals('plot(1:10)', graph.recordplot = TRUE)
## unprinted lattice plot
evals('histogram(mtcars$hp)', graph.recordplot = TRUE)
## caching
system.time(evals('plot(mtcars)'))
system.time(evals('plot(mtcars)')) # running again to see the speed-up :)
system.time(evals('plot(mtcars)', cache = FALSE)) # cache disabled
## caching mechanism does check what's inside a variable:
x <- mtcars
evals('plot(x)')
x <- cbind(mtcars, mtcars)
evals('plot(x)')
x <- mtcars
system.time(evals('plot(x)'))
## stress your CPU - only once!
evals('x <- sapply(rep(mtcars$hp, 1e3), mean)') # run it again!
## play with cache
require(lattice)
evals('histogram(rep(mtcars$hp, 1e5))')
## nor run the below call
## that would return the cached version of the above call :)
f <- histogram
g <- rep
A <- mtcars$hp
B <- 1e5
evals('f(g(A, B))')#'
## or switch off cache globally:
evalsOptions('cache', FALSE)
## and switch on later
evalsOptions('cache', TRUE)
## evaluate assignments inside call to evals
## changes to environments are cached properly and retreived
evalsOptions('cache.time', 0)
x <- 2
evals('x <- x^2')[[1]]$result
evals('x <- x^2; x + 1')[[2]]$result
evalsOptions('cache.time', 0.1)
## returning only a few classes
txt <- readLines(textConnection('rnorm(100)
list(x = 10:1, y = 'Godzilla!')
c(1,2,3)
matrix(0,3,5)'))
evals(txt, classes = 'numeric')
evals(txt, classes = c('numeric', 'list'))
## hooks
txt <- 'runif(1:4); matrix(runif(25), 5, 5); 1:5'
hooks <- list('numeric' = round, 'matrix' = pander_return)
evals(txt, hooks = hooks)
## using pander's default hook
evals(txt, hooks = list('default' = pander_return))
evals('22/7', hooks = list('numeric' = round))
evals('matrix(runif(25), 5, 5)', hooks = list('matrix' = round))
## setting default hook
evals(c('runif(10)', 'matrix(runif(9), 3, 3)'),
hooks = list('default'=round))
## round all values except for matrices
evals(c('runif(10)', 'matrix(runif(9), 3, 3)'),
hooks = list(matrix = 'print', 'default' = round))
# advanced hooks
hooks <- list('numeric' = list(round, 2), 'matrix' = list(round, 1))
evals(txt, hooks = hooks)
# return only returned values
evals(txt, output = 'result')
# return only messages (for checking syntax errors etc.)
evals(txt, output = 'msg')
# check the length of returned values and do not return looong R objects
evals('runif(10)', length = 5)
# note the following will not be filtered!
evals('matrix(1,1,1)', length = 1)
# if you do not want to let such things be eval-ed in the middle of a string
# use it with other filters :)
evals('matrix(1,1,1)', length = 1, classes = 'numeric')
# hooks & filtering
evals('matrix(5,5,5)',
hooks = list('matrix' = pander_return),
output = 'result')
# eval-ing chunks in given environment
myenv <- new.env()
evals('x <- c(0,10)', env = myenv)
evals('mean(x)', env = myenv)
rm(myenv)
# note: if you had not specified 'myenv', the second 'evals' would have failed
evals('x <- c(0,10)')
evals('mean(x)')
# log
x <- evals('1:10', log = 'foo')
# trace log
evalsOptions('cache.time', 0)
x <- evals('1:10', log = 'foo')
x <- evals('1:10', log = 'foo')
# log to file
t <- tempfile()
log_appender(appender_file(t), name = 'evals')
x <- evals('1:10', log = 'evals')
readLines(t)
# permanent log for all events
evalsOptions('log', 'evals')
log_threshold(TRACE, 'evals')
evals('foo')
# }
Run the code above in your browser using DataLab