## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.align = "center",
  fig.width = 7,
  fig.height = 4.5,
  dpi = 96,
  out.width = "100%"
)

library(NDPalette)

# This vignette is a ggplot2 demonstration. If ggplot2 is not installed,
# the figures are skipped rather than raising an error.
has_ggplot2 <- requireNamespace("ggplot2", quietly = TRUE)
if (has_ggplot2) {
  library(ggplot2)
  # Pair the brand colors with a light built-in theme throughout (see the
  # "Pairing with a light theme" section below).
  theme_set(theme_minimal(base_size = 12))
}
knitr::opts_chunk$set(eval = has_ggplot2)

## ----load, eval = TRUE--------------------------------------------------------
library(NDPalette)

## ----qs-ggplot, fig.height = 3.3----------------------------------------------
ggplot(iris, aes(Sepal.Length, Petal.Length, color = Species)) +
  geom_point(size = 2) +
  scale_color_nd()                      # one line; the colors are chosen for you

## ----qs-base, eval = TRUE, fig.height = 3.6-----------------------------------
palette(nd_palette(8))                  # base R now draws in Notre Dame colors
plot(Petal.Length ~ Sepal.Length, data = iris, col = Species, pch = 19)
palette("default")                      # restore base R's palette when done

## ----full, eval = TRUE, fig.height = 1.8, fig.width = 9-----------------------
show_palette()

## ----named-card, fig.height = 5, fig.width = 6.5------------------------------
pal   <- nd_palette()                            # the thirteen data colors
named <- nd_colors[match(pal, nd_colors$hex), ]  # matched to their catalog names
named$pos <- rev(seq_len(nrow(named)))

ggplot(named, aes(x = 0, y = pos)) +
  geom_tile(aes(fill = hex), width = 0.5, height = 0.82) +
  geom_text(aes(x = 0.32, label = paste0(name, "  (", hex, ")")),
            hjust = 0, size = 3.1) +
  scale_fill_identity() +
  coord_cartesian(xlim = c(-0.3, 4), clip = "off") +
  labs(x = NULL, y = NULL) +
  theme_void()

## ----named-swatch, eval = TRUE, fig.height = 1.8, fig.width = 9---------------
show_palette(nd_palette(), labels = named$name)

## ----anchors, eval = TRUE-----------------------------------------------------
nd_palettes$nd

## ----small-requests, eval = TRUE----------------------------------------------
nd_palette(2)
nd_palette(5)

## ----ladder, fig.height = 5---------------------------------------------------
ladder <- do.call(rbind, lapply(1:10, function(k) {
  data.frame(n = k, position = seq_len(k), hex = nd_palette(k))
}))
ladder$n <- factor(ladder$n, levels = 10:1)

ggplot(ladder, aes(position, n, fill = hex)) +
  geom_tile(color = "white", linewidth = 1.2) +
  scale_fill_identity() +
  scale_x_continuous(breaks = 1:10, position = "top") +
  coord_equal() +
  labs(x = "color position", y = "number of groups (n)") +
  theme(panel.grid = element_blank())

## ----facets, fig.height = 4.5-------------------------------------------------
bars <- do.call(rbind, lapply(1:10, function(k) {
  data.frame(n = k, position = seq_len(k))
}))
bars$value <- 2 + sin(bars$position)
bars$group <- factor(bars$position, levels = 1:10)
bars$panel <- factor(paste0("n = ", bars$n), levels = paste0("n = ", 1:10))

ggplot(bars, aes(group, value, fill = group)) +
  geom_col(width = 0.85) +
  facet_wrap(~ panel, nrow = 2, scales = "free_x") +
  scale_fill_nd() +
  labs(x = NULL, y = NULL) +
  theme(legend.position = "none",
        axis.text = element_blank(),
        panel.grid = element_blank())

## ----iris, fig.height = 4.5---------------------------------------------------
ggplot(iris, aes(Sepal.Length, Petal.Length, color = Species)) +
  geom_point(size = 2.5, alpha = 0.9) +
  scale_color_nd() +
  labs(title = "Three groups", x = "sepal length", y = "petal length",
       color = "species")

## ----mtcars, fig.height = 4.5-------------------------------------------------
ggplot(mtcars, aes(factor(cyl), fill = factor(cyl))) +
  geom_bar(width = 0.7) +
  scale_fill_nd() +
  labs(title = "Three groups", x = "cylinders", y = "count",
       fill = "cylinders")

