├── .github ├── .gitignore └── workflows │ ├── pkgdown.yaml │ └── R-CMD-check.yaml ├── R ├── aaa.R ├── .DS_Store ├── ggborderline-package.R ├── ggproto-classes.R ├── utils.R └── geom-borderpath.R ├── LICENSE ├── .gitignore ├── man ├── .DS_Store ├── figures │ ├── logo.png │ ├── README-example-1.png │ ├── README-example-2.png │ ├── README-example-3.png │ ├── README-unnamed-chunk-2-1.png │ └── README-unnamed-chunk-3-1.png ├── draw_key_borderpath.Rd ├── ggborderline-package.Rd ├── ggborderline-extensions.Rd ├── scale_bordercolour_continuous.Rd └── geom_borderpath.Rd ├── pkgdown └── favicon │ ├── favicon.ico │ ├── favicon-16x16.png │ ├── favicon-32x32.png │ ├── apple-touch-icon.png │ ├── apple-touch-icon-60x60.png │ ├── apple-touch-icon-76x76.png │ ├── apple-touch-icon-120x120.png │ ├── apple-touch-icon-152x152.png │ └── apple-touch-icon-180x180.png ├── .Rbuildignore ├── _pkgdown.yml ├── ggborderline.Rproj ├── NEWS.md ├── NAMESPACE ├── DESCRIPTION ├── hex-sticker.R ├── LICENSE.md ├── README.md └── README.Rmd /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /R/aaa.R: -------------------------------------------------------------------------------- 1 | #' @import ggplot2 2 | #' @import grid 3 | NULL 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2021 2 | COPYRIGHT HOLDER: ggborderline authors 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | docs 6 | -------------------------------------------------------------------------------- /R/.DS_Store: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wurli/ggborderline/HEAD/R/.DS_Store -------------------------------------------------------------------------------- /man/.DS_Store: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wurli/ggborderline/HEAD/man/.DS_Store -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wurli/ggborderline/HEAD/man/figures/logo.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wurli/ggborderline/HEAD/pkgdown/favicon/favicon.ico -------------------------------------------------------------------------------- /man/figures/README-example-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wurli/ggborderline/HEAD/man/figures/README-example-1.png -------------------------------------------------------------------------------- /man/figures/README-example-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wurli/ggborderline/HEAD/man/figures/README-example-2.png -------------------------------------------------------------------------------- /man/figures/README-example-3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wurli/ggborderline/HEAD/man/figures/README-example-3.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-16x16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wurli/ggborderline/HEAD/pkgdown/favicon/favicon-16x16.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-32x32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wurli/ggborderline/HEAD/pkgdown/favicon/favicon-32x32.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wurli/ggborderline/HEAD/pkgdown/favicon/apple-touch-icon.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-2-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wurli/ggborderline/HEAD/man/figures/README-unnamed-chunk-2-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-3-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wurli/ggborderline/HEAD/man/figures/README-unnamed-chunk-3-1.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-60x60.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wurli/ggborderline/HEAD/pkgdown/favicon/apple-touch-icon-60x60.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-76x76.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wurli/ggborderline/HEAD/pkgdown/favicon/apple-touch-icon-76x76.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-120x120.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wurli/ggborderline/HEAD/pkgdown/favicon/apple-touch-icon-120x120.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-152x152.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wurli/ggborderline/HEAD/pkgdown/favicon/apple-touch-icon-152x152.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-180x180.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wurli/ggborderline/HEAD/pkgdown/favicon/apple-touch-icon-180x180.png -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^LICENSE\.md$ 4 | ^_pkgdown\.yml$ 5 | ^docs$ 6 | ^pkgdown$ 7 | ^README\.Rmd$ 8 | ^hex-sticker\.R$ 9 | ^\.github$ 10 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://wurli.github.io/ggborderline/ 2 | 3 | template: 4 | bootstrap: 5 5 | bootswatch: flatly 6 | 7 | reference: 8 | - title: "Additional Geoms" 9 | - contents: 10 | - starts_with("geom") 11 | - title: "Additional scales" 12 | - contents: 13 | - starts_with("scale") 14 | -------------------------------------------------------------------------------- /R/ggborderline-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | 4 | ## usethis namespace: start 5 | #' @import vctrs 6 | #' @import rlang 7 | ## usethis namespace: end 8 | NULL 9 | 10 | # For old versions of ggplot2 11 | utils::globalVariables(c( 12 | "scale_linewidth_continuous", 13 | "scale_linewidth_discrete" 14 | )) 15 | -------------------------------------------------------------------------------- /R/ggproto-classes.R: -------------------------------------------------------------------------------- 1 | #' ggborderlines extensions to ggplot2 2 | #' 3 | #' ggborderlines makes use of the ggproto class system to extend the 4 | #' functionality of ggplot2. In general the actual classes should be of little 5 | #' interest to users as the standard ggplot2 api of using geom_* and stat_* 6 | #' functions for building up the plot is encouraged. 7 | #' 8 | #' @name ggborderline-extensions 9 | #' @rdname ggborderline-extensions 10 | #' 11 | NULL 12 | -------------------------------------------------------------------------------- /ggborderline.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 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 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | -------------------------------------------------------------------------------- /man/draw_key_borderpath.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-borderpath.R 3 | \name{draw_key_borderpath} 4 | \alias{draw_key_borderpath} 5 | \title{Key glyphs for legends} 6 | \usage{ 7 | draw_key_borderpath(data, params, size) 8 | } 9 | \arguments{ 10 | \item{data, params, size}{See \code{ggplot2::draw_key_path()} for usage} 11 | } 12 | \value{ 13 | A gTree object 14 | } 15 | \description{ 16 | Key glyphs for legends 17 | } 18 | \keyword{internal} 19 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # ggborderline 0.2.0 2 | 3 | * `geom_borderline()` and friends now use `linewidth` and `borderwidth` instead 4 | of `size` and `bordersize` in line with ggplot2 versions >= 3.3.7 5 | 6 | * `geom_borderline()` and friends no longer throw a warning when `alpha` is 7 | used 8 | 9 | * Documentation site updated to use bootstrap 5 10 | 11 | * Package readme updated to better demonstrate functionality 12 | 13 | * Internal refactoring to follow CRAN policies on using unexported functions 14 | from other packages 15 | 16 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(single_value,default) 4 | S3method(single_value,factor) 5 | export(GeomBorderline) 6 | export(GeomBorderpath) 7 | export(GeomBorderstep) 8 | export(draw_key_borderpath) 9 | export(geom_borderline) 10 | export(geom_borderpath) 11 | export(geom_borderstep) 12 | export(scale_bordercolour_continuous) 13 | export(scale_bordercolour_discrete) 14 | export(scale_borderwidth_continuous) 15 | export(scale_borderwidth_discrete) 16 | import(ggplot2) 17 | import(grid) 18 | import(rlang) 19 | import(vctrs) 20 | -------------------------------------------------------------------------------- /man/ggborderline-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggborderline-package.R 3 | \docType{package} 4 | \name{ggborderline-package} 5 | \alias{ggborderline} 6 | \alias{ggborderline-package} 7 | \title{ggborderline: Line Plots that Pop} 8 | \description{ 9 | \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} 10 | 11 | A set of geometries to make line plots a little bit nicer. Use along with 'ggplot2' to: - Improve the clarity of line plots with many overlapping lines - Draw more realistic worms. 12 | } 13 | \seealso{ 14 | Useful links: 15 | \itemize{ 16 | \item \url{https://github.com/wurli/ggborderline} 17 | \item \url{https://wurli.github.io/ggborderline/} 18 | } 19 | 20 | } 21 | \keyword{internal} 22 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: ggborderline 2 | URL: https://github.com/wurli/ggborderline, https://wurli.github.io/ggborderline/ 3 | Type: Package 4 | Title: Line Plots that Pop 5 | Version: 0.2.0 6 | Author: Jacob Scott 7 | Maintainer: Jacob Scott 8 | Description: A set of geometries to make line plots a little bit nicer. Use 9 | along with 'ggplot2' to: 10 | - Improve the clarity of line plots with many overlapping lines 11 | - Draw more realistic worms. 12 | License: MIT + file LICENSE 13 | Encoding: UTF-8 14 | LazyData: false 15 | Imports: 16 | cli, 17 | ggplot2, 18 | rlang, 19 | scales, 20 | utils, 21 | vctrs 22 | RoxygenNote: 7.2.1 23 | Roxygen: 24 | list(markdown = TRUE) 25 | Suggests: 26 | testthat (>= 3.0.0) 27 | Config/testthat/edition: 3 28 | -------------------------------------------------------------------------------- /hex-sticker.R: -------------------------------------------------------------------------------- 1 | devtools::load_all(".") 2 | 3 | library(ggplot2) 4 | 5 | set.seed(213) 6 | 7 | plot_data <- data.frame( 8 | x = rep(1:10, 2), 9 | y = cumsum(runif(20, -1, 1)), 10 | colour = rep(letters[1:2], each = 10) 11 | ) 12 | 13 | sticker_plot <- ggplot(plot_data, aes(x, y, colour = colour)) + 14 | geom_borderline(size = 1, border_size = .5, lineend = "round") + 15 | theme_minimal() + 16 | labs(x = NULL, y = NULL) + 17 | theme( 18 | legend.position = "none", 19 | axis.text = element_blank(), 20 | panel.grid.major = element_line(colour = "grey70", size = 0.1), 21 | panel.grid.minor = element_blank(), 22 | panel.background = element_blank(), 23 | axis.line = element_line(colour = "grey60") 24 | ) 25 | 26 | hexSticker::sticker( 27 | sticker_plot, 28 | package = "ggborderline", 29 | s_x = 1, s_y = 0.8, s_width = 1.5, s_height = 0.7, 30 | p_size = 6.5, 31 | p_color = colorspace::darken("steelblue", .7), 32 | h_fill = "grey98", 33 | h_color = colorspace::darken("steelblue", .8), 34 | url = "github.com/wurli/ggborderline", 35 | filename = "man/figures/logo.png", 36 | dpi = 120 37 | ) 38 | 39 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2021 ggborderline 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 | -------------------------------------------------------------------------------- /man/ggborderline-extensions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-borderpath.R, R/ggproto-classes.R 3 | \docType{data} 4 | \name{GeomBorderpath} 5 | \alias{GeomBorderpath} 6 | \alias{GeomBorderline} 7 | \alias{GeomBorderstep} 8 | \alias{ggborderline-extensions} 9 | \title{ggborderlines extensions to ggplot2} 10 | \format{ 11 | An object of class \code{GeomBorderpath} (inherits from \code{GeomPath}, \code{Geom}, \code{ggproto}, \code{gg}) of length 7. 12 | 13 | An object of class \code{GeomBorderline} (inherits from \code{GeomBorderpath}, \code{GeomPath}, \code{Geom}, \code{ggproto}, \code{gg}) of length 4. 14 | 15 | An object of class \code{GeomBorderstep} (inherits from \code{GeomBorderpath}, \code{GeomPath}, \code{Geom}, \code{ggproto}, \code{gg}) of length 2. 16 | } 17 | \usage{ 18 | GeomBorderpath 19 | 20 | GeomBorderline 21 | 22 | GeomBorderstep 23 | } 24 | \description{ 25 | ggborderlines makes use of the ggproto class system to extend the 26 | functionality of ggplot2. In general the actual classes should be of little 27 | interest to users as the standard ggplot2 api of using geom_* and stat_* 28 | functions for building up the plot is encouraged. 29 | } 30 | \keyword{datasets} 31 | \keyword{internal} 32 | -------------------------------------------------------------------------------- /man/scale_bordercolour_continuous.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-borderpath.R 3 | \name{scale_bordercolour_continuous} 4 | \alias{scale_bordercolour_continuous} 5 | \alias{scale_bordercolour_discrete} 6 | \alias{scale_borderwidth_continuous} 7 | \alias{scale_borderwidth_discrete} 8 | \title{Scales for borderlines} 9 | \usage{ 10 | scale_bordercolour_continuous(..., aesthetics = "bordercolour") 11 | 12 | scale_bordercolour_discrete(..., aesthetics = "bordercolour") 13 | 14 | scale_borderwidth_continuous(..., aesthetics = "borderwidth") 15 | 16 | scale_borderwidth_discrete(..., aesthetics = "borderwidth") 17 | } 18 | \arguments{ 19 | \item{...}{Passed to the corresponding ggplot2 scales} 20 | 21 | \item{aesthetics}{Character string or vector of character strings listing the 22 | name(s) of the aesthetic(s) that this scale works with. This can be useful, 23 | for example, to apply colour settings to the bordercolour and colour 24 | aesthetics at the same time, via aesthetics = c("bordercolour", "colour").} 25 | } 26 | \value{ 27 | A ggproto scale object 28 | } 29 | \description{ 30 | These scales control the linewidth and colour of the borders in borderlines. 31 | They work in much the same way as \code{ggplot2::scale_colour_continuous()}, 32 | \code{ggplot2::scale_linewidth_discrete()}, etc. 33 | } 34 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: 4 | - main 5 | - master 6 | tags: 7 | -'*' 8 | 9 | name: pkgdown 10 | 11 | jobs: 12 | pkgdown: 13 | runs-on: macOS-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | steps: 17 | - uses: actions/checkout@v2 18 | 19 | - uses: r-lib/actions/setup-r@v1 20 | 21 | - uses: r-lib/actions/setup-pandoc@v1 22 | 23 | - name: Query dependencies 24 | run: | 25 | install.packages('remotes') 26 | saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) 27 | writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") 28 | shell: Rscript {0} 29 | 30 | - name: Restore R package cache 31 | uses: actions/cache@v2 32 | with: 33 | path: ${{ env.R_LIBS_USER }} 34 | key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} 35 | restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- 36 | 37 | - name: Install dependencies 38 | run: | 39 | remotes::install_deps(dependencies = TRUE) 40 | install.packages("pkgdown", type = "binary") 41 | shell: Rscript {0} 42 | 43 | - name: Install package 44 | run: R CMD INSTALL . 45 | 46 | - name: Deploy package 47 | run: | 48 | git config --local user.email "actions@github.com" 49 | git config --local user.name "GitHub Actions" 50 | Rscript -e 'pkgdown::deploy_to_branch(new_process = FALSE)' 51 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # For help debugging build failures open an issue on the RStudio community with the 'github-actions' tag. 2 | # https://community.rstudio.com/new-topic?category=Package%20development&tags=github-actions 3 | on: 4 | push: 5 | branches: 6 | - main 7 | - master 8 | pull_request: 9 | branches: 10 | - main 11 | - master 12 | 13 | name: R-CMD-check 14 | 15 | jobs: 16 | R-CMD-check: 17 | runs-on: ${{ matrix.config.os }} 18 | 19 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 20 | 21 | strategy: 22 | fail-fast: false 23 | matrix: 24 | config: 25 | - {os: windows-latest, r: 'release'} 26 | - {os: macOS-latest, r: 'release'} 27 | - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} 28 | - {os: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest", http-user-agent: "R/4.1.0 (ubuntu-20.04) R (4.1.0 x86_64-pc-linux-gnu x86_64 linux-gnu) on GitHub Actions" } 29 | 30 | env: 31 | R_REMOTES_NO_ERRORS_FROM_WARNINGS: true 32 | RSPM: ${{ matrix.config.rspm }} 33 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 34 | 35 | steps: 36 | - uses: actions/checkout@v2 37 | 38 | - uses: r-lib/actions/setup-r@v1 39 | with: 40 | r-version: ${{ matrix.config.r }} 41 | 42 | - uses: r-lib/actions/setup-pandoc@v1 43 | 44 | - name: Query dependencies 45 | run: | 46 | install.packages('remotes') 47 | saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) 48 | writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") 49 | shell: Rscript {0} 50 | 51 | - name: Restore R package cache 52 | uses: actions/cache@v2 53 | with: 54 | path: ${{ env.R_LIBS_USER }} 55 | key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} 56 | restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- 57 | 58 | - name: Install system dependencies 59 | if: runner.os == 'Linux' 60 | run: | 61 | while read -r cmd 62 | do 63 | eval sudo $cmd 64 | done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))') 65 | 66 | - name: Install dependencies 67 | run: | 68 | remotes::install_deps(dependencies = TRUE) 69 | remotes::install_cran("rcmdcheck") 70 | shell: Rscript {0} 71 | 72 | - name: Check 73 | env: 74 | _R_CHECK_CRAN_INCOMING_REMOTE_: false 75 | run: | 76 | options(crayon.enabled = TRUE) 77 | rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check") 78 | shell: Rscript {0} 79 | 80 | - name: Upload check results 81 | if: failure() 82 | uses: actions/upload-artifact@main 83 | with: 84 | name: ${{ runner.os }}-r${{ matrix.config.r }}-results 85 | path: check 86 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | # ggborderline 3 | 4 | 5 | 6 | 7 | [![R-CMD-check](https://github.com/wurli/ggborderline/workflows/R-CMD-check/badge.svg)](https://github.com/wurli/ggborderline/actions) 8 | [![CRAN 9 | status](https://www.r-pkg.org/badges/version/ggborderline)](https://CRAN.R-project.org/package=ggborderline) 10 | 11 | 12 | {ggborderline} provides a set of geoms to make line plots a little bit 13 | nicer. Use this package along with 14 | [ggplot2](https://ggplot2.tidyverse.org/) to: 15 | 16 | - Improve the clarity of line plots with many overlapping lines 17 | - Draw more realistic worms 18 | 19 | ## Usage 20 | 21 | You can use ggborderline by swapping out {ggplot2} line geoms with their 22 | ‘`border`’ equivalents. For example, here is the effect of swapping 23 | `ggplot2::geom_line()` for `geom_borderline()`. Notice the white outline 24 | of lines in the first plot where different lines intersect: 25 | 26 | ``` r 27 | library(ggborderline) 28 | library(ggplot2) 29 | library(dplyr, warn.conflicts = FALSE) 30 | 31 | p <- txhousing |> 32 | filter( 33 | city %in% c("Houston", "Midland", "Beaumont", "Laredo"), 34 | !is.na(median) 35 | ) |> 36 | ggplot(aes(date, median, colour = city)) + 37 | scale_y_continuous(labels = scales::label_dollar()) + 38 | scale_colour_brewer(palette = "Paired") + 39 | theme(legend.position = "bottom") 40 | 41 | p + geom_borderline(linewidth = 1) + ggtitle("Using `geom_borderline()`") 42 | p + geom_line(linewidth = 1) + ggtitle("Using `geom_line()`") 43 | ``` 44 | 45 | 46 | 47 | This effect is best applied conservatively, hence the ‘default’ settings 48 | will only make a subtle (but hopefully positive) difference to existing 49 | plots. However you can still adjust the `borderwidth` and `bordercolour` 50 | aesthetics. Notice that the border is also much more noticable in the 51 | legend too: 52 | 53 | ``` r 54 | library(ggdark) 55 | 56 | p + 57 | geom_borderline( 58 | aes(bordercolour = after_scale(invert_colour(colour))), 59 | borderwidth = 1, linewidth = 2 60 | ) 61 | ``` 62 | 63 | 64 | 65 |
66 | 67 | Click here for more uses 68 | 69 | 70 | 71 | 72 | [Worm code](https://github.com/wurli/ggborderline/blob/main/README.Rmd) 73 | 74 |
75 | 76 | # Installation 77 | 78 | You can install the released version of ggborderline from CRAN with: 79 | 80 | ``` r 81 | install.packages("ggborderline") 82 | ``` 83 | 84 | The development version of ggborderline can be installed from 85 | [github](https://github.com/wurli/ggborderline) with: 86 | 87 | ``` r 88 | remotes::install_github("wurli/ggborderline") 89 | ``` 90 | 91 | # Inspiration 92 | 93 | I made this package after seeing this plot tweeted by [Rosamund 94 | Pearce](https://twitter.com/_rospearce), an experience that forever 95 | soured me to lines without borders: 96 |
97 |

98 | I designed my first double-page 99 | \#dataviz 100 | for The Economist!

It depicts our new 'Normalcy index', which 101 | tracks the world's return to pre-pandemic life \>\> 102 | https://www.economist.com/graphic-detail/2021/07/03/our-normalcy-index-shows-life-is-halfway-back-to-pre-covid-norms 103 | pic.twitter.com/1sIUMoZco1 104 |

105 | — Rosamund Pearce (@\_rospearce) 106 | July 107 | 2, 2021 108 |
109 | 110 | 111 | # Other Approaches 112 | 113 | While these effects can be achieved using {ggplot2} alone if you have 114 | the patience, there are other packages which provide other methods for 115 | achieving bordered lines. [{ggfx}](https://ggfx.data-imaginist.com/) is 116 | much more powerful, but would perhaps be overkill for something as 117 | simple as adding a border around a line. 118 | [{ggshadow}](https://github.com/marcmenem/ggshadow) is another great 119 | alternative which implements the shadow using a slightly different 120 | approach, and also comes with some other handy features. You are 121 | encouraged to try both! 122 | 123 | # Credit 124 | 125 | This package would not have been possible without the fantastic 126 | [ggplot2](https://ggplot2.tidyverse.org/) package, and would have been 127 | very difficult without the [accompanying 128 | book](https://ggplot2-book.org/). My humble and sincere thanks go to all 129 | the authors and developers who make projects like this possible. 130 | -------------------------------------------------------------------------------- /man/geom_borderpath.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-borderpath.R 3 | \name{geom_borderpath} 4 | \alias{geom_borderpath} 5 | \alias{geom_borderline} 6 | \alias{geom_borderstep} 7 | \title{Connect observations} 8 | \usage{ 9 | geom_borderpath( 10 | mapping = NULL, 11 | data = NULL, 12 | stat = "identity", 13 | position = "identity", 14 | ..., 15 | lineend = "butt", 16 | linejoin = "round", 17 | linemitre = 10, 18 | arrow = NULL, 19 | na.rm = FALSE, 20 | show.legend = NA, 21 | inherit.aes = TRUE 22 | ) 23 | 24 | geom_borderline( 25 | mapping = NULL, 26 | data = NULL, 27 | stat = "identity", 28 | position = "identity", 29 | ..., 30 | lineend = "butt", 31 | linejoin = "round", 32 | linemitre = 10, 33 | arrow = NULL, 34 | na.rm = FALSE, 35 | show.legend = NA, 36 | inherit.aes = TRUE 37 | ) 38 | 39 | geom_borderstep( 40 | mapping = NULL, 41 | data = NULL, 42 | stat = "identity", 43 | position = "identity", 44 | direction = "hv", 45 | na.rm = FALSE, 46 | show.legend = NA, 47 | inherit.aes = TRUE, 48 | ... 49 | ) 50 | } 51 | \arguments{ 52 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and 53 | \code{inherit.aes = TRUE} (the default), it is combined with the default mapping 54 | at the top level of the plot. You must supply \code{mapping} if there is no plot 55 | mapping.} 56 | 57 | \item{data}{The data to be displayed in this layer. There are three 58 | options: 59 | 60 | If \code{NULL}, the default, the data is inherited from the plot 61 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 62 | 63 | A \code{data.frame}, or other object, will override the plot 64 | data. All objects will be fortified to produce a data frame. See 65 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 66 | 67 | A \code{function} will be called with a single argument, 68 | the plot data. The return value must be a \code{data.frame}, and 69 | will be used as the layer data. A \code{function} can be created 70 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 71 | 72 | \item{stat}{The statistical transformation to use on the data for this 73 | layer, either as a \code{ggproto} \code{Geom} subclass or as a string naming the 74 | stat stripped of the \code{stat_} prefix (e.g. \code{"count"} rather than 75 | \code{"stat_count"})} 76 | 77 | \item{position}{Position adjustment, either as a string naming the adjustment 78 | (e.g. \code{"jitter"} to use \code{position_jitter}), or the result of a call to a 79 | position adjustment function. Use the latter if you need to change the 80 | settings of the adjustment.} 81 | 82 | \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are 83 | often aesthetics, used to set an aesthetic to a fixed value, like 84 | \code{colour = "red"} or \code{size = 3}. They may also be parameters 85 | to the paired geom/stat.} 86 | 87 | \item{lineend}{Line end style (round, butt, square).} 88 | 89 | \item{linejoin}{Line join style (round, mitre, bevel).} 90 | 91 | \item{linemitre}{Line mitre limit (number greater than 1).} 92 | 93 | \item{arrow}{Arrow specification, as created by \code{\link[grid:arrow]{grid::arrow()}}.} 94 | 95 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed with 96 | a warning. If \code{TRUE}, missing values are silently removed.} 97 | 98 | \item{show.legend}{logical. Should this layer be included in the legends? 99 | \code{NA}, the default, includes if any aesthetics are mapped. 100 | \code{FALSE} never includes, and \code{TRUE} always includes. 101 | It can also be a named logical vector to finely select the aesthetics to 102 | display.} 103 | 104 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 105 | rather than combining with them. This is most useful for helper functions 106 | that define both data and aesthetics and shouldn't inherit behaviour from 107 | the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} 108 | 109 | \item{direction}{direction of stairs: 'vh' for vertical then horizontal, 110 | 'hv' for horizontal then vertical, or 'mid' for step half-way between 111 | adjacent x-values.} 112 | } 113 | \value{ 114 | A ggproto layer object 115 | } 116 | \description{ 117 | This set of geoms is very similar to \code{ggplot2::geom_path()}, 118 | \code{ggplot2::geom_line()} and \code{ggplot2::geom_step()}, with the only difference 119 | being that they accept two additional aesthetics, \code{bordercolour} and 120 | \code{borderwidth}. For additional documentation, please refer to the ggplot2 121 | geoms. 122 | } 123 | \examples{ 124 | require(ggplot2) 125 | 126 | # geom_borderline() adds a border around lines 127 | ggplot(economics_long, aes(date, value01, colour = variable)) + 128 | geom_borderline() 129 | 130 | # You can control the linewidth and colour of the border with the 131 | # borderwidth and bordercolour aesthetics: 132 | ggplot(economics_long, aes(date, value01, bordercolour = variable)) + 133 | geom_borderline(borderwidth = .4, colour = "white") 134 | 135 | # The background 'border' part of the geom is always solid, however this 136 | # can be used to create some nice effects: 137 | x <- seq(0, 4 * pi, length.out = 500) 138 | test_data <- data.frame( 139 | x = rep(x, 2), y = c(sin(x), cos(x)), 140 | fun = rep(c("sin", "cos"), each = 500) 141 | ) 142 | ggplot(test_data, aes(x, y, colour = fun)) + 143 | geom_borderline(linewidth = 1, linetype = "dashed", lineend = "round") 144 | } 145 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | always_allow_html: true 4 | --- 5 | # ggborderline 6 | 7 | 8 | ```{r, include = FALSE} 9 | knitr::opts_chunk$set( 10 | collapse = TRUE, 11 | comment = "#>", 12 | fig.path = "man/figures/README-", 13 | out.width = "100%" 14 | ) 15 | ``` 16 | 17 | 18 | [![R-CMD-check](https://github.com/wurli/ggborderline/workflows/R-CMD-check/badge.svg)](https://github.com/wurli/ggborderline/actions) 19 | [![CRAN status](https://www.r-pkg.org/badges/version/ggborderline)](https://CRAN.R-project.org/package=ggborderline) 20 | 21 | 22 | {ggborderline} provides a set of geoms to make line plots a little bit nicer. Use 23 | this package along with [ggplot2](https://ggplot2.tidyverse.org/) to: 24 | 25 | * Improve the clarity of line plots with many overlapping lines 26 | * Draw more realistic worms 27 | 28 | ## Usage 29 | 30 | You can use ggborderline by swapping out {ggplot2} line geoms with their '`border`' 31 | equivalents. For example, here is the effect of swapping `ggplot2::geom_line()` 32 | for `geom_borderline()`. Notice the white outline of lines in the first plot where 33 | different lines intersect: 34 | 35 | ```{r example, fig.show='hold', out.width='50%', fig.width=5} 36 | library(ggborderline) 37 | library(ggplot2) 38 | library(dplyr, warn.conflicts = FALSE) 39 | 40 | p <- txhousing |> 41 | filter( 42 | city %in% c("Houston", "Midland", "Beaumont", "Laredo"), 43 | !is.na(median) 44 | ) |> 45 | ggplot(aes(date, median, colour = city)) + 46 | scale_y_continuous(labels = scales::label_dollar()) + 47 | scale_colour_brewer(palette = "Paired") + 48 | theme(legend.position = "bottom") 49 | 50 | p + geom_borderline(linewidth = 1) + ggtitle("Using `geom_borderline()`") 51 | p + geom_line(linewidth = 1) + ggtitle("Using `geom_line()`") 52 | ``` 53 | 54 | This effect is best applied conservatively, hence the 'default' settings 55 | will only make a subtle (but hopefully positive) difference to existing plots. 56 | However you can still adjust the `borderwidth` and `bordercolour` aesthetics. 57 | Notice that the border is also much more noticable in the legend too: 58 | ```{r} 59 | library(ggdark) 60 | 61 | p + 62 | geom_borderline( 63 | aes(bordercolour = after_scale(invert_colour(colour))), 64 | borderwidth = 1, linewidth = 2 65 | ) 66 | ``` 67 | 68 |
69 | Click here for more uses 70 | ```{r, echo = FALSE} 71 | x <- seq(-1, 0.5, length.out = 500) 72 | 73 | worms <- data.frame( 74 | x = rep(x, 2), y = c(sin(x * pi), cos(x * pi)), 75 | colour = rep(c("pink", "pink2"), each = 500) 76 | ) 77 | 78 | dirt_colours <- c("#453d30", "#453d30", "#988b77", "#856e52", "#695e48") 79 | 80 | background <- data.frame( 81 | x = runif(30000, -1.1, 0.6), y = runif(30000, -1.1, 1.1), 82 | colour = sample(dirt_colours, 10000, replace = TRUE) 83 | ) 84 | 85 | ggplot(worms, aes(x, y, colour = colour)) + 86 | geom_point(data = background, size = 2.5, alpha = 0.8) + 87 | geom_borderline(linewidth = 10, borderwidth = 1, bordercolour = "pink3", lineend = "round") + 88 | scale_colour_identity() + 89 | theme_void() + 90 | theme(panel.background = element_rect(fill = "grey10")) + 91 | annotate(geom = "text", label = ":)", x = 0.5, y = 0:1, angle = 270, size = 6) 92 | ``` 93 | 94 | [Worm code](https://github.com/wurli/ggborderline/blob/main/README.Rmd) 95 | 96 |
97 | 98 | # Installation 99 | 100 | You can install the released version of ggborderline from CRAN with: 101 | ```r 102 | install.packages("ggborderline") 103 | ``` 104 | The development version of ggborderline can be installed from [github](https://github.com/wurli/ggborderline) with: 105 | ```r 106 | remotes::install_github("wurli/ggborderline") 107 | ``` 108 | 109 | # Inspiration 110 | I made this package after seeing this plot tweeted by [Rosamund Pearce](https://twitter.com/_rospearce), 111 | an experience that forever soured me to lines without borders: 112 |

I designed my first double-page #dataviz for The Economist!

It depicts our new 'Normalcy index', which tracks the world's return to pre-pandemic life >> https://www.economist.com/graphic-detail/2021/07/03/our-normalcy-index-shows-life-is-halfway-back-to-pre-covid-norms pic.twitter.com/1sIUMoZco1

— Rosamund Pearce (@_rospearce) July 2, 2021
113 | 114 | # Other Approaches 115 | While these effects can be achieved using {ggplot2} alone if you have the 116 | patience, there are other packages which provide other methods for achieving bordered 117 | lines. [{ggfx}](https://ggfx.data-imaginist.com/) is much more powerful, but 118 | would perhaps be overkill for something as simple as adding a border around a line. 119 | [{ggshadow}](https://github.com/marcmenem/ggshadow) is another great alternative 120 | which implements the shadow using a slightly different approach, and also comes with 121 | some other handy features. You are encouraged to try both! 122 | 123 | # Credit 124 | This package would not have been possible without the fantastic [ggplot2](https://ggplot2.tidyverse.org/) 125 | package, and would have been very difficult without the [accompanying book](https://ggplot2-book.org/). 126 | My humble and sincere thanks go to all the authors and developers who make projects like this possible. 127 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | # Just add this to base R already 2 | `%||%` <- function(x, y) { 3 | if (is.null(x)) y else x 4 | } 5 | 6 | # Taken from ggplot2 7 | message_wrap <- function(...) { 8 | msg <- paste(..., collapse = "", sep = "") 9 | wrapped <- strwrap(msg, width = getOption("width") - 2) 10 | message(paste0(wrapped, collapse = "\n")) 11 | } 12 | 13 | 14 | # Taken from ggplot2 15 | dapply <- function(df, by, fun, ..., drop = TRUE) { 16 | grouping_cols <- .subset(df, by) 17 | fallback_order <- unique0(c(by, names(df))) 18 | apply_fun <- function(x) { 19 | res <- fun(x, ...) 20 | if (is.null(res)) return(res) 21 | if (length(res) == 0) return(data_frame0()) 22 | names(by) <- by 23 | vars <- lapply(by, function(col) .subset2(x, col)[1]) 24 | if (is.matrix(res)) res <- split_matrix(res) 25 | if (is.null(names(res))) names(res) <- paste0("V", seq_along(res)) 26 | if (all(by %in% names(res))) return(data_frame0(!!!unclass(res))) 27 | res <- modify_list(unclass(vars), unclass(res)) 28 | res <- res[intersect(c(fallback_order, names(res)), names(res))] 29 | data_frame0(!!!res) 30 | } 31 | 32 | # Shortcut when only one group 33 | if (all(vapply(grouping_cols, single_value, logical(1)))) { 34 | return(apply_fun(df)) 35 | } 36 | 37 | ids <- id(grouping_cols, drop = drop) 38 | group_rows <- split_with_index(seq_len(nrow(df)), ids) 39 | result <- lapply(seq_along(group_rows), function(i) { 40 | cur_data <- df_rows(df, group_rows[[i]]) 41 | apply_fun(cur_data) 42 | }) 43 | vec_rbind(!!!result) 44 | } 45 | 46 | # Taken from ggplot2 47 | id <- function(.variables, drop = FALSE) { 48 | nrows <- NULL 49 | if (is.data.frame(.variables)) { 50 | nrows <- nrow(.variables) 51 | .variables <- unclass(.variables) 52 | } 53 | lengths <- vapply(.variables, length, integer(1)) 54 | .variables <- .variables[lengths != 0] 55 | if (length(.variables) == 0) { 56 | n <- nrows %||% 0L 57 | id <- seq_len(n) 58 | attr(id, "n") <- n 59 | return(id) 60 | } 61 | if (length(.variables) == 1) { 62 | return(id_var(.variables[[1]], drop = drop)) 63 | } 64 | ids <- rev(lapply(.variables, id_var, drop = drop)) 65 | p <- length(ids) 66 | ndistinct <- vapply(ids, attr, "n", FUN.VALUE = numeric(1), USE.NAMES = FALSE) 67 | n <- prod(ndistinct) 68 | if (n > 2^31) { 69 | char_id <- inject(paste(!!!ids, sep = "\r")) 70 | res <- match(char_id, unique0(char_id)) 71 | } 72 | else { 73 | combs <- c(1, cumprod(ndistinct[-p])) 74 | mat <- inject(cbind(!!!ids)) 75 | res <- c((mat - 1L) %*% combs + 1L) 76 | } 77 | if (drop) { 78 | id_var(res, drop = TRUE) 79 | } 80 | else { 81 | res <- as.integer(res) 82 | attr(res, "n") <- n 83 | res 84 | } 85 | } 86 | 87 | # Taken from ggplot2 88 | id_var <- function(x, drop = FALSE) { 89 | if (length(x) == 0) { 90 | id <- integer() 91 | n = 0L 92 | } else if (!is.null(attr(x, "n")) && !drop) { 93 | return(x) 94 | } else if (is.factor(x) && !drop) { 95 | x <- addNA(x, ifany = TRUE) 96 | id <- as.integer(x) 97 | n <- length(levels(x)) 98 | } else { 99 | levels <- sort(unique0(x), na.last = TRUE) 100 | id <- match(x, levels) 101 | n <- max(id) 102 | } 103 | attr(id, "n") <- n 104 | id 105 | } 106 | 107 | # Taken from ggplot2 108 | df_rows <- function(x, i) { 109 | cols <- lapply(x, `[`, i = i) 110 | data_frame0(!!!cols, .size = length(i)) 111 | } 112 | 113 | # Taken from ggplot2 114 | split_with_index <- function(x, f, n = max(f)) { 115 | if (n == 1) return(list(x)) 116 | f <- as.integer(f) 117 | attributes(f) <- list(levels = as.character(seq_len(n)), class = "factor") 118 | unname(split(x, f)) 119 | } 120 | 121 | # Taken from ggplot2 122 | unique0 <- function(x, ...) if (is.null(x)) x else vec_unique(x, ...) 123 | 124 | # Taken from ggplot2 125 | data_frame0 <- function(...) data_frame(..., .name_repair = "minimal") 126 | 127 | # Taken from ggplot2 128 | split_matrix <- function(x, col_names = colnames(x)) { 129 | force(col_names) 130 | x <- lapply(seq_len(ncol(x)), function(i) x[, i]) 131 | if (!is.null(col_names)) names(x) <- col_names 132 | x 133 | } 134 | 135 | # Taken from ggplot2 136 | modify_list <- function(old, new) { 137 | for (i in names(new)) old[[i]] <- new[[i]] 138 | old 139 | } 140 | 141 | 142 | # Taken from ggplot2 143 | stairstep <- function(data, direction = "hv") { 144 | direction <- arg_match0(direction, c("hv", "vh", "mid")) 145 | data <- as.data.frame(data)[order(data$x), ] 146 | n <- nrow(data) 147 | 148 | if (n <= 1) { 149 | # Need at least one observation 150 | return(data[0, , drop = FALSE]) 151 | } 152 | 153 | if (direction == "vh") { 154 | xs <- rep(1:n, each = 2)[-2*n] 155 | ys <- c(1, rep(2:n, each = 2)) 156 | } else if (direction == "hv") { 157 | ys <- rep(1:n, each = 2)[-2*n] 158 | xs <- c(1, rep(2:n, each = 2)) 159 | } else if (direction == "mid") { 160 | xs <- rep(1:(n-1), each = 2) 161 | ys <- rep(1:n, each = 2) 162 | } else { 163 | cli::cli_abort(c( 164 | "{.arg direction} is invalid.", 165 | "i" = "Use either {.val vh}, {.val hv}, or {.va mid}" 166 | )) 167 | } 168 | 169 | if (direction == "mid") { 170 | gaps <- data$x[-1] - data$x[-n] 171 | mid_x <- data$x[-n] + gaps/2 # map the mid-point between adjacent x-values 172 | x <- c(data$x[1], mid_x[xs], data$x[n]) 173 | y <- c(data$y[ys]) 174 | data_attr <- data[c(1,xs,n), setdiff(names(data), c("x", "y"))] 175 | } else { 176 | x <- data$x[xs] 177 | y <- data$y[ys] 178 | data_attr <- data[xs, setdiff(names(data), c("x", "y"))] 179 | } 180 | 181 | data_frame0(x = x, y = y, data_attr) 182 | } 183 | 184 | # Taken from ggplot2 185 | snake_class <- function(x) { 186 | snakeize(class(x)[1]) 187 | } 188 | 189 | # Taken from ggplot2 190 | snakeize <- function(x) { 191 | x <- gsub("([A-Za-z])([A-Z])([a-z])", "\\1_\\2\\3", x) 192 | x <- gsub(".", "_", x, fixed = TRUE) 193 | x <- gsub("([a-z])([A-Z])", "\\1_\\2", x) 194 | to_lower_ascii(x) 195 | } 196 | 197 | # Taken from ggplot2 198 | lower_ascii <- "abcdefghijklmnopqrstuvwxyz" 199 | upper_ascii <- "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 200 | to_lower_ascii <- function(x) chartr(upper_ascii, lower_ascii, x) 201 | 202 | # Taken from ggplot2 203 | # Trim false values from left and right: keep all values from 204 | # first TRUE to last TRUE 205 | keep_mid_true <- function(x) { 206 | first <- match(TRUE, x) - 1 207 | if (is.na(first)) { 208 | return(rep(FALSE, length(x))) 209 | } 210 | 211 | last <- length(x) - match(TRUE, rev(x)) + 1 212 | c( 213 | rep(FALSE, first), 214 | rep(TRUE, last - first), 215 | rep(FALSE, length(x) - last) 216 | ) 217 | } 218 | 219 | # Taken from ggplot2 220 | single_value <- function(x, ...) { 221 | UseMethod("single_value") 222 | } 223 | #' @export 224 | single_value.default <- function(x, ...) { 225 | # This is set by id() used in creating the grouping var 226 | identical(attr(x, "n"), 1L) 227 | } 228 | #' @export 229 | single_value.factor <- function(x, ...) { 230 | # Panels are encoded as factor numbers and can never be missing (NA) 231 | identical(levels(x), "1") 232 | } 233 | -------------------------------------------------------------------------------- /R/geom-borderpath.R: -------------------------------------------------------------------------------- 1 | #' Key glyphs for legends 2 | #' 3 | #' @param data,params,size See `ggplot2::draw_key_path()` for usage 4 | #' 5 | #' @return A gTree object 6 | #' @keywords internal 7 | #' 8 | #' @export 9 | draw_key_borderpath <- function(data, params, size) { 10 | 11 | if (is.null(data$linetype)) { 12 | data$linetype <- 0 13 | } else { 14 | data$linetype[is.na(data$linetype)] <- 0 15 | } 16 | 17 | grobTree( 18 | # 'Border' line 19 | segmentsGrob( 20 | 0.1, 0.5, 0.9, 0.5, 21 | arrow = params$arrow, 22 | gp = gpar( 23 | col = alpha(data$bordercolour %||% data$fill %||% "white", data$alpha), 24 | fill = alpha( 25 | params$arrow.fill %||% data$colour %||% data$fill %||% "white", 26 | data$alpha 27 | ), 28 | lwd = (data$linewidth %||% data$size %||% 0.5 + (data$borderwidth %||% 0.5) * 2) * .pt, 29 | lty = data$linetype %||% 1, 30 | lineend = "butt" 31 | 32 | # Would be nice but causes issues with overlap 33 | # lineend = params$lineend %||% "butt" 34 | ) 35 | ), 36 | # Normal line 37 | segmentsGrob( 38 | 0.1, 0.5, 0.9, 0.5, 39 | arrow = params$arrow, 40 | gp = gpar( 41 | col = alpha(data$colour %||% data$fill %||% "black", data$alpha), 42 | fill = alpha( 43 | params$arrow.fill %||% data$colour %||% data$fill %||% "black", 44 | data$alpha 45 | ), 46 | lwd = (data$linewidth %||% data$size %||% 0.5) * .pt, 47 | lty = data$linetype %||% 1, 48 | lineend = "butt" 49 | # lineend = params$lineend %||% "butt" 50 | ) 51 | ) 52 | ) 53 | } 54 | 55 | #' Connect observations 56 | #' 57 | #' This set of geoms is very similar to `ggplot2::geom_path()`, 58 | #' `ggplot2::geom_line()` and `ggplot2::geom_step()`, with the only difference 59 | #' being that they accept two additional aesthetics, `bordercolour` and 60 | #' `borderwidth`. For additional documentation, please refer to the ggplot2 61 | #' geoms. 62 | #' 63 | #' @inheritParams ggplot2::layer 64 | #' @inheritParams ggplot2::geom_point 65 | #' 66 | #' @inheritParams ggplot2::layer 67 | #' @inheritParams ggplot2::geom_bar 68 | #' @param lineend Line end style (round, butt, square). 69 | #' @param linejoin Line join style (round, mitre, bevel). 70 | #' @param linemitre Line mitre limit (number greater than 1). 71 | #' @param arrow Arrow specification, as created by [grid::arrow()]. 72 | #' 73 | #' @return A ggproto layer object 74 | #' 75 | #' @export 76 | #' @examples 77 | #' require(ggplot2) 78 | #' 79 | #' # geom_borderline() adds a border around lines 80 | #' ggplot(economics_long, aes(date, value01, colour = variable)) + 81 | #' geom_borderline() 82 | #' 83 | #' # You can control the linewidth and colour of the border with the 84 | #' # borderwidth and bordercolour aesthetics: 85 | #' ggplot(economics_long, aes(date, value01, bordercolour = variable)) + 86 | #' geom_borderline(borderwidth = .4, colour = "white") 87 | #' 88 | #' # The background 'border' part of the geom is always solid, however this 89 | #' # can be used to create some nice effects: 90 | #' x <- seq(0, 4 * pi, length.out = 500) 91 | #' test_data <- data.frame( 92 | #' x = rep(x, 2), y = c(sin(x), cos(x)), 93 | #' fun = rep(c("sin", "cos"), each = 500) 94 | #' ) 95 | #' ggplot(test_data, aes(x, y, colour = fun)) + 96 | #' geom_borderline(linewidth = 1, linetype = "dashed", lineend = "round") 97 | geom_borderpath <- function(mapping = NULL, data = NULL, 98 | stat = "identity", position = "identity", 99 | ..., 100 | lineend = "butt", 101 | linejoin = "round", 102 | linemitre = 10, 103 | arrow = NULL, 104 | na.rm = FALSE, 105 | show.legend = NA, 106 | inherit.aes = TRUE) { 107 | layer( 108 | data = data, 109 | mapping = mapping, 110 | stat = stat, 111 | geom = GeomBorderpath, 112 | position = position, 113 | show.legend = show.legend, 114 | inherit.aes = inherit.aes, 115 | params = list( 116 | lineend = lineend, 117 | linejoin = linejoin, 118 | linemitre = linemitre, 119 | arrow = arrow, 120 | na.rm = na.rm, 121 | ... 122 | ) 123 | ) 124 | } 125 | 126 | #' @rdname ggborderline-extensions 127 | #' @export 128 | #' @keywords internal 129 | GeomBorderpath <- ggproto("GeomBorderpath", GeomPath, 130 | 131 | default_aes = aes( 132 | colour = "black", linewidth = 0.5, linetype = 1, alpha = NA, 133 | bordercolour = "white", borderwidth = NULL, size = NULL 134 | ), 135 | 136 | handle_na = function(self, data, params) { 137 | 138 | if (!is.null(data$size) && utils::packageVersion("ggplot2") >= "3.4.0") { 139 | inform("The use of `size` is deprecated, please use `linewidth` instead") 140 | } 141 | 142 | data$linewidth <- data$size %||% data$linewidth 143 | data$borderwidth <- data$borderwidth %||% (data$linewidth * 0.4) 144 | 145 | # Drop missing values at the start or end of a line - can't drop in the 146 | # middle since you expect those to be shown by a break in the line 147 | complete <- stats::complete.cases( 148 | data[c("x", "y", "linewidth", "borderwidth", "colour", "bordercolour", "linetype")] 149 | ) 150 | kept <- stats::ave(complete, data$group, FUN = keep_mid_true) 151 | data <- data[kept, ] 152 | 153 | if (!all(kept) && !params$na.rm) { 154 | cli::cli_warn("Removed {sum(!kept)} row{?s} containing missing values ({.fn {snake_class(self)}}).") 155 | } 156 | 157 | data 158 | }, 159 | 160 | draw_panel = function(data, panel_params, coord, arrow = NULL, 161 | lineend = "butt", linejoin = "round", linemitre = 10, 162 | na.rm = FALSE) { 163 | 164 | if (!anyDuplicated(data$group)) { 165 | message_wrap("geom_path: Each group consists of only one observation. ", 166 | "Do you need to adjust the group aesthetic?") 167 | } 168 | 169 | # must be sorted on group 170 | data <- data[order(data$group), , drop = FALSE] 171 | munched <- coord_munch(coord, data, panel_params) 172 | 173 | # Silently drop lines with less than two points, preserving order 174 | rows <- stats::ave(seq_len(nrow(munched)), munched$group, FUN = length) 175 | munched <- munched[rows >= 2, ] 176 | if (nrow(munched) < 2) return(zeroGrob()) 177 | 178 | # Work out whether we should use lines or segments 179 | attr <- dapply(munched, "group", function(df) { 180 | linetype <- unique(df$linetype) 181 | new_data_frame( 182 | list( 183 | solid = identical(linetype, 1) || identical(linetype, "solid"), 184 | constant = nrow(unique(df[, c("alpha", "colour", "linewidth", "linetype")])) == 1 185 | ), 186 | n = 1L 187 | ) 188 | }) 189 | solid_lines <- all(attr$solid) 190 | constant <- all(attr$constant) 191 | if (!solid_lines && !constant) { 192 | abort("geom_path: If you are using dotted or dashed lines, colour, linewidth and linetype must be constant over the line") 193 | } 194 | 195 | # Work out grouping variables for grobs 196 | n <- nrow(munched) 197 | group_diff <- munched$group[-1] != munched$group[-n] 198 | start <- c(TRUE, group_diff) 199 | end <- c(group_diff, TRUE) 200 | 201 | if (!constant) { 202 | gList( 203 | # 'Border' line 204 | segmentsGrob( 205 | munched$x[!end], munched$y[!end], munched$x[!start], munched$y[!start], 206 | default.units = "native", arrow = arrow, 207 | gp = gpar( 208 | col = alpha(munched$bordercolour, munched$alpha)[!end], 209 | fill = alpha(munched$bordercolour, munched$alpha)[!end], 210 | lwd = ((munched$linewidth %||% munched$size)[start] + munched$borderwidth[start] * 2) * .pt, 211 | lty = "solid", 212 | lineend = lineend, 213 | linejoin = linejoin, 214 | linemitre = linemitre 215 | ) 216 | ), 217 | # Normal line 218 | segmentsGrob( 219 | munched$x[!end], munched$y[!end], munched$x[!start], munched$y[!start], 220 | default.units = "native", arrow = arrow, 221 | gp = gpar( 222 | col = alpha(munched$bordercolour, munched$alpha)[!end], 223 | fill = alpha(munched$bordercolour, munched$alpha)[!end], 224 | lwd = (munched$linewidth %||% munched$size)[start] * .pt, 225 | lty = munched$linetype[!end], 226 | lineend = lineend, 227 | linejoin = linejoin, 228 | linemitre = linemitre 229 | ) 230 | ) 231 | ) 232 | } else { 233 | id <- match(munched$group, unique(munched$group)) 234 | 235 | out <- lapply(unique(munched$group), function(g) { 236 | 237 | m <- subset(munched, group == g) 238 | id <- match(m$group, g) 239 | 240 | list( 241 | # 'Border' line 242 | polylineGrob( 243 | m$x, m$y, id = id, 244 | default.units = "native", arrow = arrow, 245 | gp = gpar( 246 | col = alpha(m$bordercolour, m$alpha)[start], 247 | fill = alpha(m$bordercolour, m$alpha)[start], 248 | lwd = ((m$linewidth %||% m$size)[start] + m$borderwidth[start] * 2) * .pt, 249 | lty = "solid", 250 | lineend = lineend, 251 | linejoin = linejoin, 252 | linemitre = linemitre 253 | ) 254 | ), 255 | # Normal line 256 | polylineGrob( 257 | m$x, m$y, id = id, 258 | default.units = "native", arrow = arrow, 259 | gp = gpar( 260 | col = alpha(m$colour, m$alpha)[start], 261 | fill = alpha(m$colour, m$alpha)[start], 262 | lwd = (m$linewidth %||% m$size)[start] * .pt, 263 | lty = m$linetype[start], 264 | lineend = lineend, 265 | linejoin = linejoin, 266 | linemitre = linemitre 267 | ) 268 | ) 269 | ) 270 | }) 271 | 272 | out <- unlist(out, recursive = FALSE) 273 | 274 | do.call(gList, out) 275 | } 276 | }, 277 | 278 | draw_key = draw_key_borderpath, 279 | 280 | non_missing_aes = "size", 281 | rename_size = TRUE 282 | 283 | ) 284 | 285 | #' @export 286 | #' @rdname geom_borderpath 287 | geom_borderline <- function(mapping = NULL, data = NULL, 288 | stat = "identity", position = "identity", 289 | ..., 290 | lineend = "butt", 291 | linejoin = "round", 292 | linemitre = 10, 293 | arrow = NULL, 294 | na.rm = FALSE, 295 | show.legend = NA, 296 | inherit.aes = TRUE) { 297 | layer( 298 | data = data, 299 | mapping = mapping, 300 | stat = stat, 301 | geom = GeomBorderline, 302 | position = position, 303 | show.legend = show.legend, 304 | inherit.aes = inherit.aes, 305 | params = list( 306 | lineend = lineend, 307 | linejoin = linejoin, 308 | linemitre = linemitre, 309 | arrow = arrow, 310 | na.rm = na.rm, 311 | ... 312 | ) 313 | ) 314 | } 315 | 316 | #' @rdname ggborderline-extensions 317 | #' @export 318 | GeomBorderline <- ggproto("GeomBorderline", GeomBorderpath, 319 | setup_params = function(data, params) { 320 | params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) 321 | params 322 | }, 323 | 324 | extra_params = c("na.rm", "orientation"), 325 | 326 | setup_data = function(data, params) { 327 | data$flipped_aes <- params$flipped_aes 328 | data <- flip_data(data, params$flipped_aes) 329 | data <- data[order(data$PANEL, data$group, data$x), ] 330 | flip_data(data, params$flipped_aes) 331 | } 332 | ) 333 | 334 | #' @param direction direction of stairs: 'vh' for vertical then horizontal, 335 | #' 'hv' for horizontal then vertical, or 'mid' for step half-way between 336 | #' adjacent x-values. 337 | #' @export 338 | #' @rdname geom_borderpath 339 | geom_borderstep <- function(mapping = NULL, data = NULL, stat = "identity", 340 | position = "identity", direction = "hv", 341 | na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { 342 | layer( 343 | data = data, 344 | mapping = mapping, 345 | stat = stat, 346 | geom = GeomBorderstep, 347 | position = position, 348 | show.legend = show.legend, 349 | inherit.aes = inherit.aes, 350 | params = list( 351 | direction = direction, 352 | na.rm = na.rm, 353 | ... 354 | ) 355 | ) 356 | } 357 | 358 | #' @rdname ggborderline-extensions 359 | #' @export 360 | GeomBorderstep <- ggproto("GeomBorderstep", GeomBorderpath, 361 | draw_panel = function(data, panel_params, coord, direction = "hv") { 362 | data <- dapply(data, "group", stairstep, direction = direction) 363 | GeomBorderpath$draw_panel(data, panel_params, coord) 364 | } 365 | ) 366 | 367 | #' Scales for borderlines 368 | #' 369 | #' These scales control the linewidth and colour of the borders in borderlines. 370 | #' They work in much the same way as `ggplot2::scale_colour_continuous()`, 371 | #' `ggplot2::scale_linewidth_discrete()`, etc. 372 | #' 373 | #' @param ... Passed to the corresponding ggplot2 scales 374 | #' @param aesthetics Character string or vector of character strings listing the 375 | #' name(s) of the aesthetic(s) that this scale works with. This can be useful, 376 | #' for example, to apply colour settings to the bordercolour and colour 377 | #' aesthetics at the same time, via aesthetics = c("bordercolour", "colour"). 378 | #' 379 | #' @return A ggproto scale object 380 | #' 381 | #' @export 382 | scale_bordercolour_continuous <- function(..., aesthetics = "bordercolour") { 383 | out <- scale_colour_continuous(...) 384 | out$aesthetics <- aesthetics 385 | out 386 | } 387 | 388 | #' @rdname scale_bordercolour_continuous 389 | #' @export 390 | scale_bordercolour_discrete <- function(..., aesthetics = "bordercolour") { 391 | out <- scale_colour_discrete(...) 392 | out$aesthetics = aesthetics 393 | out 394 | } 395 | 396 | #' @rdname scale_bordercolour_continuous 397 | #' @export 398 | scale_borderwidth_continuous <- function(..., aesthetics = "borderwidth") { 399 | 400 | scale <- if (utils::packageVersion("ggplot2") < "3.4.0") { 401 | scale_size_continuous 402 | } else { 403 | scale_linewidth_continuous 404 | } 405 | 406 | out <- scale(...) 407 | out$aesthetics <- aesthetics 408 | out 409 | 410 | } 411 | 412 | #' @rdname scale_bordercolour_continuous 413 | #' @export 414 | scale_borderwidth_discrete <- function(..., aesthetics = "borderwidth") { 415 | 416 | scale <- if (utils::packageVersion("ggplot2") < "3.4.0") { 417 | scale_size_discrete 418 | } else { 419 | scale_linewidth_discrete 420 | } 421 | 422 | out <- scale(...) 423 | out$aesthetics <- aesthetics 424 | out 425 | 426 | } 427 | 428 | set_border_palettes <- function() { 429 | # Skip in old version 430 | if (!"element_geom" %in% getNamespaceExports("ggplot2")) { 431 | return() 432 | } 433 | new_pal <- function(inherit) { 434 | el_def(c("character", "function"), inherit = inherit) 435 | } 436 | 437 | register_theme_elements( 438 | palette.bordercolour.continuous = scales::pal_seq_gradient("#132B43", "#56B1F7"), 439 | palette.bordercolour.discrete = scales::pal_hue(), 440 | palette.borderwidth.continuous = scales::pal_rescale(c(1, 6)), 441 | palette.borderwidth.discrete = function(n) seq(2, 6, length.out = n), 442 | element_tree = list( 443 | palette.bordercolour.continuous = 444 | el_def(c("character", "function"), "palette.colour.continuous"), 445 | palette.bordercolour.discrete = 446 | el_def(c("character", "function"), "palette.colour.discrete"), 447 | palette.borderwidth.continuous = 448 | el_def(c("character", "numeric", "integer", "function"), "palette.linewidth.continuous"), 449 | palette.borderwidth.discrete = 450 | el_def(c("character", "numeric", "integer", "function"), "palette.linewidth.discrete") 451 | ) 452 | ) 453 | } 454 | 455 | .onLoad <- function(...) { 456 | set_border_palettes() 457 | } 458 | --------------------------------------------------------------------------------