Skip to content

Commit 427bd9f

Browse files
cpsievertcpsievert
committed
Introduce partial_bundle() for better control over plotly.js dependency
1 parent 6ca8cf5 commit 427bd9f

File tree

6 files changed

+296
-3
lines changed

6 files changed

+296
-3
lines changed

‎NAMESPACE

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -149,6 +149,7 @@ export(layout)
149149
export(mutate)
150150
export(mutate_)
151151
export(offline)
152+
export(partial_bundle)
152153
export(plot_dendro)
153154
export(plot_geo)
154155
export(plot_ly)

‎R/partial_bundles.R

Lines changed: 209 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,209 @@
1+
#' Use a partial bundle of plotly.js
2+
#'
3+
#'
4+
#' @param p a plotly object.
5+
#' @param type name of the (partial) bundle. The default `'auto'` attempts to
6+
#' @param version version number (e.g. 1.30.0). See [here](https://github.com/plotly/plotly.js/releases)
7+
#' for a list of valid versions and changelogs.
8+
#' @param local either "local", "cdn", or "rawgit".
9+
#' @param minified whether or not to use a minified js file (non-minified file can be useful for debugging plotly.js)
10+
#' @export
11+
#' @author Carson Sievert
12+
#' @references <https://github.com/plotly/plotly.js/blob/master/dist/README.md>
13+
#' @seealso `[plotly_bundle_info]()`
14+
#'
15+
#' @examples
16+
#'
17+
#' library(plotly)
18+
#' p1 <- plot_ly(x = 1:10, y = 1:10) %>% add_markers()
19+
#' p2 <- partial_bundle(p1)
20+
#' f1 <- tempfile(fileext = ".html")
21+
#' f2 <- tempfile(fileext = ".html")
22+
#'
23+
#' save_widget <- function(p, f) {
24+
#' owd <- setwd(dirname(f))
25+
#' on.exit(setwd(owd))
26+
#' htmlwidgets::saveWidget(p, f)
27+
#' mb <- round(file.info(f)$size / 1e6, 3)
28+
#' message("File is: ", mb," MB")
29+
#' }
30+
#' save_widget(p1, f1)
31+
#' save_widget(p2, f2)
32+
#'
33+
34+
35+
# TODO: implement type = 'auto' which would attempts to find the smallest partial bundle that can render `p`.
36+
# this would require, however, knowing the bundle -> trace mapping *for `p`'s plotly.js version*
37+
partial_bundle <- function(p, type = "auto", local = TRUE, minified = TRUE) {
38+
39+
if (!is.plotly(p)) stop("The first argument to `partial_bundle()` must be a plotly object", call. = FALSE)
40+
41+
# Amongst all the 'print-time' htmlwidget dependencies,
42+
# find the plotly.js dependency and attach some meta-info
43+
idx <- plotlyjsBundleIDX(p)
44+
p$dependencies[[idx]]$local <- local
45+
p$dependencies[[idx]]$minified <- minified
46+
p$dependencies[[idx]]$partial_bundle <- match.arg(type, c("auto", "main", names(bundleTraceMap)))
47+
48+
plotly_build(p)
49+
}
50+
51+
verify_partial_bundle <- function(p) {
52+
# return early if we're using the main bundle (the default)
53+
currentBundle <- plotlyjsBundle(p)
54+
bundleType <- currentBundle$partial_bundle %||% "main"
55+
if (identical(bundleType, "main")) return(p)
56+
57+
# grab all the required trace types
58+
types <- unique(vapply(p$x$data, function(x) x[["type"]] %||% "scatter", character(1)))
59+
60+
if (identical(bundleType, "auto")) {
61+
62+
# resolve an auto bundle by using the 1st bundle that supports all the types
63+
# (ordering of bundleTraceMap is important!)
64+
for (i in seq_along(bundleTraceMap)) {
65+
if (all(types %in% bundleTraceMap[[i]])) {
66+
bundleType <- names(bundleTraceMap)[[i]]
67+
break
68+
}
69+
}
70+
71+
if (identical(bundleType, "auto")) {
72+
message(
73+
"Couldn't find a single partial bundle that would support this plotly",
74+
"visualization. Using the main (full) bundle instead."
75+
)
76+
p$dependencies[[plotlyjsBundleIDX(p)]] <- plotlyMainBundle()
77+
return(p)
78+
}
79+
80+
}
81+
82+
# verify that this partial bundle actually supports this viz
83+
# (at this point, bundleType should never be 'auto' or 'main')
84+
missingTypes <- setdiff(types, bundleTraceMap[[bundleType]])
85+
if (length(missingTypes)) {
86+
msg <- sprint(
87+
"The '%s' bundle supports the following trace types: '%s'.\n\n",
88+
"This plotly visualization contains the following trace types: '%s'",
89+
bundle, paste(missingTypes, collapse = "', '"), paste(missingTypes, collapse = "', '")
90+
)
91+
stop(msg, call. = FALSE)
92+
}
93+
94+
idx <- plotlyjsBundleIDX(p)
95+
bundle_name <- sprintf("plotly-%s", bundleType)
96+
bundle_script <- sprintf(
97+
"plotly-%s-%s.%sjs",
98+
bundleType, currentBundle$version,
99+
if (isTRUE(currentBundle$minified)) "min." else ""
100+
)
101+
102+
p$dependencies[[idx]]$name <- bundle_name
103+
p$dependencies[[idx]]$script <- bundle_script
104+
p$dependencies[[idx]]$src <- list(href = "https://cdn.plot.ly")
105+
106+
# download the relevant bundle
107+
if (isTRUE(p$dependencies[[idx]]$local)) {
108+
# TODO: implement a caching mechanism?
109+
try_library("curl", "partial_bundle")
110+
tmpfile <- file.path(tempdir(), bundle_script)
111+
p$dependencies[[idx]]$src$file <- dirname(tmpfile)
112+
if (!file.exists(tmpfile)) {
113+
curl::curl_download(paste0("https://cdn.plot.ly/", bundle_script), tmpfile)
114+
}
115+
}
116+
117+
p
118+
}
119+
120+
plotlyjsBundleIDX <- function(p) {
121+
depNames <- sapply(p$dependencies, "[[", "name")
122+
bundleNames <- paste0("plotly-", c("main", "auto", names(bundleTraceMap)))
123+
idx <- which(depNames %in% bundleNames)
124+
if (length(idx) != 1) stop("Couldn't find the plotlyjs bundle")
125+
idx
126+
}
127+
128+
plotlyjsBundle <- function(p) {
129+
p$dependencies[[plotlyjsBundleIDX(p)]]
130+
}
131+
132+
133+
# TODO: create this object from the dist/README.md
134+
bundleTraceMap <- list(
135+
basic = c(
136+
"scatter",
137+
"bar",
138+
"pie"
139+
),
140+
cartesian = c(
141+
"scatter",
142+
"bar",
143+
"pie",
144+
"box",
145+
"heatmap",
146+
"histogram",
147+
"histogram2d",
148+
"histogram2dcontour",
149+
"contour",
150+
"scatterternary",
151+
"violin"
152+
),
153+
geo = c(
154+
"scatter",
155+
"scattergeo",
156+
"choropleth"
157+
),
158+
gl3d = c(
159+
"scatter",
160+
"scatter3d",
161+
"surface",
162+
"mesh3d",
163+
"cone"
164+
),
165+
gl2d = c(
166+
"scatter",
167+
"scattergl",
168+
"splom",
169+
"pointcloud",
170+
"heatmapgl",
171+
"contourgl",
172+
"parcoords"
173+
),
174+
mapbox = c(
175+
"scatter",
176+
"scattermapbox"
177+
),
178+
finance = c(
179+
"scatter",
180+
"bar",
181+
"pie",
182+
"histogram",
183+
"ohlc",
184+
"candlestick"
185+
)
186+
)
187+
188+
189+
190+
##' List trace types supported by a particular bundle
191+
##'
192+
##' @export
193+
#partial_bundle_info <- function() {
194+
# for (i in seq_along(bundle_traces)) {
195+
# bundle_name <- names(bundle_traces)[[i]]
196+
# msg <- sprintf(
197+
# "The '%s' bundle size is %s MB and contains the '%s' traces",
198+
# bundle_name,
199+
# round(file.info(bundle_file(bundle_name))$size / 1000000, 3),
200+
# paste(bundle_traces[[i]], collapse = "', '")
201+
# )
202+
# message(msg)
203+
# }
204+
#}
205+
#
206+
#bundle_file <- function(bundle = "basic") {
207+
# bundle <- match.arg(bundle, names(bundle_traces))
208+
# system.file("lib", paste0("plotly-", bundle, ".min.js"), package = "plotlyDepends")
209+
#}

