Skip to content

Commit

Permalink
Update geom_table()
Browse files Browse the repository at this point in the history
Also fix some missing "ggplot2::" and "grid::" qualifiers.
Update saved unit tests because of renaming of functions.
  • Loading branch information
aphalo committed Dec 10, 2021
1 parent fafcd8f commit 7716f74
Show file tree
Hide file tree
Showing 32 changed files with 312 additions and 207 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@ Package: ggpp
Type: Package
Title: Grammar Extensions to 'ggplot2'
Version: 0.4.3
Date: 2021-12-09
Date: 2021-12-10
Authors@R:
c(
person("Pedro J.", "Aphalo", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-3385-972X")),
Expand Down
25 changes: 14 additions & 11 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -17,20 +17,23 @@ some types of plots. One case is replacing a key or legend with direct
labels to plot elements, which is important in plots aimed at audiences
outside academia.

In one of the issues an answer by M. Krassowski included code that
provided an elegant and simple approach to implementing combined
position functions without duplicating code already in 'ggplot2' but
instead calling it. I edited this code and included it in the package.
The design of these four functions is not yet final their interface may
suffer some changes.
In one of the issues in the GitHub repository of 'ggrepel' an answer by
M. Krassowski included code that provided an elegant and simple approach
to implementing combined position functions without duplicating code
already in 'ggplot2' by instead calling methods of the parent class. I
edited this code and included it in the package. The renaming of
`geom_text_linked()` to `geom_text_s()` is code breaking but I am now
fairly confident this shorter name is easy to remember with `s` for
segment.

- Add functions `position_stacknudge()`, `position_jitternudge()`,
`position_dodgenudge()` and `position_dodge2nudge()` based on code
by M. Krassowski for `position_stack_and_nudge()`.
- Add `geom_point_s()` and update `geom_text_s()` renamed from
`geom_text_linked()`.
- Update `geom_grob()` to support plotting of segments when positions
change, e.g., with nudging.
- Add `geom_point_s()` and update `geom_text_s()` **renamed** from
`geom_text_linked()`. This is a ***code breaking change*** with
respect to the previous (unstable) version.
- Update `geom_plot()`, `geom_table()` and `geom_grob()` to support
plotting of segments when positions change, e.g., with nudging.
- Update the vignette.

# ggpp 0.4.2
Expand All @@ -48,7 +51,7 @@ the three statistics can be considered now stable.

- Update `stat_summary_xy()` and `stat_apply_group()` to return `NA`
in `x` and/or `y` when `.fun.x` or `.fun.y` are not passed an
argument. This is a code breaking change with respect to the
argument. This is a ***code breaking change*** with respect to the
previous (unstable) version.

- Update `stat_summary_xy()` and `stat_centroid()` to support
Expand Down
4 changes: 2 additions & 2 deletions R/geom-grob.R
Original file line number Diff line number Diff line change
Expand Up @@ -210,8 +210,8 @@ grob_draw_panel_fun <-
x1 = data_orig$x,
y1 = data_orig$y,
arrow = arrow,
gp = grid::gpar(col = alpha(data$segment.colour,
data$segment.alpha)),
gp = grid::gpar(col = ggplot2::alpha(data$segment.colour,
data$segment.alpha)),
name = "linking.segments.grob")
}

Expand Down
4 changes: 2 additions & 2 deletions R/geom-plot.R
Original file line number Diff line number Diff line change
Expand Up @@ -231,8 +231,8 @@ gplot_draw_panel_fun <-
x1 = data_orig$x,
y1 = data_orig$y,
arrow = arrow,
gp = grid::gpar(col = alpha(data$segment.colour,
data$segment.alpha)),
gp = grid::gpar(col = ggplot2::alpha(data$segment.colour,
data$segment.alpha)),
name = "linking.segments.grob")
}

