diff --git a/NEWS.md b/NEWS.md index 71d932d6b1..d78140f474 100644 --- a/NEWS.md +++ b/NEWS.md @@ -26,6 +26,10 @@ See the [plotly.js releases page](https://github.com/plotly/plotly.js/releases) ## Bug fixes * `plotly_build()` now works with `ggmatrix` objects (e.g., from `GGally::ggpairs()`). (#2447) +* Cross-trace layout attributes (`bargroupgap`, `boxmode`, `violingap`, etc.) no longer produce errant warnings. (#2458) +* `ggplotly()` now correctly uses custom legend labels from `scale_*_manual(labels = ...)`. (#2420) +* `ggplotly()` with `dynamicTicks = TRUE` no longer errors on grouped `geom_line()` plots. (#2462) +* `plot_ly()` with color mapping no longer resets Date/POSIXct x-axis values to 1970. (#2446) * Closed #2415: `ggplotly()` now shows variables named 'group' in tooltips when mapped to aesthetics like `colour`. * Closed #2455, #2460: `ggplotly()` no longer creates empty shapes when `panel.border` is `element_blank()` (ggplot2 4.0.0 compatibility). * Closed #2466: `ggplotly()` no longer errors when `scale_*_manual()` has unused aesthetics (e.g., `aesthetics = c("colour", "fill")` when only colour is used). diff --git a/R/ggplotly.R b/R/ggplotly.R index a37804dd9e..e97a7e8442 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -845,10 +845,12 @@ gg2list <- function(p, width = NULL, height = NULL, # inverse transform categorical data based on tickvals/ticktext if (isDiscreteType) { - traces <- lapply(traces, function(tr) { + traces <- lapply(traces, function(tr) { # map x/y trace data back to the 'closest' ticktext label # http://r.789695.n4.nabble.com/check-for-nearest-value-in-a-vector-td4369339.html tr[[xy]]<- vapply(tr[[xy]], function(val) { + # NA values (e.g., geom_line gaps) should remain NA + if (is.na(val)) return(NA_character_) with(axisObj, ticktext[[which.min(abs(tickvals - val))]]) }, character(1)) tr diff --git a/R/layers2traces.R b/R/layers2traces.R index 181ef72909..5717b9adb0 100644 --- a/R/layers2traces.R +++ b/R/layers2traces.R @@ -139,8 +139,28 @@ layers2traces <- function(data, prestats_data, layout, p) { # note: this allows us to control multiple traces from one legend entry if (any(split_legend %in% names(d))) { nms <- strsplit(names(trs), separator, fixed = TRUE) + # Build mapping from domain values to scale labels (for custom labels) + legend_aes <- sub("_plotlyDomain$", "", split_legend) + value_to_label <- list() + for (aes in legend_aes) { + sc <- discreteScales[[aes]] + if (!is.null(sc)) { + breaks <- tryCatch(sc$get_breaks(), error = function(e) NULL) + labels <- tryCatch(sc$get_labels(), error = function(e) NULL) + if (length(breaks) > 0 && length(breaks) == length(labels)) { + value_to_label[[aes]] <- setNames(as.character(labels), as.character(breaks)) + } + } + } nms <- vapply(nms, function(x) { y <- unique(x[seq_along(split_legend)]) + # Map domain values to scale labels if custom labels exist + for (j in seq_along(y)) { + aes <- legend_aes[j] + if (aes %in% names(value_to_label) && y[j] %in% names(value_to_label[[aes]])) { + y[j] <- value_to_label[[aes]][y[j]] + } + } if (length(y) > 1) paste0("(", paste(y, collapse = ","), ")") else y }, character(1)) trs <- Map(function(x, y) { diff --git a/R/plotly_build.R b/R/plotly_build.R index 3bdd432601..acfacd0450 100644 --- a/R/plotly_build.R +++ b/R/plotly_build.R @@ -877,9 +877,10 @@ map_color <- function(traces, stroke = FALSE, title = "", colorway, na.color = " # add an "empty" trace with the colorbar colorObj$color <- rng colorObj$showscale <- default(TRUE) + # Use do.call(c, ...) instead of unlist() to preserve Date/POSIXct classes colorBarTrace <- list( - x = range(unlist(lapply(traces, "[[", "x")), na.rm = TRUE), - y = range(unlist(lapply(traces, "[[", "y")), na.rm = TRUE), + x = range(do.call(c, lapply(traces, "[[", "x")), na.rm = TRUE), + y = range(do.call(c, lapply(traces, "[[", "y")), na.rm = TRUE), type = if (any(types %in% glTypes())) "scattergl" else "scatter", mode = "markers", opacity = 0, @@ -890,7 +891,7 @@ 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) + colorBarTrace$z <- range(do.call(c, lapply(traces, "[[", "z")), na.rm = TRUE) } if (length(type <- intersect(c("scattergeo", "scattermapbox"), types))) { colorBarTrace$type <- type diff --git a/R/utils.R b/R/utils.R index b558e12b03..2ae386df03 100644 --- a/R/utils.R +++ b/R/utils.R @@ -447,9 +447,19 @@ supply_highlight_attrs <- function(p) { # make sure plot attributes adhere to the plotly.js schema verify_attr_names <- function(p) { # some layout attributes (e.g., [x-y]axis can have trailing numbers) + # Cross-trace layout attrs (bar/box/violin/funnel/waterfall) are not in the + # plotly.js schema's layoutAttributes, but are valid and must be whitelisted + cross_trace_attrs <- c( + "barmode", "barnorm", "bargap", "bargroupgap", + "boxmode", "boxgap", "boxgroupgap", + "violinmode", "violingap", "violingroupgap", + "funnelmode", "funnelgap", "funnelgroupgap", + "waterfallmode", "waterfallgap", "waterfallgroupgap", + "mapType" + ) attrs_name_check( sub("[0-9]+$", "", names(p$x$layout)), - c(names(Schema$layout$layoutAttributes), c("boxmode", "barmode", "bargap", "mapType")), + c(names(Schema$layout$layoutAttributes), cross_trace_attrs), "layout" ) attrs_name_check( diff --git a/tests/testthat/test-issue-fixes.R b/tests/testthat/test-issue-fixes.R new file mode 100644 index 0000000000..fd9f0a3757 --- /dev/null +++ b/tests/testthat/test-issue-fixes.R @@ -0,0 +1,150 @@ +# Tests for specific issue fixes + +# Issue #2458: bargroupgap and other layout attributes should not warn +test_that("Cross-trace layout attributes do not produce warnings", { + p <- plot_ly(x = 1:3, y = 1:3, type = "bar") + + # Bar attributes + expect_silent(plotly_build(layout(p, bargroupgap = 0.1))) + expect_silent(plotly_build(layout(p, barnorm = "fraction"))) + + # Box attributes + expect_silent(plotly_build(layout(p, boxmode = "group"))) + expect_silent(plotly_build(layout(p, boxgap = 0.1))) + expect_silent(plotly_build(layout(p, boxgroupgap = 0.1))) + + # Violin attributes + expect_silent(plotly_build(layout(p, violinmode = "group"))) + expect_silent(plotly_build(layout(p, violingap = 0.1))) + expect_silent(plotly_build(layout(p, violingroupgap = 0.1))) + + # Funnel attributes + expect_silent(plotly_build(layout(p, funnelmode = "group"))) + expect_silent(plotly_build(layout(p, funnelgap = 0.1))) + expect_silent(plotly_build(layout(p, funnelgroupgap = 0.1))) + + # Waterfall attributes + expect_silent(plotly_build(layout(p, waterfallmode = "group"))) + expect_silent(plotly_build(layout(p, waterfallgap = 0.1))) + expect_silent(plotly_build(layout(p, waterfallgroupgap = 0.1))) +}) + +# Issue #2420: ggplotly legend should use scale labels +test_that("ggplotly legend uses custom scale labels", { + d <- data.frame(X = 1:5, Y = 1:5) + + # Test with scale_color_manual labels + + gg <- ggplot(d, aes(x = X, y = Y, col = "value1")) + + geom_point() + + scale_color_manual(values = c("blue"), labels = c("Custom Label")) + + p <- ggplotly(gg) + built <- plotly_build(p) + + # The trace name should be "Custom Label", not "value1" + expect_equal(built$x$data[[1]]$name, "Custom Label") + expect_equal(built$x$data[[1]]$legendgroup, "Custom Label") +}) + +test_that("ggplotly legend uses custom labels with multiple values", { + d <- data.frame(X = 1:10, Y = (1:10)^2, grp = rep(c("a", "b"), 5)) + + gg <- ggplot(d, aes(x = X, y = Y, col = grp)) + + geom_point() + + scale_color_manual( + values = c("a" = "red", "b" = "blue"), + labels = c("a" = "Group A", "b" = "Group B") + ) + + p <- ggplotly(gg) + built <- plotly_build(p) + + # Get trace names + trace_names <- sapply(built$x$data, function(tr) tr$name) + trace_names <- trace_names[!is.na(trace_names)] + + expect_true("Group A" %in% trace_names) + expect_true("Group B" %in% trace_names) + expect_false("a" %in% trace_names) + expect_false("b" %in% trace_names) +}) + +# Issue #2462: dynamicTicks with grouped geom_line should not error +test_that("dynamicTicks works with grouped geom_line", { + df <- data.frame( + time = factor(rep(c("t1", "t2"), 4)), + value = c(1.25, 1.5, 2, 1.75, 1.25, 0.25, 3, 3.5), + grp = factor(rep(1:4, each = 2)) + ) + + p <- ggplot(df, aes(x = time, y = value)) + + geom_line(aes(group = grp)) + + # This should not error (previously failed with "attempt to select less than one element") + expect_silent(built <- plotly_build(ggplotly(p, dynamicTicks = TRUE))) + + # Verify the data contains NA values (from group2NA) that are preserved + trace_x <- built$x$data[[1]]$x + expect_true(any(is.na(trace_x))) + + # Non-NA values should be categorical labels + non_na_x <- trace_x[!is.na(trace_x)] + expect_true(all(non_na_x %in% c("t1", "t2"))) +}) + +# Issue #2446: Date class should be preserved in colorbar trace +test_that("Date class is preserved in colorbar trace", { + df <- data.frame( + y = 1:10, + rank = sample(1:100, 10), + datetime = seq(as.Date("2022-01-01"), by = "day", length.out = 10) + ) + + p <- plot_ly(df, type = "scatter", mode = "markers") %>% + add_trace(x = ~datetime, y = ~y, color = ~rank) + + built <- plotly_build(p) + + + # Find the main data trace (not the empty first trace or colorbar) + data_trace <- NULL + for (tr in built$x$data) { + if (!is.null(tr[["x"]]) && length(tr[["x"]]) > 2) { + data_trace <- tr + break + } + } + + expect_false(is.null(data_trace)) + expect_s3_class(data_trace[["x"]], "Date") + + # The x values should be in 2022, not 1970 + expect_true(all(data_trace[["x"]] >= as.Date("2022-01-01"))) + expect_true(all(data_trace[["x"]] <= as.Date("2022-12-31"))) +}) + +test_that("POSIXct class is preserved in colorbar trace", { + df <- data.frame( + y = 1:10, + rank = sample(1:100, 10), + datetime = seq(as.POSIXct("2022-01-01"), by = "day", length.out = 10) + ) + + p <- plot_ly(df, type = "scatter", mode = "markers") %>% + add_trace(x = ~datetime, y = ~y, color = ~rank) + + built <- plotly_build(p) + + # Find the main data trace + data_trace <- NULL + for (tr in built$x$data) { + if (!is.null(tr[["x"]]) && length(tr[["x"]]) > 2) { + data_trace <- tr + break + } + } + + expect_false(is.null(data_trace)) + expect_s3_class(data_trace[["x"]], "POSIXt") +})