From affa75404d7cada032a20aaf4a645103bf7b84b9 Mon Sep 17 00:00:00 2001 From: dmurdoch Date: Wed, 21 Apr 2021 14:42:48 -0400 Subject: [PATCH] export wrap() and is_low_change() to allow rgl (and other) graphics systems to work like base graphics (#1892) also closes #1853 Co-authored-by: Yihui Xie --- NAMESPACE | 3 +++ NEWS.md | 4 ++++ R/block.R | 6 +++--- R/output.R | 34 +++++++++++++++++++--------------- R/plot.R | 25 ++++++++++++++++++++++++- man/is_low_change.Rd | 31 +++++++++++++++++++++++++++++++ man/wrap.Rd | 20 ++++++++++++++++++++ 7 files changed, 104 insertions(+), 19 deletions(-) create mode 100644 man/is_low_change.Rd create mode 100644 man/wrap.Rd diff --git a/NAMESPACE b/NAMESPACE index 8625846443..c974ad0343 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,7 @@ # Generated by roxygen2: do not edit by hand S3method("$",knitr_strict_list) +S3method(is_low_change,default) S3method(knit_print,default) S3method(knit_print,knit_asis) S3method(knit_print,knitr_kable) @@ -70,6 +71,7 @@ export(include_url) export(inline_expr) export(is_html_output) export(is_latex_output) +export(is_low_change) export(kable) export(kables) export(knit) @@ -143,6 +145,7 @@ export(spin_child) export(stitch) export(stitch_rhtml) export(stitch_rmd) +export(wrap) export(wrap_rmd) export(write_bib) import(grDevices) diff --git a/NEWS.md b/NEWS.md index 54dad1dfe1..2523f107d3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # CHANGES IN knitr VERSION 1.33 +## NEW FEATURES + +- Exported the previously internal functions `wrap()` and `is_low_change()` to make it possible for other graphics systems such as **rgl** to work in **knitr** like base and grid graphics in base R (thanks, @dmurdoch, #1892 #1853). + ## BUG FIXES - Reverted the fix for #1595 since it caused problems in **kableExtra** (thanks, @bttomio, haozhu233/kableExtra#607), and applied a different fix to the original problem (i.e., add `{}` before `[`). diff --git a/R/block.R b/R/block.R index d06e1e4093..031fcd97a4 100644 --- a/R/block.R +++ b/R/block.R @@ -278,9 +278,8 @@ eng_r = function(options) { # number of plots in this chunk if (is.null(options$fig.num)) options$fig.num = if (length(res)) sum(sapply(res, function(x) { - if (evaluate::is.recordedplot(x)) return(1) if (inherits(x, 'knit_image_paths')) return(length(x)) - if (inherits(x, 'html_screenshot')) return(1) + if (is_plot_output(x)) return(1) 0 })) else 0L @@ -422,7 +421,8 @@ find_recordedplot = function(x) { } is_plot_output = function(x) { - evaluate::is.recordedplot(x) || inherits(x, 'knit_image_paths') + evaluate::is.recordedplot(x) || + inherits(x, c('knit_image_paths', 'html_screenshot', 'knit_other_plot')) } # move plots before source code diff --git a/R/output.R b/R/output.R index ba62b9005d..5ee5db44b1 100644 --- a/R/output.R +++ b/R/output.R @@ -428,25 +428,29 @@ knit_log = new_defaults() # knitr log for errors, warnings and messages #' Wrap evaluated results for output #' -#' @param x output from \code{evaluate::\link{evaluate}()} -#' @param options List of options used to control output -#' @noRd +#' This function is mainly for internal use: it is called on each part of the +#' output of the code chunk (code, messages, text output, and plots, etc.) after +#' all statements in the code chunk have been evaluated. +#' @param x Output from \code{evaluate::\link{evaluate}()}. +#' @param options A list of chunk options used to control output. +#' @param ... Other arguments to pass to methods. +#' @export wrap = function(x, options = list(), ...) { UseMethod('wrap', x) } #' @export -wrap.list = function(x, options = list()) { +wrap.list = function(x, options = list(), ...) { if (length(x) == 0L) return(x) lapply(x, wrap, options) } # ignore unknown classes #' @export -wrap.default = function(x, options) return() +wrap.default = function(x, options, ...) return() #' @export -wrap.character = function(x, options) { +wrap.character = function(x, options, ...) { if (options$results == 'hide') return() if (output_asis(x, options)) { if (!out_format('latex')) return(x) # latex output still need a tweak @@ -457,7 +461,7 @@ wrap.character = function(x, options) { # If you provide a custom print function that returns a character object of # class 'knit_asis', it will be written as is. #' @export -wrap.knit_asis = function(x, options, inline = FALSE) { +wrap.knit_asis = function(x, options, inline = FALSE, ...) { m = attr(x, 'knit_meta') knit_meta_add(m, if (missing(options)) '' else options$label) if (!missing(options)) { @@ -482,7 +486,7 @@ wrap.knit_asis = function(x, options, inline = FALSE) { } #' @export -wrap.source = function(x, options) { +wrap.source = function(x, options, ...) { if (isFALSE(options$echo)) return() src = sub('\n$', '', x$src) if (!options$collapse && options$strip.white) src = strip_white(src) @@ -514,7 +518,7 @@ msg_sanitize = function(message, type) { } #' @export -wrap.warning = function(x, options) { +wrap.warning = function(x, options, ...) { call = if (is.null(x$call)) '' else { call = deparse(x$call)[1] if (call == 'eval(expr, envir, enclos)') '' else paste(' in', call) @@ -523,17 +527,17 @@ wrap.warning = function(x, options) { } #' @export -wrap.message = function(x, options) { +wrap.message = function(x, options, ...) { msg_wrap(paste(x$message, collapse = ''), 'message', options) } #' @export -wrap.error = function(x, options) { +wrap.error = function(x, options, ...) { msg_wrap(as.character(x), 'error', options) } #' @export -wrap.recordedplot = function(x, options) { +wrap.recordedplot = function(x, options, ...) { # figure number sequence for multiple plots fig.cur = plot_counter() options$fig.cur = fig.cur # put fig num in options @@ -555,7 +559,7 @@ wrap.recordedplot = function(x, options) { } #' @export -wrap.knit_image_paths = function(x, options = opts_chunk$get(), inline = FALSE) { +wrap.knit_image_paths = function(x, options = opts_chunk$get(), inline = FALSE, ...) { if (options$fig.show == 'hide') return('') # remove the automatically set out.width when fig.retina is set, otherwise the # size of external images embedded via include_graphics() will be set to @@ -578,7 +582,7 @@ wrap.knit_image_paths = function(x, options = opts_chunk$get(), inline = FALSE) } #' @export -wrap.html_screenshot = function(x, options = opts_chunk$get(), inline = FALSE) { +wrap.html_screenshot = function(x, options = opts_chunk$get(), inline = FALSE, ...) { ext = x$extension in_base_dir({ i = plot_counter() @@ -603,7 +607,7 @@ run_hook_plot = function(x, options) { } #' @export -wrap.knit_embed_url = function(x, options = opts_chunk$get(), inline = FALSE) { +wrap.knit_embed_url = function(x, options = opts_chunk$get(), inline = FALSE, ...) { options$fig.cur = plot_counter() options = reduce_plot_opts(options) if (length(extra <- options$out.extra)) extra = paste('', extra, collapse = '') diff --git a/R/plot.R b/R/plot.R index c2a9ed0bbb..d557c8fbb6 100644 --- a/R/plot.R +++ b/R/plot.R @@ -225,8 +225,31 @@ merge_low_plot = function(x, idx = sapply(x, evaluate::is.recordedplot)) { if (is.null(m)) x else x[-m] } -# compare two recorded plots +#' Compare two recorded plots +#' +#' Check if one plot only contains a low-level update of another plot. +#' @param p1,p2 Plot objects. +#' @return Logical value indicating whether \code{p2} is a low-level update of +#' \code{p1}. +#' @export +#' @examples +#' pdf(NULL) +#' dev.control('enable') # enable plot recording +#' plot(1:10) +#' p1 = recordPlot() +#' abline(0, 1) # add a line (a low-level change) +#' p2 = recordPlot() +#' plot(rnorm(100)) +#' p3 = recordPlot() # draw a completely new plot +#' dev.off() +#' knitr::is_low_change(p1, p2) # true +#' knitr::is_low_change(p1, p3) # false is_low_change = function(p1, p2) { + UseMethod('is_low_change') +} + +#' @export +is_low_change.default = function(p1, p2) { p1 = p1[[1]]; p2 = p2[[1]] # real plot info is in [[1]] if (length(p2) < (n1 <- length(p1))) return(FALSE) # length must increase identical(p1[1:n1], p2[1:n1]) diff --git a/man/is_low_change.Rd b/man/is_low_change.Rd new file mode 100644 index 0000000000..6931649f73 --- /dev/null +++ b/man/is_low_change.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot.R +\name{is_low_change} +\alias{is_low_change} +\title{Compare two recorded plots} +\usage{ +is_low_change(p1, p2) +} +\arguments{ +\item{p1, p2}{Plot objects.} +} +\value{ +Logical value indicating whether \code{p2} is a low-level update of + \code{p1}. +} +\description{ +Check if one plot only contains a low-level update of another plot. +} +\examples{ +pdf(NULL) +dev.control("enable") # enable plot recording +plot(1:10) +p1 = recordPlot() +abline(0, 1) # add a line (a low-level change) +p2 = recordPlot() +plot(rnorm(100)) +p3 = recordPlot() # draw a completely new plot +dev.off() +knitr::is_low_change(p1, p2) # true +knitr::is_low_change(p1, p3) # false +} diff --git a/man/wrap.Rd b/man/wrap.Rd new file mode 100644 index 0000000000..4cf03caadf --- /dev/null +++ b/man/wrap.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/output.R +\name{wrap} +\alias{wrap} +\title{Wrap evaluated results for output} +\usage{ +wrap(x, options = list(), ...) +} +\arguments{ +\item{x}{Output from \code{evaluate::\link{evaluate}()}.} + +\item{options}{A list of chunk options used to control output.} + +\item{...}{Other arguments to pass to methods.} +} +\description{ +This function is mainly for internal use: it is called on each part of the +output of the code chunk (code, messages, text output, and plots, etc.) after +all statements in the code chunk have been evaluated. +}