Fix #2419, #2437: NA handling and subplot issues

.github/workflows/docs.yml

@@ -46,7 +46,7 @@ jobs:
       - name: Setup Ruby
         uses: ruby/setup-ruby@v1
         with:
-          ruby-version: '2.7.4'
+          ruby-version: '3.2'
           bundler-cache: true
 
       - name: Fetch R/ggplot2 docs from plotly.r-docs

NEWS.md

@@ -33,6 +33,8 @@ See the [plotly.js releases page](https://github.com/plotly/plotly.js/releases)
 * Closed #2467: `ggplotly()` now correctly shows legends and splits traces when scales have multiple aesthetics.
 * Closed #2407, #2187: `ggplotly()` now translates `legend.position` theme element to plotly layout (supports "bottom", "top", "left", and numeric positions).
 * Closed #2281: `ggplotly()` no longer drops legends when `geom_blank()` is present in the plot.
+* Closed #2419: `plot_ly()` with color mapping and `hovertemplate` no longer incorrectly connects line segments that should be separated by NA values.
+* Closed #2437: `subplot()` with pie charts no longer creates invalid "NA" layout attributes.
 
 # plotly 4.11.0
 

R/plotly_build.R

@@ -273,9 +273,21 @@ plotly_build.plotly <- function(p, registerFrames = TRUE) {
   traces <- list()
   for (i in seq_along(dats)) {
     d <- dats[[i]]
-    scaleAttrs <- names(d) %in% paste0(npscales(), "s")
-    traces <- c(traces, traceify(d[!scaleAttrs], d$.plotlyTraceIndex))
-    if (i == 1) traces[[1]] <- c(traces[[1]], d[scaleAttrs])
+    # Save .plotlyVariableMapping before traceify - it's metadata (column names)
+    # that shouldn't be subsetted like data columns. When its length happens to
+    # equal the number of rows, traceify would incorrectly subset it. (#2419)
+    variableMapping <- d$.plotlyVariableMapping
+    # Exclude .plotlyVariableMapping from traceify input
+    attrsToTraceify <- setdiff(names(d), ".plotlyVariableMapping")
+    scaleAttrs <- attrsToTraceify %in% paste0(npscales(), "s")
+    newTraces <- traceify(d[attrsToTraceify[!scaleAttrs]], d$.plotlyTraceIndex)
+    # Restore .plotlyVariableMapping to all new traces
+    newTraces <- lapply(newTraces, function(tr) {
+      tr$.plotlyVariableMapping <- variableMapping
+      tr
+    })
+    traces <- c(traces, newTraces)
+    if (i == 1) traces[[1]] <- c(traces[[1]], d[attrsToTraceify[scaleAttrs]])
   }
 
   # insert NAs to differentiate groups

R/subplots.R

@@ -127,16 +127,20 @@ subplot <- function(..., nrows = 1, widths = NULL, heights = NULL, margin = 0.02
     x$annotations[!axes]
   })
   # collect axis objects (note a _single_ geo/mapbox object counts a both an x and y)
+  # Note: only extract axes that actually exist in the layout. Plots like pie charts
+  # don't have cartesian axes and shouldn't contribute NA-named axis objects (#2437)
   xAxes <- lapply(layouts, function(lay) {
-    keys <- grep("^geo|^mapbox|^xaxis", names(lay), value = TRUE) %||% "xaxis"
+    keys <- grep("^geo|^mapbox|^xaxis", names(lay), value = TRUE)
+    if (!length(keys)) return(list())
     for (k in keys) {
       dom <- lay[[k]]$domain %||% c(0, 1)
       if ("x" %in% names(dom)) dom <- dom[["x"]]
     }
     lay[keys]
   })
   yAxes <- lapply(layouts, function(lay) {
-    keys <- grep("^geo|^mapbox|^yaxis", names(lay), value = TRUE) %||% "yaxis"
+    keys <- grep("^geo|^mapbox|^yaxis", names(lay), value = TRUE)
+    if (!length(keys)) return(list())
     for (k in keys) {
       dom <- lay[[k]]$domain %||% c(0, 1)
       if ("y" %in% names(dom)) dom <- dom[["y"]]
@@ -191,9 +195,9 @@ subplot <- function(..., nrows = 1, widths = NULL, heights = NULL, margin = 0.02
     length(plots), nrows, margin, widths = widths, heights = heights
   )
   for (i in seq_along(plots)) {
-    # map axis object names
-    xMap <- xAxisMap[[i]]
-    yMap <- yAxisMap[[i]]
+    # map axis object names (plots without axes, like pie charts, have no mapping)
+    xMap <- if (i <= length(xAxisMap)) xAxisMap[[i]] else character(0)
+    yMap <- if (i <= length(yAxisMap)) yAxisMap[[i]] else character(0)
     xAxes[[i]] <- setNames(xAxes[[i]], names(xMap))
     yAxes[[i]] <- setNames(yAxes[[i]], names(yMap))
     # for cartesian, bump corresponding axis anchor

tests/testthat/test-hard-issues.R

@@ -0,0 +1,209 @@
+# Tests for hard difficulty issue fixes
+# Following TDD: these tests are written FIRST before implementing fixes
+
+# Issue #2419: Two NAs per category cause incorrect line connection
+# When exactly 2 NA values exist per category with a hovertemplate,
+# lines incorrectly connect across the NAs instead of creating gaps.
+
+test_that("Issue #2419: exactly 2 NAs per category create gaps, not connected lines", {
+  df <- data.frame(
+    Category = rep(c("A", "B"), each = 6),
+    Date = c(2020, 2021, 2022, 2023, 2024, 2025, 2020, 2021, 2022, 2023, 2024, 2025),
+    Value = c(10, 15, NA, NA, 20, 25, 12, 14, NA, 22, NA, 27)
+  )
+  df$Date <- factor(df$Date, levels = unique(df$Date), ordered = TRUE)
+
+  p <- plot_ly(
+    df,
+    x = ~Date,
+    y = ~Value,
+    color = ~Category,
+    type = 'scatter',
+    mode = 'lines+markers',
+    text = ~Category,
+    hovertemplate = paste0("Date: %{x}<br>Category: %{text}")
+  )
+
+  built <- plotly_build(p)
+
+  # There should be 2 traces (one per category)
+  expect_equal(length(built$x$data), 2)
+
+  # For category A: values are 10, 15, NA, NA, 20, 25
+  # After NA handling, the y values should have NAs inserted to create gaps
+  traceA <- built$x$data[[1]]
+
+  # The key test: NAs should be present in the y data to create gaps
+
+  # If exactly 2 NAs are being connected incorrectly, this would fail
+  # We should see NA values in the output that separate the groups
+  expect_true(any(is.na(traceA$y)))
+
+  # For category B: values are 12, 14, NA, 22, NA, 27
+  traceB <- built$x$data[[2]]
+  expect_true(any(is.na(traceB$y)))
+})
+
+test_that("Issue #2419: single NA per category creates gaps correctly", {
+  df <- data.frame(
+    Category = rep(c("A", "B"), each = 6),
+    Date = c(2020, 2021, 2022, 2023, 2024, 2025, 2020, 2021, 2022, 2023, 2024, 2025),
+    Value = c(10, 15, NA, 18, 20, 25, 12, 14, NA, 22, 24, 27)
+  )
+  df$Date <- factor(df$Date, levels = unique(df$Date), ordered = TRUE)
+
+  p <- plot_ly(
+    df,
+    x = ~Date,
+    y = ~Value,
+    color = ~Category,
+    type = 'scatter',
+    mode = 'lines+markers',
+    text = ~Category,
+    hovertemplate = paste0("Date: %{x}<br>Category: %{text}")
+  )
+
+  built <- plotly_build(p)
+
+  # There should be 2 traces (one per category)
+  expect_equal(length(built$x$data), 2)
+
+  # Both traces should have NA values to create gaps
+  traceA <- built$x$data[[1]]
+  traceB <- built$x$data[[2]]
+  expect_true(any(is.na(traceA$y)))
+  expect_true(any(is.na(traceB$y)))
+})
+
+
+# Issue #2468: Pie chart color mapping doesn't work properly when aggregating data
+# When plotly.js aggregates pie chart data (duplicate labels), the marker.colors
+# don't apply correctly to the first slice.
+
+test_that("Issue #2468: pie chart colors apply correctly with aggregated data", {
+  # When there are 3 unique labels but more rows (so plotly aggregates),
+  # marker.colors should apply to all slices correctly
+  p <- plot_ly(
+    mtcars[, c("cyl", "drat")],
+    labels = ~cyl,
+    values = ~drat,
+    type = 'pie',
+    marker = list(colors = c("cyan", "magenta", "black"))
+  )
+
+  built <- plotly_build(p)
+
+  # The colors should be present in the marker (as-is, values preserved)
+  colors <- as.character(built$x$data[[1]]$marker$colors)
+  expect_equal(length(colors), 3)
+  expect_equal(colors, c("cyan", "magenta", "black"))
+})
+
+test_that("Issue #2468: pie chart colors work without aggregation", {
+  # Without aggregation (unique labels), colors should still work
+  p <- plot_ly(
+    mtcars[c(1, 3, 5), c("cyl", "drat")],
+    labels = ~cyl,
+    values = ~drat,
+    type = 'pie',
+    marker = list(colors = c("cyan", "magenta", "black"))
+  )
+
+  built <- plotly_build(p)
+
+  # The colors should be present in the marker (as-is, values preserved)
+  colors <- as.character(built$x$data[[1]]$marker$colors)
+  expect_equal(length(colors), 3)
+  expect_equal(colors, c("cyan", "magenta", "black"))
+})
+
+
+# Issue #2437: subplot() with bar and pie chart creates NA layout attribute
+# When combining bar and pie charts in a subplot, an NA attribute is created
+# in the layout, causing a warning.
+
+test_that("Issue #2437: subplot with bar and pie does not create NA layout attribute", {
+  bar_info <- data.frame(
+    Group = rep(c("first", "second", "third"), 2),
+    values_monthly = c(100, 200, 300, 400, 500, 600),
+    month = factor(rep(c("April", "May"), each = 3))
+  )
+  pie_info <- aggregate(values_monthly ~ Group, data = bar_info, sum)
+  names(pie_info)[2] <- "values_total"
+
+  colors <- c("red", "blue", "yellow")
+
+  bar_chart <- plot_ly(
+    bar_info,
+    type = "bar",
+    x = ~month,
+    y = ~values_monthly,
+    color = ~Group,
+    colors = colors
+  )
+
+  pie_chart <- plot_ly(
+    pie_info,
+    type = "pie",
+    labels = ~Group,
+    values = ~values_total,
+    marker = list(colors = colors),
+    domain = list(x = c(0.9, 1), y = c(0, 1)),
+    showlegend = FALSE
+  )
+
+  # Should not produce warnings about NA attributes
+  expect_no_warning({
+    combined_chart <- subplot(bar_chart, pie_chart, nrows = 1, widths = c(0.9, 0.1))
+  })
+
+  built <- plotly_build(combined_chart)
+
+  # Layout should not have any attributes with NA names
+  layout_names <- names(built$x$layout)
+  expect_false(any(is.na(layout_names)))
+  expect_false(any(grepl("^NA", layout_names)))
+})
+
+test_that("Issue #2437: subplot warnings about discrete/non-discrete data", {
+  bar_info <- data.frame(
+    Group = rep(c("first", "second", "third"), 2),
+    values_monthly = c(100, 200, 300, 400, 500, 600),
+    month = factor(rep(c("April", "May"), each = 3))
+  )
+  pie_info <- aggregate(values_monthly ~ Group, data = bar_info, sum)
+  names(pie_info)[2] <- "values_total"
+
+  colors <- c("red", "blue", "yellow")
+
+  bar_chart <- plot_ly(
+    bar_info,
+    type = "bar",
+    x = ~month,
+    y = ~values_monthly,
+    color = ~Group,
+    colors = colors
+  )
+
+  pie_chart <- plot_ly(
+    pie_info,
+    type = "pie",
+    labels = ~Group,
+    values = ~values_total,
+    marker = list(colors = colors),
+    domain = list(x = c(0.9, 1), y = c(0, 1)),
+    showlegend = FALSE
+  )
+
+  # Specifically check that no warning about NA attributes is thrown
+  warnings_caught <- character(0)
+  withCallingHandlers({
+    combined_chart <- subplot(bar_chart, pie_chart, nrows = 1, widths = c(0.9, 0.1))
+  }, warning = function(w) {
+    warnings_caught <<- c(warnings_caught, conditionMessage(w))
+    invokeRestart("muffleWarning")
+  })
+
+  # Should not have warning about 'NA' attribute
+  expect_false(any(grepl("NA", warnings_caught)))
+})