## -----------------------------------------------------------------------------
#| label: setup
#| include: false
r_libs <- Sys.getenv("R_LIBS")
if (nzchar(r_libs)) {
  libs <- strsplit(r_libs, .Platform$path.sep, fixed = TRUE)[[1]]
  libs <- libs[nzchar(libs)]
  .libPaths(c(libs, .libPaths()))
}
library(plotbb)
library(aplot)
library(dplyr)


## ----plotbb-minimal-----------------------------------------------------------
p <- bbplot(mtcars, bb_aes(mpg, disp))
p + bb_point(pch = 19)


## ----plotbb-mapping-----------------------------------------------------------
bbplot(mtcars, bb_aes(mpg, log(disp), col = factor(cyl))) +
  bb_point(pch = 19)


## ----plotbb-mapping-env-------------------------------------------------------
highlight <- 300
bbplot(mtcars, bb_aes(mpg, disp, col = disp > highlight)) +
  bb_point(pch = 19)


## ----plotbb-override----------------------------------------------------------
p <- bbplot(mtcars, bb_aes(mpg, disp, col = factor(cyl)))

a <- p + bb_point(pch = 19)                                  # inherit everything
b <- p + bb_point(bb_aes(col = factor(am)), pch = 19)        # override col only
c <- p + bb_point(bb_aes(mpg, disp), inherit = FALSE, pch = 19)  # no inheritance

plot_list(a, b, c, ncol = 3, tag_levels = "A")


## ----plotbb-layer-data--------------------------------------------------------
means <- mtcars |>
  group_by(cyl) |>
  summarise(mpg = mean(mpg), disp = mean(disp), .groups = "drop")

bbplot(mtcars, bb_aes(mpg, disp)) +
  bb_point(pch = 19, col = "grey60") +
  bb_point(bb_aes(mpg, disp), data = means, col = "firebrick", pch = 17, cex = 2)


## ----plotbb-inherit-false-----------------------------------------------------
#| error: true
try({
p + bb_point(bb_aes(col = factor(am)), inherit = FALSE)
})


## ----plotbb-constant----------------------------------------------------------
pal <- c(`4` = "#1b9e77", `6` = "#d95f02", `8` = "#7570b3")

mapped <- p + bb_point(pch = 19) + bb_scale_col_manual(pal)
constant <- p + bb_point(pch = 19, col = "firebrick") + bb_scale_col_manual(pal)

plot_list(mapped, constant, ncol = 2, tag_levels = "A")


## ----plotbb-constant-wins-----------------------------------------------------
p + bb_point(pch = 19, col = "tomato")


## ----plotbb-constant-length---------------------------------------------------
#| error: true
try({
p + bb_point(col = c("red", "blue"))
})


## ----plotbb-constant-aligned--------------------------------------------------
d <- data.frame(x = c(1, NA, 3), y = c(1, 2, 3))
bbplot(d, bb_aes(x, y)) +
  bb_point(col = c("red", "green", "blue"), pch = 19, cex = 2)


## ----plotbb-order-------------------------------------------------------------
points_then_fit <- bbplot(mtcars, bb_aes(mpg, disp)) +
  bb_point(pch = 19, col = "grey50") +
  bb_lm(col = "firebrick", lwd = 2)

fit_then_points <- bbplot(mtcars, bb_aes(mpg, disp)) +
  bb_lm(col = "firebrick", lwd = 2) +
  bb_point(pch = 19, col = "grey50")

plot_list(points_then_fit, fit_then_points, ncol = 2, tag_levels = "A")


## ----plotbb-components--------------------------------------------------------
p +
  bb_grid(col = "grey85", lty = "dashed") +
  bb_point(pch = 19) +
  bb_labs(title = "mtcars", sub = "displacement versus mileage",
          xlab = "miles per gallon", ylab = "displacement") +
  bb_theme_minimal()


## ----plotbb-theme-------------------------------------------------------------
a <- p + bb_point(pch = 19) + bb_theme(bg = "lemonchiffon", mar = c(4, 4, 3, 1)) +
  bb_title("bb_theme()")
b <- p + bb_point(pch = 19) + bb_title("untouched device")
plot_list(a, b, ncol = 2, tag_levels = "A")


## ----plotbb-theme-presets-----------------------------------------------------
a <- p + bb_point(pch = 19, cex = 1.6) + bb_theme_expand() + bb_theme_deepblue() +
  bb_title("bb_theme_deepblue()")