## ----diamonds, fig.height = 4.5-----------------------------------------------
ggplot(diamonds, aes(cut, fill = cut)) +
  geom_bar() +
  scale_fill_nd() +
  labs(title = "Five groups", x = "cut", y = "count") +
  theme(legend.position = "none")

## ----sprays, fig.height = 4.5-------------------------------------------------
ggplot(InsectSprays, aes(spray, count, fill = spray)) +
  geom_boxplot() +
  scale_fill_nd() +
  labs(title = "Six groups", x = "spray", y = "count") +
  theme(legend.position = "none")

## ----reverse, fig.height = 4.5------------------------------------------------
ggplot(mtcars, aes(factor(cyl), fill = factor(cyl))) +
  geom_bar(width = 0.7) +
  scale_fill_nd(reverse = TRUE) +
  labs(x = "cylinders", y = "count", fill = "cylinders") +
  theme(legend.position = "none")

## ----lines, fig.height = 4.5--------------------------------------------------
ggplot(Orange, aes(age, circumference, color = Tree)) +
  geom_line(linewidth = 1) +
  geom_point(size = 2) +
  scale_color_nd() +
  labs(title = "Five series, as lines", x = "age (days)",
       y = "trunk circumference (mm)", color = "tree")

## ----grouped-bars, fig.height = 4.5-------------------------------------------
ggplot(warpbreaks, aes(tension, breaks, fill = wool)) +
  geom_bar(stat = "summary", fun = "mean", position = "dodge",
           width = 0.7) +
  scale_fill_nd() +
  labs(title = "Grouped bars", x = "tension", y = "mean breaks",
       fill = "wool")

## ----density, fig.height = 4.5------------------------------------------------
ggplot(ToothGrowth, aes(len, fill = factor(dose))) +
  geom_density(alpha = 0.6) +
  scale_fill_nd() +
  labs(title = "Overlapping densities", x = "tooth length", y = "density",
       fill = "dose")

## ----fitted-lines, fig.height = 4.5-------------------------------------------
ggplot(ChickWeight, aes(Time, weight, color = Diet)) +
  geom_point(size = 1.6, alpha = 0.5) +
  geom_smooth(method = "lm", formula = y ~ x, se = FALSE) +
  scale_color_nd() +
  labs(title = "Fitted lines by group", x = "time (days)",
       y = "weight (g)", color = "diet")

## ----stacked-fill, fig.height = 4.5-------------------------------------------
titanic <- aggregate(Freq ~ Sex + Class, data = as.data.frame(Titanic),
                     FUN = sum)
ggplot(titanic, aes(Sex, Freq, fill = Class)) +
  geom_col(position = "fill") +
  scale_fill_nd() +
  labs(title = "Stacked proportions", x = NULL, y = "proportion",
       fill = "passenger class")

## ----lollipop, fig.height = 4.5-----------------------------------------------
chick <- aggregate(weight ~ Diet, data = ChickWeight, FUN = mean)
ggplot(chick, aes(Diet, weight, color = Diet)) +
  geom_segment(aes(xend = Diet, yend = 0), linewidth = 1.5) +
  geom_point(size = 6) +
  scale_color_nd() +
  labs(title = "A lollipop chart", x = "diet", y = "mean weight (g)") +
  theme(legend.position = "none")

## ----polar, fig.height = 4.6, fig.width = 5-----------------------------------
ggplot(diamonds, aes(cut, fill = cut)) +
  geom_bar(width = 1, color = "white") +
  scale_fill_nd() +
  coord_polar() +
  labs(title = "A radial bar chart", x = NULL, y = NULL, fill = "cut") +
  theme_minimal(base_size = 12)

## ----base-palette, eval = TRUE, fig.height = 4--------------------------------
palette(nd_palette(6))                 # base R now draws in Notre Dame colors
boxplot(count ~ spray, data = InsectSprays, col = 1:6, border = "grey30",
        main = "Six groups, base R", xlab = "spray", ylab = "count")
palette("default")                     # restore when done

## ----base-barplot, eval = TRUE, fig.height = 4--------------------------------
barplot(table(mtcars$cyl), col = nd_palette(3), border = NA,
        main = "Three groups, base R", xlab = "cylinders", ylab = "count")

