Experiment
library(ggplot2)
geom_vline <- function(mapping = NULL,
data = NULL,
...,
xintercept,
na.rm = FALSE,
show.legend = NA,
stat = "identity", # new exposed argument
inherit.aes = NULL){ # I like this better than current implementation...
inherit.aes <- inherit.aes %||% missing(xintercept) # or similar to address nullness
# Act like an annotation
if (!missing(xintercept)) {
# Warn if supplied mapping and/or data is going to be overwritten
if (!is.null(mapping)) {
cli::cli_warn("{.fn geom_vline}: Ignoring {.arg mapping} because {.arg xintercept} was provided.")
}
if (!is.null(data)) {
cli::cli_warn("{.fn geom_vline}: Ignoring {.arg data} because {.arg xintercept} was provided.")
# add a warning about stat being ignored if xintercept is provided ?
}
data <- ggplot2:::data_frame0(xintercept = xintercept)
if(is.null(mapping)){
mapping <- aes(xintercept = xintercept)} else{
mapping <- modifyList(mapping, aes(xintercept = xintercept), keep.null = T)
}
show.legend <- FALSE
}
layer(
data = data,
mapping = mapping,
stat = stat, # not fixed
geom = GeomVline,
position = PositionIdentity,
show.legend = show.legend,
inherit.aes = inherit.aes, # This change or similar
params = rlang::list2(
na.rm = na.rm,
...
)
)
}
library(ggplot2)
ggplot() +
geom_vline(aes(colour = from_theme(accent)), xintercept = 0)
## Warning: `geom_vline()`: Ignoring `mapping` because `xintercept` was provided.
ggplot(cars) +
geom_vline(aes(colour = from_theme(accent),
linetype = I("dashed")),
xintercept = 0)
## Warning: `geom_vline()`: Ignoring `mapping` because `xintercept` was provided.
ggplot(cars) +
aes(colour = from_theme(accent),
linetype = I("dashed")) +
geom_vline(xintercept = 0)
ggplot(cars) + annotate(geom = "point",
color = theme_get()$geom$accent,
x = 0, y = 0)
mine <- theme_get()
# mine
PR
#' @include stat-.R
NULL
## NULL
#' Reference lines: horizontal, vertical, and diagonal
#'
#' These geoms add reference lines (sometimes called rules) to a plot, either
#' horizontal, vertical, or diagonal (specified by slope and intercept).
#' These are useful for annotating plots.
#'
#' These geoms act slightly differently from other geoms. You can supply the
#' parameters in two ways: either as arguments to the layer function,
#' or via aesthetics. If you use arguments, e.g.
#' `geom_abline(intercept = 0, slope = 1)`, then behind the scenes
#' the geom makes a new data frame containing just the data you've supplied.
#' That means that the lines will be the same in all facets; if you want them
#' to vary across facets, construct the data frame yourself and use aesthetics.
#'
#' Unlike most other geoms, these geoms do not inherit aesthetics from the plot
#' default, because they do not understand x and y aesthetics which are
#' commonly set in the plot. They also do not affect the x and y scales.
#'
#' @section Aesthetics:
#' These geoms are drawn using [geom_line()] so they support the
#' same aesthetics: `alpha`, `colour`, `linetype` and
#' `linewidth`. They also each have aesthetics that control the position of
#' the line:
#'
#' - `geom_vline()`: `xintercept`
#' - `geom_hline()`: `yintercept`
#' - `geom_abline()`: `slope` and `intercept`
#'
#' @seealso See [geom_segment()] for a more general approach to
#' adding straight line segments to a plot.
#' @inheritParams shared_layer_parameters
#' @param mapping Set of aesthetic mappings created by [aes()].
#' @param xintercept,yintercept,slope,intercept Parameters that control the
#' position of the line. If these are set, `data`, `mapping` and
#' `show.legend` are overridden.
#' @export
#' @examples
#' p <- ggplot(mtcars, aes(wt, mpg)) + geom_point()
#'
#' # Fixed values
#' p + geom_vline(xintercept = 5)
#' p + geom_vline(xintercept = 1:5)
#' p + geom_hline(yintercept = 20)
#'
#' p + geom_abline() # Can't see it - outside the range of the data
#' p + geom_abline(intercept = 20)
#'
#' # Calculate slope and intercept of line of best fit
#' coef(lm(mpg ~ wt, data = mtcars))
#' p + geom_abline(intercept = 37, slope = -5)
#' # But this is easier to do with geom_smooth:
#' p + geom_smooth(method = "lm", se = FALSE)
#'
#' # To show different lines in different facets, use aesthetics
#' p <- ggplot(mtcars, aes(mpg, wt)) +
#' geom_point() +
#' facet_wrap(~ cyl)
#'
#' mean_wt <- data.frame(cyl = c(4, 6, 8), wt = c(2.28, 3.11, 4.00))
#' p + geom_hline(aes(yintercept = wt), mean_wt)
#'
#' # You can also control other aesthetics
#' ggplot(mtcars, aes(mpg, wt, colour = wt)) +
#' geom_point() +
#' geom_hline(aes(yintercept = wt, colour = wt), mean_wt) +
#' facet_wrap(~ cyl)
geom_abline <- function(mapping = NULL, data = NULL,
stat = "identity",
...,
slope,
intercept,
na.rm = FALSE,
show.legend = NA,
inherit.aes = NULL) {
inherit.aes <- inherit.aes %||% (missing(slope) && missing(intercept))
# If nothing set, default to y = x
if (is.null(mapping) && missing(slope) && missing(intercept) && !inherit.aes) {
slope <- 1
intercept <- 0
}
# Act like an annotation
if (!missing(slope) || !missing(intercept)) {
# Warn if supplied mapping and/or data is going to be overwritten
if (!is.null(mapping)) {
cli::cli_warn("{.fn geom_abline}: Ignoring {.arg mapping} because {.arg slope} and/or {.arg intercept} were provided.")
}
if (!is.null(data)) {
cli::cli_warn("{.fn geom_abline}: Ignoring {.arg data} because {.arg slope} and/or {.arg intercept} were provided.")
}
if (missing(slope)) slope <- 1
if (missing(intercept)) intercept <- 0
n_slopes <- max(length(slope), length(intercept))
data <- ggplot2:::data_frame0(
intercept = intercept,
slope = slope,
.size = n_slopes
)
mapping <- aes(intercept = intercept, slope = slope)
show.legend <- FALSE
}
layer(
data = data,
mapping = mapping,
stat = stat,
geom = GeomAbline,
position = PositionIdentity,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = rlang::list2(
na.rm = na.rm,
...
)
)
}
#' @export
#' @rdname geom_abline
geom_hline <- function(mapping = NULL, data = NULL,
stat = "identity", position = "identity",
...,
yintercept,
na.rm = FALSE,
show.legend = NA,
inherit.aes = NULL) {
# if NJLL default is based on if xintercept is missing
inherit.aes <- inherit.aes %||% missing(yintercept)
# Act like an annotation
if (!missing(yintercept)) {
# Warn if supplied mapping and/or data is going to be overwritten
if (!is.null(mapping)) {
cli::cli_warn("{.fn geom_hline}: Ignoring {.arg mapping} because {.arg yintercept} was provided.")
}
if (!is.null(data)) {
cli::cli_warn("{.fn geom_hline}: Ignoring {.arg data} because {.arg yintercept} was provided.")
}
data <- ggplot2:::data_frame0(yintercept = yintercept)
mapping <- aes(yintercept = yintercept)
show.legend <- FALSE
}
layer(
data = data,
mapping = mapping,
stat = stat,
geom = GeomHline,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = rlang::list2(
na.rm = na.rm,
...
)
)
}
#' @export
#' @rdname geom_abline
geom_vline <- function(mapping = NULL, data = NULL,
stat = "identity", position = "identity",
...,
xintercept,
na.rm = FALSE,
show.legend = NA,
inherit.aes = NULL) {
# if NJLL default is based on if xintercept is missing
inherit.aes <- inherit.aes %||% missing(xintercept)
# Act like an annotation
if (!missing(xintercept)) {
# Warn if supplied mapping and/or data is going to be overwritten
if (!is.null(mapping)) {
cli::cli_warn("{.fn geom_vline}: Ignoring {.arg mapping} because {.arg xintercept} was provided.")
}
if (!is.null(data)) {
cli::cli_warn("{.fn geom_vline}: Ignoring {.arg data} because {.arg xintercept} was provided.")
}
data <- ggplot2:::data_frame0(xintercept = xintercept)
mapping <- aes(xintercept = xintercept)
show.legend <- FALSE
}
layer(
data = data,
mapping = mapping,
stat = stat,
geom = GeomVline,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = rlang::list2(
na.rm = na.rm,
...
)
)
}
#' @rdname Geom
#' @format NULL
#' @usage NULL
#' @export
GeomAbline <- ggproto("GeomAbline", Geom,
draw_panel = function(data, panel_params, coord, lineend = "butt") {
ranges <- coord$backtransform_range(panel_params)
if (coord$clip == "on" && coord$is_linear()) {
# Ensure the line extends well outside the panel to avoid visible line
# ending for thick lines
ranges$x <- ranges$x + c(-1, 1) * diff(ranges$x)
ranges$y <- ranges$y + c(-1, 1) * diff(ranges$y)
}
# Restrict 'x' to where 'y' is in range: x = (y - intercept) / slope
x <- sweep(outer(ranges$y, data$intercept, FUN = "-"), 2, data$slope, FUN = "/")
data$x <- pmax(ranges$x[1], pmin(x[1, ], x[2, ]))
data$xend <- pmin(ranges$x[2], pmax(x[1, ], x[2, ]))
data$y <- data$x * data$slope + data$intercept
data$yend <- data$xend * data$slope + data$intercept
GeomSegment$draw_panel(ggplot2:::unique0(data), panel_params, coord, lineend = lineend)
},
default_aes = aes(
colour = from_theme(colour %||% ink),
linewidth = from_theme(linewidth),
linetype = from_theme(linetype),
alpha = NA
),
required_aes = c("slope", "intercept"),
draw_key = draw_key_abline,
rename_size = TRUE,
check_constant_aes = FALSE
)
#' @rdname Geom
#' @format NULL
#' @usage NULL
#' @export
GeomHline <- ggproto("GeomHline", Geom,
draw_panel = function(data, panel_params, coord, lineend = "butt") {
ranges <- coord$backtransform_range(panel_params)
data$x <- ranges$x[1]
data$xend <- ranges$x[2]
data$y <- data$yintercept
data$yend <- data$yintercept
GeomSegment$draw_panel(ggplot2:::unique0(data), panel_params, coord, lineend = lineend)
},
default_aes = aes(
colour = from_theme(colour %||% ink),
linewidth = from_theme(linewidth),
linetype = from_theme(linetype),
alpha = NA
),
required_aes = "yintercept",
draw_key = draw_key_path,
rename_size = TRUE,
check_constant_aes = FALSE
)
#' @rdname Geom
#' @format NULL
#' @usage NULL
#' @export
GeomVline <- ggproto("GeomVline", Geom,
draw_panel = function(data, panel_params, coord, lineend = "butt") {
ranges <- coord$backtransform_range(panel_params)
data$x <- data$xintercept
data$xend <- data$xintercept
data$y <- ranges$y[1]
data$yend <- ranges$y[2]
GeomSegment$draw_panel(ggplot2:::unique0(data), panel_params, coord, lineend = lineend)
},
default_aes = aes(
colour = from_theme(colour %||% ink),
linewidth = from_theme(linewidth),
linetype = from_theme(linetype),
alpha = NA
),
required_aes = "xintercept",
draw_key = draw_key_vline,
rename_size = TRUE,
check_constant_aes = FALSE
)
gapminder::gapminder |>
filter(year == 2002) |>
filter(continent == "Americas") |>
ggplot() +
aes(x = lifeExp) +
aes(y = country) +
geom_point() +
aes(yintercept = country) +
geom_hline()
ggplot() +
geom_abline()
tibble(a = 1:2, b = 1) |>
ggplot() +
aes(slope = a, intercept = b) +
geom_abline(aes(slope = a, intercept = b))
