evaluate/0000755000175100001440000000000013123411765012101 5ustar hornikusersevaluate/tests/0000755000175100001440000000000012667467753013267 5ustar hornikusersevaluate/tests/test-parse.R0000644000175100001440000000013112667470562015464 0ustar hornikuserslibrary(evaluate) # this should not signal an error evaluate('x <-', stop_on_error = 0) evaluate/tests/testthat/0000755000175100001440000000000012576636113015112 5ustar hornikusersevaluate/tests/testthat/test-graphics.r0000644000175100001440000001010712576632141020046 0ustar hornikuserscontext("Evaluation: graphics") test_that("single plot is captured", { ev <- evaluate(file("plot.r")) expect_that(length(ev), equals(2)) expect_that(classes(ev), equals(c("source", "recordedplot"))) }) test_that("ggplot is captured", { if (require("ggplot2", quietly = TRUE)) { ev <- evaluate(file("ggplot.r")) expect_that(length(ev), equals(3)) expect_that(classes(ev), equals(c("source", "source", "recordedplot"))) } }) test_that("plot additions are captured", { ev <- evaluate(file("plot-additions.r")) expect_that(length(ev), equals(4)) expect_that(classes(ev), equals(c("source", "recordedplot", "source", "recordedplot"))) }) test_that("blank plots by plot.new() are preserved", { ev <- evaluate(file("plot-new.r")) expect_that(length(ev), equals(10)) expect_that(classes(ev), equals(rep(c("source", "recordedplot"), 5))) }) test_that("base plots in a single expression are captured", { ev <- evaluate(file("plot-loop.r")) expect_that(length(ev), equals(4)) expect_that(classes(ev), equals(c("source", rep("recordedplot", 3)))) }) test_that("ggplot2 plots in a single expression are captured", { if (require("ggplot2", quietly = TRUE)) { ev <- evaluate(file("ggplot-loop.r")) expect_that(length(ev), equals(4)) expect_that(classes(ev), equals(c(rep("source", 2), rep("recordedplot", 2)))) } }) test_that("multirow graphics are captured only when complete", { ev <- evaluate(file("plot-multi.r")) expect_that(classes(ev), equals(c(rep("source", 5), "recordedplot"))) }) test_that("multirow graphics are captured on close", { ev <- evaluate(file("plot-multi-missing.r")) expect_that(classes(ev), equals(c(rep("source", 4), "recordedplot"))) }) test_that("plots are captured in a non-rectangular layout", { ev <- evaluate(file("plot-multi-layout.r")) expect_that(classes(ev), equals(rep(c("source", "recordedplot"), c(1, 3)))) ev <- evaluate(file("plot-multi-layout2.r")) expect_that(classes(ev), equals(rep(c("source", "recordedplot"), c(4, 2)))) }) test_that("changes in parameters don't generate new plots", { ev <- evaluate(file("plot-par.r")) expect_that(classes(ev), equals(c("source", "recordedplot", "source", "source", "recordedplot"))) }) test_that("plots in a loop are captured even the changes seem to be from par only", { ev <- evaluate(file("plot-par2.r")) expect_that(classes(ev), equals(c("source", "recordedplot")[c(1, 2, 1, 1, 2, 2, 2)])) }) test_that("strwidth()/strheight() should not produce new plots", { ev <- evaluate(file("plot-strwidth.r")) expect_that(classes(ev), equals(rep(c("source", "recordedplot"), c(4, 1)))) }) test_that("clip() does not produce new plots", { ev <- evaluate(file("plot-clip.r")) expect_that(classes(ev), equals(c("source", "recordedplot")[c(1, 2, 1, 1, 2)])) }) test_that("perspective plots are captured", { ev <- evaluate(file("plot-persp.r")) expect_that(classes(ev), equals(rep(c("source", "recordedplot"), c(6, 3)))) }) test_that("an incomplete plot with a comment in the end is also captured", { ev <- evaluate(file("plot-last-comment.r")) expect_that(classes(ev), equals(rep(c("source", "recordedplot"), c(3, 1)))) }) # a bug report yihui/knitr#722 test_that("repeatedly drawing the same plot does not omit plots randomly", { expect_true(all(replicate(100, length(evaluate("plot(1:10)"))) == 2)) }) # test_that("no plot windows open", { # graphics.off() # expect_that(length(dev.list()), equals(0)) # evaluate(file("plot.r")) # expect_that(length(dev.list()), equals(0)) # }) test_that("by default, evaluate() always records plots regardless of the device", { op <- options(device = pdf) on.exit(options(op)) ev <- evaluate("plot(1)") expect_that(length(ev), equals(2)) }) test_that("Rplots.pdf files are not created", { op <- options(device = pdf) on.exit(options(op)) evaluate(file("plot.r")) expect_false(file.exists("Rplots.pdf")) }) evaluate/tests/testthat/plot-multi-layout.r0000644000175100001440000000022512576632141020712 0ustar hornikusersfor (j in 1:3) { layout(matrix(c(1, 2, 1, 3, 4, 4), 3, 2, byrow = TRUE)) plot(rnorm(10)) plot(rnorm(10)) plot(rnorm(10)) plot(rnorm(10)) } evaluate/tests/testthat/interleave-2.r0000644000175100001440000000004612576632141017567 0ustar hornikusersfor (i in 1:2) { plot(i) cat(i) } evaluate/tests/testthat/test-evaluate.r0000644000175100001440000000526212576632141020062 0ustar hornikuserscontext("Evaluation") test_that("file with only comments runs", { ev <- evaluate(file("comment.r")) expect_that(length(ev), equals(2)) expect_that(classes(ev), equals(c("source", "source"))) }) test_that("data sets loaded", { ev <- evaluate(file("data.r")) if (require("lattice", quietly = TRUE)) expect_that(length(ev), equals(3)) }) # # Don't know how to implement this # test_that("newlines escaped correctly", { # ev <- evaluate("cat('foo\n')") # expect_that(ev[[1]]$src, equals("cat('foo\\n'))")) # }) test_that("terminal newline not needed", { ev <- evaluate("cat('foo')") expect_that(length(ev), equals(2)) expect_that(ev[[2]], equals("foo")) }) test_that("S4 methods are displayed with show, not print", { setClass("A", contains = "function", where = environment()) setMethod("show", "A", function(object) cat("B")) a <- new('A', function() b) ev <- evaluate("a") expect_equal(ev[[2]], "B") }) test_that("errors during printing visible values are captured", { setClass("A", contains = "function", where = environment()) setMethod("show", "A", function(object) stop("B")) a <- new('A', function() b) ev <- evaluate("a") stopifnot("error" %in% class(ev[[2]])) }) test_that("options(warn = -1) suppresses warnings", { ev <- evaluate("op = options(warn = -1); warning('hi'); options(op)") expect_that(classes(ev), equals("source")) }) test_that("output and plots interleaved correctly", { ev <- evaluate(file("interleave-1.r")) expect_equal(classes(ev), c("source", "character", "recordedplot", "character", "recordedplot")) ev <- evaluate(file("interleave-2.r")) expect_equal(classes(ev), c("source", "recordedplot", "character", "recordedplot", "character")) }) test_that("return value of value handler inserted directly in output list", { ev <- evaluate(file("raw-output.r"), output_handler = new_output_handler(value = identity)) if (require("ggplot2", quietly = TRUE)) { expect_equal(classes(ev), c("source", "numeric", "source", "source", "source", "gg")) } }) test_that("invisible values can also be saved if value handler has two arguments", { handler <- new_output_handler(value = function(x, visible) { x # always returns a visible value }) ev <- evaluate("x<-1:10", output_handler = handler) expect_equal(classes(ev), c("source", "integer")) }) test_that("multiple expressions on one line can get printed as expected", { ev <- evaluate("x <- 1; y <- 2; x; y") expect_equal(classes(ev), c("source", "character", "character")) }) test_that("multiple lines of comments do not lose the terminating \\n", { ev <- evaluate("# foo\n#bar") expect_equal(ev[[1]][["src"]], "# foo\n") }) evaluate/tests/testthat/test-errors.r0000644000175100001440000000171512666412560017570 0ustar hornikuserscontext("Errors") test_that("all code run, even after error", { ev <- evaluate(file("error.r")) expect_that(length(ev), equals(4)) }) test_that("code aborts on error if stop_on_error == 1L", { ev <- evaluate(file("error.r"), stop_on_error = 1L) expect_that(length(ev), equals(2)) }) test_that("code errors if stop_on_error == 2L", { expect_error(evaluate(file("error.r"), stop_on_error = 2L), "1") }) test_that("traceback useful if stop_on_error == 2L", { expect_error(evaluate(file("error-complex.r"), stop_on_error = 2L), "Error") ## Doesn't work because .Traceback not create when code run ## inside try or tryCatch. Can't figure out how to work around. ## tryCatch(..., error = function(e) {}) doesn't have enough info ## in e, or in the call stack. options(error = function() {}) doesn't ## stop error propagation # expect_match(.Traceback[[2]], "h()") # expect_match(.Traceback[[3]], "g()") # expect_match(.Traceback[[4]], "f()") }) evaluate/tests/testthat/plot-new.r0000644000175100001440000000006712235534635017043 0ustar hornikusersplot.new() plot(1:10) plot.new() plot(1:10) plot.new() evaluate/tests/testthat/plot.r0000644000175100001440000000001312235534635016243 0ustar hornikusersplot(1:10) evaluate/tests/testthat/interleave-1.r0000644000175100001440000000004612576632141017566 0ustar hornikusersfor (i in 1:2) { cat(i) plot(i) } evaluate/tests/testthat/error-complex.r0000644000175100001440000000011312235534636020065 0ustar hornikusersf <- function() g() g <- function() h() h <- function() stop("Error") f() evaluate/tests/testthat/plot-additions.r0000644000175100001440000000002712235534636020225 0ustar hornikusersplot(1:10) lines(1:10) evaluate/tests/testthat/plot-clip.r0000644000175100001440000000013412235534636017175 0ustar hornikusersplot(rnorm(100), rnorm(100)) clip(-1, 1, -1, 1) points(rnorm(100), rnorm(100), col = 'red') evaluate/tests/testthat/plot-par2.r0000644000175100001440000000032612576632141017113 0ustar hornikusersbarplot(table(mtcars$mpg), main = "All") # should capture all plots in this loop for (numcyl in levels(as.factor(mtcars$cyl))) { barplot(table(mtcars$mpg[mtcars$cyl == numcyl]), main = paste("cyl = ", numcyl)) } evaluate/tests/testthat/comment.r0000644000175100001440000000011712235534636016735 0ustar hornikusers# This test case contains no executable code # but it shouldn't throw an error evaluate/tests/testthat/plot-last-comment.r0000644000175100001440000000007712576632141020655 0ustar hornikuserspar(mfrow = c(3, 3)) for (i in 1:7) image(volcano) # comment evaluate/tests/testthat/plot-multi-layout2.r0000644000175100001440000000031412576632141020773 0ustar hornikuserslayout(matrix(c(1, 2, 1, 3, 4, 4), 3, 2, byrow = TRUE)) # another expression before drawing the plots x <- 1 + 1 for (j in 1:2) { plot(rnorm(10)) plot(rnorm(10)) plot(rnorm(10)) plot(rnorm(10)) } evaluate/tests/testthat/error.r0000644000175100001440000000001412235534635016417 0ustar hornikusersstop("1") 2 evaluate/tests/testthat/raw-output.r0000644000175100001440000000016212235534635017421 0ustar hornikusersrnorm(10) x <- list("I'm a list!") suppressPackageStartupMessages(library(ggplot2)) qplot(mpg, wt, data = mtcars) evaluate/tests/testthat/order.r0000644000175100001440000000026212235534635016406 0ustar hornikuserscat("1\n") print("2") warning("3") print("4") message("5") stop("6") stop("7", call. = FALSE) f <- function(x) { print("8") message("9") warning("10") stop("11") } f() evaluate/tests/testthat/plot-multi.r0000644000175100001440000000006512235534635017402 0ustar hornikuserspar(mfrow = c(2, 2)) plot(1) plot(2) plot(3) plot(4) evaluate/tests/testthat/plot-loop.r0000644000175100001440000000004712512557531017217 0ustar hornikusersfor (i in 1:3) { plot(rnorm(100)) } evaluate/tests/testthat/parse.r0000644000175100001440000000012612576632141016403 0ustar hornikusersf <- function() { for (i in 1:3) { plot(rnorm(100)) lines(rnorm(100)) } } evaluate/tests/testthat/plot-par.r0000644000175100001440000000004512235534634017027 0ustar hornikusersplot(1) par(mar = rep(0, 4)) plot(2) evaluate/tests/testthat/test-output.r0000644000175100001440000000024512235534635017611 0ustar hornikuserscontext("Output") test_that("open plot windows maintained", { n <- length(dev.list()) evaluate(file("plot.r")) expect_that(length(dev.list()), equals(n)) }) evaluate/tests/testthat/test-output-handler.R0000644000175100001440000000074112316662535021166 0ustar hornikuserscontext("Output handlers") test_that("text output handler is called with text", { text <- NULL oh <- new_output_handler(text = function(o) text <<- o) evaluate("print('abc')", output_handler = oh) expect_equal(text, "[1] \"abc\"\n") }) test_that("graphic output handler not called with no graphics", { graphics <- NULL oh <- new_output_handler(graphics = function(o) graphics <<- 1) evaluate("print('abc')", output_handler = oh) expect_equal(graphics, NULL) }) evaluate/tests/testthat/ggplot-loop.r0000644000175100001440000000022112235534635017531 0ustar hornikuserssuppressPackageStartupMessages(library(ggplot2)) for (j in 1:2) { # ggplot2 has been loaded previously print(qplot(rnorm(30), runif(30))) } evaluate/tests/testthat/plot-strwidth.r0000644000175100001440000000014012576632141020111 0ustar hornikusersx <- strwidth('foo', 'inches') y <- strheight('foo', 'inches') par(mar = c(4, 4, 1, 1)) plot(1) evaluate/tests/testthat/data.r0000644000175100001440000000005112235534635016200 0ustar hornikusersdata(barley, package = "lattice") barley evaluate/tests/testthat/plot-persp.r0000644000175100001440000000031512576632141017376 0ustar hornikusersx <- seq(-10, 10, length = 30) y <- x ff <- function(x,y) { r <- sqrt(x^2 + y^2); 10 * sin(r) / r } z <- outer(x, y, ff) z[is.na(z)] <- 1 for (i in 1:3) { persp(x, y, z, phi = 30 + i * 10, theta = 30) } evaluate/tests/testthat/plot-multi-missing.r0000644000175100001440000000005512235534636021051 0ustar hornikuserspar(mfrow = c(2, 2)) plot(1) plot(2) plot(3) evaluate/tests/testthat/ggplot.r0000644000175100001440000000011712235534635016566 0ustar hornikuserssuppressPackageStartupMessages(library(ggplot2)) qplot(mpg, wt, data = mtcars) evaluate/tests/testthat/example-1.r0000644000175100001440000000042012235534635017060 0ustar hornikusers# These test cases check that interweave # works for a variety of situations a <- 1 # Comment after an expression b <- 2 { a b } # Here is a comment which should be followed # by two new lines { print(a) # comment in a block print(b) } a; b a; b # Comment evaluate/tests/testthat/test-parse.r0000644000175100001440000000155612667470507017377 0ustar hornikuserscontext("Parsing") test_that("{ not removed", { f <- function() { for (i in 1:3) { plot(rnorm(100)) lines(rnorm(100)) } } expect_that(nrow(parse_all(f)), equals(1)) }) test_that("parse(allow_error = TRUE/FALSE)", { expect_error(parse_all('x <-', allow_error = FALSE)) res <- parse_all('x <-', allow_error = TRUE) expect_true(inherits(attr(res, 'PARSE_ERROR'), 'error')) }) # test some multibyte characters when the locale is UTF8 based if (identical(Sys.getlocale("LC_CTYPE"), "en_US.UTF-8")) { test_that("double quotes in Chinese characters not destroyed", { expect_identical(parse_all(c('1+1', '"你好"'))[2, 1], '"你好"') }) test_that("multibyte characters are parsed correct", { code <- c("ϱ <- 1# g / ml", "äöüßÄÖÜπ <- 7 + 3# nonsense") expect_identical(parse_all(code)$src, append_break(code)) }) } evaluate/tests/test-replay.R0000644000175100001440000000027612576632141015650 0ustar hornikuserslibrary(evaluate) # replay() should work when print() returns visible NULLs print.FOO_BAR <- function(x, ...) NULL ret <- evaluate('structure(1, class = "FOO_BAR")') print(ret) replay(ret) evaluate/tests/test-all.R0000644000175100001440000000012312576632141015113 0ustar hornikuserslibrary(evaluate) if (require("testthat", quietly = TRUE)) test_check("evaluate") evaluate/NAMESPACE0000644000175100001440000000141613123276552013325 0ustar hornikusers# Generated by roxygen2: do not edit by hand S3method(parse_all,"function") S3method(parse_all,call) S3method(parse_all,character) S3method(parse_all,connection) S3method(parse_all,default) S3method(replay,character) S3method(replay,default) S3method(replay,error) S3method(replay,list) S3method(replay,message) S3method(replay,recordedplot) S3method(replay,source) S3method(replay,value) S3method(replay,warning) export(create_traceback) export(evaluate) export(flush_console) export(inject_funs) export(is.error) export(is.message) export(is.recordedplot) export(is.source) export(is.value) export(is.warning) export(new_output_handler) export(parse_all) export(replay) export(set_hooks) export(try_capture_stack) import(grDevices) import(graphics) import(stringr) import(utils) evaluate/NEWS0000644000175100001440000001763713123302300012576 0ustar hornikusersVersion 0.10.1 ------------------------------------------------------------------------------ * Added parse_all.call() method to use the original source for evaluating call objects (because base::deparse() breaks non-ascii source code) (fixes #74) Version 0.10 ------------------------------------------------------------------------------ * Added option for the evaluate function to include timing information of ran commands. This information will be subsequently rendered by the replay. Example usage: evaluate::replay(evaluate::evaluate('Sys.sleep(1)', include_timing = TRUE)) * Added a new function `flush_console()` to emulate `flush.console()` in `evaluate()` (#61). * Added a `inject_funs()` function to create functions in the environment passed to the `envir` argument of `evaluate()`. Version 0.9 ------------------------------------------------------------------------------ * Added an argument `allow_error` to `parse_all()` to allow syntactical errors in R source code when `allow_error = TRUE`; this means `evaluate(stop_on_error = 0 or 1)` will no longer stop on syntactical errors but returns a list of source code and the error object instead. This can be useful to show syntactical errors for pedagogical purposes. Version 0.8.3 ------------------------------------------------------------------------------ * Added an argument `filename` to evaluate() and parse_all() (thanks, @flying-sheep, #58). Version 0.8 ------------------------------------------------------------------------------ * Changed package license to MIT. Version 0.7.2 ------------------------------------------------------------------------------ * replay() fails to replay certain objects such as NULL (#53). Version 0.7 ------------------------------------------------------------------------------ * R 3.0.2 is the minimal required version for this package now. Version 0.6 ------------------------------------------------------------------------------ * Plots are no longer recorded when the current graphical device has been changed, which may introduce issues like yihui/knitr#824. * `parse_all()` can parse R code that contains multibyte characters correctly now (#49, yihui/knitr#988) Version 0.5.5 ------------------------------------------------------------------------------ * Actually use the `text` and `graphics` in `new_output_handler` * Multiple expressions separated by `;` on the same line can be printed as expected when the result returned is visible, e.g. both `x` and `y` will be printed when the source code is `x; y`. In previous versions, only `y` is printed. (thanks, Bill Venables) Version 0.5.3 ------------------------------------------------------------------------------ BUG FIXES * fixed the bug reported at https://github.com/yihui/knitr/issues/722 (repeatedly knitting the same code results in plots being omitted randomly) (thanks, Simon Urbanek) Version 0.5.1 ------------------------------------------------------------------------------ BUG FIXES * under R 2.15.x, evaluate() was unable to filter out the plots triggered by clip() (thanks, Uwe Ligges) Version 0.5 ------------------------------------------------------------------------------ NEW FEATURES * evaluate() is better at telling if a new plot should render a new page due to the new par('page') in R 3.0.2 BUG FIXES * fixed yihui/knitr#600: when the last expression in the code is a comment, the previous incomplete plot was not captured * the empty plots produced by strwidth(), strheight(), and clip() are no longer recorded MAJOR CHANGES * evaluate() no longer records warnings in case of options(warn = -1); see yihui/knitr#610 * for 'output_handler' in evaluate(), visible values from the 'value' handler will be saved to the output list; this makes it possible for users to save the original values instead of their printed side effects; this change will not affect those who use the default output handlers (#40, thanks, Gabriel Becker) * the 'value' handler in new_output_handler() may take an additional argument that means if the value is visible or not; this makes it possible to save the invisible values as well (#41, thanks, Joroen Ooms) Version 0.4.7 ------------------------------------------------------------------------------ NEW FEATURES * added two arguments keep_warning and keep_message in evaluate() so that it is possible not to capture warnings or messages now BUG FIXES * fixed #25: plots can be correctly recorded under a complex layout now (#25, thanks, Jack Tanner and Andy Barbour) * fixed yihui/knitr#582: evaluate() misclassified some plot changes as "par changes" and removed some plots when it should not; now it is better at identifying plot changes dur to par() (thanks, Keith Twombley) Version 0.4.4 ------------------------------------------------------------------------------ BUG FIXES * Perspective plots from `persp()` are captured now (thanks to Harvey Lime and Yihui Xie) * If an error occurs during printing a visible value, evaluate will halt on a cryptic error "operator is invalid for atomic vectors" (#26, fixed by Yihui Xie) * If the internal connection was accidentally closed by the user, a more informative message will show up (#23) * Now the graphical device will always try to record graphics by default (when new_device = TRUE) (#34) * Some empty and incomplete plots caused by par() or layout() will be filtered out correctly for R 3.0 (#35) MAINTAINENCE * Yihui Xie is the new maintainer of this package now Version 0.4.3 ------------------------------------------------------------------------------ NEW FEATURES * Added `output_handler` argument to `evaluate`. Should be a `output_handler` object, which is a list of functions for handling each type of result, prior to printing of visible return values. This allows clients to override the console-like printing of values, while still processing them in the correct temporal context. The other handlers are necessary to convey the correct ordering of the output. This essentially provides stream-based processing, as an alternative to the existing deferred processing. * New option, `stop_on_error` which controls behaviour when errors occur. The default value, `0`, acts like you've copied and pasted the code into the console, and continues to execute all code. `1` will stop the code execution and return the results of evaluation up to that point, and `2` will raise an error. BUG FIXES * Compound expressions like `x <- 10; x` are now evaluated completely. * Chinese characters on windows now work correctly (thanks to Yihui Xie) * Graphics and output interleaved correctly when generated from a loop or other compound statements * By default, `evaluate` will now open a new graphics device and clean it up afterwards. To suppress that behaviour use `new_device = FALSE` * use `show` to display S4 objects. Version 0.4.2 ------------------------------------------------------------------------------ * replace deprecated `.Internal(eval.with.vis)` with correct `withVisible` * `evaluate` gains `debug` argument Version 0.4.1 ------------------------------------------------------------------------------ * use `test_package` to avoid problems with latest version of `testthat` evaluate 0.4 (2011-11-03) ========================= * Use plot hooks to capture multiple plots created in a loop or within a function. (Contributed by Yihui Xie) evaluate 0.3 ============ * Import `stringr` instead of depending on it. * Test plot recording only in the presence of interactive devices. evaluate 0.2 ============ * try_capture_stack and create_traceback do a much better job of removing infrastructure calls from the captured traceback * visible results are automatically evaluated and their outputs are captured. This is particularly important for lattice and ggplot graphics, which otherwise require special handling. It also correctly captures warnings, errors and messages raised by the print method. evaluate/R/0000755000175100001440000000000013123276472012306 5ustar hornikusersevaluate/R/graphics.r0000644000175100001440000000357113017341055014267 0ustar hornikusers#" Capture snapshot of current device. #" #" There's currently no way to capture when a graphics device changes, #" except to check its contents after the evaluation of every expression. #" This means that only the last plot of a series will be captured. #" #" @return \code{NULL} if plot is blank or unchanged, otherwise the output of #" \code{\link[grDevices]{recordPlot}}. plot_snapshot <- local({ last_plot <- NULL function(incomplete = FALSE) { if (is.null(dev.list())) return(NULL) if (!incomplete && !par('page')) return(NULL) # current page not complete plot <- recordPlot() if (identical(last_plot, plot) || is_par_change(last_plot, plot)) { return(NULL) } if (is.empty(plot)) return(NULL) last_plot <<- plot plot } }) is_par_change <- function(p1, p2) { calls1 <- plot_calls(p1) calls2 <- plot_calls(p2) n1 <- length(calls1) n2 <- length(calls2) if (n2 <= n1) return(FALSE) i1 <- seq_len(n1) if (!identical(calls1, calls2[i1])) return(FALSE) # also check if the content of the display list is still the same (note we # need p1[[1]][] as well because [] turns a dotted pair list into a list) if (!identical(p1[[1]][i1], p2[[1]][i1])) return(FALSE) last <- calls2[(n1 + 1):n2] all(last %in% empty_calls) } # if all calls are in these elements, the plot is basically empty empty_calls <- c("layout", "par", "clip") empty_calls <- c( "palette", "palette2", sprintf("C_%s", c(empty_calls, "strWidth", "strHeight", "plot_window")) ) is.empty <- function(x) { if (is.null(x)) return(TRUE) pc <- plot_calls(x) if (length(pc) == 0) return(TRUE) all(pc %in% empty_calls) } plot_calls <- function(plot) { el <- lapply(plot[[1]], "[[", 2) if (length(el) == 0) return() sapply(el, function(x) { x <- x[[1]] # grid graphics do not have x$name if (is.null(x[["name"]])) deparse(x) else x[["name"]] }) } evaluate/R/traceback.r0000644000175100001440000000235012235534714014407 0ustar hornikusers#' Generate a traceback from a list of calls. #' #' @param callstack stack of calls, as generated by (e.g.) #' \code{\link[base]{sys.calls}} #' @keywords internal #' @export create_traceback <- function(callstack) { if (length(callstack) == 0) return() # Convert to text calls <- lapply(callstack, deparse, width = 500) calls <- sapply(calls, str_c, collapse = "\n") # Number and indent calls <- str_c(seq_along(calls), ": ", calls) calls <- str_replace(calls, "\n", "\n ") calls } #' Try, capturing stack on error. #' #' This is a variant of \code{\link{tryCatch}} that also captures the call #' stack if an error occurs. #' #' @param quoted_code code to evaluate, in quoted form #' @param env environment in which to execute code #' @keywords internal #' @export try_capture_stack <- function(quoted_code, env) { capture_calls <- function(e) { # Capture call stack, removing last two calls from end (added by # withCallingHandlers), and first frame + 7 calls from start (added by # tryCatch etc) e$calls <- head(sys.calls()[-seq_len(frame + 7)], -2) signalCondition(e) } frame <- sys.nframe() tryCatch( withCallingHandlers(eval(quoted_code, env), error = capture_calls), error = identity ) } evaluate/R/replay.r0000644000175100001440000000540312762177310013766 0ustar hornikusers#' Replay a list of evaluated results. #' #' Replay a list of evaluated results, as if you'd run them in an R #' terminal. #' #' @param x result from \code{\link{evaluate}} #' @export #' @examples #' samples <- system.file("tests", "testthat", package = "evaluate") #' if (file_test("-d", samples)) { #' replay(evaluate(file(file.path(samples, "order.r")))) #' replay(evaluate(file(file.path(samples, "plot.r")))) #' replay(evaluate(file(file.path(samples, "data.r")))) #' } replay <- function(x) UseMethod("replay", x) #' @export replay.list <- function(x) { invisible(lapply(x, replay)) } #' @export replay.default <- function(x) { render(x) } #' @export replay.character <- function(x) { cat(x) } #' @export replay.source <- function(x) { s <- if (is.null(attr(x$src,'timing'))) '' else render_timing(attr(x$src, 'timing')) cat(str_c(s, line_prompt(x$src))) } #' @export replay.warning <- function(x) { message("Warning message:\n", x$message) } #' @export replay.message <- function(x) { message(str_replace(x$message, "\n$", "")) } #' @export replay.error <- function(x) { if (is.null(x$call)) { message("Error: ", x$message) } else { call <- deparse(x$call) message("Error in ", call, ": ", x$message) } } #' @export replay.value <- function(x) { if (x$visible) print(x$value) } #' @export replay.recordedplot <- function(x) { print(x) } render_timing <- function(t) { if (max(t) < 0.5) '' else paste0( '[', render_sec(t[[1]] + t[[2]]), # User time + Kernel time ',', render_sec(t[[3]]), # Wall time ']' ) } render_sec <- function(s) { if (s < 0.005) return('<5ms') if (s < 1) return(paste0(round(s,2), 's')) if (s < 10) return(paste0(round(s,1), 's')) sec <- round(s,0) if (sec < 120) return(paste0(sec, 's')) min <- floor(sec/60) sec <- sec - min*60 if (min < 10) return(paste0( min, 'm', formatC(sec, digits = 0, width = 2, format = "f", flag = "0"), 's' )) min <- min + round(sec/60, 0) if (min < 120) return(paste0(min, 'm')) h <- floor(min/60) min <- min - h * 60 if (h < 48) return(paste0( h, 'h', formatC(min, digits = 0, width = 2, format = "f", flag = "0"), 'm' )) d <- floor(h/24) h <- h - d*24 return(paste0(d, 'd', h, 'h')) } #' Line prompt. #' #' Format a single expression as if it had been entered at the command prompt. #' #' @param x string representing a single expression #' @param prompt prompt for first line #' @param continue prompt for subsequent lines #' @keywords internal #' @return a string line_prompt <- function(x, prompt = getOption("prompt"), continue = getOption("continue")) { lines <- strsplit(x, "\n")[[1]] n <- length(lines) lines[1] <- str_c(prompt, lines[1]) if (n > 1) lines[2:n] <- str_c(continue, lines[2:n]) str_c(lines, "\n", collapse = "") } evaluate/R/eval.r0000644000175100001440000002146012775634651013434 0ustar hornikusers#' Evaluate input and return all details of evaluation. #' #' Compare to \code{\link{eval}}, \code{evaluate} captures all of the #' information necessary to recreate the output as if you had copied and pasted #' the code into a R terminal. It captures messages, warnings, errors and #' output, all correctly interleaved in the order in which they occured. It #' stores the final result, whether or not it should be visible, and the #' contents of the current graphics device. #' #' @export #' @param input input object to be parsed and evaluated. May be a string, file #' connection or function. #' @param envir environment in which to evaluate expressions. #' @param enclos when \code{envir} is a list or data frame, this is treated as #' the parent environment to \code{envir}. #' @param debug if \code{TRUE}, displays information useful for debugging, #' including all output that evaluate captures. #' @param stop_on_error if \code{2}, evaluation will halt on first error and you #' will get no results back. If \code{1}, evaluation will stop on first error #' without signaling the error, and you will get back all results up to that #' point. If \code{0} will continue running all code, just as if you'd pasted #' the code into the command line. #' @param keep_warning,keep_message whether to record warnings and messages. #' @param new_device if \code{TRUE}, will open a new graphics device and #' automatically close it after completion. This prevents evaluation from #' interfering with your existing graphics environment. #' @param output_handler an instance of \code{\link{output_handler}} that #' processes the output from the evaluation. The default simply prints the #' visible return values. #' @param filename string overrriding the \code{\link[base]{srcfile}} filename. #' @param include_timing if \code{TRUE}, evaluate will wrap each input #' expression in \code{system.time()}, which will be accessed by following #' \code{replay()} call to produce timing information for each evaluated #' command. #' @import graphics grDevices stringr utils evaluate <- function(input, envir = parent.frame(), enclos = NULL, debug = FALSE, stop_on_error = 0L, keep_warning = TRUE, keep_message = TRUE, new_device = TRUE, output_handler = default_output_handler, filename = NULL, include_timing = FALSE) { stop_on_error <- as.integer(stop_on_error) stopifnot(length(stop_on_error) == 1) parsed <- parse_all(input, filename, stop_on_error != 2L) if (inherits(err <- attr(parsed, 'PARSE_ERROR'), 'error')) { source <- new_source(parsed$src) output_handler$source(source) output_handler$error(err) err$call <- NULL # the call is unlikely to be useful return(list(source, err)) } if (is.null(enclos)) { enclos <- if (is.list(envir) || is.pairlist(envir)) parent.frame() else baseenv() } if (new_device) { # Start new graphics device and clean up afterwards if (identical(grDevices::pdf, getOption("device"))) { dev.new(file = NULL) } else dev.new() dev.control(displaylist = "enable") dev <- dev.cur() on.exit(dev.off(dev)) } # clean up the last_plot object after an evaluate() call (cf yihui/knitr#722) on.exit(assign("last_plot", NULL, envir = environment(plot_snapshot)), add = TRUE) out <- vector("list", nrow(parsed)) for (i in seq_along(out)) { expr <- parsed$expr[[i]] if (!is.null(expr)) expr <- as.expression(expr) out[[i]] <- evaluate_call( expr, parsed$src[[i]], envir = envir, enclos = enclos, debug = debug, last = i == length(out), use_try = stop_on_error != 2L, keep_warning = keep_warning, keep_message = keep_message, output_handler = output_handler, include_timing = include_timing) if (stop_on_error > 0L) { errs <- vapply(out[[i]], is.error, logical(1)) if (!any(errs)) next if (stop_on_error == 1L) break } } unlist(out, recursive = FALSE, use.names = FALSE) } evaluate_call <- function(call, src = NULL, envir = parent.frame(), enclos = NULL, debug = FALSE, last = FALSE, use_try = FALSE, keep_warning = TRUE, keep_message = TRUE, output_handler = new_output_handler(), include_timing = FALSE) { if (debug) message(src) if (is.null(call) && !last) { source <- new_source(src) output_handler$source(source) return(list(source)) } stopifnot(is.call(call) || is.language(call) || is.atomic(call)) # Capture output w <- watchout(debug) on.exit(w$close()) source <- new_source(src) output_handler$source(source) output <- list(source) dev <- dev.cur() handle_output <- function(plot = FALSE, incomplete_plots = FALSE) { # if dev.cur() has changed, we should not record plots any more plot <- plot && identical(dev, dev.cur()) out <- w$get_new(plot, incomplete_plots, output_handler$text, output_handler$graphics) output <<- c(output, out) } flush_old <- .env$flush_console; on.exit({ .env$flush_console <- flush_old }, add = TRUE) .env$flush_console <- function() handle_output(FALSE) # Hooks to capture plot creation capture_plot <- function() { handle_output(TRUE) } old_hooks <- set_hooks(list( persp = capture_plot, before.plot.new = capture_plot, before.grid.newpage = capture_plot)) on.exit(set_hooks(old_hooks, "replace"), add = TRUE) handle_condition <- function(cond) { handle_output() output <<- c(output, list(cond)) } # Handlers for warnings, errors and messages wHandler <- if (keep_warning) function(wn) { if (getOption("warn") >= 0) { handle_condition(wn) output_handler$warning(wn) } invokeRestart("muffleWarning") } else identity eHandler <- if (use_try) function(e) { handle_condition(e) output_handler$error(e) } else identity mHandler <- if (keep_message) function(m) { handle_condition(m) output_handler$message(m) invokeRestart("muffleMessage") } else identity ev <- list(value = NULL, visible = FALSE) if (use_try) { handle <- function(f) try(f, silent = TRUE) } else { handle <- force } value_handler <- output_handler$value if (include_timing) { timing_fn <- function(x) system.time(x)[1:3] } else { timing_fn <- function(x) {x; NULL}; } if (length(funs <- .env$inject_funs)) { funs_names <- names(funs) funs_new <- !vapply(funs_names, exists, logical(1), envir, inherits = FALSE) funs_names <- funs_names[funs_new] funs <- funs[funs_new] on.exit(rm(list = funs_names, envir = envir), add = TRUE) for (i in seq_along(funs_names)) assign(funs_names[i], funs[[i]], envir) } multi_args <- length(formals(value_handler)) > 1 for (expr in call) { srcindex <- length(output) time <- timing_fn(handle(ev <- withCallingHandlers( withVisible(eval(expr, envir, enclos)), warning = wHandler, error = eHandler, message = mHandler))) handle_output(TRUE) if (!is.null(time)) attr(output[[srcindex]]$src, 'timing') <- time # If visible or the value handler has multi args, process and capture output if (ev$visible || multi_args) { pv <- list(value = NULL, visible = FALSE) value_fun <- if (multi_args) value_handler else { function(x, visible) value_handler(x) } handle(pv <- withCallingHandlers(withVisible( value_fun(ev$value, ev$visible) ), warning = wHandler, error = eHandler, message = mHandler)) handle_output(TRUE) # If the return value is visible, save the value to the output if (pv$visible) output <- c(output, list(pv$value)) } } # Always capture last plot, even if incomplete if (last) { handle_output(TRUE, TRUE) } output } #' Inject functions into the environment of \code{evaluate()} #' #' Create functions in the environment specified in the \code{envir} argument of #' \code{evaluate()}. This can be helpful if you want to substitute certain #' functions when evaluating the code. To make sure it does not wipe out #' existing functions in the environment, only functions that do not exist in #' the environment are injected. #' @param ... Named arguments of functions. If empty, previously injected #' functions will be emptied. #' @note For expert use only. Do not use it unless you clearly understand it. #' @keywords internal #' @examples library(evaluate) #' # normally you cannot capture the output of system #' evaluate("system('R --version')") #' #' # replace the system() function #' inject_funs(system = function(...) cat(base::system(..., intern = TRUE), sep = '\n')) #' #' evaluate("system('R --version')") #' #' inject_funs() # empty previously injected functions #' @export inject_funs <- function(...) { funs <- list(...) funs <- funs[names(funs) != ''] .env$inject_funs <- Filter(is.function, funs) } evaluate/R/hooks.r0000644000175100001440000000146012235534714013614 0ustar hornikusers#' Set hooks. #' #' This wraps the base \code{\link{setHook}} function to provide a return #' value that makes it easy to undo. #' #' @param hooks a named list of hooks - each hook can either be a function or #' a list of functions. #' @param action \code{"replace"}, \code{"append"} or \code{"prepend"} #' @keywords internal #' @export #' @examples #' new <- list(before.plot.new = function() print("Plotted!")) #' hooks <- set_hooks(new) #' plot(1) #' set_hooks(hooks, "replace") #' plot(1) set_hooks <- function(hooks, action = "append") { stopifnot(is.list(hooks)) stopifnot(!is.null(names(hooks)) && all(names(hooks) != "")) old <- list() for (hook_name in names(hooks)) { old[[hook_name]] <- getHook(hook_name) setHook(hook_name, hooks[[hook_name]], action = action) } invisible(old) } evaluate/R/watcher.r0000644000175100001440000000432112775623064014133 0ustar hornikusers#' Watch for changes in output, text and graphical. #' #' @param debug activate debug mode where output will be both printed to #' screen and captured. #' @return list containing four functions: \code{get_new}, \code{pause}, #' \code{unpause}, \code{close}. #' @keywords internal watchout <- function(debug = FALSE) { output <- character() prev <- character() con <- textConnection("output", "wr", local = TRUE) sink(con, split = debug) list( get_new = function(plot = FALSE, incomplete_plots = FALSE, text_callback = identity, graphics_callback = identity) { incomplete <- isIncomplete(con) if (incomplete) cat("\n") out <- list() if (plot) { out$graphics <- plot_snapshot(incomplete_plots) if (!is.null(out$graphics)) graphics_callback(out$graphics) } n0 <- length(prev) n1 <- length(output) if (n1 > n0) { new <- output[n0 + seq_len(n1 - n0)] prev <<- output out$text <- str_c(new, collapse = "\n") if (!incomplete) out$text <- str_c(out$text, "\n") text_callback(out$text) } unname(out) }, pause = function() sink(), unpause = function() sink(con, split = debug), close = function() { if (!isOpen(con)) stop("something bad happened... did you use closeAllConnections()?") sink() close(con) output } ) } .env = new.env() .env$flush_console = function() {} #' An emulation of flush.console() in evaluate() #' #' When \code{evaluate()} is evaluating code, the text output is diverted into #' an internal connection, and there is no way to flush that connection. This #' function provides a way to "flush" the connection so that any text output can #' be immediately written out, and more importantly, the \code{text} handler #' (specified in the \code{output_handler} argument of \code{evaluate()}) will #' be called, which makes it possible for users to know it when the code #' produces text output using the handler. #' @note This function is supposed to be called inside \code{evaluate()} (e.g. #' either a direct \code{evaluate()} call or in \pkg{knitr} code chunks). #' @export flush_console = function() .env$flush_console() evaluate/R/output.r0000644000175100001440000000667212776776677014075 0ustar hornikusers#' Object class tests #' @export is.message is.warning is.error is.value is.source is.recordedplot #' @aliases is.message is.warning is.error is.value is.source is.recordedplot #' @keywords internal #' @rdname is.message is.message <- function(x) inherits(x, "message") #' @rdname is.message is.warning <- function(x) inherits(x, "warning") #' @rdname is.message is.error <- function(x) inherits(x, "error") #' @rdname is.message is.value <- function(x) inherits(x, "value") #' @rdname is.message is.source <- function(x) inherits(x, "source") #' @rdname is.message is.recordedplot <- function(x) inherits(x, "recordedplot") new_value <- function(value, visible = TRUE) { structure(list(value = value, visible = visible), class = "value") } new_source <- function(src) { structure(list(src = src), class = "source") } classes <- function(x) vapply(x, function(x) class(x)[1], character(1)) render <- function(x) if (isS4(x)) methods::show(x) else print(x) #' Custom output handlers. #' #' An \code{output_handler} handles the results of \code{\link{evaluate}}, #' including the values, graphics, conditions. Each type of output is handled by #' a particular function in the handler object. #' #' The handler functions should accept an output object as their first argument. #' The return value of the handlers is ignored, except in the case of the #' \code{value} handler, where a visible return value is saved in the output #' list. #' #' Calling the constructor with no arguments results in the default handler, #' which mimics the behavior of the console by printing visible values. #' #' Note that recursion is common: for example, if \code{value} does any #' printing, then the \code{text} or \code{graphics} handlers may be called. #' #' @param source Function to handle the echoed source code under evaluation. #' @param text Function to handle any textual console output. #' @param graphics Function to handle graphics, as returned by #' \code{\link{recordPlot}}. #' @param message Function to handle \code{\link{message}} output. #' @param warning Function to handle \code{\link{warning}} output. #' @param error Function to handle \code{\link{stop}} output. #' @param value Function to handle the values returned from evaluation. If it #' only has one argument, only visible values are handled; if it has more #' arguments, the second argument indicates whether the value is visible. #' @return A new \code{output_handler} object #' @aliases output_handler #' @export new_output_handler <- function(source = identity, text = identity, graphics = identity, message = identity, warning = identity, error = identity, value = render) { source <- match.fun(source) stopifnot(length(formals(source)) >= 1) text <- match.fun(text) stopifnot(length(formals(text)) >= 1) graphics <- match.fun(graphics) stopifnot(length(formals(graphics)) >= 1) message <- match.fun(message) stopifnot(length(formals(message)) >= 1) warning <- match.fun(warning) stopifnot(length(formals(warning)) >= 1) error <- match.fun(error) stopifnot(length(formals(error)) >= 1) value <- match.fun(value) stopifnot(length(formals(value)) >= 1) structure(list(source = source, text = text, graphics = graphics, message = message, warning = warning, error = error, value = value), class = "output_handler") } default_output_handler <- new_output_handler() evaluate/R/parse.r0000644000175100001440000001361713123276472013613 0ustar hornikusers#' Parse, retaining comments. #' #' Works very similarly to parse, but also keeps original formatting and #' comments. #' #' @param x object to parse. Can be a string, a file connection, or a function #' @param filename string overriding the file name #' @param allow_error whether to allow syntax errors in \code{x} #' @return A data.frame with columns \code{src}, the source code, and #' \code{expr}. If there are syntax errors in \code{x} and \code{allow_error = #' TRUE}, the data frame has an attribute \code{PARSE_ERROR} that stores the #' error object. #' @export parse_all <- function(x, filename = NULL, allow_error = FALSE) UseMethod("parse_all") #' @export parse_all.character <- function(x, filename = NULL, allow_error = FALSE) { # Do not convert strings to factors by default in data.frame() op <- options(stringsAsFactors = FALSE) on.exit(options(op), add = TRUE) if (length(grep("\n", x))) x <- unlist(str_split(x, "\n"), recursive = FALSE, use.names = FALSE) n <- length(x) if (is.null(filename)) filename <- "" src <- srcfilecopy(filename, x) if (allow_error) { exprs <- tryCatch(parse(text = x, srcfile = src), error = identity) if (inherits(exprs, 'error')) return(structure( data.frame(src = paste(x, collapse = '\n'), expr = I(list(expression()))), PARSE_ERROR = exprs )) } else { exprs <- parse(text = x, srcfile = src) } # No code, only comments and/or empty lines ne <- length(exprs) if (ne == 0) { return(data.frame(src = append_break(x), expr = I(rep(list(NULL), n)))) } srcref <- attr(exprs, "srcref", exact = TRUE) # Stard/End line numbers of expressions pos <- do.call(rbind, lapply(srcref, unclass))[, c(1, 3), drop = FALSE] l1 <- pos[, 1] l2 <- pos[, 2] # Add a third column i to store the indices of expressions pos <- cbind(pos, i = seq_len(nrow(pos))) pos <- as.data.frame(pos) # split() does not work on matrices # Split line number pairs into groups: if the next start line is the same as # the last end line, the two expressions must belong to the same group spl <- cumsum(c(TRUE, l1[-1] != l2[-ne])) # Extract src lines and expressions for each group; also record the start line # number of this group so we can re-order src/expr later res <- lapply(split(pos, spl), function(p) { n <- nrow(p) data.frame( src = paste(x[p[1, 1]:p[n, 2]], collapse = "\n"), expr = I(list(exprs[p[, 3]])), line = p[1, 1] ) }) # Now process empty expressions (comments/blank lines); see if there is a # "gap" between the last end number + 1 and the next start number - 1 pos <- cbind(c(1, l2 + 1), c(l1 - 1, n)) pos <- pos[pos[, 1] <= pos[, 2], , drop = FALSE] # Extract src lines from the gaps, and assign empty expressions to them res <- c(res, lapply(seq_len(nrow(pos)), function(i) { p <- pos[i, ] r <- p[1]:p[2] data.frame( src = x[r], expr = I(rep(list(NULL), p[2] - p[1] + 1)), line = r - 1 ) })) # Bind everything into a data frame, order it by line numbers, append \n to # all src lines except the last one, and remove the line numbers res <- do.call(rbind, res) res <- res[order(res$line), ] res$src <- append_break(res$src) res$line <- NULL # For compatibility with evaluate (<= 0.5.7): remove the last empty line (YX: # I think this is a bug) n <- nrow(res) if (res$src[n] == "") res <- res[-n, ] rownames(res) <- NULL res } # YX: It seems evaluate (<= 0.5.7) had difficulties with preserving line breaks, # so it ended up with adding \n to the first n-1 lines, which does not seem to # be necessary to me, and is actually buggy. I'm not sure if it is worth shaking # the earth and work with authors of reverse dependencies to sort this out. Also # see #42. append_break <- function(x) { n <- length(x) if (n <= 1) x else paste(x, rep(c("\n", ""), c(n - 1, 1)), sep = "") } # YX: This hack is because srcfilecopy() uses grepl("\n", fixed = TRUE), which # does not work when the source lines contain multibyte characters that are not # representable in the current locale on Windows (see # https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=16264). In our case, we # have already split the lines by \n, so there is no need to do that again like # srcfilecopy() does internally. if (getRversion() <= '3.2.2') srcfilecopy <- function(filename, lines, ...) { src <- base::srcfilecopy(filename, lines = "", ...) src$lines <- lines src } #' @export parse_all.connection <- function(x, filename = NULL, ...) { if (!isOpen(x, "r")) { open(x, "r") on.exit(close(x)) } text <- readLines(x) if (is.null(filename)) filename <- summary(x)$description parse_all(text, filename, ...) } #' @export parse_all.function <- function(x, filename = NULL, ...) { src <- attr(x, "srcref", exact = TRUE) if (is.null(src)) { src <- deparse(body(x)) # Remove { and } n <- length(src) if (n >= 2) src <- src[-c(1, n)] if (is.null(filename)) filename <- "" parse_all(src, filename, ...) } else { src2 <- attr(body(x), "srcref", exact = TRUE) n <- length(src2) if (n > 0) { if (is.null(filename)) filename <- attr(src, 'srcfile')$filename if (n >= 2) { parse_all(unlist(lapply(src2[-1], as.character)), filename, ...) } else { # f <- function(...) {} parse_all(character(0), filename, ...) } } else { if (is.null(filename)) filename <- "" parse_all(deparse(body(x)), filename, ...) } } } #' @export parse_all.default <- function(x, filename = NULL, ...) { if (is.null(filename)) filename <- "" parse_all(deparse(x), filename, ...) } # Calls are already parsed and always length one #' @export parse_all.call <- function(x, filename = NULL, ...) { expr <- list(as.expression(x)) src <- deparse(x) out <- data.frame(src = src, stringsAsFactors = FALSE) out$expr <- expr out } evaluate/MD50000644000175100001440000000640713123411765012420 0ustar hornikusersa9a1efcdb82bbcbc5f08449ff49bc94a *DESCRIPTION 5d74770859214f3b20c7bd9a25cfb2a7 *LICENSE 39bb6965609fd35533d51c4823214ada *NAMESPACE f908a1168924c385244666bd697e41ec *NEWS 557c7937fa25ebd7fa8c7d3e9435451b *R/eval.r aafc2bed34385af43269af8e64f1e01e *R/graphics.r 92ff4620dde1944914335f47d5d71b1f *R/hooks.r ec72e3ca7f14677e8f3018a1be7f54d8 *R/output.r 0e3511c3b79576aabb2ef5fc221aa786 *R/parse.r e8e364a4ff2df3073c15b4c0a65c7c49 *R/replay.r 97f0d9e1b50256566a00cc6041282e35 *R/traceback.r 1bcf653622a35ca8e93d23bdf65358e3 *R/watcher.r 5840d788c29331ac36f38bb6fd589582 *man/create_traceback.Rd 045ce3dd6156a56204665abedf6b257a *man/evaluate.Rd e7c847691a5500d7af92be4f0c2094ed *man/flush_console.Rd e7a0eef3506522bc512c04d6f0b47a19 *man/inject_funs.Rd f691c0cd4e779c1d5ee5ed8fd572dedd *man/is.message.Rd 9346c6d63cef05f64a62f61926b3123b *man/line_prompt.Rd 338034f5fe6c166911ea7572172914a1 *man/new_output_handler.Rd fcdf2e563e8be4c067ee47d77c3c568a *man/parse_all.Rd 3ecef423e3d0e6d9860b502e97ba7f1a *man/replay.Rd 11ebe2d62c935b3af826cc57d28eb1fa *man/set_hooks.Rd 6e6867d4af1f927ed78f7fb85e885d8e *man/try_capture_stack.Rd f95a92858a12cb6f6c9b7384d43ada6c *man/watchout.Rd 7d1137c5d46bfb4567e5300009945ca2 *tests/test-all.R 35c21d767406d7a49427a2faf25c3ddd *tests/test-parse.R 7916e1d386024a89d6e8c8e5aa061bd7 *tests/test-replay.R 446d67f5fc9a97626f757fae3fefcee7 *tests/testthat/comment.r 94750480cbfd8455ba433ab42828023e *tests/testthat/data.r 38a0bd49c764aefce15f4844036ccf02 *tests/testthat/error-complex.r fea574ba53709e7b38a294d855011323 *tests/testthat/error.r 24e9ae27434864fdef5901807e66ea98 *tests/testthat/example-1.r 19234a68f3630d7690a8232714fa5d04 *tests/testthat/ggplot-loop.r 9792e29336dfe5fe654b91a231d4bd1e *tests/testthat/ggplot.r 7f8df2eafe897d4ef3984fa881276903 *tests/testthat/interleave-1.r c46d014984f40ebdad0ee83a4c0b0666 *tests/testthat/interleave-2.r c887105bd174693b5ab37f3c1e92ec10 *tests/testthat/order.r 237f9f25bfab96f6928e6f29297c4827 *tests/testthat/parse.r ea5f897a7a8a861dffbfb4a97f4ba666 *tests/testthat/plot-additions.r 9cf8a8768e36e0e4b9f33c7dae3e2a29 *tests/testthat/plot-clip.r 3eb3a37b6b99567c00e9e252d3cfc079 *tests/testthat/plot-last-comment.r 396ff3413370398b3be86fa9a27ae235 *tests/testthat/plot-loop.r e4085acac5469333f8615cf24ba3c2a8 *tests/testthat/plot-multi-layout.r af1fd71e6872ce27f380da68d9e57638 *tests/testthat/plot-multi-layout2.r 2f5434a4a5a4a9fa0164c21ee9ec52f4 *tests/testthat/plot-multi-missing.r 4b9fd50ee21d4f3da6332ffed48746cb *tests/testthat/plot-multi.r b4952448dc702d1ce95cb57b8d2660f5 *tests/testthat/plot-new.r 6013de5aae712457dedf5a949395a7b4 *tests/testthat/plot-par.r ea7ff46a39730ce982233eb4a603329e *tests/testthat/plot-par2.r 9647c89b1105dba33f01d78992c1a5f8 *tests/testthat/plot-persp.r 07096b6184ee44418a18cbedbe4aa5b6 *tests/testthat/plot-strwidth.r 4cbfd1ffe04ab0562a2514f22a2e049d *tests/testthat/plot.r 7df061829daeba528956cfd392bac1e7 *tests/testthat/raw-output.r 8380a85c703130982fdd4710c0030c37 *tests/testthat/test-errors.r 2a8fab4e9a8727e85c431ea3afe4b16b *tests/testthat/test-evaluate.r 41bdf3d19acebc48429ac8120a79c757 *tests/testthat/test-graphics.r f558fc2fc0f097cdf455ad5cc1467240 *tests/testthat/test-output-handler.R f0dfe4d4709355498c1d03d06a149a7a *tests/testthat/test-output.r 56af2ed8ebfb5619225ca93b3a71b538 *tests/testthat/test-parse.r evaluate/DESCRIPTION0000644000175100001440000000217513123411765013614 0ustar hornikusersPackage: evaluate Type: Package Title: Parsing and Evaluation Tools that Provide More Details than the Default Version: 0.10.1 Date: 2017-06-24 Authors@R: c( person("Hadley", "Wickham", role = "aut"), person("Yihui", "Xie", role = c("cre", "ctb"), email = "xie@yihui.name"), person("Michael", "Lawrence", role = "ctb"), person("Thomas", "Kluyver", role = "ctb"), person("Barret", "Schloerke", role = "ctb"), person("Adam", "Ryczkowski", role = "ctb") ) Description: Parsing and evaluation tools that make it easy to recreate the command line behaviour of R. License: MIT + file LICENSE URL: https://github.com/hadley/evaluate BugReports: https://github.com/hadley/evaluate/issues Depends: R (>= 3.0.2) Imports: methods, stringr (>= 0.6.2) Suggests: testthat, lattice, ggplot2 RoxygenNote: 6.0.1 NeedsCompilation: no Packaged: 2017-06-23 22:15:15 UTC; yihui Author: Hadley Wickham [aut], Yihui Xie [cre, ctb], Michael Lawrence [ctb], Thomas Kluyver [ctb], Barret Schloerke [ctb], Adam Ryczkowski [ctb] Maintainer: Yihui Xie Repository: CRAN Date/Publication: 2017-06-24 07:25:41 UTC evaluate/man/0000755000175100001440000000000013123276552012657 5ustar hornikusersevaluate/man/line_prompt.Rd0000644000175100001440000000100213123311361015453 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/replay.r \name{line_prompt} \alias{line_prompt} \title{Line prompt.} \usage{ line_prompt(x, prompt = getOption("prompt"), continue = getOption("continue")) } \arguments{ \item{x}{string representing a single expression} \item{prompt}{prompt for first line} \item{continue}{prompt for subsequent lines} } \value{ a string } \description{ Format a single expression as if it had been entered at the command prompt. } \keyword{internal} evaluate/man/inject_funs.Rd0000644000175100001440000000210713123311361015441 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/eval.r \name{inject_funs} \alias{inject_funs} \title{Inject functions into the environment of \code{evaluate()}} \usage{ inject_funs(...) } \arguments{ \item{...}{Named arguments of functions. If empty, previously injected functions will be emptied.} } \description{ Create functions in the environment specified in the \code{envir} argument of \code{evaluate()}. This can be helpful if you want to substitute certain functions when evaluating the code. To make sure it does not wipe out existing functions in the environment, only functions that do not exist in the environment are injected. } \note{ For expert use only. Do not use it unless you clearly understand it. } \examples{ library(evaluate) # normally you cannot capture the output of system evaluate("system('R --version')") # replace the system() function inject_funs(system = function(...) cat(base::system(..., intern = TRUE), sep = "\\n")) evaluate("system('R --version')") inject_funs() # empty previously injected functions } \keyword{internal} evaluate/man/create_traceback.Rd0000644000175100001440000000062713123311361016401 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/traceback.r \name{create_traceback} \alias{create_traceback} \title{Generate a traceback from a list of calls.} \usage{ create_traceback(callstack) } \arguments{ \item{callstack}{stack of calls, as generated by (e.g.) \code{\link[base]{sys.calls}}} } \description{ Generate a traceback from a list of calls. } \keyword{internal} evaluate/man/evaluate.Rd0000644000175100001440000000444213123311361014744 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/eval.r \name{evaluate} \alias{evaluate} \title{Evaluate input and return all details of evaluation.} \usage{ evaluate(input, envir = parent.frame(), enclos = NULL, debug = FALSE, stop_on_error = 0L, keep_warning = TRUE, keep_message = TRUE, new_device = TRUE, output_handler = default_output_handler, filename = NULL, include_timing = FALSE) } \arguments{ \item{input}{input object to be parsed and evaluated. May be a string, file connection or function.} \item{envir}{environment in which to evaluate expressions.} \item{enclos}{when \code{envir} is a list or data frame, this is treated as the parent environment to \code{envir}.} \item{debug}{if \code{TRUE}, displays information useful for debugging, including all output that evaluate captures.} \item{stop_on_error}{if \code{2}, evaluation will halt on first error and you will get no results back. If \code{1}, evaluation will stop on first error without signaling the error, and you will get back all results up to that point. If \code{0} will continue running all code, just as if you'd pasted the code into the command line.} \item{keep_warning, keep_message}{whether to record warnings and messages.} \item{new_device}{if \code{TRUE}, will open a new graphics device and automatically close it after completion. This prevents evaluation from interfering with your existing graphics environment.} \item{output_handler}{an instance of \code{\link{output_handler}} that processes the output from the evaluation. The default simply prints the visible return values.} \item{filename}{string overrriding the \code{\link[base]{srcfile}} filename.} \item{include_timing}{if \code{TRUE}, evaluate will wrap each input expression in \code{system.time()}, which will be accessed by following \code{replay()} call to produce timing information for each evaluated command.} } \description{ Compare to \code{\link{eval}}, \code{evaluate} captures all of the information necessary to recreate the output as if you had copied and pasted the code into a R terminal. It captures messages, warnings, errors and output, all correctly interleaved in the order in which they occured. It stores the final result, whether or not it should be visible, and the contents of the current graphics device. } evaluate/man/replay.Rd0000644000175100001440000000114713123311361014431 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/replay.r \name{replay} \alias{replay} \title{Replay a list of evaluated results.} \usage{ replay(x) } \arguments{ \item{x}{result from \code{\link{evaluate}}} } \description{ Replay a list of evaluated results, as if you'd run them in an R terminal. } \examples{ samples <- system.file("tests", "testthat", package = "evaluate") if (file_test("-d", samples)) { replay(evaluate(file(file.path(samples, "order.r")))) replay(evaluate(file(file.path(samples, "plot.r")))) replay(evaluate(file(file.path(samples, "data.r")))) } } evaluate/man/parse_all.Rd0000644000175100001440000000136613123311361015102 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parse.r \name{parse_all} \alias{parse_all} \title{Parse, retaining comments.} \usage{ parse_all(x, filename = NULL, allow_error = FALSE) } \arguments{ \item{x}{object to parse. Can be a string, a file connection, or a function} \item{filename}{string overriding the file name} \item{allow_error}{whether to allow syntax errors in \code{x}} } \value{ A data.frame with columns \code{src}, the source code, and \code{expr}. If there are syntax errors in \code{x} and \code{allow_error = TRUE}, the data frame has an attribute \code{PARSE_ERROR} that stores the error object. } \description{ Works very similarly to parse, but also keeps original formatting and comments. } evaluate/man/set_hooks.Rd0000644000175100001440000000121013123311361015122 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hooks.r \name{set_hooks} \alias{set_hooks} \title{Set hooks.} \usage{ set_hooks(hooks, action = "append") } \arguments{ \item{hooks}{a named list of hooks - each hook can either be a function or a list of functions.} \item{action}{\code{"replace"}, \code{"append"} or \code{"prepend"}} } \description{ This wraps the base \code{\link{setHook}} function to provide a return value that makes it easy to undo. } \examples{ new <- list(before.plot.new = function() print("Plotted!")) hooks <- set_hooks(new) plot(1) set_hooks(hooks, "replace") plot(1) } \keyword{internal} evaluate/man/try_capture_stack.Rd0000644000175100001440000000073413123311361016664 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/traceback.r \name{try_capture_stack} \alias{try_capture_stack} \title{Try, capturing stack on error.} \usage{ try_capture_stack(quoted_code, env) } \arguments{ \item{quoted_code}{code to evaluate, in quoted form} \item{env}{environment in which to execute code} } \description{ This is a variant of \code{\link{tryCatch}} that also captures the call stack if an error occurs. } \keyword{internal} evaluate/man/watchout.Rd0000644000175100001440000000077113123311361014775 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/watcher.r \name{watchout} \alias{watchout} \title{Watch for changes in output, text and graphical.} \usage{ watchout(debug = FALSE) } \arguments{ \item{debug}{activate debug mode where output will be both printed to screen and captured.} } \value{ list containing four functions: \code{get_new}, \code{pause}, \code{unpause}, \code{close}. } \description{ Watch for changes in output, text and graphical. } \keyword{internal} evaluate/man/new_output_handler.Rd0000644000175100001440000000340313123311361017040 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/output.r \name{new_output_handler} \alias{new_output_handler} \alias{output_handler} \title{Custom output handlers.} \usage{ new_output_handler(source = identity, text = identity, graphics = identity, message = identity, warning = identity, error = identity, value = render) } \arguments{ \item{source}{Function to handle the echoed source code under evaluation.} \item{text}{Function to handle any textual console output.} \item{graphics}{Function to handle graphics, as returned by \code{\link{recordPlot}}.} \item{message}{Function to handle \code{\link{message}} output.} \item{warning}{Function to handle \code{\link{warning}} output.} \item{error}{Function to handle \code{\link{stop}} output.} \item{value}{Function to handle the values returned from evaluation. If it only has one argument, only visible values are handled; if it has more arguments, the second argument indicates whether the value is visible.} } \value{ A new \code{output_handler} object } \description{ An \code{output_handler} handles the results of \code{\link{evaluate}}, including the values, graphics, conditions. Each type of output is handled by a particular function in the handler object. } \details{ The handler functions should accept an output object as their first argument. The return value of the handlers is ignored, except in the case of the \code{value} handler, where a visible return value is saved in the output list. Calling the constructor with no arguments results in the default handler, which mimics the behavior of the console by printing visible values. Note that recursion is common: for example, if \code{value} does any printing, then the \code{text} or \code{graphics} handlers may be called. } evaluate/man/flush_console.Rd0000644000175100001440000000154413123311361016001 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/watcher.r \name{flush_console} \alias{flush_console} \title{An emulation of flush.console() in evaluate()} \usage{ flush_console() } \description{ When \code{evaluate()} is evaluating code, the text output is diverted into an internal connection, and there is no way to flush that connection. This function provides a way to "flush" the connection so that any text output can be immediately written out, and more importantly, the \code{text} handler (specified in the \code{output_handler} argument of \code{evaluate()}) will be called, which makes it possible for users to know it when the code produces text output using the handler. } \note{ This function is supposed to be called inside \code{evaluate()} (e.g. either a direct \code{evaluate()} call or in \pkg{knitr} code chunks). } evaluate/man/is.message.Rd0000644000175100001440000000075613123311361015200 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/output.r \name{is.message} \alias{is.message} \alias{is.warning} \alias{is.error} \alias{is.value} \alias{is.source} \alias{is.recordedplot} \alias{is.warning} \alias{is.error} \alias{is.value} \alias{is.source} \alias{is.recordedplot} \title{Object class tests} \usage{ is.message(x) is.warning(x) is.error(x) is.value(x) is.source(x) is.recordedplot(x) } \description{ Object class tests } \keyword{internal} evaluate/LICENSE0000644000175100001440000000007712666414234013117 0ustar hornikusersYEAR: 2008-2016 COPYRIGHT HOLDER: Hadley Wickham and Yihui Xie