diff --git a/NEWS.md b/NEWS.md index 27e654f097..ebcc4e2d0e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,6 +11,7 @@ ## Bug fixes * Closed #2337: Creating a new `event_data()` handler no longer causes a spurious reactive update of existing `event_data()`s. (#2339) +* Closed #1883: Support factor variables for x and/or y when numeric variable is used to set color. (#1883) # 4.10.4 diff --git a/R/plotly_build.R b/R/plotly_build.R index ad9f62c704..52a4565814 100644 --- a/R/plotly_build.R +++ b/R/plotly_build.R @@ -872,9 +872,14 @@ map_color <- function(traces, stroke = FALSE, title = "", colorway, na.color = " # add an "empty" trace with the colorbar colorObj$color <- rng colorObj$showscale <- default(TRUE) + # extract range for numeric variables + xValues <- unlist(lapply(traces, "[[", "x")) + xValues <- if (is.numeric(xValues)) range(xValues, na.rm = TRUE) else xValues + yValues <- unlist(lapply(traces, "[[", "y")) + yValues <- if (is.numeric(yValues)) range(yValues, na.rm = TRUE) else yValues colorBarTrace <- list( - x = range(unlist(lapply(traces, "[[", "x")), na.rm = TRUE), - y = range(unlist(lapply(traces, "[[", "y")), na.rm = TRUE), + x = xValues, + y = yValues, type = if (any(types %in% glTypes())) "scattergl" else "scatter", mode = "markers", opacity = 0, @@ -885,7 +890,9 @@ map_color <- function(traces, stroke = FALSE, title = "", colorway, na.color = " # 3D needs a z property if ("scatter3d" %in% types) { colorBarTrace$type <- "scatter3d" - colorBarTrace$z <- range(unlist(lapply(traces, "[[", "z")), na.rm = TRUE) + zValues <- unlist(lapply(traces, "[[", "x")) + zValues <- if (is.numeric(zValues)) range(zValues, na.rm = TRUE) else zValues + colorBarTrace$z <- zValues } if (length(type <- intersect(c("scattergeo", "scattermapbox"), types))) { colorBarTrace$type <- type diff --git a/tests/testthat/test-plotly-color.R b/tests/testthat/test-plotly-color.R index 7a81297ac1..3401d1de39 100644 --- a/tests/testthat/test-plotly-color.R +++ b/tests/testthat/test-plotly-color.R @@ -20,6 +20,13 @@ test_that("Mapping a factor variable to color works", { expect_equivalent(length(cols), 3) }) +test_that("A scatterplot with a factor variable and discrete color works", { + d <- palmerpenguins::penguins + p <- plot_ly(d, x = ~bill_length_mm, y = ~sex, color = ~bill_depth_mm, + type = 'scatter', mode = 'markers') + l <- expect_traces(p, 2, "scatterplot-factor-continous-color") +}) + test_that("Custom RColorBrewer pallette works for factor variable", { d <- palmerpenguins::penguins %>% filter(!is.na(bill_length_mm))