## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(collapse = FALSE, comment = "",
                      fig.width = 7, fig.height = 4.5, dpi = 96,
                      dev.args = list(bg = "transparent"))
# Console colour carries no meaning on a rendered page. pkgdown turns it on for
# its own build, and the escape sequences then reach the reader as literal text,
# so colour is switched off here for a plain vignette render and a site build
# alike. The fixed width keeps printed output inside the documentation column.
options(cli.num_colors = 1, cli.hyperlink = FALSE, crayon.enabled = FALSE,
        width = 80)

# Figures on the package website sit on a warm off-white page in light mode and
# are inverted by pkgdown in dark mode, so an opaque background would read as a
# pale slab one way and a black plate the other. Two things paint one. The
# device canvas is made transparent by `dev.args` above, and theme_depictr()
# then inherits theme_minimal()'s white plot.background, which is drawn over
# that canvas, so it is cleared as each figure is printed. This is deliberately
# a vignette-level choice: theme_depictr() keeps its opaque background, which is
# what a figure saved for a paper wants.
transparent_bg <- ggplot2::theme(
  plot.background  = ggplot2::element_rect(fill = NA, colour = NA),
  panel.background = ggplot2::element_rect(fill = NA, colour = NA)
)
knit_print.ggplot <- function(x, ...) knitr::normal_print(x + transparent_bg)
knit_print.patchwork <- function(x, ...) knitr::normal_print(x & transparent_bg)

library(depictr)

## -----------------------------------------------------------------------------
num <- c("rainfall", "fertiliser", "soil_ph", "yield")
pca_plot(crop_yield, cols = num, group = "treatment",
         title = "Crop-yield PCA")

## ----fig.height = 4-----------------------------------------------------------
scree_plot(crop_yield, cols = num)

## -----------------------------------------------------------------------------
pc <- prcomp(crop_yield[num], scale. = TRUE)
pca_plot(pc, components = c(1, 3))

## -----------------------------------------------------------------------------
cluster_plot(crop_yield, cols = num, k = 3, seed = 1,
             title = "Crop-yield clusters")

## ----fig.height = 4-----------------------------------------------------------
region_means <- aggregate(
  cbind(stress, sleep_hours, life_satisfaction, age, income) ~ region,
  data = wellbeing_survey, FUN = mean
)
rownames(region_means) <- region_means$region
dendrogram_plot(region_means[-1], k = 2, title = "Regions clustered")

## ----fig.height = 3.5---------------------------------------------------------
kd <- k_diagnostic(crop_yield, k_range = 2:6, cols = num,
                   method = "silhouette")
kd  # the diagnostic curve, with the suggested k marked

## -----------------------------------------------------------------------------
attr(kd, "suggested")
knitr::kable(attr(kd, "k_table"), digits = 3)

## ----fig.height = 3.5---------------------------------------------------------
set.seed(1)
k_diagnostic(crop_yield, k_range = 1:6, cols = num, method = "gap")

## ----fig.height = 5-----------------------------------------------------------
set.seed(1)
cl <- kmeans(scale(crop_yield[num]), centers = attr(kd, "suggested"),
             nstart = 10)$cluster
silhouette_plot(crop_yield, cl, cols = num,
                title = "Silhouette widths by cluster")

## ----fig.height = 4-----------------------------------------------------------
wb_num <- c("age", "income", "stress", "sleep_hours",
            "exercise_days", "life_satisfaction")
wkd <- k_diagnostic(wellbeing_survey, k_range = 2:6, cols = wb_num,
                    method = "wss")
wcl <- kmeans(scale(na.omit(wellbeing_survey[wb_num])),
              centers = attr(wkd, "suggested"), nstart = 10)$cluster
silhouette_plot(na.omit(wellbeing_survey[wb_num]), wcl,
                title = sprintf("Wellbeing survey, k = %d",
                                attr(wkd, "suggested")))

## ----fig.height = 6-----------------------------------------------------------
survival_plot(
  clinical_trial$time, clinical_trial$event, group = clinical_trial$arm,
  risk_table = TRUE, median_line = TRUE, logrank = TRUE, legend_inside = TRUE,
  x_lab = "Months", title = "Overall survival by arm"
)