1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233
|
#' Query graphical elements in multiple linked views
#'
#' This function sets a variety of options for brushing (i.e., highlighting)
#' multiple plots. These options are primarily designed for linking
#' multiple plotly graphs, and may not behave as expected when linking
#' plotly to another htmlwidget package via crosstalk. In some cases,
#' other htmlwidgets will respect these options, such as persistent selection
#' in leaflet (see `demo("highlight-leaflet", package = "plotly")`).
#'
#' @param p a plotly visualization.
#' @param on turn on a selection on which event(s)? To disable on events
#' altogether, use `NULL`. Currently the following are supported:
#' \itemize{
#' \item `'plotly_click'`
#' \item `'plotly_hover'`
#' \item `'plotly_selected'`: triggered through rectangular
#' (layout.dragmode = 'select') or lasso (layout.dragmode = 'lasso') brush.
#' }
#' @param off turn off a selection on which event(s)? To disable off
#' events altogether, use `NULL`. Currently the following are supported:
#' \itemize{
#' \item `'plotly_doubleclick'`: triggered on a double mouse click while
#' (layout.dragmode = 'zoom') or (layout.dragmode = 'pan')
#' \item `'plotly_deselect'`: triggered on a double mouse click while
#' (layout.dragmode = 'select') or (layout.dragmode = 'lasso')
#' \item `'plotly_relayout'`: triggered whenever axes are rescaled
#' (i.e., clicking the home button in the modebar) or whenever the height/width
#' of the plot changes.
#' }
#' @param persistent should selections persist (i.e., accumulate)? We often
#' refer to the default (`FALSE`) as a 'transient' selection mode;
#' which is recommended, because one may switch from 'transient' to
#' 'persistent' selection by holding the shift key.
#' @param dynamic should a widget for changing selection colors be included?
#' @param color character string of color(s) to use for
#' highlighting selections. See [toRGB()] for valid color
#' specifications. If `NULL` (the default), the color of selected marks
#' are not altered.
#' @param selectize whether or not to render a selectize.js widget for selecting
#' [highlight_key()] values. A list of additional selectize.js options may
#' also be provided. The label used for this widget should be set via the
#' `groupName` argument of [highlight_key()].
#' @param defaultValues a vector of values for setting a "default selection".
#' These values should match the key attribute.
#' @param opacityDim a number between 0 and 1 used to reduce the
#' opacity of non-selected traces (by multiplying with the existing opacity).
#' @param selected attributes of the selection, see [attrs_selected()].
#' @param debounce amount of time to wait before firing an event (in milliseconds).
#' The default of 0 means do not debounce at all.
#' Debouncing is mainly useful when `on = "plotly_hover"` to avoid firing too many events
#' when users clickly move the mouse over relevant graphical marks.
#' @param ... currently not supported.
#' @export
#' @author Carson Sievert
#' @references \url{https://plotly-r.com/client-side-linking.html}
#' @seealso [attrs_selected()]
#' @examplesIf interactive()
#'
#' # These examples are designed to show you how to highlight/brush a *single*
#' # view. For examples of multiple linked views, see `demo(package = "plotly")`
#'
#' d <- highlight_key(txhousing, ~city)
#' p <- ggplot(d, aes(date, median, group = city)) + geom_line()
#' gg <- ggplotly(p, tooltip = "city")
#' highlight(gg, dynamic = TRUE)
#'
#' # supply custom colors to the brush
#' cols <- toRGB(RColorBrewer::brewer.pal(3, "Dark2"), 0.5)
#' highlight(gg, on = "plotly_hover", color = cols, dynamic = TRUE)
#'
#' # Use attrs_selected() for complete control over the selection appearance
#' # note any relevant colors you specify here should override the color argument
#' s <- attrs_selected(
#' showlegend = TRUE,
#' mode = "lines+markers",
#' marker = list(symbol = "x")
#' )
#'
#' highlight(layout(gg, showlegend = TRUE), selected = s)
#'
highlight <- function(p, on = "plotly_click", off,
persistent = getOption("persistent", FALSE),
dynamic = FALSE, color = NULL,
selectize = FALSE, defaultValues = NULL,
opacityDim = getOption("opacityDim", 0.2),
selected = attrs_selected(), debounce = 0,
...) {
# currently ... is not-supported and will catch
# some arguments we supported at one point
dots <- list(...)
if (length(dots)) {
warning(
"The following arguments are not supported:\n",
toString(names(dots)), "\n",
"Arguments such as: hoverinfo and showInLegend \n",
"have been replaced by selected and other",
call. = FALSE
)
}
if (opacityDim < 0 || 1 < opacityDim) {
stop("opacityDim must be between 0 and 1", call. = FALSE)
}
if (dynamic && length(color) < 2) {
message("Adding more colors to the selection color palette.")
color <- c(color, RColorBrewer::brewer.pal(4, "Set1"))
}
if (!dynamic && length(color) > 1) {
warning(
"Can only use a single color for selections when `dynamic = FALSE`.",
call. = FALSE
)
color <- color[1]
}
# attach HTML dependencies (these libraries are used in the HTMLwidgets.renderValue() method)
# TODO: only attach these when keys are present!
if (!identical(selectize, FALSE)) {
p$dependencies <- c(p$dependencies, list(selectizeLib()))
}
if (dynamic) {
p$dependencies <- c(p$dependencies, list(colourPickerLib()))
}
# TODO: expose unhover?
off_options <- paste0(
"plotly_", c("doubleclick", "deselect", "relayout")
)
if (missing(off)) {
off_default <- switch(
on %||% "",
plotly_selecting = ,
plotly_selected = "plotly_deselect",
plotly_click = "plotly_doubleclick",
plotly_hover = "plotly_doubleclick"
)
off <- default(off_default %||% "plotly_relayout")
}
if (isTRUE(persistent)) {
message(
"We recommend setting `persistent` to `FALSE` (the default) because ",
"persistent selection mode can now be used by holding the shift key ",
"(while triggering the `on` event)."
)
}
# main (non-plotly.js) spec passed along to HTMLwidgets.renderValue()
p$x$highlight <- list(
# NULL may be used to disable on/off events
on = if (!is.null(on)) match.arg(on, paste0("plotly_", c("click", "hover", "selected", "selecting"))),
off = if (is.default(off)) off else if (!is.null(off)) match.arg(off, off_options),
persistent = persistent,
dynamic = dynamic,
# TODO: convert to hex...see colourpicker:::formatHEX()
color = toRGB(color),
selectize = selectize,
defaultValues = defaultValues,
opacityDim = opacityDim,
selected = selected,
debounce = debounce
)
p
}
#' Specify attributes of selection traces
#'
#' By default the name of the selection trace derives from the selected values.
#'
#'
#' @param opacity a number between 0 and 1 specifying the overall opacity of
#' the selected trace
#' @param ... other trace attributes attached to the selection trace.
#' @export
#' @author Carson Sievert
attrs_selected <- function(opacity = 1, ...) {
if (opacity < 0 || 1 < opacity) {
stop("opacity must be between 0 and 1", call. = FALSE)
}
args <- list(
opacity = opacity
)
# TODO: verify attr names... maybe that should happen in the build step?
dots <- list(...)
c(dots, args)
}
# ----------------------------------------------------------------------------
# Utility functions
# ----------------------------------------------------------------------------
highlight_defaults <- function() {
args <- formals(highlight)[-1]
# have to evaluate args now that some of them are functions...
compact(lapply(args, function(x) tryNULL(eval(x))))
}
selectizeLib <- function(bootstrap = TRUE) {
htmltools::htmlDependency(
name = "selectize",
version = "0.12.0",
package = "plotly",
src = dependency_dir("selectize"),
stylesheet = if (bootstrap) "selectize.bootstrap3.css",
script = "selectize.min.js"
)
}
colourPickerLib <- function() {
htmltools::htmlDependency(
name = "colourpicker",
version = "1.1",
package = "plotly",
src = dependency_dir("colourpicker"),
stylesheet = "colourpicker.min.css",
script = "colourpicker.min.js"
)
}
dependency_dir <- function(...) {
file.path('htmlwidgets', 'lib', ...)
}
|