├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ ├── R-CMD-check.yaml │ └── pkgdown.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── NAMESPACE ├── NEWS.md ├── R ├── fill_pattern.r ├── makeContent.r ├── re-exports.r └── scale_fill_pattern.r ├── README.Rmd ├── README.md ├── conda └── r-fillpattern │ ├── bld.bat │ ├── build.sh │ └── meta.yaml ├── cran-comments.md ├── fillpattern.Rproj ├── man ├── figures │ ├── README-unnamed-chunk-3-1.png │ ├── README-unnamed-chunk-4-1.png │ ├── README-unnamed-chunk-5-1.png │ └── README-unnamed-chunk-6-1.png ├── fill_pattern.Rd ├── reexports.Rd └── scale_fill_pattern.Rd ├── pkgdown ├── _pkgdown.yml └── extra.css └── tests ├── testthat.R └── testthat ├── test-fillPatternGrob.r ├── test-fill_pattern.r ├── test-lighten.r ├── test-makeContent.r ├── test-modify_size.r ├── test-pattern_alpha.r └── test-scale_fill_pattern.r /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^vignettes/articles$ 4 | ^LICENSE\.md$ 5 | ^README\.Rmd$ 6 | ^_pkgdown\.yml$ 7 | ^docs$ 8 | ^pkgdown$ 9 | ^cran-comments\.md$ 10 | ^\.github$ 11 | ^CRAN-SUBMISSION$ 12 | ^conda 13 | -------------------------------------------------------------------------------- /.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 | 14 | timeout-minutes: 20 15 | 16 | runs-on: ${{ matrix.config.os }} 17 | 18 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 19 | 20 | strategy: 21 | fail-fast: false 22 | matrix: 23 | config: 24 | - {os: macos-latest, r: 'release'} 25 | - {os: windows-latest, r: 'release'} 26 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 27 | - {os: ubuntu-latest, r: 'release'} 28 | - {os: ubuntu-latest, r: 'oldrel-1'} 29 | 30 | env: 31 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 32 | R_KEEP_PKG_SOURCE: yes 33 | 34 | steps: 35 | - uses: actions/checkout@v4 36 | 37 | - uses: r-lib/actions/setup-pandoc@v2 38 | 39 | - uses: r-lib/actions/setup-r@v2 40 | with: 41 | r-version: ${{ matrix.config.r }} 42 | http-user-agent: ${{ matrix.config.http-user-agent }} 43 | use-public-rspm: true 44 | 45 | - uses: r-lib/actions/setup-r-dependencies@v2 46 | with: 47 | extra-packages: any::rcmdcheck 48 | needs: check 49 | 50 | - uses: r-lib/actions/check-r-package@v2 51 | with: 52 | upload-snapshots: true 53 | build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' 54 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.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 | release: 8 | types: [published] 9 | workflow_dispatch: 10 | 11 | name: pkgdown.yaml 12 | 13 | permissions: read-all 14 | 15 | jobs: 16 | pkgdown: 17 | runs-on: ubuntu-latest 18 | # Only restrict concurrency for non-PR jobs 19 | concurrency: 20 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 21 | env: 22 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 23 | permissions: 24 | contents: write 25 | steps: 26 | - uses: actions/checkout@v4 27 | 28 | - uses: r-lib/actions/setup-pandoc@v2 29 | 30 | - uses: r-lib/actions/setup-r@v2 31 | with: 32 | use-public-rspm: true 33 | 34 | - uses: r-lib/actions/setup-r-dependencies@v2 35 | with: 36 | extra-packages: any::pkgdown, local::. 37 | needs: website 38 | 39 | - name: Build site 40 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 41 | shell: Rscript {0} 42 | 43 | - name: Deploy to GitHub pages 🚀 44 | if: github.event_name != 'pull_request' 45 | uses: JamesIves/github-pages-deploy-action@v4.5.0 46 | with: 47 | clean: false 48 | branch: gh-pages 49 | folder: docs 50 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | .RDataTmp 8 | 9 | # User-specific files 10 | .Ruserdata 11 | 12 | # Example code in package build process 13 | *-Ex.R 14 | 15 | # Output files from R CMD build 16 | /*.tar.gz 17 | 18 | # Output files from R CMD check 19 | /*.Rcheck/ 20 | 21 | # RStudio files 22 | .Rproj.user/ 23 | 24 | # produced vignettes 25 | vignettes/*.html 26 | vignettes/*.pdf 27 | 28 | # knitr and R markdown default cache directories 29 | *_cache/ 30 | /cache/ 31 | 32 | # Temporary files created by R markdown 33 | *.utf8.md 34 | *.knit.md 35 | 36 | # R Environment Variables 37 | .Renviron 38 | 39 | # translation temp files 40 | po/*~ 41 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: fillpattern 2 | Type: Package 3 | Title: Patterned Fills for 'ggplot2' and 'grid' Graphics 4 | Version: 1.0.2.9001 5 | Date: 2025-05-14 6 | Authors@R: c( 7 | person("Daniel P.", "Smith", , "dansmith01@gmail.com", role = c("aut", "cre"), 8 | comment = c(ORCID = "0000-0002-2479-2044")), 9 | person("Alkek Center for Metagenomics and Microbiome Research", role = c("cph", "fnd")) 10 | ) 11 | Maintainer: Daniel P. Smith 12 | Description: Adds distinctive yet unobtrusive geometric patterns where solid 13 | color fills are normally used. Patterned figures look just as 14 | professional when viewed by colorblind readers or when printed in black 15 | and white. The dozen included patterns can be customized in terms of scale, 16 | rotation, color, fill, line type, and line width. Compatible with the 17 | 'ggplot2' package as well as 'grid' graphics. 18 | URL: https://cmmr.github.io/fillpattern/, https://github.com/cmmr/fillpattern 19 | BugReports: https://github.com/cmmr/fillpattern/issues 20 | License: MIT + file LICENSE 21 | Encoding: UTF-8 22 | Roxygen: list(markdown = TRUE) 23 | RoxygenNote: 7.3.1 24 | Config/Needs/website: rmarkdown 25 | Config/testthat/edition: 3 26 | Config/testthat/parallel: true 27 | Depends: R (>= 4.1.0) 28 | Imports: 29 | ggplot2 (>= 3.5), 30 | grDevices, 31 | grid (>= 4.1), 32 | methods, 33 | utils 34 | Suggests: 35 | ragg, 36 | testthat (>= 3.0.0) 37 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2024 2 | COPYRIGHT HOLDER: fillpattern author 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2024 fillpattern 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 | import(grid) 2 | importFrom(ggplot2, pattern_alpha) 3 | importFrom(methods, formalArgs, is) 4 | importFrom(utils, head, tail) 5 | 6 | export(fill_pattern) 7 | export(fillPatternGrob) 8 | export(scale_fill_pattern) 9 | export(unit) 10 | 11 | S3method(makeContent, fill_pattern) 12 | S3method(pattern_alpha, GridFillPattern) 13 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # fillpattern 1.0.2.9001 (development version) 2 | 3 | 4 | 5 | # fillpattern 1.0.2 6 | 7 | * Fixed crash on very small fill areas. 8 | * New parameter `min_size` to use solid fills for small areas. 9 | 10 | 11 | # fillpattern 1.0.1 12 | 13 | * Allow installation on R 4.1 or later (for conda-forge compatibility). 14 | 15 | 16 | # fillpattern 1.0.0 17 | 18 | * Initial CRAN submission. 19 | -------------------------------------------------------------------------------- /R/fill_pattern.r: -------------------------------------------------------------------------------- 1 | 2 | #' Patterned Fills for Grobs 3 | #' 4 | #' 5 | #' @name fill_pattern 6 | #' 7 | #' @param patterns,pattern The pattern specification. Options are `"brick"`, 8 | #' `"chevron"`, `"fish"`, `"grid"`, `"herringbone"`, `"hexagon"`, 9 | #' `"octagon"`, `"rain"`, `"saw"`, `"shingle"`, `"rshingle"`, 10 | #' `"stripe"`, and `"wave"`, optionally abbreviated and/or suffixed with 11 | #' modifiers. See "Pattern Names" section below. Default: `"brick"` 12 | #' 13 | #' @param fg Foreground color, for the pattern's lines. Default: `"black"` 14 | #' 15 | #' @param bg Background color (or grob). Default: `"transparent"` 16 | #' 17 | #' @param angle How much the rotate the pattern, given in degrees clockwise. 18 | #' Default: `0` 19 | #' 20 | #' @param width The width of the pattern tile. Assumed to be millimeters 21 | #' unless set otherwise with [unit()]. Default: `5` 22 | #' 23 | #' @param height The height of the pattern tile, or `NA` to match `width`. 24 | #' Assumed to be millimeters unless set otherwise with [unit()]. 25 | #' Default: `NA` 26 | #' 27 | #' @param lwd Line width. A positive number. 28 | #' See [graphics::par()] for additional details. Default: `1` 29 | #' 30 | #' @param lty Line type. One of `"solid"`, `"dashed"`, `"dotted"`, 31 | #' `"dotdash"`, `"longdash"`, or `"twodash"`. 32 | #' See [graphics::par()] for additional details. Default: `"solid"` 33 | #' 34 | #' @param fun A function for modifying graphical parameters immediately 35 | #' before rendering. Should accept two parameters: `env`, an 36 | #' environment that the function should modify, and `row`, the row of 37 | #' transformed data that ggbuild has constructed for this grob 38 | #' (including aes mappings). The function should return a gTree or an 39 | #' error to force returning from the parent function immediately, or 40 | #' `NULL` to continue processing with the updated `env`. Default: `NULL` 41 | #' 42 | #' @param min_size Minimum size of the pattern to draw. Applies to both width 43 | #' and height. Useful for avoiding CPU and memory overhead on tiny 44 | #' graphical elements. Assumed to be millimeters unless set otherwise 45 | #' with [unit()]. Default: `2` 46 | #' 47 | #' 48 | #' @details `fillPatternGrob()` expects a single value for each parameter. 49 | #' `fill_pattern()` can accept a vector of values for each parameter 50 | #' which are subset or recycled as needed to obtain the same number as 51 | #' `length(patterns)`. 52 | #' 53 | #' 54 | #' @return `fill_pattern()` returns a list of `grid::pattern()` objects; 55 | #' `fillPatternGrob()` returns a `grid::gTree()` object. 56 | #' 57 | #' 58 | #' @section Pattern Names: 59 | #' 60 | #' **Base name:** 61 | #' * Pattern names must always begin with one of `"brick"`, `"chevron"`, 62 | #' `"fish"`, `"grid"`, `"herringbone"`, `"hexagon"`, `"octagon"`, `"rain"`, 63 | #' `"saw"`, `"shingle"`, `"rshingle"`, `"stripe"`, or `"wave"`. 64 | #' * These names support partial matching, e.g. `"her"`, `"herring"`, and 65 | #' `"herringbone"` are all valid. However, tiling designs may be added in 66 | #' the future, so it is recommended to use the full names in finished code. 67 | #' 68 | #' **Angle modifier:** 69 | #' * A number immediately following the tiling design, such as `"stripe45"`, 70 | #' `"fish180"`, or `"saw20"`. 71 | #' * Is added to the `angle` argument; `fill_pattern("brick45", angle=45)` is 72 | #' equivalent to `fill_pattern("brick90")`. 73 | #' 74 | #' **Width and height modifier:** 75 | #' * An underscore followed by a single size to be used for both width and height. 76 | #' * Or, an underscore followed by the new width and height separated by a colon. 77 | #' * Can be absolute sizes (`"grid_4"` or `"hex_5mm:0.1npc"`) or relative to 78 | #' the `width` and `height` arguments (`"saw_sm"` or `"brick_*2:/2"`). The 79 | #' shorthand values `"xs"`, `"sm"`, `"md"`, `"lg"`, and `"xl"` are equivalent 80 | #' to `"/4"`, `"/2"`, `"1"`, `"*2"`, and `"*4"`, respectively. 81 | #' 82 | #' **Line width and style:** 83 | #' * An underscore, followed by a number, followed by one of `"solid"`, 84 | #' `"dashed"`, `"dotted"`, `"dotdash"`, `"longdash"`, or `"twodash"`. For 85 | #' example, `"shingle_0.5dashed"` or `"wave_2solid"`. 86 | #' * The number component is optional, so `"oct_longdash"` is also valid, and 87 | #' will use `lwd` for the line width. 88 | #' * To specify just the line width, suffix the number with "lwd": 89 | #' `"grid_2lwd"` will use `lty` for the line style. 90 | #' 91 | #' **Combinations:** 92 | #' * Modifiers can be combined in any order. For example, `"hex_lg:xl_2dotted"` 93 | #' or `"grid45_dashed_1.4lwd_:6mm_sm:"`. 94 | #' 95 | #' 96 | #' @seealso [scale_fill_pattern()] for `ggplot2` integration. 97 | #' 98 | #' @export 99 | #' @examples 100 | #' library(grid) 101 | #' library(fillpattern) 102 | #' 103 | #' grid.newpage() 104 | #' grid.rect(gp = gpar(fill = fill_pattern("brick", bg = "gray", angle = 90))) 105 | #' 106 | #' grid.newpage() 107 | #' gp <- Map(gpar, fill = fill_pattern( 108 | #' patterns = c("grid_3lwd", "stripe_longdash", "herringbone45", "hexagon_lg"), 109 | #' fg = c("black", "white", "black", "blue"), 110 | #' bg = c("white", "black", "cyan", "beige") )) 111 | #' grid.circle( gp = gp[[1]], x = 1/4, y = 3/4, r = 1/5) 112 | #' grid.polygon(gp = gp[[2]], x = c(9,12,15)/16, y = c(15,9,15)/16) 113 | #' grid.rect( gp = gp[[3]], x = 1/4, y = 1/4, width = 2/5, height = 2/5) 114 | #' grid.rect( gp = gp[[4]], x = 3/4, y = 1/4, width = 2/5, height = 2/5) 115 | 116 | fill_pattern <- function ( 117 | patterns = "brick", fg = "black", bg = "transparent", 118 | angle = 0, width = 5, height = NA, lwd = 1, lty = "solid", fun = NULL, 119 | min_size = 2 ) { 120 | 121 | n <- length(patterns) 122 | if (n == 0) return (list()) 123 | 124 | 125 | #________________________________________________________ 126 | # Fetch the i-th value from val, subsetting/recycling. 127 | #________________________________________________________ 128 | get_i <- function (val, i) { 129 | if (length(val) <= 1) return (val) 130 | return (val[[(i - 1) %% length(val) + 1]]) 131 | } 132 | 133 | 134 | #________________________________________________________ 135 | # Convert to a list of grid::pattern() objects. 136 | #________________________________________________________ 137 | fills <- lapply(seq_along(patterns), function (i) { 138 | 139 | grid::pattern( 140 | group = FALSE, 141 | grob = fillPatternGrob( 142 | pattern = get_i(patterns, i), 143 | fg = get_i(fg, i), 144 | bg = get_i(bg, i), 145 | angle = get_i(angle, i), 146 | width = get_i(width, i), 147 | height = get_i(height, i), 148 | lwd = get_i(lwd, i), 149 | lty = get_i(lty, i), 150 | fun = get_i(fun, i), 151 | min_size = get_i(min_size, i) )) 152 | }) 153 | 154 | 155 | #________________________________________________________ 156 | # Preserve any names set by the user on `patterns`. 157 | #________________________________________________________ 158 | if (!is.null(names(patterns))) 159 | names(fills) <- names(patterns) 160 | 161 | 162 | return (fills) 163 | } 164 | 165 | 166 | 167 | #' @rdname fill_pattern 168 | #' @export 169 | fillPatternGrob <- function ( 170 | pattern = "brick", fg = "black", bg = "transparent", 171 | angle = 0, width = 5, height = NA, lwd = 1, lty = "solid", fun = NULL, 172 | min_size = 2 ) { 173 | 174 | 175 | for (i in setdiff(formalArgs(fillPatternGrob), 'fun')) 176 | if (length(val <- get(i, inherits = FALSE)) != 1) 177 | stop("`", i, "` should be one value, not ", length(val), ".") 178 | 179 | if (!is.unit(min_size)) min_size <- unit(min_size, 'mm') 180 | 181 | grid::gTree( 182 | pattern = pattern, 183 | fg = fg, 184 | bg = bg, 185 | angle = angle, 186 | width = width, 187 | height = height, 188 | lwd = lwd, 189 | lty = lty, 190 | fun = fun, 191 | min_size = min_size, 192 | cl = "fill_pattern" ) 193 | } 194 | 195 | -------------------------------------------------------------------------------- /R/makeContent.r: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | #' Render the pattern, adapting to device size. 5 | #' 6 | #' @noRd 7 | #' @keywords internal 8 | #' 9 | #' @param x A `grid::gTree()` object generated by `fillPatternGrob()`. 10 | #' Essentially a list of arguments given to `fill_pattern()`. 11 | #' 12 | #' @return `x`, but now with child grobs for drawing the pattern. 13 | #' 14 | #' @export 15 | #' @examples 16 | #' library(grid) 17 | #' library(fillpattern) 18 | #' 19 | #' gt <- fillPatternGrob() 20 | #' gt$children 21 | #' 22 | #' gt <- makeContent(gt) 23 | #' gt$children 24 | #' 25 | #' grid.newpage() 26 | #' grid.draw(gt$children[[1]]) 27 | 28 | makeContent.fill_pattern <- function (x) { 29 | 30 | gt <- x 31 | remove('x') 32 | 33 | #________________________________________________________ 34 | # Fail gracefully on, e.g., 1-dimensional grobs. 35 | #________________________________________________________ 36 | tryCatch( 37 | error = function (e) { 38 | 39 | return (grid::gTree( 40 | name = gt$name, 41 | children = grid::gList(grid::rectGrob(gp = grid::gpar(fill = gt$fg))) )) 42 | }, 43 | expr = local({ 44 | 45 | 46 | #________________________________________________________ 47 | # 'pattern', 'fg', 'bg', 'angle', 'fun', etc 48 | #________________________________________________________ 49 | for (i in formalArgs(fillpattern::fillPatternGrob)) 50 | assign(i, gt[[i]]) 51 | 52 | 53 | #________________________________________________________ 54 | # Map integers to predefined styles. 55 | #________________________________________________________ 56 | if (is.numeric(pattern) && !is.na(pattern) && !pattern %% 1) { 57 | 58 | choices <- c( 59 | "brick", "fish", "stripe45", "hexagon", "shingle45", 60 | "wave135", "grid", "octagon", "saw", "grid45", 61 | "rshingle90", "fish180", "stripe135", "wave45", 62 | "brick135", "saw45", "shingle", "fish90", "rain135", 63 | "rshingle135", "rshingle45", "saw90", "stripe", 64 | "brick45", "rshingle", "fish270", "fish135", "wave", 65 | "shingle90", "saw135", "wave90", "brick90", 66 | "fish45", "shingle135", "stripe90" ) 67 | pattern <- choices[((pattern - 1) %% length(choices)) + 1] 68 | remove("choices") 69 | 70 | } else { 71 | pattern <- tolower(trimws(pattern)) 72 | } 73 | 74 | 75 | 76 | #________________________________________________________ 77 | # Interpret SIZE for current device's width/height. 78 | #________________________________________________________ 79 | 80 | if (is.unit(width)) width <- grid::convertWidth(width, 'mm', TRUE) 81 | if (is.unit(height)) height <- grid::convertHeight(height, 'mm', TRUE) 82 | if (is.na(width)) width <- height 83 | if (is.na(height)) height <- width 84 | stopifnot(is.numeric(c(width, height))) 85 | 86 | 87 | 88 | #________________________________________________________ 89 | # Parse LINE and SIZE component(s) from the pattern. 90 | #________________________________________________________ 91 | if (grepl(pattern = '_', x = pattern, fixed = TRUE)) { 92 | 93 | parts <- strsplit(pattern, '_')[[1]] 94 | pattern <- parts[[1]] 95 | 96 | for (part in parts[-1]) { 97 | 98 | if (grepl("(lwd|solid|dashed|dotted|dotdash|longdash|twodash)$", part)) { 99 | 100 | lwd_mod <- abs(as.numeric(sub("[a-z]+", "", part))) 101 | lty_mod <- sub("[^a-z]+", "", part) 102 | if (!is.na(lwd_mod) && lwd > 0) lwd <- lwd_mod 103 | if (lty_mod != "lwd") lty <- lty_mod 104 | 105 | } else { 106 | size_mods <- strsplit(part, ':')[[1]] 107 | width <- modify_size(width, 'x', head(size_mods, 1)) 108 | height <- modify_size(height, 'y', tail(size_mods, 1)) 109 | } 110 | 111 | } 112 | 113 | remove("parts", "part") 114 | } 115 | 116 | 117 | 118 | 119 | #________________________________________________________ 120 | # The size of this grob in millimeters. 121 | #________________________________________________________ 122 | w <- grid::convertWidth( unit(1, 'npc'), 'mm', TRUE) 123 | h <- grid::convertHeight(unit(1, 'npc'), 'mm', TRUE) 124 | 125 | 126 | #________________________________________________________ 127 | # Minimum grob size thresholds to continue. 128 | #________________________________________________________ 129 | min_size <- grid::convertWidth(min_size, 'mm', TRUE) 130 | if (w < min_size || w == 0) stop('Insufficent width: ', w, ' mm') 131 | if (h < min_size || h == 0) stop('Insufficent height: ', h, ' mm') 132 | 133 | 134 | 135 | #________________________________________________________ 136 | # Pattern size limits. Also handy for legend key glyphs. 137 | #________________________________________________________ 138 | 139 | # Only change when they are both out of bounds. 140 | if (width > w/4 || width < 1.5) 141 | if (height > h/4 || height < 1.5) { 142 | 143 | adj_x_size <- min(w/4, max(1.5, width)) 144 | adj_y_size <- min(h/4, max(1.5, height)) 145 | 146 | # Make smallest change to get one back in-bounds, 147 | # then scale the other dimension by same amount. 148 | if (abs(adj_x_size - width) < abs(adj_y_size - height)) { 149 | height <- adj_x_size * (height / width) 150 | width <- adj_x_size 151 | } else { 152 | width <- adj_y_size * (width / height) 153 | height <- adj_y_size 154 | } 155 | 156 | remove("adj_x_size", "adj_y_size") 157 | } 158 | 159 | 160 | 161 | 162 | 163 | #________________________________________________________ 164 | # Parse ANGLE component from the pattern. 165 | #________________________________________________________ 166 | if (grepl(pattern = '^[a-z]+[0-9]+\\.{0,1}[0-9]*$', x = pattern)) { 167 | angle_mod <- sub("^[a-z]+", "", pattern) 168 | pattern <- sub(angle_mod, "", pattern, fixed = TRUE) 169 | angle <- angle + as.numeric(angle_mod) 170 | } 171 | stopifnot(is.numeric(angle) && !is.na(angle)) 172 | 173 | 174 | #________________________________________________________ 175 | # Validate graphical arguments. 176 | #________________________________________________________ 177 | pattern <- local({ 178 | choices <- c( 179 | "brick", "chevron", "fish", "grid", "herringbone", "hexagon", 180 | "octagon", "rain", "saw", "shingle", "rshingle", "stripe", "wave" ) 181 | tryCatch( 182 | expr = match.arg(arg = pattern, choices = choices), 183 | error = function (e) { 184 | stop("pattern '", pattern, "' doesn't match options: ", paste(collapse = ", ", choices)) 185 | })}) 186 | 187 | lty <- local({ 188 | choices <- c("solid", "dashed", "dotted", "dotdash", "longdash", "twodash") 189 | tryCatch( 190 | expr = match.arg(arg = lty, choices = choices), 191 | error = function (e) { 192 | stop("lty (line type) '", lty, "' doesn't match options: ", paste(collapse = ", ", choices)) 193 | })}) 194 | 195 | stopifnot(is.numeric(lwd) && length(lwd) == 1 && isTRUE(lwd > 0)) 196 | 197 | 198 | #________________________________________________________ 199 | # Allow the user to make custom modifications. 200 | #________________________________________________________ 201 | vp <- if (angle %% 360) grid::viewport(angle = -angle) 202 | bg <- if (!identical(bg, "transparent")) grid::rectGrob(gp = grid::gpar(fill = bg)) 203 | gp <- grid::gpar(col = fg, lwd = lwd, lty = lty) 204 | 205 | if (is.function(fun)) { 206 | result <- fun(environment(), attr(fun, 'row', TRUE)) 207 | if (is(result, 'gTree')) return (result) 208 | } 209 | 210 | 211 | #________________________________________________________ 212 | # Expand to allow rotating without gaps. 213 | #________________________________________________________ 214 | if (angle %% 180) { 215 | sq <- max(c(w, h, 2 * width, 2 * height)) 216 | x_min <- y_min <- -0.5 * sq 217 | x_max <- y_max <- 1.5 * sq 218 | remove("sq") 219 | } else { 220 | x_min <- -2 * width 221 | x_max <- 2 * width + w 222 | y_min <- -2 * height 223 | y_max <- 2 * height + h 224 | } 225 | 226 | 227 | #________________________________________________________ 228 | # Lists for the pattern-building functions to use. 229 | #________________________________________________________ 230 | XY <- list( 231 | X = list(s = width, b = c(x_min, x_max)), 232 | Y = list(s = height, b = c(y_min, y_max)) ) 233 | 234 | # devtools::check() doesn't like getting clever here. 235 | for (i in c('X', 'Y')) { 236 | XY[[i]]$p <- c( 237 | rev(seq(from = 0, to = XY[[i]]$b[[1]], by = -XY[[i]]$s)), 238 | seq(from = XY[[i]]$s, to = XY[[i]]$b[[2]], by = XY[[i]]$s) ) 239 | XY[[i]]$n <- length(XY[[i]]$p) 240 | XY[[i]]$l <- min(XY[[i]]$p) 241 | XY[[i]]$h <- max(XY[[i]]$p) 242 | XY[[i]]$i <- seq_len(XY[[i]]$n) 243 | XY[[i]]$m2 <- XY[[i]]$i %% 2 244 | XY[[i]]$e <- XY[[i]]$p[which(XY[[i]]$m2 == 0)] 245 | XY[[i]]$o <- XY[[i]]$p[which(XY[[i]]$m2 == 1)] 246 | XY[[i]]$ne <- length(XY[[i]]$e) 247 | XY[[i]]$no <- length(XY[[i]]$o) 248 | } 249 | 250 | X <- XY$X 251 | Y <- XY$Y 252 | remove('XY') 253 | 254 | 255 | mapply( 256 | from = c('n', 'ne', 'no'), 257 | to = c('m', 'me', 'mo'), 258 | FUN = function (from, to) { 259 | X[[to]] <<- Y[[from]] 260 | Y[[to]] <<- X[[from]] }) 261 | 262 | 263 | #________________________________________________________ 264 | # Add all combinations, creating a longer vector. 265 | #________________________________________________________ 266 | cross <- function (a, b) { 267 | rep(a, each = length(b)) + b 268 | # rowSums(expand.grid(...)) 269 | } 270 | 271 | 272 | #________________________________________________________ 273 | # Draw the pattern over the entire area. 274 | #________________________________________________________ 275 | res <- switch( 276 | EXPR = pattern, 277 | 278 | brick = list(grid::segmentsGrob, list( 279 | x0 = with(X, c(rep(l, m), rep(o, m), rep(e, m))), 280 | y0 = with(Y, c(p, rep(o, each = m), rep(e, each = m))), 281 | x1 = with(X, c(rep(h, m), rep(o, m), rep(e, m))), 282 | y1 = with(Y, c(p, rep(o, each = m) + s, rep(e, each = m) + s)) )), 283 | 284 | chevron = list(grid::segmentsGrob, with( 285 | data = expand.grid(x = X$p[X$i %% 4 == 1], y = Y$p), 286 | expr = list( 287 | x0 = cross(x, X$s * c(0, 2, 2, 4) ), 288 | y0 = cross(y, Y$s * c(0, 1, 1, 1) ), 289 | x1 = cross(x, X$s * c(2, 4, 2, 4) ), 290 | y1 = cross(y, Y$s * c(1, 0, 0, 0) ) ))), 291 | 292 | fish = list(grid::curveGrob, list( 293 | x1 = with(X, cross(c(0, s), c(rep(e, me), rep(e, me)))), 294 | y1 = with(Y, cross(c(0, s), c(rep(e, each = me), rep(e, each = me)))), 295 | x2 = with(X, cross(c(0, s), c(rep(e, me) + s*2, rep(e, me) + s*2))), 296 | y2 = with(Y, cross(c(0, s), c(rep(e, each = me), rep(e, each = me)))), 297 | ncp = 10, 298 | square = FALSE )), 299 | 300 | grid = list(grid::segmentsGrob, list( 301 | x0 = with(X, c(rep(l, m), p)), 302 | y0 = with(Y, c(p, rep(l, m))), 303 | x1 = with(X, c(rep(h, m), p)), 304 | y1 = with(Y, c(p, rep(h, m))) )), 305 | 306 | herringbone = list(grid::segmentsGrob, with( 307 | data = expand.grid(i = seq_len(floor(X$n / 4)), j = Y$i), 308 | expr = { 309 | i <- i * 4 - (j %% 4) 310 | list( 311 | x0 = c(X$p[i], X$p[i] + X$s), 312 | y0 = c(Y$p[j], Y$p[j]), 313 | x1 = c(X$p[i] + X$s * 3, X$p[i] + X$s), 314 | y1 = c(Y$p[j], Y$p[j] - Y$s * 3) )})), 315 | 316 | hexagon = list(grid::segmentsGrob, with( 317 | data = rbind( 318 | expand.grid(x = X$e, y = Y$e), 319 | expand.grid(x = X$o, y = Y$o) ), 320 | expr = list( 321 | x0 = cross(x, X$s * 2 * c(0, 1/2, 1)), 322 | y0 = cross(y, Y$s * 2 * c(1/3, 5/6, 1/3)), 323 | x1 = cross(x, X$s * 2 * c(0, 1, 1/2)), 324 | y1 = cross(y, Y$s * 2 * c(2/3, 2/3, 1/6)) ))), 325 | 326 | octagon = list(grid::segmentsGrob, with( 327 | data = expand.grid(x = X$e, y = Y$e), 328 | expr = list( 329 | x0 = cross(x, X$s * 2 * c(0, 0.3, 0.6, 0.3, 0.3, 0.6)), 330 | y0 = cross(y, Y$s * 2 * c(0.3, 0.6, 0.3, 0, 0.6, 0.3)), 331 | x1 = cross(x, X$s * 2 * c(0.3, 0.6, 0.3, 0, 0.3, 1)), 332 | y1 = cross(y, Y$s * 2 * c(0.6, 0.3, 0, 0.3, 1, 0.3)) ))), 333 | 334 | rain = list(grid::segmentsGrob, list( 335 | x0 = with(X, c(rep(o, m), rep(e, m))), 336 | y0 = with(Y, c(rep(o, each = m), rep(e, each = m))), 337 | x1 = with(X, c(rep(o, m), rep(e, m))), 338 | y1 = with(Y, c(rep(o, each = m), rep(e, each = m)) + s) )), 339 | 340 | rshingle = list(grid::segmentsGrob, list( 341 | x0 = with(X, c(rep(l, m), rep(o, mo), rep(e, me)) + s/5), 342 | y0 = with(Y, c(p, rep(o, each = mo), rep(e, each = me))), 343 | x1 = with(X, c(rep(h, m), rep(o, mo), rep(e, me)) - s/5), 344 | y1 = with(Y, c(p, rep(o, each = mo) + s, rep(e, each = me) + s)) )), 345 | 346 | saw = list(grid::polylineGrob, list( 347 | x = with(X, rep(p, m)), 348 | y = with(Y, rep(p, each = m) + rep(ifelse(X$m2, s/4, -s/4), n)), 349 | id.length = rep(X$n, each = Y$n) )), 350 | 351 | shingle = list(grid::segmentsGrob, list( 352 | x0 = with(X, c(rep(l, m), rep(o, mo), rep(e, me)) - s/5), 353 | y0 = with(Y, c(p, rep(o, each = mo), rep(e, each = me))), 354 | x1 = with(X, c(rep(h, m), rep(o, mo), rep(e, me)) + s/5), 355 | y1 = with(Y, c(p, rep(o, each = mo) + s, rep(e, each = me) + s)) )), 356 | 357 | stripe = list(grid::segmentsGrob, list( 358 | x0 = with(X, p), 359 | y0 = with(Y, rep(l, m)), 360 | x1 = with(X, p), 361 | y1 = with(Y, rep(h, m)) )), 362 | 363 | wave = list(grid::curveGrob, list( 364 | x1 = with(X, c(rep(p, m), rep(p, m))), 365 | y1 = with(Y, c(rep(p, each = m), rep(p, each = m))), 366 | x2 = with(X, c(rep(p, m) + s, rep(p, m) + s)), 367 | y2 = with(Y, c(rep(p, each = m), rep(p, each = m))), 368 | ncp = 10, 369 | square = FALSE )) 370 | ) 371 | 372 | 373 | #________________________________________________________ 374 | # Render the patterned grob as the foreground. 375 | #________________________________________________________ 376 | 377 | fun <- res[[1]] 378 | args <- c(res[[2]], list(gp = gp, vp = vp, default.units = "mm")) 379 | fg <- do.call(fun, args) 380 | 381 | 382 | grid::setChildren(gt, gList(bg, fg)) 383 | 384 | })) # end of tryCatch(local({})) 385 | } 386 | 387 | 388 | 389 | #' Set or adjust the size according to a string specification. 390 | #' 391 | #' @noRd 392 | #' @keywords internal 393 | #' 394 | #' @param size The size (in millimeters) to modify. 395 | #' @param axis The axis to use when converting from NPC units. `"x"` or `"y"`. 396 | #' @param str Modification string, such as `"sm"`, `"/5"`, `".1npc"`, etc. 397 | #' 398 | #' @return The converted size in millimeters. 399 | #' 400 | #' @examples 401 | #' fillpattern:::modify_size(30, 'x', "20mm") 402 | #' fillpattern:::modify_size(20, 'y', "*2") 403 | 404 | modify_size <- function (size, axis, str) { 405 | 406 | if (nchar(str) == 0) return (size) 407 | 408 | if (str %in% c('xs', 'sm', 'md', 'lg', 'xl')) { 409 | val <- c('xs' = 1/4, 'sm' = 1/2, 'md' = 1, 'lg' = 2, 'xl' = 4)[[str]] 410 | if (!is.na(val)) return (size * val) 411 | 412 | } else if (startsWith(str, "*")) { 413 | val <- as.numeric(substr(str, 2, nchar(str))) 414 | if (!is.na(val)) return (size * val) 415 | 416 | } else if (startsWith(str, "/")) { 417 | val <- as.numeric(substr(str, 2, nchar(str))) 418 | if (!is.na(val)) return (size / val) 419 | 420 | } else { 421 | 422 | val <- sub("[a-z]+$", "", str) 423 | u <- sub(val, "", str, fixed = TRUE) 424 | val <- abs(as.numeric(val)) 425 | 426 | if (nzchar(u) && !is.na(val)) { 427 | u <- tryCatch( 428 | error = function (e) stop("Invalid unit: '", u, "'\n", e), 429 | expr = match.arg(u, c( 430 | "npc", "mm", "points", "picas", "bigpts", "dida", 431 | "cicero", "scaledpts", "lines", "char", "native", "snpc" ))) 432 | val <- grid::convertUnit( 433 | x = unit(val, units = u), 434 | unitTo = "mm", 435 | axisFrom = axis, 436 | typeFrom = "dimension", 437 | valueOnly = TRUE ) 438 | } 439 | 440 | if (!is.na(val)) return (val) 441 | } 442 | 443 | stop( 444 | "Unable to parse ", axis, " size suffix '", str, "'\n", 445 | "Expected a positive number or 'xs', 'sm', 'md', 'lg', 'xl'.") 446 | } 447 | -------------------------------------------------------------------------------- /R/re-exports.r: -------------------------------------------------------------------------------- 1 | #' @export 2 | ggplot2::unit 3 | -------------------------------------------------------------------------------- /R/scale_fill_pattern.r: -------------------------------------------------------------------------------- 1 | #' Patterned Fills for ggplot. 2 | #' 3 | #' @inherit fill_pattern 4 | #' 5 | #' @param patterns A vector of pattern names that will be subset or recycled 6 | #' as needed to match the levels of the `aes()` fill variable. If 7 | #' integers are provided, they are mapped to predefined patterns. 8 | #' See "Details" and "Pattern Names" sections below. Default: `seq_len` 9 | #' 10 | #' @param fg Foreground color for the pattern's lines, or `NA` to use the 11 | #' color scale for the `aes()` color variable. Default: `NA` 12 | #' 13 | #' @param bg Background color (or grob), or `NA` to use the color scale for 14 | #' the `aes()` color variable. 15 | #' Default: `ifelse(is.na(fg), "transparent", NA)` 16 | #' 17 | #' @param fade,alpha Modify the color from the `aes()` color scale. Fade will 18 | #' make it more white, and alpha will make it more transparent. Both 19 | #' values must be between 0 and 1, inclusive, where 1 means unchanged. 20 | #' Default: `fade = ifelse(is.na(fg), 1, 0.6), alpha = 1` 21 | #' 22 | #' @param angle How much the rotate the pattern, given in degrees clockwise. 23 | #' Default: `0` 24 | #' 25 | #' @param width The width of the pattern tile. Assumed to be millimeters 26 | #' unless set otherwise with [unit()]. Default: `unit(1/10, 'npc')` 27 | #' 28 | #' 29 | #' @return A [ggplot2::discrete_scale()] object. 30 | #' 31 | #' 32 | #' @details All of the parameters can accept a vector of values or a function 33 | #' that takes `n` as an argument and returns the value(s) to use. The 34 | #' values are subset or recycled as needed to obtain the same number 35 | #' as `nlevels(fill)`, where fill is the variable defined by 36 | #' `aes(fill = )`. 37 | #' 38 | #' 39 | #' @seealso [fill_pattern()] for base `grid` graphics integration. 40 | #' 41 | #' @export 42 | #' @examples 43 | #' \donttest{ 44 | #' library(ggplot2) 45 | #' library(fillpattern) 46 | #' 47 | #' ggplot(mpg, aes(x = class, y = hwy, color = class, fill = class)) + 48 | #' geom_boxplot() + 49 | #' scale_fill_pattern() 50 | #' 51 | #' ggplot(mpg, aes(x = drv, y = hwy, color = drv, fill = drv)) + 52 | #' geom_violin() + 53 | #' scale_colour_brewer(palette = "Set1") + 54 | #' scale_fill_pattern(c("brick", "stripe45", "grid45_lg"), fg = "black") 55 | #' 56 | #' ggplot(mpg, aes(x = drv, color = drv, fill = drv)) + 57 | #' geom_bar() + 58 | #' scale_fill_pattern( 59 | #' patterns = c("hex_sm", "brick90_xl", "fish"), 60 | #' lty = c("solid", "twodash", "dotted"), 61 | #' lwd = c(2, 3, 1) ) + 62 | #' theme(legend.key.size = unit(2, 'cm')) 63 | #' } 64 | 65 | scale_fill_pattern <- function ( 66 | patterns = seq_len, 67 | fg = NA, 68 | bg = ifelse(is.na(fg), "transparent", NA), 69 | fade = ifelse(is.na(fg), 1, 0.6), 70 | alpha = 1, 71 | angle = 0, 72 | width = unit(1/10, 'npc'), 73 | height = NA, 74 | lwd = 1, 75 | lty = "solid", 76 | fun = NULL, 77 | min_size = 2 ) { 78 | 79 | 80 | #________________________________________________________ 81 | # Fetch the i-th value from val, subsetting/recycling. 82 | #________________________________________________________ 83 | get_i <- function (val, i) { 84 | if (length(val) <= 1) return (val) 85 | return (val[[(i - 1) %% length(val) + 1]]) 86 | } 87 | 88 | 89 | fill_palette <- function (n) { 90 | 91 | #________________________________________________________ 92 | # Call any functions passed to parameters 93 | #________________________________________________________ 94 | for (i in formalArgs(scale_fill_pattern)) 95 | if (is.function(v <- get(i))) 96 | if (!identical(formalArgs(v), c('env', 'row'))) 97 | assign(i, v(n)) 98 | 99 | 100 | #________________________________________________________ 101 | # Sets of fill_pattern() arguments for pattern_alpha. 102 | #________________________________________________________ 103 | fills <- lapply(seq_len(n), function (i) { 104 | structure( 105 | class = c('GridFillPattern', 'GridPattern'), 106 | .Data = list( 107 | patterns = get_i(patterns, i), 108 | fg = get_i(fg, i), 109 | bg = get_i(bg, i), 110 | fade = get_i(fade, i), 111 | alpha = get_i(alpha, i), 112 | angle = get_i(angle, i), 113 | width = get_i(width, i), 114 | height = get_i(height, i), 115 | lwd = get_i(lwd, i), 116 | lty = get_i(lty, i), 117 | fun = get_i(fun, i), 118 | min_size = get_i(min_size, i) )) 119 | }) 120 | 121 | 122 | #________________________________________________________ 123 | # Preserve any names set by the user on `patterns`. 124 | #________________________________________________________ 125 | if (!is.null(names(patterns))) 126 | names(fills) <- names(patterns) 127 | 128 | return (fills) 129 | } 130 | 131 | 132 | ggplot2::discrete_scale(aesthetics = "fill", palette = fill_palette) 133 | } 134 | 135 | 136 | 137 | 138 | #' Apply aes() color mapping to patterns. 139 | #' 140 | #' @noRd 141 | #' @keywords internal 142 | #' 143 | #' @param x A list of arguments for `fill_pattern()`. 144 | #' @param alpha The alpha mask that `ggbuild` wants applied, not used. 145 | #' 146 | #' @return A list of one [grid::pattern()] object. 147 | #' 148 | #' @export 149 | #' @examples 150 | #' library(grid) 151 | #' library(fillpattern) 152 | #' 153 | #' args <- structure( 154 | #' class = c('GridFillPattern', 'GridPattern'), 155 | #' .Data = list( 156 | #' patterns = "brick", 157 | #' fg = "black", 158 | #' bg = "white" )) 159 | #' 160 | #' fill <- ggplot2::pattern_alpha(x = args, alpha = 1) 161 | #' grid.newpage() 162 | #' grid.rect(width = 0.5, height = 0.5, gp = gpar(fill = fill)) 163 | #' 164 | 165 | pattern_alpha.GridFillPattern <- function (x, alpha) { 166 | 167 | row <- list(colour = NA) 168 | 169 | # Skip if we're somehow not in a ggplot_gtable() call stack. 170 | if (length(sys.frames()) >= 5) { 171 | 172 | # Find all the aes() mappings for all grobs. 173 | p <- parent.frame(n = 5) 174 | dat <- if (exists('coords', p)) { get('coords', p) 175 | } else if (exists('first_rows', p)) { get('first_rows', p) 176 | } else if (exists('data', p)) { get('data', p) } 177 | 178 | if (is.data.frame(dat)) { 179 | 180 | # Find our Map()/mapply() index. 181 | i <- try(match.call()$x[[3]], silent = TRUE) 182 | if (!is.integer(i)) i <- 1L 183 | 184 | # This grob's aes() mappings. 185 | if (nrow(dat) >= i) row <- as.list(dat[i,]) 186 | 187 | } 188 | } 189 | 190 | 191 | # Skip zero-width or zero-height grobs. 192 | if (all(c('xmin', 'xmax', 'ymin', 'ymax') %in% names(row))) 193 | if (row$xmin == row$xmax || row$ymin == row$ymax) 194 | return (grid::pattern(grid::rectGrob())) 195 | 196 | 197 | # Apply lightened color mapping to fg/bg if they are NA. 198 | if (is.na(x$fg)) x$fg <- lighten(row$colour, "black", x$fade, x$alpha) 199 | if (is.na(x$bg)) x$bg <- lighten(row$colour, "white", x$fade, x$alpha) 200 | 201 | 202 | # Make key glyphs visible for scale_fill_pattern(fg = "white"). 203 | if (all(c(x$fg, x$bg) %in% c("white", "#FFFFFF", "#FFFFFFFF"))) 204 | x$fg <- "black" 205 | 206 | 207 | # Enable user-provided function to access the aes mappings too. 208 | if (is.function(x$fun)) attr(x$fun, 'row') <- row 209 | 210 | 211 | # Now that we have the colors, build the grob. 212 | do.call(fill_pattern, x[intersect(names(x), formalArgs(fill_pattern))])[[1]] 213 | } 214 | 215 | 216 | 217 | #' Make a color more white and/or transparent. 218 | #' 219 | #' @noRd 220 | #' @keywords internal 221 | #' 222 | #' @param color A color in a format parse-able by `grDevices::col2rgb()`. 223 | #' @param default Color to use instead if `color` is `NA`. 224 | #' @param fade How much to fade the color towards white. Range [0,1], where 1 225 | #' is no change. 226 | #' @param alpha How much transparency to add. Range [0,1], where 1 is no 227 | #' change. 228 | #' 229 | #' @return A color. 230 | #' 231 | #' @examples 232 | #' 233 | #' fillpattern:::lighten("black", "black", 1, 1) 234 | #' fillpattern:::lighten("black", "black", 1, 0) 235 | #' fillpattern:::lighten("black", "black", 0, 0) 236 | #' 237 | 238 | lighten <- function (color, default, fade, alpha) { 239 | 240 | if (is.na(color)) color <- default 241 | 242 | for (i in c('fade', 'alpha')) { 243 | v <- get(i) 244 | if (!is.numeric(v) || length(v) != 1) stop(i, " must be one number.") 245 | if (is.na(v) || v < 0 || v > 1) stop(i, " must be within [0,1].") 246 | } 247 | 248 | if (fade < 1) { 249 | color <- grDevices::col2rgb(color) 250 | color <- color + (255 - color) * (1 - fade) 251 | color <- grDevices::rgb(t(color), maxColorValue=255) 252 | } 253 | 254 | if (alpha < 1) 255 | color <- ggplot2::alpha(color, alpha) 256 | 257 | return (color) 258 | } 259 | 260 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | ```{r, echo = FALSE} 6 | knitr::opts_chunk$set( 7 | dev = 'ragg_png', 8 | fig.width = 8, 9 | fig.height = 4, 10 | collapse = TRUE, 11 | comment = "#>", 12 | fig.path = "man/figures/README-" 13 | ) 14 | ``` 15 | 16 | # fillpattern 17 | 18 | 19 | 20 | [![cran](https://www.r-pkg.org/badges/version/fillpattern)](https://CRAN.R-project.org/package=fillpattern) 21 | [![conda](https://anaconda.org/conda-forge/r-fillpattern/badges/version.svg)](https://anaconda.org/conda-forge/r-fillpattern) 22 | [![downloads](https://cranlogs.r-pkg.org/badges/grand-total/fillpattern)](https://cranlogs.r-pkg.org/) 23 | 24 | 25 | 26 | 27 | ## Overview 28 | 29 | `fillpattern` streamlines the process of adding distinctive yet unobtrusive geometric patterns in place of solid grob/geom fills. The resultant figures look just as professional when viewed by colorblind readers or when printed in black and white. 30 | 31 | Compared to the similar [`ggpattern`](https://coolbutuseless.github.io/package/ggpattern/index.html) package, `fillpattern`: 32 | 33 | * Has no dependencies beyond base R and `ggplot2`. 34 | * Works with `ggplot2::geom_*` functions. 35 | * Focuses on simple geometric patterns. 36 | 37 | 38 | 39 | 40 | ## Installation 41 | 42 | ```{r, eval = FALSE} 43 | # Install the latest stable version from CRAN: 44 | install.packages("fillpattern") 45 | 46 | # Or the development version from GitHub: 47 | install.packages("pak") 48 | pak::pak("cmmr/fillpattern") 49 | ``` 50 | 51 | 52 | ## Usage 53 | 54 | Simply add `scale_fill_pattern()` to your ggplot. 55 | 56 | ```{r} 57 | library(ggplot2) 58 | library(fillpattern) 59 | 60 | ggplot(mpg, aes(x = class, color = drv, fill = drv)) + 61 | geom_bar() + 62 | scale_fill_pattern() 63 | ``` 64 | 65 | Works with `geom_bar()`, `geom_boxplot()`, `geom_violin()`, and other `geom_*` functions that accept a `fill` aesthetic. 66 | 67 | 68 | ### grid grobs 69 | 70 | Set `fill = fill_pattern()` in the grob's graphical parameters. 71 | 72 | ```{r, fig.height=2} 73 | library(grid) 74 | library(fillpattern) 75 | 76 | grid.newpage() 77 | grid.circle( gp = gpar(fill = fill_pattern("grid")), x = 1/4, r = 3/8) 78 | grid.rect( gp = gpar(fill = fill_pattern("fish")), width = 1/5, height = 3/4) 79 | grid.polygon(gp = gpar(fill = fill_pattern("brick")), x = c(6,7,5)/8, y = c(7,1,1)/8) 80 | ``` 81 | 82 | 83 | 84 | ## Basic Patterns 85 | 86 | Use any of these pattern names in `fill_pattern()` or `scale_fill_pattern()`. 87 | 88 | ```{r, echo = FALSE} 89 | 90 | grid.newpage() 91 | 92 | invisible(mapply( 93 | p = c( 94 | "brick", "chevron", "fish", "grid", "herringbone", "hexagon", 95 | "octagon", "saw", "shingle", "rshingle", "stripe", "wave" ), 96 | x = rep(1:4 / 4, times = 3) - 1/8, 97 | y = rep(3:1 / 3, each = 4) - 1/6, 98 | function (p, x, y) { 99 | gp <- gpar(fill = fill_pattern(p)) 100 | grid.rect(x = x, y = y - .03, width = .2, height = .2, gp = gp) 101 | grid.text(x = x, y = y + .11, label = p) 102 | })) 103 | 104 | ``` 105 | 106 | 107 | ## Modified Patterns 108 | 109 | For each basic pattern, you can specify the foreground color, background color, line width/style, tile size/rotation, and more through arguments to `fill_pattern()` and `scale_fill_pattern()`. 110 | 111 | Most modifications can be specified as part of the pattern name (shown below). 112 | 113 | ```{r, echo = FALSE} 114 | 115 | grid.newpage() 116 | 117 | invisible(mapply( 118 | p = c( 119 | "brick20", "chevron_2dashed", "fish_dotted", "grid_longdash", 120 | "herringbone45", "hexagon_sm", "octagon_:sm", "saw_16mm:8mm", 121 | "shingle_3lwd", "rshingle_dotted", "stripe35_lg", "wave45_sm" ), 122 | x = rep(1:4 / 4, times = 3) - 1/8, 123 | y = rep(3:1 / 3, each = 4) - 1/6, 124 | function (p, x, y) { 125 | gp <- gpar(fill = fill_pattern(p)) 126 | grid.rect(x = x, y = y - .03, width = .2, height = .2, gp = gp) 127 | grid.text(x = x, y = y + .11, label = p) 128 | })) 129 | 130 | ``` 131 | 132 | 133 | For additional details, see the `fill_pattern()` and `scale_fill_pattern()` reference pages. 134 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | # fillpattern 3 | 4 | 5 | 6 | [![cran](https://www.r-pkg.org/badges/version/fillpattern)](https://CRAN.R-project.org/package=fillpattern) 7 | [![conda](https://anaconda.org/conda-forge/r-fillpattern/badges/version.svg)](https://anaconda.org/conda-forge/r-fillpattern) 8 | [![downloads](https://cranlogs.r-pkg.org/badges/grand-total/fillpattern)](https://cranlogs.r-pkg.org/) 9 | 10 | 11 | 12 | ## Overview 13 | 14 | `fillpattern` streamlines the process of adding distinctive yet 15 | unobtrusive geometric patterns in place of solid grob/geom fills. The 16 | resultant figures look just as professional when viewed by colorblind 17 | readers or when printed in black and white. 18 | 19 | Compared to the similar 20 | [`ggpattern`](https://coolbutuseless.github.io/package/ggpattern/index.html) 21 | package, `fillpattern`: 22 | 23 | - Has no dependencies beyond base R and `ggplot2`. 24 | - Works with `ggplot2::geom_*` functions. 25 | - Focuses on simple geometric patterns. 26 | 27 | ## Installation 28 | 29 | ``` r 30 | # Install the latest stable version from CRAN: 31 | install.packages("fillpattern") 32 | 33 | # Or the development version from GitHub: 34 | install.packages("pak") 35 | pak::pak("cmmr/fillpattern") 36 | ``` 37 | 38 | ## Usage 39 | 40 | Simply add `scale_fill_pattern()` to your ggplot. 41 | 42 | ``` r 43 | library(ggplot2) 44 | library(fillpattern) 45 | 46 | ggplot(mpg, aes(x = class, color = drv, fill = drv)) + 47 | geom_bar() + 48 | scale_fill_pattern() 49 | ``` 50 | 51 | ![](man/figures/README-unnamed-chunk-3-1.png) 52 | 53 | Works with `geom_bar()`, `geom_boxplot()`, `geom_violin()`, and other 54 | `geom_*` functions that accept a `fill` aesthetic. 55 | 56 | ### grid grobs 57 | 58 | Set `fill = fill_pattern()` in the grob’s graphical parameters. 59 | 60 | ``` r 61 | library(grid) 62 | library(fillpattern) 63 | 64 | grid.newpage() 65 | grid.circle( gp = gpar(fill = fill_pattern("grid")), x = 1/4, r = 3/8) 66 | grid.rect( gp = gpar(fill = fill_pattern("fish")), width = 1/5, height = 3/4) 67 | grid.polygon(gp = gpar(fill = fill_pattern("brick")), x = c(6,7,5)/8, y = c(7,1,1)/8) 68 | ``` 69 | 70 | ![](man/figures/README-unnamed-chunk-4-1.png) 71 | 72 | ## Basic Patterns 73 | 74 | Use any of these pattern names in `fill_pattern()` or 75 | `scale_fill_pattern()`. 76 | 77 | ![](man/figures/README-unnamed-chunk-5-1.png) 78 | 79 | ## Modified Patterns 80 | 81 | For each basic pattern, you can specify the foreground color, background 82 | color, line width/style, tile size/rotation, and more through arguments 83 | to `fill_pattern()` and `scale_fill_pattern()`. 84 | 85 | Most modifications can be specified as part of the pattern name (shown 86 | below). 87 | 88 | ![](man/figures/README-unnamed-chunk-6-1.png) 89 | 90 | For additional details, see the `fill_pattern()` and 91 | `scale_fill_pattern()` reference pages. 92 | -------------------------------------------------------------------------------- /conda/r-fillpattern/bld.bat: -------------------------------------------------------------------------------- 1 | "%R%" CMD INSTALL --build . %R_ARGS% 2 | IF %ERRORLEVEL% NEQ 0 exit /B 1 3 | -------------------------------------------------------------------------------- /conda/r-fillpattern/build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | export DISABLE_AUTOBREW=1 3 | ${R} CMD INSTALL --build . ${R_ARGS} 4 | -------------------------------------------------------------------------------- /conda/r-fillpattern/meta.yaml: -------------------------------------------------------------------------------- 1 | {% set version = '1.0.1' %} 2 | {% set posix = 'm2-' if win else '' %} 3 | {% set native = 'm2w64-' if win else '' %} 4 | 5 | package: 6 | name: r-fillpattern 7 | version: {{ version|replace("-", "_") }} 8 | 9 | source: 10 | url: 11 | - {{ cran_mirror }}/src/contrib/fillpattern_{{ version }}.tar.gz 12 | - {{ cran_mirror }}/src/contrib/Archive/fillpattern/fillpattern_{{ version }}.tar.gz 13 | sha256: 1c5c0a4a2651dfbeb919a619c3bebd8ac3ec3186f0607d7f7a8aeeefc7cada77 14 | 15 | build: 16 | noarch: generic 17 | number: 0 18 | rpaths: 19 | - lib/R/lib/ 20 | - lib/ 21 | 22 | requirements: 23 | build: 24 | - {{ posix }}zip # [win] 25 | - cross-r-base {{ r_base }} # [build_platform != target_platform] 26 | host: 27 | - r-base 28 | - r-ggplot2 >=3.5 29 | run: 30 | - r-base 31 | - r-ggplot2 >=3.5 32 | 33 | test: 34 | commands: 35 | - $R -e "library('fillpattern')" # [not win] 36 | - "\"%R%\" -e \"library('fillpattern')\"" # [win] 37 | 38 | about: 39 | home: https://cmmr.github.io/fillpattern/ 40 | home: https://github.com/cmmr/fillpattern 41 | license: MIT 42 | summary: Adds distinctive yet unobtrusive geometric patterns where solid color fills are normally 43 | used. Patterned figures look just as professional when viewed by colorblind readers 44 | or when printed in black and white. The dozen included patterns can be customized 45 | in terms of scale, rotation, color, fill, line type, and line width. Compatible 46 | with the 'ggplot2' package as well as 'grid' graphics. 47 | license_family: MIT 48 | license_file: 49 | - '{{ environ["PREFIX"] }}/lib/R/share/licenses/MIT' 50 | - LICENSE 51 | 52 | extra: 53 | recipe-maintainers: 54 | - conda-forge/r 55 | - dansmith01 56 | 57 | # Package: fillpattern 58 | # Type: Package 59 | # Title: Patterned Fills for 'ggplot2' and 'grid' Graphics 60 | # Version: 1.0.1 61 | # Date: 2024-03-09 62 | # Authors@R: c( person("Daniel P.", "Smith", , "dansmith01@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2479-2044")), person("Alkek Center for Metagenomics and Microbiome Research", role = c("cph", "fnd")) ) 63 | # Maintainer: Daniel P. Smith 64 | # Description: Adds distinctive yet unobtrusive geometric patterns where solid color fills are normally used. Patterned figures look just as professional when viewed by colorblind readers or when printed in black and white. The dozen included patterns can be customized in terms of scale, rotation, color, fill, line type, and line width. Compatible with the 'ggplot2' package as well as 'grid' graphics. 65 | # URL: https://cmmr.github.io/fillpattern/, https://github.com/cmmr/fillpattern 66 | # BugReports: https://github.com/cmmr/fillpattern/issues 67 | # License: MIT + file LICENSE 68 | # Encoding: UTF-8 69 | # RoxygenNote: 7.3.1 70 | # Config/Needs/website: rmarkdown 71 | # Config/testthat/edition: 3 72 | # Config/testthat/parallel: true 73 | # Depends: R (>= 4.1.0) 74 | # Imports: ggplot2 (>= 3.5), grDevices, grid (>= 4.1), methods, utils 75 | # Suggests: ragg, testthat (>= 3.0.0) 76 | # NeedsCompilation: no 77 | # Packaged: 2024-03-09 17:24:15 UTC; Daniel 78 | # Author: Daniel P. Smith [aut, cre] (), Alkek Center for Metagenomics and Microbiome Research [cph, fnd] 79 | # Repository: CRAN 80 | # Date/Publication: 2024-03-09 23:30:14 UTC 81 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## R CMD check results 2 | 3 | 0 errors | 0 warnings | 0 notes 4 | -------------------------------------------------------------------------------- /fillpattern.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | ProjectId: 109a8e71-28c5-4ba8-b1b3-292fbb09e444 3 | 4 | RestoreWorkspace: Default 5 | SaveWorkspace: Default 6 | AlwaysSaveHistory: Default 7 | 8 | EnableCodeIndexing: Yes 9 | UseSpacesForTab: Yes 10 | NumSpacesForTab: 2 11 | Encoding: UTF-8 12 | 13 | RnwWeave: Sweave 14 | LaTeX: pdfLaTeX 15 | 16 | AutoAppendNewline: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-3-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cmmr/fillpattern/fa7eedf2d2ea92400649612dd0dcc2ea9d7b8c69/man/figures/README-unnamed-chunk-3-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-4-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cmmr/fillpattern/fa7eedf2d2ea92400649612dd0dcc2ea9d7b8c69/man/figures/README-unnamed-chunk-4-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-5-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cmmr/fillpattern/fa7eedf2d2ea92400649612dd0dcc2ea9d7b8c69/man/figures/README-unnamed-chunk-5-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-6-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cmmr/fillpattern/fa7eedf2d2ea92400649612dd0dcc2ea9d7b8c69/man/figures/README-unnamed-chunk-6-1.png -------------------------------------------------------------------------------- /man/fill_pattern.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fill_pattern.r 3 | \name{fill_pattern} 4 | \alias{fill_pattern} 5 | \alias{fillPatternGrob} 6 | \title{Patterned Fills for Grobs} 7 | \usage{ 8 | fill_pattern( 9 | patterns = "brick", 10 | fg = "black", 11 | bg = "transparent", 12 | angle = 0, 13 | width = 5, 14 | height = NA, 15 | lwd = 1, 16 | lty = "solid", 17 | fun = NULL, 18 | min_size = 2 19 | ) 20 | 21 | fillPatternGrob( 22 | pattern = "brick", 23 | fg = "black", 24 | bg = "transparent", 25 | angle = 0, 26 | width = 5, 27 | height = NA, 28 | lwd = 1, 29 | lty = "solid", 30 | fun = NULL, 31 | min_size = 2 32 | ) 33 | } 34 | \arguments{ 35 | \item{patterns, pattern}{The pattern specification. Options are \code{"brick"}, 36 | \code{"chevron"}, \code{"fish"}, \code{"grid"}, \code{"herringbone"}, \code{"hexagon"}, 37 | \code{"octagon"}, \code{"rain"}, \code{"saw"}, \code{"shingle"}, \code{"rshingle"}, 38 | \code{"stripe"}, and \code{"wave"}, optionally abbreviated and/or suffixed with 39 | modifiers. See "Pattern Names" section below. Default: \code{"brick"}} 40 | 41 | \item{fg}{Foreground color, for the pattern's lines. Default: \code{"black"}} 42 | 43 | \item{bg}{Background color (or grob). Default: \code{"transparent"}} 44 | 45 | \item{angle}{How much the rotate the pattern, given in degrees clockwise. 46 | Default: \code{0}} 47 | 48 | \item{width}{The width of the pattern tile. Assumed to be millimeters 49 | unless set otherwise with \code{\link[=unit]{unit()}}. Default: \code{5}} 50 | 51 | \item{height}{The height of the pattern tile, or \code{NA} to match \code{width}. 52 | Assumed to be millimeters unless set otherwise with \code{\link[=unit]{unit()}}. 53 | Default: \code{NA}} 54 | 55 | \item{lwd}{Line width. A positive number. 56 | See \code{\link[graphics:par]{graphics::par()}} for additional details. Default: \code{1}} 57 | 58 | \item{lty}{Line type. One of \code{"solid"}, \code{"dashed"}, \code{"dotted"}, 59 | \code{"dotdash"}, \code{"longdash"}, or \code{"twodash"}. 60 | See \code{\link[graphics:par]{graphics::par()}} for additional details. Default: \code{"solid"}} 61 | 62 | \item{fun}{A function for modifying graphical parameters immediately 63 | before rendering. Should accept two parameters: \code{env}, an 64 | environment that the function should modify, and \code{row}, the row of 65 | transformed data that ggbuild has constructed for this grob 66 | (including aes mappings). The function should return a gTree or an 67 | error to force returning from the parent function immediately, or 68 | \code{NULL} to continue processing with the updated \code{env}. Default: \code{NULL}} 69 | 70 | \item{min_size}{Minimum size of the pattern to draw. Applies to both width 71 | and height. Useful for avoiding CPU and memory overhead on tiny 72 | graphical elements. Assumed to be millimeters unless set otherwise 73 | with \code{\link[=unit]{unit()}}. Default: \code{2}} 74 | } 75 | \value{ 76 | \code{fill_pattern()} returns a list of \code{grid::pattern()} objects; 77 | \code{fillPatternGrob()} returns a \code{grid::gTree()} object. 78 | } 79 | \description{ 80 | Patterned Fills for Grobs 81 | } 82 | \details{ 83 | \code{fillPatternGrob()} expects a single value for each parameter. 84 | \code{fill_pattern()} can accept a vector of values for each parameter 85 | which are subset or recycled as needed to obtain the same number as 86 | \code{length(patterns)}. 87 | } 88 | \section{Pattern Names}{ 89 | 90 | 91 | \strong{Base name:} 92 | \itemize{ 93 | \item Pattern names must always begin with one of \code{"brick"}, \code{"chevron"}, 94 | \code{"fish"}, \code{"grid"}, \code{"herringbone"}, \code{"hexagon"}, \code{"octagon"}, \code{"rain"}, 95 | \code{"saw"}, \code{"shingle"}, \code{"rshingle"}, \code{"stripe"}, or \code{"wave"}. 96 | \item These names support partial matching, e.g. \code{"her"}, \code{"herring"}, and 97 | \code{"herringbone"} are all valid. However, tiling designs may be added in 98 | the future, so it is recommended to use the full names in finished code. 99 | } 100 | 101 | \strong{Angle modifier:} 102 | \itemize{ 103 | \item A number immediately following the tiling design, such as \code{"stripe45"}, 104 | \code{"fish180"}, or \code{"saw20"}. 105 | \item Is added to the \code{angle} argument; \code{fill_pattern("brick45", angle=45)} is 106 | equivalent to \code{fill_pattern("brick90")}. 107 | } 108 | 109 | \strong{Width and height modifier:} 110 | \itemize{ 111 | \item An underscore followed by a single size to be used for both width and height. 112 | \item Or, an underscore followed by the new width and height separated by a colon. 113 | \item Can be absolute sizes (\code{"grid_4"} or \code{"hex_5mm:0.1npc"}) or relative to 114 | the \code{width} and \code{height} arguments (\code{"saw_sm"} or \code{"brick_*2:/2"}). The 115 | shorthand values \code{"xs"}, \code{"sm"}, \code{"md"}, \code{"lg"}, and \code{"xl"} are equivalent 116 | to \code{"/4"}, \code{"/2"}, \code{"1"}, \code{"*2"}, and \code{"*4"}, respectively. 117 | } 118 | 119 | \strong{Line width and style:} 120 | \itemize{ 121 | \item An underscore, followed by a number, followed by one of \code{"solid"}, 122 | \code{"dashed"}, \code{"dotted"}, \code{"dotdash"}, \code{"longdash"}, or \code{"twodash"}. For 123 | example, \code{"shingle_0.5dashed"} or \code{"wave_2solid"}. 124 | \item The number component is optional, so \code{"oct_longdash"} is also valid, and 125 | will use \code{lwd} for the line width. 126 | \item To specify just the line width, suffix the number with "lwd": 127 | \code{"grid_2lwd"} will use \code{lty} for the line style. 128 | } 129 | 130 | \strong{Combinations:} 131 | \itemize{ 132 | \item Modifiers can be combined in any order. For example, \code{"hex_lg:xl_2dotted"} 133 | or \code{"grid45_dashed_1.4lwd_:6mm_sm:"}. 134 | } 135 | } 136 | 137 | \examples{ 138 | library(grid) 139 | library(fillpattern) 140 | 141 | grid.newpage() 142 | grid.rect(gp = gpar(fill = fill_pattern("brick", bg = "gray", angle = 90))) 143 | 144 | grid.newpage() 145 | gp <- Map(gpar, fill = fill_pattern( 146 | patterns = c("grid_3lwd", "stripe_longdash", "herringbone45", "hexagon_lg"), 147 | fg = c("black", "white", "black", "blue"), 148 | bg = c("white", "black", "cyan", "beige") )) 149 | grid.circle( gp = gp[[1]], x = 1/4, y = 3/4, r = 1/5) 150 | grid.polygon(gp = gp[[2]], x = c(9,12,15)/16, y = c(15,9,15)/16) 151 | grid.rect( gp = gp[[3]], x = 1/4, y = 1/4, width = 2/5, height = 2/5) 152 | grid.rect( gp = gp[[4]], x = 3/4, y = 1/4, width = 2/5, height = 2/5) 153 | } 154 | \seealso{ 155 | \code{\link[=scale_fill_pattern]{scale_fill_pattern()}} for \code{ggplot2} integration. 156 | } 157 | -------------------------------------------------------------------------------- /man/reexports.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/re-exports.r 3 | \docType{import} 4 | \name{reexports} 5 | \alias{reexports} 6 | \alias{unit} 7 | \title{Objects exported from other packages} 8 | \keyword{internal} 9 | \description{ 10 | These objects are imported from other packages. Follow the links 11 | below to see their documentation. 12 | 13 | \describe{ 14 | \item{ggplot2}{\code{\link[ggplot2:reexports]{unit}}} 15 | }} 16 | 17 | -------------------------------------------------------------------------------- /man/scale_fill_pattern.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scale_fill_pattern.r 3 | \name{scale_fill_pattern} 4 | \alias{scale_fill_pattern} 5 | \title{Patterned Fills for ggplot.} 6 | \usage{ 7 | scale_fill_pattern( 8 | patterns = seq_len, 9 | fg = NA, 10 | bg = ifelse(is.na(fg), "transparent", NA), 11 | fade = ifelse(is.na(fg), 1, 0.6), 12 | alpha = 1, 13 | angle = 0, 14 | width = unit(1/10, "npc"), 15 | height = NA, 16 | lwd = 1, 17 | lty = "solid", 18 | fun = NULL, 19 | min_size = 2 20 | ) 21 | } 22 | \arguments{ 23 | \item{patterns}{A vector of pattern names that will be subset or recycled 24 | as needed to match the levels of the \code{aes()} fill variable. If 25 | integers are provided, they are mapped to predefined patterns. 26 | See "Details" and "Pattern Names" sections below. Default: \code{seq_len}} 27 | 28 | \item{fg}{Foreground color for the pattern's lines, or \code{NA} to use the 29 | color scale for the \code{aes()} color variable. Default: \code{NA}} 30 | 31 | \item{bg}{Background color (or grob), or \code{NA} to use the color scale for 32 | the \code{aes()} color variable. 33 | Default: \code{ifelse(is.na(fg), "transparent", NA)}} 34 | 35 | \item{fade, alpha}{Modify the color from the \code{aes()} color scale. Fade will 36 | make it more white, and alpha will make it more transparent. Both 37 | values must be between 0 and 1, inclusive, where 1 means unchanged. 38 | Default: \verb{fade = ifelse(is.na(fg), 1, 0.6), alpha = 1}} 39 | 40 | \item{angle}{How much the rotate the pattern, given in degrees clockwise. 41 | Default: \code{0}} 42 | 43 | \item{width}{The width of the pattern tile. Assumed to be millimeters 44 | unless set otherwise with \code{\link[=unit]{unit()}}. Default: \code{unit(1/10, 'npc')}} 45 | 46 | \item{height}{The height of the pattern tile, or \code{NA} to match \code{width}. 47 | Assumed to be millimeters unless set otherwise with \code{\link[=unit]{unit()}}. 48 | Default: \code{NA}} 49 | 50 | \item{lwd}{Line width. A positive number. 51 | See \code{\link[graphics:par]{graphics::par()}} for additional details. Default: \code{1}} 52 | 53 | \item{lty}{Line type. One of \code{"solid"}, \code{"dashed"}, \code{"dotted"}, 54 | \code{"dotdash"}, \code{"longdash"}, or \code{"twodash"}. 55 | See \code{\link[graphics:par]{graphics::par()}} for additional details. Default: \code{"solid"}} 56 | 57 | \item{fun}{A function for modifying graphical parameters immediately 58 | before rendering. Should accept two parameters: \code{env}, an 59 | environment that the function should modify, and \code{row}, the row of 60 | transformed data that ggbuild has constructed for this grob 61 | (including aes mappings). The function should return a gTree or an 62 | error to force returning from the parent function immediately, or 63 | \code{NULL} to continue processing with the updated \code{env}. Default: \code{NULL}} 64 | 65 | \item{min_size}{Minimum size of the pattern to draw. Applies to both width 66 | and height. Useful for avoiding CPU and memory overhead on tiny 67 | graphical elements. Assumed to be millimeters unless set otherwise 68 | with \code{\link[=unit]{unit()}}. Default: \code{2}} 69 | } 70 | \value{ 71 | A \code{\link[ggplot2:discrete_scale]{ggplot2::discrete_scale()}} object. 72 | } 73 | \description{ 74 | Patterned Fills for ggplot. 75 | } 76 | \details{ 77 | All of the parameters can accept a vector of values or a function 78 | that takes \code{n} as an argument and returns the value(s) to use. The 79 | values are subset or recycled as needed to obtain the same number 80 | as \code{length(levels(fill))}, where fill is the variable defined by 81 | \code{aes(fill = )}. 82 | } 83 | \section{Pattern Names}{ 84 | 85 | 86 | \strong{Base name:} 87 | \itemize{ 88 | \item Pattern names must always begin with one of \code{"brick"}, \code{"chevron"}, 89 | \code{"fish"}, \code{"grid"}, \code{"herringbone"}, \code{"hexagon"}, \code{"octagon"}, \code{"rain"}, 90 | \code{"saw"}, \code{"shingle"}, \code{"rshingle"}, \code{"stripe"}, or \code{"wave"}. 91 | \item These names support partial matching, e.g. \code{"her"}, \code{"herring"}, and 92 | \code{"herringbone"} are all valid. However, tiling designs may be added in 93 | the future, so it is recommended to use the full names in finished code. 94 | } 95 | 96 | \strong{Angle modifier:} 97 | \itemize{ 98 | \item A number immediately following the tiling design, such as \code{"stripe45"}, 99 | \code{"fish180"}, or \code{"saw20"}. 100 | \item Is added to the \code{angle} argument; \code{fill_pattern("brick45", angle=45)} is 101 | equivalent to \code{fill_pattern("brick90")}. 102 | } 103 | 104 | \strong{Width and height modifier:} 105 | \itemize{ 106 | \item An underscore followed by a single size to be used for both width and height. 107 | \item Or, an underscore followed by the new width and height separated by a colon. 108 | \item Can be absolute sizes (\code{"grid_4"} or \code{"hex_5mm:0.1npc"}) or relative to 109 | the \code{width} and \code{height} arguments (\code{"saw_sm"} or \code{"brick_*2:/2"}). The 110 | shorthand values \code{"xs"}, \code{"sm"}, \code{"md"}, \code{"lg"}, and \code{"xl"} are equivalent 111 | to \code{"/4"}, \code{"/2"}, \code{"1"}, \code{"*2"}, and \code{"*4"}, respectively. 112 | } 113 | 114 | \strong{Line width and style:} 115 | \itemize{ 116 | \item An underscore, followed by a number, followed by one of \code{"solid"}, 117 | \code{"dashed"}, \code{"dotted"}, \code{"dotdash"}, \code{"longdash"}, or \code{"twodash"}. For 118 | example, \code{"shingle_0.5dashed"} or \code{"wave_2solid"}. 119 | \item The number component is optional, so \code{"oct_longdash"} is also valid, and 120 | will use \code{lwd} for the line width. 121 | \item To specify just the line width, suffix the number with "lwd": 122 | \code{"grid_2lwd"} will use \code{lty} for the line style. 123 | } 124 | 125 | \strong{Combinations:} 126 | \itemize{ 127 | \item Modifiers can be combined in any order. For example, \code{"hex_lg:xl_2dotted"} 128 | or \code{"grid45_dashed_1.4lwd_:6mm_sm:"}. 129 | } 130 | } 131 | 132 | \examples{ 133 | \donttest{ 134 | library(ggplot2) 135 | library(fillpattern) 136 | 137 | ggplot(mpg, aes(x = class, y = hwy, color = class, fill = class)) + 138 | geom_boxplot() + 139 | scale_fill_pattern() 140 | 141 | ggplot(mpg, aes(x = drv, y = hwy, color = drv, fill = drv)) + 142 | geom_violin() + 143 | scale_colour_brewer(palette = "Set1") + 144 | scale_fill_pattern(c("brick", "stripe45", "grid45_lg"), fg = "black") 145 | 146 | ggplot(mpg, aes(x = drv, color = drv, fill = drv)) + 147 | geom_bar() + 148 | scale_fill_pattern( 149 | patterns = c("hex_sm", "brick90_xl", "fish"), 150 | lty = c("solid", "twodash", "dotted"), 151 | lwd = c(2, 3, 1) ) + 152 | theme(legend.key.size = unit(2, 'cm')) 153 | } 154 | } 155 | \seealso{ 156 | \code{\link[=fill_pattern]{fill_pattern()}} for base \code{grid} graphics integration. 157 | } 158 | -------------------------------------------------------------------------------- /pkgdown/_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://cmmr.github.io/fillpattern/ 2 | 3 | template: 4 | bootstrap: 5 5 | bootswatch: darkly 6 | theme: breeze-dark 7 | bslib: 8 | code-bg: '#2b2b2b' 9 | base_font: {google: "Noto Sans"} 10 | heading_font: {google: "Noto Sans"} 11 | 12 | figures: 13 | dev: ragg::agg_png 14 | fig.width: 8 15 | fig.height: 4 16 | 17 | -------------------------------------------------------------------------------- /pkgdown/extra.css: -------------------------------------------------------------------------------- 1 | .nav-text.text-muted { 2 | color: white !important; 3 | } 4 | 5 | h2,h3 { 6 | margin-top: 30px; 7 | } 8 | 9 | .active>.nav-link { 10 | color: white !important; 11 | } 12 | 13 | th>.eg { 14 | font-size: smaller; 15 | font-style: italic; 16 | font-weight: lighter; 17 | } 18 | 19 | .template-article #main>div { 20 | margin-bottom: 40px; 21 | } 22 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | # This file is part of the standard setup for testthat. 2 | # It is recommended that you do not modify it. 3 | # 4 | # Where should you do additional test configuration? 5 | # Learn more about the roles of various files in: 6 | # * https://r-pkgs.org/testing-design.html#sec-tests-files-overview 7 | # * https://testthat.r-lib.org/articles/special-files.html 8 | 9 | library(testthat) 10 | library(fillpattern) 11 | 12 | test_check("fillpattern") 13 | -------------------------------------------------------------------------------- /tests/testthat/test-fillPatternGrob.r: -------------------------------------------------------------------------------- 1 | test_that("fillPatternGrob", { 2 | 3 | grDevices::pdf(file = tf <- tempfile(fileext = ".pdf")) 4 | on.exit({ grDevices::dev.off(); unlink(tf) }, add = TRUE) 5 | 6 | gt <- expect_silent(fillPatternGrob()) 7 | expect_s3_class(gt, c("fill_pattern", "gTree", "grob", "gDesc")) 8 | expect_contains(names(gt), methods::formalArgs(fillPatternGrob)) 9 | expect_contains(names(gt), c("name", "gp", "vp", "children", "childrenOrder")) 10 | 11 | }) 12 | -------------------------------------------------------------------------------- /tests/testthat/test-fill_pattern.r: -------------------------------------------------------------------------------- 1 | 2 | # vdiffr doesn't support the grid::pattern object, 3 | # so we'll just look for errors/warnings across a range of inputs. 4 | 5 | test_that("grid graphics", { 6 | 7 | library(grid) 8 | 9 | grDevices::pdf(file = tf <- tempfile(fileext = ".pdf")) 10 | on.exit({ grDevices::dev.off(); unlink(tf) }, add = TRUE) 11 | 12 | 13 | linetypes <- c("solid", "dashed", "dotted", "dotdash", "longdash", "twodash") 14 | patterns <- c("brick", "chevron", "fish", "grid", "herringbone", "hexagon", 15 | "octagon", "rain", "saw", "shingle", "rshingle", "stripe", "wave" ) 16 | 17 | n <- 20 18 | fills <- expect_silent(fill_pattern( 19 | pattern = rep(patterns, length.out = n), 20 | fg = rep(c("black", "red", "green", "blue"), length.out = n), 21 | bg = rep(c("white", "transparent"), length.out = n), 22 | angle = rep(c(0, 20, 45, 90), length.out = n), 23 | width = rep(list(unit(5, 'mm'), NA, unit(1/10, 'npc')), length.out = n), 24 | height = rep(list(NA, unit(1/10, 'npc'), unit(5, 'mm')), length.out = n), 25 | lwd = rep(c(0.5, 1, 1.5, 2, 3), length.out = n), 26 | lty = rep(linetypes, length.out = n) )) 27 | 28 | gp <- expect_silent(Map(gpar, fill = fills)) 29 | 30 | 31 | grid.newpage() 32 | 33 | i <- 0 34 | for (x in 1:5 / 5 - 1/10) 35 | for (y in 1:4 / 4 - 1/8) 36 | expect_silent({ 37 | i <- i + 1 38 | grid.rect(x = x, y = y, width = 1/5, height = 1/4, gp = gp[[i]]) 39 | NULL 40 | }) 41 | 42 | }) 43 | -------------------------------------------------------------------------------- /tests/testthat/test-lighten.r: -------------------------------------------------------------------------------- 1 | test_that("fade and alpha", { 2 | 3 | grDevices::pdf(file = tf <- tempfile(fileext = ".pdf")) 4 | on.exit({ grDevices::dev.off(); unlink(tf) }, add = TRUE) 5 | 6 | expect_equal(fillpattern:::lighten("black", "black", 1, 1), "black") 7 | expect_equal(fillpattern:::lighten(NA, "black", 1, 0), "#00000000") 8 | expect_equal(fillpattern:::lighten("black", "black", 0, 0), "#FFFFFF00") 9 | }) 10 | -------------------------------------------------------------------------------- /tests/testthat/test-makeContent.r: -------------------------------------------------------------------------------- 1 | test_that("makeContent", { 2 | 3 | grDevices::pdf(file = tf <- tempfile(fileext = ".pdf")) 4 | on.exit({ grDevices::dev.off(); unlink(tf) }, add = TRUE) 5 | 6 | gt <- expect_silent(fillPatternGrob()) 7 | gt <- expect_silent(grid::makeContent(gt)) 8 | 9 | expect_s3_class(gt, c("fill_pattern", "gTree", "grob", "gDesc")) 10 | expect_contains(names(gt), methods::formalArgs(fillPatternGrob)) 11 | expect_contains(names(gt), c("name", "gp", "vp", "children", "childrenOrder")) 12 | expect_gte(length(gt$children), 1) 13 | expect_s3_class(gt$children, c("gList")) 14 | 15 | }) 16 | -------------------------------------------------------------------------------- /tests/testthat/test-modify_size.r: -------------------------------------------------------------------------------- 1 | test_that("modify_size", { 2 | 3 | grDevices::pdf(file = tf <- tempfile(fileext = ".pdf")) 4 | on.exit({ grDevices::dev.off(); unlink(tf) }, add = TRUE) 5 | 6 | expect_equal(fillpattern:::modify_size(30, 'x', "20mm"), 20) 7 | expect_equal(fillpattern:::modify_size(20, 'y', "*2"), 40) 8 | 9 | }) 10 | -------------------------------------------------------------------------------- /tests/testthat/test-pattern_alpha.r: -------------------------------------------------------------------------------- 1 | test_that("pattern_alpha", { 2 | 3 | grDevices::pdf(file = tf <- tempfile(fileext = ".pdf")) 4 | on.exit({ grDevices::dev.off(); unlink(tf) }, add = TRUE) 5 | 6 | args <- structure( 7 | class = c('GridFillPattern', 'GridPattern'), 8 | .Data = list( 9 | patterns = "brick", 10 | fg = "black", 11 | bg = "white" )) 12 | 13 | fill <- expect_silent(ggplot2::pattern_alpha(x = args, alpha = 1)) 14 | 15 | expect_s3_class(fill, c("GridTilingPattern", "GridPattern")) 16 | 17 | }) 18 | -------------------------------------------------------------------------------- /tests/testthat/test-scale_fill_pattern.r: -------------------------------------------------------------------------------- 1 | test_that("ggplot2 graphics", { 2 | 3 | library(ggplot2) 4 | 5 | grDevices::pdf(file = tf <- tempfile(fileext = ".pdf")) 6 | on.exit({ grDevices::dev.off(); unlink(tf) }, add = TRUE) 7 | 8 | p1 <- expect_silent({ 9 | ggplot(mpg, aes(x = class, y = hwy, color = class, fill = class)) + 10 | geom_boxplot() + 11 | scale_fill_pattern() 12 | }) 13 | 14 | p2 <- expect_silent({ 15 | ggplot(mpg, aes(x = drv, y = hwy, color = drv, fill = drv)) + 16 | geom_violin() + 17 | scale_colour_brewer(palette = "Set1") + 18 | scale_fill_pattern(c("brick", "stripe45", "grid45_lg"), fg = "black") 19 | }) 20 | 21 | p3 <- expect_silent({ 22 | ggplot(mpg, aes(x = drv, color = drv, fill = drv)) + 23 | geom_bar() + 24 | scale_fill_pattern( 25 | patterns = c("hex_sm", "brick90_xl", "fish"), 26 | lty = c("solid", "twodash", "dotted"), 27 | lwd = c(2, 3, 1) ) + 28 | theme(legend.key.size = unit(2, 'cm')) 29 | }) 30 | 31 | }) 32 | 33 | 34 | # # Verify that colors are getting copied from aes() 'color' to 'fill' 35 | # test_that("ggplot2 color mapping", { 36 | # 37 | # pdf(NULL) 38 | # on.exit(dev.off(), add = TRUE) 39 | # 40 | # p <- expect_silent({ 41 | # ggplot(mpg, aes(x = drv, color = drv, fill = drv)) + 42 | # scale_color_manual(values = c("#FF0000", "#00FF00", "#0000FF")) + 43 | # geom_bar() + 44 | # scale_fill_pattern(pattern = "stripe", fg = "black", fade = 1) + 45 | # theme_void() 46 | # }) 47 | # 48 | # gtable <- expect_silent(ggplot_gtable(ggplot_build(p))) 49 | # pIndex <- expect_silent(sapply(gtable$grobs, function (g) startsWith(g$name, "panel-1"))) 50 | # expect_equal(sum(pIndex), 1) 51 | # panel <- gtable$grobs[[which(pIndex)]] 52 | # rIndex <- expect_silent(sapply(names(panel$children), startsWith, "geom_rect")) 53 | # expect_equal(sum(rIndex), 1) 54 | # fills <- panel$children[[which(rIndex)]]$gp$fill 55 | # 56 | # 57 | # skip_if_not(capabilities("cairo"), "No SVG file support.") 58 | # skip_on_os("mac") 59 | # 60 | # tf <- tempfile(fileext = ".svg") 61 | # on.exit(unlink(tf), add = TRUE) 62 | # 63 | # svg(filename = tf); fills[[1]]$f(); dev.off() 64 | # expect_true(any(grepl('fill:rgb(100%,0%,0%)', readLines(tf), fixed = TRUE))) 65 | # 66 | # svg(filename = tf); fills[[2]]$f(); dev.off() 67 | # expect_true(any(grepl('fill:rgb(0%,100%,0%)', readLines(tf), fixed = TRUE))) 68 | # 69 | # svg(filename = tf); fills[[3]]$f(); dev.off() 70 | # expect_true(any(grepl('fill:rgb(0%,0%,100%)', readLines(tf), fixed = TRUE))) 71 | # 72 | # }) 73 | --------------------------------------------------------------------------------