b <- p + bb_point(pch = 19) + bb_theme_minimal() + bb_title("bb_theme_minimal()")
c <- p + bb_point(pch = 19) + bb_theme_bw() + bb_title("bb_theme_bw()")
d <- p + bb_point(pch = 19) + bb_theme_grey() + bb_title("bb_theme_grey()")
plot_list(a, b, c, d, ncol = 2, tag_levels = "A")


## ----plotbb-with-theme--------------------------------------------------------
with_bb_theme(bb_theme_deepblue(), {
  bbplot(mtcars, bb_aes(mpg, disp)) + bb_point(pch = 19, cex = 1.6)
})


## ----plotbb-scale-manual------------------------------------------------------
pal <- c(`4` = "#1b9e77", `6` = "#d95f02", `8` = "#7570b3")
p + bb_point(pch = 19) + bb_scale_col_manual(pal) + bb_legend()


## ----plotbb-scale-limits------------------------------------------------------
p + bb_point(pch = 19) +
  bb_scale_col_manual(pal, limits = c("4", "6")) +
  bb_legend()


## ----plotbb-scale-gradient----------------------------------------------------
bbplot(mtcars, bb_aes(mpg, disp, col = hp)) +
  bb_point(pch = 19) +
  bb_scale_col_gradient(low = "grey85", high = "firebrick") +
  bb_legend(title = "horsepower")


## ----plotbb-scale-breaks------------------------------------------------------
bbplot(mtcars, bb_aes(mpg, disp, col = hp)) +
  bb_point(pch = 19) +
  bb_scale_col_gradient(low = "grey85", high = "firebrick",
                        breaks = c(100, 200, 300),
                        labels = c("low", "mid", "high")) +
  bb_legend(title = "horsepower", orientation = "horizontal",
            position = "bottomright")


## ----plotbb-scale-fill--------------------------------------------------------
bbplot(mtcars, bb_aes(factor(cyl), mpg, fill = factor(cyl))) +
  bb_density(alpha = 0.5) +
  bb_scale_fill_manual(c(`4` = "#1b9e77", `6` = "#d95f02", `8` = "#7570b3")) +
  bb_legend(aesthetic = "fill")


## ----plotbb-scale-aes---------------------------------------------------------
a <- bbplot(mtcars, bb_aes(mpg, disp, col = factor(cyl), pch = factor(gear), cex = hp)) +
  bb_point() +
  bb_scale_cex_continuous(range = c(0.8, 2)) +
  bb_legend(aesthetic = "col", position = "topleft") +
  bb_legend(aesthetic = "pch", position = "bottomleft")

b <- bbplot(mtcars, bb_aes(mpg, disp, group = gear, col = factor(gear))) +
  bb_lm(lwd = 2) +
  bb_scale_col_manual(c(`3` = "#1b9e77", `4` = "#d95f02", `5` = "#7570b3")) +
  bb_legend(position = "topleft")

plot_list(a, b, ncol = 2, tag_levels = "A")


## ----plotbb-scale-lty---------------------------------------------------------
bbplot(mtcars, bb_aes(mpg, disp, group = gear, lty = factor(gear))) +
  bb_lm(lwd = 2) +
  bb_scale_lty_manual(c(`3` = "solid", `4` = "dashed", `5` = "dotted")) +
  bb_legend(aesthetic = "lty", position = "topleft")


## ----plotbb-legend-outside----------------------------------------------------
p + bb_point(pch = 19) + bb_legend(aesthetic = "col", outside = TRUE)


## ----plotbb-legend-layer------------------------------------------------------
layer_data <- data.frame(
  x = 1:6, y = 1:6,
  g = factor(rep(c("a", "b"), 3)),
  h = factor(rep(c("u", "v", "w"), each = 2))
)
bbplot(layer_data, bb_aes(x, y, col = h)) +
  bb_point() +
  bb_line(bb_aes(group = g, col = g)) +
  bb_legend(layer = 2, title = "line grouping")


## ----plotbb-free-colour-------------------------------------------------------
free_data <- data.frame(
  x = 1:6, y = 1:6,
  panel = rep(c("a", "b"), each = 3),
  g = factor(c("u", "v", "u", "v", "w", "w"))
)
bbplot(free_data, bb_aes(x, y, col = g)) +
  bb_point() +
  bb_scale_col_manual(c(u = "red", v = "blue", w = "green")) +
  bb_facet_wrap(~panel, ncol = 2, free_colour = TRUE)


