##' Create a two-level grouped axis
##'
##' This is especially useful when ploting dates or quarters where you
##' want the quarter on one line and the year on another, but can be useful
##' in any situation where you have groups and sub-groups.
##'
##' @param x The x-axis plotting variable
##' @param groups A vector of groups the same length as the vector of x values
##' @param subgroups A vector of sub-groups the same length as the vector of
##' x values
##' @param subgroup_opts A list of parameters or options that can be used by
##' axis() for formatting the subgroup labels
##' @param group_opts A list of parameters or options that can be used by
##' axis() for formatting the group labels
##' @param group_div_opts A list of parameters or options that can be used by
##' axis() for formatting the tick marks between the main groups
##'
##' @details Probably the simplest way to make sure that you get the data
##' right for this is to add new columns to a dataframe with the group and
##' subgroup labels for each row.
##'
##' Make sure that you order the data correctly, i.e. by the values that are
##' plotted on the x-axis, e.g. your dates.
##'
##' @author David Whiting david.whiting@@publichealth.me.uk
##'
##' @export
##'
##'
##' @examples
##' ## Create some data
##' ff <- data.frame(x = rep(LETTERS[1:10], 3), y = rep(LETTERS[1:3], 10), val = runif(n = 30))
##' ff <- ff[order(ff$y, ff$x), ]
##' ff$z <- 1:30
##' ff
##'
##' plot(ff$z, ff$val, xlab = "", xaxt = "n")
##' axis_groups(ff$z, ff$y, ff$x) # Default grouped axis
##'
##' ## Simulate year-quarter data
##' ff <- data.frame(x = rep(c("Q1", "Q2", "Q3", "Q4"), 3),
##' y = rep(c("2014/15", "2015/16", "2016/17"), 4), val = runif(n = 12))
##' ff <- ff[order(ff$y, ff$x), ]
##' ff$z <- 1:12
##' ff
##' plot(ff$z, ff$val, xlab = "", xaxt = "n") # Default grouped axis
##' axis_groups(ff$z, ff$y, ff$x)
##'
##' plot(ff$z, ff$val, xlab = "", xaxt = "n")
##' ## Make the group divider red
##' axis_groups(ff$z, ff$y, ff$x, group_div_opts = list(col = "red"))
##'
##' plot(ff$z, ff$val, xlab = "", xaxt = "n")
##' ## Change the font of the main groups
##' axis_groups(ff$z, ff$y, ff$x, group_opts = list(cex.axis = 3, col.axis = "green"))
##'
##' plot(ff$z, ff$val, xlab = "", xaxt = "n")
##' ## Change the fonts of the main groups and subgroups
##' axis_groups(ff$z, ff$y, ff$x,
##' group_opts = list(cex.axis = 3, col.axis = "green"),
##' subgroup_opts = list(cex.axis = 0.8, col.axis = "blue"))
##'
axis_groups <- function(x, groups, subgroups,
subgroup_opts = list(),
group_opts = list(),
group_div_opts = list()
) {
## Sub-groups
if (!"side" %in% names(subgroup_opts)) subgroup_opts$side <- 1
if (!"x" %in% names(subgroup_opts)) subgroup_opts$at <- x
if (!"labels" %in% names(subgroup_opts)) subgroup_opts$labels <- subgroups
if (!"tick" %in% names(subgroup_opts)) subgroup_opts$tick <- FALSE
do.call(axis, subgroup_opts)
## Work out the midpoints of the groups.
grps <- table(groups)
lastidx <- cumsum(grps)
firstidx <- lastidx - grps + 1
grppos <- x[firstidx] + (x[lastidx] - x[firstidx]) / 2
if (!"side" %in% names(group_opts)) group_opts$side <- 1
if (!"x" %in% names(group_opts)) group_opts$at <- grppos
if (!"labels" %in% names(group_opts)) group_opts$labels <- names(grps)
if (!"tick" %in% names(group_opts)) group_opts$tick <- FALSE
if (!"padj" %in% names(group_opts)) group_opts$padj <- 2
do.call(axis, group_opts)
## Work out the points between the groups for the tickmarks
nextidx <- lastidx + 1
tck_pos <- x[lastidx] + (x[nextidx] - x[lastidx]) / 2
if (!"side" %in% names(group_div_opts)) group_div_opts$side <- 1
if (!"x" %in% names(group_div_opts)) group_div_opts$at <- tck_pos
if (!"labels" %in% names(group_div_opts)) group_div_opts$labels <- FALSE
if (!"tck" %in% names(group_div_opts)) group_div_opts$tck <- -0.10
if (!"lty" %in% names(group_div_opts)) group_div_opts$lty <- "dashed"
if (!"lwd" %in% names(group_div_opts)) group_div_opts$lwd <- 0
if (!"lwd.ticks" %in% names(group_div_opts)) group_div_opts$lwd.ticks <- 1
## Don't try to add tickmarks if there is only one main group
if (!all(is.na(group_div_opts$at))) do.call(axis, group_div_opts)
invisible(list(firstidx = firstidx, lastidx = lastidx,
grppos = grppos,
nextidx = nextidx,
tck_pos = tck_pos))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.