R/bookTheme.R

In topepo/AppliedPredictiveModeling: Functions and Data Sets for 'Applied Predictive Modeling'

#' Lattice Themes
#' 
#' Two \pkg{lattice} themes used throughout the book.
#' 
#' When using these functions to save a plot, make sure to invoke them after
#' the device has been opened (e.g. after calls such as \code{pdf()}.
#' 
#' @aliases bookTheme transparentTheme
#' @param set a logical: should these settings be applied to the current
#' device?
#' @param pchSize the size of the plot symbols
#' @param trans the amount of transparency (via the alpha channel). Note that
#' transparency is not supported by all graphics devices.
#' @return Each function returns a list of theme parameters. See Sarkar (2008)
#' or \code{\link[lattice]{trellis.par.get}} for specific details.
#' @author Max Kuhn
#' @references Some of the colors are based on values from ColorBrewer
#' \url{http://www.colorbrewer.org}.
#' 
#' Sarkar, D. (2008). Lattice: Multivariate Data Visualization with R. UseR!
#' (1st ed. p. 286). Springer.
#' @keywords hplot
#' @examples
#' 
#' library(lattice)
#' 
#' example <- quadBoundaryFunc(100)
#' 
#' bookTheme(set = TRUE)
#' xyplot(X2 ~ X1, data = example, groups = class, auto.key = TRUE)
#' 
#' transparentTheme(set = TRUE, trans = .6)
#' xyplot(X2 ~ X1, data = example, groups = class, auto.key = TRUE)
#' 
#' @export bookTheme
bookTheme <- function(set = TRUE){
  theme <- list(
    plot.polygon = list(alpha = 1, col = "aliceblue", border = "black", lty = 1, lwd = 1),
    background = list(col = "transparent"), 
    bar.fill = list(col = "#cce6ff"), 
    box.rectangle = list(col = "black"), 
    box.umbrella = list(col = "black"), 
    dot.line = list(col = "#e8e8e8"), 
    dot.symbol = list(col = "black"), 
    plot.line = list(col = "black", lwd = 1, lty = 1), 
    plot.symbol = list(col = "black", pch = 16), 
    regions = list(col = 
                     c("#FEF8FA", "#FDF6F9", "#FBF5F9", "#FAF3F8", 
                       "#F8F2F7", "#F7F0F7", "#F5EEF6", "#F4EDF5", 
                       "#F2EBF5", "#F1EAF4", "#EFE8F3", "#EDE7F2", 
                       "#ECE5F1", "#EAE4F1", "#E8E2F0", "#E6E1EF", 
                       "#E4DFEE", "#E2DEED", "#E0DCEC", "#DEDAEB", 
                       "#DCD9EA", "#D9D7E9", "#D7D6E8", "#D4D4E7", 
                       "#D1D2E6", "#CED1E5", "#CCCFE4", "#C8CEE3",
                       "#C5CCE2", "#C2CAE1", "#BFC9E0", "#BBC7DF", 
                       "#B8C5DF", "#B4C4DE", "#B1C2DD", "#ADC0DC", 
                       "#A9BFDB", "#A6BDDA", "#A2BBD9", "#9EB9D9", 
                       "#9BB8D8", "#97B6D7", "#93B4D6", "#8FB2D5", 
                       "#8BB0D4", "#87AFD3", "#83ADD2", "#7FABD1", 
                       "#7AA9D0", "#76A7CF", "#71A5CE", "#6CA3CC", 
                       "#68A1CB", "#63A0CA", "#5D9EC9", "#589CC8",
                       "#539AC6", "#4E98C5", "#4996C4", "#4493C3", 
                       "#3F91C1", "#3A8FC0", "#358DBF", "#308BBE", 
                       "#2C89BD", "#2887BC", "#2385BB", "#1F83BA", 
                       "#1C80B9", "#187EB7", "#157CB6", "#127AB5", 
                       "#0F78B3", "#0D76B2", "#0A73B0", "#0971AE", 
                       "#076FAC", "#066DAA", "#056AA7", "#0568A5")
    ), 
    strip.shingle = list(col = c(
      "#ff7f00", "#00ff00", "#00ffff",
      "#ff00ff", "#ff0000", "#ffff00", "#0080ff")
    ), 
    strip.background = list(col = c(
      "#ffe5cc", "#ccffcc", "#ccffff",
      "#ffccff", "#ffcccc", "#ffffcc", "#cce6ff")
    ), 
    reference.line = list(col = "#e8e8e8"), 
    superpose.line = list(
      col = c(
        "#053061", "#B2182B", "#F46D43", "#5E4FA2", "#66C2A5", "black", 
        "#053061", "#B2182B", "#F46D43", "#5E4FA2", "#66C2A5", "black", 
        "#053061", "#B2182B", "#F46D43", "#5E4FA2", "#66C2A5", "black",
        "#053061", "#B2182B", "#F46D43", "#5E4FA2", "#66C2A5", "black", 
        "#053061", "#B2182B", "#F46D43", "#5E4FA2", "#66C2A5", "black", 
        "#053061", "#B2182B", "#F46D43", "#5E4FA2", "#66C2A5", "black"
      ), 
      lty = rep(1:6, each = 6)), 
    superpose.symbol = list(
      pch = c(
        1, 4, 6, 0, 5, 17,
        4, 6, 0, 5, 17, 1,
        6, 0, 5, 17, 1, 4,
        0, 5, 17, 1, 4, 6,
        5, 17, 1, 4, 6, 0 ,
        17, 1, 4, 6, 0, 5), 
      cex = rep(0.7,  6 * 6), 
      col = c(
        "#053061", "#B2182B", "#F46D43", "#5E4FA2", "#66C2A5", "black", 
        "#053061", "#B2182B", "#F46D43", "#5E4FA2", "#66C2A5", "black", 
        "#053061", "#B2182B", "#F46D43", "#5E4FA2", "#66C2A5", "black",
        "#053061", "#B2182B", "#F46D43", "#5E4FA2", "#66C2A5", "black", 
        "#053061", "#B2182B", "#F46D43", "#5E4FA2", "#66C2A5", "black", 
        "#053061", "#B2182B", "#F46D43", "#5E4FA2", "#66C2A5", "black"
      )
    )
  )
  
  if(set) lattice::trellis.par.set(theme)
  invisible(theme)
}

