Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Support rgl and htmlwidgets in pkgdown #78

Merged
merged 9 commits into from
Mar 19, 2021
Merged

Support rgl and htmlwidgets in pkgdown #78

Show file tree
Hide file tree
Changes from 6 commits
Commits
Show all changes
9 commits
Select commit Hold shift + click to select a range
ae42fc7
- Allow custom output handler in evaluate_and_highlight.
dmurdoch Feb 17, 2021
0174171
minor fix
dmurdoch Mar 5, 2021
8749b5c
Getting closer, but dependencies aren't being handled properly yet.
dmurdoch Mar 6, 2021
cdcef74
Now working with is_low_change etc.
dmurdoch Mar 7, 2021
53a50bf
Fix check issues
dmurdoch Mar 7, 2021
93114a0
Add test of new code for merging low plots.
dmurdoch Mar 7, 2021
de9f8c6
Don't export replay_html: it's not needed in either rgl or htmlwidgets.
dmurdoch Mar 9, 2021
ea56396
Drop reply_html docs
hadley Mar 19, 2021
858ca55
Add news bullet
hadley Mar 19, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions NAMESPACE
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
# Generated by roxygen2: do not edit by hand

S3method(is_low_change,default)
S3method(replay_html,"NULL")
S3method(replay_html,character)
S3method(replay_html,error)
Expand All @@ -21,4 +22,6 @@ export(evaluate_and_highlight)
export(highlight)
export(href_article)
export(href_topic)
export(is_low_change)
export(replay_html)
import(rlang)
46 changes: 40 additions & 6 deletions R/evaluate.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@
#' components `path`, `width`, and `height`.
#' @param env Environment in which to evaluate code; if not supplied,
#' defaults to a child of the global environment.
#' @param output_handler Custom output handler for `evaluate::evaluate`.
#' @return An string containing HTML.
#' @inheritParams highlight
#' @export
Expand All @@ -19,13 +20,22 @@
evaluate_and_highlight <- function(code,
fig_save,
classes = downlit::classes_pandoc(),
env = NULL) {
env = NULL,
output_handler = evaluate::new_output_handler()) {
env <- env %||% child_env(global_env())

expr <- evaluate::evaluate(code, child_env(env), new_device = TRUE)
expr <- evaluate::evaluate(code, child_env(env), new_device = TRUE,
output_handler = output_handler)
replay_html(expr, fig_save = fig_save, fig_id = unique_id(), classes = classes)
}

#' Convert object to HTML
#'
#' @param x Object to display
#' @param ... Additional parameters to pass to methods.
#'
#' @return character vector containing html
#' @export
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Does this have to be exported? i.e. are you providing a method for it in rgl? If so, I think we'll probably need to change the name, since otherwise I'll get confused because I have internal replay_html() functions in multiple packages.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think it does need to be exported, or I'll get a warning when I try to put a method on it in rgl. Currently I've got code there to avoid the warning, but I think if anyone else wants to use this they'd want something simpler. Or maybe we should just document that the method needs to be registered using code like:

registerS3method("replay_html", "rglRecordedplot", 
			   replay_html.rglRecordedplot, 
			   envir = asNamespace("downlit"))

replay_html <- function(x, ...) UseMethod("replay_html", x)

#' @export
Expand All @@ -47,13 +57,20 @@ replay_html.list <- function(x, ...) {
parts <- merge_low_plot(parts)

pieces <- character(length(parts))
dependencies <- list()
for (i in seq_along(parts)) {
pieces[i] <- replay_html(parts[[i]], ...)
piece <- replay_html(parts[[i]], ...)
dependencies <- c(dependencies, attr(piece, "dependencies"))
pieces[i] <- piece
}
res <- paste0(pieces, collapse = "")

# convert ansi escapes
res <- fansi::sgr_to_html(res)

# get dependencies from htmlwidgets etc.
attr(res, "dependencies") <- dependencies

res
}