## ----plotbb-position----------------------------------------------------------
pos_data <- data.frame(x = 1:20, y = seq(1, 100, length.out = 20))
bbplot(pos_data, bb_aes(x, y)) +
  bb_point() +
  bb_scale_x_continuous(limits = c(5, 15),
                        breaks = c(5, 10, 15),
                        labels = c("low", "mid", "high")) +
  bb_scale_y_log10(limits = c(1, 100))


## ----plotbb-position-date-----------------------------------------------------
date_data <- data.frame(date = as.Date("2024-01-01") + 0:20,
                        value = 1:21)
bbplot(date_data, bb_aes(date, value)) +
  bb_point() +
  bb_scale_x_date(format = "%b %d")


## ----plotbb-coord-flip--------------------------------------------------------
bbplot(pos_data, bb_aes(x, y)) +
  bb_point() +
  bb_hline(50) +
  bb_coord_flip()


## ----plotbb-facet-------------------------------------------------------------
p + bb_point(pch = 19) + bb_facet_wrap(~cyl, ncol = 3)


## ----plotbb-facet-free--------------------------------------------------------
p + bb_point(pch = 19) + bb_facet_wrap(~am, ncol = 2, scales = "free_y")


## ----plotbb-facet-multi-------------------------------------------------------
p + bb_point(pch = 19) +
  bb_facet_wrap(~paste(cyl, am, sep = "/"), ncol = 2)


## ----plotbb-facet-drop--------------------------------------------------------
facet_data <- data.frame(
  x = 1:6, y = 1:6,
  f = factor(rep(c("a", "b"), each = 3), levels = c("a", "b", "c"))
)
bbplot(facet_data, bb_aes(x, y)) + bb_point() +
  bb_facet_wrap(~f, ncol = 3, drop = FALSE,
                labeller = function(key) paste("group", key),
                strip_width = 10)


## ----plotbb-facet-grid--------------------------------------------------------
bbplot(mtcars, bb_aes(mpg, disp)) + bb_point() +
  bb_facet_grid(rows = ~cyl, cols = ~am)


## ----plotbb-stat-layers-------------------------------------------------------
a <- bbplot(mtcars, bb_aes(factor(cyl), mpg)) + bb_boxplot(col = "grey90")
b <- bbplot(mtcars, bb_aes(mpg)) + bb_hist(col = "grey80", border = "white")
c <- bbplot(mtcars, bb_aes(mpg)) + bb_density(fill = "steelblue", alpha = 0.5)
d <- bbplot(mtcars, bb_aes(factor(cyl), mpg, fill = factor(cyl))) +
  bb_density(alpha = 0.5) + bb_legend(aesthetic = "fill")
plot_list(a, b, c, d, ncol = 2, tag_levels = "A")


## ----plotbb-signif------------------------------------------------------------
bbplot(mtcars, bb_aes(factor(cyl), mpg)) +
  bb_boxplot(col = "grey90") +
  bb_signif(comparisons = list(c("4", "6"), c("4", "8")))


## ----plotbb-violin------------------------------------------------------------
set.seed(7)
violin_data <- data.frame(
  group = factor(rep(c("a", "b", "c"), c(30, 25, 20))),
  value = c(rnorm(30), rnorm(25, 2), rnorm(20, 4))
)
bbplot(violin_data, bb_aes(group, value)) +
  bb_violin(fill = "steelblue", alpha = 0.5)


## ----plotbb-violin-horizontal-------------------------------------------------
bbplot(violin_data, bb_aes(value, group)) +
  bb_violin(orientation = "horizontal", fill = "steelblue", alpha = 0.5)


## ----plotbb-horizontal-stat---------------------------------------------------
a <- bbplot(mtcars, bb_aes(mpg, factor(cyl))) +
  bb_boxplot(orientation = "horizontal")
b <- bbplot(mtcars, bb_aes(factor(cyl))) +
  bb_bar(stat = "count", orientation = "horizontal")
c <- bbplot(mtcars, bb_aes(y = mpg)) +
  bb_density(orientation = "horizontal", fill = "steelblue", alpha = 0.5)
d <- bbplot(mtcars, bb_aes(y = mpg)) +
  bb_hist(orientation = "horizontal", col = "grey80", border = "white")
plot_list(a, b, c, d, ncol = 2, tag_levels = "A")