## ----base-image, eval = TRUE, fig.height = 4.2, fig.width = 5-----------------
ramp <- grDevices::colorRampPalette(c(nd_tints[["light_sky_blue"]],
                                      nd_color("bright_blue"),
                                      nd_color("navy")))(20)
image(volcano, col = ramp, axes = FALSE, main = "Maungawhau elevation")

## ----base-bg, eval = TRUE, fig.height = 6.5, fig.width = 8--------------------
panel <- function(bg, col, lab) {
  plot(mpg ~ wt, data = mtcars, type = "n", main = lab,
       xlab = "weight (1000 lbs)", ylab = "mpg")
  rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4],
       col = bg, border = NA)                  # the tint, shown per panel
  points(mtcars$wt, mtcars$mpg, pch = 19, col = col)
  box()
}
op <- par(mfrow = c(2, 2), mar = c(4, 4, 2, 1))
panel(nd_informal_tints[["soft_white"]],       nd_color("navy"),        "soft white + navy")
panel(nd_informal_tints[["soft_yellow"]],      nd_color("navy"),        "soft yellow + navy")
panel(nd_informal_tints[["soft_yellow_warm"]], nd_color("navy"),        "soft yellow, warm (gold) + navy")
panel(nd_informal_tints[["soft_white"]],       nd_color("bright_blue"), "soft white + bright blue")
par(op)

## ----corr-heatmap, fig.height = 4.6, fig.width = 5.4--------------------------
set.seed(113)
f     <- rnorm(250)                                    # the latent construct
load  <- 0.65                                          # common loading
items <- sapply(1:6, function(j) load * f + rnorm(250, sd = sqrt(1 - load^2)))
colnames(items) <- paste0("i", 1:6)

R <- cor(items)
dfR <- as.data.frame(as.table(R))
names(dfR) <- c("row", "col", "r")
dfR$txt <- ifelse(dfR$r > 0.5, "white", nd_color("navy"))

heat <- grDevices::colorRampPalette(
  c(nd_tints[["light_sky_blue"]], nd_palette(1)))(100)

ggplot(dfR, aes(col, row, fill = r)) +
  geom_tile(color = "white") +
  geom_text(aes(label = sprintf("%.2f", r), color = txt), size = 3) +
  scale_fill_gradientn(colors = heat, limits = c(0, 1)) +
  scale_color_identity() +
  coord_equal() +
  labs(title = "Item intercorrelations", x = NULL, y = NULL, fill = "r")

## ----corr-diverging, fig.height = 4.8, fig.width = 5.8------------------------
vars <- c("mpg", "cyl", "disp", "hp", "drat", "wt")
Rm   <- cor(mtcars[, vars])
dfm  <- as.data.frame(as.table(Rm)); names(dfm) <- c("row", "col", "r")
dfm$txt <- ifelse(dfm$r < -0.5, "white", nd_color("navy"))

diverging <- grDevices::colorRampPalette(
  c(nd_color("navy"), nd_tints[["light_warm_white"]], nd_color("bright_gold")))(100)

ggplot(dfm, aes(col, row, fill = r)) +
  geom_tile(color = "white") +
  geom_text(aes(label = sprintf("%.2f", r), color = txt), size = 3) +
  scale_fill_gradientn(colors = diverging, limits = c(-1, 1)) +
  scale_color_identity() +
  coord_equal() +
  labs(title = "mtcars correlations (diverging ramp)", x = NULL, y = NULL,
       fill = "r")

## ----factor-loadings, fig.height = 4.4, fig.width = 7-------------------------
loadings <- rbind(
  data.frame(item = paste0("Item ", 1:8), factor = "Verbal",
             loading = c(.74, .69, .78, .81, .22, .15, .09, .25)),
  data.frame(item = paste0("Item ", 1:8), factor = "Quantitative",
             loading = c(.18, .12, .24, .07, .71, .79, .66, .80)))
loadings$item <- factor(loadings$item, levels = paste0("Item ", 8:1))

ggplot(loadings, aes(loading, item, fill = factor)) +
  geom_col(position = "dodge", width = 0.7) +
  scale_fill_nd() +
  labs(title = "Standardized factor loadings", x = "loading", y = NULL,
       fill = "factor")

## ----item-curves, fig.height = 4.4, fig.width = 7-----------------------------
theta <- seq(-4, 4, length.out = 200)
pars  <- data.frame(item = paste0("Item ", 1:5),
                    a = c(1.2, 0.8, 1.6, 1.0, 1.9),     # discriminations
                    b = c(-1.5, -0.6, 0.1, 0.8, 1.7))   # difficulties
icc <- do.call(rbind, lapply(seq_len(nrow(pars)), function(i) {
  data.frame(theta = theta, item = pars$item[i],
             p = plogis(pars$a[i] * (theta - pars$b[i])))
}))

ggplot(icc, aes(theta, p, color = item)) +
  geom_line(linewidth = 1) +
  scale_color_nd() +
  labs(title = "Item characteristic curves (2PL)",
       x = expression(theta), y = "probability of a correct response",
       color = "item")

## ----colors-table, eval = TRUE------------------------------------------------
nd_colors

## ----color-by-name, eval = TRUE-----------------------------------------------
nd_color("navy", "green")        # two colors by name
nd_color(role = "former")        # a whole role group

## ----color-manual, fig.height = 4.5-------------------------------------------
ggplot(iris, aes(Sepal.Length, Petal.Length, color = Species)) +
  geom_point(size = 2.5, alpha = 0.9) +
  scale_color_manual(values = nd_color("navy", "bright_gold", "green")) +
  labs(title = "Picked by name", x = "sepal length", y = "petal length",
       color = "species")

## ----colors-athletics, eval = TRUE--------------------------------------------
nd_colors[nd_colors$brand == "athletics", c("name", "hex", "pms")]

## ----non-nd-defs, eval = TRUE-------------------------------------------------
st_louis_blues <- "#2c5196"   # St. Louis Blues blue
irish_flag     <- "#009900"   # Irish flag green
dark_goldenrod <- "#b8860b"   # darkgoldenrod

## ----non-nd-ggplot, fig.height = 4.2------------------------------------------
values <- c("setosa"     = nd_color("navy"),
            "versicolor" = nd_color("bright_gold"),
            "virginica"  = st_louis_blues)        # the non-ND color
ggplot(iris, aes(Sepal.Length, Petal.Length, color = Species)) +
  geom_point(size = 2.5) +
  scale_color_manual(values = values) +
  labs(title = "Two Notre Dame colors plus one from outside the palette",
       x = "sepal length", y = "petal length", color = "species")

## ----non-nd-base, eval = TRUE, fig.height = 4---------------------------------
cols <- c(nd_palette(2), irish_flag)              # navy, bright gold, Irish green
barplot(c(8, 6, 9), col = cols, border = NA, names.arg = c("A", "B", "C"),
        main = "Notre Dame palette plus one outside color")

## ----former-desc, eval = TRUE-------------------------------------------------
nd_colors[nd_colors$role == "former", c("name", "hex", "description")]

## ----former-swatch, eval = TRUE, fig.height = 1.6, fig.width = 8--------------
nd_palette(palette = "former")
show_palette(nd_palette(palette = "former"))

## ----former-plot, fig.height = 4.5--------------------------------------------
ggplot(InsectSprays, aes(spray, count, fill = spray)) +
  geom_boxplot() +
  scale_fill_manual(values = nd_palette(palette = "former")) +
  labs(title = "Former Notre Dame palette", x = "spray", y = "count") +
  theme(legend.position = "none")

## ----cvd-swatch, eval = TRUE, fig.height = 1.6, fig.width = 8-----------------
show_palette(nd_palette(palette = "nd_cvd"))

## ----cvd-plot, fig.height = 4.5-----------------------------------------------
ggplot(iris, aes(Sepal.Length, Petal.Length, color = Species)) +
  geom_point(size = 2.5) +
  scale_color_nd(palette = "nd_cvd") +
  labs(title = "Colorblind-friendly Notre Dame colors", x = "sepal length",
       y = "petal length", color = "species")

## ----cvd-sim, eval = requireNamespace("colorspace", quietly = TRUE), fig.height = 3.2, fig.width = 8----
cvd8 <- nd_palette(8, palette = "nd_cvd")
rows <- list("normal vision" = cvd8,
             deuteranopia     = colorspace::deutan(cvd8),
             protanopia       = colorspace::protan(cvd8),
             tritanopia       = colorspace::tritan(cvd8))
op <- par(mfrow = c(4, 1), mar = c(0.3, 6.5, 0.3, 0.3))
for (nm in names(rows)) {
  plot(NA, xlim = c(0, 8), ylim = c(0, 1), axes = FALSE, xlab = "", ylab = "",
       xaxs = "i", yaxs = "i")
  rect(0:7, 0, 1:8, 1, col = rows[[nm]], border = "white")
  mtext(nm, side = 2, las = 1, line = 0.5, cex = 0.85)
}
par(op)

## ----tints, eval = TRUE-------------------------------------------------------
nd_tints

## ----tint-bg, fig.height = 4.5------------------------------------------------
ggplot(mtcars, aes(wt, mpg)) +
  geom_point(color = nd_palette(1), size = 2.5) +
  labs(title = "A tint as a panel background", x = "weight", y = "mpg") +
  theme(panel.background = element_rect(fill = nd_tints[["light_sky_blue"]],
                                        color = NA))

## ----warm-white-bg, fig.height = 4.5------------------------------------------
ggplot(mtcars, aes(wt, mpg)) +
  geom_point(color = nd_palette(1), size = 2.5) +
  labs(title = "Warm White as a full background", x = "weight", y = "mpg") +
  theme(
    panel.background = element_rect(fill = nd_tints[["warm_white"]],
                                    color = NA),
    plot.background  = element_rect(fill = nd_tints[["warm_white"]],
                                    color = NA)
  )

## ----informal-tints, eval = TRUE----------------------------------------------
nd_informal_tints

## ----informal-swatch, eval = TRUE, fig.height = 1.5, fig.width = 9------------
show_palette(nd_informal_tints, labels = names(nd_informal_tints),
             border = "grey80")

## ----soft-bg, fig.height = 4.5------------------------------------------------
ggplot(mtcars, aes(wt, mpg)) +
  geom_point(color = nd_palette(1), size = 2.5) +
  labs(title = "An informal soft-white background", x = "weight", y = "mpg") +
  theme(
    panel.background = element_rect(fill = nd_informal_tints[["soft_white"]],
                                    color = NA),
    plot.background  = element_rect(fill = nd_informal_tints[["soft_white"]],
                                    color = NA)
  )

## ----ramp, eval = TRUE, fig.height = 1.6, fig.width = 8-----------------------
ramp <- grDevices::colorRampPalette(
  c(nd_tints[["light_sky_blue"]], nd_color("bright_blue"), nd_color("navy")))(7)
show_palette(ramp)

## ----ramp-plot, fig.height = 4.5----------------------------------------------
ggplot(faithfuld, aes(waiting, eruptions, fill = density)) +
  geom_raster() +
  scale_fill_gradientn(colors = ramp) +
  labs(title = "Old Faithful eruption density", x = "waiting", y = "eruptions")

## ----diverging-ramp, eval = TRUE, fig.height = 1.6, fig.width = 9-------------
diverging <- grDevices::colorRampPalette(
  c(nd_color("navy"), nd_tints[["light_warm_white"]], nd_color("bright_gold")))(11)
show_palette(diverging)

## ----theme-light, fig.height = 4.5--------------------------------------------
ggplot(iris, aes(Sepal.Length, Petal.Length, color = Species)) +
  geom_point(size = 2.5) +
  scale_color_nd() +
  labs(x = "sepal length", y = "petal length", color = "species") +
  theme_light(base_size = 12)

## ----fonts, eval = FALSE------------------------------------------------------
# # install.packages(c("showtext", "sysfonts"))
# library(showtext)
# sysfonts::font_add_google("Montserrat", "nd_sans")  # geometric sans
# sysfonts::font_add_google("Zilla Slab", "nd_slab")  # slab serif
# showtext_auto()
# 
# ggplot(iris, aes(Sepal.Length, Petal.Length, color = Species)) +
#   geom_point(size = 2.5) +
#   scale_color_nd() +
#   labs(title = "Notre Dame colors with a free, ND-evoking font",
#        x = "sepal length", y = "petal length", color = "species") +
#   theme_minimal(base_family = "nd_sans") +
#   theme(plot.title = element_text(family = "nd_slab", face = "bold"))