#' @rdname bookTheme
#' @export
transparentTheme <-
  function(set = TRUE, pchSize = 1, trans = .2) {
    theme <- list(
      plot.polygon = list(alpha = 1, col = "aliceblue", border = "black", lty = 1, lwd = 1),
      background = list(col = "transparent"), 
      bar.fill = list(col = "#cce6ff"), 
      box.rectangle = list(col = "black"), 
      box.umbrella = list(col = "black"), 
      dot.line = list(col = "#e8e8e8"), 
      dot.symbol = list(col = "black"), 
      plot.line = list(col = "black"), 
      plot.symbol = list(col = "black"), 
      regions = list(col = 
                       c("#FEF8FA", "#FDF6F9", "#FBF5F9", "#FAF3F8", 
                         "#F8F2F7", "#F7F0F7", "#F5EEF6", "#F4EDF5", 
                         "#F2EBF5", "#F1EAF4", "#EFE8F3", "#EDE7F2", 
                         "#ECE5F1", "#EAE4F1", "#E8E2F0", "#E6E1EF", 
                         "#E4DFEE", "#E2DEED", "#E0DCEC", "#DEDAEB", 
                         "#DCD9EA", "#D9D7E9", "#D7D6E8", "#D4D4E7", 
                         "#D1D2E6", "#CED1E5", "#CCCFE4", "#C8CEE3",
                         "#C5CCE2", "#C2CAE1", "#BFC9E0", "#BBC7DF", 
                         "#B8C5DF", "#B4C4DE", "#B1C2DD", "#ADC0DC", 
                         "#A9BFDB", "#A6BDDA", "#A2BBD9", "#9EB9D9", 
                         "#9BB8D8", "#97B6D7", "#93B4D6", "#8FB2D5", 
                         "#8BB0D4", "#87AFD3", "#83ADD2", "#7FABD1", 
                         "#7AA9D0", "#76A7CF", "#71A5CE", "#6CA3CC", 
                         "#68A1CB", "#63A0CA", "#5D9EC9", "#589CC8",
                         "#539AC6", "#4E98C5", "#4996C4", "#4493C3", 
                         "#3F91C1", "#3A8FC0", "#358DBF", "#308BBE", 
                         "#2C89BD", "#2887BC", "#2385BB", "#1F83BA", 
                         "#1C80B9", "#187EB7", "#157CB6", "#127AB5", 
                         "#0F78B3", "#0D76B2", "#0A73B0", "#0971AE", 
                         "#076FAC", "#066DAA", "#056AA7", "#0568A5")
      ), 
      strip.shingle = list(col = c(
        "#ff7f00", "#00ff00", "#00ffff",
        "#ff00ff", "#ff0000", "#ffff00", "#0080ff")), 
      strip.background = list(col = c(
        "#ffe5cc", "#ccffcc", "#ccffff",
        "#ffccff", "#ffcccc", "#ffffcc", "#cce6ff")), 
      reference.line = list(col = "#e8e8e8"), 
      superpose.line = list(
        col = c(
          grDevices::rgb(1, 0, 0, trans), grDevices::rgb(0, 0, 1, trans),
          grDevices::rgb(0.3984375, 0.7578125, 0.6445312, max(.6, trans)),
          grDevices::rgb(0, 0, 0, trans)), 
        lty = rep(1:2, 6)), 
      superpose.symbol = list(
        pch = c(16, 15, 17, 18, 16), 
        cex = rep(pchSize,  5), 
        col = c(
          grDevices::rgb(1, 0, 0, trans), grDevices::rgb(0, 0, 1, trans),
          grDevices::rgb(0.3984375, 0.7578125, 0.6445312, max(.6, trans)),
          grDevices::rgb(0, 0, 0, trans)))
    )
    
    if(set) lattice::trellis.par.set(theme, warn = FALSE)
    invisible(theme)
  }