‎R/plotly.R

Lines changed: 14 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -405,6 +405,7 @@ as_widget <- function(x, ...) {
405405
dependencies = c(
406406
list(typedArrayPolyfill()),
407407
crosstalk::crosstalkLibs(),
408+
list(plotlyHtmlwidgetsCSS()),
408409
list(plotlyMainBundle())
409410
)
410411
)
@@ -414,18 +415,28 @@ typedArrayPolyfill <- function() {
414415
htmltools::htmlDependency(
415416
"typedarray", "0.1",
416417
src = depPath("typedarray"),
417-
script = "typedarray.min.js"
418+
script = "typedarray.min.js",
419+
all_files = FALSE
418420
)
419421
}
420422

421423
# TODO: suggest a plotlyBundles package that has trace-level bundles
422424
# and bundle size at print time.
423425
plotlyMainBundle <- function() {
424426
htmltools::htmlDependency(
425-
"plotlyjs", "1.38.1",
427+
"plotly-main", "1.38.1",
426428
src = depPath("plotlyjs"),
427429
script = "plotly-latest.min.js",
428-
stylesheet = "plotly-htmlwidgets.css"
430+
all_files = FALSE
431+
)
432+
}
433+
434+
plotlyHtmlwidgetsCSS <- function() {
435+
htmltools::htmlDependency(
436+
"plotly-htmlwidgets-css", "1.38.1",
437+
src = depPath("plotlyjs"),
438+
stylesheet = "plotly-htmlwidgets.css",
439+
all_files = FALSE
429440
)
430441
}
431442