Expand Down Expand Up @@ -150,12 +167,19 @@ unique_id <- function() {

# get MD5 digests of recorded plots so that merge_low_plot works
digest_plot = function(x, level = 1) {
if (!is.list(x) || level >= 3) return(digest::digest(x))
if (inherits(x, "otherRecordedplot"))
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Does this class come from rgl?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This class currently only exists in rgl, where I used class c("rglRecordedPlot", "otherRecordedPlot") for the object it's supposed to handle. The idea is that it's an object that has both high level and low level versions (like base graphics, where plot() produces high level changes, but points() produces low level changes). You don't want to display every low level change, you just want to display the plot after the last one.

As far as I know the only implementations of this style of graphics are base graphics and rgl (that was written to emulate base), so it's not really necessary now: but if anyone else ever writes one, they wouldn't want their plots to be handled like rgl plots in other respects.

I submitted similar changes to knitr back in September (yihui/knitr#1892); Yihui hasn't merged them yet. In that PR I used the name "knitr_other_plot" instead of "otherRecordedPlot", but I didn't like that name much, and it doesn't make sense to use it for pkgdown. I will probably suggest modifying the knitr PR to use the same name as used in pkgdown, whatever that turns out to be.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I forgot, "otherRecordedPlot" isn't just an object with high and low levels, it could also be used just to break up a sequence of those. For example, knitr treats "knit_image_paths" objects like plots when deciding whether to break up a sequence of base graphics calls. The change would add "otherRecordedPlot" objects to the list of things that count as plots.

return(x)
if (!is.list(x) || level >= 3) return(structure(digest::digest(x),
class = "plot_digest"))
lapply(x, digest_plot, level = level + 1)
}

is_plot_output = function(x) {
evaluate::is.recordedplot(x) || inherits(x, 'otherRecordedplot')
}

# merge low-level plotting changes
merge_low_plot = function(x, idx = sapply(x, evaluate::is.recordedplot)) {
merge_low_plot = function(x, idx = vapply(x, is_plot_output, logical(1L))) {
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm slightly nervous about modifying this code since it came from knitr. Are you planning to submit changes there as well?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

As mentioned a similar change was submitted in yihui/knitr#1892 .

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I just took a closer look at yihui/knitr#1892 . It didn't change the default for idx in merge_low_plot, because merge_low_plot is called with an explicit value for idx, calculated here: https://github.com/yihui/knitr/blob/ca09938f8bb08cdd949c3cc6b94d640f68529126/R/block.R#L400 . The findRecordedPlot function is here: https://github.com/yihui/knitr/blob/ca09938f8bb08cdd949c3cc6b94d640f68529126/R/block.R#L370. It uses the formula I put in as the default in this PR.

idx = which(idx); n = length(idx); m = NULL # store indices that will be removed
if (n <= 1) return(x)

Expand All @@ -172,8 +196,18 @@ 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
#'
#' @param p1,p2 Plot results
#'
#' @return Logical value indicating whether `p2` is a low-level update of `p1`.
#' @export
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 ((n2 <- length(p2)) < (n1 <- length(p1))) return(FALSE) # length must increase
identical(p1[1:n1], p2[1:n1])
Expand Down
5 changes: 4 additions & 1 deletion man/evaluate_and_highlight.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

17 changes: 17 additions & 0 deletions man/is_low_change.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

19 changes: 19 additions & 0 deletions man/replay_html.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

25 changes: 25 additions & 0 deletions tests/testthat/test-evaluate.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,31 @@ test_that("evaluate_and_highlight works", {
f1 <- function() plot(1)
f2 <- function() lines(0:2, 0:2)
cat(evaluate_and_highlight("f1()\nf2()", fig_save = fig_save, env = environment()))

"Other plots"
f3 <- function()
structure(3, class = c("fakePlot", "otherRecordedplot"))
f4 <- function()
structure(4, class = c("fakePlot", "otherRecordedplot"))
# Check that we can drop the inclusion of the first one
is_low_change.fakePlot <- function(p1, p2) TRUE
print.fakePlot <- function(x, ...) {
x
}
replay_html.fakePlot <- function(x, ...) {
paste("Text for plot ", unclass(x))
}
registerS3method("is_low_change", "fakePlot",
is_low_change.fakePlot,
envir = asNamespace("downlit"))
registerS3method("replay_html", "fakePlot",
replay_html.fakePlot,
envir = asNamespace("downlit"))
registerS3method("print", "fakePlot",
print.fakePlot)
cat(evaluate_and_highlight("f3()\nf4()", env = environment(),
fig_save = fig_save,
output_handler = evaluate::new_output_handler(value = print)))
})
})

Expand Down
20 changes: 20 additions & 0 deletions tests/testthat/test-evaluate.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,3 +26,23 @@
<div class='input'><span class='fu'>f1</span><span class='op'>(</span><span class='op'>)</span>
</div><div class='input'><span class='fu'>f2</span><span class='op'>(</span><span class='op'>)</span></div><div class='img'><img src='1.png' alt='' width='10' height='10' /></div>

> # Other plots
> f3 <- (function() structure(3, class = c("fakePlot", "otherRecordedplot")))
> f4 <- (function() structure(4, class = c("fakePlot", "otherRecordedplot")))
> is_low_change.fakePlot <- (function(p1, p2) TRUE)
> print.fakePlot <- (function(x, ...) {
+ x
+ })
> replay_html.fakePlot <- (function(x, ...) {
+ paste("Text for plot ", unclass(x))
+ })
> registerS3method("is_low_change", "fakePlot", is_low_change.fakePlot, envir = asNamespace(
+ "downlit"))
> registerS3method("replay_html", "fakePlot", replay_html.fakePlot, envir = asNamespace(
+ "downlit"))
> registerS3method("print", "fakePlot", print.fakePlot)
> cat(evaluate_and_highlight("f3()\nf4()", env = environment(), fig_save = fig_save,
+ output_handler = evaluate::new_output_handler(value = print)))
<div class='input'><span class='fu'>f3</span><span class='op'>(</span><span class='op'>)</span>
</div><div class='input'><span class='fu'>f4</span><span class='op'>(</span><span class='op'>)</span></div>Text for plot 4