Skip to content

Commit

Permalink
Merge pull request #59 from rnabioco/trace_position
Browse files Browse the repository at this point in the history
  • Loading branch information
sheridar authored Nov 24, 2023
2 parents c49c567 + 34c364c commit 7fbf074
Show file tree
Hide file tree
Showing 16 changed files with 91 additions and 188 deletions.
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

0 comments on commit 7fbf074

Please sign in to comment.