|
| 1 | +#' Use a partial bundle of plotly.js |
| 2 | +#' |
| 3 | +#' Leveraging plotly.js' partial bundles can lead to smaller file sizes |
| 4 | +#' and faster rendering. The full list of available bundles, and the |
| 5 | +#' trace types that they support, are available |
| 6 | +#' [here](https://github.com/plotly/plotly.js/blob/master/dist/README.md#partial-bundles) |
| 7 | +#' |
| 8 | +#' @details WARNING: use this function with caution when rendering multiple |
| 9 | +#' plotly graphs on a single website. That's because, if multiple plotly.js |
| 10 | +#' bundles are used, the most recent bundle will override the other bundles. |
| 11 | +#' See the examples section for an example. |
| 12 | +#' |
| 13 | +#' @param p a plotly object. |
| 14 | +#' @param type name of the (partial) bundle. The default, `'auto'`, attempts to |
| 15 | +#' find the smallest single bundle that can render `p`. If no single partial bundle |
| 16 | +#' can render `p`, then the full bundle is used. |
| 17 | +#' @param local whether or not to download the partial bundle so that it can be |
| 18 | +#' viewed later without an internet connection. |
| 19 | +#' @param minified whether or not to use a minified js file (non-minified file can be useful for debugging plotly.js) |
| 20 | +#' @author Carson Sievert |
| 21 | +#' @export |
| 22 | +#' @examples |
| 23 | +#' |
| 24 | +#' # ---------------------------------------------------------------------- |
| 25 | +#' # This function is always safe to use when rendering a single |
| 26 | +#' # plotly graph. In this case, we get a 3x file reduction. |
| 27 | +#' # ---------------------------------------------------------------------- |
| 28 | +#' |
| 29 | +#' library(plotly) |
| 30 | +#' p <- plot_ly(x = 1:10, y = 1:10) %>% add_markers() |
| 31 | +#' save_widget <- function(p, f) { |
| 32 | +#' owd <- setwd(dirname(f)) |
| 33 | +#' on.exit(setwd(owd)) |
| 34 | +#' htmlwidgets::saveWidget(p, f) |
| 35 | +#' mb <- round(file.info(f)$size / 1e6, 3) |
| 36 | +#' message("File is: ", mb," MB") |
| 37 | +#' } |
| 38 | +#' f1 <- tempfile(fileext = ".html") |
| 39 | +#' f2 <- tempfile(fileext = ".html") |
| 40 | +#' save_widget(p, f1) |
| 41 | +#' save_widget(partial_bundle(p), f2) |
| 42 | +#' |
| 43 | +#' # ---------------------------------------------------------------------- |
| 44 | +#' # But, since plotly.js bundles override one another, |
| 45 | +#' # be careful when putting multiple graphs in a larger document! |
| 46 | +#' # Note how the surface (part of the gl3d bundle) renders, but the |
| 47 | +#' # heatmap (part of the cartesian bundle) doesn't... |
| 48 | +#' # ---------------------------------------------------------------------- |
| 49 | +#' |
| 50 | +#' library(htmltools) |
| 51 | +#' p1 <- plot_ly(z = ~volcano) %>% |
| 52 | +#' add_heatmap() %>% |
| 53 | +#' partial_bundle() |
| 54 | +#' p2 <- plot_ly(z = ~volcano) %>% |
| 55 | +#' add_surface() %>% |
| 56 | +#' partial_bundle() |
| 57 | +#' browsable(tagList(p1, p2)) |
| 58 | +#' |
| 59 | + |
| 60 | + |
| 61 | +partial_bundle <- function(p, type = "auto", local = TRUE, minified = TRUE) { |
| 62 | + |
| 63 | + if (!is.plotly(p)) stop("The first argument to `partial_bundle()` must be a plotly object", call. = FALSE) |
| 64 | + |
| 65 | + # Amongst all the 'print-time' htmlwidget dependencies, |
| 66 | + # find the plotly.js dependency and attach some meta-info |
| 67 | + idx <- plotlyjsBundleIDX(p) |
| 68 | + p$dependencies[[idx]]$local <- local |
| 69 | + p$dependencies[[idx]]$minified <- minified |
| 70 | + p$dependencies[[idx]]$partial_bundle <- match.arg(type, c("auto", "main", names(bundleTraceMap))) |
| 71 | + |
| 72 | + # unfortunately, htmlwidgets doesn't appear to support manipulation of |
| 73 | + # dependencies field during preRenderHook(), so we need to explicitly build |
| 74 | + plotly_build(p) |
| 75 | +} |
| 76 | + |
| 77 | +verify_partial_bundle <- function(p) { |
| 78 | + # return early if we're using the main bundle (the default) |
| 79 | + currentBundle <- plotlyjsBundle(p) |
| 80 | + bundleType <- currentBundle$partial_bundle %||% "main" |
| 81 | + if (identical(bundleType, "main")) return(p) |
| 82 | + |
| 83 | + # grab all the required trace types |
| 84 | + types <- unique(vapply(p$x$data, function(x) x[["type"]] %||% "scatter", character(1))) |
| 85 | + |
| 86 | + if (identical(bundleType, "auto")) { |
| 87 | + |
| 88 | + # resolve an auto bundle by using the 1st bundle that supports all the types |
| 89 | + # (ordering of bundleTraceMap is important!) |
| 90 | + for (i in seq_along(bundleTraceMap)) { |
| 91 | + if (all(types %in% bundleTraceMap[[i]])) { |
| 92 | + bundleType <- names(bundleTraceMap)[[i]] |
| 93 | + break |
| 94 | + } |
| 95 | + } |
| 96 | + |
| 97 | + if (identical(bundleType, "auto")) { |
| 98 | + warning( |
| 99 | + "Couldn't find a single partial bundle that would support this plotly ", |
| 100 | + "visualization. Using the main (full) bundle instead." |
| 101 | + ) |
| 102 | + p$dependencies[[plotlyjsBundleIDX(p)]] <- plotlyMainBundle() |
| 103 | + return(p) |
| 104 | + } |
| 105 | + |
| 106 | + } |
| 107 | + |
| 108 | + # verify that this partial bundle actually supports this viz |
| 109 | + # (at this point, bundleType should never be 'auto' or 'main') |
| 110 | + missingTypes <- setdiff(types, bundleTraceMap[[bundleType]]) |
| 111 | + if (length(missingTypes)) { |
| 112 | + msg <- sprint( |
| 113 | + "The '%s' bundle supports the following trace types: '%s'.\n\n", |
| 114 | + "This plotly visualization contains the following trace types: '%s'", |
| 115 | + bundle, paste(missingTypes, collapse = "', '"), paste(missingTypes, collapse = "', '") |
| 116 | + ) |
| 117 | + stop(msg, call. = FALSE) |
| 118 | + } |
| 119 | + |
| 120 | + idx <- plotlyjsBundleIDX(p) |
| 121 | + bundle_name <- sprintf("plotly-%s", bundleType) |
| 122 | + bundle_script <- sprintf( |
| 123 | + "plotly-%s-%s.%sjs", |
| 124 | + bundleType, currentBundle$version, |
| 125 | + if (isTRUE(currentBundle$minified)) "min." else "" |
| 126 | + ) |
| 127 | + |
| 128 | + p$dependencies[[idx]]$name <- bundle_name |
| 129 | + p$dependencies[[idx]]$script <- bundle_script |
| 130 | + p$dependencies[[idx]]$src <- list(href = "https://cdn.plot.ly") |
| 131 | + |
| 132 | + # download the relevant bundle |
| 133 | + if (isTRUE(p$dependencies[[idx]]$local)) { |
| 134 | + # TODO: implement a caching mechanism? |
| 135 | + try_library("curl", "partial_bundle") |
| 136 | + tmpfile <- file.path(tempdir(), bundle_script) |
| 137 | + p$dependencies[[idx]]$src$file <- dirname(tmpfile) |
| 138 | + if (!file.exists(tmpfile)) { |
| 139 | + curl::curl_download(paste0("https://cdn.plot.ly/", bundle_script), tmpfile) |
| 140 | + } |
| 141 | + } |
| 142 | + |
| 143 | + p |
| 144 | +} |
| 145 | + |
| 146 | +plotlyjsBundleIDX <- function(p) { |
| 147 | + depNames <- sapply(p$dependencies, "[[", "name") |
| 148 | + bundleNames <- paste0("plotly-", c("main", "auto", names(bundleTraceMap))) |
| 149 | + idx <- which(depNames %in% bundleNames) |
| 150 | + if (length(idx) != 1) stop("Couldn't find the plotlyjs bundle") |
| 151 | + idx |
| 152 | +} |
| 153 | + |
| 154 | +plotlyjsBundle <- function(p) { |
| 155 | + p$dependencies[[plotlyjsBundleIDX(p)]] |
| 156 | +} |
| 157 | + |
| 158 | +# TODO: create this object in inst/plotlyjs.R from the dist/README.md |
| 159 | +bundleTraceMap <- list( |
| 160 | + basic = c( |
| 161 | + "scatter", |
| 162 | + "bar", |
| 163 | + "pie" |
| 164 | + ), |
| 165 | + cartesian = c( |
| 166 | + "scatter", |
| 167 | + "bar", |
| 168 | + "pie", |
| 169 | + "box", |
| 170 | + "heatmap", |
| 171 | + "histogram", |
| 172 | + "histogram2d", |
| 173 | + "histogram2dcontour", |
| 174 | + "contour", |
| 175 | + "scatterternary", |
| 176 | + "violin" |
| 177 | + ), |
| 178 | + geo = c( |
| 179 | + "scatter", |
| 180 | + "scattergeo", |
| 181 | + "choropleth" |
| 182 | + ), |
| 183 | + gl3d = c( |
| 184 | + "scatter", |
| 185 | + "scatter3d", |
| 186 | + "surface", |
| 187 | + "mesh3d", |
| 188 | + "cone" |
| 189 | + ), |
| 190 | + gl2d = c( |
| 191 | + "scatter", |
| 192 | + "scattergl", |
| 193 | + "splom", |
| 194 | + "pointcloud", |
| 195 | + "heatmapgl", |
| 196 | + "contourgl", |
| 197 | + "parcoords" |
| 198 | + ), |
| 199 | + mapbox = c( |
| 200 | + "scatter", |
| 201 | + "scattermapbox" |
| 202 | + ), |
| 203 | + finance = c( |
| 204 | + "scatter", |
| 205 | + "bar", |
| 206 | + "pie", |
| 207 | + "histogram", |
| 208 | + "ohlc", |
| 209 | + "candlestick" |
| 210 | + ) |
| 211 | +) |
0 commit comments