Skip to content

Instantly share code, notes, and snippets.

@danlewer
Last active June 6, 2020 20:04
Show Gist options
  • Save danlewer/e62806d1bff7dc938f0932b80b3a58cf to your computer and use it in GitHub Desktop.
Save danlewer/e62806d1bff7dc938f0932b80b3a58cf to your computer and use it in GitHub Desktop.
# make a merrimekko chart (100% stacked bar chart with variable widths)
# m is a matrix
# cols is a vector of colours of same length as number of rows in matrix
# ... is other arguments passed to plot
# set par(xpd = NA) to see x-axis labels
mm <- function(m, cols = NA, ...) {
widths <- colSums(m)
xs <- c(0, cumsum(widths)) / sum(m)
xl <- rep(xs[-length(xs)], each = nrow(m)) # x-left
xr <- rep(xs[-1], each = nrow(m)) # x-right
ys <- rbind(0, m)
ys <- apply(ys, 2, cumsum)
ys <- apply(ys, 2, function(x) x / max(x))
yb <- ys[-nrow(ys),] # y-bottom
yt <- ys[-1,] # y-top
cs <- c('#8DD3C7', '#FFFFB3', '#BEBADA', '#FB8072', '#80B1D3', '#FDB462', '#B3DE69', '#FCCDE5') # default colour scheme is 'Set3' from RColorBrewer
cols <- if (is.na(cols)) cs[seq_len(nrow(m))] else cols
plot(1, type = 'n', xlim = c(0, 1), ylim = c(0, 1), axes = F, ylab = NA, xlab = NA, ...)
rect(xl, yb, xr, yt, col = cols)
xp <- xs[-length(xs)] + diff(xs) / 2
xlab <- if (is.null(colnames(m))) LETTERS[seq_len(ncol(m))] else colnames(m)
text(xp, -0.15, xlab)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment