grid.pattern_pch()draws "plotting character" geometry patternsCaveats:
- Only supports pch values 0-25 and NA
- Does not support arbitrary ASCII / Unicode values
- A couple shapes not exactly alike the "base" shape
trevorld
Showing 3 of 14 files from the diff.
R/star_scale.R
changed.
Newly tracked file
R/pattern-geometry-pch.R
created.
R/grid-pattern.R
changed.
Other files ignored by Codecov
tests/figs/pch/col-fill.svg
is new.
DESCRIPTION
has changed.
tests/figs/pch/simple.svg
is new.
NAMESPACE
has changed.
tests/figs/pch/compound.svg
is new.
man/grid.pattern.Rd
has changed.
man/grid.pattern_pch.Rd
is new.
tests/testthat/test_pch.R
is new.
README.Rmd
has changed.
README.md
has changed.
tests/figs/pch/fill-fill.svg
is new.
@@ -0,0 +1,189 @@
Loading
| 1 | + | #' Plotting character patterned grobs |
|
| 2 | + | #' |
|
| 3 | + | #' `grid.pattern_pch()` draws a plotting character pattern onto the graphic device. |
|
| 4 | + | #' |
|
| 5 | + | #' @inheritParams grid.pattern_regular_polygon |
|
| 6 | + | #' @param shape An integer from `0` to `25` or `NA`. |
|
| 7 | + | #' See [graphics::points()] for more details. |
|
| 8 | + | #' Note we only support these shapes and do not |
|
| 9 | + | #' support arbitrary ASCII / Unicode characters. |
|
| 10 | + | #' @return A grid grob object invisibly. If `draw` is `TRUE` then also draws to the graphic device as a side effect. |
|
| 11 | + | #' @seealso [grid.pattern_regular_polygon()] which is used to implement this pattern. |
|
| 12 | + | #' @examples |
|
| 13 | + | #' if (require("grid")) { |
|
| 14 | + | #' x_hex <- 0.5 + 0.5 * cos(seq(2 * pi / 4, by = 2 * pi / 6, length.out = 6)) |
|
| 15 | + | #' y_hex <- 0.5 + 0.5 * sin(seq(2 * pi / 4, by = 2 * pi / 6, length.out = 6)) |
|
| 16 | + | #' gp <- gpar(col = "black", fill = "lightblue") |
|
| 17 | + | #' |
|
| 18 | + | #' # pch 0-6 are simple shapes with no fill |
|
| 19 | + | #' grid.pattern_pch(x_hex, y_hex, shape = 0:6, gp = gp, |
|
| 20 | + | #' spacing = 0.1, density = 0.4, angle = 0) |
|
| 21 | + | #' |
|
| 22 | + | #' # pch 7-14 are compound shapes with no fill |
|
| 23 | + | #' grid.newpage() |
|
| 24 | + | #' grid.pattern_pch(x_hex, y_hex, shape = 7:14, gp = gp, |
|
| 25 | + | #' spacing = 0.1, density = 0.4, angle = 0) |
|
| 26 | + | #' |
|
| 27 | + | #' # pch 15-20 are filled with 'col' |
|
| 28 | + | #' grid.newpage() |
|
| 29 | + | #' grid.pattern_pch(x_hex, y_hex, shape = 15:20, gp = gp, |
|
| 30 | + | #' spacing = 0.1, density = 0.4, angle = 0) |
|
| 31 | + | #' |
|
| 32 | + | #' # pch 21-25 are filled with 'fill' |
|
| 33 | + | #' grid.newpage() |
|
| 34 | + | #' grid.pattern_pch(x_hex, y_hex, shape = 21:25, gp = gp, |
|
| 35 | + | #' spacing = 0.1, density = 0.4, angle = 0) |
|
| 36 | + | #' |
|
| 37 | + | #' # using a 'basket' weave `type` with two shapes |
|
| 38 | + | #' grid.newpage() |
|
| 39 | + | #' grid.pattern_pch(x_hex, y_hex, shape = c(1,4), gp = gp, |
|
| 40 | + | #' type = "basket", |
|
| 41 | + | #' spacing = 0.1, density = 0.4, angle = 0) |
|
| 42 | + | #' } |
|
| 43 | + | #' @export |
|
| 44 | + | grid.pattern_pch <- function(x = c(0, 0, 1, 1), y = c(1, 0, 0, 1), id = 1L, ..., |
|
| 45 | + | colour = gp$col %||% "grey20", |
|
| 46 | + | fill = gp$fill %||% "grey80", |
|
| 47 | + | angle = 30, density = 0.2, |
|
| 48 | + | spacing = 0.05, xoffset = 0, yoffset = 0, |
|
| 49 | + | scale = 0.5, shape = 1L, |
|
| 50 | + | grid = "square", type = NULL, subtype = NULL, rot = 0, |
|
| 51 | + | alpha = gp$alpha %||% NA_real_, linetype = gp$lty %||% 1, |
|
| 52 | + | size = gp$lwd %||% 1, |
|
| 53 | + | default.units = "npc", name = NULL, |
|
| 54 | + | gp = gpar(), draw = TRUE, vp = NULL) { |
|
| 55 | + | if (missing(colour) && hasName(l <- list(...), "color")) colour <- l$color |
|
| 56 | + | grid.pattern("pch", x, y, id, |
|
| 57 | + | colour = colour, fill = fill, angle = angle, |
|
| 58 | + | density = density, spacing = spacing, xoffset = xoffset, yoffset = yoffset, |
|
| 59 | + | scale = scale, shape = shape, |
|
| 60 | + | grid = grid, type = type, subtype = subtype, rot = rot, |
|
| 61 | + | alpha = alpha, linetype = linetype, size = size, |
|
| 62 | + | default.units = default.units, name = name, gp = gp , draw = draw, vp = vp) |
|
| 63 | + | } |
|
| 64 | + | ||
| 65 | + | # each pch will be represented by two regular polygons (although one may be "null") |
|
| 66 | + | create_pattern_pch <- function(params, boundary_df, aspect_ratio, legend = FALSE) { |
|
| 67 | + | # vectorize fill, col, lwd, lty, density, rot, and shape |
|
| 68 | + | fill <- alpha(params$pattern_fill, params$pattern_alpha) |
|
| 69 | + | col <- alpha(params$pattern_colour, params$pattern_alpha) |
|
| 70 | + | lwd <- params$pattern_size |
|
| 71 | + | lty <- params$pattern_linetype |
|
| 72 | + | ||
| 73 | + | density <- params$pattern_density |
|
| 74 | + | rot <- params$pattern_rot |
|
| 75 | + | shape <- params$pattern_shape |
|
| 76 | + | ||
| 77 | + | n_par <- max(lengths(list(fill, col, lwd, lty, density, rot, shape))) |
|
| 78 | + | ||
| 79 | + | fill <- rep(fill, length.out = n_par) |
|
| 80 | + | col <- rep(col, length.out = n_par) |
|
| 81 | + | lwd <- rep(lwd, length.out = n_par) |
|
| 82 | + | lty <- rep(lty, length.out = n_par) |
|
| 83 | + | density <- rep(density, length.out = n_par) |
|
| 84 | + | rot <- rep(rot, length.out = n_par) |
|
| 85 | + | shape <- rep(shape, length.out = n_par) |
|
| 86 | + | ||
| 87 | + | # setup bottom and top regular polygons |
|
| 88 | + | pint <- as.integer(shape) |
|
| 89 | + | if (!all(is.na(pint))) |
|
| 90 | + | stopifnot(any(na_omit(pint) >= 0), any(na_omit(pint) <= 25)) |
|
| 91 | + | pch <- ifelse(is.na(pint), "26", as.character(pint)) |
|
| 92 | + | pint <- ifelse(is.na(pint), 26L, pint) |
|
| 93 | + | ||
| 94 | + | density1 <- ifelse(pint == 4L, 1.414 * density, density) |
|
| 95 | + | density1 <- ifelse(pint == 20L, 2/3 * density, density1) |
|
| 96 | + | ||
| 97 | + | density2 <- ifelse(pint == 7L | pint == 13L, 1.414 * density, density) |
|
| 98 | + | ||
| 99 | + | fill <- ifelse(pint < 21L, col, fill) |
|
| 100 | + | fill <- ifelse(pint < 15L, NA_character_, fill) |
|
| 101 | + | ||
| 102 | + | col <- ifelse(pint > 14L & pint < 19L, NA_character_, col) |
|
| 103 | + | ||
| 104 | + | rot1 <- rot + sapply(pch, get_rot_base) |
|
| 105 | + | rot2 <- rot + sapply(pch, get_rot_top) |
|
| 106 | + | ||
| 107 | + | shape1 <- sapply(pch, get_shape_base) |
|
| 108 | + | shape2 <- sapply(pch, get_shape_top) |
|
| 109 | + | ||
| 110 | + | params$pattern_fill <- fill |
|
| 111 | + | params$pattern_col <- col |
|
| 112 | + | params$pattern_size <- lwd |
|
| 113 | + | params$pattern_linetype <- lty |
|
| 114 | + | params$pattern_scale <- 0.001 |
|
| 115 | + | params_base <- params_top <- params |
|
| 116 | + | ||
| 117 | + | # bottom regular polygon |
|
| 118 | + | params_base$pattern_shape <- shape1 |
|
| 119 | + | params_base$pattern_rot <- rot1 |
|
| 120 | + | params_base$pattern_density <- density1 |
|
| 121 | + | grob_base <- create_pattern_regular_polygon_via_sf(params_base, boundary_df, aspect_ratio, legend) |
|
| 122 | + | grob_base <- editGrob(grob_base, name = "pch_base") |
|
| 123 | + | ||
| 124 | + | # top regular polygon |
|
| 125 | + | params_top$pattern_shape <- shape2 |
|
| 126 | + | params_top$pattern_rot <- rot2 |
|
| 127 | + | params_top$pattern_density <- density2 |
|
| 128 | + | grob_top <- create_pattern_regular_polygon_via_sf(params_top, boundary_df, aspect_ratio, legend) |
|
| 129 | + | grob_top <- editGrob(grob_top, name = "pch_top") |
|
| 130 | + | ||
| 131 | + | gl <- gList(grob_base, grob_top) |
|
| 132 | + | ||
| 133 | + | gTree(children = gl, name = "pch") |
|
| 134 | + | } |
|
| 135 | + | ||
| 136 | + | get_rot_base <- function(pch) { |
|
| 137 | + | switch(pch, |
|
| 138 | + | "4" = 45, |
|
| 139 | + | "6" = 180, |
|
| 140 | + | "25" = 180, |
|
| 141 | + | 0) |
|
| 142 | + | } |
|
| 143 | + | ||
| 144 | + | get_rot_top <- function(pch) { |
|
| 145 | + | switch(pch, |
|
| 146 | + | "7" = 45, |
|
| 147 | + | "11" = 180, |
|
| 148 | + | "13" = 45, |
|
| 149 | + | 0) |
|
| 150 | + | } |
|
| 151 | + | ||
| 152 | + | get_shape_base <- function(pch) { |
|
| 153 | + | switch(pch, |
|
| 154 | + | "0" = "square", |
|
| 155 | + | "2" = "convex3", |
|
| 156 | + | "3" = "star4", |
|
| 157 | + | "4" = "star4", |
|
| 158 | + | "5" = "convex4", |
|
| 159 | + | "6" = "convex3", |
|
| 160 | + | "7" = "square", |
|
| 161 | + | "9" = "convex4", |
|
| 162 | + | "8" = "star8", |
|
| 163 | + | "11" = "convex3", |
|
| 164 | + | "12" = "square", |
|
| 165 | + | "14" = "square", |
|
| 166 | + | "15" = "square", |
|
| 167 | + | "17" = "convex3", |
|
| 168 | + | "18" = "convex4", |
|
| 169 | + | "22" = "square", |
|
| 170 | + | "23" = "convex4", |
|
| 171 | + | "24" = "convex3", |
|
| 172 | + | "25" = "convex3", |
|
| 173 | + | "26" = "null", |
|
| 174 | + | "circle") |
|
| 175 | + | } |
|
| 176 | + | ||
| 177 | + | get_shape_top <- function(pch) { |
|
| 178 | + | switch(pch, |
|
| 179 | + | "7" = "star4", |
|
| 180 | + | "9" = "star4", |
|
| 181 | + | "10" = "star4", |
|
| 182 | + | "11" = "convex3", |
|
| 183 | + | "12" = "star4", |
|
| 184 | + | "13" = "star4", |
|
| 185 | + | "14" = "convex3", |
|
| 186 | + | "null") |
|
| 187 | + | } |
|
| 188 | + | ||
| 189 | + | na_omit <- function(x) Filter(Negate(is.na), x) |
@@ -20,6 +20,8 @@
Loading
| 20 | 20 | #' See [grid.pattern_magick()] for more information.} |
|
| 21 | 21 | #' \item{none}{Does nothing. |
|
| 22 | 22 | #' See [grid::grid.null()] for more information.} |
|
| 23 | + | #' \item{pch}{Plotting character geometry patterns. |
|
| 24 | + | #' See [grid.pattern_pch()] for more information.} |
|
| 23 | 25 | #' \item{placeholder}{Placeholder image array patterns. |
|
| 24 | 26 | #' See [grid.pattern_placeholder()] for more information.} |
|
| 25 | 27 | #' \item{plasma}{Plasma array patterns. |
@@ -153,6 +155,7 @@
Loading
| 153 | 155 | geometry_fns <- c(list(circle = create_pattern_circle_via_sf, |
|
| 154 | 156 | crosshatch = create_pattern_crosshatch_via_sf, |
|
| 155 | 157 | none = create_pattern_none, |
|
| 158 | + | pch = create_pattern_pch, |
|
| 156 | 159 | polygon_tiling = create_pattern_polygon_tiling, |
|
| 157 | 160 | regular_polygon = create_pattern_regular_polygon_via_sf, |
|
| 158 | 161 | stripe = create_pattern_stripes_via_sf, |
| Files | Coverage |
|---|---|
| R | 94.25% |
| Project Totals (33 files) | 94.25% |
56.1
0adibnht9uomaapw
wsbdmash9naccr4n
56.2
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file.
The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files.
The size and color of each slice is representing the number of statements and the coverage, respectively.
