Last active
November 20, 2020 11:05
-
-
Save k-barton/74bb7cc472216821f486db175f1ed441 to your computer and use it in GitHub Desktop.
Add chequerboard background to the plot (with base graphics)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#' @param nx,ny number of checkers horizontally and vertically | |
#' @param size size in inches, alternative way to specify number of checkers. | |
#' Ignored if `nx` or `ny` are given. | |
#' @param ratio numeric scalar, x/y ratio of checker side | |
#' @adj adjust numeric of length 1 or 2, adjusts horizontal and vertical alignment | |
#' of the checkerboard. Preferably within 0-1 range. | |
#' @param col1,col2 first and second colour for the checkers | |
#' @param add logical, if `TRUE` (the default) draws the checkerboard over the existing plot | |
checkers <- | |
function(nx = NULL, ny = NULL, size = NULL, ratio = 1, | |
adj = 0.5, col1 = "white", col2 = "gray70", | |
add = TRUE) { | |
if(is.null(nx) && is.null(ny) && is.null(size)) | |
stop("one of 'nx', 'ny' or 'size' must be given") | |
.fromsize <- function(pin, szinch, ratio) | |
c(n = ceiling(pin * ratio / size), size = szinch / pin / ratio) | |
pin <- par("pin") | |
if(is.null(nx)) { # _,ny,[size] | |
if(is.null(size)) { #_,ny,_ | |
sy <- c(n = ceiling(ny[1L]), size = 1 / ny[1L]) | |
size <- pin[2L] / ny[1L] * ratio | |
} else { | |
sy <- .fromsize(pin[2L], size, ratio) # x | |
} | |
sx <- .fromsize(pin[1L], size, 1) # x | |
} else if(is.null(ny)) { # nx,_,[size] { | |
if(is.null(size)) { # nx,_,_ | |
sx <- c(n = ceiling(nx[1L]), size = 1 / nx[1L]) | |
size <- pin[1L] / nx[1L] | |
} else { # nx,_,size | |
sx <- .fromsize(pin[1L], size, 1) # x | |
} | |
sy <- .fromsize(pin[2L], size, ratio) # y | |
} | |
adj <- rep(adj, length.out = 2L) | |
cx0 <- -adj[1L] * ((sx[2L] * sx[1L]) - 1) | |
cy0 <- -adj[2L] * ((sy[2L] * sy[1L]) - 1) | |
m <- matrix(0, nrow = sx[1L] + 1L, ncol = sy[1L] + 1L) | |
m[] <- (col(m) + row(m)) %% 2 | |
if(!isTRUE(add)) plot.new() | |
op <- par(c("usr", "xlog", "ylog", "yaxs", "xaxs")) | |
on.exit(par(op)) | |
plot.window(c(0, 1), c(0, 1), xaxs = "i", yaxs = "i", log = "") | |
image(seq(cx0, by = sx[2L], length.out = sx[1L] + 2L), | |
seq(cy0, by = sy[2L], length.out = sy[1L] + 2L), | |
m, col = c(col1, col2), add = TRUE, useRaster = TRUE) | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Examples: