From 4635e32868ffed91a83a094b05d6584702f46847 Mon Sep 17 00:00:00 2001 From: James Beeson Date: Wed, 7 Oct 2026 16:38:06 -0600 Subject: [PATCH 1/9] updates for CRAN release: fixed alternative whitespace characters for annotation_wrap; testthat compatible; imports cleaned; tested clean with `check_win_devel(`), `check_win_release()` and `check_mac_release()` - with the exception of a temporarily broken link. --- .Rbuildignore | 3 +++ .gitignore | 1 + DESCRIPTION | 9 ++++--- NAMESPACE | 3 +++ NEWS.md | 2 +- R/diagnose.R | 3 +++ R/slice_2d.R | 6 +---- R/slice_annotation_wrap.R | 7 ++++-- README.Rmd | 6 +++++ cran-comments.md | 20 +++++++++++++++ debug.log | 4 --- man/add_slice_2d.Rd | 4 +-- man/slice_2d.Rd | 2 -- tests/report.html | 4 +-- tests/testthat/test-deprecated.R | 10 ++++++++ tests/testthat/test-geom_slice.R | 42 +++++++++++++++++++++++++++++++ tests/testthat/test-lm_equation.R | 27 ++++++++++++++++++++ tests/testthat/test-plots.R | 35 ++++++++++++++++++++++++++ 18 files changed, 166 insertions(+), 22 deletions(-) create mode 100644 cran-comments.md delete mode 100644 debug.log create mode 100644 tests/testthat/test-deprecated.R create mode 100644 tests/testthat/test-geom_slice.R create mode 100644 tests/testthat/test-lm_equation.R create mode 100644 tests/testthat/test-plots.R diff --git a/.Rbuildignore b/.Rbuildignore index 65ccb49..e36e88b 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -26,3 +26,6 @@ ^docs$ ^pkgdown$ ^\.github$ +^debug\.log$ +^cran-comments\.md$ +^scratch$ diff --git a/.gitignore b/.gitignore index 9f2e178..20e507b 100644 --- a/.gitignore +++ b/.gitignore @@ -11,3 +11,4 @@ Rplots.pdf docs/ inst/doc/ scratch/ +debug.log diff --git a/DESCRIPTION b/DESCRIPTION index 7c03043..d28a8b8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,13 +1,14 @@ Package: Applr Title: Visualize and Explain Linear Models -Version: 0.0.0.9000 +Version: 1.0.0 Authors@R: c( person("Cameron", "McClellan", , "cameron.m.mcclellan@gmail.com", role = "aut"), person("James", "Beeson", , "jamesbeeson01@gmail.com", role = c("aut", "cre"))) Description: Tools for visualizing and explaining linear models fit with lm(). Draws 2D slices of higher-dimensional models in base graphics and as a - ggplot2 layer, offers an interactive 3D scatter with a fitted surface for - two-predictor models, and renders model equations as plain text or LaTeX. + 'ggplot2' layer, offers an interactive 'plotly' 3D scatter with a fitted + surface for two-predictor models, and renders model equations as plain + text or 'LaTeX'. License: MIT + file LICENSE URL: https://saundersg.github.io/Applr/, https://github.com/saundersg/Applr BugReports: https://github.com/saundersg/Applr/issues @@ -15,6 +16,8 @@ Encoding: UTF-8 Language: en-US Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.3 +Depends: + R (>= 4.1.0) Imports: ggplot2 (>= 3.5.0), plotly, diff --git a/NAMESPACE b/NAMESPACE index 3d426da..dad0979 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -27,11 +27,13 @@ export(theme_lc) import(ggplot2) importFrom(ggplot2,autoplot) importFrom(grDevices,adjustcolor) +importFrom(graphics,abline) importFrom(graphics,lines) importFrom(graphics,mtext) importFrom(graphics,par) importFrom(graphics,plot) importFrom(graphics,polygon) +importFrom(graphics,text) importFrom(plotly,add_markers) importFrom(plotly,add_trace) importFrom(plotly,layout) @@ -41,6 +43,7 @@ importFrom(stats,coef) importFrom(stats,delete.response) importFrom(stats,formula) importFrom(stats,get_all_vars) +importFrom(stats,lowess) importFrom(stats,model.frame) importFrom(stats,predict) importFrom(stats,setNames) diff --git a/NEWS.md b/NEWS.md index 38ef8ec..5fd556e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# Applr 1.0.0 (unreleased) +# Applr 1.0.0 First stable release. The public API documented here is covered by a stability promise: renames or removals after 1.0 go through a deprecation diff --git a/R/diagnose.R b/R/diagnose.R index 9e57097..3a234c1 100644 --- a/R/diagnose.R +++ b/R/diagnose.R @@ -11,6 +11,9 @@ #' #' @return None. The function is called for its side effect of producing plots. #' +#' @importFrom graphics abline text +#' @importFrom stats lowess +#' #' @export #' #' @examples diff --git a/R/slice_2d.R b/R/slice_2d.R index 7a6a79c..c2cb063 100644 --- a/R/slice_2d.R +++ b/R/slice_2d.R @@ -40,13 +40,11 @@ #' @importFrom grDevices adjustcolor #' #' @examples -#' \dontrun{ #' model <- lm(mpg ~ disp, data = mtcars) #' slice_2d(model, x_axis = 'disp') #' #' # With a 95% confidence band around the line #' slice_2d(model, x_axis = 'disp', interval = "confidence") -#' } #' #' @export slice_2d <- function(model, x_axis = NULL, n = 100, caption = TRUE, @@ -125,11 +123,9 @@ slice_2d <- function(model, x_axis = NULL, n = 100, caption = TRUE, #' @returns A line added to a preexisting R plot displaying a 2D graphable slice of an HD model #' #' @examples -#' \dontrun{ #' model <- lm(mpg ~ disp + hp, data = mtcars) #' plot(mpg ~ disp, data = mtcars) -#' add_slice_2d(model,x_axis='disp', hp=100) -#' } +#' add_slice_2d(model, x_axis = 'disp', hp = 100) #' #' @export add_slice_2d <- function(model, x_axis = NA, n = 100, caption = FALSE, diff --git a/R/slice_annotation_wrap.R b/R/slice_annotation_wrap.R index c902456..11a3991 100644 --- a/R/slice_annotation_wrap.R +++ b/R/slice_annotation_wrap.R @@ -71,7 +71,10 @@ annotation_width <- function(strings, gp) { # whether a hanging indent even makes sense (it does not for a right-aligned # caption). annotation_style <- function(plot, element) { - theme <- tryCatch(ggplot2::complete_theme(plot$theme), + # complete_theme() only exists in ggplot2 >= 4.0 + complete <- get0("complete_theme", envir = asNamespace("ggplot2"), + mode = "function", inherits = FALSE) + theme <- tryCatch(complete(plot$theme), error = function(e) ggplot2::theme_get()) el <- tryCatch(ggplot2::calc_element(paste0("plot.", element), theme), error = function(e) NULL) @@ -123,7 +126,7 @@ annotation_avail_width <- function(plot, element) { # here, so the indent quietly degrades to whole spaces rather than emitting # characters the device would draw as a missing-glyph box. pad_glyphs <- function(gp) { - candidates <- c(" ", " ", " ", " ") + candidates <- c(" ", "\u2002", "\u2009", "\u200a") w <- annotation_width(candidates, gp) keep <- w > 0 & !duplicated(round(w, 4)) list(glyph = candidates[keep], width = w[keep]) diff --git a/README.Rmd b/README.Rmd index bde930c..e9d9270 100644 --- a/README.Rmd +++ b/README.Rmd @@ -6,6 +6,12 @@ output: github_document with devtools::build_readme(). Do not edit README.md by hand. --> ```{r setup, include = FALSE} +# knitr stages its htmlwidget screenshots (the plotly 3-D chunks) in a temp +# directory it creates inside the working directory; on Windows the live Chrome +# process keeps a handle on it, so the cleanup fails and an empty random-named +# folder is left in the package root. Stage them in the session temp dir instead. +options(knitr.html_screenshot.tmpdir = tempdir()) + knitr::opts_chunk$set( collapse = TRUE, comment = "#>", diff --git a/cran-comments.md b/cran-comments.md new file mode 100644 index 0000000..fe3b969 --- /dev/null +++ b/cran-comments.md @@ -0,0 +1,20 @@ +## R CMD check results + +0 errors | 0 warnings | 1 note + +* This is a new submission. + +## Test environments + +* local: Windows 11, R 4.5.x +* win-builder: R-devel, R-release +* mac-builder: R-release +* GitHub Actions: macOS-latest, windows-latest, ubuntu-latest (R-release, R-devel) + +## Notes for reviewers + +* `autoplot.lm()` prints `summary()` of the model by default, since the + function is designed for interactive model exploration. Users can + suppress it with `summary = FALSE`. +* Examples that create 'plotly' widgets are wrapped in `if (interactive())`. +* Thanks for your work taking time to review this. diff --git a/debug.log b/debug.log deleted file mode 100644 index 7ab2f84..0000000 --- a/debug.log +++ /dev/null @@ -1,4 +0,0 @@ -[0810/160819.407:ERROR:third_party\crashpad\crashpad\util\win\registration_protocol_win.cc:108] CreateFile: The system cannot find the file specified. (0x2) -[0810/160829.822:ERROR:third_party\crashpad\crashpad\util\win\registration_protocol_win.cc:108] CreateFile: The system cannot find the file specified. (0x2) -[0810/160838.555:ERROR:third_party\crashpad\crashpad\util\win\registration_protocol_win.cc:108] CreateFile: The system cannot find the file specified. (0x2) -[0810/162457.862:ERROR:third_party\crashpad\crashpad\util\win\registration_protocol_win.cc:108] CreateFile: The system cannot find the file specified. (0x2) diff --git a/man/add_slice_2d.Rd b/man/add_slice_2d.Rd index d5dbd5d..04fa389 100644 --- a/man/add_slice_2d.Rd +++ b/man/add_slice_2d.Rd @@ -51,10 +51,8 @@ than creating a new one. Useful for overlaying multiple model slices or adding model predictions to scatter plots. } \examples{ -\dontrun{ model <- lm(mpg ~ disp + hp, data = mtcars) plot(mpg ~ disp, data = mtcars) -add_slice_2d(model,x_axis='disp', hp=100) -} +add_slice_2d(model, x_axis = 'disp', hp = 100) } diff --git a/man/slice_2d.Rd b/man/slice_2d.Rd index 8b1d79d..790fe6c 100644 --- a/man/slice_2d.Rd +++ b/man/slice_2d.Rd @@ -53,12 +53,10 @@ to be the first predictor in the model and all other variable are imputed (mean for numeric, first level for factors). } \examples{ -\dontrun{ model <- lm(mpg ~ disp, data = mtcars) slice_2d(model, x_axis = 'disp') # With a 95\% confidence band around the line slice_2d(model, x_axis = 'disp', interval = "confidence") -} } diff --git a/tests/report.html b/tests/report.html index a57ecc8..191891c 100644 --- a/tests/report.html +++ b/tests/report.html @@ -1578,7 +1578,7 @@

Applr Test Suite

-

2026-08-19 16:47

+

2026-10-07 08:27

@@ -4760,7 +4760,7 @@

gs_38_multi_value_cross_colored

geom_point() + geom_slice(model)

Output (this run):

-

+

Reference (ground truth):

diff --git a/tests/testthat/test-deprecated.R b/tests/testthat/test-deprecated.R new file mode 100644 index 0000000..4f8c43f --- /dev/null +++ b/tests/testthat/test-deprecated.R @@ -0,0 +1,10 @@ +test_that("geom_fit() is removed and points to geom_slice()", { + expect_error(geom_fit(), "geom_slice") +}) + +test_that("drawit() warns and still draws", { + grDevices::pdf(NULL) + on.exit(grDevices::dev.off(), add = TRUE) + m <- lm(mpg ~ disp, data = mtcars) + expect_warning(drawit(m, xaxis = "disp")) +}) diff --git a/tests/testthat/test-geom_slice.R b/tests/testthat/test-geom_slice.R new file mode 100644 index 0000000..d51731a --- /dev/null +++ b/tests/testthat/test-geom_slice.R @@ -0,0 +1,42 @@ +build_layer <- function(p, i = 1) ggplot2::ggplot_build(p)$data[[i]] + +m_simple <- lm(mpg ~ disp, data = mtcars) +m_two <- lm(mpg ~ disp + hp, data = mtcars) +base <- ggplot2::ggplot(mtcars, ggplot2::aes(disp, mpg)) + +test_that("geom_slice() returns a ggplot2 layer", { + expect_s3_class(geom_slice(m_simple), "Layer") +}) + +test_that("the slice matches predict() across the data range", { + d <- build_layer(base + geom_slice(m_simple)) + expect_equal(nrow(d), 100) + expect_equal(range(d$x), range(mtcars$disp)) + expect_equal(d$y, unname(predict(m_simple, data.frame(disp = d$x)))) +}) + +test_that("predict_vars holds other predictors at the given value", { + d <- build_layer(base + geom_slice(m_two, predict_vars = list(hp = 150))) + expect_equal(d$y, unname(predict(m_two, data.frame(disp = d$x, hp = 150)))) +}) + +test_that("multiple predict_vars values draw one line each", { + d <- build_layer(base + geom_slice(m_two, predict_vars = list(hp = c(100, 200)))) + expect_length(unique(d$group), 2) +}) + +test_that("interval = 'confidence' adds a band around the line", { + d <- build_layer(base + geom_slice(m_simple, interval = "confidence")) + expect_true(all(c("ymin", "ymax") %in% names(d))) + expect_true(all(d$ymin < d$y & d$y < d$ymax)) +}) + +test_that("a log response is back-transformed to the plotted scale", { + m_log <- lm(log(mpg) ~ disp, data = mtcars) + expect_message(d <- build_layer(base + geom_slice(m_log)), "back-transformed") + expect_equal(d$y, unname(exp(predict(m_log, data.frame(disp = d$x))))) +}) + +test_that("geom_slice() rejects non-lm input", { + expect_error(ggplot2::ggplot_build(base + geom_slice("x")), "fitted by `lm\\(\\)`") +}) diff --git a/tests/testthat/test-lm_equation.R b/tests/testthat/test-lm_equation.R new file mode 100644 index 0000000..e582a5e --- /dev/null +++ b/tests/testthat/test-lm_equation.R @@ -0,0 +1,27 @@ +m_simple <- lm(mpg ~ disp, data = mtcars) + +test_that("lm_equation() writes a plain-text equation", { + expect_identical(lm_equation(m_simple), "mpg = 29.6 - 0.0412*disp") + expect_identical(lm_equation(m_simple, style = "raw"), "mpg = 29.6 - 0.0412*disp") +}) + +test_that("lm_equation() keeps a transformed response on the left side", { + m_log <- lm(log(mpg) ~ disp, data = mtcars) + expect_identical(lm_equation(m_log), "log(mpg) = 3.45 - 0.00212*disp") +}) + +test_that("lm_equation() spells out factor levels", { + m_factor <- lm(mpg ~ disp + factor(cyl), data = mtcars) + eq <- lm_equation(m_factor) + expect_match(eq, "factor(cyl)=\"6\"", fixed = TRUE) + expect_match(eq, "factor(cyl)=\"8\"", fixed = TRUE) +}) + +test_that("lm_latex() returns display-math LaTeX", { + tex <- NULL + invisible(capture.output(tex <- lm_latex(m_simple))) + expect_type(tex, "character") + expect_match(tex, "^\\$\\$.*\\$\\$$") + expect_match(tex, "\\hat{Y_i}", fixed = TRUE) + expect_match(tex, "0.0412", fixed = TRUE) +}) diff --git a/tests/testthat/test-plots.R b/tests/testthat/test-plots.R new file mode 100644 index 0000000..841ebb2 --- /dev/null +++ b/tests/testthat/test-plots.R @@ -0,0 +1,35 @@ +m_simple <- lm(mpg ~ disp, data = mtcars) +m_two <- lm(mpg ~ disp + hp, data = mtcars) + +test_that("autoplot() builds a ggplot and summary = FALSE keeps it quiet", { + expect_silent(p <- ggplot2::autoplot(m_simple, summary = FALSE)) + expect_s3_class(p, "ggplot") + expect_no_error(ggplot2::ggplot_build(p)) +}) + +test_that("autoplot() prints the model summary by default", { + expect_output(ggplot2::autoplot(m_simple), "Residual standard error") +}) + +test_that("slice_2d() and add_slice_2d() draw in base graphics", { + grDevices::pdf(NULL) + on.exit(grDevices::dev.off(), add = TRUE) + expect_no_error(slice_2d(m_simple, x_axis = "disp")) + expect_no_error(slice_2d(m_simple, x_axis = "disp", interval = "confidence")) + plot(mpg ~ disp, data = mtcars) + expect_no_error(add_slice_2d(m_two, x_axis = "disp", hp = 100)) +}) + +test_that("slice_2d() errors on an x_axis not in the model", { + grDevices::pdf(NULL) + on.exit(grDevices::dev.off(), add = TRUE) + expect_error(slice_2d(m_simple, x_axis = "nope"), "not found in the model") +}) + +test_that("scatter_3d() returns a plotly widget", { + expect_s3_class(scatter_3d(m_two), "plotly") +}) + +test_that("theme_lc() returns a ggplot2 theme", { + expect_s3_class(theme_lc(), "theme") +}) From 71b93146ee4ce356f5b0353964c1354b5453d17c Mon Sep 17 00:00:00 2001 From: James Beeson Date: Wed, 7 Oct 2026 16:44:56 -0600 Subject: [PATCH 2/9] remove `theme_lc()` - out of scope for this package --- NAMESPACE | 1 - R/Applr-package.R | 3 +- R/theme_lc.R | 92 ---------------------------- _pkgdown.yml | 3 - for_devs/dev_todo.Rmd | 2 +- for_devs/release_plan_1.0.md | 2 +- for_devs/scattered_notes.Rmd | 3 - man/Applr-package.Rd | 3 +- man/theme_lc.Rd | 50 --------------- tests/cases/ap_01_single_predictor.R | 2 +- tests/report.html | 8 +-- tests/testthat/test-plots.R | 4 -- 12 files changed, 9 insertions(+), 164 deletions(-) delete mode 100644 R/theme_lc.R delete mode 100644 man/theme_lc.Rd diff --git a/NAMESPACE b/NAMESPACE index dad0979..945c0d2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -23,7 +23,6 @@ export(lm_equation) export(lm_latex) export(scatter_3d) export(slice_2d) -export(theme_lc) import(ggplot2) importFrom(ggplot2,autoplot) importFrom(grDevices,adjustcolor) diff --git a/R/Applr-package.R b/R/Applr-package.R index 5267c54..dad25dd 100644 --- a/R/Applr-package.R +++ b/R/Applr-package.R @@ -18,7 +18,6 @@ #' - ggplot2 labeling: \code{\link{geom_slice_text}}, \code{\link{geom_slice_subtitle}}, \code{\link{geom_slice_caption}} #' - 3D visualization: \code{\link{scatter_3d}} #' - Equations: \code{\link{lm_equation}}, \code{\link{lm_latex}} -#' - Theme: \code{\link{theme_lc}} #' #' @section Quick start: #' Fit a model and plot a slice: @@ -39,7 +38,7 @@ #' } #' #' @seealso \itemize{ -#' \item Function help pages: \code{?slice_2d}, \code{?geom_slice}, \code{?scatter_3d}, \code{?lm_equation}, \code{?lm_latex}, \code{?theme_lc} +#' \item Function help pages: \code{?slice_2d}, \code{?geom_slice}, \code{?scatter_3d}, \code{?lm_equation}, \code{?lm_latex} #' \item The package README for a brief tour #' } #' diff --git a/R/theme_lc.R b/R/theme_lc.R deleted file mode 100644 index 0338f6a..0000000 --- a/R/theme_lc.R +++ /dev/null @@ -1,92 +0,0 @@ -#' Theme based off of Lauren Condie's work -#' -#' A custom ggplot2 theme that provides a cohesive, aesthetically pleasing color scheme -#' and styling for statistical graphics. This theme sets both default geom aesthetics -#' and plot theme elements to create a consistent visual style across all plots. -#' The color palette uses warm, earthy tones that work well for academic and professional -#' presentations. Reach for it when you want every plot in a document or -#' presentation to share the same warm, muted look without styling each one -#' by hand. -#' -#' Note that, in addition to returning a theme, calling `theme_lc()` sets -#' session-wide geom defaults (point, line, smooth, segment, hline colors) -#' via [ggplot2::update_geom_defaults()]. These defaults persist for the rest -#' of the R session, even on plots that don't use the theme. -#' -#' @return A complete ggplot2 theme object (class `"theme"`) that can be added -#' to a plot with `+`. -#' -#' @examples -#' library(ggplot2) -#' -#' # Scatterplot with the theme's warm-gray points and beige grid -#' ggplot(mtcars, aes(disp, mpg)) + -#' geom_point() + -#' labs(title = "Fuel efficiency vs displacement") + -#' theme_lc() -#' -#' # The theme also restyles lines and smooths -#' ggplot(pressure, aes(temperature, pressure)) + -#' geom_line() + -#' geom_point() + -#' theme_lc() -#' -#' # Works alongside faceting and further theme tweaks -#' ggplot(iris, aes(Sepal.Length, Sepal.Width)) + -#' geom_point() + -#' facet_wrap(~Species) + -#' theme_lc() + -#' theme(legend.position = "bottom") -#' -#' @export -#' -#' -theme_lc <- function(){ - - # Set default aesthetic values for various geom types - # These will be applied automatically to all plots using this theme - # unless explicitly overridden in individual geom calls - - # Points: warm gray color that's easy on the eyes - update_geom_defaults('point', list(color = "#78776C")) - - # Smooth lines (like geom_smooth): light brown line with warm fill and transparency - # The alpha = 0.3 makes confidence bands semi-transparent - update_geom_defaults('smooth', list(color= '#B7B799', fill = '#D3B593', alpha = 0.3)) - - # Regular lines: coordinated light brown color - update_geom_defaults('line', list(color='#B7B799')) - - # Line segments: matching color for consistency - update_geom_defaults('segment', list(color='#B7B799')) - - # Horizontal reference lines: same coordinated color - update_geom_defaults('hline', list(color='#B7B799')) - - # Build the theme by starting with theme_minimal() and modifying specific elements - # %+replace% ensures our customizations completely replace the defaults - theme_minimal() %+replace% - - theme( - # Plot title: warm reddish-brown color that stands out without being harsh - plot.title = element_text(color = "#B07E63"), - - # Axis titles: warm beige color that's readable but not overpowering - axis.title.y = element_text(color = "#D3B593"), - axis.title.x = element_text(color = "#D3B593"), - - # Major grid lines: very subtle beige lines with thin width - # These provide structure without overwhelming the data - panel.grid.major = element_line(color = "#D3B593", linewidth = .06), - - # Axis text (tick labels): matching the point color for consistency - axis.text.x = element_text(color = "#78776C"), - axis.text.y = element_text(color = "#78776C"), - - # Remove minor grid lines entirely for a cleaner look - panel.grid.minor = element_blank(), - - # Mark theme as complete - this prevents inheritance issues - complete=TRUE - ) -} diff --git a/_pkgdown.yml b/_pkgdown.yml index 7d2db16..2a27e13 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -26,9 +26,6 @@ reference: - lm_equation - lm_latex - diagnose -- title: Theme - contents: - - theme_lc - title: ggproto objects desc: Extension points underlying geom_slice. contents: diff --git a/for_devs/dev_todo.Rmd b/for_devs/dev_todo.Rmd index f821cae..f7f5430 100644 --- a/for_devs/dev_todo.Rmd +++ b/for_devs/dev_todo.Rmd @@ -97,7 +97,7 @@ date: "2026-07-11" - [x] Add error to check if the data being plotted is the same as the data the lm was fit to - [x] `geom_slice` - [x] Remove %>% in favor of |> -- [x] `autoplot(lm)` (takes minimal arguments, feasts/ggtime is a good example) — DONE 2026-07-07 (`autoplot.lm(object, ..., x_axis =)`: scatter + geom_slice + theme_lc from the model's own data, first numeric predictor on x, `...` forwarded to geom_slice, `autoplot` generic re-exported; cases ap_01–ap_11) +- [x] `autoplot(lm)` (takes minimal arguments, feasts/ggtime is a good example) — DONE 2026-07-07 (`autoplot.lm(object, ..., x_axis =)`: scatter + geom_slice from the model's own data, first numeric predictor on x, `...` forwarded to geom_slice, `autoplot` generic re-exported; cases ap_01–ap_11) - [x] Add confidence and prediction interval to `geom_slice` — DONE 2026-07-07 (`interval = "confidence"/"prediction"`, GeomSlice now inherits GeomSmooth; cases gs_33/gs_34) - [x] Add standards to `decisions.Rmd` (like error format) - [x] Make sure existing ground truth tests are accurate diff --git a/for_devs/release_plan_1.0.md b/for_devs/release_plan_1.0.md index 70ea7e9..f8b861c 100644 --- a/for_devs/release_plan_1.0.md +++ b/for_devs/release_plan_1.0.md @@ -41,7 +41,7 @@ does and when to reach for it, and `@examples` that show the **range** of the function (not one minimal call). Examples must run unattended in seconds; wrap plotly/interactive ones in `if (interactive())`. -- [x] **Prompt A** — utility docs pass: `theme_lc`, `lm_equation`/`lm_latex`, +- [x] **Prompt A** — utility docs pass: `lm_equation`/`lm_latex`, `scatter_3d`, `diagnose`, `get_inverse_function` (internal → `@noRd`). Review note: two "Use it when…" paragraphs in `lm_equation.R` sat after `@param clearer` (would merge into that param's doc) — fixed on review. diff --git a/for_devs/scattered_notes.Rmd b/for_devs/scattered_notes.Rmd index 1875cf6..0b58f54 100644 --- a/for_devs/scattered_notes.Rmd +++ b/for_devs/scattered_notes.Rmd @@ -287,6 +287,3 @@ Same - Quadratic - Exponential -## theme_lc - -Cool. Captions? diff --git a/man/Applr-package.Rd b/man/Applr-package.Rd index 37301ee..7422c45 100644 --- a/man/Applr-package.Rd +++ b/man/Applr-package.Rd @@ -29,7 +29,6 @@ Core capabilities: \item ggplot2 labeling: \code{\link{geom_slice_text}}, \code{\link{geom_slice_subtitle}}, \code{\link{geom_slice_caption}} \item 3D visualization: \code{\link{scatter_3d}} \item Equations: \code{\link{lm_equation}}, \code{\link{lm_latex}} -\item Theme: \code{\link{theme_lc}} } } @@ -55,7 +54,7 @@ ggplot(mtcars, aes(disp, mpg)) + \seealso{ \itemize{ -\item Function help pages: \code{?slice_2d}, \code{?geom_slice}, \code{?scatter_3d}, \code{?lm_equation}, \code{?lm_latex}, \code{?theme_lc} +\item Function help pages: \code{?slice_2d}, \code{?geom_slice}, \code{?scatter_3d}, \code{?lm_equation}, \code{?lm_latex} \item The package README for a brief tour } } diff --git a/man/theme_lc.Rd b/man/theme_lc.Rd deleted file mode 100644 index ca04552..0000000 --- a/man/theme_lc.Rd +++ /dev/null @@ -1,50 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/theme_lc.R -\name{theme_lc} -\alias{theme_lc} -\title{Theme based off of Lauren Condie's work} -\usage{ -theme_lc() -} -\value{ -A complete ggplot2 theme object (class \code{"theme"}) that can be added -to a plot with \code{+}. -} -\description{ -A custom ggplot2 theme that provides a cohesive, aesthetically pleasing color scheme -and styling for statistical graphics. This theme sets both default geom aesthetics -and plot theme elements to create a consistent visual style across all plots. -The color palette uses warm, earthy tones that work well for academic and professional -presentations. Reach for it when you want every plot in a document or -presentation to share the same warm, muted look without styling each one -by hand. -} -\details{ -Note that, in addition to returning a theme, calling \code{theme_lc()} sets -session-wide geom defaults (point, line, smooth, segment, hline colors) -via \code{\link[ggplot2:update_defaults]{ggplot2::update_geom_defaults()}}. These defaults persist for the rest -of the R session, even on plots that don't use the theme. -} -\examples{ -library(ggplot2) - -# Scatterplot with the theme's warm-gray points and beige grid -ggplot(mtcars, aes(disp, mpg)) + - geom_point() + - labs(title = "Fuel efficiency vs displacement") + - theme_lc() - -# The theme also restyles lines and smooths -ggplot(pressure, aes(temperature, pressure)) + - geom_line() + - geom_point() + - theme_lc() - -# Works alongside faceting and further theme tweaks -ggplot(iris, aes(Sepal.Length, Sepal.Width)) + - geom_point() + - facet_wrap(~Species) + - theme_lc() + - theme(legend.position = "bottom") - -} diff --git a/tests/cases/ap_01_single_predictor.R b/tests/cases/ap_01_single_predictor.R index 80ef1f5..9010edd 100644 --- a/tests/cases/ap_01_single_predictor.R +++ b/tests/cases/ap_01_single_predictor.R @@ -4,7 +4,7 @@ # EXPECT: Complete plot built by autoplot(model) alone: mtcars scatter # (disp on x, mpg on y), one straight downward-sloping slice line # through the point cloud with its default confidence ribbon (a -# narrow shaded band hugging the line), theme_lc styling. +# narrow shaded band hugging the line). # No errors, warnings, or imputation messages. source("tests/_setup.R") diff --git a/tests/report.html b/tests/report.html index 191891c..65a444f 100644 --- a/tests/report.html +++ b/tests/report.html @@ -1578,7 +1578,7 @@

Applr Test Suite

-

2026-10-07 08:27

+

2026-10-07 16:42

@@ -7671,8 +7671,8 @@

ap_01_single_predictor

Expect: Complete plot built by autoplot(model) alone: mtcars scatter (disp on x, mpg on y), one straight downward-sloping slice line through the point cloud with its default -confidence ribbon (a narrow shaded band hugging the line), theme_lc -styling. No errors, warnings, or imputation messages.

+confidence ribbon (a narrow shaded band hugging the line). No errors, +warnings, or imputation messages.

Status: OK

# CASE: ap_01_single_predictor
@@ -7681,7 +7681,7 @@ 

ap_01_single_predictor

# EXPECT: Complete plot built by autoplot(model) alone: mtcars scatter # (disp on x, mpg on y), one straight downward-sloping slice line # through the point cloud with its default confidence ribbon (a -# narrow shaded band hugging the line), theme_lc styling. +# narrow shaded band hugging the line). # No errors, warnings, or imputation messages. source("tests/_setup.R") diff --git a/tests/testthat/test-plots.R b/tests/testthat/test-plots.R index 841ebb2..dc86e5d 100644 --- a/tests/testthat/test-plots.R +++ b/tests/testthat/test-plots.R @@ -29,7 +29,3 @@ test_that("slice_2d() errors on an x_axis not in the model", { test_that("scatter_3d() returns a plotly widget", { expect_s3_class(scatter_3d(m_two), "plotly") }) - -test_that("theme_lc() returns a ggplot2 theme", { - expect_s3_class(theme_lc(), "theme") -}) From 1d74f2c4d07e2e177d2c1a757fea364223f1a85b Mon Sep 17 00:00:00 2001 From: James Beeson Date: Tue, 13 Oct 2026 14:40:44 -0600 Subject: [PATCH 3/9] small documentation fixes: logo and badges in README, bro saunders attributed, additional cran-comments --- DESCRIPTION | 3 +- R/deprecated.R | 2 ++ README.Rmd | 15 +++++++--- README.md | 19 +++++++++---- cran-comments.md | 6 +++- man/Applr-package.Rd | 5 ++++ man/figures/applr-logo.svg | 56 ++++++++++++++++++++++++++++++++++++++ man/geom_fit.Rd | 3 ++ 8 files changed, 98 insertions(+), 11 deletions(-) create mode 100644 man/figures/applr-logo.svg diff --git a/DESCRIPTION b/DESCRIPTION index d28a8b8..4490f4e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -3,7 +3,8 @@ Title: Visualize and Explain Linear Models Version: 1.0.0 Authors@R: c( person("Cameron", "McClellan", , "cameron.m.mcclellan@gmail.com", role = "aut"), - person("James", "Beeson", , "jamesbeeson01@gmail.com", role = c("aut", "cre"))) + person("James", "Beeson", , "jamesbeeson01@gmail.com", role = c("aut", "cre")), + person("Garrett", "Saunders", , "saundersg@byui.edu", role = "ths")) Description: Tools for visualizing and explaining linear models fit with lm(). Draws 2D slices of higher-dimensional models in base graphics and as a 'ggplot2' layer, offers an interactive 'plotly' 3D scatter with a fitted diff --git a/R/deprecated.R b/R/deprecated.R index afddc78..133949f 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -9,6 +9,8 @@ #' ribbons, back-transformation) plus grouping, faceting, and held-variable #' reporting. Calling it is an error that points to the replacement. #' +#' @return None; always throws an error pointing to [geom_slice()]. +#' #' @param ... Ignored; accepted only so old calls reach the error message. #' #' @seealso [geom_slice()] diff --git a/README.Rmd b/README.Rmd index e9d9270..0a2442e 100644 --- a/README.Rmd +++ b/README.Rmd @@ -25,7 +25,14 @@ knitr::opts_chunk$set( set.seed(42) ``` -# Applr +# Applr Applr logo + + +[![R-CMD-check](https://github.com/saundersg/Applr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/saundersg/Applr/actions/workflows/R-CMD-check.yaml) +[![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/Applr)](https://cran.r-project.org/package=Applr) + + +## Overview A small R package for visualizing linear models. Plots anything from simple lines to high-dimensional squiggles all with the same functions. @@ -498,9 +505,9 @@ Enjoy clearer model visualizations with **Applr**! ## Attributions -Thanks to **Cameron McClellan** for his vision and initiation, **James Beeson** for seeing it through, **Anthropic's Claude** for solving the problems we couldn't, and **Brother Saunders** - our teacher and inspiration to do great things. +Thanks to **Cameron McClellan** for his vision and initiation, **James Beeson** for seeing it through, **Anthropic's Claude** for solving the coding problems we couldn't, and **Brother Garrett Saunders** - our teacher and inspiration to do great things. And of course, Brigham Young University Idaho - our alma mater; the school we love and cherish. And the God of Heaven and Earth, who gives us all. -33 For God is not the author of *confusion*, but of *peace*, as in all churches of the saints. -- 1 Corinthians 14:33 +> "For God is not the author of *confusion*, but of *peace*, as in all churches of the saints." +> - 1 Corinthians 14:33 diff --git a/README.md b/README.md index 59b59b8..5b9862a 100644 --- a/README.md +++ b/README.md @@ -2,7 +2,16 @@ -# Applr +# Applr Applr logo + + + +[![R-CMD-check](https://github.com/saundersg/Applr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/saundersg/Applr/actions/workflows/R-CMD-check.yaml) +[![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/Applr)](https://cran.r-project.org/package=Applr) + + + +## Overview A small R package for visualizing linear models. Plots anything from simple lines to high-dimensional squiggles all with the same functions. @@ -577,12 +586,12 @@ Enjoy clearer model visualizations with **Applr**! Thanks to **Cameron McClellan** for his vision and initiation, **James Beeson** for seeing it through, **Anthropic’s Claude** for solving the -problems we couldn’t, and **Brother Saunders** - our teacher and -inspiration to do great things. +coding problems we couldn’t, and **Brother Garrett Saunders** - our +teacher and inspiration to do great things. And of course, Brigham Young University Idaho - our alma mater; the school we love and cherish. And the God of Heaven and Earth, who gives us all. -33 For God is not the author of *confusion*, but of *peace*, as in all -churches of the saints. - 1 Corinthians 14:33 +> “For God is not the author of *confusion*, but of *peace*, as in all +> churches of the saints.” - 1 Corinthians 14:33 diff --git a/cran-comments.md b/cran-comments.md index fe3b969..f883506 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -9,12 +9,16 @@ * local: Windows 11, R 4.5.x * win-builder: R-devel, R-release * mac-builder: R-release -* GitHub Actions: macOS-latest, windows-latest, ubuntu-latest (R-release, R-devel) +* GitHub Actions: + * R-release: macOS-latest, windows-latest, ubuntu-latest + * R-devel: ubuntu-latest ## Notes for reviewers * `autoplot.lm()` prints `summary()` of the model by default, since the function is designed for interactive model exploration. Users can suppress it with `summary = FALSE`. +* `lm_latex()` exists to print a LaTeX equation (e.g. in `results = "asis"` + chunks), so it writes with `cat()`; the string is also returned invisibly. * Examples that create 'plotly' widgets are wrapped in `if (interactive())`. * Thanks for your work taking time to review this. diff --git a/man/Applr-package.Rd b/man/Applr-package.Rd index 7422c45..46f4970 100644 --- a/man/Applr-package.Rd +++ b/man/Applr-package.Rd @@ -66,4 +66,9 @@ Authors: \item Cameron McClellan \email{cameron.m.mcclellan@gmail.com} } +Other contributors: +\itemize{ + \item Garrett Saunders \email{saundersg@byui.edu} [thesis advisor] +} + } diff --git a/man/figures/applr-logo.svg b/man/figures/applr-logo.svg new file mode 100644 index 0000000..6170ccd --- /dev/null +++ b/man/figures/applr-logo.svg @@ -0,0 +1,56 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/man/geom_fit.Rd b/man/geom_fit.Rd index 37b6404..944ca68 100644 --- a/man/geom_fit.Rd +++ b/man/geom_fit.Rd @@ -9,6 +9,9 @@ geom_fit(...) \arguments{ \item{...}{Ignored; accepted only so old calls reach the error message.} } +\value{ +None; always throws an error pointing to \code{\link[=geom_slice]{geom_slice()}}. +} \description{ \code{geom_fit()} was removed in favor of \code{\link[=geom_slice]{geom_slice()}}, which does everything it did (prediction lines from a fitted \code{lm()}, confidence/prediction From cde3dd4ac76798d382049c97ccce853ea8c8781c Mon Sep 17 00:00:00 2001 From: James Beeson Date: Tue, 13 Oct 2026 14:52:39 -0600 Subject: [PATCH 4/9] logo align right --- README.Rmd | 2 +- README.md | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/README.Rmd b/README.Rmd index 0a2442e..4617f14 100644 --- a/README.Rmd +++ b/README.Rmd @@ -25,7 +25,7 @@ knitr::opts_chunk$set( set.seed(42) ``` -# Applr Applr logo +# Applr Applr logo [![R-CMD-check](https://github.com/saundersg/Applr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/saundersg/Applr/actions/workflows/R-CMD-check.yaml) diff --git a/README.md b/README.md index 5b9862a..6f9cc02 100644 --- a/README.md +++ b/README.md @@ -2,13 +2,12 @@ -# Applr Applr logo +# Applr Applr logo [![R-CMD-check](https://github.com/saundersg/Applr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/saundersg/Applr/actions/workflows/R-CMD-check.yaml) [![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/Applr)](https://cran.r-project.org/package=Applr) - ## Overview From 979f04daa952c348aa7bd41cba232a791afacb79 Mon Sep 17 00:00:00 2001 From: James Beeson Date: Tue, 13 Oct 2026 15:15:25 -0600 Subject: [PATCH 5/9] logo fix --- README.Rmd | 2 +- README.md | 2 +- man/figures/{applr-logo.svg => logo.svg} | 0 3 files changed, 2 insertions(+), 2 deletions(-) rename man/figures/{applr-logo.svg => logo.svg} (100%) diff --git a/README.Rmd b/README.Rmd index 4617f14..b84c5f8 100644 --- a/README.Rmd +++ b/README.Rmd @@ -25,7 +25,7 @@ knitr::opts_chunk$set( set.seed(42) ``` -# Applr Applr logo +# Applr Applr logo [![R-CMD-check](https://github.com/saundersg/Applr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/saundersg/Applr/actions/workflows/R-CMD-check.yaml) diff --git a/README.md b/README.md index 6f9cc02..d522bbf 100644 --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ -# Applr Applr logo +# Applr Applr logo diff --git a/man/figures/applr-logo.svg b/man/figures/logo.svg similarity index 100% rename from man/figures/applr-logo.svg rename to man/figures/logo.svg From c9da36c518d829d90780159629e7e5fcd5a9230d Mon Sep 17 00:00:00 2001 From: James Beeson Date: Tue, 13 Oct 2026 15:18:36 -0600 Subject: [PATCH 6/9] documentation remodel (literally using new models) --- R/Applr-package.R | 17 +-- R/autoplot.lm.R | 34 +++-- R/geom_slice.R | 71 +++++----- R/geom_slice_caption.R | 10 +- R/geom_slice_subtitle.R | 10 +- R/geom_slice_text.R | 23 +++- R/scatter_3d.R | 10 +- R/slice_2d.R | 18 ++- man/Applr-package.Rd | 17 +-- man/add_slice_2d.Rd | 9 +- man/autoplot.lm.Rd | 34 +++-- man/geom_slice.Rd | 71 +++++----- man/geom_slice_caption.Rd | 10 +- man/geom_slice_subtitle.Rd | 10 +- man/geom_slice_text.Rd | 23 +++- man/scatter_3d.Rd | 10 +- man/slice_2d.Rd | 9 +- vignettes/Applr.Rmd | 276 +++++++++++++++++++++++++++++-------- 18 files changed, 431 insertions(+), 231 deletions(-) diff --git a/R/Applr-package.R b/R/Applr-package.R index dad25dd..655b814 100644 --- a/R/Applr-package.R +++ b/R/Applr-package.R @@ -20,21 +20,22 @@ #' - Equations: \code{\link{lm_equation}}, \code{\link{lm_latex}} #' #' @section Quick start: -#' Fit a model and plot a slice: +#' Fit a model, then see it in one call: #' \preformatted{ #' library(Applr) -#' model <- lm(mpg ~ disp + hp, data = mtcars) -#' slice_2d(model, x_axis = "disp") +#' model <- lm(mpg ~ qsec + am, data = mtcars) +#' autoplot(model) #' } #' -#' ggplot2 layer with facets: +#' Or build the plot yourself with a geom_slice() layer: #' \preformatted{ #' library(ggplot2) -#' model <- lm(mpg ~ disp + hp + cyl, data = mtcars) -#' ggplot(mtcars, aes(disp, mpg)) + +#' model <- lm(hwy ~ displ * drv + cyl, data = mpg) +#' ggplot(mpg, aes(displ, hwy, color = drv)) + #' geom_point() + -#' facet_wrap(~cyl) + -#' geom_slice(model = model, predict_vars = list(hp = 110)) +#' geom_slice(model, band = TRUE) + +#' geom_slice_text() + +#' geom_slice_subtitle() #' } #' #' @seealso \itemize{ diff --git a/R/autoplot.lm.R b/R/autoplot.lm.R index 3650dd2..65f186d 100644 --- a/R/autoplot.lm.R +++ b/R/autoplot.lm.R @@ -71,30 +71,28 @@ ggplot2::autoplot #' @examples #' library(ggplot2) #' -#' # A complete plot from a model in one call -#' autoplot(lm(mpg ~ disp, data = mtcars)) +#' # A complete plot from a model in one call; summary() prints to the console +#' autoplot(lm(Petal.Length ~ Sepal.Length + I(Sepal.Length^2):Species, iris)) #' -#' # Predictors not on the plot are imputed (a message says how) -#' autoplot(lm(mpg ~ disp + hp, data = mtcars)) +#' # Predictors that group into a few values become color, then facets +#' model <- lm(hwy ~ displ + drv + cyl, data = mpg) +#' autoplot(model, summary = FALSE) #' -#' # Choose which predictor goes on the x-axis -#' autoplot(lm(mpg ~ disp + hp, data = mtcars), mapping = aes(x = hp)) +#' # Change the defaults like a normal ggplot; the rest is still inferred +#' autoplot(model, aes(color = factor(cyl)), summary = FALSE) + facet_wrap(~drv) #' -#' # Transformed response, back-transformed onto the raw mpg axis -#' autoplot(lm(log(mpg) ~ disp, data = mtcars)) -#' -#' # Options pass through to geom_slice(); the result is a normal ggplot -#' autoplot(lm(mpg ~ disp + hp, data = mtcars), -#' predict_vars = list(hp = 110), interval = "prediction") + -#' labs(title = "Slice at hp = 110") +#' # Choose the x-axis and pass geom_slice() options through +#' autoplot(model, +#' aes(x = cyl, color = factor(drv)), +#' interval = "none", summary = FALSE) + +#' labs(title = "The Same Model From a Different Angle") #' -#' # Extra aesthetics for the scatter (mapping goes to ggplot()) -#' autoplot(lm(mpg ~ hp + factor(cyl), data = mtcars), -#' mapping = aes(color = factor(cyl))) +#' # Transformed response, back-transformed onto the raw mpg axis +#' autoplot(lm(log(mpg) ~ disp + hp, data = mtcars), summary = FALSE) #' -#' # An interactive 3-D surface for a two-predictor model +#' # An interactive 3-D surface for a model with two numeric predictors #' if (interactive()) { -#' autoplot(lm(mpg ~ disp + hp, data = mtcars), type = "3d") +#' autoplot(lm(mpg ~ wt + I(wt^2) + hp, data = mtcars), type = "3d") #' } #' #' @export diff --git a/R/geom_slice.R b/R/geom_slice.R index 53ab0f4..c1a5425 100644 --- a/R/geom_slice.R +++ b/R/geom_slice.R @@ -1032,69 +1032,72 @@ ggplot_add.SliceLayer <- function(object, plot, ...) { #' @examples #' library(ggplot2) #' -#' # Basic use, like geom_smooth() but drawing *your* model. hp is not on -#' # the plot, so it is held at its mean (a console message says so). -#' model <- lm(mpg ~ disp + hp, data = mtcars) -#' ggplot(mtcars, aes(disp, mpg)) + +#' # Basic use, like geom_smooth() but drawing *your* model. Sepal.Width is +#' # not on the plot, so it is held at its mean (a console message says so). +#' model <- lm(Sepal.Length ~ Sepal.Width + Petal.Length, data = iris) +#' ggplot(iris, aes(Petal.Length, Sepal.Length)) + #' geom_point() + #' geom_slice(model) #' -#' # Choose the slice yourself -#' ggplot(mtcars, aes(disp, mpg)) + -#' geom_point() + -#' geom_slice(model, predict_vars = list(hp = 110)) -#' #' # Several values draw one line per value (label them with #' # geom_slice_text()); several multi-value variables are crossed -#' ggplot(mtcars, aes(disp, mpg)) + +#' ggplot(iris, aes(Petal.Length, Sepal.Length)) + #' geom_point() + -#' geom_slice(model, predict_vars = list(hp = c(66, 150, 335))) +#' geom_slice(model, predict_vars = list(Sepal.Width = c(2, 3, 4))) + +#' geom_slice_text() #' #' # Confidence or prediction ribbon around the line -#' ggplot(mtcars, aes(disp, mpg)) + +#' model2 <- lm(hwy ~ displ + I(displ^2), data = mpg) +#' ggplot(mpg, aes(displ, hwy)) + #' geom_point() + -#' geom_slice(model, predict_vars = list(hp = 110), interval = "confidence") +#' geom_slice(model2, interval = "prediction") #' #' # A grouping aesthetic pins its predictor to each group's own value: -#' # one line per cylinder count, each with its own slope -#' model2 <- lm(mpg ~ disp * cyl, data = mtcars) -#' ggplot(mtcars, aes(disp, mpg, color = factor(cyl))) + +#' # one line per drive type, each stopping at the end of its group's data +#' model3 <- lm(hwy ~ displ + I(displ^2) + displ:drv, data = mpg) +#' ggplot(mpg, aes(displ, hwy, color = drv)) + #' geom_point() + -#' geom_slice(model2) +#' geom_slice(model3) #' -#' # full_range = TRUE extends each group's line across the whole panel, -#' # not just its own data range -#' ggplot(mtcars, aes(disp, mpg, color = factor(cyl))) + +#' # full_range = TRUE extends each group's line across the whole panel +#' ggplot(mpg, aes(displ, hwy, color = drv)) + #' geom_point() + -#' geom_slice(model2, full_range = TRUE) +#' geom_slice(model3, full_range = TRUE) #' #' # Facet variables pin per panel the same way -#' ggplot(mtcars, aes(disp, mpg)) + +#' ggplot(mpg, aes(displ, hwy)) + #' geom_point() + -#' geom_slice(model2) + -#' facet_wrap(~ cyl) +#' geom_slice(model3) + +#' facet_wrap(~drv) #' -#' # A transformed response is back-transformed automatically: the model -#' # predicts log(mpg), the line appears in raw mpg units (a message says so) -#' model3 <- lm(log(mpg) ~ disp + hp, data = mtcars) -#' ggplot(mtcars, aes(disp, mpg)) + +#' # A projection band shows the reach of a predictor, here cyl from 5 to 7; +#' # band = TRUE infers the variable and its data range when it can +#' model4 <- lm(hwy ~ displ * drv + cyl, data = mpg) +#' ggplot(mpg, aes(displ, hwy, color = drv)) + #' geom_point() + -#' geom_slice(model3) +#' geom_slice(model4, band = "cyl", predict_vars = list(cyl = c(5, 7))) #' -#' # ... or control the mapping yourself with back_transform +#' # A transformed response is back-transformed to match the y-axis: the +#' # model predicts log(mpg), the line appears in raw mpg units +#' model5 <- lm(log(mpg) ~ disp + hp, data = mtcars) #' ggplot(mtcars, aes(disp, mpg)) + #' geom_point() + -#' geom_slice(model3, back_transform = exp) +#' geom_slice(model5) #' -#' # A projection band spanning hp between two values, instead of a line +#' # ... adapts when the axis itself is transformed +#' ggplot(mtcars, aes(disp, log(mpg))) + +#' geom_point() + +#' geom_slice(model5) +#' +#' # ... or control the mapping yourself with back_transform #' ggplot(mtcars, aes(disp, mpg)) + #' geom_point() + -#' geom_slice(model, predict_vars = list(hp = c(66, 335)), band = "hp") +#' geom_slice(model5, back_transform = exp) #' #' # n controls how many prediction points make up the line #' ggplot(mtcars, aes(disp, mpg)) + #' geom_point() + -#' geom_slice(model, predict_vars = list(hp = 110), n = 10) +#' geom_slice(model5, n = 10) #' #' @export geom_slice <- function(model, diff --git a/R/geom_slice_caption.R b/R/geom_slice_caption.R index 8804696..4d2712a 100644 --- a/R/geom_slice_caption.R +++ b/R/geom_slice_caption.R @@ -37,11 +37,13 @@ ggplot_add.slice_caption_spec <- function(object, plot, ...) { #' @examples #' library(ggplot2) #' -#' # Caption reports the model equation and that hp is held at its mean -#' model <- lm(mpg ~ disp + hp, data = mtcars) -#' ggplot(mtcars, aes(disp, mpg)) + +#' # Caption reports the model equation and the held Sepal.Width; Species +#' # is already shown by the legend, so it is left out +#' model <- lm(Petal.Length ~ Sepal.Length + I(Sepal.Length^2):Species + +#' Sepal.Width, data = iris) +#' ggplot(iris, aes(Sepal.Length, Petal.Length, color = Species)) + #' geom_point() + -#' geom_slice(model) + +#' geom_slice(model, interval = "confidence") + #' geom_slice_caption() #' #' @export diff --git a/R/geom_slice_subtitle.R b/R/geom_slice_subtitle.R index 211d80f..1961d70 100644 --- a/R/geom_slice_subtitle.R +++ b/R/geom_slice_subtitle.R @@ -245,11 +245,13 @@ ggplot_add.slice_subtitle_spec <- function(object, plot, ...) { #' @examples #' library(ggplot2) #' -#' # Subtitle reports the model equation and that hp is held at its mean -#' model <- lm(mpg ~ disp + hp, data = mtcars) -#' ggplot(mtcars, aes(disp, mpg)) + +#' # Subtitle reports the model equation and the held Sepal.Width; Species +#' # is already shown by the legend, so it is left out +#' model <- lm(Petal.Length ~ Sepal.Length + I(Sepal.Length^2):Species + +#' Sepal.Width, data = iris) +#' ggplot(iris, aes(Sepal.Length, Petal.Length, color = Species)) + #' geom_point() + -#' geom_slice(model) + +#' geom_slice(model, interval = "confidence") + #' geom_slice_subtitle() #' #' @export diff --git a/R/geom_slice_text.R b/R/geom_slice_text.R index 2523258..6a7850d 100644 --- a/R/geom_slice_text.R +++ b/R/geom_slice_text.R @@ -608,19 +608,32 @@ ggplot_add.slice_text_spec <- function(object, plot, ...) { #' @examples #' library(ggplot2) #' -#' # Two visually identical lines, told apart by their labels -#' model <- lm(mpg ~ disp + hp, data = mtcars) -#' ggplot(mtcars, aes(disp, mpg)) + +#' # One label per predict_vars value +#' model <- lm(Sepal.Length ~ Sepal.Width + Petal.Length, data = iris) +#' ggplot(iris, aes(Petal.Length, Sepal.Length)) + #' geom_point() + -#' geom_slice(model, predict_vars = list(hp = c(66, 335))) + +#' geom_slice(model, predict_vars = list(Sepal.Width = c(2, 3, 4))) + #' geom_slice_text() #' #' # A projection band, labeled on each edge -#' ggplot(mtcars, aes(disp, mpg)) + +#' ggplot(iris, aes(Petal.Length, Sepal.Length)) + #' geom_point() + #' geom_slice(model, band = TRUE) + #' geom_slice_text() #' +#' # Labels take the color of their group +#' model2 <- lm(hwy ~ displ * drv + cyl, data = mpg) +#' ggplot(mpg, aes(displ, hwy, color = drv)) + +#' geom_point() + +#' geom_slice(model2, predict_vars = list(cyl = c(4, 8))) + +#' geom_slice_text() +#' +#' # Lines defined by several variables read best with a corner key +#' ggplot(mpg, aes(displ, hwy)) + +#' geom_point() + +#' geom_slice(model2, predict_vars = list(cyl = c(4, 8), drv = c("f", "r"))) + +#' geom_slice_text(style = "legend") +#' #' @export geom_slice_text <- function(style = "variable", location = "right", diff --git a/R/scatter_3d.R b/R/scatter_3d.R index 1102de9..015a282 100644 --- a/R/scatter_3d.R +++ b/R/scatter_3d.R @@ -22,16 +22,12 @@ #' #' @examples #' if (interactive()) { -#' # A flat regression plane over two predictors -#' model <- lm(mpg ~ disp + hp, data = mtcars) +#' # Transformed terms graph over their raw predictors +#' model <- lm(mpg ~ wt + I(wt^2) + hp, data = mtcars) #' scatter_3d(model) #' #' # Custom marker gradient and a finer surface grid -#' scatter_3d(model, n = 200, colors = c("blue", "yellow")) -#' -#' # Transformed terms graph over their raw predictors -#' curved <- lm(mpg ~ wt + I(wt^2) + hp, data = mtcars) -#' scatter_3d(curved) +#' scatter_3d(model, n = 200, colors = c("purple", "orange")) #' #' # Interaction models produce a twisted (non-planar) surface #' twisted <- lm(Sepal.Length ~ Sepal.Width * Petal.Length, data = iris) diff --git a/R/slice_2d.R b/R/slice_2d.R index c2cb063..26a162d 100644 --- a/R/slice_2d.R +++ b/R/slice_2d.R @@ -40,11 +40,14 @@ #' @importFrom grDevices adjustcolor #' #' @examples -#' model <- lm(mpg ~ disp, data = mtcars) -#' slice_2d(model, x_axis = 'disp') +#' model <- lm(log(mpg) ~ disp + hp, data = mtcars) +#' slice_2d(model) +#' +#' # Choose the x-axis, hold disp at a value, and style the line +#' slice_2d(model, x_axis = "hp", disp = 250, n = 150, col = "blue", lwd = 2) #' #' # With a 95% confidence band around the line -#' slice_2d(model, x_axis = 'disp', interval = "confidence") +#' slice_2d(model, interval = "confidence") #' #' @export slice_2d <- function(model, x_axis = NULL, n = 100, caption = TRUE, @@ -123,9 +126,14 @@ slice_2d <- function(model, x_axis = NULL, n = 100, caption = TRUE, #' @returns A line added to a preexisting R plot displaying a 2D graphable slice of an HD model #' #' @examples -#' model <- lm(mpg ~ disp + hp, data = mtcars) +#' model <- lm(log(mpg) ~ disp + hp, data = mtcars) +#' plot(mpg ~ disp, data = mtcars) +#' add_slice_2d(model) +#' +#' # Multiple slices on one plot #' plot(mpg ~ disp, data = mtcars) -#' add_slice_2d(model, x_axis = 'disp', hp = 100) +#' add_slice_2d(model, hp = min(mtcars$hp), col = "blue") +#' add_slice_2d(model, hp = max(mtcars$hp), col = "red", lty = 2) #' #' @export add_slice_2d <- function(model, x_axis = NA, n = 100, caption = FALSE, diff --git a/man/Applr-package.Rd b/man/Applr-package.Rd index 46f4970..f5ed650 100644 --- a/man/Applr-package.Rd +++ b/man/Applr-package.Rd @@ -34,21 +34,22 @@ Core capabilities: \section{Quick start}{ -Fit a model and plot a slice: +Fit a model, then see it in one call: \preformatted{ library(Applr) -model <- lm(mpg ~ disp + hp, data = mtcars) -slice_2d(model, x_axis = "disp") +model <- lm(mpg ~ qsec + am, data = mtcars) +autoplot(model) } -ggplot2 layer with facets: +Or build the plot yourself with a geom_slice() layer: \preformatted{ library(ggplot2) -model <- lm(mpg ~ disp + hp + cyl, data = mtcars) -ggplot(mtcars, aes(disp, mpg)) + +model <- lm(hwy ~ displ * drv + cyl, data = mpg) +ggplot(mpg, aes(displ, hwy, color = drv)) + geom_point() + - facet_wrap(~cyl) + - geom_slice(model = model, predict_vars = list(hp = 110)) + geom_slice(model, band = TRUE) + + geom_slice_text() + + geom_slice_subtitle() } } diff --git a/man/add_slice_2d.Rd b/man/add_slice_2d.Rd index 04fa389..83fbbfd 100644 --- a/man/add_slice_2d.Rd +++ b/man/add_slice_2d.Rd @@ -51,8 +51,13 @@ than creating a new one. Useful for overlaying multiple model slices or adding model predictions to scatter plots. } \examples{ -model <- lm(mpg ~ disp + hp, data = mtcars) +model <- lm(log(mpg) ~ disp + hp, data = mtcars) plot(mpg ~ disp, data = mtcars) -add_slice_2d(model, x_axis = 'disp', hp = 100) +add_slice_2d(model) + +# Multiple slices on one plot +plot(mpg ~ disp, data = mtcars) +add_slice_2d(model, hp = min(mtcars$hp), col = "blue") +add_slice_2d(model, hp = max(mtcars$hp), col = "red", lty = 2) } diff --git a/man/autoplot.lm.Rd b/man/autoplot.lm.Rd index 7ecc66e..73461b7 100644 --- a/man/autoplot.lm.Rd +++ b/man/autoplot.lm.Rd @@ -73,30 +73,28 @@ automatically back-transformed to match the raw y-axis. \examples{ library(ggplot2) -# A complete plot from a model in one call -autoplot(lm(mpg ~ disp, data = mtcars)) +# A complete plot from a model in one call; summary() prints to the console +autoplot(lm(Petal.Length ~ Sepal.Length + I(Sepal.Length^2):Species, iris)) -# Predictors not on the plot are imputed (a message says how) -autoplot(lm(mpg ~ disp + hp, data = mtcars)) +# Predictors that group into a few values become color, then facets +model <- lm(hwy ~ displ + drv + cyl, data = mpg) +autoplot(model, summary = FALSE) -# Choose which predictor goes on the x-axis -autoplot(lm(mpg ~ disp + hp, data = mtcars), mapping = aes(x = hp)) +# Change the defaults like a normal ggplot; the rest is still inferred +autoplot(model, aes(color = factor(cyl)), summary = FALSE) + facet_wrap(~drv) -# Transformed response, back-transformed onto the raw mpg axis -autoplot(lm(log(mpg) ~ disp, data = mtcars)) - -# Options pass through to geom_slice(); the result is a normal ggplot -autoplot(lm(mpg ~ disp + hp, data = mtcars), - predict_vars = list(hp = 110), interval = "prediction") + - labs(title = "Slice at hp = 110") +# Choose the x-axis and pass geom_slice() options through +autoplot(model, + aes(x = cyl, color = factor(drv)), + interval = "none", summary = FALSE) + + labs(title = "The Same Model From a Different Angle") -# Extra aesthetics for the scatter (mapping goes to ggplot()) -autoplot(lm(mpg ~ hp + factor(cyl), data = mtcars), - mapping = aes(color = factor(cyl))) +# Transformed response, back-transformed onto the raw mpg axis +autoplot(lm(log(mpg) ~ disp + hp, data = mtcars), summary = FALSE) -# An interactive 3-D surface for a two-predictor model +# An interactive 3-D surface for a model with two numeric predictors if (interactive()) { - autoplot(lm(mpg ~ disp + hp, data = mtcars), type = "3d") + autoplot(lm(mpg ~ wt + I(wt^2) + hp, data = mtcars), type = "3d") } } diff --git a/man/geom_slice.Rd b/man/geom_slice.Rd index 6c9fc6a..b04c245 100644 --- a/man/geom_slice.Rd +++ b/man/geom_slice.Rd @@ -91,69 +91,72 @@ and transformed scales (\code{scale_x_log10()}) are also handled. \examples{ library(ggplot2) -# Basic use, like geom_smooth() but drawing *your* model. hp is not on -# the plot, so it is held at its mean (a console message says so). -model <- lm(mpg ~ disp + hp, data = mtcars) -ggplot(mtcars, aes(disp, mpg)) + +# Basic use, like geom_smooth() but drawing *your* model. Sepal.Width is +# not on the plot, so it is held at its mean (a console message says so). +model <- lm(Sepal.Length ~ Sepal.Width + Petal.Length, data = iris) +ggplot(iris, aes(Petal.Length, Sepal.Length)) + geom_point() + geom_slice(model) -# Choose the slice yourself -ggplot(mtcars, aes(disp, mpg)) + - geom_point() + - geom_slice(model, predict_vars = list(hp = 110)) - # Several values draw one line per value (label them with # geom_slice_text()); several multi-value variables are crossed -ggplot(mtcars, aes(disp, mpg)) + +ggplot(iris, aes(Petal.Length, Sepal.Length)) + geom_point() + - geom_slice(model, predict_vars = list(hp = c(66, 150, 335))) + geom_slice(model, predict_vars = list(Sepal.Width = c(2, 3, 4))) + + geom_slice_text() # Confidence or prediction ribbon around the line -ggplot(mtcars, aes(disp, mpg)) + +model2 <- lm(hwy ~ displ + I(displ^2), data = mpg) +ggplot(mpg, aes(displ, hwy)) + geom_point() + - geom_slice(model, predict_vars = list(hp = 110), interval = "confidence") + geom_slice(model2, interval = "prediction") # A grouping aesthetic pins its predictor to each group's own value: -# one line per cylinder count, each with its own slope -model2 <- lm(mpg ~ disp * cyl, data = mtcars) -ggplot(mtcars, aes(disp, mpg, color = factor(cyl))) + +# one line per drive type, each stopping at the end of its group's data +model3 <- lm(hwy ~ displ + I(displ^2) + displ:drv, data = mpg) +ggplot(mpg, aes(displ, hwy, color = drv)) + geom_point() + - geom_slice(model2) + geom_slice(model3) -# full_range = TRUE extends each group's line across the whole panel, -# not just its own data range -ggplot(mtcars, aes(disp, mpg, color = factor(cyl))) + +# full_range = TRUE extends each group's line across the whole panel +ggplot(mpg, aes(displ, hwy, color = drv)) + geom_point() + - geom_slice(model2, full_range = TRUE) + geom_slice(model3, full_range = TRUE) # Facet variables pin per panel the same way -ggplot(mtcars, aes(disp, mpg)) + +ggplot(mpg, aes(displ, hwy)) + geom_point() + - geom_slice(model2) + - facet_wrap(~ cyl) + geom_slice(model3) + + facet_wrap(~drv) -# A transformed response is back-transformed automatically: the model -# predicts log(mpg), the line appears in raw mpg units (a message says so) -model3 <- lm(log(mpg) ~ disp + hp, data = mtcars) -ggplot(mtcars, aes(disp, mpg)) + +# A projection band shows the reach of a predictor, here cyl from 5 to 7; +# band = TRUE infers the variable and its data range when it can +model4 <- lm(hwy ~ displ * drv + cyl, data = mpg) +ggplot(mpg, aes(displ, hwy, color = drv)) + geom_point() + - geom_slice(model3) + geom_slice(model4, band = "cyl", predict_vars = list(cyl = c(5, 7))) -# ... or control the mapping yourself with back_transform +# A transformed response is back-transformed to match the y-axis: the +# model predicts log(mpg), the line appears in raw mpg units +model5 <- lm(log(mpg) ~ disp + hp, data = mtcars) ggplot(mtcars, aes(disp, mpg)) + geom_point() + - geom_slice(model3, back_transform = exp) + geom_slice(model5) -# A projection band spanning hp between two values, instead of a line +# ... adapts when the axis itself is transformed +ggplot(mtcars, aes(disp, log(mpg))) + + geom_point() + + geom_slice(model5) + +# ... or control the mapping yourself with back_transform ggplot(mtcars, aes(disp, mpg)) + geom_point() + - geom_slice(model, predict_vars = list(hp = c(66, 335)), band = "hp") + geom_slice(model5, back_transform = exp) # n controls how many prediction points make up the line ggplot(mtcars, aes(disp, mpg)) + geom_point() + - geom_slice(model, predict_vars = list(hp = 110), n = 10) + geom_slice(model5, n = 10) } \seealso{ diff --git a/man/geom_slice_caption.Rd b/man/geom_slice_caption.Rd index c23c2a0..f7d57dd 100644 --- a/man/geom_slice_caption.Rd +++ b/man/geom_slice_caption.Rd @@ -53,11 +53,13 @@ or \code{\link[=geom_slice_text]{geom_slice_text()}} already label it, and every \examples{ library(ggplot2) -# Caption reports the model equation and that hp is held at its mean -model <- lm(mpg ~ disp + hp, data = mtcars) -ggplot(mtcars, aes(disp, mpg)) + +# Caption reports the model equation and the held Sepal.Width; Species +# is already shown by the legend, so it is left out +model <- lm(Petal.Length ~ Sepal.Length + I(Sepal.Length^2):Species + + Sepal.Width, data = iris) +ggplot(iris, aes(Sepal.Length, Petal.Length, color = Species)) + geom_point() + - geom_slice(model) + + geom_slice(model, interval = "confidence") + geom_slice_caption() } diff --git a/man/geom_slice_subtitle.Rd b/man/geom_slice_subtitle.Rd index 1b54ac7..bed6acf 100644 --- a/man/geom_slice_subtitle.Rd +++ b/man/geom_slice_subtitle.Rd @@ -62,11 +62,13 @@ the line is dropped entirely. \examples{ library(ggplot2) -# Subtitle reports the model equation and that hp is held at its mean -model <- lm(mpg ~ disp + hp, data = mtcars) -ggplot(mtcars, aes(disp, mpg)) + +# Subtitle reports the model equation and the held Sepal.Width; Species +# is already shown by the legend, so it is left out +model <- lm(Petal.Length ~ Sepal.Length + I(Sepal.Length^2):Species + + Sepal.Width, data = iris) +ggplot(iris, aes(Sepal.Length, Petal.Length, color = Species)) + geom_point() + - geom_slice(model) + + geom_slice(model, interval = "confidence") + geom_slice_subtitle() } diff --git a/man/geom_slice_text.Rd b/man/geom_slice_text.Rd index 241ea05..46874cd 100644 --- a/man/geom_slice_text.Rd +++ b/man/geom_slice_text.Rd @@ -63,19 +63,32 @@ inherits its line's color. \examples{ library(ggplot2) -# Two visually identical lines, told apart by their labels -model <- lm(mpg ~ disp + hp, data = mtcars) -ggplot(mtcars, aes(disp, mpg)) + +# One label per predict_vars value +model <- lm(Sepal.Length ~ Sepal.Width + Petal.Length, data = iris) +ggplot(iris, aes(Petal.Length, Sepal.Length)) + geom_point() + - geom_slice(model, predict_vars = list(hp = c(66, 335))) + + geom_slice(model, predict_vars = list(Sepal.Width = c(2, 3, 4))) + geom_slice_text() # A projection band, labeled on each edge -ggplot(mtcars, aes(disp, mpg)) + +ggplot(iris, aes(Petal.Length, Sepal.Length)) + geom_point() + geom_slice(model, band = TRUE) + geom_slice_text() +# Labels take the color of their group +model2 <- lm(hwy ~ displ * drv + cyl, data = mpg) +ggplot(mpg, aes(displ, hwy, color = drv)) + + geom_point() + + geom_slice(model2, predict_vars = list(cyl = c(4, 8))) + + geom_slice_text() + +# Lines defined by several variables read best with a corner key +ggplot(mpg, aes(displ, hwy)) + + geom_point() + + geom_slice(model2, predict_vars = list(cyl = c(4, 8), drv = c("f", "r"))) + + geom_slice_text(style = "legend") + } \seealso{ \code{\link[=geom_slice]{geom_slice()}} for the layers being labeled; diff --git a/man/scatter_3d.Rd b/man/scatter_3d.Rd index 76aa9c7..d694ec0 100644 --- a/man/scatter_3d.Rd +++ b/man/scatter_3d.Rd @@ -34,16 +34,12 @@ fine — the surface is evaluated with \code{\link[=predict]{predict()}} on the } \examples{ if (interactive()) { - # A flat regression plane over two predictors - model <- lm(mpg ~ disp + hp, data = mtcars) + # Transformed terms graph over their raw predictors + model <- lm(mpg ~ wt + I(wt^2) + hp, data = mtcars) scatter_3d(model) # Custom marker gradient and a finer surface grid - scatter_3d(model, n = 200, colors = c("blue", "yellow")) - - # Transformed terms graph over their raw predictors - curved <- lm(mpg ~ wt + I(wt^2) + hp, data = mtcars) - scatter_3d(curved) + scatter_3d(model, n = 200, colors = c("purple", "orange")) # Interaction models produce a twisted (non-planar) surface twisted <- lm(Sepal.Length ~ Sepal.Width * Petal.Length, data = iris) diff --git a/man/slice_2d.Rd b/man/slice_2d.Rd index 790fe6c..6195bac 100644 --- a/man/slice_2d.Rd +++ b/man/slice_2d.Rd @@ -53,10 +53,13 @@ to be the first predictor in the model and all other variable are imputed (mean for numeric, first level for factors). } \examples{ -model <- lm(mpg ~ disp, data = mtcars) -slice_2d(model, x_axis = 'disp') +model <- lm(log(mpg) ~ disp + hp, data = mtcars) +slice_2d(model) + +# Choose the x-axis, hold disp at a value, and style the line +slice_2d(model, x_axis = "hp", disp = 250, n = 150, col = "blue", lwd = 2) # With a 95\% confidence band around the line -slice_2d(model, x_axis = 'disp', interval = "confidence") +slice_2d(model, interval = "confidence") } diff --git a/vignettes/Applr.Rmd b/vignettes/Applr.Rmd index 6c78dcb..f273fa8 100644 --- a/vignettes/Applr.Rmd +++ b/vignettes/Applr.Rmd @@ -17,120 +17,274 @@ knitr::opts_chunk$set( ``` A fitted linear model with more than one predictor lives in more dimensions -than a scatterplot can show. The usual workaround — `geom_smooth(method = -"lm")` — quietly fits a *different*, single-predictor model to the plotted -variables, so the line on the screen is not the model you summarized. +than a scatterplot can show. The usual workaround, `geom_smooth(method = +"lm")`, quietly fits a *different*, simpler model to the plotted variables, so +the line on the screen is not the model you summarized. Applr draws the model you actually fit. Its core idea is the **slice**: hold every predictor except one at a fixed value, and draw the model's predictions -as that one predictor varies. This vignette walks through the workflow on a -single dataset, `mtcars`. +as that one predictor varies. Start by fitting an `lm()`, then hand it to +Applr. Explore it with `autoplot()`, or present it with polish and +fine-grained control using `geom_slice()`. ```{r setup, message = FALSE} library(Applr) library(ggplot2) ``` -## Fit a model, then autoplot() it +## Explore with autoplot() -Start with a model where `mpg` depends on two predictors: +`autoplot()` on an `lm` builds the whole plot in one call: the model's own data +as a scatter, a fitted slice line with its confidence ribbon, and a subtitle +saying what the model is. It also prints `summary()` to the console, so you +can refit, re-plot, and read the coefficients and R² in one step (turn this off +with `summary = FALSE`). ```{r} -model <- lm(mpg ~ disp + hp, data = mtcars) -lm_equation(model) +autoplot(lm(Petal.Length ~ Sepal.Length + I(Sepal.Length^2):Species, iris)) ``` -`autoplot()` is the quickest way to see it. It rebuilds the scatterplot from -the model's own data, picks the first numeric predictor for the x-axis, and -adds a slice line with its confidence ribbon — plus a subtitle recording -which values the other predictors were held at: +`autoplot()` makes a few decisions for you. The model's first numeric +predictor goes on the x-axis, and predictors that group into a few discrete +values become `color`, then facets. Every decision can be overridden. Pass a +`mapping` to change the defaults, just as you would with `ggplot()`; whatever +you leave out is still inferred. Choose a different x-axis with +`aes(x = ...)`. Arguments in `...` pass through to `geom_slice()`, so +`interval = "prediction"` gives the wider ribbon and `interval = "none"` a +bare line. -```{r} -autoplot(model) -``` +```{r, results = "hide"} +model <- lm(hwy ~ displ + drv + cyl, data = mpg) -The message tells you what happened: `hp` was not on an axis, so the line -holds it at its mean. Use `mapping = aes(x = ...)` to slice along a different -predictor, and pass any `geom_slice()` argument through `...`: +autoplot(model, aes(color = factor(cyl))) + facet_wrap(~drv) -```{r} -autoplot(model, mapping = aes(x = hp), interval = "prediction") +autoplot(model, + aes(x = cyl, color = factor(drv)), + interval = "none") + + labs(title = "The Same Model From a Different Angle") ``` -## Build the plot yourself with geom_slice() +The result is an ordinary ggplot, so `+` works as usual. + +## Present with geom_slice() + +`geom_slice()` is the layer underneath `autoplot()`. It looks like +`geom_smooth()`, but where `geom_smooth()` fits its own model to the plotted +data, `geom_slice()` draws the model *you* fitted, reading the plot's `aes()` +to learn which predictor is on the x-axis. Unlike `autoplot()`, it makes as +few decisions as it can. + +Once a model has more than one predictor, each line is a 2-D slice through it. +Every predictor not on the x-axis has to be held at some value, and +`geom_slice()` fills those values in this order: + +- Variables named in `predict_vars` are held at your chosen values. +- Variables mapped to a grouping aesthetic (`aes(color = g)`) are held at each + group's value, giving one line per group. +- Facet variables are held at each panel's value. +- Anything left over is imputed (mean for numeric, most common value for + factors), with a console message naming the value used. + +The model below has four predictors and was fitted exactly, with no noise. A +bare `geom_slice()` has to impute three of them, and the console messages +report each choice: + +```{r, message = TRUE, fig.show = "hold", out.width = "49%", fig.width = 4, fig.height = 3.2} +set.seed(123) +n <- 80 +x <- runif(n, 0.1, 10) +x2 <- runif(n, 0.1, 10) +x3 <- sample(c(1, 20, 40), n, replace = TRUE) +x4 <- sample(c(1, 2), n, replace = TRUE) +y <- log(5 + x + x2 + x3 + 1/5 * x * x3 + 80 * x4) # no random noise +dat <- data.frame(x, x2, x3, x4, y) + +model <- lm(exp(y) ~ x*x3 + x2 + x4, data = dat) # exact model fit + +ggplot(dat, aes(x, y)) + + geom_point() + + geom_slice(model) + + labs(title = "A Perfectly Fit Model 'Slice'") + +# The same model against its full linear predictor: an exact fit +ggplot(dat, aes(x = log(5 + x + x2 + x3 + 1/5 * x * x3 + 80 * x4), y)) + + geom_point() + + geom_slice(model) + + labs(title = "Same Model, Different X-Axis") +``` -For full control, add `geom_slice()` to an ordinary ggplot. The layer reads -the plot's `aes()` to learn which predictor is on x, and predicts from your -model — no separate model is fit: +Notice that the response `exp(y)` was back-transformed onto the plotted `y` +axis without being asked. Those imputations were forced, but you can do better. +Map `x3` to color, facet by `x4`, and show the reach of `x2` as a band, and +every line lands on its points: ```{r} -ggplot(mtcars, aes(x = disp, y = mpg)) + +ggplot(dat, aes(x, y, color = factor(x3))) + geom_point() + - geom_slice(model) + geom_slice(model, band = "x2", predict_vars = list(x2 = c(0, 10))) + + facet_wrap(~x4) + + geom_slice_text() + + geom_slice_subtitle() ``` -### Choosing the slice +The rest of this vignette goes through those features one at a time. -`predict_vars` pins the off-axis predictors to values you choose instead of -their means. Give a predictor several values and you get one line per value — -a small multiple of slices through the same model: +### Choosing slices with predict_vars + +Give a variable several values in `predict_vars` to draw one line per value. +Several multi-value variables are crossed. ```{r} -ggplot(mtcars, aes(x = disp, y = mpg)) + +model <- lm(Sepal.Length ~ Sepal.Width + Petal.Length, iris) + +ggplot(iris, aes(Petal.Length, Sepal.Length)) + geom_point() + - geom_slice(model, predict_vars = list(hp = c(66, 150, 335))) + geom_slice( + model, + predict_vars = list(Sepal.Width = c(2, 3, 4)), + interval = "confidence" + ) + + geom_slice_text() ``` -### Intervals +### Confidence and prediction intervals `interval = "confidence"` or `"prediction"` shades the corresponding `predict.lm()` interval around each line: +```{r, fig.show = "hold", out.width = "49%", fig.width = 4, fig.height = 3.2} +model <- lm(hwy ~ displ + I(displ^2), data = mpg) + +ggplot(mpg, aes(displ, hwy)) + + geom_point() + + geom_slice(model, interval = "confidence") + + labs(title = "Confidence Interval") + +ggplot(mpg, aes(displ, hwy)) + + geom_point() + + geom_slice(model, interval = "prediction") + + labs(title = "Prediction Interval") +``` + +### Projection bands + +An interval shows uncertainty. A `band` shows the *reach of a predictor*: two +edge slices with a translucent ribbon between them. `band = "variable"` spans +that predictor between the values given in `predict_vars`, or across its +observed range if `predict_vars` doesn't mention it. `band = TRUE` infers the +variable when there is only one sensible choice. + ```{r} -ggplot(mtcars, aes(x = disp, y = mpg)) + +model <- lm(hwy ~ displ * drv + cyl, data = mpg) + +# Inferred: cyl is the only predictor not shown, so it spans 4 to 8 +ggplot(mpg, aes(displ, hwy, color = drv)) + + geom_point() + + geom_slice(model, band = TRUE) + + geom_slice_text() + +# Specified: cyl from 5 to 7 +ggplot(mpg, aes(displ, hwy, color = drv)) + geom_point() + - geom_slice(model, predict_vars = list(hp = 150), interval = "prediction") + geom_slice(model, band = "cyl", predict_vars = list(cyl = c(5, 7))) + + geom_slice_text() ``` -## Labeling the slices +`band` cannot be combined with `interval`. -Three companion helpers describe the slices on the plot itself, so a reader -can tell which line is which and what was held constant. +### Transformed responses -`geom_slice_text()` labels the end of each line with its held value; -`geom_slice_caption()` writes the slice description under the plot: +If the model's response is transformed but the plot shows something else, +predictions are back-transformed to match the y-axis, and a console message +says so. Turn this off with `back_transform = FALSE`, or pass a function or +name (`exp`, `"log10"`, ...) to override the auto-detection. -```{r} -ggplot(mtcars, aes(x = disp, y = mpg)) + +```{r, fig.show = "hold", out.width = "33%", fig.width = 2.5, fig.height = 3.2} +model <- lm(log(mpg) ~ disp + hp, data = mtcars) + +ggplot(mtcars, aes(disp, mpg)) + geom_point() + - geom_slice(model, predict_vars = list(hp = c(66, 150, 335))) + - geom_slice_text() + - geom_slice_caption() + geom_slice(model) + + labs(title = "normal y axis") + +ggplot(mtcars, aes(disp, log(mpg))) + + geom_point() + + geom_slice(model) + + labs(title = "log() y axis") + +ggplot(mtcars, aes(disp, mpg)) + + geom_point() + + geom_slice(model) + + scale_y_log10() + + labs(title = "scale_y_log10() axis") +``` + +### Grouping: one line per group + +With a grouping aesthetic, each group gets its own slice, and each line stops +at the end of its group's data. `full_range = TRUE` extends every line across +the whole panel instead, like `fullrange` in `geom_smooth()`: + +```{r, fig.show = "hold", out.width = "49%", fig.width = 4, fig.height = 3.2} +model <- lm(hwy ~ displ + I(displ^2) + displ:drv, data = mpg) + +ggplot(mpg, aes(displ, hwy, color = drv)) + + geom_point() + + geom_slice(model) + +ggplot(mpg, aes(displ, hwy, color = drv)) + + geom_point() + + geom_slice(model, full_range = TRUE) ``` -(`geom_slice_subtitle()` is the third helper — it puts the model equation and -held values in the subtitle, and is what `autoplot()` uses by default.) +## Labeling the slices + +Three companion layers describe the slices on the plot itself, so a reader can +tell which line is which and what was held constant. They take no model; they +read everything from the plot's `geom_slice()` layers, so add them *after* +those layers. -## Grouping and faceting +`geom_slice_text()` labels the end of each line with the values that define +it. It is most useful with bands and multi-value `predict_vars`: + +```{r, fig.width = 7.5} +set.seed(123) +n <- 80 +x <- runif(n, -10, 10) +x2 <- runif(n, 0, 4) +g <- factor(sample(c("A", "B"), n, replace = TRUE)) +y <- x * ifelse(g == "A", 0.5, 2) + ifelse(g == "A", 5, -5) + 4 * x2 + rnorm(n) +dat <- data.frame(x, x2, g, y) +model <- lm(y ~ x * g + x2, data = dat) + +ggplot(dat, aes(x, y)) + + geom_point(alpha = 0.5) + + geom_slice(model, predict_vars = list(x2 = c(0, 2, 4), g = c("A", "B"))) + + geom_slice_text(style = "legend") +``` -Slices respect the plot's grouping and faceting. With a model that includes -the grouping variable, each group gets its own correctly-sliced line: +`geom_slice_subtitle()` (or `geom_slice_caption()`) writes the model equation +and any held values that aren't already shown by the legend, facets, or +`geom_slice_text()`. It indents the equation when there's room and compresses +it when space is tight. ```{r} -model_cyl <- lm(mpg ~ disp * cyl, data = mtcars) +model <- lm(Petal.Length ~ Sepal.Length + I(Sepal.Length^2):Species + Sepal.Width, iris) -ggplot(mtcars, aes(x = disp, y = mpg, color = factor(cyl))) + +ggplot(iris, aes(Sepal.Length, Petal.Length, color = Species)) + geom_point() + - geom_slice(model_cyl) + geom_slice(model, interval = "confidence") + + geom_slice_subtitle() ``` ## Where to go next -- `?geom_slice` covers the remaining options: projection bands (`band`), - extending lines across the panel (`full_range`), transformed responses and - `back_transform`, and the `n` resolution of the line. -- `?slice_2d` is the base-graphics equivalent of this whole workflow. -- `?scatter_3d` (or `autoplot(model, type = "3d")`) shows a two-predictor - model as an interactive 3-D surface instead of a slice. +- `?geom_slice` documents every option, including `n`, the number of points + that make up each line. +- `?geom_slice_text` and `?geom_slice_subtitle` cover label styles, + placement, and `prepend`/`append` text. +- `?slice_2d` and `?add_slice_2d` draw the same slices in base graphics. +- `?scatter_3d` (or `autoplot(model, type = "3d")`) shows a model with two + numeric predictors as an interactive 3-D surface. - `?lm_equation` and `?lm_latex` turn the fitted model into text or LaTeX for - reports. + reports, and `?diagnose` draws the standard residual plots. From 52ea5949d2aab022a1d2e663c6a6c01ca0845512 Mon Sep 17 00:00:00 2001 From: James Beeson Date: Tue, 13 Oct 2026 15:35:44 -0600 Subject: [PATCH 7/9] avoided displaying known `facet_wrap`/`geom_slice_subtitle` integration issue. --- R/autoplot.lm.R | 7 ++-- README.Rmd | 34 +++++++++---------- README.md | 38 +++++++++++----------- man/figures/README-autoplot-mapping-1.png | Bin 15232 -> 14914 bytes tests/report.html | 2 +- 5 files changed, 41 insertions(+), 40 deletions(-) diff --git a/R/autoplot.lm.R b/R/autoplot.lm.R index 65f186d..c4e8123 100644 --- a/R/autoplot.lm.R +++ b/R/autoplot.lm.R @@ -242,10 +242,11 @@ autoplot.lm <- function(object, mapping = NULL, type = c("2d", "3d"), plot <- ggplot(model_data, plot_mapping) + geom_point() + - geom_slice(object, interval = interval, ...) + - geom_slice_subtitle() + geom_slice(object, interval = interval, ...) + # The facet must come before the subtitle, which only skips facet variables + # already on the plot when it is added if (!is.null(facet_var)) { plot <- plot + facet_wrap(vars(!!as.name(facet_var))) } - plot + plot + geom_slice_subtitle() } diff --git a/README.Rmd b/README.Rmd index b84c5f8..2c7f531 100644 --- a/README.Rmd +++ b/README.Rmd @@ -58,7 +58,7 @@ library(Applr) ## Quick start -```{r quickstart-autoplot, results = "hide", fig.keep = "first", fig.show = "hold", fig.alt = "autoplot() of an lm: scatter plot with the fitted slice line"} +```{r quickstart-autoplot, results = "hide", fig.keep = "first", fig.show = "hold", fig.alt = "autoplot() of lm(mpg ~ qsec + am): mpg against qsec, one slice line with a confidence ribbon per am value"} library(Applr) # One call: scatter + fitted line + label from any lm() @@ -89,7 +89,7 @@ other statistics (override with `summary = FALSE`). The result is a regular ggplot you can extend with `mapping` and `+` as usual. -```{r autoplot, fig.alt = "autoplot() with a confidence interval and a custom title"} +```{r autoplot, fig.alt = "autoplot() of an iris model: Petal.Length against Sepal.Length with a curved slice and confidence ribbon per Species, and the model equation as subtitle"} autoplot(lm(Petal.Length ~ Sepal.Length + I(Sepal.Length^2):Species, iris)) ``` @@ -102,7 +102,7 @@ aesthetics such as `color`. Everything else in `...` is passed on to `geom_slice()` or `geom_slice_subtitle()`. Pass `interval = "prediction"` for the wider ribbon, or `interval = "none"` for a bare line. -```{r autoplot-mapping, results = "hide", fig.alt = "autoplot() with an x-axis override and a color mapping"} +```{r autoplot-mapping, results = "hide", fig.alt = c("autoplot() of hwy against displ, colored by cyl and faceted by drv", "The same model with cyl on the x-axis, colored by drv, as bare lines without ribbons")} model <- lm(hwy ~ displ + drv + cyl, data = mpg) # Change the defaults like a normal ggplot; it will still infer the rest @@ -156,7 +156,7 @@ In this example, the fitted model with 4 predictors can't be plotted as a line without making multiple assumptions. The console messages clarify the decisions it HAD to make in order to plot the 2d slice. -```{r minimal, message = TRUE, fig.show = "hold", out.width = "49%", fig.width = 4, fig.height = 3.2, fig.alt = "geom_slice() base functionality with few assumptions made"} +```{r minimal, message = TRUE, fig.show = "hold", out.width = "49%", fig.width = 4, fig.height = 3.2, fig.alt = c("A single slice of a four-predictor model through scattered points, with the other predictors imputed", "The same model plotted against its full linear predictor, with every point on the line")} set.seed(123) n <- 80 x <- runif(n, 0.1, 10) @@ -185,7 +185,7 @@ Those assumptions had to be made, but you can make better ones. This plot shows the same model far clearer by utilizing several features `geom_slice()` offers. -```{r geom-slice, fig.alt = "geom_slice() drawing the model's line using color, facet, band, and predict_vars"} +```{r geom-slice, fig.alt = "The four-predictor model as projection bands over x2 from 0 to 10, one color per x3 value, faceted by x4, with every point inside its band"} ggplot(dat, aes(x, y, color = factor(x3))) + geom_point() + geom_slice(model, band = "x2", predict_vars = list(x2 = c(0, 10))) + @@ -199,7 +199,7 @@ ggplot(dat, aes(x, y, color = factor(x3))) + Give a variable several values to draw one line per value; several multi-value variables are crossed: -```{r predict-vars, fig.alt = "Three slice lines of the same model, one per hp value"} +```{r predict-vars, fig.alt = "Three labeled slice lines of Sepal.Length against Petal.Length, one per Sepal.Width value of 2, 3, and 4, with confidence ribbons"} model <- lm(Sepal.Length ~ Sepal.Width + Petal.Length, iris) ggplot(iris, aes(Petal.Length, Sepal.Length)) + @@ -217,7 +217,7 @@ ggplot(iris, aes(Petal.Length, Sepal.Length)) + `interval = "confidence"` or `"prediction"` adds the corresponding `predict.lm()` ribbon around the line: -```{r interval, fig.show = "hold", out.width = "49%", fig.width = 4, fig.height = 3.2, fig.alt = "Slice line with a prediction-interval ribbon"} +```{r interval, fig.show = "hold", out.width = "49%", fig.width = 4, fig.height = 3.2, fig.alt = c("Quadratic slice of hwy against displ with a confidence ribbon", "The same slice with a wider prediction ribbon")} model <- lm(hwy ~ displ + I(displ^2) + displ, data = mpg) ggplot(mpg, aes(displ, hwy)) + @@ -239,7 +239,7 @@ make a decision about what the band should project over. `band = "variable"` spans that predictor between the values you gave in `predict_vars`, or its observed data range when `predict_vars` leaves it out: -```{r band, fig.alt = "Projection band spanning hp from 66 to 335"} +```{r band, fig.alt = c("One projection band per drv spanning cyl from 4 to 8, labeled at each edge", "One projection band per drv spanning cyl from 5 to 7, labeled at each edge")} model <- lm(hwy ~ displ * drv + cyl, data = mpg) # Projection band infered using the min and max of an unused variable @@ -267,7 +267,7 @@ shows raw `y`, predictions are back-transformed automatically to match the y-axis (a message says so). Use `back_transform = FALSE` to turn this off, or pass a function/name (`exp`, `"log10"`, ...) to override the auto-detection. -```{r back-transform, fig.show = "hold", out.width = "33%", fig.width = 2.5, fig.height = 3.2, fig.alt = "Back-transformed slice of a log-response model on the raw mpg axis"} +```{r back-transform, fig.show = "hold", out.width = "33%", fig.width = 2.5, fig.height = 3.2, fig.alt = c("A log(mpg) model back-transformed onto a raw mpg axis", "The same model on a log(mpg) axis", "The same model on a scale_y_log10() axis")} model <- lm(log(mpg) ~ disp + hp, data = mtcars) ggplot(mtcars, aes(disp, mpg)) + @@ -293,7 +293,7 @@ Each group's line normally stops at its own data range. `full_range = TRUE` extends every line to the edge of the panel instead (like `fullrange` in `geom_smooth()`): -```{r grouping, fig.show = "hold", out.width = "49%", fig.width = 4, fig.height = 3.2, fig.alt = "One slice line per drv group, colored to match the points"} +```{r grouping, fig.show = "hold", out.width = "49%", fig.width = 4, fig.height = 3.2, fig.alt = c("One curved slice per drv group, each ending at its group's data range", "The same slices extended across the full panel with full_range = TRUE")} model <- lm(hwy ~ displ + I(displ^2) + displ:drv, data = mpg) # One slice per drv group, capped at the end of each group @@ -318,7 +318,7 @@ no model or `predict_vars` — everything is borrowed from the plot's existing Writes a label at the end of each slice line; especially useful when `band` or multiple `predict_vars` are specified. -```{r slice-text-band, fig.alt = ""} +```{r slice-text-band, fig.alt = "Projection band over Sepal.Width with each edge labeled by its value"} model <- lm(Sepal.Length ~ Sepal.Width + Petal.Length, iris) ggplot(iris, aes(Petal.Length, Sepal.Length)) + @@ -327,7 +327,7 @@ ggplot(iris, aes(Petal.Length, Sepal.Length)) + geom_slice_text() ``` -```{r slice-text-color, fig.width = 7.5, fig.alt = "Slice lines labeled at their right ends"} +```{r slice-text-color, fig.width = 7.5, fig.alt = "Three slice lines per group g, labeled at their right ends with their x2 value in the group's color"} set.seed(123) n <- 80 @@ -345,7 +345,7 @@ ggplot(dat, aes(x, y, color = g)) + geom_slice_text() ``` -```{r slice-text-multiple, fig.width = 7.5, fig.alt = "geom_slice_text plots labels with multiple predictors"} +```{r slice-text-multiple, fig.width = 7.5, fig.alt = "Six slice lines, one per combination of x2 and g, each labeled with both values at its right end"} # Multiple predictors represent one line ggplot(dat, aes(x, y)) + geom_point(alpha = 0.5) + @@ -353,7 +353,7 @@ ggplot(dat, aes(x, y)) + geom_slice_text() ``` -```{r slice-text-legend, fig.width = 7.5, fig.alt = "geom_slice_text labels multiple predictors with the 'legend' style"} +```{r slice-text-legend, fig.width = 7.5, fig.alt = "The same six slice lines with bare-value labels and a corner key naming x2 and g"} # Identical, with `style = "legend"` ggplot(dat, aes(x, y)) + geom_point(alpha = 0.5) + @@ -371,7 +371,7 @@ Fill the plot subtitle (or caption) with the model equation and the held values the plot does not otherwise show — values already labeled by the legend, facets, or `geom_slice_text()` are skipped: -```{r slice-subtitle, fig.alt = "Plot whose subtitle shows the model equation and the held hp value"} +```{r slice-subtitle, fig.alt = "Curved slices per iris Species with confidence ribbons; the subtitle shows the model equation and the held Sepal.Width value"} model <- lm(Petal.Length ~ Sepal.Length + I(Sepal.Length^2):Species + Sepal.Width, iris) ggplot(iris, aes(Sepal.Length, Petal.Length, color = Species)) + @@ -399,7 +399,7 @@ Create a new base-R plot showing a 2-D slice of a linear model. Unspecified values are held at sensible defaults (numeric → mean, factor → first level) and reported in the caption. -```{r slice-2d, fig.keep = "first", fig.show = "hold", fig.alt = "Base-R slice plot with held values reported in the caption"} +```{r slice-2d, fig.keep = "first", fig.show = "hold", fig.alt = "Base-R plot of mpg against disp with the back-transformed slice line and the held hp value in the caption"} model <- lm(log(mpg) ~ disp + hp, data = mtcars) slice_2d(model) #--or-- @@ -411,7 +411,7 @@ slice_2d(model, x_axis = "hp", disp = 250, n = 150, col = "blue", lwd = 2) Add a 2-D slice line to an *existing* base-R plot. X and Y axis variables must match the plot it is being added to. -```{r add-slice-2d, fig.keep = "last", fig.alt = "Two slice lines added to an existing base-R plot"} +```{r add-slice-2d, fig.keep = "last", fig.alt = "Base-R scatter of mpg against disp with added slices at the lowest hp (blue) and highest hp (red, dashed)"} model <- lm(log(mpg) ~ disp + hp, data = mtcars) plot(mpg ~ disp, data = mtcars) add_slice_2d(model) diff --git a/README.md b/README.md index d522bbf..4b996b7 100644 --- a/README.md +++ b/README.md @@ -53,7 +53,7 @@ ggplot(mtcars, aes(qsec, mpg, color = am)) + geom_slice_subtitle() ``` -autoplot() of an lm: scatter plot with the fitted slice line +autoplot() of lm(mpg ~ qsec + am): mpg against qsec, one slice line with a confidence ribbon per am value Both report helpful messages to the console about what decisions it made, and how you can control those decisions. @@ -98,7 +98,7 @@ autoplot(lm(Petal.Length ~ Sepal.Length + I(Sepal.Length^2):Species, iris)) #> F-statistic: 1655 on 4 and 145 DF, p-value: < 2.2e-16 ``` -autoplot() with a confidence interval and a custom title +autoplot() of an iris model: Petal.Length against Sepal.Length with a curved slice and confidence ribbon per Species, and the model equation as subtitle `autoplot` makes a few decisions for you, but lets you control them. The model’s first numeric predictor goes on the x-axis, and subsequent @@ -117,7 +117,7 @@ model <- lm(hwy ~ displ + drv + cyl, data = mpg) autoplot(model, aes(color = factor(cyl))) + facet_wrap(~drv) ``` -autoplot() with an x-axis override and a color mapping +autoplot() of hwy against displ, colored by cyl and faceted by drv ``` r @@ -128,7 +128,7 @@ autoplot(model, labs(title = "The Same Model From a Different Angle") ``` -autoplot() with an x-axis override and a color mapping +The same model with cyl on the x-axis, colored by drv, as bare lines without ribbons ### 3d @@ -211,7 +211,7 @@ ggplot(dat, aes(x = log(5 + x + x2 + x3 + 1/5 * x * x3 + 80 * x4), y)) + #> To turn this off, use 'back_transform = FALSE'. ``` -geom_slice() base functionality with few assumptions madegeom_slice() base functionality with few assumptions made +A single slice of a four-predictor model through scattered points, with the other predictors imputedThe same model plotted against its full linear predictor, with every point on the line Those assumptions had to be made, but you can make better ones. This plot shows the same model far clearer by utilizing several features @@ -226,7 +226,7 @@ ggplot(dat, aes(x, y, color = factor(x3))) + geom_slice_subtitle() ``` -geom_slice() drawing the model's line using color, facet, band, and predict_vars +The four-predictor model as projection bands over x2 from 0 to 10, one color per x3 value, faceted by x4, with every point inside its band ### Choosing slices with `predict_vars` @@ -246,7 +246,7 @@ ggplot(iris, aes(Petal.Length, Sepal.Length)) + geom_slice_text() ``` -Three slice lines of the same model, one per hp value +Three labeled slice lines of Sepal.Length against Petal.Length, one per Sepal.Width value of 2, 3, and 4, with confidence ribbons ### Confidence and prediction intervals @@ -267,7 +267,7 @@ ggplot(mpg, aes(displ, hwy)) + labs(title = "Prediction Interval") ``` -Slice line with a prediction-interval ribbonSlice line with a prediction-interval ribbon +Quadratic slice of hwy against displ with a confidence ribbonThe same slice with a wider prediction ribbon ### Projection bands @@ -289,7 +289,7 @@ ggplot(mpg, aes(displ, hwy, color = drv)) + geom_slice_text() ``` -Projection band spanning hp from 66 to 335 +One projection band per drv spanning cyl from 4 to 8, labeled at each edge ``` r @@ -300,7 +300,7 @@ ggplot(mpg, aes(displ, hwy, color = drv)) + geom_slice_text() ``` -Projection band spanning hp from 66 to 335 +One projection band per drv spanning cyl from 5 to 7, labeled at each edge `band = TRUE` infers the variable when there is only one sensible choice (the one multi-value `predict_vars` entry, or the single predictor the @@ -335,7 +335,7 @@ ggplot(mtcars, aes(disp, mpg)) + labs(title = "scale_y_log10() axis") ``` -Back-transformed slice of a log-response model on the raw mpg axisBack-transformed slice of a log-response model on the raw mpg axisBack-transformed slice of a log-response model on the raw mpg axis +A log(mpg) model back-transformed onto a raw mpg axisThe same model on a log(mpg) axisThe same model on a scale_y_log10() axis ### Grouping: one line per group @@ -357,7 +357,7 @@ ggplot(mpg, aes(displ, hwy, color = drv)) + geom_slice(model, full_range = TRUE) ``` -One slice line per drv group, colored to match the pointsOne slice line per drv group, colored to match the points +One curved slice per drv group, each ending at its group's data rangeThe same slices extended across the full panel with full_range = TRUE ## Labeling the slices @@ -379,7 +379,7 @@ ggplot(iris, aes(Petal.Length, Sepal.Length)) + geom_slice_text() ``` - +Projection band over Sepal.Width with each edge labeled by its value ``` r set.seed(123) @@ -399,7 +399,7 @@ ggplot(dat, aes(x, y, color = g)) + geom_slice_text() ``` -Slice lines labeled at their right ends +Three slice lines per group g, labeled at their right ends with their x2 value in the group's color ``` r # Multiple predictors represent one line @@ -409,7 +409,7 @@ ggplot(dat, aes(x, y)) + geom_slice_text() ``` -geom_slice_text plots labels with multiple predictors +Six slice lines, one per combination of x2 and g, each labeled with both values at its right end ``` r # Identical, with `style = "legend"` @@ -419,7 +419,7 @@ ggplot(dat, aes(x, y)) + geom_slice_text(style = "legend") ``` -geom_slice_text labels multiple predictors with the 'legend' style +The same six slice lines with bare-value labels and a corner key naming x2 and g Options: `style` (`"variable"` writes `"hp: 66"`, `"value"` writes bare values, `"legend"` adds a corner key), `location = "left"`/`"right"`, @@ -440,7 +440,7 @@ ggplot(iris, aes(Sepal.Length, Petal.Length, color = Species)) + geom_slice_subtitle() # or geom_slice_caption() ``` -Plot whose subtitle shows the model equation and the held hp value +Curved slices per iris Species with confidence ribbons; the subtitle shows the model equation and the held Sepal.Width value `geom_slice_subtitle()` will go to great lengths to keep the model readable. It adds indents where there is room, and compresses where @@ -468,7 +468,7 @@ slice_2d(model) slice_2d(model, x_axis = "hp", disp = 250, n = 150, col = "blue", lwd = 2) ``` -Base-R slice plot with held values reported in the caption +Base-R plot of mpg against disp with the back-transformed slice line and the held hp value in the caption ### `add_slice_2d()` @@ -486,7 +486,7 @@ add_slice_2d(model, hp = min(mtcars$hp), col = "blue") add_slice_2d(model, hp = max(mtcars$hp), col = "red", lty = 2) ``` -Two slice lines added to an existing base-R plot +Base-R scatter of mpg against disp with added slices at the lowest hp (blue) and highest hp (red, dashed) ------------------------------------------------------------------------ diff --git a/man/figures/README-autoplot-mapping-1.png b/man/figures/README-autoplot-mapping-1.png index f8652cfef67eb2543f07a37e9d1e5e355c6d3d05..12ec077c9d26935c9cc06cbe8a607d966bace80f 100644 GIT binary patch literal 14914 zcmdse2UHYWwKtM7`k|sYdVp?|pOMy!R%pHPfr8wYoU9&ptbTXP@06cWx_?5YZCh;o*_ox+$lQ zhlda1;holn;p3jr4bJ1?otnL)ta$_aiianPhi8r_DvBox-J|i$EASecXlSHpXiR9N zq-do4XiU;*X=w!n1fX%yAlyLQ$6Qo2TGZTJ)Ev53h(%^LXi#KZTV&gGWZQAH zC|)$gr8#t+P>rs@5v~}C9)YgonCH<6GvCupXwpoi(&~oNhK364R0<*?+K~lq(*dH5gm==3!;Skj8u$3*Kx&hMaA(*#qn{SpH$t@P(x2d ztJiT`q)J<)U0VTkLF^p29Ul*+nGDtW4dJGOMh%Tbi;hH_k5oWc^vEw-IMyJN(B~MU z3f)GIkH;D|rVH$*+ajmiAa;)DKOZkHF0Q?+-gUJ-Xlp*MFo$M39*M@y4-KC#IG%>4 zf_Q=M(A&@($C{!HS&*Iy9d6!zh=+HP9QSwX6WfLq9v%YkmYj^Hd-8HhSlU>N_t0yb%wv~W=X1;7#hEpe_ zo&7sHiGxSZn+?w;Bt|7i_9{I{D8`~hFO{GVF0DG=BPGtBRkMcvYqmu>BKmwf;x@gP0} zLG2Pv{I_2T`3A}vTYF0nM)N|?#{e*vOrt2t$S)je5$x5G+A=$;OZBR%cX9>#w` z&0PFYO!eFipYm*-^I&X)@!2Gu$;tJyC`sMPR*#{UkXrrFRRVp_;huhef9)rl{Ldbd zuplzo6;_*7r3JaA-0~+;tYS;t%p=ETJ;``F{O5{^GmLBoGE+b7G~z6^dmEjZk0_-O^_osG3ZV2of5yS zz=F*btvok^-qQ7V1~)h_0+>dQnY6Lb6uh^d%w3)Kuv#nbIhV(u(UU62H1);MUeupe z+ViqhKW9;Y&t;*3%1n({*Xgw`DylZ5f~gUSuXtW0BEtoW)RV5TT-^iQ1?!kUfA(<~ zy`PcWDC2O|!|5Qe%qfN^ti@U3qR>w7y=xx4-ua|f^4iE=tC!9%y+!Xcsm+HyrZsn5 z?bmtwDd5T4`2|{*h1KbI(FWl+*s=(d=@_IwX;w7Hi}Ix|G5Y5G%p9b+w@-H#t(kTF z^zmEuK6ln2zS^1*_0_tX6iK_lHSGLU_eU1@*-)eK)V_S7ud|f*Efl&J9A0`jZg`vu z9=coWxMLSU1J3u9?upz9D9x4WuWe4?JGQ3s%SB(P)G>yHLWk($0>6YpO zAWiiR?~cOA&qJe1Otbeb_&pd%-<(&_GHAc0VxfiLs=M>ZxIjj`c{9c;eXi&#H<9v%=IsQU5S=9~!u+L0t@T)Fsu zMy#MLHS6d@Pptho>ADn;OfIRu9-{3-|Dr=QBlFKuE9&?9h!HD~3H2wLX7#((O%+RE zkpgiZR_2b#YPEp|kA^Tzi>$Sn-Z1>#NJNX1#Rj(HT*b$*XOTx+J>4;_Qsv?wuhC=F zt<2h&tt>E8KfP2$r6_eKJZQgEk9KGXfA%85cxC4iV`ZXARm(+Rm9Uoc5UgowA-K(7 z+X$BRA?m>>9oFL9hDdby>s~3Fz}~f&PR!gYWoiNM-)4Tw)iN7i2s!rIGfU(uSa@74 zFSLoAi&%Ge<^#`-(6x}iRiuIoSOu)_x`pOp*1mR+B`C!#X9!>wX^d*kx5y8(*^GyQbV8 zKOPft&5zSCQ0sI)?{aL=&ASv2-ewM@eLD9*8`gt=x5RGq?Nb7Djh%KNpM)>1OPe*F zZ{%_|J6(=7$`oPfGok%NOL9IV(o?pBJHdrsT{es=i&MSYOWM84`|9{^+3-O_P7h60 zM_r7hwHg`vaMMzl8neS0cezghZBQo_p>z56wm)A3?1@DoB}-!!AZSdYz7Y& z$MZPF%=4Kp4?TRi!oS~ERrO=JMXP%+gl2y~hL*aqdu(Z=MOcRUEcAI(RcD@%JBGy1Ob84Ro13_JoB#-DY?xRgi65qg}d+gD!y0UrtaH0qA3b? zPwX2N)2o$BA4s=+Z}%wIHh+=gMmfR98pYv{A3KNXMrKrCht`AjdU7-Cr_s~HvGvwc z9=)z2(MFT3Z{zmh%RNIhn1u;5dQ|a1483AfH5<_kD3oAK`Wb_(s!t;-K4kHPR122?R=^C^10`grc#9Lg%`;XeX zybl+BhT+8Exn`}WkHQyKW40q(jPb>{_1^ed~mhk=j!}NDR9sBMPS>M z;R|WO>4?!rjD_MW*!j#~8g3G*CSP&zj=vKuQ0%Okvr0Q>h3F6@ROD`Wt=T6jC zcodA4I@1kL+BJgFiI3S%rEjfNw;0~)7@40rAV*o9rocllGRQ5veG#-9zyCFM!ZsdI zhj&pT$|kCM?tK-9&$`jE;TD63N?JgcjagN$_goqp3nYXVt#S&ZIiL5%sbGvRt$3)z zt~hq|*V~(jvQaCc_I|>*OirIxt}EjfE)4EP480ALKGd!aaNVj6HUCBTnhb19f7$BO zPGrk)htI?_Kz)*x5|f@dJrs z!}7|J`*5U9@0f$JttqiHa7W^7+mbp`qJsUtZUU3no}XL&?C{SG^7F!#QoW3g@1 zbd?l2M*d1c$U|Eew${TC;JVdam1Ju=evuVbuvG1Teu^AI)NaG^`1gM8eqogZH&w}> z)l$YfXw#u8c{Ics8w|UXnk)kP{+NC~b?qq-nK>`BJN5Lcv+aF(;ONN~l{~Cb4o znfLH8flQ&{VhYT6QL3=0ir?m-Kx%h1D(#@ix1o5F58_kf311B&d0!CAj5ruE_E@h} zs9uW6&6C-!n>gC2maTe>oijfC@Vue2_>GS|?89DI!xry%DY2R}umSgcc2M_lCeFwH zloF-VV+U{3?lf{#q0fO?#++9bV^Kqh6btBpV;B-;|3nk?&nn!MJ^pt>8r5=JN}mF> zko0M@LO_7~xAZwwE`j%cuTk{>rpW)MRX@b2j^goUN^PUO7U8q$CN+$?bs-rAs}%Te z)ZX-+*uYH~^15OL?TKv=BAettYMbH~ibR5g979$otGNUMbgcRjCpHEGCYfdhCx#IX zpln{)2%Z=W1u8h=Sy2mQNPdV{9Qh^gY|{z<(MWO>3ikTHzy|$kY@O$uzcD|^gz;2- z_P0lWU5}@%J8#Ulh1#aa|G+3Yid5mBmmbG~_){c7(!qta$W3kPf3wX0D)av(8UBAr zJV?5Y37n^tg)K9KhsbHwOqXyZ==!&X4$`5H3|t4OQI;2xe-#&f^LwGr3n|IT`j1Ld}Tu|7fi|?fEUj$2ah}$5m-w7}^Tp+-fr%+=Q zF1j*%|I8WwbAWO%&Q1@1=thakxLYegf8VVunU2lAFAj_SLFCsM{9WC!8tL6{qfE_> z-K}xPRVjx;@a(sNTcXG%DtJYun$wmc5nW)gugha7Txkw~^8wg$Gx5DgtWq(VxvaVP z;DAw8(XOY%Z4x>Als%sVGAI?Gor2bSV4~;25WdDh^b{GXf@d?hZ2Q8%I}Q_woHXtP zI5%O~viwzwKWAtQb`z0xw`T9oTa~JLiFlV?qIOTzTDJs_G2%yi(y{7HWR?1byX%m_ zM8p=dtiUdP^pnd!3MIwNi<=igCZ`lYA1BVzBlkiDZ^U#Y4U-lNI8L+})#}mfxjMHo zDi&IVa|>N#;eJ-1F#mrH1%K1-U;XlbN1XY8fp{q|xU+&TkcZV#1)fCDL&Uor@So!e z#t0a%jnm+$-s9m%{A0LnRQn^w{%!4TtVDl4$J7HEf0^z-4A$hR+wK2yBBzkk{}|l2 z{i8?v_nH7y?cdVEv;*Zo4*x3|NCI>D6SnDrpd42e)22?EQ2Fk_)|e=7PQm9{#X;STdUul#{lL5QnNrYpvpNCt)I-6W_k< z1)Na<7|-ZO_!^u~@aHpVKF)*xjyKCMFts1F$3Ajvvw&o(0}Tn%gOoBbPgEOgC?h`x zStvykcm-Iod#Ar|bQ*06LoS_1)|~hbDPbW&X6RcwUIntqy4YkY`{WSD21Y}2qxSLo zW7o}ZLtGyxlHb)c(EAEa+Vl`djVl_3+%CBc290b1@ZV{WlrUL#*9e#vmnS~^F~)=x z`=P?){#4;!60h7B=HWNbEg4f&jxwaglB5cys3?BFbo+90v@>Ay4u1GhBKWDuC~1Aw zMTyAEih-HkTwjhv#XVH(yn##KYr}aZyt2%#Oz<>dNrAQCuhduv9hN3nrk>nCe=?Hp)59X$Y5} z>W)}7Qr`aLAS}8hU9K|iP^QrCj1a$5;9Waph1Kp@vRt2b5Hn5~I114rpE{QuPot-6 z3nxTJQU3(k8oM)hp0nEfV+-L&v&+sYe14_x3t>9!8ZI#(SwqtU1g||+ zqD(QJmW^LYCcHkOs_OM~C85#mVR*GE+Xv1G;>-Z9)V|LKg-m+7p70ww6RZSg5SGHp z=+f9x0*};ml1$$K$y8i;UFLlCGGa>Ud=yzO=?7bD+4I)+8FT-_F^e(w->#db?p68K z?)VKSan$@7Gky>(>(%$@i*6O|YGv1-v-;a>bY@~yMnY^RyIJE$=iUhNr#!_rDSwY2 zLh07kHFLt+;YfS??tSS#wrp#-LB<@pfH90q$iqWw(B07U6P*N!@SSouT(cFSHy(%rDt9_Ka|tazlPt2c{by~ zU%BjQI7+#srA8}C^?MuBSdBo5TgH}`b`qJKCV>ur|}1!DF)nDjkv&qy@|UEY$#z$)I*+YJ}pDt ziShH&@r43{vQ=~d<_F@PXJxRU&e@2OQo`JNr4!&HcFBR%C?X$Vv^y3cRcHlE-$w(k z!3l7%`z*4AP$7`7xy$Ufn~L0);UBz+$yN=IvVfVgxqO#ELlg5e*bgnW$qX@g=x}6E zCWDEY?BIQqS%>{gaUA_x@#P^}m2VtSgVX{Hu#s4fuf{oKv_3!IK7pa#V5>2sUyoyz zC`tG={JWU1Bm>2-`K;j`exKOWM*9Z1<+Og=I0Ho$3#dpR8F>yXvEeTxW9h_^{o7`j ze<{#9kZ+3b$(^Y?%Kzds=QOs}erf68XnD8W!hU(lYm4PjLfL|3am$5NL6BGwCP2}w z`Ns^;YRN#pY8>Y2kMpGsjN&niazf)EPl=;zSxw-JTM}>$@3?rt6mmI+H=eYBWX&2z z0Xs$JR!=jvTRsxy`)0#s+3f`2CEOGDFtpE&Sb3Al9{Hnen+5sZ~D0^H(gShPHQou@9uNI zwI4Gn8otkxNm#~0-H8d)RZMlF7YaX0@6M4;42HA`AeBLy>%?@v;e7Pvt9vsJWo&_s zYPF(9a35D}z(`n7X*?4vm|_A;H#EGs$g;_3cn2`*8Q|bc5iA@SfT0U*uCpBuP)91} z)hj6vcF8;BfnCK!P%@L+h`h4)K}3)NE>pET)NSx7(d2b1P=QP8+yH^hTDzF%%m9<| z_)mFipLg(dw<|{M2M*PXU`;!N09eW|&j%j&$aLOuiMcQAF}1v_MBDnA-p7MyoE>fq z4Sm2!Vu*9&LwSM!eh!wnOF?98wCrd;A0PjGC>Im~oE zZ$oAH56y@hzH3jI-u;|SDp$}HO`mS~mtmboiq|-@&90UkH&16iyVxE}SC-?fV({`$OOthzM~mE*yO}T`!{zrul_1 zy*{%a$H#W0Ux19e zd=aVSe&+4}ZVC5gsCg;!JFb5CF)*r-{l{kHkHBC7)3M?T`%LRmYvtNbe>n8nk%p%L zuJ~_<1yl)5*nn$u8NRSaGx*LOSbo#4a=GEY)W@SC&>x8aV^}CqZGJ654m%;fZyD&%`B{!t zY`44BbVLk~eZKBg?S^wXe2f*Hz(ApbINHj1;sXv_Lpi_@sXTlCbbEZ6`Rd$ThBzWy z1{oNa!X+>sKY|q7-5lYDS@S3zdURtfJCHThqF%ru#J{oo6S)X|0KMfwNP-+!Nkgya zW|+N{pnHfvpdAVAR?e-HqM<5vhT()%+~MarF9-zovpI!eB+L~7y;lKDb_G=Qnw`yx6%b&C*Z zEq}=vD=@Ts^yp*4xAJNaHzrn{lebRnH4Yz}wb7_p6oCZmh#ubjRty9NS@?f*D{;{H&F&X03{RvGsrFa7ZN`qRHM&Q~fu9$=#0OriUMmY3+S5g;b zc-_Ss3TIaYjB1)#iKhL`$Py4RVDX@e4Ur3ckL8VrW!~Q!Lo=-y_0dE+`*)okBlnIX`w^I(Iu_Ve$%@e$pTw z`U5s=iPN#8&n@J47LUcpcJm$;~UMFYI|LYS>HD)@8^=?kEyfNfkaK+mDHPE0uUM%IEcImUBm zW!&&Oc!4;M7~Q{+dX5<^x+=;%Qs=U>!j7%4ziV4R(jRI;YhRv&`b;MfSUTLxc&^4n zOM!>GwB0!WhzhBUIJhLr0Bs;{!jh(4g!3Ux;f8JOrg+E}@O|T=#d!z<*fN8Qfn8o% zkJl)WHlhI1Myr~I(w_$84{W9*N$DF(=;UA2&uAk^{V8>yI6}yR1l`SIkWu<+K*D^5 z7T_#*(pcwFz}Jev za8MQqXz8-HA^o_Tv`Q`#!+KUl-S@mPKAdh~#cfMYKaFNHo%wF#9RqRN>F^#u+Qh+` zV6}Zt#yF8BBJ}d<1ZmjYaCzA|Tay-#q2ksO|L@zF#-4GXw9=^d$f~%-=U4sbhnvT0 zo4s6g#X;d7N&zD9?!FbUR4%8c{N-~{X`3ZC_>DC*^zzJ?TUQQ{um-tQWP3CVcxzvg zsjQ|0EVV|npxp6jgW1-rZHxTVw=q)UPjhBNCXw$GX5;x0+~uloYn|1X?s(gNj&+BL zr7owOm$lblJcDg<^R2o9@pXp=Kt9p#blJ}SbOaR86>nV6a9amU_mNQm`ry}}H$I>Ac%8M*c9 zZ`@auD2pvT$(1OzA7FzLjn3UxHbi5XcOcm)69~)2U^dTf{jQ zy59U22{0Oty0bGz5*e|NR@&%unFg`hhUqgqhJ`P!`6GHe!C{JKFNCs`@uW`K-AA@g zM%Lv%;rFF24PUL@FMnj5tKC6?IU_3uE*PUMgMmpR4Q4Pw5wPmX93JofDIH(VTR8rG zRqj!e&5ZQhpssqO)sI%Drg^fbzffa#Nl4z(eItVbQ z8oSR*w_z<)`cI>|QB@79FbMfsKjCZTlep{@VnPB1oOvtLlK5*8)pF=QTI8q>z0Wh* z;1w5gV7p|v5IO2*9QdP4hm`Og0>(m)ImNFL=pa?Un5+x47ll0uy86yCk;k_fglN-u!XTf(CX1L9w8OQ$^#~#{rf?7ZNfz_cOw^YQeK|Hjf!fZ3L zf^|^Yv8S=69ydohO81Z_-8!m;f7Y9g9S{9lwLqf9R%ze>!JVMz`SPoZJYo6`yG{Tz zOpO}!LZAkD6fA`4i^8xDWi!(BkrnybEKoVXhL9PYx}sLLQ*$LyiSq4}XeCOPEB$U{ z>q!J#{L3nohW|o^|NZ9dS3VVfxhG`r!2>}jFYJ~CB% z zf({ePTa+l%L!Wy%cF3W`p0k#;#gmdHYiYv47B-S}6Y|m;8C?esGRztx{=I#Ft#d44 zdSrS$x82EF=84gt(xqXIbQaUc=5U{{kC~�tMRLQ^T|gq2Q!S&$QC zza054UO)+o*rVc2st~YhIW@h^QW^KRWtK89+l47* zpD=!WQ~(mWsS$t0JU4>DgciXqTsf!DX3vIonxTT0(}N$JBx z=&uwoVCK%EEY)}|)@`k+NO`p`kP;#@`1ITF(T$ldAm2Uk3Q1?ch<&8#K5;owFpejM z*Hl-z&$-k+5h^V(2NgR#8a$0vNrCnll&B4_T-kUhVGEd8Q#%F9`}KGv8V=GxM~!&s zLvEFJXkFTaILgDwvNTeCq_TH9Hubgqmdl+7;VYA(H} zFb$7PEx!MZnp8-uD}TGu7qz+LA)*mbdZAG%CXW^cZ@5_BWdV@hFDY|+@b3kmqX1lPLZPLBY7ndy#xFNS0@cS z0m*u=g{a0>si8;w#P-Wx%dVSqi^H`HDcyGVY5}F6(5GJIT+5Ak@XIPrqkpz2fqY+| zJmhzV_S+6(N51R1?vdF?#N*FE)_S3a}*;#APU zvmbNcV`>;!_lIl_%ay27IJi8D^hJ6vIk)D2(xxp>$_{I>i+d}Ig3fS~=0*75Q5iE% zA~daLqk&G16~ML8VaZjbfDUA8jRV=h5Yb4raIEEJ4u;5KUNQ-iU@KD$v*PywI?eFOV+$Rs)kNs zoFR!lxaJw{T~YQCry4dJ`zhLdd%rtlkA*~j#JnyWO>m4G5(DumY%B#4>Au41TdaQtVD<;#yIb>jtcoG zjMUp+seI{`JgJ2mWW;~dt*}K0896C51nDd}`7%C0rYg-z_gE`?Z%7?AIFMi?!gtN* zuHL?6z_x|nPEu>P5i7V1oq5!0HIQT2ND0wW7KunGok4n4ABpp@zHkMGdlZ;CBQ@nf zsZQM{|E13!ES>GV29~DbiWBD5z>1KpWw9QB@#`Fn

WN_N$UR#X)QaiFSe*eP34* zHZU7Lf%&skI-q`d0j6YJjsO=QwpgJ5Oe)s-KIcKUpl0O#FaUR?ZC&6)2hs-q`F*j_ zXJ2TM>Ir@1>EyiI?XQ^Zwgsj49Vd17msD&cVCgyPp7gmbRzddt8;QU-WtR|U2Gdu^ z!c^MTk_d1Hs%04E8{4~xfyoSKg=Jxc=;wW4Dfc^pEL&^d8^;Y+ZCQL0<8|_2mqwl; zS+9v8@>+mfHZfKS>{5jkr102bLbrh(WK8A{%H*xv{Hj8#aFHPW2}C3MoCTCPonI#c z=IfK;^>RO+E$Hy5ai2#C6%eACS37lmg8Pio5ShI3y-=WKeI>lVwYYPWHylFWea6tP z!l4exrlvqCL({YdbgeIYqF`>>y{$gySwJ7ftq~m%m{b;rXL{%9_zEV(Kbp_-$CN@4 zaw+|~Cp>Xg*ZNi6UC4V)23~zMPiivbZ)-W~t__`7=L=P?f9D1*QH?)tNCm@vRr;PsZXy`=(R?mmFEvwx_Tep z6*fMWCqH-+*M(Zg_PYe#@FAtOO9ttd}9T$^_zRrpST^bpRMgL#Tg z;h~|B>U^dB3RLmE1lu7*`&uN%aui=sL~{G|9GEY3)F1K2ag5?>sk#|ma2MS-eigP|FM-015c-h^>Mo&hnT0!MKLLOrhM@riIM zS$2HMBczr~f`KBv3KeSO+y@jogVj4vWkeiyEL7A>9XHi>q{A{V18z;N$Nw{z-Vd#Ujny&3xN@HS~jA@1BwwMP%J_&m4rxJ9&@@lZWwPU>(26}Nwb1|kN}|d zOr%)fL!Zc7I=)jg&cq4x?E7p*`NAjkI@!s(nsgfY;sDXSBH1y~0-iQP%$%?a07W94 z0C6h8LlahfE%-_I!|~IamQW9XQHPZ1z9smO5WD+nskFhWUJZ)Z4K|KB8RZoLPBCL! zcddvlP~WkZ2p z2Q7pSF!DTVn*(x)CGyNzQYChY#h=lTIO%&9DloW4qm2NEiPPy+vZ!FF)o6Pl92q{a z$_0#9YhZE1a2m3P?a0!BGaI-`glqapPR?6r3DaF~*o(nqg>8iIc)|(OJ)zp8btDiw zTcH9ALvtXNnNYa5%kf|&xN1772>p!{76Sn*_A2gdQ8B%D@2#OQ2+1S%6xuKSetGKe z`D9_%+hRk3nb1ihQI``!d8g}_fKY?R55ZEOp7aVi8Q4Y;fHU0=IE44dO|x-LN6ApI zGKMPnE;$$&PKTM|P=G4I^uK3Uhh1`-B> z0Qz??)A=C2798nc?Mx4T;AZ^uP#rZue3rrS4l!~`>wnM%l#?fG`BR443`!=Kz!ltX z=z*-|sL+d(6Cp_NzY+>0Nj8%7N9S!%j+7t^=7q{I$mQTRM3NHq9 zc3DCfxoDU{39>U%8Sm;bOlk(k9|7djBg8KG%of#A@Z_FiAPoHl|3efT^2S{a9)jva`1~;VFSUxRs9gsI~#Ss4th|b8>{`ZJVs;5tyb(*+O?g%%=5fnl#)lK)e5pRPH#QQI?EZD!!^DckCHMOxTkNi?Dte? zSaHT($0W}6%6F?Y4bF|qL33X51tf(p?!2G+Oqvn{UMDzE`z$=G5%lGq0#Azzk+VI^ z%Mc!0$}zd{h)%&(K;(^=YP)#-sB1dB*}!^!Z%#2|*<`Xm?zpEq<$Ds@#)EwYmyC+N z7t>wxa&W_8j_MEuT}skmdBoI5A+S=fmb->nc#FLQ3AG@N%^Eq$Oc)I2vbQFISxHeU>m^`=fgKWaG+9$G=EZ>u%WHaa58k$XsIBR@Olyeh8(ppJ zRo-v?u4n#ZH1yN-pu8?TX@sLPgpZCPY4CMK<|lTr8)$ZPUC@45BBm-N#K>N|U{AW> z)J^Vc35mYr+_Mq6_=rfArT!Mj8FGw*eTq}vb(-Y#`S#KBmZ((eR3esRGt1bI`Yr9Py~D7&BAvz=U~*wOfcXMp0it(;(YUc{Ru*z4}R5RIBkP-|9> z7!MFghHE>s8X?dKl8lJj_%af?G1M^pKwsHe_aV=8zq}?qWtgKTgqqGUaWF5!G;AW{ z<$tCJ_}_F2-vLSei}*%KZub+2iyt(0lVL)Vlc(viOvipI;P%UBl0{2ar1vg4K|7t~ONW$1I^V+W4_N0zZ zxA3*_FVE>#DSo}uxO^4FZsqhgwLgSdyUYw`=6kS(J8$Ov;B3Bys-h&vsA*NRDZ6a? zlvc+X!dr5bP{O9<7)PyChK`n;pb;WW$L=s6+Y6vm7j!USuxr)GSe;)4lXNg^^%+-< zBuA%2u}e2#3jKB+&`%4Pnt=KY#Auk~eAi97w2!y5IBgfni{`;4|b>aV~ep**}OjZl)zCl6r1Udo0!@G6kwp=ml Hp8tOX86Dd* literal 15232 zcmdUW2UHZzv+t6J=ny5d3xXuc0)oo2ASg+4kmQncP?BVHNg_cd2?zorVTmG$L|t+a zL4ssH6p)+*B?)g9zx2QN`=5L7d*_|=-kxF3nW4M7s=B)BSJgey+FGjA6s#057>xSb zRb^cmj0gjR5gG$T_&01Li!d0$ytan^73dKLlY_zRU~+OWIq04Mv#W+RwXm=#u&`LM zC@8Qfgt1s<4`w+um(;1&rMS^ zPSedz(+#>~HRC$8pHEmpM6=K~+xLtL% zT{Uz+h6v%wxW&1-Vcp`OtHTWoU9*9uurLLdu!hmt(eb#G!Q$LBp+<2X9dRAAaUI7A za*IRZ(Ry5M2aR+*o`4@8YCelSo`r^j zc!BOvZ>Yzyz8ps$G|%K7S50oiV5e#Ee*|58-xOdlIP99TqP}0o>eJXJ#`ZhYKPcAn z9EG#st=w%F3LY&`78nXug-#6WQs{8g3mX`EnvOmHNRa1vMJOL`q{Ye+MmN4nLL%Z( z1H7|69$4#XeBaZ%*1LB3_V>}r>2>RvZ(A8pQ>MQ)$jeLGUk6d(Aogyf5KK|;G#v9R zlLSB%*b|_DC6iF_u0PX%`AQ!Yx!XKR8iVh>4I@2c{L9+81sRX)Dr0}- zMp`PX9zWe)TwAeOwI5<_@dv%H8Y*p`S@wLyy7YkqE34@l=E0J`d32rP`k;i<%eQn1 z4PN4xU-ZN`jWS)>6uQ(PhpdqoLZ*5=X?p1^ov>G&+(5C_YADVNkg z&-!Mmz$Gm`rEhQa7|#mwfhsCbqmJ0QQZ74RmsmY_cS*RMcviH8@J>%9VGO@y=3a^Y z-HT0516Wd2_t(?!=52M%lE3$JF>M;3GnMz0QQx#JuPV7%!okCT{_2^89w%l3mP?~` z{F&fTU*MX4YxI3`OlP~VJ@;tU*}@i}N`g|DU{77A>)NccE@tLaNbtpxA4}~fW_rN; z$Mf7`?KiGXa&f4C)5-8XL#Q^|ebHo6H*kHW?ZDH(hI%W1KU?^`zVpq(8SXpw=xwb? zR;J8!1B?VMs)jA^@b+!;e-E3zA)pBBfQQP(#XNLUw zX6DC)<*o=e>)grS?unM&wi!HgCtII7yWks_grgo`a2wk?`9S{ zkM3QYqcCTRUHsnb=GOhrVcTL$pHn|x7*#NcbjmyQRy$Va6{Q;#iw$V1zpu?F2Q=}N ziRT=}eW2WIHMY@x^!7>rXC1)-Cf6loz{`nai=8Yh_0UyGI$VL;u_UQI0=ub3iuU(@ z%{v|7oqVx0Vxzy}XMZP;-}jd{9;6MulzB8iYn!jCvsC`5q2|sxGUfH+yoIR}v2d|F ztW3u=42T}*gzs*_d_9-X@$fsPwz;Ml(RL}5W!Dr%9qm442qB)U5#=<=)S#32@Z}aT z*Ish{xl_ARGVDvjBrT{{`#^(c!||5%^F+7l;;sbt}D)E^odb4sL`*V zm3i7Z`V;tWY5OzY)(*Ks`=)*~bLSd2ArL#GcTsjyJ{^^6+1x4f#ra8r?GUI!?&~0b zxNnvaG!m-KIcyB?cx$*^u0}(9JXys2))YQoJA~ zDRF>-1M@O6TqwYvXFa*!c+Ez-ey>IP4%%ToJ}bKP;!*hAwW2kUweX?DYyDo#LFHbW zP4HFyX@AxaHD-1K8Fr0?Xz2kPR1L+WnL^#j*{Yi1Jy>G_A!biFxg?^RHA>yDLeSGB z_{LlQa{c2Gufmxk4{j;Gv1ev2mAM}auGoxyE)qBUiZoF^!Md%or1^Mi})-`y%pFQXtTC?h<)<5oKInPD@873w_M;_FHKDB^_cg^0m4th#wRQaDw*cMSfPZ9OT zH5vk$UcE-AK@emfk*IPtF_3-w`SK`lO^7<5#Ron4L#DKd6&xkn$oTv^)%A z-q+__S}JeQQqzmm>TC)ZOfN8WiijwyIb0ts&}!~)xPoRg+e{NH>CN*i=Bk8ZgFabPH3k7-H&8ZXnKHRliP^-8h${PF(_8$vUN+0&*#FA%c8gf|n0W ze1h}s@}#pe$0aiPmxyO_{2uCNaA>MpNJu`u9>r&nMSi-g);9+i_vCX{;`W=%KT?l6 zW$QMz=87ElS|0rTiK2crvmo&^AonS@cCgQigwL*PmIUYbaG}4#>+r0Pq){2I;{fq~ zhGMA*DB?SGcx&;|dy2#R*-Bax@HDcUYtgzY$qapnkic z1iMIgrGj*`R_$ZwX7AXtYCE1wK5OqQWlLQVR%hlM z=8+mg9Hhkj(~(=~=1l%Qa_0r?ee1p(@Zv)nI@3Fm32VwZ!2C@mFcrn8Vhju?o4SbXt z-M%;jAc_c71xkMGyWXl^JOE&a{xo7cOhO)I=$W) zII}nzL4c5gQ4`>lI}1PD!cK~%mzungF^XB2rh;_g;0NAtt73bxj9EN&A@BG8?5Lf# zmBlO1{IQc}>N}-5f6xF?JBD@lUpC~Ty0?FvBS5rRXdqUK6sKI7(+b+iXT%_qn)+Wb z9;v=;5qw4BDA~a}Y9;z1W(51vWJGqf(*qFI_ly{ixM+{BIw&rwnUBT?t_68@1oypA zC_h{<_K+|!IkaLTZhEW`4sZMnLkl>sA`+*2V3G|WRTu!^k(xSG0DC$p99+%`N4Gw_i0 ze|da!>wTUrV=ColQ1km$gO@4tchm-zfh`_<{C2-mFqP!-#U^-wH`|CIScG)(HD@s> z$YtEg<8C3@q{1AcwYQ}F+*be4N=O5t0oj6czaq1X1=Cki^32_~>8U(;!_Y^y;!I}+ zG1`VL3;ybq)=GXp{v|R)@zG9!^G%fxsBs!2Z>gzOy+A(80ELWrW)kv8Pj~N%=hz9I zN=az>TE&flT6c23+D&du%I!CUtRZdz-s2|vFeqFxkU*^Ql+WQ^g1%3djkhnBqY8p< z<{dFV_SB2fg^Wa&JCnoQ?)06`peKXr{n+wLvYFF8Q-s-DVGO9f9G|Ra3Vfq27moS=xwj-*&m*Mh?u2PSnSYf<-a2G)C}}TZkDHwY zguSIGfb54IA3XGr&7(e_NAKSs8PE;UOs!`#w>m2M;=llzPfkqkJKGs2+hftnmWJ`QtW%7VscHc7BpY3G~3AW`unb1-K0|eAwoiqnJ;D9A-a&G z{>^T0ju6x5F-wH=NIH!Bn!UZ{=D3!6EjYyL+ao`LqYM77?GLuX*m3;5-aPzpOazZ8 z$QPj6nwjdgzMyEm?r(WoQW3+ke2`y^e!d;J*PngG{ z8|xwKi_?ONN28xd=qV>nIVqI4f%O+{dldmYo8sYTNXW@YGOHFSzv&heJSJw zKQ5Iu{-~oj&PgT2EVIP~(*TY;mHF0JzBcbT{M0;T2Oq`owf`gs4W0gaax@0j(6VYp zmtBZ4X)tu2KP18#Ce645dU&zEs3tL{B?p=eRybyP@Ku`Zu=GbrWCEO;CN|pImFHKp z|NH--#mMV+D!jqrgj$*N;YF!0$co&#mzU~Vz|oFTrxVKofNL(ZF6U1;BF3DNzEz!e zA}b+^j_rb}=Ho9%!~g*zIyR%^#ffo+CbX#Z8V=y4K_RbN@z`S>Z%t%H!7=cH5)ZzX zC;#|w7y^E#;$h{G)P=R{p&d z5CN-%m{ml}DV)>;0*ue!?E^nOn>^W?*05~ze=&fl8UDZ2|99IG)=Bu&N=8UfT}1>a z_i+4L{}-}7K_~)XaLhzj1*+`wU;=Tb$9^xUS5pMSB3hW*{|PZ5`7)yu%=~1I74wn zEVKgF-nQQuB*sPNA6=zV%`)@bG~A!omwGx>@`(VAO)YPX&A_hf8p|jjVhJ$)B-!ZD0D`)%Ob7i8U3e;r08U&vi~W>)nF;f9oLo%msym$yu72pMV@CrothDda{j+ zIj;IX`SN(jn|+aRZ>5%|3`F7r0S;|2&C6Hp&hvGtj$!yA?fR{Vjrohi4^MGsJp?Tb zKJov_C_0Gkg3)wddE5g(BT7JAekso>w9gd%RA94MTHdbozBlfAh1ONm^T>sg^6yag zxP1YEbP_tiH=c@;_X>|9>0vzvJE&Q6G>}eWJ`0 zH&)I8`6GTTDbT>E@}In93A{c)CO6^sj=5FTKe|^dS+zfW=fAFIb%wuuaCLY>?Oy}_ zJHOd-{%`I%m4o*m9qkAOY9-Z?{$z>%eVI|I{>2x&_hlLm1^|zXl?FaNctMg zv1Xp=UUqjkFl8$*LUdLm7A6)}?o<;aiHOL>&+eE&xb;;galy|Fd}NQ&sW3*R)Oxyx zSG-|K8*`~oW zSH$yDe5^~=qi6?JK6$@ut1Jr+G`tXbjThuAI|I7$W=(Wi=zTu5oYl`V^alv=QA3lX zrJhf8MI`Uoqli#R5*03pG8zK(C)`qcNA13dxbiOnQ#L=M!$43Dw0vNI|~x5jLpXtI7jw<0BRPQoh@8J}IO{Fvl-6`blYck~D2) z?m4SnCFWBQKyOuF+r&-pnAFe1uf}{LZ@QdPOy361r_Rl6*$9?NKxR@^{*jLm$0UA; z(D3OcPEUD6Z&@8+Co{#KyPg_d(Iwr?Kl8|bPl9Q=j>&LX*~QeEUJ?cjtY&p?DOI!R z2Ty9(KVRk0>~+N^it?JVYjau!jSv6nSMg#&$f!HX^|#^YS^MQ-bvt2d=}|KdF{u?O z=1s#xtuoIg)8DWfuBY_Jl#wIccCWxOt?*B;qM4x*!_P3mv?$*DZQ{A%<$eJ%SHOj{ zD5$`&6ZSWyLDYq8rxq4<%RNzd?z3I;memfTH~IH~#~OGXqi9Ai9fyy#xCoGMASac> zmG(a_ahx4EHFU)o@9@R`6XI*}Nc?k||GA=eY9kDSEC!IUN9{Bl`4)VA-#sL2Hl`lXX>~NLPq` z;gdi7F%7vHQoDc^XA6S>uqOJ%t`T998*2I(58v;i;_P#T*})|InKNnSXY4dUmD89S zJ{!X9%cs-QhYJTkG9yQd#3G5^sAjBgvw`0M^sFiq3}9<{0N{q&4pKQ*S#S(WPcICe zXZi!?(vVMhSlRjdFsm~x3-*k)w9s!dfYQ+{G#GDnhR(79GRCIEQDkWOc?_Krl`2~c z6*(#<(F0l2hAY+-jx+t}fiz~3*lh{3-)jF9PUaW1!UL}I3z&W0gNA@E8-dC{ zz<(q$DMqTHkq;QUw#KFItOZE=QvI^Jx zy$oMlSW039BFQm=QGa!K6aWXOGAJ({$A|?6@&zSE{56lmBJ zm^Fr|izJx&A}Jcoba~I~h$rmJDfdfzdxz9>=4ri4!^_SYsTHgFQM8F4M)V=X^Bf<{ zXcjL~0oIo;?x^g};$r%rNgcTh{%ZV`g9LL9FCql~ZtZlC^h?ugHrgQ@x8E(&hWj53b7v|9=fSqj0n}913?-?==CO7{pI+M0mOqV zk}eC-i4ndtzQgmNBarlmZz{`e{sj+@%AHD}k7)FVLO} zc8Qfl)82b|r%I7OQB<=dWXFV68k$#f_3^6~g78<}glLfXL*r}L#-okIj5sKa9IiMN zjih;1SiDQngir#mOZriA7c=g74sP^)G?_j13DztVN zy*`mMPWJosz;H{VZ{&#JNooj*Oo`k0lw5G* z#9r4!WNYuuIM`CbUtwW0obVOWnRItT+#|g9R@3@kI+kdiK=@BY*+J2$gLdUUL&0SJ zT6TwRkTV5)??ceUg4nMHB-!~VS;&PmVxmARclLxZ{YuFDARDy-lgYpP!wF_w_(a#| zmk}0ak2oX)LXKYYH`{un?*FTlc&C%@ZiuS!9ag}g>!a(0Fs*F3Z=P+7$Q{jBuPV0E z#NIILmy$n@#N+p0&WI2Qcdj)*cxTep9fp_J*KgmFYJmr2mne|DDNj* z;=;}89s4k?oF(k9bzL3xO@ALdHmUw2p~e?l^y@@8D>l7P#i|#dIjc@yB!WOM+CD_%75^&MT1_YyHcFDp4EM1>vg$>?usjYh4KuiT4N)hF|c~c8q1lbX2<|TaGUiEn^^MZ-4_S)r>h-7m%cCCNf;T*-izgas@?N$66#SGD$E=n#JK_ z??CV)r^5=k_LRCh%{{8pr)4%WmnDKZ?&R%dxnaA_<}un(vDTAzhhX*SeZ7yg^yWFT zH<5n(fe?c1B8ug}dGyb#>zz}>!E%ARfm2w~yrZ;L|s>dI=u+aCA>t?>6o%Z~U2 z`P*IXFB^wfdHF(mE!oj=|4_bZuY7v8$1eiE7LQIu} zJc>IN#V=O>xIw4iB=)Hzdu286ePx!|R`G)G^96{W0Ah6p!@b&uRt{=Z;eM~vj7Br_ zDKME`r&83kSf)MCsV53C;n=5g%258yhCckkg$xQzg$58y&kZNWKqEbnItPS%0qPfs zG5X<*ciHLu9)M2tl0~zu!NuEzh<&f_JIh+VvK$3D(VB6_%mFvr@-z{`Pt)xI^kZph zf#P;&9NE{qH>b%7y-;P9xeqmfO2+~DF3uNXAy+?Z7-&ER@KquC(|pX*_r$VTW>29j zrE5>md;7fF_0_v4wpV&DfBLM;*#@39LBX(%-fj3qr@b?U5aUA_dH{D3VT54tMJCovivK(4LvPDf+RKY5j*}Yw@-JAPWK)1u$+)>KZLJ=5zHEEy@nI>NN}-nMb2`Qr;vxs_jmnCrvfFtnx-GA9 z;BFqziPcMg+f#3dHCO~8A2V75 z1!TzO(l_fgE@M#N8*&9BW*aVR0BpScaIg4H3bdEtY@@YZejw3n!fXlgfk;U$vLdIP zov2OC`Pt^r=F~%xOZj|6==^nh=?6M?t`I5~z|7oBxpz~c^X98|$?TWP;+()^1<}t* zfj;B=Y#ME0d<1CE!nW&Z-TiZpPD9KnwY|gl`x3w$5wd_1e8k8{0(|RznF*{r1gN$X zp~o7_{bDMJ=A}ogAZXXt*;bl2PgUx8&3N2+DdBByg!bWSs8E13&h|#uJoa>$u9jv6 z>ZnxPPeEC;?G1X2ym%y(68p#}+@^vHFBZ%Ds(p{s-IgN*Oht73u#M^(x7kcv&oKKa zBsf3#%1fbE!ic--yJidO{*a>t#*JKO!8L%Uz0&x4k+%|aD-1U*-W*Z>y7AW4-wG9( zEjd5_z^5GpQ*CYHp?#&^N~vosu4LI;KP%A4g)O1_*5$U3X|Z&up}`^|6SsTo#!wD2 z?Ez8?GL@W0Sua-y#CI{TrVlEG_Sp)&lD(&93?VQk>FU@DlEoLvTpe5Y#CoAXECw%L z*MSlPC{UeqabbgUwHrd1aCh+wKMJDy-92Ssz_)YUJK}D2*V@Rk(N2qD4-VJ}Q85!4 z1eiSW(DHq}Pl@ZjDSLwnf;8{L#Mny=uBk$`5Mz2`;J`GeVBOo4Dw$t}43W(5f1}u) zb5@4B%ldCQ<`^Oj%4JR}n#$5X1xM7=CrmwG{Dq#{M8K&U9kzi&C~?U=gXyZ8xzRNJ zQ6AG;Ch^8hrdqg%_r>Gb_f}n{Gvu?P)WGX;E}S0{Pre2w1{J)xg}_(muJIu4O8 zTKO!fot(9yOV)e>5S}cVy0V_jzWBj}VQ~9M}j~=Xo_GBSs*K3jSRGLuD>6 zd#0!`J0a>Wu2}r3t5+3Xlb5>~TyeD%Ho5&)!H_kY{%f zOCuL%HLA6Ye-leDaj@!-aUk#OjPa;vyuNBMM4rcYpvDsX1j1UooIQ zYnN%}C%_upc!tv=wmo+`*~uqyyB$?^`on1(UFL?tVs;0x*44mMGMlyfW~JX& z+Ow2U2D^z__#(NL1!c)stnCvmZ3W3+-Zn<#XPkccwdbWF8ARfbJJC&(iA~zIF5=Vx zSCjXw>t5(hpF#1f5WZn1#wdq}@3@+o?ob2gLX$*HHHdK7(T#6K#%B*-b<1T3BvdB@ zfGSP4_UcY1NAor0?ndH-IFEFf_DZVfDO~mWrtokn=|_f5ZUv4r9&}(^-LTd7mZ|>J zwd)*Jqyh>iiJ7}(?Q9{mjxYszDe><`(tXx@9oB3g^b3yQVj0{CxJ;6+E z#-^$9ALYZg9sMR&l(jJh@M+;e`(K6H(!%}opc9-B=Pmc8tbCvECFH!J0@^Y*m;=KS z5$f^2*H5sxF}fIwuMB;W!>(`SSs<^@YIs`lJ@Ke0BN&V4v0AN^$vaPo$y9Uod`5>o zdyqFJc*o;Kjq*d`OJ|N{8SO+Ch;S%~s6~+_`aE2?`eBE@;f?+3Q!Tl*{IjY7(h`<3lRdj_jqdzj2_MVIw`%`9&h#?V9 zgA)php?#fB$kdJ)$tAj0ozXI*(ut@BPf;p$hVxJ&=wH;BJ`}3mQ75U!mD1*S_1-=o zA?gQnNDv9oyn{-;2_>o&JTEIOfpeCJB$(M=6L+IngozaR zM1>AkAbQV<lwOm!v|=D*&SPGV6CmJFM%Y9~3U^t9OiC)3qFLt$ZUU;A z+DNb`5n@W7dfweo3pVXMBpG6X?DsL395Kc_Yw1<44Z*9#GNR5T8>U=V+4v zLh=oo+753@p1+Y@=80KOU$__ZF;xe(fE7cIJgdw=2zxjP_f9qH1h6BGqo4)Eg}DPl zJLv;&;q^K@*tyq_JsrQ|VA)x^1li`z_sSES4^@|IA;Etpj(tXIHdYz3DnmPIQda@> z;BeKwz2TScH( z4uZXy(&m1#culgb@J`(f^7qgI3vqVWvQ9<6ymBW3K;T3SNFc}+eK~_=>f#u+TI)g* zLz=LP&Vj^1$1uO~a>&>&hVTIe+rg{aQv5zd{wB)dnA(;yA~XS~f*i51j_BKG>uNQh zf}YzNOGq&j@E%dVVsPoKGV&@KKh5H(g6mio(C#b}nR@w51uaaO^Dlt z_CO)!sQ}q815@j*o}}tz;zuJu2WS$aNR*1{(;(##;=Z#YFyBjbp%?e863r$n6#E_{M|2!!}9|3i3gV^|WK4%~iDvjXP`s;{};~2Px$FWU( zG}#b<)BXLlM1H5zLPoZ->I!rm!}K3^rvKXfrRG3&yKV?jVoz`mw24H`hC7ts&ZPMB z#jm3lkm?nc3MP!+>!E*v)zCf>$XWc-jsqah&ddLx13!h3WB;Yn5oqg(5R_xU?~6-$ z0hdl2PAd=pvCHw_J_GdcHsb%1;NKkuIbr0#I%4$CwpGSlVKh49c5(; z@g1dQegIf~5!|EQ+hP1kJG#SoiU5~P#;w5J)R?2dUDx;-fgIUF&Z^FSGTK(P`DApF z7%=6GI*dBpzkd|9vVT7khVCYM$o0_DvY+drx#ebpC4c~m82`;DKXdfIgVV~iXJt9h zrt1s>ireiiifC%&PW$J|EuwG^nMAM`Op_SLYEAfZ6N`PMOo(I3lNh0$hXSBI7J zrC+*n$Hw+*dbwFoZ;{P3>*bJTnt3b~%f6EME#9e3{0GO;{3RdpQk`c3Y~*PRA614m zpI7w1nWyFsNM4VAa`yC+h*wT3_PjZl`L#iFjfub`g{-tD?V!|yosc5yp`rE!B{l(k zzh2EVFZ>9QI0*_J@Avv+MP-=oomkrq4G6(deW;NdXsC+Ek#ENMMG<|T*UQhP!^jT!}k<}|Q_oE)v6jkvEc3B`p?~Vf*&Db*h!rmMjTrsx_fniSHDa^DBfIv1aMrA2^ZBE;x1!EF%a=p@)o6bWDgfLbP@#3#`WlWJP(6nnsbmW46Jo*CN$%afC@FH+$iCAWDQiW5 z3$D7ab#G>h`zm5Wo-I&DZqq!=wO*89vR+s#=`6uaDhY5fgrZU8*`@=yIOw-+-PN{| z-_1+I*(+e^GPNhBg7&zdT>0y5n666r?=MHY&e|n^=Jq(Q8~;3XMT&;H_0Fv?K_{bG zRLM&ssLD7J=_Mnp31;+(fdGR|4Q9vn4=sYNXrwG70nWmphEL;_ufWKJRvCHgA{`iK z99nMqq%wDL*UOg=F~RUD;;#1Ztjp8u<(wY!#=Y-G?;>>tl25&^(315hz-3kmkBV0w z(-X`HZEd1gQdz2C=;>Pg2NwP!IFGCmQRtJMoPpmiSHv^m$tP4i8r5-_CB!@+0rC;Z o4&zV{*8lMEKR=MXd`#5-t_k diff --git a/tests/report.html b/tests/report.html index 65a444f..0ceef2b 100644 --- a/tests/report.html +++ b/tests/report.html @@ -1578,7 +1578,7 @@

