Contour removes duplicates (#5243)

* de-duplicate contours

* Add de-duplication test

* Add NEWS bullet

Author: teunbrand

NEWS.md

@@ -1,5 +1,7 @@
 # ggplot2 (development version)
 
+* `stat_contour()` and `stat_contour_filled()` now warn about and remove
+  duplicated coordinates (@teunbrand, #5215).
 * `annotation_logticks()` skips drawing ticks when the scale range is non-finite
   instead of throwing an error (@teunbrand, #5229).
 * Fixed spurious warnings when the `weight` was used in `stat_bin_2d()`, 

R/stat-contour.R

@@ -98,6 +98,10 @@ StatContour <- ggproto("StatContour", Stat,
     params
   },
 
+  setup_data = function(data, params) {
+    contour_deduplicate(data)
+  },
+
   compute_group = function(data, scales, z.range, bins = NULL, binwidth = NULL,
                            breaks = NULL, na.rm = FALSE) {
 
@@ -129,6 +133,10 @@ StatContourFilled <- ggproto("StatContourFilled", Stat,
     params
   },
 
+  setup_data = function(data, params) {
+    contour_deduplicate(data)
+  },
+
   compute_group = function(data, scales, z.range, bins = NULL, binwidth = NULL, breaks = NULL, na.rm = FALSE) {
     breaks <- contour_breaks(z.range, bins, binwidth, breaks)
 
@@ -352,3 +360,30 @@ pretty_isoband_levels <- function(isoband_levels, dig.lab = 3) {
   # and open at their upper boundary
   sprintf("(%s, %s]", label_low, label_high)
 }
+
+#' De-duplicate data for contours
+#'
+#' Gives a warning if data has duplicates and throws out duplicated rows.
+#'
+#' @param data A `data.frame`
+#' @param check Column names to check for duplicates
+#'
+#' @return A de-duplicated `data.frame`
+#' @noRd
+contour_deduplicate <- function(data, check = c("x", "y", "group", "PANEL")) {
+  check <- intersect(check, names(data))
+  if (length(check) == 0) {
+    return(data)
+  }
+  if (vec_duplicate_any(data[, check, drop = FALSE])) {
+    # We use fromLast here to be consistent with `isoband_z_matrix()` behaviour
+    dups <- duplicated(data[, check, drop = FALSE], fromLast = TRUE)
+    data <- data[!dups, , drop = FALSE]
+
+    cli::cli_warn(c(
+      "Contour data has duplicated {.field x}, {.field y} coordinates.",
+      i = "{sum(dups)} duplicated row{?s} have been dropped."
+    ))
+  }
+  data
+}

tests/testthat/test-stat-contour.R

@@ -80,3 +80,23 @@ test_that("basic stat_contour_filled() plot builds", {
   # implementation in isoband
   expect_silent(ggplot_build(p))
 })
+
+test_that("stat_contour() removes duplicated coordinates", {
+
+  df <- data_frame0(
+    x = c(1, 1, 2, 2, 1, 1, 2, 2),
+    y = c(1, 2, 1, 2, 1, 2, 1, 2),
+    z = c(1, 0, 0, 1, 1, 0, 0, 1),
+    group = c(1, 1, 1, 1, 2, 2, 2, 2)
+  )
+
+  layer <- stat_contour()
+
+  expect_silent(layer$stat$setup_data(df))
+  expect_warning(
+    new <- layer$stat$setup_data(transform(df, group = 1)),
+    "has duplicated"
+  )
+  expect_equal(new, df[1:4,], ignore_attr = TRUE)
+})
+