## ----plotbb-smooth------------------------------------------------------------
set.seed(8)
smooth_data <- data.frame(
  x = 1:60,
  y = sin((1:60) / 8) + rnorm(60, sd = 0.3),
  g = rep(c("a", "b"), each = 30)
)
bbplot(smooth_data, bb_aes(x = x, y = y, col = g)) +
  bb_point(pch = 19, cex = 0.6) +
  bb_smooth(method = "loess", se = TRUE, level = 0.95) +
  bb_legend(title = "group")


## ----plotbb-smooth-horizontal-------------------------------------------------
bbplot(smooth_data, bb_aes(y, x)) +
  bb_point(pch = 19, cex = 0.6) +
  bb_smooth(orientation = "horizontal", method = "loess", se = TRUE)


## ----plotbb-lm-errorbar-------------------------------------------------------
means <- mtcars |>
  group_by(cyl) |>
  summarise(x = cyl[1], y = mean(disp), sd = sd(disp), .groups = "drop")

a <- bbplot(means, bb_aes(x, y)) +
  bb_line(col = "grey50") +
  bb_point(pch = 19, cex = 1.5) +
  bb_errorbar(bb_aes(ymin = y - sd, ymax = y + sd), width = 0.8)

b <- bbplot(mtcars, bb_aes(mpg, disp, group = cyl, col = factor(cyl))) +
  bb_point() +
  bb_lm(lwd = 2, se = TRUE)

plot_list(a, b, ncol = 2, tag_levels = "A")


## ----plotbb-ribbon------------------------------------------------------------
fit <- lm(disp ~ mpg, data = mtcars)
grid <- data.frame(mpg = seq(min(mtcars$mpg), max(mtcars$mpg),
                             length.out = 50))
ci <- as.data.frame(predict(fit, newdata = grid, interval = "confidence"))
ci$mpg <- grid$mpg

bbplot(mtcars, bb_aes(mpg, disp)) +
  bb_ribbon(bb_aes(x = mpg, ymin = lwr, ymax = upr), data = ci,
            fill = "steelblue", alpha = 0.3) +
  bb_point(pch = 19, col = "grey40") +
  bb_lm(lwd = 1.5, se = FALSE, col = "firebrick")


## ----plotbb-ribbon-horizontal-------------------------------------------------
bbplot(ci, bb_aes(y = mpg, xmin = lwr, xmax = upr)) +
  bb_ribbon(orientation = "horizontal", fill = "steelblue", alpha = 0.3)


## ----plotbb-ribbon-groups-----------------------------------------------------
bands <- data.frame(
  x = rep(1:5, 2),
  lo = c(1, 2, 3, 4, 5, 2, 3, 4, 5, 6) - 0.4,
  hi = c(1, 2, 3, 4, 5, 2, 3, 4, 5, 6) + 0.4,
  g = factor(rep(c("a", "b"), each = 5))
)

bbplot(bands, bb_aes(x, fill = g)) +
  bb_ribbon(bb_aes(ymin = lo, ymax = hi), alpha = 0.3)


## ----plotbb-reference-lines---------------------------------------------------
thresholds <- data.frame(threshold = c(100, 300))

bbplot(mtcars, bb_aes(mpg, disp)) +
  bb_point(pch = 19, col = "grey40") +
  bb_hline(mapping = bb_aes(yintercept = threshold), data = thresholds,
           lty = 2, col = "steelblue") +
  bb_vline(20, col = "firebrick", lty = 3)


## ----plotbb-reference-expand--------------------------------------------------
bbplot(mtcars, bb_aes(mpg, disp)) +
  bb_point(pch = 19, col = "grey40") +
  bb_hline(500, col = "grey50", lty = 2, expand_limits = TRUE)


## ----plotbb-tile--------------------------------------------------------------
df <- expand.grid(x = 1:8, y = 1:6)
df$value <- with(df, x * y) + rnorm(nrow(df), sd = 3)

a <- bbplot(df, bb_aes(x, y, col = value)) + bb_tile() +
  bb_title("continuous mapping")
b <- bbplot(df, bb_aes(x, y, col = value)) +
  bb_tile() +
  bb_scale_col_palette("YlOrRd") +
  bb_title("with a palette")
c <- bbplot(df, bb_aes(x, y, col = value)) +
  bb_tile() +
  bb_text(bb_aes(label = round(value)), col = "black", cex = 0.7) +
  bb_theme_expand() +
  bb_title("with text labels")
plot_list(a, b, c, ncol = 3, tag_levels = "A")


