RoxygenNote: 7.2.3

* Closed #2216: Additional selectize.js options can now be passed along to `highlight()`'s `selectize` argument. (#2217)

* Closed #2218: `highlight(selectize = TRUE)` no longer yields an incorrect selectize.js result when there is a combination of crosstalk and non-crosstalk traces. (#2217)

* Closed #2208: `ggplotly()` no longer errors given a `geom_area()` with 1 or less data points (error introduced by new behavior in ggplot2 v3.4.0). (#2209)

if (!identical(selectize, FALSE)) {

# Grab the special "crosstalk set" (i.e., group) for each trace

sets <- lapply(p$x$data, "[[", "set")

noSet <- vapply(sets, is.null, logical(1))

# If no sets are present, there's nothing more to do

if (all(noSet)) {

return(p)

}

# Store the unique set of crosstalk sets (which gets looped over client-side)

p$x$highlight$ctGroups <- i(unique(unlist(sets)))

# Build a set -> key mapping for each relevant trace, which we'll use

# to set default values and/or build the selectize.js payload (if relevant)

setDat <- p$x$data[!noSet]

keys <- setNames(lapply(setDat, "[[", "key"), sets[!noSet])

# Get all the keys for this crosstalk group

if (length(k) == 0) next

vals <- intersect(p$x$highlight$defaultValues, k)

# include one selectize dropdown per "valid" SharedData layer

selectize <- p$x$highlight$selectize %||% FALSE

if (!identical(selectize, FALSE)) {

options <- list(items = data.frame(value = k, label = k), group = i)

if (!is.logical(selectize)) {

options <- modify_list(options, selectize)

}

# Hash i (the crosstalk group id) so that it can be used

# as an HTML id client-side (i.e., key shouldn't contain spaces)

groupId <- rlang::hash(i)

# If the selectize payload has already been built, use that already built payload

# (since it may have been modified at this point), unless there are new keys to consider

oldSelectize <- p$x$selectize[[groupId]]

if (length(oldSelectize) > 0) {

missingKeys <- setdiff(k, oldSelectize$items$value)

if (length(missingKeys) > 0) {

warning("Overwriting the existing selectize payload for group '", i, "'. If you've previously modified this payload in some way, consider modifying it again.")

} else {

options <- oldSelectize

}

}

p$x$selectize[[groupId]] <- options

}

# set a sensible dragmode default, & throw messages

p$x$layout$dragmode <- p$x$layout$dragmode %|D|%

default(switch(p$x$highlight$on %||% "", plotly_selected = "select", plotly_selecting = "select") %||% "zoom")

if (is.default(p$x$highlight$off)) {

message(

sprintf(

"Setting the `off` event (i.e., '%s') to match the `on` event (i.e., '%s'). You can change this default via the `highlight()` function.",

p$x$highlight$off, p$x$highlight$on

)

var options = x.selectize[selectizeID];

var opts = $.extend({

options: first.concat(options.items),

searchField: "label",

valueField: "value",

labelField: "label",

maxItems: 50

},

options

);

test_that("highlight(selectize) produces a sensible payload", {

p <- plot_ly() %>%

add_lines(data = mtcars, x = ~wt, y = ~mpg) %>%

add_markers(

data = highlight_key(mtcars, ~cyl, "Choose cylinder"),

x = ~wt, y = ~mpg

)

# Builds basic payload when selectize=TRUE

b <- p %>%

highlight(selectize = TRUE) %>%

plotly_build()

selectize <- list(

items = data.frame(value = c(6, 4, 8), label = c(6, 4, 8)),

group = "Choose cylinder"

)

expect_length(b$x$selectize, 1)

expect_equal(b$x$selectize[[1]], selectize)

# Copies over any list() options

b2 <- p %>%

highlight(selectize = list(plugins = list("remove_button"))) %>%

plotly_build()

selectize$plugins <- list("remove_button")

expect_length(b2$x$selectize, 1)

expect_equal(b2$x$selectize[[1]], selectize)

# Can also tack on options after building, and plotly_build() won't overwrite

b2$x$selectize[[1]] <- modifyList(

b2$x$selectize[[1]], list(foo = "bar")

)

b2 <- plotly_build(b2)

selectize$foo <- "bar"

expect_equal(b2$x$selectize[[1]], selectize)

})