Applr Test Suite

-

2026-10-07 16:42

+

2026-10-13 15:30

From 3da46d94927853c8bbe5db9877dd84a3210f71bf Mon Sep 17 00:00:00 2001 From: James Beeson Date: Tue, 13 Oct 2026 15:46:15 -0600 Subject: [PATCH 8/9] fix linux integration issues with test suite: near-zero rounding errors, straight quote (not curly) --- .github/workflows/R-CMD-check.yaml | 4 +-- .github/workflows/pkgdown.yaml | 2 +- R/lm_equation.R | 6 +++-- tests/_setup.R | 4 +++ tests/cases/le_01_single_predictor.R | 2 +- tests/expected/le_01_single_predictor.txt | 2 +- tests/expected/le_02_additive.txt | 2 +- tests/expected/le_03_multiplicative.txt | 2 +- tests/expected/le_04_interaction.txt | 2 +- tests/expected/le_05_quadratic.txt | 2 +- tests/expected/le_06_ytransform_inverse.txt | 2 +- tests/expected/le_07_ytransform_sqrt.txt | 2 +- tests/expected/le_08_ytransform_log.txt | 2 +- tests/expected/le_09_ytransform_exp.txt | 2 +- tests/expected/le_10_ytransform_square.txt | 2 +- tests/report.html | 29 +++++++++++---------- 16 files changed, 37 insertions(+), 30 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 2a006ee..ee6d00f 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -33,7 +33,7 @@ jobs: R_KEEP_PKG_SOURCE: yes steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@v5 - uses: r-lib/actions/setup-pandoc@v2 @@ -61,7 +61,7 @@ jobs: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@v5 - uses: r-lib/actions/setup-r@v2 with: diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 4663f98..9dba485 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -22,7 +22,7 @@ jobs: permissions: contents: write steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@v5 - uses: r-lib/actions/setup-pandoc@v2 diff --git a/R/lm_equation.R b/R/lm_equation.R index 929a2ce..aa8de39 100644 --- a/R/lm_equation.R +++ b/R/lm_equation.R @@ -19,11 +19,13 @@ check_equation_style <- function(style) { # so term labels and coefficients don't line up (or even match in length). # Coefficient names are the design-matrix column names and always align. # NA coefficients (rank-deficient fits) are dropped: they contribute nothing -# to predictions and "NA*x" is not an equation. +# to predictions and "NA*x" is not an equation. zapsmall() rounds +# floating-point residue (an exact fit's 2e-15 intercept) to 0, which would +# otherwise print as noise that differs between platforms. lm_equation_parts <- function(model, style = c("prettier", "brackets", "raw")) { style <- check_equation_style(style) co <- coef(model) - co <- co[!is.na(co)] + co <- zapsmall(co[!is.na(co)]) has_intercept <- names(co)[1] == "(Intercept)" slopes <- signif(if (has_intercept) co[-1] else co, 3) if (style != "raw") { diff --git a/tests/_setup.R b/tests/_setup.R index 1c25f9c..c6eea5a 100644 --- a/tests/_setup.R +++ b/tests/_setup.R @@ -12,6 +12,10 @@ if (!"Applr" %in% loadedNamespaces()) { } suppressPackageStartupMessages(library(ggplot2)) +# Straight quotes keep console snapshots identical across locales (a UTF-8 +# locale prints summary()'s significance codes with curly quotes). +options(useFancyQuotes = FALSE) + # try_show(expr) — run one step of a console case. Prints the visible result, # or the error/warning/message it raises, then lets the rest of the file keep # running (a bare error would abort the script at the first failing call). diff --git a/tests/cases/le_01_single_predictor.R b/tests/cases/le_01_single_predictor.R index 0c26006..39cb2f1 100644 --- a/tests/cases/le_01_single_predictor.R +++ b/tests/cases/le_01_single_predictor.R @@ -2,7 +2,7 @@ # TYPE: console # FUNC: lm_equation # EXPECT: "y = + 1*x" with coefficients to 3 significant figures -# (intercept ~0 in scientific notation is fine). +# (the exact fit's floating-point intercept is zapped to 0). source("tests/_setup.R") set.seed(123) diff --git a/tests/expected/le_01_single_predictor.txt b/tests/expected/le_01_single_predictor.txt index e43b818..0845c13 100644 --- a/tests/expected/le_01_single_predictor.txt +++ b/tests/expected/le_01_single_predictor.txt @@ -1 +1 @@ -[1] "y = 6.28e-17 + 1*x" +[1] "y = 0 + 1*x" diff --git a/tests/expected/le_02_additive.txt b/tests/expected/le_02_additive.txt index a06e24a..75370df 100644 --- a/tests/expected/le_02_additive.txt +++ b/tests/expected/le_02_additive.txt @@ -1 +1 @@ -[1] "y = -3.39e-15 + 1*x + 1*x_pos" +[1] "y = 0 + 1*x + 1*x_pos" diff --git a/tests/expected/le_03_multiplicative.txt b/tests/expected/le_03_multiplicative.txt index e003f31..a3ff349 100644 --- a/tests/expected/le_03_multiplicative.txt +++ b/tests/expected/le_03_multiplicative.txt @@ -1 +1 @@ -[1] "y = -1.51e-15 + 1*I(x * x_pos)" +[1] "y = 0 + 1*I(x * x_pos)" diff --git a/tests/expected/le_04_interaction.txt b/tests/expected/le_04_interaction.txt index b5e88d7..d8bf6d2 100644 --- a/tests/expected/le_04_interaction.txt +++ b/tests/expected/le_04_interaction.txt @@ -1 +1 @@ -[1] "y = -2.51e-16 + 1*x:x_switch" +[1] "y = 0 + 1*x:x_switch" diff --git a/tests/expected/le_05_quadratic.txt b/tests/expected/le_05_quadratic.txt index 6a9e673..6175b5b 100644 --- a/tests/expected/le_05_quadratic.txt +++ b/tests/expected/le_05_quadratic.txt @@ -1 +1 @@ -[1] "y = 8.29e-15 + 1*x + 1*I(x^2)" +[1] "y = 0 + 1*x + 1*I(x^2)" diff --git a/tests/expected/le_06_ytransform_inverse.txt b/tests/expected/le_06_ytransform_inverse.txt index 188cbb9..8d51f34 100644 --- a/tests/expected/le_06_ytransform_inverse.txt +++ b/tests/expected/le_06_ytransform_inverse.txt @@ -1 +1 @@ -[1] "1/y = 6.28e-17 + 1*x" +[1] "1/y = 0 + 1*x" diff --git a/tests/expected/le_07_ytransform_sqrt.txt b/tests/expected/le_07_ytransform_sqrt.txt index 2b2a09b..6c6c1f1 100644 --- a/tests/expected/le_07_ytransform_sqrt.txt +++ b/tests/expected/le_07_ytransform_sqrt.txt @@ -1 +1 @@ -[1] "sqrt(y) = 2.01e-15 + 1*x_pos" +[1] "sqrt(y) = 0 + 1*x_pos" diff --git a/tests/expected/le_08_ytransform_log.txt b/tests/expected/le_08_ytransform_log.txt index 776a2e8..9d3a858 100644 --- a/tests/expected/le_08_ytransform_log.txt +++ b/tests/expected/le_08_ytransform_log.txt @@ -1 +1 @@ -[1] "log(y) = 2.01e-15 + 1*x_pos" +[1] "log(y) = 0 + 1*x_pos" diff --git a/tests/expected/le_09_ytransform_exp.txt b/tests/expected/le_09_ytransform_exp.txt index 1f4cb97..6f7dae7 100644 --- a/tests/expected/le_09_ytransform_exp.txt +++ b/tests/expected/le_09_ytransform_exp.txt @@ -1 +1 @@ -[1] "exp(y) = 2.01e-15 + 1*x_pos" +[1] "exp(y) = 0 + 1*x_pos" diff --git a/tests/expected/le_10_ytransform_square.txt b/tests/expected/le_10_ytransform_square.txt index b149d16..0d8a36a 100644 --- a/tests/expected/le_10_ytransform_square.txt +++ b/tests/expected/le_10_ytransform_square.txt @@ -1 +1 @@ -[1] "y^2 = 2.01e-15 + 1*x_pos" +[1] "y^2 = 0 + 1*x_pos" diff --git a/tests/report.html b/tests/report.html index 0ceef2b..cb10188 100644 --- a/tests/report.html +++ b/tests/report.html @@ -1578,7 +1578,7 @@

Applr Test Suite

-

2026-10-13 15:30

+

2026-10-13 15:40

@@ -2813,7 +2813,7 @@

Show

console lm_equation “y = + 1*x” with coefficients to 3 -significant figures (intercept ~0 in scientific notation is fin… +significant figures (the exact fit’s floating-point intercept i… le_02_additive @@ -7145,14 +7145,15 @@

lm_equation

le_01_single_predictor

Expect: “y = + 1*x” with coefficients to -3 significant figures (intercept ~0 in scientific notation is fine).

+3 significant figures (the exact fit’s floating-point intercept is +zapped to 0).

Status: OK

# CASE: le_01_single_predictor
 # TYPE: console
 # FUNC: lm_equation
 # EXPECT: "y = <intercept> + 1*x" with coefficients to 3 significant figures
-#         (intercept ~0 in scientific notation is fine).
+#         (the exact fit's floating-point intercept is zapped to 0).
 
 source("tests/_setup.R")
 set.seed(123)
@@ -7165,7 +7166,7 @@ 

le_01_single_predictor

try_show(lm_equation(model))

No plot produced by this run (expected for error cases).

Console output (this run):

-
[1] "y = 6.28e-17 + 1*x"
+
[1] "y = 0 + 1*x"

le_02_additive

@@ -7191,7 +7192,7 @@

le_02_additive

try_show(lm_equation(model))

No plot produced by this run (expected for error cases).

Console output (this run):

-
[1] "y = -3.39e-15 + 1*x + 1*x_pos"
+
[1] "y = 0 + 1*x + 1*x_pos"

le_03_multiplicative

@@ -7217,7 +7218,7 @@

le_03_multiplicative

try_show(lm_equation(model))

No plot produced by this run (expected for error cases).

Console output (this run):

-
[1] "y = -1.51e-15 + 1*I(x * x_pos)"
+
[1] "y = 0 + 1*I(x * x_pos)"

le_04_interaction

@@ -7243,7 +7244,7 @@

le_04_interaction

try_show(lm_equation(model))

No plot produced by this run (expected for error cases).

Console output (this run):

-
[1] "y = -2.51e-16 + 1*x:x_switch"
+
[1] "y = 0 + 1*x:x_switch"

le_05_quadratic

@@ -7268,7 +7269,7 @@

le_05_quadratic

try_show(lm_equation(model))

No plot produced by this run (expected for error cases).

Console output (this run):

-
[1] "y = 8.29e-15 + 1*x + 1*I(x^2)"
+
[1] "y = 0 + 1*x + 1*I(x^2)"

le_06_ytransform_inverse

@@ -7293,7 +7294,7 @@

le_06_ytransform_inverse

try_show(lm_equation(model))

No plot produced by this run (expected for error cases).

Console output (this run):

-
[1] "1/y = 6.28e-17 + 1*x"
+
[1] "1/y = 0 + 1*x"

le_07_ytransform_sqrt

@@ -7319,7 +7320,7 @@

le_07_ytransform_sqrt

try_show(lm_equation(model))

No plot produced by this run (expected for error cases).

Console output (this run):

-
[1] "sqrt(y) = 2.01e-15 + 1*x_pos"
+
[1] "sqrt(y) = 0 + 1*x_pos"

le_08_ytransform_log

@@ -7345,7 +7346,7 @@

le_08_ytransform_log

try_show(lm_equation(model))

No plot produced by this run (expected for error cases).

Console output (this run):

-
[1] "log(y) = 2.01e-15 + 1*x_pos"
+
[1] "log(y) = 0 + 1*x_pos"

le_09_ytransform_exp

@@ -7371,7 +7372,7 @@

le_09_ytransform_exp

try_show(lm_equation(model))

No plot produced by this run (expected for error cases).

Console output (this run):

-
[1] "exp(y) = 2.01e-15 + 1*x_pos"
+
[1] "exp(y) = 0 + 1*x_pos"

le_10_ytransform_square

@@ -7397,7 +7398,7 @@

le_10_ytransform_square

try_show(lm_equation(model))

No plot produced by this run (expected for error cases).

Console output (this run):

-
[1] "y^2 = 2.01e-15 + 1*x_pos"
+
[1] "y^2 = 0 + 1*x_pos"

le_11_mtcars_log

From 99a0676a8367c1c4f92dfcd654b90d7f8b9ca89a Mon Sep 17 00:00:00 2001 From: James Beeson Date: Tue, 13 Oct 2026 16:08:01 -0600 Subject: [PATCH 9/9] one more linux integration issue --- R/slice_annotation_wrap.R | 11 ++++++++--- tests/report.html | 2 +- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/R/slice_annotation_wrap.R b/R/slice_annotation_wrap.R index 11a3991..b68da5e 100644 --- a/R/slice_annotation_wrap.R +++ b/R/slice_annotation_wrap.R @@ -124,11 +124,16 @@ annotation_avail_width <- function(plot, element) { # the thin and hair spaces land much closer. Fonts that have no separate # glyphs for them report the width of a plain space instead; those are dropped # here, so the indent quietly degrades to whole spaces rather than emitting -# characters the device would draw as a missing-glyph box. +# characters the device would draw as a missing-glyph box. So are glyphs the +# device cannot encode at all: pdf() in a single-byte encoding errors on them +# (Linux, macOS) where Windows substitutes a plain space. pad_glyphs <- function(gp) { candidates <- c(" ", "\u2002", "\u2009", "\u200a") - w <- annotation_width(candidates, gp) - keep <- w > 0 & !duplicated(round(w, 4)) + w <- vapply(candidates, function(s) { + tryCatch(annotation_width(s, gp), warning = function(w) NA_real_, + error = function(e) NA_real_) + }, numeric(1), USE.NAMES = FALSE) + keep <- !is.na(w) & w > 0 & !duplicated(round(w, 4)) list(glyph = candidates[keep], width = w[keep]) } diff --git a/tests/report.html b/tests/report.html index cb10188..51e62dc 100644 --- a/tests/report.html +++ b/tests/report.html @@ -1578,7 +1578,7 @@

Applr Test Suite

-

2026-10-13 15:40

+

2026-10-13 16:04