diff --git a/NEWS.md b/NEWS.md index 7ddc2d14..17be8be0 100644 --- a/NEWS.md +++ b/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) diff --git a/R/type_abline.R b/R/type_abline.R index 9d95741a..614598a3 100644 --- a/R/type_abline.R +++ b/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) diff --git a/R/type_barplot.R b/R/type_barplot.R index 899aa914..10fea377 100644 --- a/R/type_barplot.R +++ b/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) diff --git a/R/type_errorbar.R b/R/type_errorbar.R index c5e4ee95..146dbdd5 100644 --- a/R/type_errorbar.R +++ b/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 #' diff --git a/R/type_hline.R b/R/type_hline.R index 3ac9bece..c7a0b815 100644 --- a/R/type_hline.R +++ b/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") } diff --git a/R/type_vline.R b/R/type_vline.R index 25748211..146523c0 100644 --- a/R/type_vline.R +++ b/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") } diff --git a/inst/tinytest/_tinysnapshot/abline.svg b/inst/tinytest/_tinysnapshot/abline.svg new file mode 100644 index 00000000..bb2b01a3 --- /dev/null +++ b/inst/tinytest/_tinysnapshot/abline.svg @@ -0,0 +1,95 @@ + + + + + + + + + + + + + +wt +mpg + + + + + +2 +3 +4 +5 + + + + + + +10 +15 +20 +25 +30 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/inst/tinytest/_tinysnapshot/flip_ablines.svg b/inst/tinytest/_tinysnapshot/flip_ablines.svg new file mode 100644 index 00000000..c23b230b --- /dev/null +++ b/inst/tinytest/_tinysnapshot/flip_ablines.svg @@ -0,0 +1,97 @@ + + + + + + + + + + + + + +Flipped h/v/ablines +mpg +wt + + + + + + +10 +15 +20 +25 +30 + + + + + +2 +3 +4 +5 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/inst/tinytest/_tinysnapshot/flip_ablines_facet_zero_slope.svg b/inst/tinytest/_tinysnapshot/flip_ablines_facet_zero_slope.svg new file mode 100644 index 00000000..30f4adcc --- /dev/null +++ b/inst/tinytest/_tinysnapshot/flip_ablines_facet_zero_slope.svg @@ -0,0 +1,165 @@ + + + + + + + + + + + + + +mpg +wt + + + + + + + + + + + + + + + +10 +15 +20 +25 +30 + + + + + +2 +3 +4 +5 + +0 + + + + + + + + + + + + + + + + +10 +15 +20 +25 +30 + + + + + +2 +3 +4 +5 + +1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/inst/tinytest/test-flip.R b/inst/tinytest/test-flip.R index c2e9537d..3280717a 100644 --- a/inst/tinytest/test-flip.R +++ b/inst/tinytest/test-flip.R @@ -140,3 +140,21 @@ f = function() { ) } expect_snapshot_plot(f, label = "flip_type_h_grouped") + + +# flipped straight line types (#733) + +f = function() { + tinyplot(mpg ~ wt, data = mtcars, flip = TRUE, main = "Flipped h/v/ablines") + 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) +} +expect_snapshot_plot(f, label = "flip_ablines") + +f = function() { + tinyplot(mpg ~ wt, facet = ~am, data = mtcars, flip = TRUE) + tinyplot_add(type = type_hline(c(15, 25)), col = "hotpink") + tinyplot_add(type = type_abline(a = 20, b = 0), lty = 2) +} +expect_snapshot_plot(f, label = "flip_ablines_facet_zero_slope") diff --git a/inst/tinytest/test-type_abline.R b/inst/tinytest/test-type_abline.R index 31e81a7d..4072ae1d 100644 --- a/inst/tinytest/test-type_abline.R +++ b/inst/tinytest/test-type_abline.R @@ -56,6 +56,13 @@ f = function() { } expect_snapshot_plot(f, label = "vline_univariate_y1") +f = function() { + tinyplot(mpg ~ wt, data = mtcars) + tinyplot_add(type = type_abline(a = 37, b = -5), lty = 2) + tinyplot_add(type = type_abline(a = 20, b = 0), col = "hotpink") +} +expect_snapshot_plot(f, label = "abline") + ## TODO: uncomment this when ready to test. Probably after the tinyplot_add ## refactor to save in an environment instead of global option # f = function() { diff --git a/inst/tinytest/test-type_pointrange.R b/inst/tinytest/test-type_pointrange.R index a0e4a2ce..b56af741 100644 --- a/inst/tinytest/test-type_pointrange.R +++ b/inst/tinytest/test-type_pointrange.R @@ -68,7 +68,7 @@ fun = function() { flip = TRUE ) tinyplot_add(type = "ribbon") - tinyplot_add(type = "vline", lty = 2) + tinyplot_add(type = "hline", lty = 2) # "hline" b/c flip = TRUE (not vline!) } expect_snapshot_plot(fun, label = "pointrange_with_layers_flipped") diff --git a/man/type_abline.Rd b/man/type_abline.Rd index c815e16a..3396d64f 100644 --- a/man/type_abline.Rd +++ b/man/type_abline.Rd @@ -30,6 +30,11 @@ These functions add straight line(s) through the current plot. While \code{type_abline}, \code{type_hline}, and \code{type_vline} can be called in a base plot layer, we expect that they will typically be called as subsequent layers via \code{\link{tinyplot_add}}. + +Line parameters always refer to the original (pre-flip) variables. So, if +\code{flip = TRUE}, then \code{type_hline()} draws vertical line(s) at the given \code{y} +value(s), \code{type_vline()} draws horizontal line(s) at the given \code{x} value(s), +and \code{type_abline()} draws the line \eqn{y = a + bx} with the axes swapped. } \section{Recycling logic}{ @@ -97,6 +102,16 @@ tinyplot_add(type = type_hline(with(mtcars, tapply(mpg, cyl, mean))), lty = 2) # Similar idea for vline 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 diff --git a/man/type_barplot.Rd b/man/type_barplot.Rd index 58ac257a..eebed4ee 100644 --- a/man/type_barplot.Rd +++ b/man/type_barplot.Rd @@ -246,7 +246,7 @@ tinyplot( 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 @@ -288,8 +288,8 @@ tinyplot( 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) diff --git a/man/type_errorbar.Rd b/man/type_errorbar.Rd index b1e4bfe9..a6395a75 100644 --- a/man/type_errorbar.Rd +++ b/man/type_errorbar.Rd @@ -103,7 +103,7 @@ tinyplot(est ~ term, ymin = lwr, ymax = upr, data = coefs, 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 diff --git a/vignettes/gallery_figs/likert.R b/vignettes/gallery_figs/likert.R index 1348b20b..05c69606 100644 --- a/vignettes/gallery_figs/likert.R +++ b/vignettes/gallery_figs/likert.R @@ -25,5 +25,5 @@ plt( theme = list("clean2", palette.qualitative = pal), main = "Likert example with \"Unsure\" category offset" ) -plt_add(type = "vline") -# plt_add(type = "vline", v = 1, lty = 2) ## optional +plt_add(type = "hline") # note: "hline" b/c flip = TRUE (not "vline"!) +# plt_add(type = type_hline(1), lty = 2) ## optional \ No newline at end of file