Makes the option to center the steps in geom_step() work

R/geom-path.r

@@ -264,8 +264,9 @@ GeomLine <- ggproto("GeomLine", GeomPath,
   }
 )
 
-#' @param direction direction of stairs: 'vh' for vertical then horizontal, or
-#'   'hv' for horizontal then vertical.
+#' @param direction direction of stairs: 'vh' for vertical then horizontal,
+#'   'hv' for horizontal then vertical, or 'mid' for step half-way between
+#'   adjacent x-values.
 #' @export
 #' @rdname geom_path
 geom_step <- function(mapping = NULL, data = NULL, stat = "identity",
@@ -299,12 +300,12 @@ GeomStep <- ggproto("GeomStep", GeomPath,
   }
 )
 
-# Calculate stairsteps
-# Used by [geom_step()]
-#
-# @keyword internal
-stairstep <- function(data, direction="hv") {
-  direction <- match.arg(direction, c("hv", "vh"))
+#' Calculate stairsteps for `geom_step()`
+#' Used by `GeomStep()`
+#'
+#' @noRd
+stairstep <- function(data, direction = "hv") {
+  direction <- match.arg(direction, c("hv", "vh", "mid"))
   data <- as.data.frame(data)[order(data$x), ]
   n <- nrow(data)
 
@@ -316,16 +317,27 @@ stairstep <- function(data, direction="hv") {
   if (direction == "vh") {
     xs <- rep(1:n, each = 2)[-2*n]
     ys <- c(1, rep(2:n, each = 2))
-  } else {
+  } else if (direction == "hv") {
     ys <- rep(1:n, each = 2)[-2*n]
     xs <- c(1, rep(2:n, each = 2))
+  } else if (direction == "mid") {
+    xs <- rep(1:(n-1), each = 2)
+    ys <- rep(1:n, each = 2)
+  } else {
+    stop("Parameter `direction` is invalid.")
+  }
+
+  if (direction == "mid") {
+    gaps <- data$x[-1] - data$x[-n]
+    mid_x <- data$x[-n] + gaps/2 # map the mid-point between adjacent x-values
+    x <- c(data$x[1], mid_x[xs], data$x[n])
+    y <- c(data$y[ys])
+    data_attr <- data[c(1,xs,n), setdiff(names(data), c("x", "y"))]
+  } else {
+    x <- data$x[xs]
+    y <- data$y[ys]
+    data_attr <- data[xs, setdiff(names(data), c("x", "y"))]
   }
 
-  new_data_frame(c(
-    list(
-      x = data$x[xs],
-      y = data$y[ys]
-    ),
-    data[xs, setdiff(names(data), c("x", "y"))]
-  ))
+  new_data_frame(c(list(x = x, y = y), data_attr))
 }

tests/testthat/test-geom-path.R

@@ -8,6 +8,40 @@ test_that("keep_mid_true drops leading/trailing FALSE", {
 })
 
 
+# Tests on stairstep() ------------------------------------------------------------
+
+test_that("stairstep() does not error with too few observations", {
+  df <- data_frame(x = 1, y = 1)
+  expect_silent(stairstep(df))
+})
+
+test_that("stairstep() exists with error when an invalid `direction` is given", {
+  df <- data_frame(x = 1:3, y = 1:3)
+  expect_error(stairstep(df, direction="invalid"))
+})
+
+test_that("stairstep() output is correct for direction = 'vh'", {
+  df <- data_frame(x = 1:3, y = 1:3)
+  stepped_expected <- data_frame(x = c(1L, 1L, 2L, 2L, 3L), y = c(1L, 2L, 2L, 3L, 3L))
+  stepped <- stairstep(df, direction = "vh")
+  expect_equal(stepped, stepped_expected)
+})
+
+test_that("stairstep() output is correct for direction = 'hv'", {
+  df <- data_frame(x = 1:3, y = 1:3)
+  stepped_expected <- data_frame(x = c(1L, 2L, 2L, 3L, 3L), y = c(1L, 1L, 2L, 2L, 3L))
+  stepped <- stairstep(df, direction = "hv")
+  expect_equal(stepped, stepped_expected)
+})
+
+test_that("stairstep() output is correct for direction = 'mid'", {
+  df <- data_frame(x = 1:3, y = 1:3)
+  stepped_expected <- data_frame(x = c(1, 1.5, 1.5, 2.5, 2.5, 3), y = c(1L, 1L, 2L, 2L, 3L, 3L))
+  stepped <- stairstep(df, direction = "mid")
+  expect_equal(stepped, stepped_expected)
+})
+
+
 # Visual tests ------------------------------------------------------------
 
 test_that("geom_path draws correctly", {