type_abline()-alike now respect flip = TRUE

NEWS.md

@@ -229,6 +229,11 @@ related to plot layering. See "Bug fixes" below.
 
 - `type_text()` no longer converts a categorical axis to a numeric one.
   (#730 @grantmcdermott)
+- `type_hline()`, `type_vline()`, and `type_abline()` now respect
+  `flip = TRUE`, so that (e.g.) `h` refers to the flipped `y` variable and is
+  drawn vertically. Code that previously used `type_vline()` as a workaround
+  for a vertical line on a flipped plot should switch to `type_hline()`, and
+  vice versa. (#733 @grantmcdermott)
 - The `adjust` argument of `type_density()`, `type_violin()`, and
   `type_ridge()` was accepted but never passed on to the underlying
   `density()` call, so it silently did nothing. (#734 @grantmcdermott)

R/type_abline.R

@@ -5,6 +5,11 @@
 #' While `type_abline`, `type_hline`, and `type_vline` can be called in a base
 #' plot layer, we expect that they will typically be called as subsequent
 #' layers via [`tinyplot_add`].
+#'
+#' Line parameters always refer to the original (pre-flip) variables. So, if
+#' `flip = TRUE`, then `type_hline()` draws vertical line(s) at the given `y`
+#' value(s), `type_vline()` draws horizontal line(s) at the given `x` value(s),
+#' and `type_abline()` draws the line \eqn{y = a + bx} with the axes swapped.
 #' @section Recycling logic:
 #' The recycling behaviour of the line parameters (i.e., `a`, `b`, `h`, or `v`)
 #' is adaptive, depending on whether `by` or `facet` grouping is detected. While
@@ -72,6 +77,16 @@
 #' tinyplot_add(type = type_vline(with(mtcars, tapply(hp, cyl, mean))), lty = 2)
 #'
 #' #
+#' ## Flipped plots
+#'
+#' # Line parameters refer to the original x and y variables, so "hline" is
+#' # drawn vertically and "vline" horizontally when flip = TRUE
+#' tinyplot(mpg ~ wt, data = mtcars, flip = TRUE)
+#' tinyplot_add(type = type_hline(20), col = "hotpink")
+#' tinyplot_add(type = type_vline(3), col = "dodgerblue")
+#' tinyplot_add(type = type_abline(a = 37, b = -5), lty = 2)
+#'
+#' #
 #' ## Recycling logic
 #'
 #' # length(h) == no. of groups
@@ -92,82 +107,99 @@
 #'
 #' @export
 type_abline = function(a = 0, b = 1) {
-  data_abline = function(settings, ...) {
+  ablines_type(a = a, b = b, name = "abline")
+}
+
+
+# Shared internals for type_abline(), type_hline(), and type_vline()
+ablines_type = function(a = NULL, b = NULL, h = NULL, v = NULL, name) {
+  params = switch(name,
+    abline = list(a = a, b = b),
+    hline = list(h = h),
+    vline = list(v = v)
+  )
+  for (p in names(params)) assert_numeric(params[[p]], name = p)
+  data_ablines = function(settings, ...) {
     env2env(settings, environment(), c("datapoints", "lwd", "lty", "col"))
     if (nrow(datapoints) == 0) {
-      msg = "`type_abline() only works on existing plots with x and y data points."
+      msg = sprintf(
+        "`type_%s()` only works on existing plots with x and y data points.",
+        name
+      )
       stop(msg, call. = FALSE)
     }
     # keep track of unique lty and lwd (needed for group catch / escape hatch
-    # later in draw_hline)
-    ul_lwd = length(unique(lwd))
-    ul_lty = length(unique(lty))
-    ul_col = length(unique(col))
-    type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col)
+    # later in draw_ablines)
+    type_info = list(
+      ul_lty = length(unique(lty)),
+      ul_lwd = length(unique(lwd)),
+      ul_col = length(unique(col))
+    )
     env2env(environment(), settings, "type_info")
   }
-  draw_abline = function() {
-    fun = function(ifacet, iby, data_facet, icol, ilty, ilwd,
-                   ngrps, nfacets, by_continuous, facet_by,
-                   type_info,
-                   ...) {
-      # flag for aesthetics by groups
-      grp_aes = type_info[["ul_col"]] == 1 || type_info[["ul_lty"]] == ngrps || type_info[["ul_lwd"]] == ngrps
-
-      if (length(a) != 1) {
-        if (!length(a) %in% c(ngrps, nfacets, ngrps * nfacets)) {
-          msg = "Length of 'a' must be 1, or equal to the number of facets or number of groups (or product thereof)."
-          stop(msg, call. = FALSE)
-        }
-        if (!facet_by && length(a) == nfacets) {
-          a = a[ifacet]
-          if (!grp_aes && type_info[["ul_col"]] != ngrps) {
-            icol = 1
-          } else if (by_continuous) {
-            icol = 1
-          }
-        } else if (!by_continuous && length(a) == ngrps * nfacets) {
-          a = a[ifacet * ngrps - c(ngrps - iby)]
-        } else if (!by_continuous) {
-          a = a[iby]
-        }
-      } else if (!grp_aes) {
-        icol = 1
-      }
+  draw_ablines = function(ifacet, iby, data_facet, icol, ilty, ilwd,
+                          ngrps, nfacets, by_continuous, facet_by,
+                          type_info, flip = FALSE,
+                          ...) {
+    # flag for aesthetics by groups
+    grp_aes = type_info[["ul_col"]] == 1 ||
+      type_info[["ul_lty"]] == ngrps ||
+      type_info[["ul_lwd"]] == ngrps
 
-      if (length(b) != 1) {
-        if (!length(b) %in% c(ngrps, nfacets, ngrps * nfacets)) {
-          msg = "Length of 'b' must be 1, or equal to the number of facets or number of groups (or product thereof)."
+    # recycle each line parameter across groups and/or facets
+    for (p in names(params)) {
+      val = params[[p]]
+      if (length(val) != 1) {
+        if (!length(val) %in% c(ngrps, nfacets, ngrps * nfacets)) {
+          msg = sprintf(
+            "Length of '%s' must be 1, or equal to the number of facets or number of groups (or product thereof).",
+            p
+          )
           stop(msg, call. = FALSE)
         }
-        if (!facet_by && length(b) == nfacets) {
-          b = b[ifacet]
-          if (!grp_aes && type_info[["ul_col"]] != ngrps) {
-            icol = 1
-          } else if (by_continuous) {
+        if (!facet_by && length(val) == nfacets) {
+          val = val[ifacet]
+          if ((!grp_aes && type_info[["ul_col"]] != ngrps) || by_continuous) {
             icol = 1
           }
-        } else if (!by_continuous && length(b) == ngrps * nfacets) {
-          b = b[ifacet * ngrps - c(ngrps - iby)]
+        } else if (!by_continuous && length(val) == ngrps * nfacets) {
+          val = val[ifacet * ngrps - c(ngrps - iby)]
         } else if (!by_continuous) {
-          b = b[iby]
+          val = val[iby]
         }
       } else if (!grp_aes) {
         icol = 1
       }
+      params[[p]] = val
+    }
 
-      if (type_info[["ul_col"]] != 1 && !(type_info[["ul_lty"]] == ngrps || type_info[["ul_lwd"]] == ngrps)) {
-        icol = 1
-      }
+    if (name == "abline" && type_info[["ul_col"]] != 1 &&
+      !(type_info[["ul_lty"]] == ngrps || type_info[["ul_lwd"]] == ngrps)) {
+      icol = 1
+    }
 
-      abline(a = a, b = b, col = icol, lty = ilty, lwd = ilwd)
+    # Line parameters refer to the original (pre-flip) variables, so under flip
+    # we swap orientation: h <-> v, and y = a + b*x becomes x = (y - a) / b in
+    # plotting coordinates (i.e., a vertical line if b == 0). Note that abline()
+    # only uses the first a/b values, so we only check the first slope.
+    if (isTRUE(flip)) {
+      params = switch(name,
+        hline = list(v = params[["h"]]),
+        vline = list(h = params[["v"]]),
+        abline = if (params[["b"]][1] == 0) {
+          list(v = params[["a"]])
+        } else {
+          list(a = -params[["a"]] / params[["b"]], b = 1 / params[["b"]])
+        }
+      )
     }
-    return(fun)
+
+    do.call(abline, c(params, list(col = icol, lty = ilty, lwd = ilwd)))
   }
   out = list(
-    draw = draw_abline(),
-    data = data_abline,
-    name = "abline"
+    draw = draw_ablines,
+    data = data_ablines,
+    name = name
   )
   class(out) = "tinyplot_type"
   return(out)

R/type_barplot.R

@@ -213,7 +213,7 @@
 #'   flip = TRUE, yaxl = "percent",
 #'   theme = list("clean2", palette.qualitative = hcols)
 #' )
-#' tinyplot_add(type = "vline", col = "white")
+#' tinyplot_add(type = "hline", col = "white") # "hline" b/c flip = TRUE
 #'
 #' #
 #' ## Offset examples
@@ -255,8 +255,8 @@
 #'   theme = list("clean2", palette.qualitative = pal),
 #'   main = "Hypothetical Likert example with category offset"
 #' )
-#' tinyplot_add(type = "vline")
-#' tinyplot_add(type = "vline", v = 1, lty = 2)
+#' tinyplot_add(type = "hline") # "hline" b/c flip = TRUE
+#' tinyplot_add(type = type_hline(1), lty = 2) # ditto
 #'
 #' #
 #' ## Implicit zeros and empty cells (see the section of the same name above)

R/type_errorbar.R

@@ -62,7 +62,7 @@
 #' tinytheme("classic")
 #' tinyplot(est ~ term, ymin = lwr, ymax = upr, data = coefs, type = "errorbar",
 #'          flip = TRUE)
-#' tinyplot_add(type = 'vline', lty = 2)
+#' tinyplot_add(type = "hline", lty = 2) # "hline" b/c flip = TRUE (not vline!)
 #' 
 #' tinytheme("basic") # back to basic theme for the remaining examples
 #' 

R/type_hline.R

@@ -3,60 +3,5 @@
 #'   the number of groups or number of facets (or the product thereof).
 #' @export
 type_hline = function(h = 0) {
-  assert_numeric(h)
-  data_hline = function(settings, ...) {
-    env2env(settings, environment(), c("lwd", "lty", "col", "datapoints"))
-
-    if (nrow(datapoints) == 0) {
-      msg = "`type_hline() only works on existing plots with x and y data points."
-      stop(msg, call. = FALSE)
-    }
-    # keep track of unique lty and lwd (needed for group catch / escape hatch
-    # later in draw_hline)
-    ul_lwd = length(unique(lwd))
-    ul_lty = length(unique(lty))
-    ul_col = length(unique(col))
-    type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col)
-    env2env(environment(), settings, "type_info")
-  }
-  draw_hline = function() {
-    fun = function(ifacet, iby, data_facet, icol, ilty, ilwd,
-                   ngrps, nfacets, by_continuous, facet_by,
-                   type_info,
-                   ...) {
-      # flag for aesthetics by groups
-      grp_aes = type_info[["ul_col"]] == 1 || type_info[["ul_lty"]] == ngrps || type_info[["ul_lwd"]] == ngrps
-
-      if (length(h) != 1) {
-        if (!length(h) %in% c(ngrps, nfacets, ngrps * nfacets)) {
-          msg = "Length of 'h' must be 1, or equal to the number of facets or number of groups (or product thereof)."
-          stop(msg, call. = FALSE)
-        }
-        if (!facet_by && length(h) == nfacets) {
-          h = h[ifacet]
-          if (!grp_aes && type_info[["ul_col"]] != ngrps) {
-            icol = 1
-          } else if (by_continuous) {
-            icol = 1
-          }
-        } else if (!by_continuous && length(h) == ngrps * nfacets) {
-          h = h[ifacet * ngrps - c(ngrps - iby)]
-        } else if (!by_continuous) {
-          h = h[iby]
-        }
-      } else if (!grp_aes) {
-        icol = 1
-      }
-
-      abline(h = h, col = icol, lty = ilty, lwd = ilwd)
-    }
-    return(fun)
-  }
-  out = list(
-    draw = draw_hline(),
-    data = data_hline,
-    name = "hline"
-  )
-  class(out) = "tinyplot_type"
-  return(out)
+  ablines_type(h = h, name = "hline")
 }

R/type_vline.R

@@ -3,60 +3,5 @@
 #' @rdname type_abline
 #' @export
 type_vline = function(v = 0) {
-  assert_numeric(v)
-  data_vline = function(settings, ...) {
-    env2env(settings, environment(), c("datapoints", "lwd", "lty", "col"))
-    if (nrow(datapoints) == 0) {
-      msg = "`type_vline() only works on existing plots with x and y data points."
-      stop(msg, call. = FALSE)
-    }
-    # keep track of unique lty and lwd (needed for group catch / escape hatch
-    # later in draw_hline)
-    ul_lwd = length(unique(lwd))
-    ul_lty = length(unique(lty))
-    ul_col = length(unique(col))
-
-    type_info = list(ul_lty = ul_lty, ul_lwd = ul_lwd, ul_col = ul_col)
-    env2env(environment(), settings, "type_info")
-  }
-  draw_vline = function() {
-    fun = function(ifacet, iby, data_facet, icol, ilty, ilwd,
-                   ngrps, nfacets, by_continuous, facet_by,
-                   type_info,
-                   ...) {
-      # flag for aesthetics by groups
-      grp_aes = type_info[["ul_col"]] == 1 || type_info[["ul_lty"]] == ngrps || type_info[["ul_lwd"]] == ngrps
-
-      if (length(v) != 1) {
-        if (!length(v) %in% c(ngrps, nfacets, ngrps * nfacets)) {
-          msg = "Length of 'v' must be 1, or equal to the number of facets or number of groups (or product thereof)."
-          stop(msg, call. = FALSE)
-        }
-        if (!facet_by && length(v) == nfacets) {
-          v = v[ifacet]
-          if (!grp_aes && type_info[["ul_col"]] != ngrps) {
-            icol = 1
-          } else if (by_continuous) {
-            icol = 1
-          }
-        } else if (!by_continuous && length(v) == ngrps * nfacets) {
-          v = v[ifacet * ngrps - c(ngrps - iby)]
-        } else if (!by_continuous) {
-          v = v[iby]
-        }
-      } else if (!grp_aes) {
-        icol = 1
-      }
-
-      abline(v = v, col = icol, lty = ilty, lwd = ilwd)
-    }
-    return(fun)
-  }
-  out = list(
-    draw = draw_vline(),
-    data = data_vline,
-    name = "vline"
-  )
-  class(out) = "tinyplot_type"
-  return(out)
+  ablines_type(v = v, name = "vline")
 }