Skip to content

Instantly share code, notes, and snippets.

@k-barton
Last active November 20, 2020 11:05
Show Gist options
  • Save k-barton/74bb7cc472216821f486db175f1ed441 to your computer and use it in GitHub Desktop.
Save k-barton/74bb7cc472216821f486db175f1ed441 to your computer and use it in GitHub Desktop.
Add chequerboard background to the plot (with base graphics)
#' @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)
}
@k-barton
Copy link
Author

Examples:

par(mfcol = c(3,2), mar = c(3, 3, 3, 3))
checkers(ny = 8.5, add = FALSE)
title("checkers(ny = 8.5)")
box()
checkers(nx = 2.5, ratio = 2, add = FALSE)
title("checkers(nx = 2.5, ratio = 2)")
box()
checkers(size = .1, add = FALSE)
title("checkers(size = 0.1)")
box()
for(adj in c(0, .5, 1)) {
    plot(c(0,10), c(0,10), type = "n",
       main = title(sprintf("checkers(..., adj = %g)", adj)))
    checkers(nx = 3.5, adj = adj, col1 = "steelblue3", col2 = "oldlace")
    box()
}

checkers

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment