flip = TRUE: flip the drawn geometry of "h" and the step types

NEWS.md

@@ -47,6 +47,10 @@ where the formatting is also better._
 
 ### Bug fixes
 
+- `flip = TRUE` now flips the drawn geometry of the single-letter line types,
+  not just the axes: `type = "h"` draws horizontal segments to the baseline,
+  and the step types `"s"` and `"S"` swap which coordinate moves first.
+  (#675 @haomeng797-ship-it)
 - Fixed several bugs specific to plots with free facets (i.e.,
   `facet.args = list(free = TRUE)`):
   - Single-valued discrete axes no longer trigger invalid `par(usr)` values.

R/type_lines.R

@@ -77,12 +77,37 @@ data_lines = function(dodge = 0, fixed.dodge = FALSE) {
 
 
 draw_lines = function(type = "l") {
-    fun = function(ix, iy, icol, ipch, ibg, ilty, ilwd, icex = 1, ...) {
+    fun = function(ix, iy, icol, ipch, ibg, ilty, ilwd, icex = 1, flip = FALSE, ...) {
+        ltype = type
+        if (isTRUE(flip)) {
+            # flip_datapoints() has already swapped the coordinates, but the
+            # base engine still draws these types in fixed orientations:
+            # type = "h" always drops vertically, and the step types commit
+            # to which coordinate moves first. So draw "h" as explicit
+            # horizontal segments to the baseline, and mirror the step order.
+            if (ltype == "h") {
+                x0 = if (par("xlog")) 10^par("usr")[1] else 0
+                segments(
+                    x0 = x0,
+                    y0 = iy,
+                    x1 = ix,
+                    y1 = iy,
+                    col = icol,
+                    lty = ilty,
+                    lwd = ilwd
+                )
+                return(invisible(NULL))
+            } else if (ltype == "s") {
+                ltype = "S"
+            } else if (ltype == "S") {
+                ltype = "s"
+            }
+        }
         lines(
             x = ix,
             y = iy,
             col = icol,
-            type = type,
+            type = ltype,
             pch = ipch,
             bg = ibg,
             lty = ilty,

inst/tinytest/test-flip.R

@@ -113,3 +113,52 @@ f = function() {
   tinyplot(x_dt, y, grid = TRUE, flip = TRUE)
 }
 expect_snapshot_plot(f, label = "flip_date")
+
+
+# flipped single-letter line types keep their geometry (#675)
+# These checks read the SVG output directly, so they run on every OS.
+
+svg_of = function(...) {
+  tf = tempfile(fileext = ".svg")
+  svglite::svglite(tf)
+  tinyplot(...)
+  dev.off()
+  readLines(tf)
+}
+
+num_attr = function(el, attr) {
+  as.numeric(sub(sprintf(".*%s='([^']*)'.*", attr), "\\1", el))
+}
+
+first_step = function(svg) {
+  pl = grep("<polyline ", svg, value = TRUE)[1]
+  pts = strsplit(sub(".*points='([^']*)'.*", "\\1", pl), " ")[[1]]
+  xy = do.call(rbind, lapply(strsplit(pts, ","), as.numeric))
+  xy[2, ] - xy[1, ]
+}
+
+x = 1:5
+y = c(10, 20, 30, 40, 50)
+
+# type = "h" with flip draws one horizontal segment per point
+svg = svg_of(x, y, type = "h", flip = TRUE, axes = FALSE)
+seg = grep("<line ", svg, value = TRUE)
+expect_equal(length(seg), length(x))
+expect_true(all(abs(num_attr(seg, "y1") - num_attr(seg, "y2")) < 1e-6))
+expect_true(all(abs(num_attr(seg, "x2") - num_attr(seg, "x1")) > 1))
+
+# unflipped "h" still draws vertical drops
+svg = svg_of(x, y, type = "h", axes = FALSE)
+seg = grep("<line ", svg, value = TRUE)
+expect_equal(length(seg), length(x))
+expect_true(all(abs(num_attr(seg, "x1") - num_attr(seg, "x2")) < 1e-6))
+
+# flipping swaps which coordinate moves first in the step types
+d = first_step(svg_of(x, y, type = "s", flip = TRUE, axes = FALSE))
+expect_true(abs(d[1]) < 1e-6 && abs(d[2]) > 1)
+
+d = first_step(svg_of(x, y, type = "S", flip = TRUE, axes = FALSE))
+expect_true(abs(d[1]) > 1 && abs(d[2]) < 1e-6)
+
+d = first_step(svg_of(x, y, type = "s", axes = FALSE))
+expect_true(abs(d[1]) > 1 && abs(d[2]) < 1e-6)