Expand Down
155 changes: 78 additions & 77 deletions R/geom-point-linked.r
Original file line number Diff line number Diff line change
Expand Up @@ -115,89 +115,90 @@ geom_point_s <- function(mapping = NULL, data = NULL,
#' @format NULL
#' @usage NULL
#' @export
GeomPointS <- ggplot2::ggproto("GeomPointS", Geom,
required_aes = c("x", "y"),
non_missing_aes = c("size", "shape", "colour"),
default_aes = ggplot2::aes(
shape = 19,
colour = "black",
size = 1.5,
fill = NA,
alpha = NA,
stroke = 0.5,
segment.linetype = 1,
segment.colour = "grey33",
segment.size = 0.5,
segment.alpha = 1
),
GeomPointS <-
ggplot2::ggproto("GeomPointS", Geom,
required_aes = c("x", "y"),
non_missing_aes = c("size", "shape", "colour"),
default_aes = ggplot2::aes(
shape = 19,
colour = "black",
size = 1.5,
fill = NA,
alpha = NA,
stroke = 0.5,
segment.linetype = 1,
segment.colour = "grey33",
segment.size = 0.5,
segment.alpha = 1
),

draw_panel = function(data,
panel_params,
coord,
na.rm = FALSE,
arrow = NULL,
add.segments = FALSE) {
if (is.character(data$shape)) {
data$shape <- ggplot2::translate_shape_string(data$shape)
}
draw_panel = function(data,
panel_params,
coord,
na.rm = FALSE,
arrow = NULL,
add.segments = FALSE) {
if (is.character(data$shape)) {
data$shape <- ggplot2::translate_shape_string(data$shape)
}

if (nrow(data) == 0L) {
return(nullGrob())
}
if (nrow(data) == 0L) {
return(nullGrob())
}

add.segments <- add.segments && all(c("x_orig", "y_orig") %in% colnames(data))
add.segments <- add.segments && all(c("x_orig", "y_orig") %in% colnames(data))

coords <- coord$transform(data, panel_params)
if (add.segments) {
data_orig <- data.frame(x = data$x_orig, y = data$y_orig)
data_orig <- coord$transform(data_orig, panel_params)
}
coords <- coord$transform(data, panel_params)
if (add.segments) {
data_orig <- data.frame(x = data$x_orig, y = data$y_orig)
data_orig <- coord$transform(data_orig, panel_params)
}

# create the grobs
if(add.segments) {
ggname("geom_point_s",
grid::grobTree(
grid::segmentsGrob(
x0 = data_orig$x,
y0 = data_orig$y,
x1 = coords$x,
y1 = coords$y,
arrow = arrow,
gp = grid::gpar(col = alpha(coords$segment.colour,
coords$segment.alpha))
),
grid::pointsGrob(
coords$x, coords$y,
pch = coords$shape,
gp = gpar(
col = alpha(coords$colour, coords$alpha),
fill = alpha(coords$fill, coords$alpha),
# Stroke is added around the outside of the point
fontsize = coords$size * .pt + coords$stroke * .stroke / 2,
lwd = coords$stroke * .stroke / 2
)
)
)
)
} else {
ggname("geom_point_s",
grid::pointsGrob(
coords$x, coords$y,
pch = coords$shape,
gp = gpar(
col = alpha(coords$colour, coords$alpha),
fill = alpha(coords$fill, coords$alpha),
# Stroke is added around the outside of the point
fontsize = coords$size * .pt + coords$stroke * .stroke / 2,
lwd = coords$stroke * .stroke / 2
)
)
)
}
},
# create the grobs
if(add.segments) {
ggname("geom_point_s",
grid::grobTree(
grid::segmentsGrob(
x0 = data_orig$x,
y0 = data_orig$y,
x1 = coords$x,
y1 = coords$y,
arrow = arrow,
gp = grid::gpar(col = ggplot2::alpha(coords$segment.colour,
coords$segment.alpha))
),
grid::pointsGrob(
coords$x, coords$y,
pch = coords$shape,
gp = gpar(
col = alpha(coords$colour, coords$alpha),
fill = alpha(coords$fill, coords$alpha),
# Stroke is added around the outside of the point
fontsize = coords$size * .pt + coords$stroke * .stroke / 2,
lwd = coords$stroke * .stroke / 2
)
)
)
)
} else {
ggname("geom_point_s",
grid::pointsGrob(
coords$x, coords$y,
pch = coords$shape,
gp = gpar(
col = alpha(coords$colour, coords$alpha),
fill = alpha(coords$fill, coords$alpha),
# Stroke is added around the outside of the point
fontsize = coords$size * .pt + coords$stroke * .stroke / 2,
lwd = coords$stroke * .stroke / 2
)
)
)
}
},

draw_key = ggplot2::draw_key_point
)
draw_key = ggplot2::draw_key_point
)

translate_shape_string <- function(shape_string) {
# strings of length 0 or 1 are interpreted as symbols by grid
Expand Down
Loading

0 comments on commit 7716f74

Please sign in to comment.