## ----plotbb-custom-layer------------------------------------------------------
bbplot(mtcars, bb_aes(mpg, disp, col = factor(cyl))) +
  bb_layer(
    function(x, y, col, size = 1, ...) {
      graphics::points(x, y, col = col, pch = 19, cex = size)
      graphics::points(x, y, col = "black", pch = 1, cex = size)
    },
    size = 1.5,
    name = "hollow circles over points"
  ) +
  bb_legend()


## ----plotbb-custom-layer-limits-----------------------------------------------
low <- subset(mtcars, mpg < 20)
p_low <- bbplot(low, bb_aes(mpg, disp)) + bb_point(pch = 19)
p_low +
  bb_layer(
    function(x, y, ...) graphics::abline(h = min(y) - 50, col = "firebrick", lty = 2),
    limits = list(y = c(min(low$disp) - 50, max(low$disp)))
  )


## ----plotbb-escape------------------------------------------------------------
bbplot(mtcars, bb_aes(mpg, disp)) +
  bb_point(pch = 19) +
  (~abline(stats::lm(disp ~ mpg, data = mtcars), col = "firebrick", lwd = 2)) +
  (~text(30, 450, label = "base graphics still work", col = "steelblue"))


## ----plotbb-as-bbplot---------------------------------------------------------
draw_background <- function() {
  plot(mtcars$mpg, mtcars$disp, pch = 19, col = "grey75",
       xlab = "", ylab = "")
  abline(stats::lm(disp ~ mpg, data = mtcars), col = "firebrick")
}

as.bbplot(draw_background) +
  bb_lm(bb_aes(mpg, disp), data = mtcars, lwd = 2, se = FALSE,
        col = "steelblue") +
  bb_title("a base plot turned into a bbplot") +
  bb_theme_minimal()


## ----plotbb-third-party-------------------------------------------------------
bb_threshold <- function(value) {
  structure(list(value = value), class = "bb_threshold")
}

bbplot_add.bb_threshold <- function(object, plot) {
  plot + bb_layer(function(x, y, ...) {
    graphics::abline(h = object$value, lty = 2, col = "firebrick")
  })
}

p + bb_point(pch = 19) + bb_threshold(300)


## ----plotbb-custom-stat-------------------------------------------------------
bbplot(mtcars, bb_aes(factor(cyl), mpg)) +
  bb_layer(
    function(x, y, ...) {
      graphics::rect(0.5, min(y), 3.5, max(y), col = "grey95", border = NA)
      graphics::points(as.numeric(x), y, ...)
    },
    aesthetics = "fill",
    summary = TRUE,
    range = function(plot, data, mapping) {
      list(x = c(0.5, 3.5), y = range(data$mpg, na.rm = TRUE))
    }
  )


## ----plotbb-aplot, eval=FALSE-------------------------------------------------
# p1 <- bbplot(mtcars, bb_aes(mpg, disp)) + bb_point()
# p2 <- bbplot(mtcars, bb_aes(hp, wt)) + bb_point(col = "firebrick")
# aplot::plot_list(p1, p2)


## ----plotbb-workflow----------------------------------------------------------
means <- mtcars |>
  group_by(cyl) |>
  summarise(mpg = mean(mpg), disp = mean(disp), .groups = "drop")

bbplot(mtcars, bb_aes(mpg, disp, col = factor(cyl))) +
  bb_point(pch = 19, cex = 0.8) +
  bb_point(bb_aes(mpg, disp), data = means, pch = 17, cex = 2.2) +
  bb_lm(lwd = 1.5, se = FALSE) +
  bb_scale_col_manual(c(`4` = "#1b9e77", `6` = "#d95f02", `8` = "#7570b3")) +
  bb_legend(title = "cylinders") +
  bb_labs(title = "mtcars", xlab = "miles per gallon", ylab = "displacement") +
  bb_theme_minimal()


## ----plotbb-build-------------------------------------------------------------
built <- bb_build(
  p + bb_point(pch = 19) +
    bb_scale_col_manual(c(`4` = "#1b9e77", `6` = "#d95f02", `8` = "#7570b3"))
)
names(built)
built$limits
built$layers[[1]]$name
built$scales$col$domain


## ----plotbb-build-facet-------------------------------------------------------
facet_built <- bb_build(
  p + bb_point() + bb_facet_wrap(~am, ncol = 2, scales = "free_y")
)
vapply(facet_built$panels, `[[`, "", "key")
facet_built$panels[[1]]$ylim


## ----plotbb-save--------------------------------------------------------------
out <- tempfile(fileext = ".pdf")
bb_save(p + bb_point(pch = 19), out, width = 6, height = 4)
file.exists(out)
unlink(out)