├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ └── R-CMD-check.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── NAMESPACE ├── NEWS.md ├── R ├── geom_finallabel.R ├── geom_linepoint.R ├── geom_richlegend.R └── scale_x_date_rightalign.R ├── README.Rmd ├── README.md ├── ggdirectlabel.Rproj ├── man ├── breaks_right.Rd ├── figures │ ├── README-example-1.png │ ├── README-geom_finallabel-1.png │ ├── README-no-directlabel-1.png │ ├── README-scale_x_date_rightalign-1.png │ ├── README-unnamed-chunk-3-1.png │ ├── README-unnamed-chunk-4-1.png │ ├── README-unnamed-chunk-5-1.png │ └── README-unnamed-chunk-6-1.png ├── geom_finallabel.Rd ├── geom_linepoint.Rd ├── geom_richlegend.Rd └── scale_date_align.Rd └── tests ├── testthat.R └── testthat ├── _snaps ├── combined-functions │ └── all-functions-together.svg ├── geom_finallabel │ ├── final-label.svg │ └── nudge-x-perc.svg ├── geom_linepoint │ ├── faceted-plot.svg │ ├── no-colour.svg │ ├── numeric-axes.svg │ └── unordered-data.svg ├── geom_richlegend │ ├── default-richlegend-plot.svg │ ├── faceted-richlegend-plot.svg │ ├── numeric-richlegend-position.svg │ └── string-richlegend-position.svg └── scale_x_date_align │ ├── both-aligned.svg │ ├── day-dates.svg │ ├── left-aligned.svg │ ├── manual-dates-2.svg │ ├── manual-dates.svg │ ├── month-dates.svg │ ├── right-aligned-dates.svg │ ├── right-aligned.svg │ └── year-dates.svg ├── test-combined-functions.R ├── test-geom_finallabel.R ├── test-geom_linepoint.R ├── test-geom_richlegend.R └── test-scale_x_date_align.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^ggdirectlabel\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^LICENSE\.md$ 4 | ^\.github$ 5 | ^README\.Rmd$ 6 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ${{ matrix.config.os }} 14 | 15 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 16 | 17 | strategy: 18 | fail-fast: false 19 | matrix: 20 | config: 21 | - {os: macos-latest, r: 'release'} 22 | - {os: windows-latest, r: 'release'} 23 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 24 | - {os: ubuntu-latest, r: 'release'} 25 | - {os: ubuntu-latest, r: 'oldrel-1'} 26 | 27 | env: 28 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 29 | R_KEEP_PKG_SOURCE: yes 30 | 31 | steps: 32 | - uses: actions/checkout@v3 33 | 34 | - uses: r-lib/actions/setup-pandoc@v2 35 | 36 | - uses: r-lib/actions/setup-r@v2 37 | with: 38 | r-version: ${{ matrix.config.r }} 39 | http-user-agent: ${{ matrix.config.http-user-agent }} 40 | use-public-rspm: true 41 | 42 | - uses: r-lib/actions/setup-r-dependencies@v2 43 | with: 44 | extra-packages: any::rcmdcheck 45 | needs: check 46 | 47 | - uses: r-lib/actions/check-r-package@v2 48 | with: 49 | upload-snapshots: true 50 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: ggdirectlabel 2 | Title: What the Package Does (One Line, Title Case) 3 | Version: 0.1.0.901 4 | Authors@R: 5 | person("Matt", "Cowgill", , "mattcowgill@gmail.com", role = c("aut", "cre"), 6 | comment = c(ORCID = "0000-0003-0422-3300")) 7 | Description: What the package does (one paragraph). 8 | License: MIT + file LICENSE 9 | Encoding: UTF-8 10 | Roxygen: list(markdown = TRUE) 11 | RoxygenNote: 7.2.3 12 | Imports: 13 | ggplot2, 14 | dplyr, 15 | gridtext, 16 | ggtext, 17 | scales 18 | Suggests: 19 | vdiffr, 20 | testthat (>= 3.0.0) 21 | Config/testthat/edition: 3 22 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2022 2 | COPYRIGHT HOLDER: ggdirectlabel authors 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2022 ggdirectlabel authors 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(GeomFinalLabel) 4 | export(GeomLinePoint) 5 | export(GeomRichLegend) 6 | export(breaks_right) 7 | export(geom_finallabel) 8 | export(geom_linepoint) 9 | export(geom_richlegend) 10 | export(scale_x_date_bothalign) 11 | export(scale_x_date_leftalign) 12 | export(scale_x_date_rightalign) 13 | import(ggplot2) 14 | importFrom(dplyr,mutate) 15 | importFrom(ggtext,GeomRichText) 16 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # ggdirectlabel 0.1.0.9xx 2 | * Bug fixes 3 | 4 | # ggdirectlabel 0.1.0 5 | * geom_richlegend() added 6 | 7 | # ggdirectlabel 0.0.1 8 | * initial working version, with scale_x_date_*align(), breaks_right(), 9 | geom_linepoint() and geom_finallabel() 10 | -------------------------------------------------------------------------------- /R/geom_finallabel.R: -------------------------------------------------------------------------------- 1 | #' Line with a dot on the final observation 2 | #' @description `geom_finallabel()` draws a `ggplot2::geom_text()` 3 | #' at the observation with the maximum x value for each group. 4 | #' @inheritParams ggplot2::geom_text 5 | #' @param nudge_x_perc Amount to nudge label along the x-axis, expressed as a 6 | #' percentage of the data range along the x-axis. The default is `1.5`, which 7 | #' will nudge the text 1.5% of the data range from the final point. This is applied 8 | #' in addition to `nudge_x`, which nudges the text a specific number of data units. 9 | #' @section Aesthetics: 10 | #' \code{geom_text()} understands the following aesthetics (required aesthetics are in bold): 11 | #' \itemize{ 12 | #' \item \strong{\code{x}} 13 | #' \item \strong{\code{y}} 14 | #' \item \strong{\code{label}} 15 | #' \item \code{alpha} 16 | #' \item \code{angle} 17 | #' \item \code{colour} 18 | #' \item \code{family} 19 | #' \item \code{fontface} 20 | #' \item \code{group} 21 | #' \item \code{hjust} 22 | #' \item \code{lineheight} 23 | #' \item \code{size} 24 | #' \item \code{vjust} 25 | #' } 26 | #' 27 | #' Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. 28 | #' @seealso `ggplot2::geom_text` 29 | #' @export 30 | #' @rdname geom_finallabel 31 | #' @examples 32 | #' library(ggplot2) 33 | #' 34 | #'ggplot(ggplot2::economics_long, aes(x = date, y = value)) + 35 | #' geom_linepoint(aes(col = variable)) + 36 | #' geom_finallabel(aes(label = value)) + 37 | #' facet_wrap(~variable) 38 | geom_finallabel <- 39 | function(mapping = NULL, 40 | data = NULL, 41 | stat = "identity", 42 | position = "identity", 43 | nudge_x = 0, 44 | nudge_y = 0, 45 | nudge_x_perc = 1.5, 46 | na.rm = FALSE, 47 | show.legend = FALSE, 48 | inherit.aes = TRUE, 49 | ...) { 50 | if (!missing(nudge_x) || !missing(nudge_y)) { 51 | if (!missing(position)) { 52 | stop("You must specify either `position` or `nudge_x`/`nudge_y`.") 53 | } 54 | 55 | position <- position_nudge(nudge_x, nudge_y) 56 | } 57 | 58 | ggplot2::layer( 59 | data = data, 60 | mapping = mapping, 61 | stat = stat, 62 | geom = GeomFinalLabel, 63 | position = position, 64 | show.legend = show.legend, 65 | inherit.aes = inherit.aes, 66 | params = list( 67 | na.rm = na.rm, 68 | nudge_x_perc = nudge_x_perc, 69 | ... 70 | ) 71 | ) 72 | } 73 | 74 | #' @export 75 | #' @rdname geom_finallabel 76 | GeomFinalLabel <- ggplot2::ggproto( 77 | "GeomFinalLabel", 78 | ggplot2::Geom, 79 | extra_params = c("na.rm", "nudge_x_perc"), 80 | setup_data = function(data, params) { 81 | ggplot2::GeomText$setup_data(data, params) 82 | }, 83 | draw_group = function(data, 84 | panel_params, 85 | coord, 86 | nudge_x_perc, 87 | flipped_aes = FALSE) { 88 | x_range <- range(data$x) 89 | x_min <- x_range[1] 90 | x_max <- x_range[2] 91 | data <- data[data$x == x_max, ] 92 | data$x <- data$x + ((x_max - x_min) * (nudge_x_perc / 100)) 93 | 94 | 95 | ggplot2::GeomText$draw_panel( 96 | data, 97 | panel_params, 98 | coord 99 | ) 100 | }, 101 | draw_key = ggplot2::draw_key_text, 102 | required_aes = c("x", "y", "label"), 103 | default_aes = ggplot2::aes( 104 | colour = ggplot2::GeomText$default_aes$colour, 105 | size = ggplot2::GeomText$default_aes$size, 106 | angle = ggplot2::GeomText$default_aes$angle, 107 | hjust = 0, 108 | vjust = ggplot2::GeomText$default_aes$vjust, 109 | alpha = ggplot2::GeomText$default_aes$alpha, 110 | family = ggplot2::GeomText$default_aes$family, 111 | fontface = ggplot2::GeomText$default_aes$fontface, 112 | lineheight = 0.9 113 | ) 114 | ) 115 | -------------------------------------------------------------------------------- /R/geom_linepoint.R: -------------------------------------------------------------------------------- 1 | #' Line with a dot on the final observation 2 | #' @description `geom_linepoint()` draws a `ggplot2::geom_line()` and adds a 3 | #' `ggplot2::geom_point()` at the observation with the maximum x value for each 4 | #' group. 5 | #' @inheritParams ggplot2::geom_line 6 | #' @section Aesthetics: 7 | #' \code{geom_linepoint()} understands the following aesthetics (required aesthetics are in bold): 8 | #' \itemize{ 9 | #' \item \strong{\code{x}} 10 | #' \item \strong{\code{y}} 11 | #' \item \code{alpha} 12 | #' \item \code{colour} 13 | #' \item \code{group} 14 | #' \item \code{linetype} 15 | #' \item \code{pointfill} 16 | #' \item \code{pointshape} 17 | #' \item \code{pointsize} 18 | #' \item \code{pointstroke} 19 | #' \item \code{pointshape} 20 | #' \item \code{linewidth} 21 | #' \item \code{weight} 22 | #' } 23 | #' The aesthetics that begin with 'point' (eg. `pointfill`) are passed to 24 | #' `geom_point()` - for example `pointfill` is passed to the `fill` aesthetic 25 | #' of `geom_point()`. 26 | #' 27 | #' The `x`, `y`, `alpha`, `colour`, and `group` aesthetics are passed to both 28 | #' `geom_line()` and `geom_point()`. 29 | #' 30 | #' The `linetype`, `linewidth`, and `weight` aesthetics are passed to `geom_line()`. 31 | #' 32 | #' Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. 33 | #' @seealso `ggplot2::geom_line`, `ggplot2::geom_point` 34 | #' @rdname geom_linepoint 35 | #' @export 36 | #' @examples 37 | #' library(ggplot2) 38 | #' 39 | #'ggplot(ggplot2::economics_long, aes(x = date, y = value)) + 40 | #' geom_linepoint(aes(col = variable)) + 41 | #' facet_wrap(~variable) 42 | geom_linepoint <- 43 | function(mapping = NULL, 44 | data = NULL, 45 | stat = "identity", 46 | position = "identity", 47 | na.rm = FALSE, 48 | show.legend = NA, 49 | inherit.aes = TRUE, 50 | ...) { 51 | ggplot2::layer( 52 | data = data, 53 | mapping = mapping, 54 | stat = stat, 55 | geom = GeomLinePoint, 56 | position = position, 57 | show.legend = show.legend, 58 | inherit.aes = inherit.aes, 59 | params = list( 60 | na.rm = na.rm, 61 | ... 62 | ) 63 | ) 64 | } 65 | 66 | #' @rdname geom_linepoint 67 | #' @export 68 | GeomLinePoint <- ggplot2::ggproto( 69 | "GeomLinePoint", 70 | ggplot2::Geom, 71 | extra_params = c("na.rm"), 72 | setup_data = function(data, params) { 73 | ggplot2::GeomLine$setup_data(data, params) 74 | }, 75 | draw_group = function(data, 76 | panel_params, 77 | coord, 78 | lineend = "butt", 79 | linejoin = "round", 80 | linemitre = 10, 81 | size = 5, 82 | flipped_aes = FALSE) { 83 | point <- data 84 | point <- point[point$x == point$x[length(point$x)], ] 85 | point$size <- point$pointsize 86 | point$fill <- point$pointfill 87 | point$shape <- point$pointshape 88 | point$stroke <- point$pointstroke 89 | point$shape <- point$pointshape 90 | 91 | if (utils::packageVersion("ggplot2") < "3.4.0") { 92 | names(data)[names(data) == "linewidth"] <- "size" 93 | } 94 | 95 | path <- transform(data, alpha = NA) 96 | 97 | grid::gList( 98 | ggplot2::GeomLine$draw_panel( 99 | path, 100 | panel_params, 101 | coord, 102 | lineend = lineend, 103 | linejoin = linejoin, 104 | linemitre = linemitre 105 | ), 106 | ggplot2::GeomPoint$draw_panel(point, panel_params, coord) 107 | ) 108 | }, 109 | draw_key = ggplot2::draw_key_smooth, 110 | required_aes = c("x", "y"), 111 | non_missing_aes = c( 112 | "linewidth", "shape", "colour", "pointsize", 113 | "pointstroke", "pointfill", "pointshape" 114 | ), 115 | default_aes = ggplot2::aes( 116 | pointsize = 2.5, 117 | pointfill = "white", 118 | pointshape = 21, 119 | shape = 19, 120 | colour = "black", 121 | linewidth = 1, 122 | alpha = 1, 123 | pointstroke = 1.5, 124 | linetype = 1, 125 | weight = 1 126 | ) 127 | ) 128 | -------------------------------------------------------------------------------- /R/geom_richlegend.R: -------------------------------------------------------------------------------- 1 | #' Create a 'rich legend' for your ggplot2 plot. 2 | #' @description `geom_richlegend()` draws coloured text in lieu of a legend. It 3 | #' uses the wonderful `{ggtext}` to create coloured text annotation(s) at a 4 | #' location of your choice on your plot. Use this instead of a standard legend. 5 | #' @param legend.position Either: 6 | #' 7 | #' - a two-element numeric vector such as `c(0.2, 0.9)`. The first element 8 | #' denoted the x-position of the data and the second element denotes the 9 | #' y-position. Each element must be between 0 and 1 (inclusive). 10 | #' 11 | #' - one of the following strings: "left", "right", "bottom", "top", 12 | #' "topleft", "topright", "bottomleft", "bottomright". 13 | #' 14 | #' Default is "topright", which is equivalent to `c(0.975, 0.975)`. 15 | #' 16 | #' @inheritParams ggtext::geom_richtext 17 | #' @examples 18 | #' library(ggplot2) 19 | #' 20 | #' base_plot <- ggplot(mtcars, aes(x = wt, y = mpg, col = factor(cyl))) + 21 | #' geom_point() + 22 | #' theme(legend.position = "none") 23 | #' 24 | #' # By default, the rich legend is placed at the "topright" 25 | #' base_plot + 26 | #' geom_richlegend(aes(label = cyl)) 27 | #' 28 | #' # You can change the position of the rich legend: 29 | #' base_plot + 30 | #' geom_richlegend(aes(label = cyl), 31 | #' legend.position = "top") 32 | #' 33 | #' # Or you can change the position using a numeric vector: 34 | #' base_plot + 35 | #' geom_richlegend(aes(label = cyl), 36 | #' legend.position = c(0.1, 0.1)) 37 | #' 38 | #' # The legend respects facets: 39 | #' base_plot + 40 | #' geom_richlegend(aes(label = cyl)) + 41 | #' facet_wrap(~cyl) 42 | #' 43 | #' 44 | #' @import ggplot2 45 | #' @rdname geom_richlegend 46 | #' @export 47 | geom_richlegend <- 48 | function(mapping = NULL, 49 | data = NULL, 50 | legend.position = "topright", 51 | na.rm = FALSE, 52 | inherit.aes = TRUE, 53 | ...) { 54 | ggplot2::layer( 55 | data = data, 56 | mapping = mapping, 57 | stat = "identity", 58 | geom = GeomRichLegend, 59 | position = "identity", 60 | show.legend = FALSE, 61 | inherit.aes = inherit.aes, 62 | params = list( 63 | na.rm = na.rm, 64 | legend.position = legend.position, 65 | ... 66 | ) 67 | ) 68 | } 69 | 70 | #' @rdname geom_richlegend 71 | #' @export 72 | #' @importFrom ggtext GeomRichText 73 | #' @importFrom dplyr mutate 74 | GeomRichLegend <- ggplot2::ggproto( 75 | "GeomRichLegend", 76 | ggplot2::Geom, 77 | extra_params = c("na.rm", 78 | "legend.position"), 79 | setup_data = function(data, params) { 80 | 81 | out <- ggtext::GeomRichText$setup_data(data, params) |> 82 | dplyr::group_by(label, PANEL, colour) |> 83 | dplyr::summarise() |> 84 | dplyr::distinct() |> 85 | dplyr::ungroup() |> 86 | dplyr::mutate(legend.position = list(params$legend.position)) 87 | 88 | out 89 | }, 90 | draw_panel = function(data, 91 | panel_params, 92 | coord, 93 | flipped_aes = FALSE) { 94 | 95 | xy <- legend_pos_to_xy(data$legend.position[[1]], 96 | panel_params$x.range, 97 | panel_params$y.range, 98 | inherits(coord, "CoordFlip")) 99 | 100 | richtext_data <- data |> 101 | dplyr::mutate( 102 | label = paste0( 103 | "", 106 | label, 107 | "" 108 | ), 109 | x = xy[1], 110 | y = xy[2] 111 | ) |> 112 | dplyr::group_by( 113 | PANEL, x, y, size, angle, hjust, vjust, 114 | alpha, lineheight, family, fontface 115 | ) |> 116 | dplyr::summarise(label = paste0(label, collapse = "
")) |> 117 | dplyr::ungroup() |> 118 | as.data.frame() |> 119 | dplyr::mutate(colour = "#000000") 120 | 121 | rt_draw_panel( 122 | richtext_data, 123 | panel_params, 124 | coord 125 | ) 126 | }, 127 | draw_key = ggplot2::draw_key_text, 128 | required_aes = c( 129 | "label", 130 | "colour" 131 | ), 132 | default_aes = ggplot2::aes( 133 | colour = ggtext::GeomRichText$default_aes$colour, 134 | size = ggtext::GeomRichText$default_aes$size, 135 | angle = ggtext::GeomRichText$default_aes$angle, 136 | hjust = 1, 137 | vjust = 1, 138 | alpha = ggtext::GeomRichText$default_aes$alpha, 139 | family = ggtext::GeomRichText$default_aes$family, 140 | fontface = ggtext::GeomRichText$default_aes$fontface, 141 | lineheight = 1.2 142 | ) 143 | ) 144 | 145 | legend_pos_to_xy <- function(legend.position, 146 | xrange, 147 | yrange, 148 | flipped) { 149 | l <- legend.position 150 | 151 | if(is.numeric(l)) { 152 | stopifnot("Numeric `legend.position` must have length 2" = length(l) == 2) 153 | stopifnot("Numeric `legend.position` must have values between 0 & 1" = 154 | min(l) >= 0 || max(l) <= 1) 155 | l_num <- l 156 | } 157 | 158 | if (is.character(l)) { 159 | stopifnot(l %in% c("left", 160 | "right", 161 | "bottom", 162 | "top", 163 | "topright", 164 | "bottomright", 165 | "bottomleft", 166 | "topleft")) 167 | l_num <- switch( 168 | l, 169 | "left" = c(0.025, 0.5), 170 | "right" = c(0.975, 0.5), 171 | "bottom" = c(0.5, 0.025), 172 | "top" = c(0.5, 0.975), 173 | "topright" = c(0.975, 0.975), 174 | "bottomright" = c(0.975, 0.025), 175 | "bottomleft" = c(0.025, 0.025), 176 | "topleft" = c(0.025, 0.975) 177 | ) 178 | } 179 | l_x <- l_num[1] * (xrange[2] - xrange[1]) + xrange[1] 180 | l_y <- l_num[2] * (yrange[2] - yrange[1]) + yrange[1] 181 | 182 | if (isTRUE(flipped)) { 183 | return(c(l_y, l_x)) 184 | } else { 185 | return(c(l_x, l_y)) 186 | } 187 | } 188 | 189 | #' Slightly modified from gridtext by Claus O Wilke 190 | #' @keywords internal 191 | #' @noRd 192 | rt_draw_panel <- function(data, panel_params, coord, 193 | label.padding = unit(c( 194 | 0.25, 195 | 0.25, 0.25, 0.25 196 | ), "lines"), 197 | label.margin = unit(c( 198 | 0, 0, 199 | 0, 0 200 | ), "lines"), 201 | label.r = unit(0.15, "lines"), 202 | na.rm = FALSE) { 203 | data <- coord$transform(data, panel_params) 204 | if (is.character(data$vjust)) { 205 | data$vjust <- compute_just(data$vjust, data$y) 206 | } 207 | if (is.character(data$hjust)) { 208 | data$hjust <- compute_just(data$hjust, data$x) 209 | } 210 | gridtext::richtext_grob(data$label, data$x, data$y, 211 | default.units = "native", 212 | hjust = data$hjust, vjust = data$vjust, rot = data$angle, 213 | padding = label.padding, margin = label.margin, 214 | gp = grid::gpar( 215 | col = scales::alpha(data$text.colour %||% 216 | data$colour, data$alpha), fontsize = data$size * 217 | .pt, fontfamily = data$family, fontface = data$fontface, 218 | lineheight = data$lineheight 219 | ), 220 | r = label.r 221 | ) 222 | } 223 | 224 | #' @noRd 225 | `%||%` <- function(a, b) { 226 | if (!is.null(a)) { 227 | a 228 | } else { 229 | b 230 | } 231 | } 232 | 233 | # From gridtext by Claus O Wilke 234 | #' @noRd 235 | compute_just <- function(just, x) { 236 | inward <- just == "inward" 237 | just[inward] <- c("left", "middle", "right")[just_dir(x[inward])] 238 | outward <- just == "outward" 239 | just[outward] <- c("right", "middle", "left")[just_dir(x[outward])] 240 | 241 | unname(c(left = 0, center = 0.5, right = 1, 242 | bottom = 0, middle = 0.5, top = 1)[just]) 243 | } 244 | 245 | # From gridtext by Claus O Wilke 246 | #' @noRd 247 | just_dir <- function(x, tol = 0.001) { 248 | out <- rep(2L, length(x)) 249 | out[x < 0.5 - tol] <- 1L 250 | out[x > 0.5 + tol] <- 3L 251 | out 252 | } 253 | 254 | -------------------------------------------------------------------------------- /R/scale_x_date_rightalign.R: -------------------------------------------------------------------------------- 1 | #' Add a ggplot2 date scale with breaks aligned to the end of your data 2 | #' 3 | #' When visualising time series, it's often important to be clear about 4 | #' the date of the latest observation. `scale_x_date_rightalign()` aligns 5 | #' your axis breaks to the most recent observation in your data. 6 | #' 7 | #' `scale_x_date_leftalign()` aligns your breaks to the initial date in 8 | #' your data. 9 | #' 10 | #' `scale_x_date_bothalign()` ensures that your breaks include both the initial 11 | #' and final date in your data, with evenly-spaced breaks in between. 12 | #' 13 | #' @param expand The amount of padding/expansion that should be added at the 14 | #' left and right of the data. Use the `ggplot2::expansion()` function to 15 | #' add padding. By default, 5% padding is added to both right and left. 16 | #' @param num_breaks The (approximate) number of breaks to include on the 17 | #' axis. `base::pretty()` is used to generate these breaks. 18 | #' @param date_labels The format for the date labels on the axis. The default 19 | #' means "day of month, then shortened month, then linebreak, then 20 | #' full year". See `?strptime` for codes that can be used here. The default is 21 | #' `NULL`, which means a sensible default will be inferred from your data. 22 | #' @param ... Arguments passed to `ggplot2::scale_x_date()`. 23 | #' @export 24 | #' @rdname scale_date_align 25 | #' @import ggplot2 26 | #' @examples 27 | #' library(ggplot2) 28 | #' ggplot(ggplot2::economics, aes(date, unemploy)) + 29 | #' geom_line() + 30 | #' scale_x_date_rightalign() 31 | #' 32 | #' ggplot(ggplot2::economics, aes(date, unemploy)) + 33 | #' geom_line() + 34 | #' scale_x_date_leftalign() 35 | #' 36 | #' ggplot(ggplot2::economics, aes(date, unemploy)) + 37 | #' geom_line() + 38 | #' scale_x_date_bothalign() 39 | scale_x_date_rightalign <- function(expand = expansion(mult = c(0.05, 0.1)), 40 | num_breaks = 5, 41 | date_labels = NULL, 42 | ...) { 43 | scale_x_date_align(expand = expand, 44 | num_breaks = num_breaks, 45 | date_labels = date_labels, 46 | align = "right", 47 | ...) 48 | } 49 | 50 | #' @rdname scale_date_align 51 | #' @export 52 | scale_x_date_leftalign <- function(expand = expansion(mult = c(0.05, 0.05)), 53 | num_breaks = 5, 54 | date_labels = NULL, 55 | ...) { 56 | scale_x_date_align(expand = expand, 57 | num_breaks = num_breaks, 58 | date_labels = date_labels, 59 | align = "left", 60 | ...) 61 | } 62 | 63 | #' @rdname scale_date_align 64 | #' @export 65 | scale_x_date_bothalign <- function(expand = expansion(mult = c(0.05, 0.05)), 66 | num_breaks = 5, 67 | date_labels = NULL, 68 | ...) { 69 | scale_x_date_align(expand = expand, 70 | num_breaks = num_breaks, 71 | date_labels = date_labels, 72 | align = "both", 73 | ...) 74 | } 75 | 76 | scale_x_date_align <- function(expand = expansion(mult = c(0.05, 0.05)), 77 | num_breaks = 5, 78 | date_labels = NULL, 79 | align = c("both", "right", "left"), 80 | ...) { 81 | 82 | align <- match.arg(align) 83 | 84 | date_labeller <- if (is.null(date_labels)) { 85 | function(x, fmt = labels_date_auto(x)) format(x, fmt) 86 | } else { 87 | function(x, fmt = date_labels) format(x, fmt) 88 | } 89 | 90 | scale_x_date( 91 | expand = expand, 92 | breaks = function(limits, 93 | exp = expand, 94 | break_num = num_breaks, 95 | date_align = align) { 96 | exp_mult <- exp[c(1, 3)] 97 | exp_add <- exp[c(2, 4)] 98 | 99 | range_perc_data <- 1 + exp_mult[1] + exp_mult[2] 100 | data_range <- as.numeric((1 / range_perc_data) * 101 | (limits[2] - limits[1] - exp_add[1] - exp_add[2])) 102 | 103 | data_max <- 104 | limits[2] - (data_range * (exp_mult[2])) - exp_add[2] 105 | 106 | data_min <- data_max - data_range 107 | 108 | if (date_align == "right") { 109 | breaks <- breaks_right(limits = c(data_min, data_max), 110 | n_breaks = break_num) 111 | } else if (date_align == "left") { 112 | breaks <- breaks_left(limits = c(data_min, data_max), 113 | n_breaks = break_num) 114 | } else { 115 | breaks <- seq.Date(from = data_min, 116 | to = data_max, 117 | length.out = break_num) 118 | } 119 | 120 | 121 | 122 | breaks 123 | }, 124 | labels = date_labeller, 125 | ... 126 | ) 127 | } 128 | 129 | 130 | #' Generate date breaks that align with the maximum data value 131 | #' 132 | #' This function generates a vector of of 'pretty' 133 | #' breaks (using `scales::breaks_pretty()`) that ends with 134 | #' the upper limit provided and excludes any values that lie 135 | #' outside the limits. 136 | #' 137 | #' @param limits Length-two numeric or date vector 138 | #' @param n_breaks Number of breaks; passed to `scales::breaks_pretty()` 139 | #' @param ... Passed to `scales::breaks_pretty()` 140 | #' @export 141 | #' @seealso scale_x_date_rightalign() 142 | #' @return Vector of breaks, of the same class as `limits` 143 | #' @author Originally written by Matt Cowgill for the `djprtheme` package, 144 | #' in which the Department of Jobs, Precincts and Regions (Victoria) is 145 | #' the copyright holder. 146 | #' @examples 147 | #'# Can be used with numeric vectors 148 | #'breaks_right(c(10, 30)) 149 | #' 150 | #'# Or date vectors 151 | #'econ_dates <- range(ggplot2::economics$date) 152 | #'breaks_right(econ_dates) 153 | #' 154 | #'# Can be supplied directly to the `breaks` argument of 155 | #'# `ggplot2::scale_*_continuous()`. Note that the breaks will 156 | #'# be aligned to the right-limit of the plot 157 | #'# (including expansion/padding area). 158 | #' 159 | #'library(ggplot2) 160 | #' 161 | #'ggplot(ggplot2::economics, 162 | #' aes(x = date, y = unemploy)) + 163 | #' geom_line() + 164 | #' scale_x_date(breaks = breaks_right) 165 | #' 166 | #' # To right-align to the data, not including padding, try: 167 | #' ggplot(ggplot2::economics, 168 | #' aes(x = date, y = unemploy)) + 169 | #' geom_line() + 170 | #' scale_x_date(breaks = breaks_right(limits = range( 171 | #' ggplot2::economics$date))) 172 | #' 173 | #' # Or use `scale_x_date_rightalign()`: 174 | #' ggplot(ggplot2::economics, 175 | #' aes(x = date, y = unemploy)) + 176 | #' geom_line() + 177 | #' scale_x_date_rightalign() 178 | #' 179 | breaks_right <- function(limits, 180 | n_breaks = 5, 181 | ...) { 182 | breaks_align(limits = limits, 183 | n_breaks = n_breaks, 184 | date_align = "right", 185 | ...) 186 | } 187 | 188 | breaks_left <- function(limits, 189 | n_breaks = 5, 190 | ...) { 191 | breaks_align(limits = limits, 192 | n_breaks = n_breaks, 193 | date_align = "left", 194 | ...) 195 | } 196 | 197 | breaks_align <- function(limits, 198 | n_breaks, 199 | date_align = c("right", "left"), 200 | ...) { 201 | date_align <- match.arg(date_align) 202 | min_date <- limits[1] 203 | max_date <- limits[2] 204 | pre_br <- scales::breaks_pretty(n = n_breaks, 205 | min.n = n_breaks - 1, 206 | ...)(c(min_date, max_date)) 207 | 208 | 209 | if (date_align == "right") { 210 | date_adj <- as.numeric(pre_br[length(pre_br)] - max_date) 211 | } else { 212 | date_adj <- as.numeric(min(pre_br[pre_br >= min_date]) - min_date) 213 | } 214 | 215 | adj_br <- pre_br - date_adj 216 | names(adj_br) <- NULL 217 | out_br <- adj_br[adj_br >= min_date & adj_br <= max_date] 218 | out_br 219 | } 220 | 221 | labels_date_auto <- function(dates) { 222 | date_range <- as.numeric(max(dates) - min(dates)) 223 | days_per_obs <- date_range / length(unique(dates)) 224 | 225 | if (days_per_obs < 28) { 226 | fmt <- "%e %b\n%Y" 227 | } else if (days_per_obs < 365) { 228 | fmt <- "%b\n%Y" 229 | } else { 230 | fmt <- "%Y" 231 | } 232 | fmt 233 | } 234 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | # out.width = "100%", 13 | fig.retina = 2 14 | ) 15 | ``` 16 | 17 | # ggdirectlabel 18 | 19 | 20 | [![R-CMD-check](https://github.com/MattCowgill/ggdirectlabel/workflows/R-CMD-check/badge.svg)](https://github.com/MattCowgill/ggdirectlabel/actions) 21 | [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) 22 | [![R-CMD-check](https://github.com/MattCowgill/ggdirectlabel/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/MattCowgill/ggdirectlabel/actions/workflows/R-CMD-check.yaml) 23 | 24 | 25 | The goal of ggdirectlabel is to make it easier to directly label ggplot2 charts rather than using legends. 26 | 27 | ## Installation 28 | 29 | You can install the development version of ggdirectlabel from [GitHub](https://github.com/) with: 30 | 31 | ``` r 32 | # install.packages("devtools") 33 | devtools::install_github("MattCowgill/ggdirectlabel") 34 | ``` 35 | 36 | ```{r} 37 | library(ggdirectlabel) 38 | library(ggplot2) 39 | library(magrittr) 40 | ``` 41 | 42 | ## Using `geom_richlegend()` 43 | Here's a standard ggplot2 scatterplot: 44 | ```{r} 45 | base_scatter <- mtcars |> 46 | ggplot(aes(x = wt, y = mpg, col = factor(cyl))) + 47 | geom_point() 48 | 49 | base_scatter 50 | ``` 51 | 52 | This is fine! But sometimes you might like the legend levels (4, 6, and 8 in this example) to be coloured according to the levels in the data. That's where `geom_richlegend()` comes in: 53 | ```{r} 54 | base_scatter + 55 | geom_richlegend(aes(label = cyl)) + 56 | theme(legend.position = "none") 57 | ``` 58 | 59 | You can move the 'rich legend' around: 60 | ```{r} 61 | base_scatter + 62 | geom_richlegend(aes(label = cyl), 63 | legend.position = "bottomleft", 64 | vjust = 0, 65 | hjust = 0) + 66 | theme(legend.position = "none") 67 | ``` 68 | 69 | `geom_richlegend()` respects facets - it'll place a little legend annotation for each level of the data that appears in that panel: 70 | 71 | ```{r} 72 | base_scatter + 73 | geom_richlegend(aes(label = paste0(cyl, " cylinders"))) + 74 | facet_wrap(~cyl) 75 | ``` 76 | 77 | 78 | ## Using `geom_linepoint()` 79 | 80 | Without ggirectlabel, we might do something like: 81 | 82 | ```{r no-directlabel} 83 | 84 | ggplot2::economics_long %>% 85 | ggplot(aes(x = date, y = value, col = variable)) + 86 | geom_line() + 87 | geom_point(data = ~dplyr::filter(., date == max(date)), 88 | fill = "white", 89 | shape = 21, 90 | size = 2.5, 91 | stroke = 1.25) 92 | ``` 93 | 94 | This is fine! But this is a more straightforward way to achieve the same thing: 95 | 96 | ```{r example} 97 | ggplot2::economics_long %>% 98 | ggplot(aes(x = date, y = value, col = variable)) + 99 | geom_linepoint() 100 | ``` 101 | 102 | ## Using `scale_x_date_rightalign()` 103 | 104 | In time series line charts, it's often important to make clear the date of 105 | your most recent observation. The `scale_x_date_rightalign()` function aligns 106 | the breaks of your x-axis so that the most recent observation is included in 107 | the breaks. 108 | 109 | ```{r scale_x_date_rightalign} 110 | ggplot2::economics_long %>% 111 | ggplot(aes(x = date, y = value, col = variable)) + 112 | geom_linepoint() + 113 | scale_x_date_rightalign() 114 | ``` 115 | 116 | ## Using `geom_finallabel()` 117 | 118 | In time series line charts, you may wish to label the final point in the series. The `geom_finallabel()` function makes that easy. 119 | 120 | ```{r geom_finallabel} 121 | ggplot2::economics_long %>% 122 | ggplot(aes(x = date, y = value, col = variable)) + 123 | geom_linepoint() + 124 | geom_finallabel(aes(label = round(value, 0))) + 125 | scale_x_date_rightalign(expand = expansion(c(0, 0.15))) + 126 | theme(legend.position = "none") 127 | ``` 128 | 129 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # ggdirectlabel 5 | 6 | 7 | 8 | [![R-CMD-check](https://github.com/MattCowgill/ggdirectlabel/workflows/R-CMD-check/badge.svg)](https://github.com/MattCowgill/ggdirectlabel/actions) 9 | [![Lifecycle: 10 | experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) 11 | [![R-CMD-check](https://github.com/MattCowgill/ggdirectlabel/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/MattCowgill/ggdirectlabel/actions/workflows/R-CMD-check.yaml) 12 | 13 | 14 | The goal of ggdirectlabel is to make it easier to directly label ggplot2 15 | charts rather than using legends. 16 | 17 | ## Installation 18 | 19 | You can install the development version of ggdirectlabel from 20 | [GitHub](https://github.com/) with: 21 | 22 | ``` r 23 | # install.packages("devtools") 24 | devtools::install_github("MattCowgill/ggdirectlabel") 25 | ``` 26 | 27 | ``` r 28 | library(ggdirectlabel) 29 | library(ggplot2) 30 | library(magrittr) 31 | ``` 32 | 33 | ## Using `geom_richlegend()` 34 | 35 | Here’s a standard ggplot2 scatterplot: 36 | 37 | ``` r 38 | base_scatter <- mtcars |> 39 | ggplot(aes(x = wt, y = mpg, col = factor(cyl))) + 40 | geom_point() 41 | 42 | base_scatter 43 | ``` 44 | 45 | 46 | 47 | This is fine! But sometimes you might like the legend levels (4, 6, and 48 | 8 in this example) to be coloured according to the levels in the data. 49 | That’s where `geom_richlegend()` comes in: 50 | 51 | ``` r 52 | base_scatter + 53 | geom_richlegend(aes(label = cyl)) + 54 | theme(legend.position = "none") 55 | ``` 56 | 57 | 58 | 59 | You can move the ‘rich legend’ around: 60 | 61 | ``` r 62 | base_scatter + 63 | geom_richlegend(aes(label = cyl), 64 | legend.position = "bottomleft", 65 | vjust = 0, 66 | hjust = 0) + 67 | theme(legend.position = "none") 68 | ``` 69 | 70 | 71 | 72 | `geom_richlegend()` respects facets - it’ll place a little legend 73 | annotation for each level of the data that appears in that panel: 74 | 75 | ``` r 76 | base_scatter + 77 | geom_richlegend(aes(label = paste0(cyl, " cylinders"))) + 78 | facet_wrap(~cyl) 79 | ``` 80 | 81 | 82 | 83 | ## Using `geom_linepoint()` 84 | 85 | Without ggirectlabel, we might do something like: 86 | 87 | ``` r 88 | 89 | ggplot2::economics_long %>% 90 | ggplot(aes(x = date, y = value, col = variable)) + 91 | geom_line() + 92 | geom_point(data = ~dplyr::filter(., date == max(date)), 93 | fill = "white", 94 | shape = 21, 95 | size = 2.5, 96 | stroke = 1.25) 97 | ``` 98 | 99 | 100 | 101 | This is fine! But this is a more straightforward way to achieve the same 102 | thing: 103 | 104 | ``` r 105 | ggplot2::economics_long %>% 106 | ggplot(aes(x = date, y = value, col = variable)) + 107 | geom_linepoint() 108 | ``` 109 | 110 | 111 | 112 | ## Using `scale_x_date_rightalign()` 113 | 114 | In time series line charts, it’s often important to make clear the date 115 | of your most recent observation. The `scale_x_date_rightalign()` 116 | function aligns the breaks of your x-axis so that the most recent 117 | observation is included in the breaks. 118 | 119 | ``` r 120 | ggplot2::economics_long %>% 121 | ggplot(aes(x = date, y = value, col = variable)) + 122 | geom_linepoint() + 123 | scale_x_date_rightalign() 124 | ``` 125 | 126 | 127 | 128 | ## Using `geom_finallabel()` 129 | 130 | In time series line charts, you may wish to label the final point in the 131 | series. The `geom_finallabel()` function makes that easy. 132 | 133 | ``` r 134 | ggplot2::economics_long %>% 135 | ggplot(aes(x = date, y = value, col = variable)) + 136 | geom_linepoint() + 137 | geom_finallabel(aes(label = round(value, 0))) + 138 | scale_x_date_rightalign(expand = expansion(c(0, 0.15))) + 139 | theme(legend.position = "none") 140 | ``` 141 | 142 | 143 | -------------------------------------------------------------------------------- /ggdirectlabel.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | LineEndingConversion: Posix 18 | 19 | BuildType: Package 20 | PackageUseDevtools: Yes 21 | PackageInstallArgs: --no-multiarch --with-keep.source 22 | PackageRoxygenize: rd,collate,namespace 23 | -------------------------------------------------------------------------------- /man/breaks_right.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scale_x_date_rightalign.R 3 | \name{breaks_right} 4 | \alias{breaks_right} 5 | \title{Generate date breaks that align with the maximum data value} 6 | \usage{ 7 | breaks_right(limits, n_breaks = 5, ...) 8 | } 9 | \arguments{ 10 | \item{limits}{Length-two numeric or date vector} 11 | 12 | \item{n_breaks}{Number of breaks; passed to \code{scales::breaks_pretty()}} 13 | 14 | \item{...}{Passed to \code{scales::breaks_pretty()}} 15 | } 16 | \value{ 17 | Vector of breaks, of the same class as \code{limits} 18 | } 19 | \description{ 20 | This function generates a vector of of 'pretty' 21 | breaks (using \code{scales::breaks_pretty()}) that ends with 22 | the upper limit provided and excludes any values that lie 23 | outside the limits. 24 | } 25 | \examples{ 26 | # Can be used with numeric vectors 27 | breaks_right(c(10, 30)) 28 | 29 | # Or date vectors 30 | econ_dates <- range(ggplot2::economics$date) 31 | breaks_right(econ_dates) 32 | 33 | # Can be supplied directly to the `breaks` argument of 34 | # `ggplot2::scale_*_continuous()`. Note that the breaks will 35 | # be aligned to the right-limit of the plot 36 | # (including expansion/padding area). 37 | 38 | library(ggplot2) 39 | 40 | ggplot(ggplot2::economics, 41 | aes(x = date, y = unemploy)) + 42 | geom_line() + 43 | scale_x_date(breaks = breaks_right) 44 | 45 | # To right-align to the data, not including padding, try: 46 | ggplot(ggplot2::economics, 47 | aes(x = date, y = unemploy)) + 48 | geom_line() + 49 | scale_x_date(breaks = breaks_right(limits = range( 50 | ggplot2::economics$date))) 51 | 52 | # Or use `scale_x_date_rightalign()`: 53 | ggplot(ggplot2::economics, 54 | aes(x = date, y = unemploy)) + 55 | geom_line() + 56 | scale_x_date_rightalign() 57 | 58 | } 59 | \seealso{ 60 | scale_x_date_rightalign() 61 | } 62 | \author{ 63 | Originally written by Matt Cowgill for the \code{djprtheme} package, 64 | in which the Department of Jobs, Precincts and Regions (Victoria) is 65 | the copyright holder. 66 | } 67 | -------------------------------------------------------------------------------- /man/figures/README-example-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MattCowgill/ggdirectlabel/757a27674483ed3f681a987f01e7168bf02c2e88/man/figures/README-example-1.png -------------------------------------------------------------------------------- /man/figures/README-geom_finallabel-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MattCowgill/ggdirectlabel/757a27674483ed3f681a987f01e7168bf02c2e88/man/figures/README-geom_finallabel-1.png -------------------------------------------------------------------------------- /man/figures/README-no-directlabel-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MattCowgill/ggdirectlabel/757a27674483ed3f681a987f01e7168bf02c2e88/man/figures/README-no-directlabel-1.png -------------------------------------------------------------------------------- /man/figures/README-scale_x_date_rightalign-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MattCowgill/ggdirectlabel/757a27674483ed3f681a987f01e7168bf02c2e88/man/figures/README-scale_x_date_rightalign-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-3-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MattCowgill/ggdirectlabel/757a27674483ed3f681a987f01e7168bf02c2e88/man/figures/README-unnamed-chunk-3-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-4-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MattCowgill/ggdirectlabel/757a27674483ed3f681a987f01e7168bf02c2e88/man/figures/README-unnamed-chunk-4-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-5-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MattCowgill/ggdirectlabel/757a27674483ed3f681a987f01e7168bf02c2e88/man/figures/README-unnamed-chunk-5-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-6-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MattCowgill/ggdirectlabel/757a27674483ed3f681a987f01e7168bf02c2e88/man/figures/README-unnamed-chunk-6-1.png -------------------------------------------------------------------------------- /man/geom_finallabel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom_finallabel.R 3 | \docType{data} 4 | \name{geom_finallabel} 5 | \alias{geom_finallabel} 6 | \alias{GeomFinalLabel} 7 | \title{Line with a dot on the final observation} 8 | \format{ 9 | An object of class \code{GeomFinalLabel} (inherits from \code{Geom}, \code{ggproto}, \code{gg}) of length 7. 10 | } 11 | \usage{ 12 | geom_finallabel( 13 | mapping = NULL, 14 | data = NULL, 15 | stat = "identity", 16 | position = "identity", 17 | nudge_x = 0, 18 | nudge_y = 0, 19 | nudge_x_perc = 1.5, 20 | na.rm = FALSE, 21 | show.legend = FALSE, 22 | inherit.aes = TRUE, 23 | ... 24 | ) 25 | 26 | GeomFinalLabel 27 | } 28 | \arguments{ 29 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and 30 | \code{inherit.aes = TRUE} (the default), it is combined with the default mapping 31 | at the top level of the plot. You must supply \code{mapping} if there is no plot 32 | mapping.} 33 | 34 | \item{data}{The data to be displayed in this layer. There are three 35 | options: 36 | 37 | If \code{NULL}, the default, the data is inherited from the plot 38 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 39 | 40 | A \code{data.frame}, or other object, will override the plot 41 | data. All objects will be fortified to produce a data frame. See 42 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 43 | 44 | A \code{function} will be called with a single argument, 45 | the plot data. The return value must be a \code{data.frame}, and 46 | will be used as the layer data. A \code{function} can be created 47 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 48 | 49 | \item{stat}{The statistical transformation to use on the data for this 50 | layer, either as a \code{ggproto} \code{Geom} subclass or as a string naming the 51 | stat stripped of the \code{stat_} prefix (e.g. \code{"count"} rather than 52 | \code{"stat_count"})} 53 | 54 | \item{position}{Position adjustment, either as a string, or the result of 55 | a call to a position adjustment function. Cannot be jointly specified with 56 | \code{nudge_x} or \code{nudge_y}.} 57 | 58 | \item{nudge_x, nudge_y}{Horizontal and vertical adjustment to nudge labels by. 59 | Useful for offsetting text from points, particularly on discrete scales. 60 | Cannot be jointly specified with \code{position}.} 61 | 62 | \item{nudge_x_perc}{Amount to nudge label along the x-axis, expressed as a 63 | percentage of the data range along the x-axis. The default is \code{1.5}, which 64 | will nudge the text 1.5\% of the data range from the final point. This is applied 65 | in addition to \code{nudge_x}, which nudges the text a specific number of data units.} 66 | 67 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed with 68 | a warning. If \code{TRUE}, missing values are silently removed.} 69 | 70 | \item{show.legend}{logical. Should this layer be included in the legends? 71 | \code{NA}, the default, includes if any aesthetics are mapped. 72 | \code{FALSE} never includes, and \code{TRUE} always includes. 73 | It can also be a named logical vector to finely select the aesthetics to 74 | display.} 75 | 76 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 77 | rather than combining with them. This is most useful for helper functions 78 | that define both data and aesthetics and shouldn't inherit behaviour from 79 | the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} 80 | 81 | \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are 82 | often aesthetics, used to set an aesthetic to a fixed value, like 83 | \code{colour = "red"} or \code{size = 3}. They may also be parameters 84 | to the paired geom/stat.} 85 | } 86 | \description{ 87 | \code{geom_finallabel()} draws a \code{ggplot2::geom_text()} 88 | at the observation with the maximum x value for each group. 89 | } 90 | \section{Aesthetics}{ 91 | 92 | \code{geom_text()} understands the following aesthetics (required aesthetics are in bold): 93 | \itemize{ 94 | \item \strong{\code{x}} 95 | \item \strong{\code{y}} 96 | \item \strong{\code{label}} 97 | \item \code{alpha} 98 | \item \code{angle} 99 | \item \code{colour} 100 | \item \code{family} 101 | \item \code{fontface} 102 | \item \code{group} 103 | \item \code{hjust} 104 | \item \code{lineheight} 105 | \item \code{size} 106 | \item \code{vjust} 107 | } 108 | 109 | Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. 110 | } 111 | 112 | \examples{ 113 | library(ggplot2) 114 | 115 | ggplot(ggplot2::economics_long, aes(x = date, y = value)) + 116 | geom_linepoint(aes(col = variable)) + 117 | geom_finallabel(aes(label = value)) + 118 | facet_wrap(~variable) 119 | } 120 | \seealso{ 121 | \code{ggplot2::geom_text} 122 | } 123 | \keyword{datasets} 124 | -------------------------------------------------------------------------------- /man/geom_linepoint.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom_linepoint.R 3 | \docType{data} 4 | \name{geom_linepoint} 5 | \alias{geom_linepoint} 6 | \alias{GeomLinePoint} 7 | \title{Line with a dot on the final observation} 8 | \format{ 9 | An object of class \code{GeomLinePoint} (inherits from \code{Geom}, \code{ggproto}, \code{gg}) of length 8. 10 | } 11 | \usage{ 12 | geom_linepoint( 13 | mapping = NULL, 14 | data = NULL, 15 | stat = "identity", 16 | position = "identity", 17 | na.rm = FALSE, 18 | show.legend = NA, 19 | inherit.aes = TRUE, 20 | ... 21 | ) 22 | 23 | GeomLinePoint 24 | } 25 | \arguments{ 26 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and 27 | \code{inherit.aes = TRUE} (the default), it is combined with the default mapping 28 | at the top level of the plot. You must supply \code{mapping} if there is no plot 29 | mapping.} 30 | 31 | \item{data}{The data to be displayed in this layer. There are three 32 | options: 33 | 34 | If \code{NULL}, the default, the data is inherited from the plot 35 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 36 | 37 | A \code{data.frame}, or other object, will override the plot 38 | data. All objects will be fortified to produce a data frame. See 39 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 40 | 41 | A \code{function} will be called with a single argument, 42 | the plot data. The return value must be a \code{data.frame}, and 43 | will be used as the layer data. A \code{function} can be created 44 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 45 | 46 | \item{stat}{The statistical transformation to use on the data for this 47 | layer, either as a \code{ggproto} \code{Geom} subclass or as a string naming the 48 | stat stripped of the \code{stat_} prefix (e.g. \code{"count"} rather than 49 | \code{"stat_count"})} 50 | 51 | \item{position}{Position adjustment, either as a string naming the adjustment 52 | (e.g. \code{"jitter"} to use \code{position_jitter}), or the result of a call to a 53 | position adjustment function. Use the latter if you need to change the 54 | settings of the adjustment.} 55 | 56 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed with 57 | a warning. If \code{TRUE}, missing values are silently removed.} 58 | 59 | \item{show.legend}{logical. Should this layer be included in the legends? 60 | \code{NA}, the default, includes if any aesthetics are mapped. 61 | \code{FALSE} never includes, and \code{TRUE} always includes. 62 | It can also be a named logical vector to finely select the aesthetics to 63 | display.} 64 | 65 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 66 | rather than combining with them. This is most useful for helper functions 67 | that define both data and aesthetics and shouldn't inherit behaviour from 68 | the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} 69 | 70 | \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are 71 | often aesthetics, used to set an aesthetic to a fixed value, like 72 | \code{colour = "red"} or \code{size = 3}. They may also be parameters 73 | to the paired geom/stat.} 74 | } 75 | \description{ 76 | \code{geom_linepoint()} draws a \code{ggplot2::geom_line()} and adds a 77 | \code{ggplot2::geom_point()} at the observation with the maximum x value for each 78 | group. 79 | } 80 | \section{Aesthetics}{ 81 | 82 | \code{geom_linepoint()} understands the following aesthetics (required aesthetics are in bold): 83 | \itemize{ 84 | \item \strong{\code{x}} 85 | \item \strong{\code{y}} 86 | \item \code{alpha} 87 | \item \code{colour} 88 | \item \code{group} 89 | \item \code{linetype} 90 | \item \code{pointfill} 91 | \item \code{pointshape} 92 | \item \code{pointsize} 93 | \item \code{pointstroke} 94 | \item \code{pointshape} 95 | \item \code{linewidth} 96 | \item \code{weight} 97 | } 98 | The aesthetics that begin with 'point' (eg. \code{pointfill}) are passed to 99 | \code{geom_point()} - for example \code{pointfill} is passed to the \code{fill} aesthetic 100 | of \code{geom_point()}. 101 | 102 | The \code{x}, \code{y}, \code{alpha}, \code{colour}, and \code{group} aesthetics are passed to both 103 | \code{geom_line()} and \code{geom_point()}. 104 | 105 | The \code{linetype}, \code{linewidth}, and \code{weight} aesthetics are passed to \code{geom_line()}. 106 | 107 | Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. 108 | } 109 | 110 | \examples{ 111 | library(ggplot2) 112 | 113 | ggplot(ggplot2::economics_long, aes(x = date, y = value)) + 114 | geom_linepoint(aes(col = variable)) + 115 | facet_wrap(~variable) 116 | } 117 | \seealso{ 118 | \code{ggplot2::geom_line}, \code{ggplot2::geom_point} 119 | } 120 | \keyword{datasets} 121 | -------------------------------------------------------------------------------- /man/geom_richlegend.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom_richlegend.R 3 | \docType{data} 4 | \name{geom_richlegend} 5 | \alias{geom_richlegend} 6 | \alias{GeomRichLegend} 7 | \title{Create a 'rich legend' for your ggplot2 plot.} 8 | \format{ 9 | An object of class \code{GeomRichLegend} (inherits from \code{Geom}, \code{ggproto}, \code{gg}) of length 7. 10 | } 11 | \usage{ 12 | geom_richlegend( 13 | mapping = NULL, 14 | data = NULL, 15 | legend.position = "topright", 16 | na.rm = FALSE, 17 | inherit.aes = TRUE, 18 | ... 19 | ) 20 | 21 | GeomRichLegend 22 | } 23 | \arguments{ 24 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}} or 25 | \code{\link[ggplot2:aes_]{aes_()}}. If specified and \code{inherit.aes = TRUE} (the 26 | default), it is combined with the default mapping at the top level of the 27 | plot. You must supply \code{mapping} if there is no plot mapping.} 28 | 29 | \item{data}{The data to be displayed in this layer. There are three 30 | options: 31 | 32 | If \code{NULL}, the default, the data is inherited from the plot 33 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 34 | 35 | A \code{data.frame}, or other object, will override the plot 36 | data. All objects will be fortified to produce a data frame. See 37 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 38 | 39 | A \code{function} will be called with a single argument, 40 | the plot data. The return value must be a \code{data.frame}, and 41 | will be used as the layer data. A \code{function} can be created 42 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 43 | 44 | \item{legend.position}{Either: 45 | \itemize{ 46 | \item a two-element numeric vector such as \code{c(0.2, 0.9)}. The first element 47 | denoted the x-position of the data and the second element denotes the 48 | y-position. Each element must be between 0 and 1 (inclusive). 49 | \item one of the following strings: "left", "right", "bottom", "top", 50 | "topleft", "topright", "bottomleft", "bottomright". 51 | } 52 | 53 | Default is "topright", which is equivalent to \code{c(0.975, 0.975)}.} 54 | 55 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed with 56 | a warning. If \code{TRUE}, missing values are silently removed.} 57 | 58 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 59 | rather than combining with them. This is most useful for helper functions 60 | that define both data and aesthetics and shouldn't inherit behaviour from 61 | the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} 62 | 63 | \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are 64 | often aesthetics, used to set an aesthetic to a fixed value, like 65 | \code{colour = "red"} or \code{size = 3}. They may also be parameters 66 | to the paired geom/stat.} 67 | } 68 | \description{ 69 | \code{geom_richlegend()} draws coloured text in lieu of a legend. It 70 | uses the wonderful \code{{ggtext}} to create coloured text annotation(s) at a 71 | location of your choice on your plot. Use this instead of a standard legend. 72 | } 73 | \examples{ 74 | library(ggplot2) 75 | 76 | base_plot <- ggplot(mtcars, aes(x = wt, y = mpg, col = factor(cyl))) + 77 | geom_point() + 78 | theme(legend.position = "none") 79 | 80 | # By default, the rich legend is placed at the "topright" 81 | base_plot + 82 | geom_richlegend(aes(label = cyl)) 83 | 84 | # You can change the position of the rich legend: 85 | base_plot + 86 | geom_richlegend(aes(label = cyl), 87 | legend.position = "top") 88 | 89 | # Or you can change the position using a numeric vector: 90 | base_plot + 91 | geom_richlegend(aes(label = cyl), 92 | legend.position = c(0.1, 0.1)) 93 | 94 | # The legend respects facets: 95 | base_plot + 96 | geom_richlegend(aes(label = cyl)) + 97 | facet_wrap(~cyl) 98 | 99 | 100 | } 101 | \keyword{datasets} 102 | -------------------------------------------------------------------------------- /man/scale_date_align.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scale_x_date_rightalign.R 3 | \name{scale_x_date_rightalign} 4 | \alias{scale_x_date_rightalign} 5 | \alias{scale_x_date_leftalign} 6 | \alias{scale_x_date_bothalign} 7 | \title{Add a ggplot2 date scale with breaks aligned to the end of your data} 8 | \usage{ 9 | scale_x_date_rightalign( 10 | expand = expansion(mult = c(0.05, 0.1)), 11 | num_breaks = 5, 12 | date_labels = NULL, 13 | ... 14 | ) 15 | 16 | scale_x_date_leftalign( 17 | expand = expansion(mult = c(0.05, 0.05)), 18 | num_breaks = 5, 19 | date_labels = NULL, 20 | ... 21 | ) 22 | 23 | scale_x_date_bothalign( 24 | expand = expansion(mult = c(0.05, 0.05)), 25 | num_breaks = 5, 26 | date_labels = NULL, 27 | ... 28 | ) 29 | } 30 | \arguments{ 31 | \item{expand}{The amount of padding/expansion that should be added at the 32 | left and right of the data. Use the \code{ggplot2::expansion()} function to 33 | add padding. By default, 5\% padding is added to both right and left.} 34 | 35 | \item{num_breaks}{The (approximate) number of breaks to include on the 36 | axis. \code{base::pretty()} is used to generate these breaks.} 37 | 38 | \item{date_labels}{The format for the date labels on the axis. The default 39 | means "day of month, then shortened month, then linebreak, then 40 | full year". See \code{?strptime} for codes that can be used here. The default is 41 | \code{NULL}, which means a sensible default will be inferred from your data.} 42 | 43 | \item{...}{Arguments passed to \code{ggplot2::scale_x_date()}.} 44 | } 45 | \description{ 46 | When visualising time series, it's often important to be clear about 47 | the date of the latest observation. \code{scale_x_date_rightalign()} aligns 48 | your axis breaks to the most recent observation in your data. 49 | } 50 | \details{ 51 | \code{scale_x_date_leftalign()} aligns your breaks to the initial date in 52 | your data. 53 | 54 | \code{scale_x_date_bothalign()} ensures that your breaks include both the initial 55 | and final date in your data, with evenly-spaced breaks in between. 56 | } 57 | \examples{ 58 | library(ggplot2) 59 | ggplot(ggplot2::economics, aes(date, unemploy)) + 60 | geom_line() + 61 | scale_x_date_rightalign() 62 | 63 | ggplot(ggplot2::economics, aes(date, unemploy)) + 64 | geom_line() + 65 | scale_x_date_leftalign() 66 | 67 | ggplot(ggplot2::economics, aes(date, unemploy)) + 68 | geom_line() + 69 | scale_x_date_bothalign() 70 | } 71 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(ggdirectlabel) 3 | 4 | test_check("ggdirectlabel") 5 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/geom_finallabel/nudge-x-perc.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 11.5 32 | 33 | 34 | 35 | 5 36 | 10 37 | 15 38 | 20 39 | 25 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 1980 49 | 2000 50 | 2020 51 | date 52 | uempmed 53 | nudge_x_perc 54 | 55 | 56 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/geom_linepoint/numeric-axes.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 2.0 40 | 2.5 41 | 3.0 42 | 3.5 43 | 4.0 44 | 4.5 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 5 56 | 6 57 | 7 58 | 8 59 | Sepal.Length 60 | Sepal.Width 61 | 62 | Species 63 | 64 | 65 | 66 | 67 | 68 | 69 | setosa 70 | versicolor 71 | virginica 72 | Numeric axes 73 | 74 | 75 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/geom_linepoint/unordered-data.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 4000 36 | 8000 37 | 12000 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 1970 47 | 1980 48 | 1990 49 | 2000 50 | 2010 51 | date 52 | unemploy 53 | Unordered data 54 | 55 | 56 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/geom_richlegend/default-richlegend-plot.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 4 83 | 6 84 | 8 85 | 86 | 87 | 10 88 | 15 89 | 20 90 | 25 91 | 30 92 | 35 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 2 104 | 3 105 | 4 106 | 5 107 | wt 108 | mpg 109 | default richlegend plot 110 | 111 | 112 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/geom_richlegend/numeric-richlegend-position.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 4 83 | 6 84 | 8 85 | 86 | 87 | 10 88 | 15 89 | 20 90 | 25 91 | 30 92 | 35 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 2 104 | 3 105 | 4 106 | 5 107 | wt 108 | mpg 109 | numeric richlegend position 110 | 111 | 112 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/geom_richlegend/string-richlegend-position.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 4 83 | 6 84 | 8 85 | 86 | 87 | 10 88 | 15 89 | 20 90 | 25 91 | 30 92 | 35 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 2 104 | 3 105 | 4 106 | 5 107 | wt 108 | mpg 109 | string richlegend position 110 | 111 | 112 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/scale_x_date_align/both-aligned.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 4000 35 | 8000 36 | 12000 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 1967 46 | 1979 47 | 1991 48 | 2003 49 | 2015 50 | date 51 | unemploy 52 | both-aligned 53 | 54 | 55 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/scale_x_date_align/day-dates.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 8500 35 | 8600 36 | 8700 37 | 8800 38 | 8900 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 1 Jan 52 | 2015 53 | 15 Jan 54 | 2015 55 | 1 Feb 56 | 2015 57 | 15 Feb 58 | 2015 59 | 1 Mar 60 | 2015 61 | 15 Mar 62 | 2015 63 | 1 Apr 64 | 2015 65 | date 66 | unemploy 67 | day-dates 68 | 69 | 70 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/scale_x_date_align/left-aligned.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 4000 35 | 8000 36 | 12000 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 1967 46 | 1977 47 | 1987 48 | 1997 49 | 2007 50 | date 51 | unemploy 52 | left-aligned 53 | 54 | 55 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/scale_x_date_align/manual-dates-2.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 10000 35 | 12000 36 | 14000 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | Apr-2010 47 | Apr-2011 48 | Apr-2012 49 | Apr-2013 50 | Apr-2014 51 | Apr-2015 52 | date 53 | unemploy 54 | manual-dates-2 55 | 56 | 57 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/scale_x_date_align/manual-dates.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 10000 35 | 12000 36 | 14000 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 2010 47 | 2011 48 | 2012 49 | 2013 50 | 2014 51 | 2015 52 | date 53 | unemploy 54 | manual-dates 55 | 56 | 57 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/scale_x_date_align/month-dates.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 10000 35 | 12000 36 | 14000 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | Apr 47 | 2010 48 | Apr 49 | 2011 50 | Apr 51 | 2012 52 | Apr 53 | 2013 54 | Apr 55 | 2014 56 | Apr 57 | 2015 58 | date 59 | unemploy 60 | month-dates 61 | 62 | 63 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/scale_x_date_align/right-aligned-dates.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 4000 35 | 8000 36 | 12000 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 1975 46 | 1985 47 | 1995 48 | 2005 49 | 2015 50 | date 51 | unemploy 52 | Right-aligned dates 53 | 54 | 55 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/scale_x_date_align/right-aligned.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 4000 35 | 8000 36 | 12000 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 1975 46 | 1985 47 | 1995 48 | 2005 49 | 2015 50 | date 51 | unemploy 52 | right-aligned 53 | 54 | 55 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/scale_x_date_align/year-dates.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 4000 35 | 8000 36 | 12000 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 1975 46 | 1985 47 | 1995 48 | 2005 49 | 2015 50 | date 51 | unemploy 52 | year-dates 53 | 54 | 55 | -------------------------------------------------------------------------------- /tests/testthat/test-combined-functions.R: -------------------------------------------------------------------------------- 1 | test_that("core functions work together", { 2 | 3 | p <- ggplot(ggplot2::economics_long, 4 | aes(x = date, y = value, col = variable)) + 5 | geom_linepoint() + 6 | geom_finallabel(aes(label = value)) + 7 | geom_richlegend(aes(label = variable), 8 | legend.position = "topleft", 9 | hjust = 0) + 10 | scale_x_date_rightalign() + 11 | theme(legend.position = "none") 12 | 13 | expect_s3_class(p, "gg") 14 | vdiffr::expect_doppelganger("all functions together", p) 15 | }) 16 | -------------------------------------------------------------------------------- /tests/testthat/test-geom_finallabel.R: -------------------------------------------------------------------------------- 1 | test_that("geom_finallabel() works", { 2 | x <- geom_finallabel() 3 | expect_s3_class(x, "gg") 4 | 5 | vdiffr::expect_doppelganger("Final label", 6 | ggplot(ggplot2::economics, aes(date, uempmed)) + 7 | geom_line() + 8 | geom_finallabel(aes(label = uempmed))) 9 | 10 | vdiffr::expect_doppelganger("nudge_x_perc", 11 | ggplot(ggplot2::economics, aes(date, uempmed)) + 12 | geom_line() + 13 | geom_finallabel(aes(label = uempmed), 14 | nudge_x_perc = 5) + 15 | scale_x_date(expand = expansion(mult = c(0, 0.2)))) 16 | }) 17 | 18 | 19 | -------------------------------------------------------------------------------- /tests/testthat/test-geom_linepoint.R: -------------------------------------------------------------------------------- 1 | library(ggplot2) 2 | 3 | test_that("geom_linepoint() produces expected output", { 4 | 5 | plot <- ggplot(ggplot2::economics_long, aes(x = date, y = value)) + 6 | geom_linepoint(aes(col = variable)) + 7 | facet_wrap(~variable, scales = "free_y") 8 | 9 | expect_s3_class(plot, "gg") 10 | vdiffr::expect_doppelganger("Faceted plot", plot) 11 | 12 | vdiffr::expect_doppelganger("Numeric axes", 13 | ggplot(iris, 14 | aes(x = Sepal.Length, y = Sepal.Width, col = Species)) + 15 | geom_linepoint()) 16 | 17 | vdiffr::expect_doppelganger("No colour", 18 | ggplot(ggplot2::economics_long, 19 | aes(x = date, y = value)) + 20 | geom_linepoint() + 21 | facet_wrap(~variable) ) 22 | 23 | }) 24 | 25 | 26 | test_that("non-ordered data displays correctly with geom_linepoint()", { 27 | plot <- economics[order(-economics$unemploy), , drop = FALSE] |> 28 | ggplot(aes(x = date, y = unemploy)) + 29 | geom_linepoint() 30 | 31 | vdiffr::expect_doppelganger("Unordered data", plot) 32 | }) 33 | -------------------------------------------------------------------------------- /tests/testthat/test-geom_richlegend.R: -------------------------------------------------------------------------------- 1 | test_that("geom_richlegend produces expected output", { 2 | library(ggplot2) 3 | 4 | base_plot <- ggplot(mtcars, aes(x = wt, y = mpg, col = factor(cyl))) + 5 | geom_point() + 6 | theme(legend.position = "none") 7 | 8 | # Default rich legend 9 | def_rich <- base_plot + 10 | geom_richlegend(aes(label = cyl)) 11 | 12 | vdiffr::expect_doppelganger("default richlegend plot", def_rich) 13 | 14 | # Change rich legend position with string 15 | text_pos <- base_plot + 16 | geom_richlegend(aes(label = cyl), 17 | legend.position = "top") 18 | 19 | vdiffr::expect_doppelganger("string richlegend position", text_pos) 20 | 21 | # Change the position using a numeric vector: 22 | num_pos <- base_plot + 23 | geom_richlegend(aes(label = cyl), 24 | legend.position = c(0.1, 0.1)) 25 | 26 | vdiffr::expect_doppelganger("numeric richlegend position", num_pos) 27 | 28 | # faceted richlegend 29 | faceted <- base_plot + 30 | geom_richlegend(aes(label = cyl)) + 31 | facet_wrap(~cyl) 32 | 33 | vdiffr::expect_doppelganger("faceted richlegend plot", faceted) 34 | 35 | }) 36 | -------------------------------------------------------------------------------- /tests/testthat/test-scale_x_date_align.R: -------------------------------------------------------------------------------- 1 | test_that("scale_x_date_*align() works", { 2 | 3 | lapply(X = list(scale_x_date_rightalign(), 4 | scale_x_date_leftalign(), 5 | scale_x_date_bothalign()), 6 | FUN = function(x) { 7 | expect_s3_class(x, "ScaleContinuousDate") 8 | }) 9 | 10 | vdiffr::expect_doppelganger(title = "Right-aligned dates", 11 | ggplot(ggplot2::economics, 12 | aes(x = date, y = unemploy)) + 13 | geom_line() + 14 | scale_x_date_rightalign()) 15 | 16 | 17 | 18 | plots <- list( 19 | "right-aligned" = ggplot(ggplot2::economics, 20 | aes(x = date, y = unemploy)) + 21 | geom_line() + 22 | scale_x_date_rightalign(), 23 | "left-aligned" = ggplot(ggplot2::economics, 24 | aes(x = date, y = unemploy)) + 25 | geom_line() + 26 | scale_x_date_leftalign(), 27 | "both-aligned" = ggplot(ggplot2::economics, 28 | aes(x = date, y = unemploy)) + 29 | geom_line() + 30 | scale_x_date_bothalign() 31 | ) 32 | 33 | Map(function(x, i) vdiffr::expect_doppelganger(title = i, fig = x), 34 | plots, names(plots)) 35 | 36 | 37 | }) 38 | 39 | test_that("date_labels behaviour in scale_date_*align() works", { 40 | plots <- list( 41 | "year-dates" = ggplot(ggplot2::economics, 42 | aes(x = date, y = unemploy)) + 43 | geom_line() + 44 | scale_x_date_rightalign(), 45 | "month-dates" = ggplot(subset(ggplot2::economics, date >= as.Date("2010-01-01")), 46 | aes(x = date, y = unemploy)) + 47 | geom_line() + 48 | scale_x_date_rightalign(), 49 | "day-dates" = ggplot(subset(ggplot2::economics, date >= as.Date("2015-01-01")), 50 | aes(x = date, y = unemploy)) + 51 | geom_line() + 52 | scale_x_date_rightalign(), 53 | "manual-dates" = ggplot(subset(ggplot2::economics, date >= as.Date("2010-01-01")), 54 | aes(x = date, y = unemploy)) + 55 | geom_line() + 56 | scale_x_date_rightalign(date_labels = "%Y"), 57 | "manual-dates-2" = ggplot(subset(ggplot2::economics, date >= as.Date("2010-01-01")), 58 | aes(x = date, y = unemploy)) + 59 | geom_line() + 60 | scale_x_date_rightalign(date_labels = "%b-%Y") 61 | ) 62 | 63 | Map(function(x, i) vdiffr::expect_doppelganger(title = i, fig = x), 64 | plots, names(plots)) 65 | 66 | }) 67 | 68 | test_that("labels_date_auto() works as expected", { 69 | my_dates <- ggplot2::economics$date 70 | 71 | cut_dates <- function(x, n) { 72 | as.Date( 73 | labels( 74 | split(x, cut(x, n)) 75 | ) 76 | ) 77 | } 78 | 79 | expect_equal(labels_date_auto(cut_dates(my_dates, 5)), 80 | "%Y") 81 | 82 | expect_equal(labels_date_auto(cut_dates(my_dates, 100)), 83 | "%b\n%Y") 84 | 85 | expect_equal(labels_date_auto(cut_dates(my_dates, 500)), 86 | "%b\n%Y") 87 | 88 | }) 89 | 90 | test_that("breaks_right() works with numeric vectors", { 91 | expect_identical( 92 | breaks_right(c(10, 30)), 93 | seq(10, 30, 5) 94 | ) 95 | 96 | expect_length(breaks_right(c(10, 30), 97 | n = 10), 98 | 11) 99 | 100 | expect_length(breaks_right(c(10, 30), 101 | n = 1), 102 | 2) 103 | }) 104 | 105 | test_that("breaks_right() works with date vectors", { 106 | econ_dates <- c(min(ggplot2::economics$date), 107 | max(ggplot2::economics$date)) 108 | 109 | expect_identical(breaks_right(econ_dates), 110 | seq.Date(as.Date("1975-04-01"), 111 | as.Date("2015-04-01"), 112 | by = "10 years")) 113 | }) 114 | 115 | test_that("breaks_right() works when supplied to scale_x_date()", { 116 | p <- ggplot2::ggplot(ggplot2::economics, 117 | ggplot2::aes(x = date, y = unemploy)) + 118 | ggplot2::geom_line() + 119 | ggplot2::scale_x_date(breaks = breaks_right) 120 | 121 | expect_s3_class(p, "gg") 122 | 123 | }) 124 | --------------------------------------------------------------------------------