Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

trace_position tidy eval #59

Merged
merged 3 commits into from
Nov 24, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -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'
Expand Down
6 changes: 0 additions & 6 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -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)
2 changes: 2 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -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
Expand Down
16 changes: 8 additions & 8 deletions R/a-legend-draw.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
)
)

Expand All @@ -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"
),
Expand All @@ -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"
),
Expand Down
26 changes: 13 additions & 13 deletions R/geom-path-trace.R
Original file line number Diff line number Diff line change
Expand Up @@ -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"),
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -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
},
Expand All @@ -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
}
Expand Down Expand Up @@ -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") {
Expand Down
33 changes: 17 additions & 16 deletions R/geom-point-trace.R
Original file line number Diff line number Diff line change
Expand Up @@ -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(
Expand All @@ -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
Expand Down Expand Up @@ -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)) {
Expand All @@ -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
Expand Down Expand Up @@ -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,
Expand All @@ -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,
Expand Down Expand Up @@ -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
Expand All @@ -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
)
)

Expand Down Expand Up @@ -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
Expand Down
7 changes: 0 additions & 7 deletions R/ggtrace-package.R
Original file line number Diff line number Diff line change
Expand Up @@ -14,12 +14,5 @@
#'
#' @name ggtrace
#' @docType package
#' @import ggplot2
#' @importFrom grid
#' gpar
#' pointsGrob
#' grobName
#' grobTree
#' @importFrom rlang on_load
#' @keywords internal
"_PACKAGE"
1 change: 0 additions & 1 deletion R/utilities-ggplot2.R
Original file line number Diff line number Diff line change
Expand Up @@ -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()
Expand Down
20 changes: 12 additions & 8 deletions man/geom_path_trace.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

20 changes: 12 additions & 8 deletions man/geom_point_trace.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 1 addition & 0 deletions tests/testthat.R
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
library(testthat)
library(vdiffr)
library(ggtrace)
library(ggplot2)

test_check("ggtrace")
Loading