‎R/plotly_build.R

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -375,6 +375,9 @@ plotly_build.plotly <- function(p, registerFrames = TRUE) {
375375
# box up 'data_array' attributes where appropriate
376376
p <- verify_attr_spec(p)
377377

378+
# if a partial bundle was specified, make sure it supports the visualization
379+
p <- verify_partial_bundle(p)
380+
378381
# make sure plots don't get sent out of the network (for enterprise)
379382
p$x$base_url <- get_domain()
380383
p

‎man/partial_bundle.Rd

Lines changed: 51 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/testthat/test-plotly-partial-bundles.R

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
context("partial-bundles")
2+
3+
4+
test_that("Can reduce saved file size with an auto partial bundle", {
5+
6+
p1 <- plot_ly(x = 1:10, y = 1:10) %>% add_markers()
7+
p2 <- partial_bundle(p1)
8+
f1 <- tempfile(fileext = ".html")
9+
f2 <- tempfile(fileext = ".html")
10+
11+
file_size <- function(p, f) {
12+
owd <- setwd(dirname(f))
13+
on.exit(setwd(owd))
14+
htmlwidgets::saveWidget(p, f)
15+
file.info(f)$size / 1e6
16+
}
17+
expect_true(file_size(p1, f1) / 2 > file_size(p2, f2))
18+
})

0 commit comments

Comments
 (0)