diff --git a/DESCRIPTION b/DESCRIPTION index 33a5830..67b15d2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -46,7 +46,7 @@ VignetteBuilder: Config/testthat/edition: 3 Encoding: UTF-8 LazyData: true -RoxygenNote: 7.2.0 +RoxygenNote: 7.2.3 SystemRequirements: pandoc Collate: 'a-legend-draw.R' diff --git a/NAMESPACE b/NAMESPACE index 111ad34..81e9e7e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,9 +12,3 @@ export(geom_line_trace) export(geom_path_trace) export(geom_point_trace) export(geom_step_trace) -import(ggplot2) -importFrom(grid,gpar) -importFrom(grid,grobName) -importFrom(grid,grobTree) -importFrom(grid,pointsGrob) -importFrom(rlang,on_load) diff --git a/NEWS.md b/NEWS.md index 003edcc..68a9d95 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,6 @@ # ggtrace (development version) +* Implemented tidy evaluation for expressions passed +to the trace_position argument (@sheridar #60) # ggtrace 0.2.0 * Initial CRAN submission diff --git a/R/a-legend-draw.R b/R/a-legend-draw.R index a0e3627..c667a47 100644 --- a/R/a-legend-draw.R +++ b/R/a-legend-draw.R @@ -52,7 +52,7 @@ draw_key_point_trace <- function(data, params, size) { 0.5, 0.5, pch = data$trace_shape, gp = grid::gpar( - col = alpha(data$colour, 1), + col = ggplot2::alpha(data$colour, 1), lty = data$linetype, fontsize = data$trace_fontsize, lwd = data$trace_lwd @@ -64,9 +64,9 @@ draw_key_point_trace <- function(data, params, size) { 0.5, 0.5, pch = data$shape, gp = grid::gpar( - col = alpha(data$fill, data$alpha), - fontsize = data$size * .pt + pt_stroke * .stroke / 2, - lwd = pt_stroke * .stroke / 2 + col = ggplot2::alpha(data$fill, data$alpha), + fontsize = data$size * ggplot2::.pt + pt_stroke * ggplot2::.stroke / 2, + lwd = pt_stroke * ggplot2::.stroke / 2 ) ) @@ -91,8 +91,8 @@ draw_key_path_trace <- function(data, params, size) { 0.1, 0.5, 0.9, 0.5, gp = grid::gpar( - col = alpha(data$colour, 1), - lwd = data$size * .pt + data$stroke * .pt * 2, + col = ggplot2::alpha(data$colour, 1), + lwd = data$size * ggplot2::.pt + data$stroke * ggplot2::.pt * 2, lty = 1, lineend = "butt" ), @@ -105,8 +105,8 @@ draw_key_path_trace <- function(data, params, size) { 0.1, 0.5, 0.9, 0.5, gp = grid::gpar( - col = alpha(data$fill, 1), - lwd = data$size * .pt, + col = ggplot2::alpha(data$fill, 1), + lwd = data$size * ggplot2::.pt, lty = data$linetype, lineend = "butt" ), diff --git a/R/geom-path-trace.R b/R/geom-path-trace.R index 1b97fb6..a268d2a 100644 --- a/R/geom-path-trace.R +++ b/R/geom-path-trace.R @@ -196,7 +196,7 @@ extra_bkgd_params <- paste0("bkgd_", c( #' @return ggproto object #' @seealso \link[ggplot2]{GeomPath} #' @export -GeomPathTrace <- ggproto( +GeomPathTrace <- ggplot2::ggproto( "GeomPathTrace", ggplot2::Geom, required_aes = c("x", "y"), @@ -347,7 +347,7 @@ GeomPathTrace <- ggproto( # Munch data # this divides data into line segments to plot - munched <- coord_munch(coord, data, panel_params) + munched <- ggplot2::coord_munch(coord, data, panel_params) # Silently drop lines with less than two points, preserving order rows <- stats::ave(seq_len(nrow(munched)), munched$group, FUN = length) @@ -401,9 +401,9 @@ GeomPathTrace <- ggproto( arrow = arrow, gp = grid::gpar( - col = alpha(clr, munched$alpha)[!end], - fill = alpha(clr, munched$alpha)[!end], # modifies arrow fill - lwd = munched$size[!end] * .pt + strk * .pt * 2, + col = ggplot2::alpha(clr, munched$alpha)[!end], + fill = ggplot2::alpha(clr, munched$alpha)[!end], # modifies arrow fill + lwd = munched$size[!end] * ggplot2::.pt + strk * ggplot2::.pt * 2, lty = lty, lineend = lineend, linejoin = linejoin, @@ -441,9 +441,9 @@ GeomPathTrace <- ggproto( arrow = arrow, gp = grid::gpar( - col = alpha(clr, munched$alpha)[start], - fill = alpha(clr, munched$alpha)[start], # modifies arrow fill - lwd = munched$size[start] * .pt + strk * .pt * 2, + col = ggplot2::alpha(clr, munched$alpha)[start], + fill = ggplot2::alpha(clr, munched$alpha)[start], # modifies arrow fill + lwd = munched$size[start] * ggplot2::.pt + strk * ggplot2::.pt * 2, lty = lty, lineend = lineend, linejoin = linejoin, @@ -528,13 +528,13 @@ geom_line_trace <- function(mapping = NULL, data = NULL, stat = "identity", #' @format NULL #' @usage NULL #' @export -GeomLineTrace <- ggproto( +GeomLineTrace <- ggplot2::ggproto( "GeomLineTrace", GeomPathTrace, extra_params = c(GeomPathTrace$extra_params, "na.rm", "orientation"), setup_params = function(data, params) { - params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) + params$flipped_aes <- ggplot2::has_flipped_aes(data, params, ambiguous = TRUE) params }, @@ -545,9 +545,9 @@ GeomLineTrace <- ggproto( data <- data[order(data$PANEL, data$group, data$x), ] data <- GeomPathTrace$setup_data(data, params) - data <- flip_data(data, params$flipped_aes) + data <- ggplot2::flip_data(data, params$flipped_aes) data <- data[order(data$PANEL, data$group, data$x), ] - data <- flip_data(data, params$flipped_aes) + data <- ggplot2::flip_data(data, params$flipped_aes) data } @@ -595,7 +595,7 @@ geom_step_trace <- function(mapping = NULL, data = NULL, stat = "identity", #' @format NULL #' @usage NULL #' @export -GeomStepTrace <- ggproto( +GeomStepTrace <- ggplot2::ggproto( "GeomStepTrace", GeomPathTrace, draw_group = function(data, panel_params, coord, direction = "hv") { diff --git a/R/geom-point-trace.R b/R/geom-point-trace.R index 71886b8..8740a9f 100644 --- a/R/geom-point-trace.R +++ b/R/geom-point-trace.R @@ -66,10 +66,10 @@ geom_point_trace <- function(mapping = NULL, data = NULL, stat = "identity", trans_fn <- function(dat, ex, inv = FALSE) { if (inv) { - return(subset(dat, !eval(ex))) + return(subset(dat, !rlang::eval_tidy(ex, dat))) } - subset(dat, eval(ex)) + subset(dat, rlang::eval_tidy(ex, dat)) } create_trace_layers( @@ -81,7 +81,7 @@ geom_point_trace <- function(mapping = NULL, data = NULL, stat = "identity", show.legend = show.legend, inherit.aes = inherit.aes, params = list(na.rm = na.rm, ...), - trace_position = substitute(trace_position), + trace_position = rlang::enquo(trace_position), background_params = background_params, trans_fn = trans_fn, allow_bottom = TRUE @@ -117,7 +117,8 @@ create_trace_layers <- function(mapping, data, stat, geom, position, # If trace_position is 'bottom', create new column and use to override # original group specification. - if (allow_bottom && trace_expr == "bottom") { + if (allow_bottom && identical(rlang::as_label(trace_expr), "\"bottom\"")) { + data <- ggplot2::fortify(~ transform(.x, BOTTOM_TRACE_GROUP = "bottom")) if (is.null(mapping)) { @@ -126,8 +127,8 @@ create_trace_layers <- function(mapping, data, stat, geom, position, mapping$group <- as.name("BOTTOM_TRACE_GROUP") - # If trace_position is not 'all', evaluate expression - } else if (trace_expr != "all") { + # If trace_position is not 'all', evaluate expression + } else if (!identical(rlang::as_label(trace_expr), "\"all\"")) { # If data is not NULL, the user has passed a data.frame, function, or # formula to the geom. Need to fortify this before applying the predicate # passed through trace_position. For a formula fortify will return an @@ -162,7 +163,7 @@ create_trace_layers <- function(mapping, data, stat, geom, position, bkgd_params[names(background_params)] <- background_params } - bkgd_lyr <- layer( + bkgd_lyr <- ggplot2::layer( data = bkgd_data, mapping = mapping, stat = stat, @@ -177,7 +178,7 @@ create_trace_layers <- function(mapping, data, stat, geom, position, } # Create trace layer - trace_lyr <- layer( + trace_lyr <- ggplot2::layer( data = data, mapping = mapping, stat = stat, @@ -252,7 +253,7 @@ GeomPointTrace <- ggplot2::ggproto( pch = coords$trace_shape, gp = grid::gpar( - col = alpha(coords$colour, 1), + col = ggplot2::alpha(coords$colour, 1), lty = coords$linetype, fontsize = coords$trace_fontsize, lwd = coords$trace_lwd @@ -266,9 +267,9 @@ GeomPointTrace <- ggplot2::ggproto( pch = coords$shape, gp = grid::gpar( - col = alpha(coords$fill, coords$alpha), - fontsize = coords$size * .pt + pt_stroke * .stroke / 2, - lwd = pt_stroke * .stroke / 2 + col = ggplot2::alpha(coords$fill, coords$alpha), + fontsize = coords$size * ggplot2::.pt + pt_stroke * ggplot2::.stroke / 2, + lwd = pt_stroke * ggplot2::.stroke / 2 ) ) @@ -383,14 +384,14 @@ calculate_trace_size <- function(data) { pch <- data$shape # Calculate fontsize for closed shapes - fontsize <- data$size * .pt + pt_stroke * .stroke / 2 + fontsize <- data$size * ggplot2::.pt + pt_stroke * ggplot2::.stroke / 2 - fontsize[!pch %in% pch_open] <- fontsize[!pch %in% pch_open] + data$stroke * .stroke / 2 + fontsize[!pch %in% pch_open] <- fontsize[!pch %in% pch_open] + data$stroke * ggplot2::.stroke / 2 # Calculate lwd for open shapes - lwd <- data$stroke * .stroke / 2 + lwd <- data$stroke * ggplot2::.stroke / 2 - lwd[pch %in% pch_open] <- lwd[pch %in% pch_open] * 2 + (pt_stroke * .stroke / 2) + lwd[pch %in% pch_open] <- lwd[pch %in% pch_open] * 2 + (pt_stroke * ggplot2::.stroke / 2) # Add results to data data$trace_fontsize <- fontsize diff --git a/R/ggtrace-package.R b/R/ggtrace-package.R index dcb76d1..64c83f7 100644 --- a/R/ggtrace-package.R +++ b/R/ggtrace-package.R @@ -14,12 +14,5 @@ #' #' @name ggtrace #' @docType package -#' @import ggplot2 -#' @importFrom grid -#' gpar -#' pointsGrob -#' grobName -#' grobTree -#' @importFrom rlang on_load #' @keywords internal "_PACKAGE" diff --git a/R/utilities-ggplot2.R b/R/utilities-ggplot2.R index b0a53c1..555c351 100644 --- a/R/utilities-ggplot2.R +++ b/R/utilities-ggplot2.R @@ -134,7 +134,6 @@ modify_list <- function(old, new) { # Info needed for rbind_dfs date/time handling ggtrace_global <- new.env(parent = emptyenv()) -#' @importFrom rlang on_load #' @noRd rlang::on_load({ date <- Sys.Date() diff --git a/man/geom_path_trace.Rd b/man/geom_path_trace.Rd index 29a0363..416eb59 100644 --- a/man/geom_path_trace.Rd +++ b/man/geom_path_trace.Rd @@ -52,10 +52,10 @@ geom_step_trace( ) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}} or -\code{\link[ggplot2:aes_]{aes_()}}. If specified and \code{inherit.aes = TRUE} (the -default), it is combined with the default mapping at the top level of the -plot. You must supply \code{mapping} if there is no plot mapping.} +\item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and +\code{inherit.aes = TRUE} (the default), it is combined with the default mapping +at the top level of the plot. You must supply \code{mapping} if there is no plot +mapping.} \item{data}{The data to be displayed in this layer. There are three options: @@ -73,10 +73,14 @@ will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this -layer, as a string.} - -\item{position}{Position adjustment, either as a string, or the result of -a call to a position adjustment function.} +layer, either as a \code{ggproto} \code{Geom} subclass or as a string naming the +stat stripped of the \code{stat_} prefix (e.g. \code{"count"} rather than +\code{"stat_count"})} + +\item{position}{Position adjustment, either as a string naming the adjustment +(e.g. \code{"jitter"} to use \code{position_jitter}), or the result of a call to a +position adjustment function. Use the latter if you need to change the +settings of the adjustment.} \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are often aesthetics, used to set an aesthetic to a fixed value, like diff --git a/man/geom_point_trace.Rd b/man/geom_point_trace.Rd index f8a7cb6..48b5b1b 100644 --- a/man/geom_point_trace.Rd +++ b/man/geom_point_trace.Rd @@ -18,10 +18,10 @@ geom_point_trace( ) } \arguments{ -\item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}} or -\code{\link[ggplot2:aes_]{aes_()}}. If specified and \code{inherit.aes = TRUE} (the -default), it is combined with the default mapping at the top level of the -plot. You must supply \code{mapping} if there is no plot mapping.} +\item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and +\code{inherit.aes = TRUE} (the default), it is combined with the default mapping +at the top level of the plot. You must supply \code{mapping} if there is no plot +mapping.} \item{data}{The data to be displayed in this layer. There are three options: @@ -39,10 +39,14 @@ will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this -layer, as a string.} - -\item{position}{Position adjustment, either as a string, or the result of -a call to a position adjustment function.} +layer, either as a \code{ggproto} \code{Geom} subclass or as a string naming the +stat stripped of the \code{stat_} prefix (e.g. \code{"count"} rather than +\code{"stat_count"})} + +\item{position}{Position adjustment, either as a string naming the adjustment +(e.g. \code{"jitter"} to use \code{position_jitter}), or the result of a call to a +position adjustment function. Use the latter if you need to change the +settings of the adjustment.} \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are often aesthetics, used to set an aesthetic to a fixed value, like diff --git a/tests/testthat.R b/tests/testthat.R index 32b2055..12a62cc 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,5 +1,6 @@ library(testthat) library(vdiffr) library(ggtrace) +library(ggplot2) test_check("ggtrace") diff --git a/tests/testthat/_snaps/geom-path-trace/geom-path-group-reorder.svg b/tests/testthat/_snaps/geom-path-trace/geom-path-group-reorder.svg deleted file mode 100644 index 652617a..0000000 --- a/tests/testthat/_snaps/geom-path-trace/geom-path-group-reorder.svg +++ /dev/null @@ -1,95 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -2000 -4000 -6000 -8000 - - - - - - - - -0 -500 -1000 -1500 -day -value - -name - - - - - - - - - - - - - - - - - - - - -SMI -CAC -DAX -FTSE -geom_path group reorder - - diff --git a/tests/testthat/test-geom-line-trace.R b/tests/testthat/test-geom-line-trace.R index 50d0f59..fe6a7cc 100644 --- a/tests/testthat/test-geom-line-trace.R +++ b/tests/testthat/test-geom-line-trace.R @@ -30,29 +30,29 @@ test_that("aesthetics to variable", { p <- ggplot(stocks, aes(day, value, color = name)) p2 <- p + geom_line_trace() - expect_identical(as.character(p2$mapping$colour)[[2]], "name") + expect_identical(rlang::as_label(p2$mapping$colour), "name") expect_doppelganger("aesthetics to variable", p2) }) test_that("aesthetics from geom", { p <- ggplot(stocks, aes(day, value, color = name)) - expect_identical(as.character(p$mapping$colour)[2], "name") + expect_identical(rlang::as_label(p$mapping$colour), "name") expect_doppelganger("aesthetics from geom 1", p) p <- geom_line_trace(aes(fill = name)) - expect_identical(as.character(p[[1]]$mapping$fill)[2], "name") + expect_identical(rlang::as_label(p[[1]]$mapping$fill), "name") expect_doppelganger("aesthetics from geom 2", p) p <- geom_line_trace(aes(linetype = name)) - expect_identical(as.character(p[[1]]$mapping$linetype)[2], "name") + expect_identical(rlang::as_label(p[[1]]$mapping$linetype), "name") expect_doppelganger("aesthetics from geom 3", p) p <- geom_line_trace(aes(alpha = name)) - expect_identical(as.character(p[[1]]$mapping$alpha)[2], "name") + expect_identical(rlang::as_label(p[[1]]$mapping$alpha), "name") expect_doppelganger("aesthetics from geom 4", p) p <- geom_line_trace(aes(stroke = name)) - expect_identical(as.character(p[[1]]$mapping$stroke)[2], "name") + expect_identical(rlang::as_label(p[[1]]$mapping$stroke), "name") expect_doppelganger("aesthetics from geom 5", p) }) diff --git a/tests/testthat/test-geom-path-trace.R b/tests/testthat/test-geom-path-trace.R index 9336a1b..ab3f60a 100644 --- a/tests/testthat/test-geom-path-trace.R +++ b/tests/testthat/test-geom-path-trace.R @@ -25,24 +25,24 @@ test_that("aesthetics to variable", { p <- ggplot(stocks, aes(day, value, color = name)) p2 <- p + geom_path_trace() - expect_identical(as.character(p2$mapping$colour)[[2]], "name") + expect_identical(rlang::as_label(p2$mapping$colour), "name") }) test_that("aesthetics from geom", { p <- ggplot(stocks, aes(day, value, color = name)) - expect_identical(as.character(p$mapping$colour)[2], "name") + expect_identical(rlang::as_label(p$mapping$colour), "name") p <- geom_path_trace(aes(fill = name)) - expect_identical(as.character(p[[1]]$mapping$fill)[2], "name") + expect_identical(rlang::as_label(p[[1]]$mapping$fill), "name") p <- geom_path_trace(aes(linetype = name)) - expect_identical(as.character(p[[1]]$mapping$linetype)[2], "name") + expect_identical(rlang::as_label(p[[1]]$mapping$linetype), "name") p <- geom_path_trace(aes(alpha = name)) - expect_identical(as.character(p[[1]]$mapping$alpha)[2], "name") + expect_identical(rlang::as_label(p[[1]]$mapping$alpha), "name") p <- geom_path_trace(aes(stroke = name)) - expect_identical(as.character(p[[1]]$mapping$stroke)[2], "name") + expect_identical(rlang::as_label(p[[1]]$mapping$stroke), "name") }) test_that("trace_position predicate return list", { diff --git a/tests/testthat/test-geom-point-trace.R b/tests/testthat/test-geom-point-trace.R index 67356e1..c600f17 100644 --- a/tests/testthat/test-geom-point-trace.R +++ b/tests/testthat/test-geom-point-trace.R @@ -25,30 +25,30 @@ test_that("aesthetics to variable", { p <- ggplot(clusters, aes(UMAP_1, UMAP_2, color = cluster)) p2 <- p + geom_point_trace() - expect_identical(as.character(p2$mapping$colour)[[2]], "cluster") + expect_identical(rlang::as_label(p2$mapping$colour), "cluster") }) test_that("aesthetics from geom", { p <- geom_point_trace(aes(color = cluster)) - expect_identical(as.character(p[[1]]$mapping$colour)[2], "cluster") + expect_identical(rlang::as_label(p[[1]]$mapping$colour), "cluster") p <- geom_point_trace(aes(fill = cluster)) - expect_identical(as.character(p[[1]]$mapping$fill)[2], "cluster") + expect_identical(rlang::as_label(p[[1]]$mapping$fill), "cluster") p <- geom_point_trace(aes(linetype = cluster)) - expect_identical(as.character(p[[1]]$mapping$linetype)[2], "cluster") + expect_identical(rlang::as_label(p[[1]]$mapping$linetype), "cluster") p <- geom_point_trace(aes(alpha = cluster)) - expect_identical(as.character(p[[1]]$mapping$alpha)[2], "cluster") + expect_identical(rlang::as_label(p[[1]]$mapping$alpha), "cluster") p <- geom_point_trace(aes(stroke = cluster)) - expect_identical(as.character(p[[1]]$mapping$stroke)[2], "cluster") + expect_identical(rlang::as_label(p[[1]]$mapping$stroke), "cluster") }) test_that("trace_position bottom", { p <- geom_point_trace(trace_position = "bottom") - expect_identical(as.character(p[[1]]$mapping$group)[2], "BOTTOM_TRACE_GROUP") + expect_identical(rlang::as_label(p[[1]]$mapping$group), "BOTTOM_TRACE_GROUP") expect_doppelganger("trace_position bottom", p) }) diff --git a/tests/testthat/test-geom-step-trace.R b/tests/testthat/test-geom-step-trace.R index 4065759..24310b1 100644 --- a/tests/testthat/test-geom-step-trace.R +++ b/tests/testthat/test-geom-step-trace.R @@ -25,24 +25,24 @@ test_that("aesthetics to variable", { p <- ggplot(stocks, aes(day, value, color = name)) p2 <- p + geom_step_trace() - expect_identical(as.character(p2$mapping$colour)[[2]], "name") + expect_identical(rlang::as_label(p2$mapping$colour), "name") }) test_that("aesthetics from geom", { p <- ggplot(stocks, aes(day, value, color = name)) - expect_identical(as.character(p$mapping$colour)[2], "name") + expect_identical(rlang::as_label(p$mapping$colour), "name") p <- geom_step_trace(aes(fill = name)) - expect_identical(as.character(p[[1]]$mapping$fill)[2], "name") + expect_identical(rlang::as_label(p[[1]]$mapping$fill), "name") p <- geom_step_trace(aes(linetype = name)) - expect_identical(as.character(p[[1]]$mapping$linetype)[2], "name") + expect_identical(rlang::as_label(p[[1]]$mapping$linetype), "name") p <- geom_step_trace(aes(alpha = name)) - expect_identical(as.character(p[[1]]$mapping$alpha)[2], "name") + expect_identical(rlang::as_label(p[[1]]$mapping$alpha), "name") p <- geom_step_trace(aes(stroke = name)) - expect_identical(as.character(p[[1]]$mapping$stroke)[2], "name") + expect_identical(rlang::as_label(p[[1]]$mapping$stroke), "name") }) test_that("trace_position predicate return list", {