├── .github ├── .gitignore ├── workflows │ ├── auto-pkg-maintenance.yaml │ ├── pkgdown.yaml │ └── R-CMD-check.yaml └── CODE_OF_CONDUCT.md ├── LICENSE ├── man ├── figures │ ├── logo.png │ └── README-expected-plot-1.png ├── reexports.Rd ├── n_layers.Rd ├── fragments │ ├── readme-intro.Rmd │ └── readme-usage.Rmd ├── get_coordinate_system.Rd ├── ith_stat.Rd ├── get_stats.Rd ├── get_geoms_stats.Rd ├── gradethis_equal.ggplot.Rd ├── get_geoms.Rd ├── ith_geom.Rd ├── ith_stat_is.Rd ├── uses_stat_param.Rd ├── ith_geom_is.Rd ├── ith_geom_stat.Rd ├── uses_coordinate_system.Rd ├── default_label.Rd ├── identical_aes.Rd ├── get_stat_layer.Rd ├── uses_aesthetics.Rd ├── uses_extra_mappings.Rd ├── get_labels.Rd ├── get_geom_layer.Rd ├── ggcheck-package.Rd ├── uses_stats.Rd ├── ith_data.Rd ├── uses_data.Rd ├── ith_data_is.Rd ├── get_default_params.Rd ├── uses_geoms.Rd ├── get_data.Rd ├── get_default_labels.Rd ├── is_ggplot.Rd ├── uses_mappings.Rd ├── get_mappings.Rd ├── ith_mappings.Rd ├── ith_mappings_use.Rd ├── uses_labels.Rd └── uses_geom_params.Rd ├── tests ├── testthat.R └── testthat │ ├── _snaps │ └── is_ggplot.md │ ├── test-coordinates.R │ ├── test-is_ggplot.R │ ├── test-layers.R │ ├── test-data.R │ ├── test-geoms.R │ ├── test-stats.R │ ├── test-labels.R │ ├── test-mappings.R │ └── test-geom_params.R ├── pkgdown ├── favicon │ ├── favicon.ico │ ├── favicon-16x16.png │ ├── favicon-32x32.png │ ├── apple-touch-icon.png │ ├── apple-touch-icon-60x60.png │ ├── apple-touch-icon-76x76.png │ ├── apple-touch-icon-120x120.png │ ├── apple-touch-icon-152x152.png │ └── apple-touch-icon-180x180.png ├── assets │ └── ggcheck-social.png └── _pkgdown.yml ├── .Rbuildignore ├── .lintr ├── R ├── ggcheck-package.R ├── gradethis_equal.R ├── default_placeholders.R ├── coordinates.R ├── is_ggplot.R ├── stats.R ├── geom_params.R ├── layers.R ├── geoms.R ├── data.R ├── utils.R ├── labels.R └── mappings.R ├── ggcheck.Rproj ├── .gitignore ├── README.Rmd ├── NEWS.md ├── LICENSE.md ├── NAMESPACE ├── DESCRIPTION └── README.md /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | r-depends.rds 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2021 2 | COPYRIGHT HOLDER: ggcheck authors 3 | -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/ggcheck/HEAD/man/figures/logo.png -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(ggcheck) 3 | 4 | test_check("ggcheck") 5 | -------------------------------------------------------------------------------- /pkgdown/favicon/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/ggcheck/HEAD/pkgdown/favicon/favicon.ico -------------------------------------------------------------------------------- /pkgdown/assets/ggcheck-social.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/ggcheck/HEAD/pkgdown/assets/ggcheck-social.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-16x16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/ggcheck/HEAD/pkgdown/favicon/favicon-16x16.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-32x32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/ggcheck/HEAD/pkgdown/favicon/favicon-32x32.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/ggcheck/HEAD/pkgdown/favicon/apple-touch-icon.png -------------------------------------------------------------------------------- /man/figures/README-expected-plot-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/ggcheck/HEAD/man/figures/README-expected-plot-1.png -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^ggcheck\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^\.github$ 4 | ^pkgdown$ 5 | ^\.lintr$ 6 | ^README\.Rmd$ 7 | ^LICENSE\.md$ 8 | -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-60x60.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/ggcheck/HEAD/pkgdown/favicon/apple-touch-icon-60x60.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-76x76.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/ggcheck/HEAD/pkgdown/favicon/apple-touch-icon-76x76.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-120x120.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/ggcheck/HEAD/pkgdown/favicon/apple-touch-icon-120x120.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-152x152.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/ggcheck/HEAD/pkgdown/favicon/apple-touch-icon-152x152.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-180x180.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/ggcheck/HEAD/pkgdown/favicon/apple-touch-icon-180x180.png -------------------------------------------------------------------------------- /.lintr: -------------------------------------------------------------------------------- 1 | linters: linters_with_defaults( 2 | line_length_linter(120), 3 | T_and_F_symbol_linter, 4 | absolute_path_linter, 5 | nonportable_path_linter, 6 | semicolon_linter, 7 | undesirable_operator_linter 8 | ) 9 | -------------------------------------------------------------------------------- /R/ggcheck-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | 4 | ## usethis namespace: start 5 | #' @importFrom gradethis fail 6 | ## usethis namespace: end 7 | NULL 8 | 9 | #' @importFrom gradethis .result 10 | #' @export 11 | gradethis::.result 12 | -------------------------------------------------------------------------------- /.github/workflows/auto-pkg-maintenance.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | pull_request_target: 3 | types: [opened, synchronize, labeled] 4 | push: 5 | branches: main 6 | 7 | name: Package Maintenance 8 | 9 | jobs: 10 | auto-pkg-maintenance: 11 | uses: rstudio/education-workflows/.github/workflows/auto-pkg-maintenance.yaml@v1 12 | -------------------------------------------------------------------------------- /man/reexports.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggcheck-package.R 3 | \docType{import} 4 | \name{reexports} 5 | \alias{reexports} 6 | \alias{.result} 7 | \title{Objects exported from other packages} 8 | \keyword{internal} 9 | \description{ 10 | These objects are imported from other packages. Follow the links 11 | below to see their documentation. 12 | 13 | \describe{ 14 | \item{gradethis}{\code{\link[gradethis:grade_this-objects]{.result}}} 15 | }} 16 | 17 | -------------------------------------------------------------------------------- /ggcheck.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | LineEndingConversion: Posix 18 | 19 | BuildType: Package 20 | PackageUseDevtools: Yes 21 | PackageInstallArgs: --no-multiarch --with-keep.source 22 | PackageRoxygenize: rd,collate,namespace 23 | -------------------------------------------------------------------------------- /man/n_layers.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/layers.R 3 | \name{n_layers} 4 | \alias{n_layers} 5 | \title{How many layers are in a plot?} 6 | \usage{ 7 | n_layers(p) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object} 11 | } 12 | \value{ 13 | Numeric. The number of layers. 14 | } 15 | \description{ 16 | How many layers are in a plot? 17 | } 18 | \examples{ 19 | require(ggplot2) 20 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 21 | geom_point(mapping = aes(color = class)) + 22 | geom_smooth() 23 | n_layers(p) 24 | } 25 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | .DS_Store 5 | 6 | # Session Data files 7 | .RData 8 | 9 | # User-specific files 10 | .Ruserdata 11 | 12 | # Example code in package build process 13 | *-Ex.R 14 | 15 | # Output files from R CMD build 16 | /*.tar.gz 17 | 18 | # Output files from R CMD check 19 | /*.Rcheck/ 20 | 21 | # RStudio files 22 | .Rproj.user/ 23 | 24 | # produced vignettes 25 | vignettes/*.html 26 | vignettes/*.pdf 27 | 28 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 29 | .httr-oauth 30 | 31 | # knitr and R markdown default cache directories 32 | *_cache/ 33 | /cache/ 34 | 35 | # Temporary files created by R markdown 36 | *.utf8.md 37 | *.knit.md 38 | 39 | # R Environment Variables 40 | .Renviron 41 | .Rproj.user 42 | reference 43 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/is_ggplot.md: -------------------------------------------------------------------------------- 1 | # fail_if_not_ggplot() within mock_this_exercise() 2 | 3 | Code 4 | gradethis::grade_this({ 5 | fail_if_not_ggplot() 6 | })(gradethis::mock_this_exercise(.user_code = "2")) 7 | Output 8 | 12 | 13 | --- 14 | 15 | Code 16 | gradethis::grade_this({ 17 | fail_if_not_ggplot() 18 | })(gradethis::mock_this_exercise(.user_code = "ggplot2::geom_point()")) 19 | Output 20 | 24 | 25 | -------------------------------------------------------------------------------- /R/gradethis_equal.R: -------------------------------------------------------------------------------- 1 | #' Compare two `ggplot`s to check whether they are equal 2 | #' 3 | #' @param x,y Two `ggplot` objects to compare 4 | #' @param ... Unused 5 | #' 6 | #' @seealso [gradethis::gradethis_equal()] for the generic function. 7 | #' @inherit gradethis::gradethis_equal return 8 | #' @importFrom gradethis gradethis_equal 9 | #' @export 10 | #' 11 | #' @examples 12 | #' library(ggplot2) 13 | #' library(ggcheck) 14 | #' library(gradethis) 15 | #' 16 | #' cty_plot <- ggplot(mpg, aes(x = displ, y = cty)) + geom_point() 17 | #' hwy_plot <- ggplot(mpg, aes(x = displ, y = cty)) + geom_point() 18 | #' 19 | #' gradethis_equal(cty_plot, hwy_plot) 20 | #' gradethis_equal(cty_plot, cty_plot) 21 | gradethis_equal.ggplot <- function(x, y, ...) { 22 | try(ggplot2::ggplot_build(x), silent = TRUE) 23 | try(ggplot2::ggplot_build(y), silent = TRUE) 24 | NextMethod() 25 | } 26 | -------------------------------------------------------------------------------- /man/fragments/readme-intro.Rmd: -------------------------------------------------------------------------------- 1 | 2 | [![CRAN status](https://www.r-pkg.org/badges/version/ggcheck)](https://CRAN.R-project.org/package=ggcheck) 3 | [![R-CMD-check](https://github.com/rstudio/ggcheck/workflows/R-CMD-check/badge.svg)](https://github.com/rstudio/ggcheck/actions) 4 | 5 | 6 | 7 | ggcheck provides functions that inspect [ggplot2] objects to make it easier for teachers to check that student plots meet expectations. Designed primarily for automated grading via [gradethis] in interactive [learnr] tutorials. 8 | 9 | ## Installation 10 | 11 | You can install ggcheck from [GitHub][gh-ggcheck] with: 12 | 13 | ``` r 14 | # install.packages("remotes") 15 | remotes::install_github("rstudio/ggcheck") 16 | ``` 17 | -------------------------------------------------------------------------------- /man/get_coordinate_system.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/coordinates.R 3 | \name{get_coordinate_system} 4 | \alias{get_coordinate_system} 5 | \title{Which coordinate system does a plot use?} 6 | \usage{ 7 | get_coordinate_system(p) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot2 object} 11 | } 12 | \value{ 13 | A character string that corresponds to the suffix of a ggplot2 14 | \code{coord_} function, e.g. \code{"cartesian"}. 15 | } 16 | \description{ 17 | Which coordinate system does a plot use? 18 | } 19 | \examples{ 20 | require(ggplot2) 21 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 22 | geom_point(mapping = aes(color = class)) + 23 | geom_smooth() + 24 | coord_polar() 25 | get_coordinate_system(p) 26 | } 27 | \seealso{ 28 | Other functions for checking coordinate systems: 29 | \code{\link{uses_coordinate_system}()} 30 | } 31 | \concept{functions for checking coordinate systems} 32 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | fig.retina = 2, 13 | out.width = "100%" 14 | ) 15 | ``` 16 | 17 | # ggcheck 18 | 19 | ```{r child="man/fragments/readme-intro.Rmd"} 20 | ``` 21 | 22 | ## Usage 23 | 24 | ```{r usage, child="man/fragments/readme-usage.Rmd"} 25 | ``` 26 | 27 | ## Code of Conduct 28 | 29 | Please note that the tblcheck project is released with a [Contributor Code of Conduct](https://contributor-covenant.org/version/2/0/CODE_OF_CONDUCT.html). By contributing to this project, you agree to abide by its terms. 30 | 31 | [gh-ggcheck]: https://github.com/rstudio/ggcheck 32 | [ggplot2]: https://ggplot2.tidyverse.org 33 | [gradethis]: https://pkgs.rstudio.com/gradethis 34 | [learnr]: https://rstudio.github.io/learnr/ 35 | -------------------------------------------------------------------------------- /man/ith_stat.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stats.R 3 | \name{ith_stat} 4 | \alias{ith_stat} 5 | \title{Which stat is used in the ith layer?} 6 | \usage{ 7 | ith_stat(p, i) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object} 11 | 12 | \item{i}{A numerical index that corresponds to the first layer of a plot (1), 13 | the second layer (2), and so on.} 14 | } 15 | \value{ 16 | A character string that corresponds to the suffix of a ggplot2 17 | \code{stat_} function, e.g. \code{"qq"}. 18 | } 19 | \description{ 20 | \code{ith_stat} returns the type of stat used by the ith layer. 21 | } 22 | \examples{ 23 | require(ggplot2) 24 | p <- ggplot(data = diamonds, aes(sample = price)) + 25 | geom_qq() 26 | ith_stat(p, i = 1) 27 | } 28 | \seealso{ 29 | Other functions for checking stats: 30 | \code{\link{get_stats}()}, 31 | \code{\link{ith_stat_is}()}, 32 | \code{\link{uses_stats}()} 33 | } 34 | \concept{functions for checking stats} 35 | -------------------------------------------------------------------------------- /tests/testthat/test-coordinates.R: -------------------------------------------------------------------------------- 1 | require(ggplot2, quietly = TRUE) 2 | 3 | p <- 4 | ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 5 | geom_point(mapping = aes(color = class)) + 6 | geom_smooth(se = FALSE) + 7 | labs(title = "TITLE", subtitle = "SUBTITLE", caption = "CAPTION") 8 | 9 | test_that("Identifies coordinate system", { 10 | expect_equal( 11 | get_coordinate_system(p), 12 | "cartesian" 13 | ) 14 | expect_equal( 15 | get_coordinate_system(p + coord_cartesian()), 16 | "cartesian" 17 | ) 18 | expect_equal( 19 | get_coordinate_system(p + coord_cartesian(xlim = c(0, 1))), 20 | "cartesian" 21 | ) 22 | }) 23 | 24 | test_that("Checks whether a coordinate system is used", { 25 | expect_true(uses_coordinate_system(p, "cartesian")) 26 | expect_true(uses_coordinate_system(p + coord_cartesian(), "cartesian")) 27 | expect_true(uses_coordinate_system(p + coord_cartesian(xlim = c(0, 1)), "cartesian")) 28 | expect_false(uses_coordinate_system(p, "polar")) 29 | }) 30 | -------------------------------------------------------------------------------- /man/get_stats.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stats.R 3 | \name{get_stats} 4 | \alias{get_stats} 5 | \title{List the stats used by a plot} 6 | \usage{ 7 | get_stats(p) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object} 11 | } 12 | \value{ 13 | A vector of character strings. Each element corresponds to the suffix 14 | of a ggplot2 \code{stat_} function, e.g. \code{c("identity", "smooth")}. 15 | } 16 | \description{ 17 | \code{get_stats} returns a vector of stats names, written as character 18 | strings, that describes which stats in which order are used by a plot. 19 | } 20 | \examples{ 21 | require(ggplot2) 22 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 23 | geom_point(mapping = aes(color = class)) + 24 | geom_smooth() 25 | get_stats(p) 26 | } 27 | \seealso{ 28 | Other functions for checking stats: 29 | \code{\link{ith_stat_is}()}, 30 | \code{\link{ith_stat}()}, 31 | \code{\link{uses_stats}()} 32 | } 33 | \concept{functions for checking stats} 34 | -------------------------------------------------------------------------------- /man/get_geoms_stats.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geoms.R 3 | \name{get_geoms_stats} 4 | \alias{get_geoms_stats} 5 | \title{List the geom and stat combination used by all layers of a plot.} 6 | \usage{ 7 | get_geoms_stats(p) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object} 11 | } 12 | \value{ 13 | A list of lists with a GEOM and STAT character. 14 | e.g. list(list(GEOM = "point", STAT = "identity")) 15 | } 16 | \description{ 17 | List the geom and stat combination used by all layers of a plot. 18 | } 19 | \examples{ 20 | require(ggplot2) 21 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 22 | geom_point(mapping = aes(color = class)) + 23 | geom_smooth() 24 | get_geoms_stats(p) 25 | } 26 | \seealso{ 27 | Other functions for checking geoms: 28 | \code{\link{get_geoms}()}, 29 | \code{\link{ith_geom_is}()}, 30 | \code{\link{ith_geom_stat}()}, 31 | \code{\link{ith_geom}()}, 32 | \code{\link{uses_geoms}()} 33 | } 34 | \concept{functions for checking geoms} 35 | -------------------------------------------------------------------------------- /man/gradethis_equal.ggplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gradethis_equal.R 3 | \name{gradethis_equal.ggplot} 4 | \alias{gradethis_equal.ggplot} 5 | \title{Compare two \code{ggplot}s to check whether they are equal} 6 | \usage{ 7 | \method{gradethis_equal}{ggplot}(x, y, ...) 8 | } 9 | \arguments{ 10 | \item{x, y}{Two \code{ggplot} objects to compare} 11 | 12 | \item{...}{Unused} 13 | } 14 | \value{ 15 | A \link{logical} value of length one, or an internal gradethis error. 16 | } 17 | \description{ 18 | Compare two \code{ggplot}s to check whether they are equal 19 | } 20 | \examples{ 21 | library(ggplot2) 22 | library(ggcheck) 23 | library(gradethis) 24 | 25 | cty_plot <- ggplot(mpg, aes(x = displ, y = cty)) + geom_point() 26 | hwy_plot <- ggplot(mpg, aes(x = displ, y = cty)) + geom_point() 27 | 28 | gradethis_equal(cty_plot, hwy_plot) 29 | gradethis_equal(cty_plot, cty_plot) 30 | } 31 | \seealso{ 32 | \code{\link[gradethis:gradethis_equal]{gradethis::gradethis_equal()}} for the generic function. 33 | } 34 | -------------------------------------------------------------------------------- /man/get_geoms.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geoms.R 3 | \name{get_geoms} 4 | \alias{get_geoms} 5 | \title{List the geoms used by a plot} 6 | \usage{ 7 | get_geoms(p) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object} 11 | } 12 | \value{ 13 | A vector of character strings. Each element corresponds to the suffix 14 | of a ggplot2 \code{geom_} function, e.g. \code{c("point", "line", "smooth")}. 15 | } 16 | \description{ 17 | \code{get_geoms} returns a vector of geom names, written as character 18 | strings, that describes which geoms in which order are used by a plot. 19 | } 20 | \examples{ 21 | require(ggplot2) 22 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 23 | geom_point(mapping = aes(color = class)) + 24 | geom_smooth() 25 | get_geoms(p) 26 | } 27 | \seealso{ 28 | Other functions for checking geoms: 29 | \code{\link{get_geoms_stats}()}, 30 | \code{\link{ith_geom_is}()}, 31 | \code{\link{ith_geom_stat}()}, 32 | \code{\link{ith_geom}()}, 33 | \code{\link{uses_geoms}()} 34 | } 35 | \concept{functions for checking geoms} 36 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # ggcheck 0.0.5 2 | 3 | * Add `gradethis_equal()` method for `ggplot` objects (#37). 4 | 5 | # ggcheck 0.0.4 (2022-04-14) 6 | 7 | * Allow uses_mappings() to find mappings that appear in every layer of the plot (#35). 8 | 9 | # ggcheck 0.0.3 (2022-02-24) 10 | 11 | - Fixed a bug when `fail_if_not_ggplot()` attempted to access a `gradethis` `.result` object (#33) 12 | 13 | # ggcheck 0.0.2 (2021-12-22) 14 | 15 | ## New Features 16 | 17 | * New functions for checking plot labels (#22) 18 | - `get_labels()` lists (a subset of) the labels of a plot 19 | - `uses_labels()` checks if labels match their expected values 20 | - Added `fail_if_not_ggplot()` for use in grading code to check that the submitted result is a ggplot, powered by the lower-level testing function `is_ggplot()` (#29). 21 | 22 | ## Improvements and Updates 23 | 24 | - Improve handling of `...` in `uses_labels()` (#26) 25 | - Unnamed arguments to `uses_labels()` check if label is set (#27) 26 | - Check for `aes` params in `uses_geom_param()` (#28) 27 | 28 | # ggcheck 0.0.1 (2021-10-22) 29 | 30 | - Initial release of ggcheck 31 | -------------------------------------------------------------------------------- /man/ith_geom.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geoms.R 3 | \name{ith_geom} 4 | \alias{ith_geom} 5 | \title{Which geom is used in the ith layer?} 6 | \usage{ 7 | ith_geom(p, i) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object} 11 | 12 | \item{i}{A numerical index that corresponds to the first layer of a plot (1), 13 | the second layer (2), and so on.} 14 | } 15 | \value{ 16 | A character string that corresponds to the suffix of a ggplot2 17 | \code{geom_} function, e.g. \code{"point"}. 18 | } 19 | \description{ 20 | \code{ith_geom} returns the type of geom used by the ith layer. 21 | } 22 | \examples{ 23 | require(ggplot2) 24 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 25 | geom_point(mapping = aes(color = class)) + 26 | geom_smooth() 27 | ith_geom(p, i = 2) 28 | } 29 | \seealso{ 30 | Other functions for checking geoms: 31 | \code{\link{get_geoms_stats}()}, 32 | \code{\link{get_geoms}()}, 33 | \code{\link{ith_geom_is}()}, 34 | \code{\link{ith_geom_stat}()}, 35 | \code{\link{uses_geoms}()} 36 | } 37 | \concept{functions for checking geoms} 38 | -------------------------------------------------------------------------------- /man/ith_stat_is.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stats.R 3 | \name{ith_stat_is} 4 | \alias{ith_stat_is} 5 | \title{Is the ith stat what it should be?} 6 | \usage{ 7 | ith_stat_is(p, stat, i = 1) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object} 11 | 12 | \item{stat}{A character string that corresponds to 13 | the suffix of a ggplot2 \code{stat_} function, e.g. \code{"identity"}.} 14 | 15 | \item{i}{A numerical index that corresponds to the first layer of a plot (1), 16 | the second layer (2), and so on. \code{ith_stat_is} will check the 17 | stat used by the ith layer.} 18 | } 19 | \value{ 20 | \code{TRUE} or \code{FALSE} 21 | } 22 | \description{ 23 | \code{ith_stat_is} checks whether the ith layer uses the prescribed type of stat 24 | } 25 | \examples{ 26 | require(ggplot2) 27 | p <- ggplot(data = diamonds, aes(sample = price)) + 28 | geom_qq() 29 | ith_stat_is(p, i = 1, "qq") 30 | } 31 | \seealso{ 32 | Other functions for checking stats: 33 | \code{\link{get_stats}()}, 34 | \code{\link{ith_stat}()}, 35 | \code{\link{uses_stats}()} 36 | } 37 | \concept{functions for checking stats} 38 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2021 ggcheck authors 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /man/uses_stat_param.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stats.R 3 | \name{uses_stat_param} 4 | \alias{uses_stat_param} 5 | \title{Does a layer use a specific stat parameter?} 6 | \usage{ 7 | uses_stat_param(p, stat, params, i = NULL) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object} 11 | 12 | \item{stat}{A character string found in the suffix of a ggplot2 stat function, 13 | e.g. \code{"bin"}.} 14 | 15 | \item{params}{A named list of stat or geom parameter values, e.g. \code{list(bins = 200)}} 16 | 17 | \item{i}{A numerical index, e.g. \code{1}.} 18 | } 19 | \value{ 20 | A boolean 21 | } 22 | \description{ 23 | \code{uses_stat_param} is a mirror function of \code{uses_geom_param} but instead of checking a plot's 24 | geom layer, it checks that a plot's stat layer uses a specific stat parameter. 25 | } 26 | \details{ 27 | To specify a specific stat layer, either specify using position using the \code{i} index or 28 | by using a combination of \code{stat} function suffix name and \code{i} to check the ith layer that 29 | uses the stat. 30 | } 31 | \examples{ 32 | require(ggplot2) 33 | p <- ggplot(diamonds, aes(carat)) + 34 | stat_bin(bins = 200) 35 | uses_stat_param(p, stat = "bin", params = list(bins = 200)) 36 | } 37 | -------------------------------------------------------------------------------- /man/ith_geom_is.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geoms.R 3 | \name{ith_geom_is} 4 | \alias{ith_geom_is} 5 | \title{Is the ith geom what it should be?} 6 | \usage{ 7 | ith_geom_is(p, geom, i = 1) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object} 11 | 12 | \item{geom}{A character string that corresponds to 13 | the suffix of a ggplot2 \code{geom_} function, e.g. \code{"point"}.} 14 | 15 | \item{i}{A numerical index that corresponds to the first layer of a plot (1), 16 | the second layer (2), and so on. \code{ith_geom_is} will check the 17 | geom used by the ith layer.} 18 | } 19 | \value{ 20 | \code{TRUE} or \code{FALSE} 21 | } 22 | \description{ 23 | \code{ith_geom_is} checks whether the ith layer uses the prescribed type of geom. 24 | } 25 | \examples{ 26 | require(ggplot2) 27 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 28 | geom_point(mapping = aes(color = class)) + 29 | geom_smooth() 30 | ith_geom_is(p, geom = "smooth", i = 2) 31 | } 32 | \seealso{ 33 | Other functions for checking geoms: 34 | \code{\link{get_geoms_stats}()}, 35 | \code{\link{get_geoms}()}, 36 | \code{\link{ith_geom_stat}()}, 37 | \code{\link{ith_geom}()}, 38 | \code{\link{uses_geoms}()} 39 | } 40 | \concept{functions for checking geoms} 41 | -------------------------------------------------------------------------------- /R/default_placeholders.R: -------------------------------------------------------------------------------- 1 | #' Placeholders for default values 2 | #' 3 | #' @description 4 | #' These functions generate placeholder values. 5 | #' - `default_label()` can be used as a named argument in [uses_labels()] 6 | #' to check that a label matches the result of [get_default_labels()] 7 | #' with that name. 8 | #' - `default_param()` can be used as a named argument in [uses_geom_params()] 9 | #' to check that a parameter matched the result of [get_default_params()] 10 | #' with that name. 11 | #' 12 | #' @examples 13 | #' require(ggplot2) 14 | #' 15 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy, color = trans)) + 16 | #' geom_smooth(se = FALSE) + 17 | #' labs(title = "My plot", x = "Weight", y = "MPG") 18 | #' 19 | #' uses_labels(p, x = default_label(), color = default_label()) 20 | #' 21 | #' uses_geom_params(p, "smooth", size = default_param(), se = default_param()) 22 | #' @return A placeholder value to be used within [uses_labels()] 23 | #' or [uses_geom_params()]. 24 | #' @export 25 | default_label <- function() { 26 | structure(list(), class = c(".default_label", "ggcheck_placeholder")) 27 | } 28 | 29 | #' @rdname default_label 30 | #' @export 31 | default_param <- function() { 32 | structure(list(), class = c(".default_param", "ggcheck_placeholder")) 33 | } 34 | -------------------------------------------------------------------------------- /man/ith_geom_stat.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geoms.R 3 | \name{ith_geom_stat} 4 | \alias{ith_geom_stat} 5 | \title{Which geom/stat combination is used in the ith layer?} 6 | \usage{ 7 | ith_geom_stat(p, i) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object} 11 | 12 | \item{i}{A numerical index that corresponds to the first layer of a plot (1), 13 | the second layer (2), and so on.} 14 | } 15 | \value{ 16 | A list of lists with a GEOM and STAT strings, each corresponding to the suffix of a ggplot2 17 | \code{geom_} function (e.g. \code{"point"}), and \code{stat_} function (e.g. \code{"identity"}). 18 | e.g. list(list(GEOM = "point", STAT = "identity")) 19 | } 20 | \description{ 21 | \code{ith_geom_stat} returns the type of geom used by the ith layer 22 | according to a geom/stat combination. 23 | } 24 | \examples{ 25 | require(ggplot2) 26 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 27 | geom_point(mapping = aes(color = class)) + 28 | geom_smooth() 29 | ith_geom_stat(p, i = 2) 30 | } 31 | \seealso{ 32 | Other functions for checking geoms: 33 | \code{\link{get_geoms_stats}()}, 34 | \code{\link{get_geoms}()}, 35 | \code{\link{ith_geom_is}()}, 36 | \code{\link{ith_geom}()}, 37 | \code{\link{uses_geoms}()} 38 | } 39 | \concept{functions for checking geoms} 40 | -------------------------------------------------------------------------------- /man/uses_coordinate_system.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/coordinates.R 3 | \name{uses_coordinate_system} 4 | \alias{uses_coordinate_system} 5 | \title{Does a plot use the correct coordinate system?} 6 | \usage{ 7 | uses_coordinate_system(p, coordinates) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot2 object} 11 | 12 | \item{coordinates}{A character string that corresponds to the suffix of a 13 | ggplot2 \code{coord_} function, e.g. \code{"cartesian"}.} 14 | } 15 | \value{ 16 | \code{TRUE} or \code{FALSE} 17 | } 18 | \description{ 19 | \code{uses_coordinate_system} checks whether a plot uses the coordinate 20 | system you describe. To describe a coordinate system, use the character 21 | string that matches the suffix of the ggplot2 \code{coord_} function that 22 | would make the coordinate system. The default coordinate system for ggplot2 23 | plots is \code{"cartesian"}. 24 | } 25 | \examples{ 26 | require(ggplot2) 27 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 28 | geom_point(mapping = aes(color = class)) + 29 | geom_smooth() + 30 | coord_polar() 31 | uses_coordinate_system(p, coordinates = "polar") 32 | } 33 | \seealso{ 34 | Other functions for checking coordinate systems: 35 | \code{\link{get_coordinate_system}()} 36 | } 37 | \concept{functions for checking coordinate systems} 38 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(get_data,ggplot) 4 | S3method(get_data,layer_to_check) 5 | S3method(get_mappings,ggplot) 6 | S3method(get_mappings,layer_to_check) 7 | S3method(gradethis_equal,ggplot) 8 | export(.result) 9 | export(default_label) 10 | export(default_param) 11 | export(fail_if_not_ggplot) 12 | export(get_coordinate_system) 13 | export(get_data) 14 | export(get_default_labels) 15 | export(get_default_params) 16 | export(get_geom_layer) 17 | export(get_geoms) 18 | export(get_geoms_stats) 19 | export(get_labels) 20 | export(get_mappings) 21 | export(get_stat_layer) 22 | export(get_stats) 23 | export(identical_aes) 24 | export(is_ggplot) 25 | export(ith_data) 26 | export(ith_data_is) 27 | export(ith_geom) 28 | export(ith_geom_is) 29 | export(ith_geom_stat) 30 | export(ith_mappings) 31 | export(ith_mappings_use) 32 | export(ith_stat) 33 | export(ith_stat_is) 34 | export(n_layers) 35 | export(stop_if_not_ggplot) 36 | export(uses_aesthetics) 37 | export(uses_coordinate_system) 38 | export(uses_data) 39 | export(uses_extra_mappings) 40 | export(uses_geom_param) 41 | export(uses_geom_params) 42 | export(uses_geoms) 43 | export(uses_labels) 44 | export(uses_mappings) 45 | export(uses_stat_param) 46 | export(uses_stats) 47 | importFrom(gradethis,.result) 48 | importFrom(gradethis,fail) 49 | importFrom(gradethis,gradethis_equal) 50 | -------------------------------------------------------------------------------- /man/default_label.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/default_placeholders.R 3 | \name{default_label} 4 | \alias{default_label} 5 | \alias{default_param} 6 | \title{Placeholders for default values} 7 | \usage{ 8 | default_label() 9 | 10 | default_param() 11 | } 12 | \value{ 13 | A placeholder value to be used within \code{\link[=uses_labels]{uses_labels()}} 14 | or \code{\link[=uses_geom_params]{uses_geom_params()}}. 15 | } 16 | \description{ 17 | These functions generate placeholder values. 18 | \itemize{ 19 | \item \code{default_label()} can be used as a named argument in \code{\link[=uses_labels]{uses_labels()}} 20 | to check that a label matches the result of \code{\link[=get_default_labels]{get_default_labels()}} 21 | with that name. 22 | \item \code{default_param()} can be used as a named argument in \code{\link[=uses_geom_params]{uses_geom_params()}} 23 | to check that a parameter matched the result of \code{\link[=get_default_params]{get_default_params()}} 24 | with that name. 25 | } 26 | } 27 | \examples{ 28 | require(ggplot2) 29 | 30 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy, color = trans)) + 31 | geom_smooth(se = FALSE) + 32 | labs(title = "My plot", x = "Weight", y = "MPG") 33 | 34 | uses_labels(p, x = default_label(), color = default_label()) 35 | 36 | uses_geom_params(p, "smooth", size = default_param(), se = default_param()) 37 | } 38 | -------------------------------------------------------------------------------- /man/identical_aes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mappings.R 3 | \name{identical_aes} 4 | \alias{identical_aes} 5 | \title{Are aesthetic mapping specifications "identical"?} 6 | \usage{ 7 | identical_aes(a1, a2) 8 | } 9 | \arguments{ 10 | \item{a1}{The output of \code{\link[ggplot2]{aes}}, perhaps extracted from a ggplot object.} 11 | 12 | \item{a2}{The output of \code{\link[ggplot2]{aes}}, perhaps extracted from a ggplot object.} 13 | } 14 | \value{ 15 | \code{TRUE} or \code{FALSE} 16 | } 17 | \description{ 18 | The ggplot2 package uses quosures to record aesthetic mappings. These record 19 | both the mapping described as well as the environment in which the mapping 20 | was described. As a result, it is difficult to compare mappings created by 21 | students in one environment to mappings created on the fly by graders in 22 | another environment. \code{identical_aes} facilitates comparison by ignoring 23 | the environments associated with an aesthetic mapping specification. If the 24 | two specifications contain identical expressions, e.g. \code{x = displ}, 25 | etc., \code{identical_aes} returns \code{TRUE}. 26 | } 27 | \seealso{ 28 | Other functions for checking mappings: 29 | \code{\link{get_mappings}()}, 30 | \code{\link{ith_mappings_use}()}, 31 | \code{\link{ith_mappings}()}, 32 | \code{\link{uses_mappings}()} 33 | } 34 | \concept{functions for checking mappings} 35 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | release: 9 | types: [published] 10 | workflow_dispatch: 11 | 12 | name: pkgdown 13 | 14 | jobs: 15 | pkgdown: 16 | runs-on: ubuntu-latest 17 | # Only restrict concurrency for non-PR jobs 18 | concurrency: 19 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 20 | env: 21 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 22 | steps: 23 | - uses: actions/checkout@v2 24 | 25 | - uses: r-lib/actions/setup-pandoc@v2 26 | 27 | - uses: r-lib/actions/setup-r@v2 28 | with: 29 | use-public-rspm: true 30 | 31 | - uses: r-lib/actions/setup-r-dependencies@v2 32 | with: 33 | extra-packages: any::pkgdown, local::. 34 | needs: website 35 | 36 | - name: Build site 37 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 38 | shell: Rscript {0} 39 | 40 | - name: Deploy to GitHub pages 🚀 41 | if: github.event_name != 'pull_request' 42 | uses: JamesIves/github-pages-deploy-action@4.1.4 43 | with: 44 | clean: false 45 | branch: gh-pages 46 | folder: docs 47 | -------------------------------------------------------------------------------- /man/get_stat_layer.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/layers.R 3 | \name{get_stat_layer} 4 | \alias{get_stat_layer} 5 | \title{Isolate a stat layer from a plot} 6 | \usage{ 7 | get_stat_layer(p, stat = NULL, i = NULL) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object} 11 | 12 | \item{stat}{A character string found in the suffix of a ggplot2 stat function, 13 | e.g. \code{"bin"}.} 14 | 15 | \item{i}{A numerical index, e.g. \code{1}.} 16 | } 17 | \value{ 18 | An object with class \code{layer_to_check} to be manipulated further 19 | with ggcheck functions. 20 | } 21 | \description{ 22 | \code{get_stat_layer} returns a stat layer from a plot along with the global data sets 23 | and aesthetic mappings that the layer may inherit from. 24 | } 25 | \details{ 26 | Users can specify a layer in one of 3 ways: 27 | 28 | \enumerate{ 29 | \item By order of appearance with \code{i}. The first layer to appear in the 30 | plot (the one drawn first, on the bottom) corresponds to \code{i = 1}. 31 | \item By type of stat with \code{stat}. \code{get_stat_layer} will return the 32 | first layer that uses the stat 33 | \item By a combination of \code{stat} and 34 | \code{i}. \code{get_stat_layer} will return the ith layer that uses the stat 35 | } 36 | } 37 | \examples{ 38 | require(ggplot2) 39 | p <- ggplot(data = diamonds, aes(price)) + 40 | stat_bin(bins = 20, binwidth = 500) 41 | 42 | get_stat_layer(p, i = 1) 43 | get_stat_layer(p, stat = "bin") 44 | } 45 | -------------------------------------------------------------------------------- /man/uses_aesthetics.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mappings.R 3 | \name{uses_aesthetics} 4 | \alias{uses_aesthetics} 5 | \title{Does a plot use one or more aesthetics?} 6 | \usage{ 7 | uses_aesthetics(p, aesthetics, local_only = FALSE, exact = FALSE) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object or a layer extracted from a ggplot object with 11 | \code{\link{get_geom_layer}} or \code{\link{get_stat_layer}}..} 12 | 13 | \item{aesthetics}{character vector of variables to check for, e.g. "x" or c("x")} 14 | 15 | \item{local_only}{\code{TRUE} or \code{FALSE}. Should \code{uses_aesthetics} only 16 | return mappings defined locally in the layer?} 17 | 18 | \item{exact}{If \code{TRUE}, variables need to be mapped exactly} 19 | } 20 | \value{ 21 | A logical value. 22 | } 23 | \description{ 24 | \code{uses_aesthetics} checks whether the student used one or more aesthetics. 25 | } 26 | \details{ 27 | By default, \code{uses_aesthetics} requires that only one of the 28 | aesthetics need to be used. Set \code{exact} to \code{TRUE} to check if all of 29 | the variables have to be matched exactly. 30 | } 31 | \examples{ 32 | require(ggplot2) 33 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 34 | geom_point(mapping = aes(color = class)) 35 | uses_aesthetics(p, "x") 36 | uses_aesthetics(p, c("x", "y")) 37 | uses_aesthetics(get_geom_layer(p, "point"), c("x", "y", "color"), local_only = TRUE) 38 | uses_aesthetics(get_geom_layer(p, "point"), c("x", "y"), local_only = FALSE) 39 | } 40 | -------------------------------------------------------------------------------- /man/uses_extra_mappings.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mappings.R 3 | \name{uses_extra_mappings} 4 | \alias{uses_extra_mappings} 5 | \title{Does the plot uses extra aesthetic mappings?} 6 | \usage{ 7 | uses_extra_mappings(p, mappings, local_only = FALSE) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object or a layer extracted from a ggplot object with 11 | \code{\link{get_geom_layer}} or \code{\link{get_stat_layer}}.} 12 | 13 | \item{mappings}{One or more aesthetic mappings created with 14 | \code{\link[ggplot2]{aes}}.} 15 | 16 | \item{local_only}{If \code{TRUE}, \code{uses_extra_mappings} will check only the 17 | mappings defined locally in a layer for the presence of \code{mappings}. If 18 | \code{FALSE}, \code{uses_extra_mappings} will check for \code{mappings} in the 19 | combination of global and local methods that will be used to plot a layer.} 20 | } 21 | \value{ 22 | A logical value. 23 | } 24 | \description{ 25 | \code{uses_extra_mappings} checks if a student's plot contains more than the 26 | required aesthetic mappings. Note that we still return \code{TRUE} if 27 | the student's plot differs from the required aesthetic mappings because they 28 | are technically extra mappings from required set. We recommend you use 29 | \code{uses_mapping} checks for checking required mappings before \code{uses_extra_mappings}. 30 | } 31 | \examples{ 32 | require(ggplot2) 33 | p <- ggplot(data = diamonds, aes(x = cut, sample = price)) + 34 | geom_qq() 35 | uses_extra_mappings(p, aes(sample = price)) 36 | } 37 | -------------------------------------------------------------------------------- /man/get_labels.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/labels.R 3 | \name{get_labels} 4 | \alias{get_labels} 5 | \title{List the labels used by a plot} 6 | \usage{ 7 | get_labels(p, aes = NULL) 8 | } 9 | \arguments{ 10 | \item{p}{A \link[ggplot2:ggplot]{ggplot} object} 11 | 12 | \item{aes}{If \code{aes} is a \link{character} vector, returns only the labels 13 | corresponding to the included aesthetics. 14 | Defaults to \code{\link{NULL}}, which returns all labels.} 15 | } 16 | \value{ 17 | A named list of character strings. 18 | } 19 | \description{ 20 | \code{get_labels()} returns a named \link{list} of \link[ggplot2:labs]{labels}, 21 | written as \link{character} strings, indicating which labels are used by a plot. 22 | } 23 | \details{ 24 | Note that \code{get_labels()} will return \code{\link{NULL}} if a label is explicitly set to 25 | \code{\link{NULL}} \emph{\strong{or}} if a requested aesthetic is not present in the plot. 26 | } 27 | \examples{ 28 | require(ggplot2) 29 | 30 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 31 | geom_point(mapping = aes(color = class)) + 32 | geom_smooth() + 33 | labs(x = "Weight", y = "MPG", color = NULL) 34 | 35 | get_labels(p) 36 | get_labels(p, c("x", "y")) 37 | 38 | # The colo(u)r aesthetic can be matched with or without a u 39 | get_labels(p, "color") 40 | get_labels(p, "colour") 41 | } 42 | \seealso{ 43 | Other functions for checking labels: 44 | \code{\link{get_default_labels}()}, 45 | \code{\link{uses_labels}()} 46 | } 47 | \concept{functions for checking labels} 48 | -------------------------------------------------------------------------------- /man/get_geom_layer.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/layers.R 3 | \name{get_geom_layer} 4 | \alias{get_geom_layer} 5 | \title{Isolate a geom layer from a plot} 6 | \usage{ 7 | get_geom_layer(p, geom = NULL, i = NULL) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object} 11 | 12 | \item{geom}{A character string found in the suffix of a ggplot2 geom function, 13 | e.g. \code{"point"}.} 14 | 15 | \item{i}{A numerical index, e.g. \code{1}.} 16 | } 17 | \value{ 18 | An object with class \code{layer_to_check} to be manipulated further 19 | with ggcheck functions. 20 | } 21 | \description{ 22 | \code{get_geom_layer} returns a geom layer from a plot along with the global data sets 23 | and aesthetic mappings that the layer may inherit from. 24 | } 25 | \details{ 26 | Users can specify a layer in one of 3 ways: 27 | 28 | \enumerate{ 29 | \item By order of appearance with \code{i}. The first layer to appear in the 30 | plot (the one drawn first, on the bottom) corresponds to \code{i = 1}. 31 | \item By type of geom with \code{geom}. \code{get_geom_layer} will return the 32 | first layer that uses the geom. 33 | \item By a combination of \code{geom} and 34 | \code{i}. \code{get_geom_layer} will return the ith layer that uses the geom. 35 | } 36 | } 37 | \examples{ 38 | require(ggplot2) 39 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 40 | geom_point(color = "red") + 41 | geom_point(mapping = aes(color = class)) + 42 | geom_smooth(se = FALSE) 43 | 44 | get_geom_layer(p, i = 1) 45 | get_geom_layer(p, geom = "smooth") 46 | get_geom_layer(p, geom = "point", i = 2) 47 | } 48 | -------------------------------------------------------------------------------- /man/fragments/readme-usage.Rmd: -------------------------------------------------------------------------------- 1 | The primary goal of ggcheck is to help tutorial authors inspect and test properties of [ggplot2] plots. 2 | The examples below demonstrate how ggcheck can be used in general; 3 | for more information about using gradethis in learnr tutorials, 4 | please see the [gradethis package documentation](https://pkgs.rstudio.com/gradethis/). 5 | 6 | Suppose an exercise asks students to create the following plot 7 | of engine displacement vs highway miles per gallon ratings. 8 | 9 | ```{r expected-plot} 10 | library(ggplot2) 11 | 12 | p <- 13 | ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 14 | geom_point(mapping = aes(color = class)) + 15 | geom_smooth(se = FALSE, method = "lm") 16 | 17 | p 18 | ``` 19 | 20 | We can use ggcheck to test that students used `geom_point()` 21 | 22 | ```{r test-geom-point} 23 | library(ggcheck) 24 | 25 | uses_geoms(p, "point", exact = FALSE) 26 | ``` 27 | 28 | or that both `geom_point()` and `geom_smooth()` were used 29 | 30 | ```{r test-geom-both} 31 | uses_geoms(p, c("point", "smooth"), exact = FALSE) 32 | ``` 33 | 34 | or that exactly both `geom_point()` and `geom_smooth()` were used and in that order. 35 | 36 | ```{r test-geom-both-exact} 37 | uses_geoms(p, c("point", "smooth"), exact = TRUE) 38 | ``` 39 | 40 | Similarly, we can test that a linear model was used for the smoothing method 41 | and the confidence interval was not displayed: 42 | 43 | ```{r test-geom-params} 44 | uses_geom_param(p, "smooth", list(se = FALSE, method = "lm")) 45 | ``` 46 | 47 | There's a lot more that ggcheck can do. 48 | Read more in the [full function listing](https://rstudio.github.io/ggcheck/). 49 | -------------------------------------------------------------------------------- /man/ggcheck-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggcheck-package.R 3 | \docType{package} 4 | \name{ggcheck-package} 5 | \alias{ggcheck} 6 | \alias{ggcheck-package} 7 | \title{ggcheck: Inspect 'ggplot2' Plots for Automated Grading in Learning Exercises} 8 | \description{ 9 | \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} 10 | 11 | 'ggcheck' provides functions that inspect 'ggplot2' objects to make it easier for teachers to check that student plots meet expectations. Designed primarily for automated grading via 'gradethis' in interactive 'learnr' tutorials. 12 | } 13 | \seealso{ 14 | Useful links: 15 | \itemize{ 16 | \item \url{https://github.com/rstudio/ggcheck} 17 | \item Report bugs at \url{https://github.com/rstudio/ggcheck/issues} 18 | } 19 | 20 | } 21 | \author{ 22 | \strong{Maintainer}: Garrick Aden-Buie \email{garrick@rstudio.com} (\href{https://orcid.org/0000-0002-7111-0077}{ORCID}) 23 | 24 | Authors: 25 | \itemize{ 26 | \item Garrett Grolemund \email{garrett@rstudio.com} (\href{https://orcid.org/0000-0002-7765-6011}{ORCID}) [conceptor] 27 | \item Nischal Shrestha \email{nsrocker92@gmail.com} (\href{https://orcid.org/0000-0003-3321-1712}{ORCID}) 28 | } 29 | 30 | Other contributors: 31 | \itemize{ 32 | \item Alexander Rossell Hayes \email{alex.rossellhayes@rstudio.com} (\href{https://orcid.org/0000-0001-9412-0457}{ORCID}) [contributor] 33 | \item Sara Altman \email{sara.altman@rstudio.com} (\href{https://orcid.org/0000-0002-2529-5680}{ORCID}) [contributor] 34 | \item RStudio, PBC [copyright holder, funder] 35 | } 36 | 37 | } 38 | \keyword{internal} 39 | -------------------------------------------------------------------------------- /man/uses_stats.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stats.R 3 | \name{uses_stats} 4 | \alias{uses_stats} 5 | \title{Does a plot use one or more stats?} 6 | \usage{ 7 | uses_stats(p, stats, geoms = NULL, exact = TRUE) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object} 11 | 12 | \item{stats}{A vector of character strings. Each element should correspond to 13 | the suffix of a ggplot2 \code{stat_} function, e.g. \code{c("identity", "smooth")}.} 14 | 15 | \item{geoms}{A character vector to optionally check for the geoms corresponding to stats 16 | e.g. c("point", "smooth") if checking c("identity", "smooth")} 17 | 18 | \item{exact}{if \code{TRUE}, use exact matching} 19 | } 20 | \value{ 21 | \code{TRUE} or \code{FALSE} 22 | } 23 | \description{ 24 | \code{uses_stats} tests whether a plot uses one or more stats in its layers. 25 | } 26 | \details{ 27 | By default, the plot must have the exact stats or geom/stat combinations and in the same order. 28 | However, if \code{exact} is set to \code{FALSE}, the plot stats or geom/stat combinations do not have to be exact. 29 | } 30 | \examples{ 31 | require(ggplot2) 32 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 33 | geom_point(mapping = aes(color = class)) + 34 | geom_smooth() 35 | uses_stats(p, stats = "smooth") 36 | uses_stats(p, stats = c("identity", "smooth"), exact = TRUE) 37 | uses_stats(p, c("smooth", "identity"), geoms = c("smooth", "point")) 38 | } 39 | \seealso{ 40 | Other functions for checking stats: 41 | \code{\link{get_stats}()}, 42 | \code{\link{ith_stat_is}()}, 43 | \code{\link{ith_stat}()} 44 | } 45 | \concept{functions for checking stats} 46 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: ggcheck 2 | Title: Inspect 'ggplot2' Plots for Automated Grading in Learning Exercises 3 | Version: 0.0.5 4 | Authors@R: c( 5 | person("Garrick", "Aden-Buie", , "garrick@rstudio.com", role = c("aut", "cre"), 6 | comment = c(ORCID = "0000-0002-7111-0077")), 7 | person("Garrett", "Grolemund", , "garrett@rstudio.com", role = c("ccp", "aut"), 8 | comment = c(ORCID = "0000-0002-7765-6011")), 9 | person("Nischal", "Shrestha", , "nsrocker92@gmail.com", role = "aut", 10 | comment = c(ORCID = "0000-0003-3321-1712")), 11 | person("Alexander", "Rossell Hayes", , "alex.rossellhayes@rstudio.com", role = "ctb", 12 | comment = c(ORCID = "0000-0001-9412-0457")), 13 | person("Sara", "Altman", , "sara.altman@rstudio.com", role = "ctb", 14 | comment = c(ORCID = "0000-0002-2529-5680")), 15 | person("RStudio, PBC", role = c("cph", "fnd")) 16 | ) 17 | Description: 'ggcheck' provides functions that inspect 'ggplot2' objects 18 | to make it easier for teachers to check that student plots meet 19 | expectations. Designed primarily for automated grading via 'gradethis' 20 | in interactive 'learnr' tutorials. 21 | License: MIT + file LICENSE 22 | URL: https://github.com/rstudio/ggcheck 23 | BugReports: https://github.com/rstudio/ggcheck/issues 24 | Imports: 25 | ggplot2, 26 | gradethis (>= 0.2.12.9004), 27 | purrr, 28 | rlang, 29 | utils 30 | Suggests: 31 | testthat 32 | Remotes: 33 | rstudio/gradethis 34 | Config/Needs/learnr: rstudio/learnr, rstudio/gradethis 35 | Config/Needs/website: pkgdown, tidyverse/tidytemplate 36 | Config/testthat/edition: 3 37 | Encoding: UTF-8 38 | Roxygen: list(markdown = TRUE) 39 | RoxygenNote: 7.2.3 40 | -------------------------------------------------------------------------------- /man/ith_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \name{ith_data} 4 | \alias{ith_data} 5 | \title{Which data set does the ith layer use?} 6 | \usage{ 7 | ith_data(p, i, local_only = FALSE) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object or a layer extracted from a ggplot object with 11 | \code{\link{get_geom_layer}}.} 12 | 13 | \item{i}{A numerical index that corresponds to the first layer of a plot (1), 14 | the second layer (2), and so on.} 15 | 16 | \item{local_only}{\code{TRUE} or \code{FALSE}. See the details.} 17 | } 18 | \value{ 19 | A data frame. If no data set is found, \code{ith_data} returns \code{NULL}. 20 | } 21 | \description{ 22 | \code{ith_data} returns the data set used by the ith layer. 23 | } 24 | \details{ 25 | If \code{local_only = TRUE}, \code{ith_data} returns the data set, 26 | if any, that was defined locally in the function that created the ith layer. 27 | If \code{local_only = FALSE}, \code{ith_data} returns the data used by 28 | the ith layer, whether or not that data was defined globally in 29 | \code{\link[ggplot2]{ggplot}} or locally. 30 | 31 | Functions that use the \code{ith_} prefix are designed to eliminate the need 32 | to call \code{get_geom_layer} to check a specific layer in a plot, e.g. \code{p 33 | \%>\% get_geom_layer(geom = "point") \%>\% get_data()}. 34 | } 35 | \examples{ 36 | require(ggplot2) 37 | d2 <- head(mpg) 38 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 39 | geom_point(data = d2, color = "red") + 40 | geom_point() 41 | ith_data(p, i = 1) 42 | } 43 | \seealso{ 44 | Other functions for checking data: 45 | \code{\link{get_data}()}, 46 | \code{\link{ith_data_is}()}, 47 | \code{\link{uses_data}()} 48 | } 49 | \concept{functions for checking data} 50 | -------------------------------------------------------------------------------- /man/uses_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \name{uses_data} 4 | \alias{uses_data} 5 | \title{Does a plot or layer use the correct data set?} 6 | \usage{ 7 | uses_data(p, data, local_only = FALSE) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object or a layer extracted from a ggplot object with 11 | \code{\link{get_geom_layer}}.} 12 | 13 | \item{data}{A data frame} 14 | 15 | \item{local_only}{\code{TRUE} or \code{FALSE}. See the details.} 16 | } 17 | \value{ 18 | A data frame. 19 | } 20 | \description{ 21 | \code{uses_data} checks whether the data set used by a plot or layer matches 22 | the data set provided. 23 | } 24 | \details{ 25 | When passed a ggplot object (i.e. a plot), \code{uses_data} will check only 26 | the data that has been set globally with \code{\link[ggplot2]{ggplot}}. 27 | 28 | When passed a single layer from a plot, the behavior of \code{uses_data} will 29 | depend on the \code{local_only} argument passed to \code{...}. If 30 | \code{local_only = TRUE}, \code{uses_data} will check only the data set, if 31 | any, that was defined locally in the function that created the layer. If 32 | \code{local_only = FALSE}, \code{uses_data} will check the data used by the 33 | layer, whether or not that data was defined globally in 34 | \code{\link[ggplot2]{ggplot}} or locally. 35 | } 36 | \examples{ 37 | require(ggplot2) 38 | d2 <- head(mpg) 39 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 40 | geom_point(data = d2, color = "red") + 41 | geom_point() 42 | uses_data(p, mpg) 43 | uses_data(get_geom_layer(p, i = 1), data = head(mpg)) 44 | } 45 | \seealso{ 46 | Other functions for checking data: 47 | \code{\link{get_data}()}, 48 | \code{\link{ith_data_is}()}, 49 | \code{\link{ith_data}()} 50 | } 51 | \concept{functions for checking data} 52 | -------------------------------------------------------------------------------- /tests/testthat/test-is_ggplot.R: -------------------------------------------------------------------------------- 1 | require(ggplot2) 2 | 3 | p_valid <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 4 | geom_point() 5 | 6 | p_invalid <- geom_point() 7 | 8 | p_basic <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) 9 | 10 | p_minimal <- ggplot() 11 | 12 | test_that("is_ggplot", { 13 | expect_true(is_ggplot(p_valid)) 14 | expect_true(is_ggplot(p_basic)) 15 | expect_true(is_ggplot(p_minimal)) 16 | 17 | expect_false(is_ggplot(p_invalid)) 18 | }) 19 | 20 | test_that("stop_if_not_ggplot", { 21 | expect_invisible(expect_null(stop_if_not_ggplot(p_valid))) 22 | expect_invisible(expect_null(stop_if_not_ggplot(p_basic))) 23 | expect_invisible(expect_null(stop_if_not_ggplot(p_minimal))) 24 | 25 | expect_error(stop_if_not_ggplot(p_invalid)) 26 | }) 27 | 28 | test_that("fail_if_not_ggplot", { 29 | expect_invisible(expect_null(fail_if_not_ggplot(p_valid))) 30 | expect_invisible(expect_null(fail_if_not_ggplot(p_basic))) 31 | expect_invisible(expect_null(fail_if_not_ggplot(p_minimal))) 32 | 33 | expect_s3_class(fail_if_not_ggplot(p_invalid), "gradethis_graded") 34 | expect_false(fail_if_not_ggplot(p_invalid)$correct) 35 | }) 36 | 37 | test_that("fail_if_not_ggplot() within mock_this_exercise()", { 38 | # Should fail 39 | expect_snapshot( 40 | gradethis::grade_this({ 41 | fail_if_not_ggplot() 42 | })(gradethis::mock_this_exercise(.user_code = "2")) 43 | ) 44 | 45 | # Should fail 46 | expect_snapshot( 47 | gradethis::grade_this({ 48 | fail_if_not_ggplot() 49 | })(gradethis::mock_this_exercise(.user_code = "ggplot2::geom_point()")) 50 | ) 51 | 52 | # Should not fail 53 | expect_null( 54 | gradethis::grade_this({ 55 | fail_if_not_ggplot() 56 | })(gradethis::mock_this_exercise(.user_code = "ggplot2::ggplot()")) 57 | ) 58 | }) 59 | -------------------------------------------------------------------------------- /R/coordinates.R: -------------------------------------------------------------------------------- 1 | #' Which coordinate system does a plot use? 2 | #' 3 | #' @param p A ggplot2 object 4 | #' 5 | #' @return A character string that corresponds to the suffix of a ggplot2 6 | #' \code{coord_} function, e.g. \code{"cartesian"}. 7 | #' @family functions for checking coordinate systems 8 | #' @export 9 | #' 10 | #' @examples 11 | #' require(ggplot2) 12 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 13 | #' geom_point(mapping = aes(color = class)) + 14 | #' geom_smooth() + 15 | #' coord_polar() 16 | #' get_coordinate_system(p) 17 | get_coordinate_system <- function(p) { 18 | stop_if_not_ggplot(p) 19 | coords <- class(p$coordinates)[1] 20 | gsub("coord", "", tolower(coords)) 21 | } 22 | 23 | #' Does a plot use the correct coordinate system? 24 | #' 25 | #' \code{uses_coordinate_system} checks whether a plot uses the coordinate 26 | #' system you describe. To describe a coordinate system, use the character 27 | #' string that matches the suffix of the ggplot2 \code{coord_} function that 28 | #' would make the coordinate system. The default coordinate system for ggplot2 29 | #' plots is \code{"cartesian"}. 30 | #' 31 | #' @param p A ggplot2 object 32 | #' @param coordinates A character string that corresponds to the suffix of a 33 | #' ggplot2 \code{coord_} function, e.g. \code{"cartesian"}. 34 | #' 35 | #' @return \code{TRUE} or \code{FALSE} 36 | #' @family functions for checking coordinate systems 37 | #' @export 38 | #' 39 | #' @examples 40 | #' require(ggplot2) 41 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 42 | #' geom_point(mapping = aes(color = class)) + 43 | #' geom_smooth() + 44 | #' coord_polar() 45 | #' uses_coordinate_system(p, coordinates = "polar") 46 | uses_coordinate_system <- function(p, coordinates) { 47 | stop_if_not_ggplot(p) 48 | coordinates == get_coordinate_system(p) 49 | } 50 | -------------------------------------------------------------------------------- /man/ith_data_is.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \name{ith_data_is} 4 | \alias{ith_data_is} 5 | \title{Does the ith layer use the correct data set?} 6 | \usage{ 7 | ith_data_is(p, data, i, local_only = FALSE) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object or a layer extracted from a ggplot object with 11 | \code{\link{get_geom_layer}}.} 12 | 13 | \item{data}{A data frame} 14 | 15 | \item{i}{A numerical index that corresponds to the first layer of a plot (1), 16 | the second layer (2), and so on.} 17 | 18 | \item{local_only}{\code{TRUE} or \code{FALSE}. See the details.} 19 | } 20 | \value{ 21 | \code{TRUE} or \code{FALSE} 22 | } 23 | \description{ 24 | \code{ith_data_is} checks whether the student uses the supplied data set for 25 | the ith layer of their plot. 26 | } 27 | \details{ 28 | Functions that use the \code{ith_} prefix are designed to eliminate the need 29 | to call \code{get_geom_layer} to check a specific layer in a plot, e.g. \code{p 30 | \%>\% get_geom_layer(geom = "point") \%>\% uses_data(mpg)}. 31 | 32 | If \code{local_only = TRUE}, \code{ith_data_is} will check only the data set, 33 | if any, that was defined locally in the function that created the ith layer. 34 | If \code{local_only = FALSE}, \code{ith_data_is} will check the data used by 35 | the ith layer, whether or not that data was defined globally in 36 | \code{\link[ggplot2]{ggplot}} or locally. 37 | } 38 | \examples{ 39 | require(ggplot2) 40 | d2 <- head(mpg) 41 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 42 | geom_point(data = d2, color = "red") + 43 | geom_point() 44 | ith_data_is(p, data = head(mpg), i = 1) 45 | } 46 | \seealso{ 47 | Other functions for checking data: 48 | \code{\link{get_data}()}, 49 | \code{\link{ith_data}()}, 50 | \code{\link{uses_data}()} 51 | } 52 | \concept{functions for checking data} 53 | -------------------------------------------------------------------------------- /man/get_default_params.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom_params.R 3 | \name{get_default_params} 4 | \alias{get_default_params} 5 | \title{What are the default parameters for a plot layer?} 6 | \usage{ 7 | get_default_params(p, geom, params = NULL, i = NULL) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object} 11 | 12 | \item{geom}{A character string found in the suffix of a ggplot2 geom function, 13 | e.g. \code{"point"}.} 14 | 15 | \item{params}{A \link{character} vector. 16 | \code{get_default_params()} returns the default parameter value with a name 17 | matching each string in \code{params}. 18 | If \code{params} is \code{\link{NULL}} (the default), the default values for 19 | all parameters are returned.} 20 | 21 | \item{i}{A numerical index, e.g. \code{1}.} 22 | } 23 | \value{ 24 | A named \link{list} of the same length as \code{params}, or, if \code{params} is 25 | \code{\link{NULL}}, a named list of default values for all parameters of \code{geom}. 26 | } 27 | \description{ 28 | What are the default parameters for a plot layer? 29 | } 30 | \examples{ 31 | require(ggplot2) 32 | 33 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 34 | geom_smooth(aes(color = class)) 35 | 36 | # Returns the parameters the ggplot would use by default for a layer 37 | get_default_params(p, "smooth", "linetype") 38 | get_default_params(p, "smooth", c("se", "level")) 39 | get_default_params(p, "smooth") 40 | 41 | # If a parameter does not exist, returns NULL 42 | get_default_params(p, "smooth", "shape") 43 | 44 | # The colo(u)r aesthetic can be matched with or without a u 45 | get_default_params(p, "smooth", "color") 46 | get_default_params(p, "smooth", "colour") 47 | } 48 | \seealso{ 49 | Other functions for checking geom parameters: 50 | \code{\link{uses_geom_params}()} 51 | } 52 | \concept{functions for checking geom parameters} 53 | -------------------------------------------------------------------------------- /man/uses_geoms.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geoms.R 3 | \name{uses_geoms} 4 | \alias{uses_geoms} 5 | \title{Does a plot use one or more geoms?} 6 | \usage{ 7 | uses_geoms(p, geoms, stats = NULL, exact = TRUE) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object} 11 | 12 | \item{geoms}{A vector of character strings. Each element should correspond to 13 | the suffix of a ggplot2 \code{geom_} function, e.g. \code{c("point", 14 | "line", "smooth")}.} 15 | 16 | \item{stats}{A character vector to optionally check for the stats corresponding to geoms 17 | e.g. c("identity", "smooth") if checking c("point", "smooth")} 18 | 19 | \item{exact}{A boolean to indicate whether to use exact matching} 20 | } 21 | \value{ 22 | \code{TRUE} or \code{FALSE} 23 | } 24 | \description{ 25 | \code{use_geoms} tests whether a plot uses one or more geoms created using a \code{geom}. 26 | If checking for a layer that is created using a \code{stat} function, please use 27 | \code{uses_stats} instead. 28 | } 29 | \details{ 30 | By default, the plot must have the exact geoms or geom/stat combinations and in the same order. 31 | However, if \code{exact} is set to \code{FALSE}, the plot geoms or geom/stat combinations do not have to be exact. 32 | } 33 | \examples{ 34 | require(ggplot2) 35 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 36 | geom_point(mapping = aes(color = class)) + 37 | geom_smooth() 38 | uses_geoms(p, geoms = "point") 39 | uses_geoms(p, geoms = c("point", "smooth"), exact = TRUE) 40 | uses_geoms(p, geoms = c("point", "smooth"), stats = c("identity", "smooth")) 41 | } 42 | \seealso{ 43 | Other functions for checking geoms: 44 | \code{\link{get_geoms_stats}()}, 45 | \code{\link{get_geoms}()}, 46 | \code{\link{ith_geom_is}()}, 47 | \code{\link{ith_geom_stat}()}, 48 | \code{\link{ith_geom}()} 49 | } 50 | \concept{functions for checking geoms} 51 | -------------------------------------------------------------------------------- /man/get_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \name{get_data} 4 | \alias{get_data} 5 | \title{Get the data set used by a plot or layer} 6 | \usage{ 7 | get_data(p, local_only = FALSE) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object or a layer extracted from a ggplot object with 11 | \code{\link{get_geom_layer}}.} 12 | 13 | \item{local_only}{\code{TRUE} or \code{FALSE}. Should \code{get_data} onbly 14 | return data defined locally in the layer?} 15 | } 16 | \value{ 17 | A data frame. If no data set is found, \code{get_data} returns 18 | \code{NULL} 19 | } 20 | \description{ 21 | \code{get_data} returns the data set used by a ggplot object or a single 22 | layer extracted from the object with \code{\link{get_geom_layer}}. 23 | } 24 | \details{ 25 | When passed a ggplot object (i.e. a plot), \code{get_data} will return only 26 | the data that has been set globally with \code{\link[ggplot2]{ggplot}}. 27 | 28 | When passed a single layer from a plot, the behavior of \code{get_data} will 29 | depend on the \code{local_only} argument passed to \code{...}. If 30 | \code{local_only = TRUE}, \code{get_data} will return only the data set, if 31 | any, that was defined locally in the function that created the layer. If 32 | \code{local_only = FALSE}, \code{get_data} will return the data used by the 33 | layer, whether or not that data was defined globally in 34 | \code{\link[ggplot2]{ggplot}} or locally. 35 | } 36 | \examples{ 37 | require(ggplot2) 38 | d2 <- head(mpg) 39 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 40 | geom_point(data = d2, color = "red") + 41 | geom_point() 42 | get_data(p) 43 | get_data(get_geom_layer(p, i = 1)) 44 | } 45 | \seealso{ 46 | Other functions for checking data: 47 | \code{\link{ith_data_is}()}, 48 | \code{\link{ith_data}()}, 49 | \code{\link{uses_data}()} 50 | } 51 | \concept{functions for checking data} 52 | -------------------------------------------------------------------------------- /man/get_default_labels.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/labels.R 3 | \name{get_default_labels} 4 | \alias{get_default_labels} 5 | \title{What is the default label for a plot aesthetic?} 6 | \usage{ 7 | get_default_labels(p, aes = NULL) 8 | } 9 | \arguments{ 10 | \item{p}{A \link[ggplot2:ggplot]{ggplot} object} 11 | 12 | \item{aes}{If \code{aes} is a \link{character} vector, returns only the default labels 13 | (based on the plot \code{p}) that correspond to the included aesthetics. 14 | Defaults to \code{\link{NULL}}, which returns the default values of all labels.} 15 | } 16 | \value{ 17 | A named \link{list} in which each element is a \link{character} string 18 | or \code{\link{NULL}}. 19 | Strings are returned for aesthetics with a default value. 20 | \code{\link{NULL}} is returned for aesthetics that do not exist in the plot, 21 | or non-aesthetic labels that do not have a default value, like \code{title}. 22 | } 23 | \description{ 24 | What is the default label for a plot aesthetic? 25 | } 26 | \examples{ 27 | require(ggplot2) 28 | 29 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 30 | geom_point(mapping = aes(color = class, shape = drv)) + 31 | geom_smooth() + 32 | labs(title = "My plot", x = "Weight", y = "MPG", color = NULL) 33 | 34 | # Returns the label the ggplot would create by default for an aesthetic 35 | get_default_labels(p, "x") 36 | get_default_labels(p, c("x", "y")) 37 | get_default_labels(p) 38 | 39 | # If an aesthetic does not exist, returns NULL 40 | get_default_labels(p, "size") 41 | 42 | # Non-aesthetic labels have no default value, so they also return NULL 43 | get_default_labels(p, "title") 44 | get_default_labels(p, "comment") 45 | 46 | # The colo(u)r aesthetic can be matched with or without a u 47 | get_default_labels(p, "color") 48 | get_default_labels(p, "colour") 49 | } 50 | \seealso{ 51 | Other functions for checking labels: 52 | \code{\link{get_labels}()}, 53 | \code{\link{uses_labels}()} 54 | } 55 | \concept{functions for checking labels} 56 | -------------------------------------------------------------------------------- /man/is_ggplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/is_ggplot.R 3 | \name{is_ggplot} 4 | \alias{is_ggplot} 5 | \alias{stop_if_not_ggplot} 6 | \alias{fail_if_not_ggplot} 7 | \title{Check if an object is a ggplot} 8 | \usage{ 9 | is_ggplot(p) 10 | 11 | stop_if_not_ggplot(p, message = getOption("ggcheck.error")) 12 | 13 | fail_if_not_ggplot( 14 | p = .result, 15 | message = getOption("ggcheck.fail"), 16 | env = parent.frame() 17 | ) 18 | } 19 | \arguments{ 20 | \item{p}{An object} 21 | 22 | \item{message}{A message to be displayed if \code{p} is not a 23 | \link[ggplot2:ggplot]{ggplot} object.} 24 | 25 | \item{env}{Environment in which to find \code{.result}. 26 | Most users of \code{ggcheck} will not need to use this argument.} 27 | } 28 | \value{ 29 | \code{is_ggplot()} returns \code{\link{TRUE}} if \code{p} is a \link[ggplot2:ggplot]{ggplot} 30 | object; otherwise it returns \code{\link{FALSE}}. 31 | 32 | \code{stop_if_not_ggplot()} returns an error if \code{p} is not a 33 | \link[ggplot2:ggplot]{ggplot} object; other it invisibly returns \code{\link{NULL}}. 34 | 35 | \code{fail_if_not_ggplot()} returns a \link[gradethis:graded]{failing grade} if \code{p} is 36 | not a \link[ggplot2:ggplot]{ggplot} object; other it invisibly returns \code{\link{NULL}}. 37 | } 38 | \description{ 39 | \code{is_ggplot()} tests if an object is a \link[ggplot2:ggplot]{ggplot}. 40 | 41 | \code{stop_if_not_ggplot()} signals an error if an object is not 42 | a \link[ggplot2:ggplot]{ggplot}. 43 | 44 | \code{fail_if_not_ggplot()} returns a \link[gradethis:graded]{failing grade} if an 45 | object is not a \link[ggplot2:ggplot]{ggplot}. 46 | } 47 | \examples{ 48 | require(ggplot2) 49 | 50 | p_valid <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 51 | geom_point() 52 | is_ggplot(p_valid) 53 | stop_if_not_ggplot(p_valid) 54 | fail_if_not_ggplot(p_valid) 55 | 56 | p_invalid <- geom_point() 57 | is_ggplot(p_invalid) 58 | \dontrun{ 59 | stop_if_not_ggplot(p_invalid) 60 | } 61 | fail_if_not_ggplot(p_valid) 62 | } 63 | -------------------------------------------------------------------------------- /man/uses_mappings.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mappings.R 3 | \name{uses_mappings} 4 | \alias{uses_mappings} 5 | \title{Does a plot or layer use one or more mappings?} 6 | \usage{ 7 | uses_mappings(p, mappings, local_only = FALSE, exact = FALSE) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object or a layer extracted from a ggplot object with 11 | \code{\link{get_geom_layer}} or \code{\link{get_stat_layer}}.} 12 | 13 | \item{mappings}{One or more aesthetic mappings created with 14 | \code{\link[ggplot2]{aes}}.} 15 | 16 | \item{local_only}{If \code{TRUE}, \code{uses_mappings} will check only the 17 | mappings defined locally in a layer for the presence of \code{mappings}. If 18 | \code{FALSE}, \code{uses_mappings} will check for \code{mappings} in the 19 | combination of global and local methods that will be used to plot a layer.} 20 | 21 | \item{exact}{If \code{TRUE}, mappings need to be mapped exactly} 22 | } 23 | \value{ 24 | A logical value. 25 | } 26 | \description{ 27 | \code{uses_mappings} checks whether the student used one or more mappings in 28 | their plot. By default, \code{uses_mappings} ignores whether or not the student 29 | also supplied additional mappings. Use \code{uses_extra_mappings} to check if they did. 30 | If \code{exact} is \code{TRUE}, then all of the mappings have to match exactly. 31 | } 32 | \examples{ 33 | require(ggplot2) 34 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 35 | geom_point(mapping = aes(color = class)) 36 | uses_mappings(p, aes(x = displ)) 37 | uses_mappings(get_geom_layer(p, i = 1), aes(x = displ, color = class), local_only = FALSE) 38 | uses_mappings(get_geom_layer(p, i = 1), aes(x = displ, color = class), local_only = TRUE) 39 | uses_mappings(p, aes(x = displ, y = hwy), exact = TRUE) 40 | } 41 | \seealso{ 42 | Other functions for checking mappings: 43 | \code{\link{get_mappings}()}, 44 | \code{\link{identical_aes}()}, 45 | \code{\link{ith_mappings_use}()}, 46 | \code{\link{ith_mappings}()} 47 | } 48 | \concept{functions for checking mappings} 49 | -------------------------------------------------------------------------------- /man/get_mappings.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mappings.R 3 | \name{get_mappings} 4 | \alias{get_mappings} 5 | \title{Get aesthetic mappings from a layer or plot} 6 | \usage{ 7 | get_mappings(p, local_only = FALSE) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object or a layer extracted from a ggplot object with 11 | \code{\link{get_geom_layer}} or \code{\link{get_stat_layer}}.} 12 | 13 | \item{local_only}{\code{TRUE} or \code{FALSE}. Should \code{get_mappings} 14 | return only the mappings defined locally in a layer. This has no effect 15 | when \code{p} is a ggplot object.} 16 | } 17 | \value{ 18 | A list with class uneval, as returned by \code{\link[ggplot2]{aes}} 19 | Components of the list are either quosures or constants. 20 | } 21 | \description{ 22 | \code{get_mappings} returns the mappings used by a ggplot object or a single 23 | layer extracted from the object with \code{\link{get_geom_layer}} or \code{\link{get_stat_layer}}. 24 | } 25 | \details{ 26 | When passed a ggplot object (i.e. a plot), \code{get_mappings} will return 27 | only the mappings that have been set globally with 28 | \code{\link[ggplot2]{ggplot}}. When passed a single layer from a plot, the 29 | behavior of \code{get_mappings} will depend on the value of 30 | \code{local_only}. If \code{local_only = TRUE}, \code{get_mappings} will 31 | return only the mappings defined locally in a layer. When \code{local_only = 32 | FALSE}, \code{get_mappings} will return the combination of global and local 33 | methods that will be used to plot a layer. 34 | } 35 | \examples{ 36 | require(ggplot2) 37 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 38 | geom_point(mapping = aes(color = class)) 39 | get_mappings(p) 40 | get_mappings(get_geom_layer(p, i = 1), local_only = FALSE) 41 | } 42 | \seealso{ 43 | Other functions for checking mappings: 44 | \code{\link{identical_aes}()}, 45 | \code{\link{ith_mappings_use}()}, 46 | \code{\link{ith_mappings}()}, 47 | \code{\link{uses_mappings}()} 48 | } 49 | \concept{functions for checking mappings} 50 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | # 4 | # NOTE: This workflow is overkill for most R packages and 5 | # check-standard.yaml is likely a better choice. 6 | # usethis::use_github_action("check-standard") will install it. 7 | on: 8 | push: 9 | branches: [main, master] 10 | pull_request: 11 | branches: [main, master] 12 | 13 | name: R-CMD-check 14 | 15 | jobs: 16 | R-CMD-check: 17 | runs-on: ${{ matrix.config.os }} 18 | 19 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 20 | 21 | strategy: 22 | fail-fast: false 23 | matrix: 24 | config: 25 | - {os: macOS-latest, r: 'release'} 26 | 27 | - {os: windows-latest, r: 'release'} 28 | # Use 3.6 to trigger usage of RTools35 29 | - {os: windows-latest, r: '3.6'} 30 | 31 | # Use older ubuntu to maximise backward compatibility 32 | - {os: ubuntu-20.04, r: 'devel', http-user-agent: 'release'} 33 | - {os: ubuntu-20.04, r: 'release'} 34 | - {os: ubuntu-20.04, r: 'oldrel-1'} 35 | - {os: ubuntu-20.04, r: 'oldrel-2'} 36 | - {os: ubuntu-20.04, r: 'oldrel-3'} 37 | - {os: ubuntu-20.04, r: 'oldrel-4'} 38 | 39 | env: 40 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 41 | R_KEEP_PKG_SOURCE: yes 42 | 43 | steps: 44 | - uses: actions/checkout@v2 45 | 46 | - uses: r-lib/actions/setup-pandoc@v2 47 | 48 | - uses: r-lib/actions/setup-r@v2 49 | with: 50 | r-version: ${{ matrix.config.r }} 51 | http-user-agent: ${{ matrix.config.http-user-agent }} 52 | use-public-rspm: true 53 | 54 | - uses: r-lib/actions/setup-r-dependencies@v2 55 | with: 56 | extra-packages: any::rcmdcheck 57 | needs: check 58 | 59 | - uses: r-lib/actions/check-r-package@v2 60 | with: 61 | upload-snapshots: true 62 | -------------------------------------------------------------------------------- /man/ith_mappings.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mappings.R 3 | \name{ith_mappings} 4 | \alias{ith_mappings} 5 | \title{Return the aesthetic mappings used by the ith layer} 6 | \usage{ 7 | ith_mappings(p, i, local_only = FALSE) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object or a layer extracted from a ggplot object with 11 | \code{\link{get_geom_layer}} or \code{\link{get_stat_layer}}.} 12 | 13 | \item{i}{A numerical index that corresponds to the first layer of a plot (1), 14 | the second layer (2), and so on. \code{ith_mappings_use} will check the 15 | aesthetics used by the ith layer.} 16 | 17 | \item{local_only}{If \code{TRUE}, \code{ith_mappings_use} will check only the 18 | mappings defined locally in a layer for the presence of \code{mappings}. If 19 | \code{FALSE}, \code{ith_mappings_use} will check for \code{mappings} in the 20 | combination of global and local methods that will be used to plot a layer.} 21 | } 22 | \value{ 23 | A list with class uneval, as returned by \code{\link[ggplot2]{aes}} 24 | Components of the list are either quosures or constants. 25 | } 26 | \description{ 27 | \code{ith_mappings} returns the mappings used by a ggplot object or a single 28 | layer extracted from the object with \code{\link{get_geom_layer}} or \code{\link{get_stat_layer}}. 29 | } 30 | \details{ 31 | Functions that use the \code{ith_} prefix are 32 | designed to eliminate the need to call \code{get_layer} to check a specific 33 | layer in a plot, e.g. \code{p \%>\% get_geom_layer(geom = "point") \%>\% get_mappings()}. 34 | } 35 | \examples{ 36 | require(ggplot2) 37 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 38 | geom_point(mapping = aes(color = class)) + 39 | geom_smooth() 40 | ith_mappings(p, i = 1, local_only = FALSE) 41 | ith_mappings(p, i = 1, local_only = TRUE) 42 | ith_mappings(p, i = 2, local_only = FALSE) 43 | } 44 | \seealso{ 45 | Other functions for checking mappings: 46 | \code{\link{get_mappings}()}, 47 | \code{\link{identical_aes}()}, 48 | \code{\link{ith_mappings_use}()}, 49 | \code{\link{uses_mappings}()} 50 | } 51 | \concept{functions for checking mappings} 52 | -------------------------------------------------------------------------------- /pkgdown/_pkgdown.yml: -------------------------------------------------------------------------------- 1 | destination: reference 2 | 3 | url: https://pkgs.rstudio.com/ggcheck 4 | 5 | template: 6 | package: tidytemplate 7 | bootstrap: 5 8 | trailing_slash_redirect: true 9 | bslib: 10 | primary: "#096B72" 11 | navbar-background: "#e6f3fc" 12 | pkgdown-nav-height: 90px 13 | 14 | opengraph: 15 | image: 16 | src: man/figures/logo.png 17 | alt: "ggcheck package" 18 | twitter: 19 | creator: "@rstudio" 20 | card: summary 21 | 22 | authors: 23 | Garrick Aden-Buie: 24 | href: https://www.garrickadenbuie.com 25 | Nischal Shrestha: 26 | href: http://nischalshrestha.me/ 27 | "RStudio, PBC": 28 | href: https://www.rstudio.com 29 | html: 30 | 31 | home: 32 | links: 33 | - text: Learn more about learnr 34 | href: "https://rstudio.github.io/learnr" 35 | - text: Learn more about gradethis 36 | href: "https://pkgs.rstudio.com/gradethis" 37 | 38 | navbar: 39 | structure: 40 | left: [intro, articles, reference, news] 41 | components: 42 | examples: 43 | text: Examples 44 | href: articles/articles/examples.html 45 | 46 | # custom footer for rmarkdown ecosystem 47 | footer: 48 | structure: 49 | left: [ggcheck] 50 | right: [developed_by, p, built_with] 51 | components: 52 | p: "\n\n" 53 | ggcheck: | 54 | ggcheck is built for use with [learnr](https://rstudio.github.io/learnr) 55 | interactive tutorials. 56 | 57 | learnr is a part of the **R Markdown** ecosystem of packages for creating 58 | computational documents in R. Learn more at 59 | [rmarkdown.rstudio.com](https://rmarkdown.rstudio.com/). 60 | 61 | reference: 62 | - title: Get Plot Components 63 | contents: 64 | - starts_with("get_") 65 | - title: Locate Components by Layer 66 | contents: 67 | - n_layers 68 | - starts_with("ith_") 69 | - title: Test that a Plot Uses a Component 70 | contents: 71 | - identical_aes 72 | - starts_with("uses_") 73 | - title: Miscellaneous Helper Functions 74 | contents: 75 | - is_ggplot 76 | - get_default_labels 77 | - get_default_params 78 | - default_label 79 | - gradethis_equal.ggplot 80 | -------------------------------------------------------------------------------- /tests/testthat/test-layers.R: -------------------------------------------------------------------------------- 1 | require(ggplot2, quietly = TRUE) 2 | 3 | p <- 4 | ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 5 | geom_point(color = "red") + 6 | geom_point(mapping = aes(color = class)) + 7 | geom_smooth(se = FALSE) + 8 | labs(title = "TITLE", subtitle = "SUBTITLE", caption = "CAPTION") 9 | 10 | test_that("Identifies number of layers", { 11 | expect_equal( 12 | n_layers(p), 13 | 3 14 | ) 15 | }) 16 | 17 | test_that("Identifies a geom layer", { 18 | default_geom_point <- get_geom_layer(p, geom = "point") 19 | expect_true(inherits(default_geom_point, "layer_to_check")) 20 | expect_equal(default_geom_point$layer, p$layers[[1]]) 21 | expect_equal(default_geom_point$global_data, p$data) 22 | expect_equal(default_geom_point$global_mapping, p$mapping) 23 | }) 24 | 25 | test_that("Identifies the ith geom layer", { 26 | second_geom_point <- get_geom_layer(p, geom = "point", i = 2) 27 | expect_true(inherits(second_geom_point, "layer_to_check")) 28 | expect_equal(second_geom_point$layer, p$layers[[2]]) 29 | expect_equal(second_geom_point$global_data, p$data) 30 | expect_equal(second_geom_point$global_mapping, p$mapping) 31 | }) 32 | 33 | test_that("Identifies a stat layer", { 34 | default_stat_smooth <- get_stat_layer(p, stat = "smooth") 35 | expect_true(inherits(default_stat_smooth, "layer_to_check")) 36 | expect_equal(default_stat_smooth$layer, p$layers[[3]]) 37 | expect_equal(default_stat_smooth$global_data, p$data) 38 | expect_equal(default_stat_smooth$global_mapping, p$mapping) 39 | }) 40 | 41 | test_that("Identifies a stat layer", { 42 | first_stat_smooth <- get_stat_layer(p, stat = "smooth", i = 1) 43 | expect_true(inherits(first_stat_smooth, "layer_to_check")) 44 | expect_equal(first_stat_smooth$layer, p$layers[[3]]) 45 | expect_equal(first_stat_smooth$global_data, p$data) 46 | expect_equal(first_stat_smooth$global_mapping, p$mapping) 47 | }) 48 | 49 | test_that("Throws an error for getting a layer with invalid parameters", { 50 | expect_error(get_geom_layer(p)) 51 | expect_error(get_geom_layer(p, i = 0)) 52 | expect_error(get_geom_layer(p, "")) 53 | expect_error(get_geom_layer(p, "line")) 54 | # geom and stat should not be specified together 55 | expect_error(get_geom_layer(p, geom = "point", stat = "identity")) 56 | }) 57 | -------------------------------------------------------------------------------- /man/ith_mappings_use.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mappings.R 3 | \name{ith_mappings_use} 4 | \alias{ith_mappings_use} 5 | \title{Does the ith layer use one or more aesthetic mappings?} 6 | \usage{ 7 | ith_mappings_use(p, mappings, i, local_only = FALSE, exact = FALSE) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object or a layer extracted from a ggplot object with 11 | \code{\link{get_geom_layer}} or \code{\link{get_stat_layer}}.} 12 | 13 | \item{mappings}{One or more aesthetic mappings created with 14 | \code{\link[ggplot2]{aes}}.} 15 | 16 | \item{i}{A numerical index that corresponds to the first layer of a plot (1), 17 | the second layer (2), and so on. \code{ith_mappings_use} will check the 18 | aesthetics used by the ith layer.} 19 | 20 | \item{local_only}{If \code{TRUE}, \code{ith_mappings_use} will check only the 21 | mappings defined locally in a layer for the presence of \code{mappings}. If 22 | \code{FALSE}, \code{ith_mappings_use} will check for \code{mappings} in the 23 | combination of global and local methods that will be used to plot a layer.} 24 | 25 | \item{exact}{If \code{TRUE}, mappings need to be mapped exactly} 26 | } 27 | \value{ 28 | A logical value 29 | } 30 | \description{ 31 | \code{ith_mappings_use} checks whether the student uses the supplied mappings 32 | in the ith layer of their plot. 33 | } 34 | \details{ 35 | \code{ith_mappings_use} ignores whether or not the student supplied 36 | additional mappings as well. Functions that use the \code{ith_} prefix are 37 | designed to eliminate the need to call \code{get_layer} to check a specific 38 | layer in a plot, e.g. \code{p %>% get_geom_layer(geom = "point") %>% 39 | uses_mappings(aes(color = class))}. 40 | } 41 | \examples{ 42 | require(ggplot2) 43 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 44 | geom_point(mapping = aes(color = class)) + 45 | geom_smooth() 46 | ith_mappings_use(p, i = 1, aes(x = displ), local_only = FALSE) 47 | ith_mappings_use(p, i = 1, aes(x = displ), local_only = TRUE) 48 | ith_mappings_use(p, i = 2, aes(x = displ, y = hwy), local_only = FALSE) 49 | } 50 | \seealso{ 51 | Other functions for checking mappings: 52 | \code{\link{get_mappings}()}, 53 | \code{\link{identical_aes}()}, 54 | \code{\link{ith_mappings}()}, 55 | \code{\link{uses_mappings}()} 56 | } 57 | \concept{functions for checking mappings} 58 | -------------------------------------------------------------------------------- /man/uses_labels.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/labels.R 3 | \name{uses_labels} 4 | \alias{uses_labels} 5 | \title{Does a plot use one or more labels?} 6 | \usage{ 7 | uses_labels(p, ...) 8 | } 9 | \arguments{ 10 | \item{p}{A ggplot object} 11 | 12 | \item{...}{<\code{\link[rlang:dyn-dots]{dynamic-dots}}> 13 | \link[=character]{Character} strings. 14 | Unnamed arguments will check whether a label exists for that aesthetic. 15 | Named arguments will check whether the aesthetic with the same name 16 | has a label with a matching value. 17 | Each argument should have a matching \link[ggplot2:ggplot]{ggplot} 18 | \link[ggplot2:aes]{aesthetic} or \link[ggplot2:labs]{label}. 19 | Strings may be input as individual arguments or as list elements.} 20 | } 21 | \value{ 22 | A named logical vector of the same length as the number of inputs 23 | to \code{...}. 24 | } 25 | \description{ 26 | \code{uses_labels()} tests whether a plot uses one or more \link[ggplot2:labs]{labels}. 27 | } 28 | \details{ 29 | Note that \code{uses_labels()} will match \code{\link{NULL}} if a label is explicitly set to 30 | \code{\link{NULL}} \emph{\strong{or}} if a requested aesthetic is not present in the plot. 31 | } 32 | \examples{ 33 | require(ggplot2) 34 | 35 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 36 | geom_point(mapping = aes(color = class, shape = drv)) + 37 | geom_smooth() + 38 | labs(title = "My plot", x = "Weight", y = "MPG", color = NULL) 39 | 40 | # Unnamed arguments check if a label is set for the given aesthetic 41 | uses_labels(p, "title", "subtitle", "x", "y") 42 | 43 | # The check will return TRUE for labels set to NULL 44 | uses_labels(p, "color") 45 | 46 | # The check will return TRUE for aesthetics with default labels 47 | uses_labels(p, "shape") 48 | 49 | # Named arguments check if the label matches an expected value 50 | uses_labels(p, x = "Weight") 51 | uses_labels(p, x = "Weight", y = "MPG", color = NULL) 52 | 53 | # You can check for default labels with default_label() 54 | uses_labels(p, shape = default_label(), x = default_label()) 55 | 56 | # The colo(u)r aesthetic can be matched with or without a u 57 | uses_labels(p, color = NULL) 58 | uses_labels(p, colour = NULL) 59 | 60 | # Inputs can be passed from a list, with or without the !!! operator 61 | label_list <- list(x = "Weight", y = "MPG", color = NULL) 62 | uses_labels(p, label_list) 63 | uses_labels(p, !!!label_list) 64 | } 65 | \seealso{ 66 | Other functions for checking labels: 67 | \code{\link{get_default_labels}()}, 68 | \code{\link{get_labels}()} 69 | } 70 | \concept{functions for checking labels} 71 | -------------------------------------------------------------------------------- /R/is_ggplot.R: -------------------------------------------------------------------------------- 1 | #' Check if an object is a ggplot 2 | #' 3 | #' @description 4 | #' `is_ggplot()` tests if an object is a [ggplot][ggplot2::ggplot]. 5 | #' 6 | #' `stop_if_not_ggplot()` signals an error if an object is not 7 | #' a [ggplot][ggplot2::ggplot]. 8 | #' 9 | #' `fail_if_not_ggplot()` returns a [failing grade][gradethis::fail] if an 10 | #' object is not a [ggplot][ggplot2::ggplot]. 11 | #' 12 | #' @examples 13 | #' require(ggplot2) 14 | #' 15 | #' p_valid <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 16 | #' geom_point() 17 | #' is_ggplot(p_valid) 18 | #' stop_if_not_ggplot(p_valid) 19 | #' fail_if_not_ggplot(p_valid) 20 | #' 21 | #' p_invalid <- geom_point() 22 | #' is_ggplot(p_invalid) 23 | #' \dontrun{ 24 | #' stop_if_not_ggplot(p_invalid) 25 | #' } 26 | #' fail_if_not_ggplot(p_valid) 27 | #' @param p An object 28 | #' 29 | #' @param message A message to be displayed if `p` is not a 30 | #' [ggplot][ggplot2::ggplot] object. 31 | #' 32 | #' @param env Environment in which to find `.result`. 33 | #' Most users of `ggcheck` will not need to use this argument. 34 | #' 35 | #' @return `is_ggplot()` returns [`TRUE`] if `p` is a [ggplot][ggplot2::ggplot] 36 | #' object; otherwise it returns [`FALSE`]. 37 | #' 38 | #' `stop_if_not_ggplot()` returns an error if `p` is not a 39 | #' [ggplot][ggplot2::ggplot] object; other it invisibly returns [`NULL`]. 40 | #' 41 | #' `fail_if_not_ggplot()` returns a [failing grade][gradethis::fail] if `p` is 42 | #' not a [ggplot][ggplot2::ggplot] object; other it invisibly returns [`NULL`]. 43 | #' 44 | #' @export 45 | is_ggplot <- function(p) { 46 | inherits(p, "ggplot") 47 | } 48 | 49 | #' @rdname is_ggplot 50 | #' @export 51 | stop_if_not_ggplot <- function(p, message = getOption("ggcheck.error")) { 52 | if (is_ggplot(p)) { 53 | return(invisible(NULL)) 54 | } 55 | 56 | if (is.null(message)) { 57 | message <- paste0( 58 | '`p` must be a "ggplot" object, not an object of class ', 59 | '"', class(p)[[1]], '"' 60 | ) 61 | } 62 | 63 | stop(message, call. = FALSE) 64 | } 65 | 66 | #' @rdname is_ggplot 67 | #' @export 68 | fail_if_not_ggplot <- function( 69 | p = .result, 70 | message = getOption("ggcheck.fail"), 71 | env = parent.frame() 72 | ) { 73 | if (inherits(p, ".result")) { 74 | p <- get(".result", env) 75 | } 76 | 77 | if (is_ggplot(p)) { 78 | return(invisible(NULL)) 79 | } 80 | 81 | if (is.null(message)) { 82 | if (inherits(p, "LayerInstance")) { 83 | message <- paste0( 84 | 'I expected your code to create an entire ggplot, ', 85 | 'but it only created a ggplot layer (class "', class(p)[[1]], '")' 86 | ) 87 | } else { 88 | message <- paste0( 89 | 'I expected your code to create a ggplot, ', 90 | 'but it created an object of class "', class(p)[[1]], '"' 91 | ) 92 | } 93 | } 94 | 95 | gradethis::fail(message) 96 | } 97 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # ggcheck 5 | 6 | 7 | 8 | [![CRAN 9 | status](https://www.r-pkg.org/badges/version/ggcheck)](https://CRAN.R-project.org/package=ggcheck) 10 | [![R-CMD-check](https://github.com/rstudio/ggcheck/workflows/R-CMD-check/badge.svg)](https://github.com/rstudio/ggcheck/actions) 11 | 12 | 13 | 14 | ggcheck provides functions that inspect 15 | [ggplot2](https://ggplot2.tidyverse.org) objects to make it easier for 16 | teachers to check that student plots meet expectations. Designed 17 | primarily for automated grading via 18 | [gradethis](https://pkgs.rstudio.com/gradethis) in interactive 19 | [learnr](https://rstudio.github.io/learnr/) tutorials. 20 | 21 | ## Installation 22 | 23 | You can install ggcheck from 24 | [GitHub](https://github.com/rstudio/ggcheck) with: 25 | 26 | ``` r 27 | # install.packages("remotes") 28 | remotes::install_github("rstudio/ggcheck") 29 | ``` 30 | 31 | ## Usage 32 | 33 | The primary goal of ggcheck is to help tutorial authors inspect and test 34 | properties of [ggplot2](https://ggplot2.tidyverse.org) plots. The 35 | examples below demonstrate how ggcheck can be used in general; for more 36 | information about using gradethis in learnr tutorials, please see the 37 | [gradethis package documentation](https://pkgs.rstudio.com/gradethis/). 38 | 39 | Suppose an exercise asks students to create the following plot of engine 40 | displacement vs highway miles per gallon ratings. 41 | 42 | ``` r 43 | library(ggplot2) 44 | 45 | p <- 46 | ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 47 | geom_point(mapping = aes(color = class)) + 48 | geom_smooth(se = FALSE, method = "lm") 49 | 50 | p 51 | #> `geom_smooth()` using formula = 'y ~ x' 52 | ``` 53 | 54 | 55 | 56 | We can use ggcheck to test that students used `geom_point()` 57 | 58 | ``` r 59 | library(ggcheck) 60 | 61 | uses_geoms(p, "point", exact = FALSE) 62 | #> [1] TRUE 63 | ``` 64 | 65 | or that both `geom_point()` and `geom_smooth()` were used 66 | 67 | ``` r 68 | uses_geoms(p, c("point", "smooth"), exact = FALSE) 69 | #> [1] TRUE 70 | ``` 71 | 72 | or that exactly both `geom_point()` and `geom_smooth()` were used and in 73 | that order. 74 | 75 | ``` r 76 | uses_geoms(p, c("point", "smooth"), exact = TRUE) 77 | #> [1] TRUE 78 | ``` 79 | 80 | Similarly, we can test that a linear model was used for the smoothing 81 | method and the confidence interval was not displayed: 82 | 83 | ``` r 84 | uses_geom_param(p, "smooth", list(se = FALSE, method = "lm")) 85 | #> se method 86 | #> TRUE TRUE 87 | ``` 88 | 89 | There’s a lot more that ggcheck can do. Read more in the [full function 90 | listing](https://rstudio.github.io/ggcheck/). 91 | 92 | ## Code of Conduct 93 | 94 | Please note that the tblcheck project is released with a [Contributor 95 | Code of 96 | Conduct](https://contributor-covenant.org/version/2/0/CODE_OF_CONDUCT.html). 97 | By contributing to this project, you agree to abide by its terms. 98 | -------------------------------------------------------------------------------- /man/uses_geom_params.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom_params.R 3 | \name{uses_geom_params} 4 | \alias{uses_geom_params} 5 | \alias{uses_geom_param} 6 | \title{Does a layer use one of more specific parameters?} 7 | \usage{ 8 | uses_geom_params(p, geom, ..., params = NULL, i = NULL) 9 | 10 | uses_geom_param(p, geom, ..., params = NULL, i = NULL) 11 | } 12 | \arguments{ 13 | \item{p}{A ggplot object} 14 | 15 | \item{geom}{A character string found in the suffix of a ggplot2 geom function, 16 | e.g. \code{"point"}.} 17 | 18 | \item{...}{<\code{\link[rlang:dyn-dots]{dynamic-dots}}> 19 | Named values or \link{character} strings. 20 | Unnamed arguments will check whether any value was set for that parameter. 21 | Named arguments will check whether the parameter with the same name has a 22 | matching value. 23 | Each argument should have a name matching a \link[ggplot2:ggplot]{ggplot} 24 | layer parameter. 25 | Values may be passed as arguments or as list elements.} 26 | 27 | \item{params}{A named list of geom or stat parameter values, e.g. 28 | \code{list(outlier.alpha = 0.01)}. 29 | This list is combined with any inputs to \code{...}} 30 | 31 | \item{i}{A numerical index, e.g. \code{1}.} 32 | } 33 | \value{ 34 | A named logical vector of the same length as the number of inputs 35 | to \code{...}. 36 | } 37 | \description{ 38 | \code{uses_geom_params} checks that a plot's geom layer uses a specific parameter. 39 | } 40 | \details{ 41 | To specify a specific geom layer, either specify using position using the \code{i} index or 42 | by using a combination of \code{geom} function suffix name and \code{i} to check the ith layer that 43 | uses the geom. 44 | 45 | The \code{params} argument accepts a list that contains geom, stat, or aes 46 | parameters. This offers flexibility in certain situations where setting a 47 | parameter on a \code{geom_} function is actually setting a stat parameter or 48 | aes parameter. For example, in \code{geom_histogram(binwidth = 500)}, the 49 | \code{binwidth} is a stat parameter, while in 50 | \code{geom_histogram(fill = "blue")}, the \code{fill} is an aes parameter. 51 | \code{uses_geom_params} will take this into account and check geom, stat, and 52 | aes parameters. 53 | 54 | Note that \code{uses_geom_params()} can detect aes \emph{parameters}, but not aes 55 | \emph{mappings}. Parameters are set to static values directly within a layer (e.g. 56 | \code{geom_point(color = "blue")}), while mappings associate variables in the data with plot aesthetics using 57 | \code{\link[ggplot2:aes]{aes()}} (e.g. \code{geom_point(aes(color = class))}). 58 | } 59 | \examples{ 60 | require(ggplot2) 61 | 62 | p <- ggplot(data = diamonds, aes(x = cut, y = price)) + 63 | geom_boxplot(varwidth = TRUE, outlier.alpha = 0.01, fill = "blue") 64 | 65 | uses_geom_params( 66 | p, "boxplot", list(varwidth = TRUE, outlier.alpha = 0.01, fill = "blue") 67 | ) 68 | 69 | uses_geom_params( 70 | p, "boxplot", varwidth = TRUE, outlier.alpha = 0.01, fill = "blue" 71 | ) 72 | 73 | # Unnamed arguments check that a parameter is set to any value 74 | uses_geom_params(p, "boxplot", "fill") 75 | } 76 | \seealso{ 77 | Other functions for checking geom parameters: 78 | \code{\link{get_default_params}()} 79 | } 80 | \concept{functions for checking geom parameters} 81 | -------------------------------------------------------------------------------- /tests/testthat/test-data.R: -------------------------------------------------------------------------------- 1 | require(ggplot2, quietly = TRUE) 2 | 3 | p <- 4 | ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 5 | geom_point(mapping = aes(color = class)) + 6 | geom_smooth(se = FALSE) + 7 | labs(title = "TITLE", subtitle = "SUBTITLE", caption = "CAPTION") 8 | 9 | d2 <- head(mpg) 10 | 11 | p2 <- 12 | ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 13 | geom_point(data = d2, color = "red") + 14 | geom_point(mapping = aes(color = class)) + 15 | geom_smooth(se = FALSE) + 16 | labs(title = "TITLE", subtitle = "SUBTITLE", caption = "CAPTION") 17 | 18 | test_that("Identifies global data", { 19 | expect_equal( 20 | get_data(p), 21 | mpg 22 | ) 23 | }) 24 | 25 | test_that("Checks whether data is used globally", { 26 | expect_true(uses_data(p, data = mpg)) 27 | expect_false(uses_data(p, data = mtcars)) 28 | }) 29 | 30 | test_that("Identifies local data", { 31 | expect_equal( 32 | p %>% get_geom_layer(geom = "point") %>% get_data(local_only = TRUE), 33 | NULL 34 | ) 35 | expect_equal( 36 | p %>% get_geom_layer(geom = "point") %>% get_data(local_only = FALSE), 37 | mpg 38 | ) 39 | expect_equal( 40 | p %>% get_geom_layer(i = 1) %>% get_data(local_only = FALSE), 41 | mpg 42 | ) 43 | expect_equal( 44 | p2 %>% get_geom_layer(geom = "point") %>% get_data(), 45 | d2 46 | ) 47 | expect_equal( 48 | p2 %>% get_geom_layer(geom = "point") %>% get_data(local_only = FALSE), 49 | d2 50 | ) 51 | expect_equal( 52 | p2 %>% get_geom_layer(i = 1) %>% get_data(), 53 | d2 54 | ) 55 | expect_equal( 56 | p2 %>% get_geom_layer(i = 1) %>% get_data(local_only = FALSE), 57 | d2 58 | ) 59 | expect_equal( 60 | p2 %>% get_geom_layer(geom = "point", i = 2) %>% get_data(local_only = TRUE), 61 | NULL 62 | ) 63 | expect_equal( 64 | p2 %>% get_geom_layer(geom = "point", i = 2) %>% get_data(local_only = FALSE), 65 | mpg 66 | ) 67 | }) 68 | 69 | test_that("Checks whether data is used by layer", { 70 | expect_true(p2 %>% get_geom_layer(i = 1) %>% uses_data(d2)) 71 | expect_true(p2 %>% get_geom_layer(i = 2) %>% uses_data(mpg)) 72 | expect_false(p2 %>% get_geom_layer(i = 2) %>% uses_data(mpg, local_only = TRUE)) 73 | expect_false(p2 %>% get_geom_layer(i = 1) %>% uses_data(mpg)) 74 | expect_false(p2 %>% get_geom_layer(i = 2) %>% uses_data(d2)) 75 | }) 76 | 77 | test_that("Identifies the data set used by ith layer", { 78 | expect_equal( 79 | p2 %>% ith_data(1), 80 | d2 81 | ) 82 | expect_equal( 83 | p2 %>% ith_data(1, local_only = FALSE), 84 | d2 85 | ) 86 | expect_equal( 87 | p2 %>% ith_data(2, local_only = FALSE), 88 | mpg 89 | ) 90 | expect_equal( 91 | p2 %>% ith_data(2, local_only = TRUE), 92 | NULL 93 | ) 94 | }) 95 | 96 | test_that("Checks the data used by ith layer", { 97 | expect_true(p2 %>% ith_data_is(data = d2, i = 1)) 98 | expect_true(p2 %>% ith_data_is(data = d2, i = 1, local_only = FALSE)) 99 | expect_true(p2 %>% ith_data_is(data = mpg, i = 2, local_only = FALSE)) 100 | expect_true(p2 %>% ith_data_is(data = NULL, i = 2, local_only = TRUE)) 101 | expect_false(p2 %>% ith_data_is(data = mpg, i = 1)) 102 | expect_false(p2 %>% ith_data_is(data = mpg, i = 1, local_only = FALSE)) 103 | expect_false(p2 %>% ith_data_is(data = NULL, i = 2, local_only = FALSE)) 104 | expect_false(p2 %>% ith_data_is(data = mpg, i = 2, local_only = TRUE)) 105 | }) 106 | -------------------------------------------------------------------------------- /tests/testthat/test-geoms.R: -------------------------------------------------------------------------------- 1 | require(ggplot2, quietly = TRUE) 2 | 3 | p <- 4 | ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 5 | geom_point(mapping = aes(color = class)) + 6 | geom_smooth(se = FALSE) + 7 | labs(title = "TITLE", subtitle = "SUBTITLE", caption = "CAPTION") 8 | 9 | d2 <- head(mpg) 10 | 11 | p2 <- 12 | ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 13 | geom_point(data = d2, color = "red") + 14 | geom_point(mapping = aes(color = class)) + 15 | geom_smooth(se = FALSE) + 16 | labs(title = "TITLE", subtitle = "SUBTITLE", caption = "CAPTION") 17 | 18 | test_that("Identifies ith geom", { 19 | expect_equal( 20 | ith_geom(p, 1), 21 | "point" 22 | ) 23 | expect_equal( 24 | ith_geom(p, 2), 25 | "smooth" 26 | ) 27 | }) 28 | 29 | test_that("Identifies ith geom and stat combination", { 30 | expect_equal( 31 | ith_geom_stat(p, 1), 32 | structure( 33 | list(GEOM = "point", STAT = "identity"), 34 | class = "GEOM_STAT" 35 | ) 36 | ) 37 | expect_equal( 38 | ith_geom_stat(p, 2), 39 | structure( 40 | list(GEOM = "smooth", STAT = "smooth"), 41 | class = "GEOM_STAT" 42 | ) 43 | ) 44 | }) 45 | 46 | test_that("Checks ith geom", { 47 | expect_true(ith_geom_is(p, "point", i = 1)) 48 | expect_true(ith_geom_is(p, "smooth", i = 2)) 49 | expect_false(ith_geom_is(p, "smooth", i = 1)) 50 | expect_false(ith_geom_is(p, "point", i = 2)) 51 | }) 52 | 53 | test_that("Identifies sequence of geoms", { 54 | expect_equal( 55 | get_geoms(p), 56 | c("point", "smooth") 57 | ) 58 | }) 59 | 60 | test_that("Identifies sequence of geom and stat combinations", { 61 | expect_equal( 62 | get_geoms_stats(p), 63 | list( 64 | structure( 65 | list(GEOM = "point", STAT = "identity"), 66 | class = "GEOM_STAT" 67 | ), 68 | structure( 69 | list(GEOM = "smooth", STAT = "smooth"), 70 | class = "GEOM_STAT" 71 | ) 72 | ) 73 | ) 74 | }) 75 | 76 | test_that("Checks whether a geom is used", { 77 | expect_true(uses_geoms(p, "point", exact = FALSE)) 78 | expect_true(uses_geoms(p, "smooth", exact = FALSE)) 79 | expect_true(uses_geoms(p, c("point", "smooth"))) 80 | expect_false(uses_geoms(p, "line")) 81 | expect_false(uses_geoms(p, c("point", "line"))) 82 | expect_true(uses_geoms(p2, c("point", "point", "point"), exact = FALSE)) 83 | expect_false(uses_geoms(p2, c("point", "point", "point"))) 84 | }) 85 | 86 | test_that("Checks whether a sequence of geoms is used", { 87 | expect_true(uses_geoms(p, c("point", "smooth"))) 88 | expect_false(uses_geoms(p, "point")) 89 | expect_false(uses_geoms(p, "smooth")) 90 | expect_false(uses_geoms(p, c("point", "line"))) 91 | }) 92 | 93 | test_that("Checks whether geom and stat combinations are used", { 94 | expect_true(uses_geoms(p, geoms = c("point", "smooth"), stats = c("identity", "smooth"))) 95 | expect_false(uses_geoms(p, geoms = c("point", "smooth"), stats = c("sum", "smooth"))) 96 | # throw error if length of stats does not match total number of geoms 97 | expect_error(uses_geoms(p, geoms = c("point", "smooth"), stats = c("identity"))) 98 | }) 99 | 100 | test_that("Throws a grading error when checking an invalid geom", { 101 | expect_error(uses_geoms(p, "lline")) 102 | expect_error(uses_geoms(p, c("point", "lline"))) 103 | }) 104 | 105 | test_that("Throws a grading error when checking an invalid geom and stat combination", { 106 | # invalid geom 107 | expect_error(uses_geoms(p, geoms = c("pointtt", "smooth"), stats = c("identity", "smooth"))) 108 | # invalid stat 109 | expect_error(uses_geoms(p, geoms = c("point", "smooth"), stats = c("point", "smooth"))) 110 | }) 111 | -------------------------------------------------------------------------------- /tests/testthat/test-stats.R: -------------------------------------------------------------------------------- 1 | require(ggplot2, quietly = TRUE) 2 | 3 | p <- ggplot(data = diamonds, aes(x = cut, y = price)) + 4 | stat_boxplot(outlier.alpha = 0.01) + 5 | stat_summary() 6 | 7 | p2 <- ggplot(data = diamonds, aes(sample = price)) + 8 | geom_qq() 9 | 10 | test_that("Identifies ith stat", { 11 | expect_equal( 12 | ith_stat(p, 1), 13 | "boxplot" 14 | ) 15 | expect_equal( 16 | ith_stat(p, 2), 17 | "summary" 18 | ) 19 | expect_equal( 20 | ith_stat(p2, 1), 21 | "qq" 22 | ) 23 | }) 24 | 25 | test_that("Checks ith stat", { 26 | expect_true(ith_stat_is(p, "boxplot", i = 1)) 27 | expect_true(ith_stat_is(p, "summary", i = 2)) 28 | expect_true(ith_stat_is(p2, "qq", i = 1)) 29 | }) 30 | 31 | test_that("Identifies sequence of stats", { 32 | expect_equal( 33 | get_stats(p), 34 | c("boxplot", "summary") 35 | ) 36 | expect_equal( 37 | get_stats(p2), 38 | "qq" 39 | ) 40 | }) 41 | 42 | test_that("Checks whether a sequence of stats are used", { 43 | expect_true(uses_stats(p, "boxplot", exact = FALSE)) 44 | # order does not matter if exact = FALSE 45 | expect_true(uses_stats(p, c("summary", "boxplot"), exact = FALSE)) 46 | # order matters in default case because exact = TRUE 47 | expect_false(uses_stats(p, c("summary", "boxplot"))) 48 | expect_true(uses_stats(p, c("boxplot", "summary"))) 49 | expect_true(uses_stats(p2, "qq")) 50 | }) 51 | 52 | test_that("Checks whether stat and geom combinations are used", { 53 | expect_true(uses_stats(p, stats = c("boxplot", "summary"), geoms = c("boxplot", "pointrange"))) 54 | expect_false(uses_stats(p, stats = c("boxplot", "summary"), geoms = c("boxplot", "point"))) 55 | # geom suffix gets properly mapped 56 | expect_true(uses_stats(p2, stats = "qq", geoms = "qq")) 57 | # if instructor already knows geom is "point", that works too 58 | expect_true(uses_stats(p2, stats = "qq", geoms = "point")) 59 | expect_false(uses_stats(p2, stats = "qq", geoms = "line")) 60 | # wrong geom 61 | expect_error(uses_stats(p, stats = c("boxplot", "summary"), geoms = c("boxplot", "summary"))) 62 | # throw error if length of stats does not match total number of geoms 63 | expect_error(uses_stats(p, stats = c("boxplot", "summary"), geoms = c("boxplot"))) 64 | expect_error(uses_stats(p2, stats = "qq", geoms = c("qq", "point"))) 65 | }) 66 | 67 | test_that("Throws a grading error when checking an invalid stat", { 68 | expect_error(uses_stats(p, "line")) 69 | expect_error(uses_stats(p, c("boxplot", "line"))) 70 | expect_error(uses_stats(p2, "point")) 71 | }) 72 | 73 | test_that("Throws a grading error when checking an invalid stat", { 74 | # invalid stats 75 | expect_error(uses_stats(p, stats = c("boxplott", "summary"), geoms = c("boxplot", "pointrange"))) 76 | expect_error(uses_stats(p2, stats = "qqq", geoms = "qq")) 77 | # invalid geom 78 | expect_error(uses_stats(p, stats = c("boxplot", "summary"), geoms = c("boxplot", "summary"))) 79 | expect_error(uses_stats(p2, stats = "qq", geoms = "qqq")) 80 | }) 81 | 82 | test_that("Checks whether a stat uses a specfic parameter value", { 83 | # check a default parameter 84 | expect_true(uses_stat_param(p, stat = "boxplot", params = list(na.rm = FALSE, coef = 1.5))) 85 | expect_true(uses_stat_param(p, stat = "summary", params = list(fun = NULL))) 86 | # check set parameters 87 | expect_true(uses_stat_param(p, stat = "boxplot", params = list(outlier.alpha = 0.01))) 88 | }) 89 | 90 | test_that("Throws a grading error when checking an invalid geom parameter", { 91 | # typo 92 | expect_error(uses_stat_param(p, stat = "boxplot", params = list(coeff = FALSE))) 93 | # invalid parameter for stat 94 | expect_error(uses_stat_param(p, stat = "summary", params = list(outlier.alpha = 0.01))) 95 | expect_error(uses_stat_param(p, stat = "boxplot", params = list(bad_param = NULL))) 96 | expect_error(uses_stat_param(p, stat = "summary", params = list(bad1 = 1, bad2 = 2))) 97 | }) 98 | -------------------------------------------------------------------------------- /.github/CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | We as members, contributors, and leaders pledge to make participation in our 6 | community a harassment-free experience for everyone, regardless of age, body 7 | size, visible or invisible disability, ethnicity, sex characteristics, gender 8 | identity and expression, level of experience, education, socio-economic status, 9 | nationality, personal appearance, race, religion, or sexual identity and 10 | orientation. 11 | 12 | We pledge to act and interact in ways that contribute to an open, welcoming, 13 | diverse, inclusive, and healthy community. 14 | 15 | ## Our Standards 16 | 17 | Examples of behavior that contributes to a positive environment for our 18 | community include: 19 | 20 | * Demonstrating empathy and kindness toward other people 21 | * Being respectful of differing opinions, viewpoints, and experiences 22 | * Giving and gracefully accepting constructive feedback 23 | * Accepting responsibility and apologizing to those affected by our mistakes, 24 | and learning from the experience 25 | * Focusing on what is best not just for us as individuals, but for the overall 26 | community 27 | 28 | Examples of unacceptable behavior include: 29 | 30 | * The use of sexualized language or imagery, and sexual attention or 31 | advances of any kind 32 | * Trolling, insulting or derogatory comments, and personal or political attacks 33 | * Public or private harassment 34 | * Publishing others' private information, such as a physical or email 35 | address, without their explicit permission 36 | * Other conduct which could reasonably be considered inappropriate in a 37 | professional setting 38 | 39 | ## Enforcement Responsibilities 40 | 41 | Community leaders are responsible for clarifying and enforcing our standards 42 | of acceptable behavior and will take appropriate and fair corrective action in 43 | response to any behavior that they deem inappropriate, threatening, offensive, 44 | or harmful. 45 | 46 | Community leaders have the right and responsibility to remove, edit, or reject 47 | comments, commits, code, wiki edits, issues, and other contributions that are 48 | not aligned to this Code of Conduct, and will communicate reasons for moderation 49 | decisions when appropriate. 50 | 51 | ## Scope 52 | 53 | This Code of Conduct applies within all community spaces, and also applies 54 | when an individual is officially representing the community in public spaces. 55 | Examples of representing our community include using an official e-mail 56 | address, posting via an official social media account, or acting as an appointed 57 | representative at an online or offline event. 58 | 59 | ## Enforcement 60 | 61 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 62 | reported to the community leaders responsible for enforcement at [INSERT CONTACT 63 | METHOD]. All complaints will be reviewed and investigated promptly and fairly. 64 | 65 | All community leaders are obligated to respect the privacy and security of the 66 | reporter of any incident. 67 | 68 | ## Enforcement Guidelines 69 | 70 | Community leaders will follow these Community Impact Guidelines in determining 71 | the consequences for any action they deem in violation of this Code of Conduct: 72 | 73 | ### 1. Correction 74 | 75 | **Community Impact**: Use of inappropriate language or other behavior deemed 76 | unprofessional or unwelcome in the community. 77 | 78 | **Consequence**: A private, written warning from community leaders, providing 79 | clarity around the nature of the violation and an explanation of why the 80 | behavior was inappropriate. A public apology may be requested. 81 | 82 | ### 2. Warning 83 | 84 | **Community Impact**: A violation through a single incident or series of 85 | actions. 86 | 87 | **Consequence**: A warning with consequences for continued behavior. No 88 | interaction with the people involved, including unsolicited interaction with 89 | those enforcing the Code of Conduct, for a specified period of time. This 90 | includes avoiding interactions in community spaces as well as external channels 91 | like social media. Violating these terms may lead to a temporary or permanent 92 | ban. 93 | 94 | ### 3. Temporary Ban 95 | 96 | **Community Impact**: A serious violation of community standards, including 97 | sustained inappropriate behavior. 98 | 99 | **Consequence**: A temporary ban from any sort of interaction or public 100 | communication with the community for a specified period of time. No public or 101 | private interaction with the people involved, including unsolicited interaction 102 | with those enforcing the Code of Conduct, is allowed during this period. 103 | Violating these terms may lead to a permanent ban. 104 | 105 | ### 4. Permanent Ban 106 | 107 | **Community Impact**: Demonstrating a pattern of violation of community 108 | standards, including sustained inappropriate behavior, harassment of an 109 | individual, or aggression toward or disparagement of classes of individuals. 110 | 111 | **Consequence**: A permanent ban from any sort of public interaction within the 112 | community. 113 | 114 | ## Attribution 115 | 116 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], 117 | version 2.0, 118 | available at https://www.contributor-covenant.org/version/2/0/ 119 | code_of_conduct.html. 120 | 121 | Community Impact Guidelines were inspired by [Mozilla's code of conduct 122 | enforcement ladder](https://github.com/mozilla/diversity). 123 | 124 | [homepage]: https://www.contributor-covenant.org 125 | 126 | For answers to common questions about this code of conduct, see the FAQ at 127 | https://www.contributor-covenant.org/faq. Translations are available at https:// 128 | www.contributor-covenant.org/translations. 129 | -------------------------------------------------------------------------------- /tests/testthat/test-labels.R: -------------------------------------------------------------------------------- 1 | require(ggplot2, quietly = TRUE) 2 | 3 | p <- 4 | ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 5 | geom_point(mapping = aes(color = class, shape = drv)) + 6 | labs( 7 | title = "TITLE", 8 | x = "X", 9 | y = "Y", 10 | color = NULL, 11 | fill = character(0) 12 | ) 13 | 14 | test_that("Identifies labels", { 15 | expect_equal( 16 | get_labels(p), 17 | list( 18 | x = "X", 19 | y = "Y", 20 | colour = NULL, 21 | fill = character(0), 22 | title = "TITLE", 23 | shape = "drv" 24 | ) 25 | ) 26 | 27 | expect_equal( 28 | get_labels(p, "x"), 29 | list(x = "X") 30 | ) 31 | 32 | expect_equal( 33 | get_labels(p, c("x", "y")), 34 | list(x = "X", y = "Y") 35 | ) 36 | 37 | expect_equal( 38 | get_labels(p, c("y", "x")), 39 | list(y = "Y", x = "X") 40 | ) 41 | 42 | expect_equal( 43 | get_labels(p, "color"), 44 | list(color = NULL) 45 | ) 46 | 47 | expect_equal( 48 | get_labels(p, "subtitle"), 49 | list(subtitle = NULL) 50 | ) 51 | }) 52 | 53 | test_that("Checks whether a label is used", { 54 | expect_equal(uses_labels(p, x = "X"), c(x = TRUE)) 55 | expect_equal(uses_labels(p, x = "X", y = "Y"), c(x = TRUE, y = TRUE)) 56 | 57 | expect_equal(uses_labels(p, color = NULL), c(color = TRUE)) 58 | expect_equal(uses_labels(p, fill = NULL), c(fill = TRUE)) 59 | expect_equal(uses_labels(p, color = character(0)), c(color = TRUE)) 60 | expect_equal(uses_labels(p, fill = character(0)), c(fill = TRUE)) 61 | 62 | expect_equal( 63 | uses_labels(p, x = "X", y = "Y", color = NULL), 64 | c(x = TRUE, y = TRUE, color = TRUE) 65 | ) 66 | 67 | expect_equal(uses_labels(p, x = "Incorrect"), c(x = FALSE)) 68 | expect_equal(uses_labels(p, x = "X", y = "Incorrect"), c(x = TRUE, y = FALSE)) 69 | expect_equal(uses_labels(p, fill = "Incorrect"), c(fill = FALSE)) 70 | }) 71 | 72 | test_that("Inputs from list", { 73 | expect_equal( 74 | uses_labels(p, list(x = "X", y = "Y", color = "C")), 75 | c(x = TRUE, y = TRUE, color = FALSE) 76 | ) 77 | expect_equal( 78 | uses_labels(p, x = "X", list(y = "Y", color = "C")), 79 | c(x = TRUE, y = TRUE, color = FALSE) 80 | ) 81 | 82 | expect_equal( 83 | uses_labels(p, !!!list(x = "X", y = "Y", color = "C")), 84 | c(x = TRUE, y = TRUE, color = FALSE) 85 | ) 86 | expect_equal( 87 | uses_labels(p, x = "X", !!!list(y = "Y", color = "C")), 88 | c(x = TRUE, y = TRUE, color = FALSE) 89 | ) 90 | 91 | expect_equal( 92 | uses_labels(p, x = "X", list(y = "Y"), !!!list(color = "C")), 93 | c(x = TRUE, y = TRUE, color = FALSE) 94 | ) 95 | }) 96 | 97 | test_that("unnamed inputs", { 98 | expect_equal(uses_labels(p, "x"), c(x = TRUE)) 99 | expect_equal(uses_labels(p, "x", "y"), c(x = TRUE, y = TRUE)) 100 | expect_equal(uses_labels(p, "title"), c(title = TRUE)) 101 | expect_equal(uses_labels(p, "shape"), c(shape = TRUE)) 102 | expect_equal(uses_labels(p, "subtitle"), c(subtitle = FALSE)) 103 | 104 | expect_equal(uses_labels(p, x = "X", "title"), c(x = TRUE, title = TRUE)) 105 | expect_equal( 106 | uses_labels(p, list(x = "X", "title")), 107 | c(x = TRUE, title = TRUE) 108 | ) 109 | expect_equal( 110 | uses_labels(p, !!!list(x = "X", "title")), 111 | c(x = TRUE, title = TRUE) 112 | ) 113 | }) 114 | 115 | test_that("default labels", { 116 | # Returns the label the ggplot would create by default for an aesthetic 117 | expect_equal(get_default_labels(p, "x"), list(x = "displ")) 118 | expect_equal(get_default_labels(p, "y"), list(y = "hwy")) 119 | expect_equal(get_default_labels(p, "color"), list(color = "class")) 120 | expect_equal(get_default_labels(p, "shape"), list(shape = "drv")) 121 | 122 | expect_equal( 123 | get_default_labels(p), 124 | list( 125 | x = "displ", 126 | y = "hwy", 127 | colour = "class", 128 | fill = NULL, 129 | title = NULL, 130 | shape = "drv" 131 | ) 132 | ) 133 | 134 | # If an aesthetic does not exist, returns NULL 135 | expect_equal(get_default_labels(p, "size"), list(size = NULL)) 136 | 137 | # If an aesthetic has no default, returns NULL 138 | expect_equal(get_default_labels(p, "title"), list(title = NULL)) 139 | 140 | # The colo(u)r aesthetic can be matched with or without a u 141 | expect_equal(get_default_labels(p, "color"), list(color = "class")) 142 | expect_equal(get_default_labels(p, "colour"), list(colour = "class")) 143 | 144 | # Works with no arguments within `uses_labels()` 145 | expect_equal( 146 | uses_labels(p, x = default_label(), shape = default_label()), 147 | c(x = FALSE, shape = TRUE) 148 | ) 149 | expect_equal(uses_labels(p, color = default_label()), c(color = FALSE)) 150 | }) 151 | 152 | test_that("Throws a grading error when label is not a string or NULL", { 153 | expect_error(uses_labels(p, x = c("X", "Y"))) 154 | expect_error(uses_labels(p, x = 1)) 155 | expect_error(uses_labels(p, color = FALSE)) 156 | }) 157 | 158 | test_that("Throws a grading error when name is duplicated", { 159 | expect_error(uses_labels(p, x = "X", x = "X")) 160 | expect_error(uses_labels(p, x = "X", list(x = "X", y = "Y"))) 161 | expect_error(uses_labels(p, x = "X", !!!list(x = "X", y = "Y"))) 162 | expect_error(uses_labels(p, list(x = "X"), list(x = "X", y = "Y"))) 163 | expect_error(uses_labels(p, list(x = "X"), !!!list(x = "X", y = "Y"))) 164 | expect_error(uses_labels(p, !!!list(x = "X"), !!!list(x = "X", y = "Y"))) 165 | }) 166 | 167 | test_that("stop_if_not_ggplot", { 168 | expect_error( 169 | uses_labels( 170 | geom_point(data = mpg, mapping = aes(x = displ, y = hwy)), 171 | x = "displ", y = "hwy" 172 | ), 173 | '`p` must be a "ggplot" object' 174 | ) 175 | }) 176 | -------------------------------------------------------------------------------- /R/stats.R: -------------------------------------------------------------------------------- 1 | #' List the stats used by a plot 2 | #' 3 | #' \code{get_stats} returns a vector of stats names, written as character 4 | #' strings, that describes which stats in which order are used by a plot. 5 | #' 6 | #' @param p A ggplot object 7 | #' 8 | #' @return A vector of character strings. Each element corresponds to the suffix 9 | #' of a ggplot2 \code{stat_} function, e.g. \code{c("identity", "smooth")}. 10 | #' 11 | #' @family functions for checking stats 12 | #' 13 | #' @export 14 | #' 15 | #' @examples 16 | #' require(ggplot2) 17 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 18 | #' geom_point(mapping = aes(color = class)) + 19 | #' geom_smooth() 20 | #' get_stats(p) 21 | get_stats <- function(p) { 22 | stop_if_not_ggplot(p) 23 | n <- n_layers(p) 24 | vapply(seq_len(n), ith_stat, character(1), p = p) 25 | } 26 | 27 | #' Does a plot use one or more stats? 28 | #' 29 | #' \code{uses_stats} tests whether a plot uses one or more stats in its layers. 30 | #' 31 | #' By default, the plot must have the exact stats or geom/stat combinations and in the same order. 32 | #' However, if \code{exact} is set to \code{FALSE}, the plot stats or geom/stat combinations do not have to be exact. 33 | #' 34 | #' @param p A ggplot object 35 | #' @param stats A vector of character strings. Each element should correspond to 36 | #' the suffix of a ggplot2 \code{stat_} function, e.g. \code{c("identity", "smooth")}. 37 | #' @param exact if \code{TRUE}, use exact matching 38 | #' @param geoms A character vector to optionally check for the geoms corresponding to stats 39 | #' e.g. c("point", "smooth") if checking c("identity", "smooth") 40 | #' 41 | #' @return \code{TRUE} or \code{FALSE} 42 | #' 43 | #' @family functions for checking stats 44 | #' 45 | #' @export 46 | #' 47 | #' @examples 48 | #' require(ggplot2) 49 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 50 | #' geom_point(mapping = aes(color = class)) + 51 | #' geom_smooth() 52 | #' uses_stats(p, stats = "smooth") 53 | #' uses_stats(p, stats = c("identity", "smooth"), exact = TRUE) 54 | #' uses_stats(p, c("smooth", "identity"), geoms = c("smooth", "point")) 55 | uses_stats <- function(p, stats, geoms = NULL, exact = TRUE) { 56 | stop_if_not_ggplot(p) 57 | # map the GEOM + STAT for plot and the instructor's target stats 58 | stats <- lapply(stats, map_stat) 59 | # if geoms is specified override the GEOM(s) defaults of geoms 60 | if (!is.null(geoms)) { 61 | # number of geoms have to be the same as number of stats. 62 | if (length(geoms) != length(stats)) { 63 | stop("Grading error: number of geoms supplied don't match number of stats.") 64 | } 65 | # map user supplied geoms suffixes to actual class names 66 | geoms <- lapply(geoms, map_geom) 67 | stats <- lapply(seq_along(stats), function(s) { 68 | stats[[s]][["GEOM"]] <- geoms[[s]][["GEOM"]] 69 | stats[[s]] 70 | }) 71 | } 72 | pstats <- get_geoms_stats(p) 73 | if (exact) { 74 | return(identical(stats, pstats)) 75 | } else { 76 | return(all(stats %in% pstats)) 77 | } 78 | } 79 | 80 | #' Does a layer use a specific stat parameter? 81 | #' 82 | #' \code{uses_stat_param} is a mirror function of \code{uses_geom_param} but instead of checking a plot's 83 | #' geom layer, it checks that a plot's stat layer uses a specific stat parameter. 84 | #' 85 | #' To specify a specific stat layer, either specify using position using the \code{i} index or 86 | #' by using a combination of \code{stat} function suffix name and \code{i} to check the ith layer that 87 | #' uses the stat. 88 | #' 89 | #' @param p A ggplot object 90 | #' @param stat A character string found in the suffix of a ggplot2 stat function, 91 | #' e.g. \code{"bin"}. 92 | #' @param params A named list of stat or geom parameter values, e.g. \code{list(bins = 200)} 93 | #' @param i A numerical index, e.g. \code{1}. 94 | #' 95 | #' @return A boolean 96 | #' @export 97 | #' 98 | #' @examples 99 | #' require(ggplot2) 100 | #' p <- ggplot(diamonds, aes(carat)) + 101 | #' stat_bin(bins = 200) 102 | #' uses_stat_param(p, stat = "bin", params = list(bins = 200)) 103 | uses_stat_param <- function(p, stat, params, i = NULL) { 104 | stop_if_not_ggplot(p) 105 | layer <- get_stat_layer(p, stat = stat, i)$layer 106 | user_params <- names(params) 107 | # collect geom and stat parameters 108 | all_params <- c(layer$geom_params, layer$stat_params) 109 | p_params <- names(all_params) 110 | # check if user supplied invalid parameters 111 | invalid_params <- !(user_params %in% p_params) 112 | if (any(invalid_params)) { 113 | stop( 114 | "Grading error: the supplied parameters ", 115 | paste0("'", user_params[invalid_params], "'", collapse = ", "), " are invalid." 116 | ) 117 | } 118 | # check both the user parameters contained in plot's geom and stat parameters 119 | identical(params, all_params[user_params]) 120 | } 121 | 122 | #' Which stat is used in the ith layer? 123 | #' 124 | #' \code{ith_stat} returns the type of stat used by the ith layer. 125 | #' 126 | #' @param p A ggplot object 127 | #' @param i A numerical index that corresponds to the first layer of a plot (1), 128 | #' the second layer (2), and so on. 129 | #' 130 | #' @return A character string that corresponds to the suffix of a ggplot2 131 | #' \code{stat_} function, e.g. \code{"qq"}. 132 | #' 133 | #' @family functions for checking stats 134 | #' 135 | #' @export 136 | #' 137 | #' @examples 138 | #' require(ggplot2) 139 | #' p <- ggplot(data = diamonds, aes(sample = price)) + 140 | #' geom_qq() 141 | #' ith_stat(p, i = 1) 142 | ith_stat <- function(p, i) { 143 | stop_if_not_ggplot(p) 144 | stat <- class(p$layers[[i]]$stat)[1] 145 | gsub("stat", "", tolower(stat)) 146 | } 147 | 148 | #' Is the ith stat what it should be? 149 | #' 150 | #' \code{ith_stat_is} checks whether the ith layer uses the prescribed type of stat 151 | #' 152 | #' @param p A ggplot object 153 | #' @param stat A character string that corresponds to 154 | #' the suffix of a ggplot2 \code{stat_} function, e.g. \code{"identity"}. 155 | #' @param i A numerical index that corresponds to the first layer of a plot (1), 156 | #' the second layer (2), and so on. \code{ith_stat_is} will check the 157 | #' stat used by the ith layer. 158 | #' 159 | #' @return \code{TRUE} or \code{FALSE} 160 | #' 161 | #' @family functions for checking stats 162 | #' 163 | #' @export 164 | #' 165 | #' @examples 166 | #' require(ggplot2) 167 | #' p <- ggplot(data = diamonds, aes(sample = price)) + 168 | #' geom_qq() 169 | #' ith_stat_is(p, i = 1, "qq") 170 | ith_stat_is <- function(p, stat, i = 1) { 171 | stop_if_not_ggplot(p) 172 | stat_i <- ith_stat(p, i) 173 | stat_i == stat 174 | } 175 | -------------------------------------------------------------------------------- /R/geom_params.R: -------------------------------------------------------------------------------- 1 | #' Does a layer use one of more specific parameters? 2 | #' 3 | #' \code{uses_geom_params} checks that a plot's geom layer uses a specific parameter. 4 | #' 5 | #' To specify a specific geom layer, either specify using position using the \code{i} index or 6 | #' by using a combination of \code{geom} function suffix name and \code{i} to check the ith layer that 7 | #' uses the geom. 8 | #' 9 | #' The \code{params} argument accepts a list that contains geom, stat, or aes 10 | #' parameters. This offers flexibility in certain situations where setting a 11 | #' parameter on a \code{geom_} function is actually setting a stat parameter or 12 | #' aes parameter. For example, in \code{geom_histogram(binwidth = 500)}, the 13 | #' \code{binwidth} is a stat parameter, while in 14 | #' \code{geom_histogram(fill = "blue")}, the \code{fill} is an aes parameter. 15 | #' \code{uses_geom_params} will take this into account and check geom, stat, and 16 | #' aes parameters. 17 | #' 18 | #' Note that `uses_geom_params()` can detect aes _parameters_, but not aes 19 | #' _mappings_. Parameters are set to static values directly within a layer (e.g. 20 | #' `geom_point(color = "blue")`), while mappings associate variables in the data with plot aesthetics using 21 | #' [`aes()`][ggplot2::aes] (e.g. `geom_point(aes(color = class))`). 22 | #' 23 | #' @examples 24 | #' require(ggplot2) 25 | #' 26 | #' p <- ggplot(data = diamonds, aes(x = cut, y = price)) + 27 | #' geom_boxplot(varwidth = TRUE, outlier.alpha = 0.01, fill = "blue") 28 | #' 29 | #' uses_geom_params( 30 | #' p, "boxplot", list(varwidth = TRUE, outlier.alpha = 0.01, fill = "blue") 31 | #' ) 32 | #' 33 | #' uses_geom_params( 34 | #' p, "boxplot", varwidth = TRUE, outlier.alpha = 0.01, fill = "blue" 35 | #' ) 36 | #' 37 | #' # Unnamed arguments check that a parameter is set to any value 38 | #' uses_geom_params(p, "boxplot", "fill") 39 | #' @param p A ggplot object 40 | #' @param geom A character string found in the suffix of a ggplot2 geom function, 41 | #' e.g. \code{"point"}. 42 | #' @param ... <[`dynamic-dots`][rlang::dyn-dots]> 43 | #' Named values or [character] strings. 44 | #' Unnamed arguments will check whether any value was set for that parameter. 45 | #' Named arguments will check whether the parameter with the same name has a 46 | #' matching value. 47 | #' Each argument should have a name matching a [ggplot][ggplot2::ggplot] 48 | #' layer parameter. 49 | #' Values may be passed as arguments or as list elements. 50 | #' @param params A named list of geom or stat parameter values, e.g. 51 | #' \code{list(outlier.alpha = 0.01)}. 52 | #' This list is combined with any inputs to `...` 53 | #' @inheritParams get_geom_layer 54 | #' 55 | #' @return A named logical vector of the same length as the number of inputs 56 | #' to `...`. 57 | #' @family functions for checking geom parameters 58 | #' @export 59 | uses_geom_params <- function(p, geom, ..., params = NULL, i = NULL) { 60 | stop_if_not_ggplot(p) 61 | 62 | layer <- get_geom_layer(p, geom = geom, i = i)$layer 63 | 64 | params <- c(params, flatten_dots(...)) 65 | named <- names(params) != "" 66 | 67 | user_params <- names(params) 68 | user_params[!named] <- as.character(params[!named]) 69 | 70 | default_params <- purrr::map_lgl(params, inherits, ".default_param") 71 | params[default_params] <- purrr::map( 72 | names(params)[default_params], 73 | ~ unlist(unname(get_default_params(p, geom, ., i = i))) 74 | ) 75 | 76 | result <- logical(length(params)) 77 | names(result) <- user_params 78 | 79 | user_params[user_params == "color"] <- "colour" 80 | 81 | # Collect geom, stat, and aes parameters 82 | all_params <- c(layer$geom_params, layer$stat_params, layer$aes_params) 83 | 84 | # Add inherited default parameters 85 | get_default_params <- get_default_params(p, geom) 86 | inherited <- !names(get_default_params) %in% names(all_params) 87 | all_params_with_inherited <- c(all_params, get_default_params[inherited]) 88 | 89 | result[named] <- purrr::map2_lgl( 90 | params[named], all_params_with_inherited[user_params][named], identical 91 | ) 92 | result[!named] <- user_params[!named] %in% names(all_params) 93 | result 94 | } 95 | 96 | #' @rdname uses_geom_params 97 | #' @export 98 | uses_geom_param <- uses_geom_params 99 | 100 | #' What are the default parameters for a plot layer? 101 | #' 102 | #' @examples 103 | #' require(ggplot2) 104 | #' 105 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 106 | #' geom_smooth(aes(color = class)) 107 | #' 108 | #' # Returns the parameters the ggplot would use by default for a layer 109 | #' get_default_params(p, "smooth", "linetype") 110 | #' get_default_params(p, "smooth", c("se", "level")) 111 | #' get_default_params(p, "smooth") 112 | #' 113 | #' # If a parameter does not exist, returns NULL 114 | #' get_default_params(p, "smooth", "shape") 115 | #' 116 | #' # The colo(u)r aesthetic can be matched with or without a u 117 | #' get_default_params(p, "smooth", "color") 118 | #' get_default_params(p, "smooth", "colour") 119 | #' @inheritParams uses_geom_params 120 | #' @param params A [character] vector. 121 | #' `get_default_params()` returns the default parameter value with a name 122 | #' matching each string in `params`. 123 | #' If `params` is [`NULL`] (the default), the default values for 124 | #' all parameters are returned. 125 | #' 126 | #' @return A named [list] of the same length as `params`, or, if `params` is 127 | #' [`NULL`], a named list of default values for all parameters of `geom`. 128 | #' @family functions for checking geom parameters 129 | #' @export 130 | get_default_params <- function(p, geom, params = NULL, i = NULL) { 131 | stop_if_not_ggplot(p) 132 | 133 | layer <- get_geom_layer(p, geom = geom, i = i)$layer 134 | 135 | if (!is.character(params) && !is.null(params)) { 136 | stop( 137 | "`params` must be a character vector or `NULL`.", 138 | call. = FALSE 139 | ) 140 | } 141 | 142 | names(params) <- params 143 | params[params == "color"] <- "colour" 144 | 145 | snake_class <- utils::getFromNamespace("snake_class", "ggplot2") 146 | 147 | default_geom <- utils::getFromNamespace(snake_class(layer$geom), "ggplot2")() 148 | default_stat <- utils::getFromNamespace(snake_class(layer$stat), "ggplot2")() 149 | 150 | result <- c( 151 | default_geom$geom$default_aes, 152 | default_geom$geom_params, 153 | default_geom$stat_params, 154 | default_stat$geom$default_aes, 155 | default_stat$geom_params, 156 | default_stat$stat_params 157 | ) 158 | 159 | # Remove duplicate entries 160 | # (some params have the same default in geom_params and stat_params) 161 | result <- result[unique(names(result))] 162 | 163 | if (length(params)) { 164 | result <- result[params] 165 | names(result) <- names(params) 166 | } 167 | 168 | result 169 | } 170 | -------------------------------------------------------------------------------- /R/layers.R: -------------------------------------------------------------------------------- 1 | #' How many layers are in a plot? 2 | #' 3 | #' @param p A ggplot object 4 | #' 5 | #' @return Numeric. The number of layers. 6 | #' @export 7 | #' 8 | #' @examples 9 | #' require(ggplot2) 10 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 11 | #' geom_point(mapping = aes(color = class)) + 12 | #' geom_smooth() 13 | #' n_layers(p) 14 | n_layers <- function(p) { 15 | length(p$layers) 16 | } 17 | 18 | #' Isolate a layer from a plot 19 | #' 20 | #' \code{get_layer} returns a layer from a plot along with the global data sets 21 | #' and aesthetic mappings that the layer may inherit from. 22 | #' 23 | #' Users can specify a layer in several ways: 24 | #' 25 | #' \enumerate{ 26 | #' \item By order of appearance with \code{i}. The first layer to appear in the 27 | #' plot (the one drawn first, on the bottom) corresponds to \code{i = 1}. 28 | #' \item By type of geom with \code{geom}. \code{get_layer} will return the 29 | #' first layer that uses the geom. 30 | #' \item By a combination of \code{geom} and 31 | #' \code{i}. \code{get_layer} will return the ith layer that uses the geom. 32 | #' \item By type of stat with \code{stat}. \code{get_layer} will return the 33 | #' first layer that uses the stat 34 | #' \item By a combination of \code{stat} and 35 | #' \code{i}. \code{get_layer} will return the ith layer that uses the stat. 36 | #' } 37 | #' 38 | #' @param p A ggplot object 39 | #' @param geom A character string found in the suffix of a ggplot2 geom function, 40 | #' e.g. \code{"point"}. 41 | #' @param stat A character string found in the suffix of a ggplot2 stat function, 42 | #' e.g. \code{"bin"}. 43 | #' @param i A numerical index, e.g. \code{1}. 44 | #' 45 | #' @return An object with class \code{layer_to_check} to be manipulated further 46 | #' with ggcheck functions. 47 | #' 48 | #' @examples 49 | #' require(ggplot2) 50 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 51 | #' geom_point(mapping = aes(color = class)) + 52 | #' stat_smooth() 53 | #' 54 | #' get_layer(p, i = 1) 55 | #' get_layer(p, geom = "point") 56 | #' get_layer(p, stat = "smooth") 57 | #' @noRd 58 | get_layer <- function(p, geom = NULL, stat = NULL, i = NULL) { 59 | stop_if_not_ggplot(p) 60 | 61 | if (!is.null(geom) && !is.null(stat)) { 62 | stop("Grading error: cannot identify a layer with a combination of geom and stat name. Please pick one or the other.") 63 | } 64 | 65 | if (is.null(geom) && is.null(stat)) { 66 | # index is a position 67 | index <- i 68 | } else if (!is.null(geom)) { 69 | # index is a geom layer 70 | geom <- map_geom(geom)$GEOM 71 | if (is.null(i)) { 72 | index <- which(get_geoms(p) == geom)[1] 73 | } else { 74 | index <- which(get_geoms(p) == geom)[i] 75 | } 76 | } else if (!is.null(stat)) { 77 | # index is a stat layer 78 | stat <- map_stat(stat)$STAT 79 | if (is.null(i)) { 80 | index <- which(get_stats(p) == stat)[1] 81 | } else { 82 | index <- which(get_stats(p) == stat)[i] 83 | } 84 | } 85 | 86 | # index has to be valid 87 | if (index > length(p$layers)) { 88 | stop("Grading error: cannot find specified layer. Use checks to check that desired layer exists before inspecting the layer.") 89 | } 90 | 91 | l <- list( 92 | layer = p$layers[[index]], 93 | global_data = get_data(p), 94 | global_mapping = get_mappings(p) 95 | ) 96 | structure(l, class = "layer_to_check") 97 | } 98 | 99 | #' Isolate a geom layer from a plot 100 | #' 101 | #' \code{get_geom_layer} returns a geom layer from a plot along with the global data sets 102 | #' and aesthetic mappings that the layer may inherit from. 103 | #' 104 | #' Users can specify a layer in one of 3 ways: 105 | #' 106 | #' \enumerate{ 107 | #' \item By order of appearance with \code{i}. The first layer to appear in the 108 | #' plot (the one drawn first, on the bottom) corresponds to \code{i = 1}. 109 | #' \item By type of geom with \code{geom}. \code{get_geom_layer} will return the 110 | #' first layer that uses the geom. 111 | #' \item By a combination of \code{geom} and 112 | #' \code{i}. \code{get_geom_layer} will return the ith layer that uses the geom. 113 | #' } 114 | #' 115 | #' @param p A ggplot object 116 | #' @param geom A character string found in the suffix of a ggplot2 geom function, 117 | #' e.g. \code{"point"}. 118 | #' @param i A numerical index, e.g. \code{1}. 119 | #' 120 | #' @return An object with class \code{layer_to_check} to be manipulated further 121 | #' with ggcheck functions. 122 | #' @export 123 | #' 124 | #' @examples 125 | #' require(ggplot2) 126 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 127 | #' geom_point(color = "red") + 128 | #' geom_point(mapping = aes(color = class)) + 129 | #' geom_smooth(se = FALSE) 130 | #' 131 | #' get_geom_layer(p, i = 1) 132 | #' get_geom_layer(p, geom = "smooth") 133 | #' get_geom_layer(p, geom = "point", i = 2) 134 | get_geom_layer <- function(p, geom = NULL, i = NULL) { 135 | stop_if_not_ggplot(p) 136 | 137 | if (is.null(geom) && is.null(i)) { 138 | stop("Grading error: cannot identify which layer to grade. Please specify at least one of geom or i.") 139 | } 140 | 141 | get_layer(p, geom = geom, i = i) 142 | } 143 | 144 | #' Isolate a stat layer from a plot 145 | #' 146 | #' \code{get_stat_layer} returns a stat layer from a plot along with the global data sets 147 | #' and aesthetic mappings that the layer may inherit from. 148 | #' 149 | #' Users can specify a layer in one of 3 ways: 150 | #' 151 | #' \enumerate{ 152 | #' \item By order of appearance with \code{i}. The first layer to appear in the 153 | #' plot (the one drawn first, on the bottom) corresponds to \code{i = 1}. 154 | #' \item By type of stat with \code{stat}. \code{get_stat_layer} will return the 155 | #' first layer that uses the stat 156 | #' \item By a combination of \code{stat} and 157 | #' \code{i}. \code{get_stat_layer} will return the ith layer that uses the stat 158 | #' } 159 | #' 160 | #' @param p A ggplot object 161 | #' @param stat A character string found in the suffix of a ggplot2 stat function, 162 | #' e.g. \code{"bin"}. 163 | #' @param i A numerical index, e.g. \code{1}. 164 | #' 165 | #' @return An object with class \code{layer_to_check} to be manipulated further 166 | #' with ggcheck functions. 167 | #' @export 168 | #' 169 | #' @examples 170 | #' require(ggplot2) 171 | #' p <- ggplot(data = diamonds, aes(price)) + 172 | #' stat_bin(bins = 20, binwidth = 500) 173 | #' 174 | #' get_stat_layer(p, i = 1) 175 | #' get_stat_layer(p, stat = "bin") 176 | get_stat_layer <- function(p, stat = NULL, i = NULL) { 177 | stop_if_not_ggplot(p) 178 | 179 | if (is.null(stat) && is.null(i)) { 180 | stop("Grading error: cannot identify which layer to grade. Please specify at least one of stat or i.") 181 | } 182 | 183 | get_layer(p, stat = stat, i = i) 184 | } 185 | 186 | is_layer_to_check <- function(x) inherits(x, "layer_to_check") 187 | -------------------------------------------------------------------------------- /tests/testthat/test-mappings.R: -------------------------------------------------------------------------------- 1 | require(ggplot2, quietly = TRUE) 2 | 3 | p <- 4 | ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 5 | geom_point(mapping = aes(color = class)) + 6 | geom_smooth(se = FALSE) + 7 | labs(title = "TITLE", subtitle = "SUBTITLE", caption = "CAPTION") 8 | 9 | d2 <- head(mpg) 10 | 11 | p2 <- 12 | ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 13 | geom_point(data = d2, color = "red") + 14 | geom_point(mapping = aes(color = class)) + 15 | geom_smooth(se = FALSE) + 16 | labs(title = "TITLE", subtitle = "SUBTITLE", caption = "CAPTION") 17 | 18 | p3 <- 19 | ggplot(data = mpg, mapping = aes(x = displ)) + 20 | geom_point(mapping = aes(y = hwy, color = class, shape = drv)) + 21 | geom_smooth(mapping = aes(y = hwy, color = drv), se = FALSE) + 22 | labs(title = "TITLE", subtitle = "SUBTITLE", caption = "CAPTION") 23 | 24 | test_that("Identifies global mapping", { 25 | expect_equal( 26 | get_mappings(p), 27 | aes(x = displ, y = hwy), 28 | ignore_formula_env = TRUE 29 | ) 30 | }) 31 | 32 | test_that("Inherit local mappings that appear in all layers", { 33 | expect_equal( 34 | get_mappings(p3), 35 | aes(x = displ, y = hwy), 36 | ignore_formula_env = TRUE 37 | ) 38 | 39 | expect_equal( 40 | get_mappings(p3, local_only = TRUE), 41 | aes(x = displ), 42 | ignore_formula_env = TRUE 43 | ) 44 | 45 | # `x` is mapped globally in `ggplot()` 46 | expect_true(uses_mappings(p3, aes(x = displ))) 47 | expect_true(uses_mappings(p3, aes(x = displ), local_only = TRUE)) 48 | # `y` is mapped locally to the same value in each layer 49 | expect_true(uses_mappings(p3, aes(y = hwy))) 50 | expect_false(uses_mappings(p3, aes(y = hwy), local_only = TRUE)) 51 | # `color` is mapped locally to different values in each layer 52 | expect_false(uses_mappings(p3, aes(color = class))) 53 | expect_false(uses_mappings(p3, aes(color = drv))) 54 | # `shape` is only mapped in one layer 55 | expect_false(uses_mappings(p3, aes(shape = drv))) 56 | }) 57 | 58 | test_that("Checks whether mappings are used globally", { 59 | expect_true(uses_mappings(p, mappings = aes(x = displ, y = hwy))) 60 | expect_true(uses_mappings(p, mappings = aes(x = displ))) 61 | expect_false(uses_mappings(p, mappings = aes(x = hwy, y = displ))) 62 | expect_true(uses_mappings(p, mapping = aes(x = displ))) 63 | expect_true(uses_mappings(p, mapping = aes(y = hwy))) 64 | expect_false(uses_mappings(p, mapping = aes(x = hwy))) 65 | }) 66 | 67 | test_that("Identifies local mappings", { 68 | expect_equal( 69 | ith_mappings(p2, i = 1, local_only = FALSE), 70 | aes(x = displ, y = hwy), 71 | ignore_formula_env = TRUE 72 | ) 73 | expect_equal( 74 | ith_mappings(p2, i = 2, local_only = FALSE), 75 | aes(x = displ, y = hwy, color = class), 76 | ignore_formula_env = TRUE 77 | ) 78 | expect_equal( 79 | ith_mappings(p2, i = 1, local_only = TRUE), 80 | NULL 81 | ) 82 | expect_equal( 83 | ith_mappings(p2, i = 2, local_only = TRUE), 84 | aes(color = class), 85 | ignore_formula_env = TRUE 86 | ) 87 | }) 88 | 89 | test_that("Checks whether layer mappings exactly match", { 90 | expect_true( 91 | ith_mappings_use(p2, aes(x = displ, y = hwy, color = class), i = 2, local_only = FALSE, exact = TRUE) 92 | ) 93 | expect_true( 94 | ith_mappings_use(p2, aes(y = hwy, x = displ, color = class), i = 2, local_only = FALSE, exact = TRUE) 95 | ) 96 | expect_false( 97 | ith_mappings_use(p2, aes(x = displ, y = hwy), i = 2, local_only = TRUE, exact = TRUE) 98 | ) 99 | expect_false( 100 | ith_mappings_use(p2, aes(x = displ, y = hwy, color = class), i = 2, local_only = TRUE, exact = TRUE) 101 | ) 102 | expect_true( 103 | ith_mappings_use(p2, aes(color = class), i = 2, local_only = TRUE, exact = TRUE) 104 | ) 105 | }) 106 | 107 | test_that("Checks whether layer uses a mapping", { 108 | expect_true( 109 | ith_mappings_use(p2, aes(x = displ), i = 2, local_only = FALSE) 110 | ) 111 | expect_true( 112 | ith_mappings_use(p2, aes(color = class), i = 2, local_only = FALSE) 113 | ) 114 | expect_false( 115 | ith_mappings_use(p2, aes(x = displ), i = 2, local_only = TRUE) 116 | ) 117 | }) 118 | 119 | test_that("Checks whether layer uses extra mappings", { 120 | expect_true( 121 | uses_extra_mappings(p, aes(color = class), local_only = FALSE) 122 | ) 123 | # first geom_point does not use any extra mappings 124 | expect_false( 125 | uses_extra_mappings(get_geom_layer(p2, i = 1), aes(x = displ, y = hwy), local_only = FALSE) 126 | ) 127 | # but second geom_point does 128 | expect_true( 129 | uses_extra_mappings(get_geom_layer(p2, i = 2), aes(x = displ, y = hwy), local_only = FALSE) 130 | ) 131 | # and it does not have more than required 132 | expect_false( 133 | uses_extra_mappings(get_geom_layer(p2, i = 2), aes(x = displ, y = hwy, color = class), local_only = FALSE) 134 | ) 135 | }) 136 | 137 | test_that("Checks whether layer uses certain aesthetics", { 138 | # loose 139 | expect_true( 140 | uses_aesthetics(p, "x") 141 | ) 142 | expect_true( 143 | uses_aesthetics(p, c("x", "y")) 144 | ) 145 | # exact 146 | expect_false( 147 | uses_aesthetics(p, "x", exact = TRUE) 148 | ) 149 | # at the global layer, this is correct 150 | expect_true( 151 | uses_aesthetics(p, c("x", "y"), exact = TRUE) 152 | ) 153 | # at the local layer, this is false because it is missing the color aesthetic 154 | expect_false( 155 | uses_aesthetics(get_geom_layer(p, "point"), c("x", "y"), local_only = TRUE) 156 | ) 157 | # unless you want to include global layer via `local_only` = FALSE 158 | expect_true( 159 | uses_aesthetics(get_geom_layer(p, "point"), c("x", "y"), local_only = FALSE) 160 | ) 161 | # spelling of color vs colour should not matter 162 | expect_true( 163 | uses_aesthetics(get_geom_layer(p, "point"), c("x", "y", "colour"), local_only = TRUE) 164 | ) 165 | expect_true( 166 | uses_aesthetics(get_geom_layer(p, "point"), c("x", "y", "color"), local_only = TRUE) 167 | ) 168 | }) 169 | 170 | test_that("Aesthetics mapped to strings and column names are distinguished", { 171 | p3 <- 172 | ggplot(data = mpg, mapping = aes(x = displ, y = "hwy")) + 173 | geom_point(mapping = aes(color = "class")) 174 | # y = "hwy" should be different than y = hwy 175 | expect_false( 176 | uses_mappings(p3, mappings = aes(y = hwy)) 177 | ) 178 | expect_false( 179 | uses_mappings(p, mappings = aes(y = "hwy")) 180 | ) 181 | expect_true( 182 | uses_mappings(p3, mappings = aes(y = "hwy")) 183 | ) 184 | # should distinguish between strings 185 | expect_false( 186 | uses_mappings(p3, mappings = aes(y = "cty")) 187 | ) 188 | expect_false( 189 | ith_mappings_use(p3, mappings = aes(color = class), i = 1) 190 | ) 191 | expect_true( 192 | ith_mappings_use(p3, mappings = aes(color = "class"), i = 1) 193 | ) 194 | }) 195 | -------------------------------------------------------------------------------- /tests/testthat/test-geom_params.R: -------------------------------------------------------------------------------- 1 | require(ggplot2, quietly = TRUE) 2 | 3 | p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 4 | geom_point(mapping = aes(color = class)) + 5 | geom_smooth(se = FALSE) 6 | 7 | p3 <- ggplot(data = diamonds, aes(x = cut, y = price)) + 8 | geom_boxplot(varwidth = TRUE, outlier.alpha = 0.01) 9 | 10 | p4 <- ggplot(data = diamonds, aes(price)) + 11 | geom_histogram(bins = 20, binwidth = 500) 12 | 13 | p5 <- ggplot(data = diamonds, aes(price)) + 14 | geom_histogram(fill = "blue", color = "red") 15 | 16 | test_that("Checks whether a geom uses a specfic parameter value", { 17 | # check a default parameter 18 | expect_equal( 19 | uses_geom_params(p, geom = "smooth", params = list(na.rm = FALSE)), 20 | c(na.rm = TRUE) 21 | ) 22 | expect_equal( 23 | uses_geom_params(p, geom = "smooth", na.rm = FALSE), 24 | c(na.rm = TRUE) 25 | ) 26 | 27 | # check set parameters 28 | expect_equal( 29 | uses_geom_params(p, geom = "smooth", params = list(se = FALSE)), 30 | c(se = TRUE) 31 | ) 32 | expect_equal( 33 | uses_geom_params(p, geom = "smooth", se = FALSE), 34 | c(se = TRUE) 35 | ) 36 | 37 | expect_equal( 38 | uses_geom_params(p3, geom = "boxplot", params = list(varwidth = TRUE, outlier.alpha = 0.01)), 39 | c(varwidth = TRUE, outlier.alpha = TRUE) 40 | ) 41 | 42 | expect_equal( 43 | uses_geom_params(p3, geom = "boxplot", varwidth = TRUE, outlier.alpha = 0.01), 44 | c(varwidth = TRUE, outlier.alpha = TRUE) 45 | ) 46 | 47 | # check parameter of a geom which is a stat parameter 48 | expect_equal( 49 | uses_geom_params(p4, geom = "histogram", params = list(bins = 20, binwidth = 500)), 50 | c(bins = TRUE, binwidth = TRUE) 51 | ) 52 | expect_equal( 53 | uses_geom_params(p4, geom = "histogram", bins = 20, binwidth = 500), 54 | c(bins = TRUE, binwidth = TRUE) 55 | ) 56 | 57 | # check parameter of a geom which is an aes parameter 58 | expect_equal( 59 | uses_geom_params(p5, geom = "histogram", params = list(fill = "blue")), 60 | c(fill = TRUE) 61 | ) 62 | expect_equal( 63 | uses_geom_params(p5, geom = "histogram", fill = "blue"), 64 | c(fill = TRUE) 65 | ) 66 | expect_equal( 67 | uses_geom_params(p5, geom = "histogram", fill = "red"), 68 | c(fill = FALSE) 69 | ) 70 | }) 71 | 72 | test_that("uses_geom_param() alias", { 73 | # check a default parameter 74 | expect_equal( 75 | uses_geom_param(p, geom = "smooth", params = list(na.rm = FALSE)), 76 | c(na.rm = TRUE) 77 | ) 78 | expect_equal( 79 | uses_geom_param(p, geom = "smooth", na.rm = FALSE), 80 | c(na.rm = TRUE) 81 | ) 82 | 83 | # check set parameters 84 | expect_equal( 85 | uses_geom_param(p, geom = "smooth", params = list(se = FALSE)), 86 | c(se = TRUE) 87 | ) 88 | expect_equal( 89 | uses_geom_param(p, geom = "smooth", se = FALSE), 90 | c(se = TRUE) 91 | ) 92 | 93 | expect_equal( 94 | uses_geom_param(p3, geom = "boxplot", params = list(varwidth = TRUE, outlier.alpha = 0.01)), 95 | c(varwidth = TRUE, outlier.alpha = TRUE) 96 | ) 97 | 98 | expect_equal( 99 | uses_geom_param(p3, geom = "boxplot", varwidth = TRUE, outlier.alpha = 0.01), 100 | c(varwidth = TRUE, outlier.alpha = TRUE) 101 | ) 102 | 103 | # check parameter of a geom which is a stat parameter 104 | expect_equal( 105 | uses_geom_param(p4, geom = "histogram", params = list(bins = 20, binwidth = 500)), 106 | c(bins = TRUE, binwidth = TRUE) 107 | ) 108 | expect_equal( 109 | uses_geom_param(p4, geom = "histogram", bins = 20, binwidth = 500), 110 | c(bins = TRUE, binwidth = TRUE) 111 | ) 112 | 113 | # check parameter of a geom which is an aes parameter 114 | expect_equal( 115 | uses_geom_param(p5, geom = "histogram", params = list(fill = "blue")), 116 | c(fill = TRUE) 117 | ) 118 | expect_equal( 119 | uses_geom_param(p5, geom = "histogram", fill = "blue"), 120 | c(fill = TRUE) 121 | ) 122 | expect_equal( 123 | uses_geom_param(p5, geom = "histogram", fill = "red"), 124 | c(fill = FALSE) 125 | ) 126 | 127 | # support color and colour 128 | expect_equal( 129 | uses_geom_param(p5, geom = "histogram", color = "red"), 130 | c(color = TRUE) 131 | ) 132 | expect_equal( 133 | uses_geom_param(p5, geom = "histogram", colour = "red"), 134 | c(colour = TRUE) 135 | ) 136 | expect_equal( 137 | uses_geom_param(p5, geom = "histogram", color = "blue"), 138 | c(color = FALSE) 139 | ) 140 | expect_equal( 141 | uses_geom_param(p5, geom = "histogram", colour = "blue"), 142 | c(colour = FALSE) 143 | ) 144 | }) 145 | 146 | test_that("unnamed uses_geom_params", { 147 | expect_equal( 148 | uses_geom_params(p5, geom = "histogram", "fill"), 149 | c(fill = TRUE) 150 | ) 151 | expect_equal( 152 | uses_geom_params(p5, geom = "histogram", "color"), 153 | c(color = TRUE) 154 | ) 155 | expect_equal( 156 | uses_geom_params(p5, geom = "histogram", "colour"), 157 | c(colour = TRUE) 158 | ) 159 | expect_equal( 160 | uses_geom_params(p5, geom = "histogram", "linetype"), 161 | c(linetype = FALSE) 162 | ) 163 | expect_equal( 164 | uses_geom_params(p5, geom = "histogram", "fill", "color", "linetype"), 165 | c(fill = TRUE, color = TRUE, linetype = FALSE) 166 | ) 167 | expect_equal( 168 | uses_geom_params(p5, geom = "histogram", fill = "blue", "color", "linetype"), 169 | c(fill = TRUE, color = TRUE, linetype = FALSE) 170 | ) 171 | }) 172 | 173 | test_that("Return FALSE when checking an invalid geom parameter", { 174 | # typo 175 | expect_equal( 176 | uses_geom_param(p, geom = "smooth", params = list(see = FALSE)), 177 | c(see = FALSE) 178 | ) 179 | # invalid parameter for geom 180 | expect_equal( 181 | uses_geom_param(p3, geom = "boxplot", params = list(bins = 20, outlier.alpha = 0.01)), 182 | c(bins = FALSE, outlier.alpha = TRUE) 183 | ) 184 | expect_equal( 185 | uses_geom_param(p4, geom = "histogram", params = list(bins = 20, outlier.alpha = 0.01)), 186 | c(bins = TRUE, outlier.alpha = FALSE) 187 | ) 188 | # multiple invalid parameters 189 | expect_equal( 190 | uses_geom_param(p3, geom = "boxplot", params = list(varwidthh = TRUE, outlierr.alpha = 0.01)), 191 | c(varwidthh = FALSE, outlierr.alpha = FALSE) 192 | ) 193 | }) 194 | 195 | test_that("get_default_params()", { 196 | expect_equal( 197 | get_default_params(p, "point"), 198 | list( 199 | shape = 19, colour = "black", size = 1.5, fill = NA, alpha = NA, 200 | stroke = 0.5, na.rm = FALSE 201 | ) 202 | ) 203 | 204 | expect_equal(get_default_params(p, "point", "color"), list(color = "black")) 205 | 206 | expect_equal( 207 | get_default_params(p, "smooth", c("se", "level")), 208 | list(se = TRUE, level = 0.95) 209 | ) 210 | 211 | expect_equal( 212 | uses_geom_params( 213 | p, "smooth", se = default_param(), level = default_param() 214 | ), 215 | c(se = FALSE, level = TRUE) 216 | ) 217 | }) 218 | -------------------------------------------------------------------------------- /R/geoms.R: -------------------------------------------------------------------------------- 1 | #' List the geoms used by a plot 2 | #' 3 | #' \code{get_geoms} returns a vector of geom names, written as character 4 | #' strings, that describes which geoms in which order are used by a plot. 5 | #' 6 | #' @param p A ggplot object 7 | #' 8 | #' @return A vector of character strings. Each element corresponds to the suffix 9 | #' of a ggplot2 \code{geom_} function, e.g. \code{c("point", "line", "smooth")}. 10 | #' 11 | #' @family functions for checking geoms 12 | #' @export 13 | #' 14 | #' @examples 15 | #' require(ggplot2) 16 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 17 | #' geom_point(mapping = aes(color = class)) + 18 | #' geom_smooth() 19 | #' get_geoms(p) 20 | get_geoms <- function(p) { 21 | stop_if_not_ggplot(p) 22 | n <- n_layers(p) 23 | vapply(seq_len(n), ith_geom, character(1), p = p) 24 | } 25 | 26 | #' List the geom and stat combination used by all layers of a plot. 27 | #' 28 | #' @param p A ggplot object 29 | #' 30 | #' @return A list of lists with a GEOM and STAT character. 31 | #' e.g. list(list(GEOM = "point", STAT = "identity")) 32 | #' 33 | #' @family functions for checking geoms 34 | #' @export 35 | #' 36 | #' @examples 37 | #' require(ggplot2) 38 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 39 | #' geom_point(mapping = aes(color = class)) + 40 | #' geom_smooth() 41 | #' get_geoms_stats(p) 42 | get_geoms_stats <- function(p) { 43 | stop_if_not_ggplot(p) 44 | n <- n_layers(p) 45 | lapply(seq_len(n), ith_geom_stat, p = p) 46 | } 47 | 48 | #' Does a plot use one or more geoms? 49 | #' 50 | #' \code{use_geoms} tests whether a plot uses one or more geoms created using a \code{geom}. 51 | #' If checking for a layer that is created using a \code{stat} function, please use 52 | #' \code{uses_stats} instead. 53 | #' 54 | #' By default, the plot must have the exact geoms or geom/stat combinations and in the same order. 55 | #' However, if \code{exact} is set to \code{FALSE}, the plot geoms or geom/stat combinations do not have to be exact. 56 | #' 57 | #' @param p A ggplot object 58 | #' @param geoms A vector of character strings. Each element should correspond to 59 | #' the suffix of a ggplot2 \code{geom_} function, e.g. \code{c("point", 60 | #' "line", "smooth")}. 61 | #' @param exact A boolean to indicate whether to use exact matching 62 | #' @param stats A character vector to optionally check for the stats corresponding to geoms 63 | #' e.g. c("identity", "smooth") if checking c("point", "smooth") 64 | #' 65 | #' @return \code{TRUE} or \code{FALSE} 66 | #' 67 | #' @family functions for checking geoms 68 | #' @export 69 | #' 70 | #' @examples 71 | #' require(ggplot2) 72 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 73 | #' geom_point(mapping = aes(color = class)) + 74 | #' geom_smooth() 75 | #' uses_geoms(p, geoms = "point") 76 | #' uses_geoms(p, geoms = c("point", "smooth"), exact = TRUE) 77 | #' uses_geoms(p, geoms = c("point", "smooth"), stats = c("identity", "smooth")) 78 | uses_geoms <- function(p, geoms, stats = NULL, exact = TRUE) { 79 | stop_if_not_ggplot(p) 80 | # map the GEOM + STAT for the instructor's target geoms 81 | geoms <- lapply(geoms, map_geom) 82 | # if stats is specified override the STAT(s) defaults of geoms 83 | if (!is.null(stats)) { 84 | # number of stats have to be the same as number of geoms 85 | if (length(stats) != length(geoms)) { 86 | stop("Grading error: number of stats supplied don't match number of geoms.") 87 | } 88 | # map user supplied stats suffixes to actual class names 89 | stats <- lapply(stats, map_stat) 90 | geoms <- lapply(seq_along(geoms), function(g) { 91 | geoms[[g]][["STAT"]] <- stats[[g]][["STAT"]] 92 | geoms[[g]] 93 | }) 94 | } 95 | # extract the GEOM + STAT for the plot 96 | pgeoms <- get_geoms_stats(p) 97 | if (exact) { 98 | return(identical(geoms, pgeoms)) 99 | } else { 100 | return(all(geoms %in% pgeoms)) 101 | } 102 | } 103 | 104 | #' Which geom is used in the ith layer? 105 | #' 106 | #' \code{ith_geom} returns the type of geom used by the ith layer. 107 | #' 108 | #' @param p A ggplot object 109 | #' @param i A numerical index that corresponds to the first layer of a plot (1), 110 | #' the second layer (2), and so on. 111 | #' 112 | #' @return A character string that corresponds to the suffix of a ggplot2 113 | #' \code{geom_} function, e.g. \code{"point"}. 114 | #' 115 | #' @family functions for checking geoms 116 | #' @export 117 | #' 118 | #' @examples 119 | #' require(ggplot2) 120 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 121 | #' geom_point(mapping = aes(color = class)) + 122 | #' geom_smooth() 123 | #' ith_geom(p, i = 2) 124 | ith_geom <- function(p, i) { 125 | stop_if_not_ggplot(p) 126 | geom <- class(p$layers[[i]]$geom)[1] 127 | gsub("geom", "", tolower(geom)) 128 | } 129 | 130 | #' Which geom/stat combination is used in the ith layer? 131 | #' 132 | #' \code{ith_geom_stat} returns the type of geom used by the ith layer 133 | #' according to a geom/stat combination. 134 | #' 135 | #' @param p A ggplot object 136 | #' @param i A numerical index that corresponds to the first layer of a plot (1), 137 | #' the second layer (2), and so on. 138 | #' @return A list of lists with a GEOM and STAT strings, each corresponding to the suffix of a ggplot2 139 | #' \code{geom_} function (e.g. \code{"point"}), and \code{stat_} function (e.g. \code{"identity"}). 140 | #' e.g. list(list(GEOM = "point", STAT = "identity")) 141 | #' 142 | #' @family functions for checking geoms 143 | #' @export 144 | #' 145 | #' @examples 146 | #' require(ggplot2) 147 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 148 | #' geom_point(mapping = aes(color = class)) + 149 | #' geom_smooth() 150 | #' ith_geom_stat(p, i = 2) 151 | ith_geom_stat <- function(p, i) { 152 | stop_if_not_ggplot(p) 153 | # extract geom/stat classes 154 | geom_class <- gsub("geom", "", tolower(class(p$layers[[i]]$geom)[1])) 155 | stat_class <- gsub("stat", "", tolower(class(p$layers[[i]]$stat)[1])) 156 | # return combination 157 | geom_stat( 158 | geom = geom_class, 159 | stat = stat_class 160 | ) 161 | } 162 | 163 | #' Is the ith geom what it should be? 164 | #' 165 | #' \code{ith_geom_is} checks whether the ith layer uses the prescribed type of geom. 166 | #' 167 | #' @param p A ggplot object 168 | #' @param geom A character string that corresponds to 169 | #' the suffix of a ggplot2 \code{geom_} function, e.g. \code{"point"}. 170 | #' @param i A numerical index that corresponds to the first layer of a plot (1), 171 | #' the second layer (2), and so on. \code{ith_geom_is} will check the 172 | #' geom used by the ith layer. 173 | #' 174 | #' @return \code{TRUE} or \code{FALSE} 175 | #' 176 | #' @family functions for checking geoms 177 | #' 178 | #' @export 179 | #' 180 | #' @examples 181 | #' require(ggplot2) 182 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 183 | #' geom_point(mapping = aes(color = class)) + 184 | #' geom_smooth() 185 | #' ith_geom_is(p, geom = "smooth", i = 2) 186 | ith_geom_is <- function(p, geom, i = 1) { 187 | stop_if_not_ggplot(p) 188 | geom_i <- ith_geom(p, i) 189 | geom_i == geom 190 | } 191 | -------------------------------------------------------------------------------- /R/data.R: -------------------------------------------------------------------------------- 1 | is_empty_data <- function(d) { 2 | identical(d, structure(list(), class = "waiver")) 3 | } 4 | 5 | get_global_data_from_layer <- function(l) { 6 | stopifnot(is_layer_to_check(l)) 7 | 8 | data <- l$global_data 9 | 10 | if (is_empty_data(data)) { 11 | return(NULL) 12 | } 13 | 14 | data 15 | } 16 | 17 | #' Get the data set used by a plot or layer 18 | #' 19 | #' \code{get_data} returns the data set used by a ggplot object or a single 20 | #' layer extracted from the object with \code{\link{get_geom_layer}}. 21 | #' 22 | #' When passed a ggplot object (i.e. a plot), \code{get_data} will return only 23 | #' the data that has been set globally with \code{\link[ggplot2]{ggplot}}. 24 | #' 25 | #' When passed a single layer from a plot, the behavior of \code{get_data} will 26 | #' depend on the \code{local_only} argument passed to \code{...}. If 27 | #' \code{local_only = TRUE}, \code{get_data} will return only the data set, if 28 | #' any, that was defined locally in the function that created the layer. If 29 | #' \code{local_only = FALSE}, \code{get_data} will return the data used by the 30 | #' layer, whether or not that data was defined globally in 31 | #' \code{\link[ggplot2]{ggplot}} or locally. 32 | #' 33 | #' @param p A ggplot object or a layer extracted from a ggplot object with 34 | #' \code{\link{get_geom_layer}}. 35 | #' @param local_only \code{TRUE} or \code{FALSE}. Should \code{get_data} onbly 36 | #' return data defined locally in the layer? 37 | #' 38 | #' @return A data frame. If no data set is found, \code{get_data} returns 39 | #' \code{NULL} 40 | #' 41 | #' @family functions for checking data 42 | #' 43 | #' @export 44 | #' 45 | #' @examples 46 | #' require(ggplot2) 47 | #' d2 <- head(mpg) 48 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 49 | #' geom_point(data = d2, color = "red") + 50 | #' geom_point() 51 | #' get_data(p) 52 | #' get_data(get_geom_layer(p, i = 1)) 53 | get_data <- function(p, local_only = FALSE) { 54 | UseMethod("get_data") 55 | } 56 | 57 | #' @export 58 | get_data.ggplot <- function(p, local_only = FALSE) { 59 | p$data 60 | } 61 | 62 | #' @export 63 | get_data.layer_to_check <- function(p, local_only = FALSE) { 64 | data <- p$layer$data 65 | 66 | # if no local data 67 | if (is_empty_data(data)) { 68 | if (local_only) { 69 | return(NULL) 70 | } else { 71 | return(get_global_data_from_layer(p)) 72 | } 73 | } 74 | 75 | data 76 | } 77 | 78 | 79 | #' Does a plot or layer use the correct data set? 80 | #' 81 | #' \code{uses_data} checks whether the data set used by a plot or layer matches 82 | #' the data set provided. 83 | #' 84 | #' When passed a ggplot object (i.e. a plot), \code{uses_data} will check only 85 | #' the data that has been set globally with \code{\link[ggplot2]{ggplot}}. 86 | #' 87 | #' When passed a single layer from a plot, the behavior of \code{uses_data} will 88 | #' depend on the \code{local_only} argument passed to \code{...}. If 89 | #' \code{local_only = TRUE}, \code{uses_data} will check only the data set, if 90 | #' any, that was defined locally in the function that created the layer. If 91 | #' \code{local_only = FALSE}, \code{uses_data} will check the data used by the 92 | #' layer, whether or not that data was defined globally in 93 | #' \code{\link[ggplot2]{ggplot}} or locally. 94 | #' 95 | #' @param p A ggplot object or a layer extracted from a ggplot object with 96 | #' \code{\link{get_geom_layer}}. 97 | #' @param data A data frame 98 | #' @param local_only \code{TRUE} or \code{FALSE}. See the details. 99 | #' 100 | #' @return A data frame. 101 | #' 102 | #' @family functions for checking data 103 | #' 104 | #' @export 105 | #' 106 | #' @examples 107 | #' require(ggplot2) 108 | #' d2 <- head(mpg) 109 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 110 | #' geom_point(data = d2, color = "red") + 111 | #' geom_point() 112 | #' uses_data(p, mpg) 113 | #' uses_data(get_geom_layer(p, i = 1), data = head(mpg)) 114 | uses_data <- function(p, data, local_only = FALSE) { 115 | identical(data, get_data(p, local_only)) 116 | } 117 | 118 | #' Which data set does the ith layer use? 119 | #' 120 | #' \code{ith_data} returns the data set used by the ith layer. 121 | #' 122 | #' If \code{local_only = TRUE}, \code{ith_data} returns the data set, 123 | #' if any, that was defined locally in the function that created the ith layer. 124 | #' If \code{local_only = FALSE}, \code{ith_data} returns the data used by 125 | #' the ith layer, whether or not that data was defined globally in 126 | #' \code{\link[ggplot2]{ggplot}} or locally. 127 | #' 128 | #' Functions that use the \code{ith_} prefix are designed to eliminate the need 129 | #' to call \code{get_geom_layer} to check a specific layer in a plot, e.g. \code{p 130 | #' %>% get_geom_layer(geom = "point") %>% get_data()}. 131 | #' 132 | #' @param p A ggplot object or a layer extracted from a ggplot object with 133 | #' \code{\link{get_geom_layer}}. 134 | #' @param i A numerical index that corresponds to the first layer of a plot (1), 135 | #' the second layer (2), and so on. 136 | #' @param local_only \code{TRUE} or \code{FALSE}. See the details. 137 | #' 138 | #' @return A data frame. If no data set is found, \code{ith_data} returns \code{NULL}. 139 | #' 140 | #' @family functions for checking data 141 | #' 142 | #' @export 143 | #' 144 | #' @examples 145 | #' require(ggplot2) 146 | #' d2 <- head(mpg) 147 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 148 | #' geom_point(data = d2, color = "red") + 149 | #' geom_point() 150 | #' ith_data(p, i = 1) 151 | ith_data <- function(p, i, local_only = FALSE) { 152 | get_data(get_geom_layer(p, i = i), local_only) 153 | } 154 | 155 | #' Does the ith layer use the correct data set? 156 | #' 157 | #' \code{ith_data_is} checks whether the student uses the supplied data set for 158 | #' the ith layer of their plot. 159 | #' 160 | #' Functions that use the \code{ith_} prefix are designed to eliminate the need 161 | #' to call \code{get_geom_layer} to check a specific layer in a plot, e.g. \code{p 162 | #' %>% get_geom_layer(geom = "point") %>% uses_data(mpg)}. 163 | #' 164 | #' If \code{local_only = TRUE}, \code{ith_data_is} will check only the data set, 165 | #' if any, that was defined locally in the function that created the ith layer. 166 | #' If \code{local_only = FALSE}, \code{ith_data_is} will check the data used by 167 | #' the ith layer, whether or not that data was defined globally in 168 | #' \code{\link[ggplot2]{ggplot}} or locally. 169 | #' 170 | #' @param p A ggplot object or a layer extracted from a ggplot object with 171 | #' \code{\link{get_geom_layer}}. 172 | #' @param data A data frame 173 | #' @param i A numerical index that corresponds to the first layer of a plot (1), 174 | #' the second layer (2), and so on. 175 | #' @param local_only \code{TRUE} or \code{FALSE}. See the details. 176 | #' 177 | #' @return \code{TRUE} or \code{FALSE} 178 | #' 179 | #' @family functions for checking data 180 | #' 181 | #' @export 182 | #' 183 | #' @examples 184 | #' require(ggplot2) 185 | #' d2 <- head(mpg) 186 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 187 | #' geom_point(data = d2, color = "red") + 188 | #' geom_point() 189 | #' ith_data_is(p, data = head(mpg), i = 1) 190 | ith_data_is <- function(p, data, i, local_only = FALSE) { 191 | identical(data, ith_data(p, i, local_only)) 192 | } 193 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | # ggplot2 default mappings from a `geom_` function suffix to geom and stat class names when 2 | # creating a layer using a `geom_` function. 3 | # NOTE: this could be dynamically generated as well but would require extra dependency of {sf} package 4 | geom_lookup <- data.frame( 5 | geom = c( 6 | "abline", 7 | "hline", 8 | "vline", 9 | "bar", 10 | "col", 11 | "bin2d", 12 | "blank", 13 | "boxplot", 14 | "contour", 15 | "contour_filled", 16 | "count", 17 | "density", 18 | "density2d", 19 | "density2d_filled", 20 | "dotplot", 21 | "errorbarh", 22 | "function", 23 | "hex", 24 | "freqpoly", 25 | "histogram", 26 | "jitter", 27 | "crossbar", 28 | "errorbar", 29 | "linerange", 30 | "pointrange", 31 | "map", 32 | "path", 33 | "line", 34 | "step", 35 | "point", 36 | "polygon", 37 | "qq_line", 38 | "qq", 39 | "quantile", 40 | "ribbon", 41 | "area", 42 | "rug", 43 | "segment", 44 | "curve", 45 | "smooth", 46 | "spoke", 47 | "label", 48 | "text", 49 | "raster", 50 | "rect", 51 | "tile", 52 | "violin", 53 | "sf", 54 | "sf_label", 55 | "sf_text" 56 | ), 57 | GEOM = c( 58 | "abline", 59 | "hline", 60 | "vline", 61 | "bar", 62 | "col", 63 | "bin2d", 64 | "blank", 65 | "boxplot", 66 | "contour", 67 | "contourfilled", 68 | "point", 69 | "density", 70 | "density2d", 71 | "density2dfilled", 72 | "dotplot", 73 | "errorbarh", 74 | "function", 75 | "hex", 76 | "path", 77 | "bar", 78 | "point", 79 | "crossbar", 80 | "errorbar", 81 | "linerange", 82 | "pointrange", 83 | "map", 84 | "path", 85 | "line", 86 | "step", 87 | "point", 88 | "polygon", 89 | "path", 90 | "point", 91 | "quantile", 92 | "ribbon", 93 | "area", 94 | "rug", 95 | "segment", 96 | "curve", 97 | "smooth", 98 | "spoke", 99 | "label", 100 | "text", 101 | "raster", 102 | "rect", 103 | "tile", 104 | "violin", 105 | "sf", 106 | "label", 107 | "text" 108 | ), 109 | STAT = c( 110 | "identity", 111 | "identity", 112 | "identity", 113 | "count", 114 | "identity", 115 | "bin2d", 116 | "identity", 117 | "boxplot", 118 | "contour", 119 | "contourfilled", 120 | "sum", 121 | "density", 122 | "density2d", 123 | "density2dfilled", 124 | "bindot", 125 | "function", 126 | "identity", 127 | "binhex", 128 | "bin", 129 | "bin", 130 | "identity", 131 | "identity", 132 | "identity", 133 | "identity", 134 | "identity", 135 | "identity", 136 | "identity", 137 | "identity", 138 | "identity", 139 | "identity", 140 | "identity", 141 | "qqline", 142 | "qq", 143 | "quantile", 144 | "identity", 145 | "identity", 146 | "identity", 147 | "identity", 148 | "identity", 149 | "smooth", 150 | "identity", 151 | "identity", 152 | "identity", 153 | "identity", 154 | "identity", 155 | "identity", 156 | "ydensity", 157 | "sf", 158 | "sfcoordinates", 159 | "sfcoordinates" 160 | ), 161 | stringsAsFactors = FALSE 162 | ) 163 | 164 | # ggplot2 default mappings from a `stat_` function suffix to geom and stat class names when 165 | # creating a layer using a `stat_` function. 166 | # NOTE: this could be dynamically generated as well and would not require any extra dependencies 167 | stat_lookup <- data.frame( 168 | stat = c( 169 | "bin", 170 | "bin_2d", 171 | "bin_hex", 172 | "bin2d", 173 | "binhex", 174 | "boxplot", 175 | "contour", 176 | "contour_filled", 177 | "count", 178 | "density", 179 | "density_2d", 180 | "density_2d_filled", 181 | "density2d", 182 | "density2d_filled", 183 | "ecdf", 184 | "ellipse", 185 | "function", 186 | "identity", 187 | "qq", 188 | "qq_line", 189 | "quantile", 190 | "sf", 191 | "sf_coordinates", 192 | "smooth", 193 | "spoke", 194 | "sum", 195 | "summary", 196 | "summary_2d", 197 | "summary_bin", 198 | "summary_hex", 199 | "summary2d", 200 | "unique", 201 | "ydensity" 202 | ), 203 | GEOM = c( 204 | "bar", 205 | "tile", 206 | "hex", 207 | "tile", 208 | "hex", 209 | "boxplot", 210 | "contour", 211 | "contourfilled", 212 | "bar", 213 | "area", 214 | "density2d", 215 | "density2dfilled", 216 | "density2d", 217 | "density2dfilled", 218 | "step", 219 | "path", 220 | "function", 221 | "point", 222 | "point", 223 | "path", 224 | "quantile", 225 | "rect", 226 | "point", 227 | "smooth", 228 | "spoke", 229 | "point", 230 | "pointrange", 231 | "tile", 232 | "pointrange", 233 | "hex", 234 | "tile", 235 | "point", 236 | "violin" 237 | ), 238 | STAT = c( 239 | "bin", 240 | "bin2d", 241 | "binhex", 242 | "bin2d", 243 | "binhex", 244 | "boxplot", 245 | "contour", 246 | "contourfilled", 247 | "count", 248 | "density", 249 | "density2d", 250 | "density2dfilled", 251 | "density2d", 252 | "density2dfilled", 253 | "ecdf", 254 | "ellipse", 255 | "function", 256 | "identity", 257 | "qq", 258 | "qqline", 259 | "quantile", 260 | "sf", 261 | "sfcoordinates", 262 | "smooth", 263 | "identity", 264 | "sum", 265 | "summary", 266 | "summary2d", 267 | "summarybin", 268 | "summaryhex", 269 | "summary2d", 270 | "unique", 271 | "ydensity" 272 | ), 273 | stringsAsFactors = FALSE 274 | ) 275 | 276 | #' Helper function to create the GEOM_STAT list structure 277 | #' 278 | #' @param geom A character (e.g. "point") 279 | #' @param stat A character (e.g. "qq") 280 | #' 281 | #' @return list structure with "GEOM_STAT" class 282 | #' 283 | #' @examples 284 | #' geom_stat(geom = "point", stat = "qq") 285 | #' @noRd 286 | geom_stat <- function(geom, stat) { 287 | structure( 288 | list(GEOM = geom, STAT = stat), 289 | class = "GEOM_STAT" 290 | ) 291 | } 292 | 293 | #' Given a geom_ function suffix (e.g. "point"), \code{map_geom} returns the ggplot2 294 | #' geom/stat class names. using the \code{geom_lookup} table. 295 | #' 296 | #' @param geom A character (e.g. "point") 297 | #' 298 | #' @return a \code{GEOM_STAT} list structure 299 | #' 300 | #' @examples 301 | #' map_geom("qq") 302 | #' @noRd 303 | map_geom <- function(geom) { 304 | # check if the geom suffix does not exist 305 | if (!(geom %in% geom_lookup$geom)) { 306 | stop("Grading error: the supplied geom '", geom, "' does not exist.") 307 | } 308 | # GEOM + STAT combination 309 | geom_stat( 310 | geom = geom_lookup$GEOM[which(geom_lookup$geom == geom)], 311 | stat = geom_lookup$STAT[which(geom_lookup$geom == geom)] 312 | ) 313 | } 314 | 315 | #' Given a stat_ function suffix (e.g. "qq"), \code{map_stat} returns the ggplot2 316 | #' geom/stat class names using the \code{stat_lookup} table. 317 | #' 318 | #' @param stat A character (e.g. "qq") 319 | #' 320 | #' @return a \code{GEOM_STAT} list structure 321 | #' 322 | #' @examples 323 | #' map_stat("qq") 324 | #' @noRd 325 | map_stat <- function(stat) { 326 | # check if the stat suffix does not exist 327 | if (!(stat %in% stat_lookup$stat)) { 328 | stop("Grading error: the supplied stat '", stat, "' does not exist.") 329 | } 330 | # GEOM + STAT combination 331 | geom_stat( 332 | geom = stat_lookup$GEOM[which(stat_lookup$stat == stat)], 333 | stat = stat_lookup$STAT[which(stat_lookup$stat == stat)] 334 | ) 335 | } 336 | 337 | flatten_dots <- function(...) { 338 | args <- rlang::flatten(rlang::dots_list(...)) 339 | args <- rlang::dots_list(!!!args, .homonyms = "error") 340 | args 341 | } 342 | 343 | all_identical <- function(.l) { 344 | if (length(.l) < 2) { 345 | return(TRUE) 346 | } 347 | 348 | for (i in seq_along(.l)[-1]) { 349 | if (!identical(.l[[i - 1]], .l[[i]])) { 350 | return(FALSE) 351 | } 352 | } 353 | 354 | TRUE 355 | } 356 | -------------------------------------------------------------------------------- /R/labels.R: -------------------------------------------------------------------------------- 1 | #' List the labels used by a plot 2 | #' 3 | #' `get_labels()` returns a named [list] of [labels][ggplot2::labs], 4 | #' written as [character] strings, indicating which labels are used by a plot. 5 | #' 6 | #' Note that `get_labels()` will return [`NULL`] if a label is explicitly set to 7 | #' [`NULL`] ***or*** if a requested aesthetic is not present in the plot. 8 | #' 9 | #' @examples 10 | #' require(ggplot2) 11 | #' 12 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 13 | #' geom_point(mapping = aes(color = class)) + 14 | #' geom_smooth() + 15 | #' labs(x = "Weight", y = "MPG", color = NULL) 16 | #' 17 | #' get_labels(p) 18 | #' get_labels(p, c("x", "y")) 19 | #' 20 | #' # The colo(u)r aesthetic can be matched with or without a u 21 | #' get_labels(p, "color") 22 | #' get_labels(p, "colour") 23 | #' @param p A [ggplot][ggplot2::ggplot] object 24 | #' @param aes If `aes` is a [character] vector, returns only the labels 25 | #' corresponding to the included aesthetics. 26 | #' Defaults to [`NULL`], which returns all labels. 27 | #' 28 | #' @return A named list of character strings. 29 | #' 30 | #' @family functions for checking labels 31 | #' @export 32 | get_labels <- function(p, aes = NULL) { 33 | stop_if_not_ggplot(p) 34 | 35 | if (is.null(aes)) {return(p$labels)} 36 | 37 | label_names <- aes 38 | label_names[aes == "color"] <- "colour" 39 | 40 | result <- p$labels[label_names] 41 | 42 | # Restore names from inputs so spelling of "colo(u)r" matches 43 | names(result) <- aes 44 | 45 | result 46 | } 47 | 48 | #' Does a plot use one or more labels? 49 | #' 50 | #' `uses_labels()` tests whether a plot uses one or more [labels][ggplot2::labs]. 51 | #' 52 | #' Note that `uses_labels()` will match [`NULL`] if a label is explicitly set to 53 | #' [`NULL`] ***or*** if a requested aesthetic is not present in the plot. 54 | #' 55 | #' @examples 56 | #' require(ggplot2) 57 | #' 58 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 59 | #' geom_point(mapping = aes(color = class, shape = drv)) + 60 | #' geom_smooth() + 61 | #' labs(title = "My plot", x = "Weight", y = "MPG", color = NULL) 62 | #' 63 | #' # Unnamed arguments check if a label is set for the given aesthetic 64 | #' uses_labels(p, "title", "subtitle", "x", "y") 65 | #' 66 | #' # The check will return TRUE for labels set to NULL 67 | #' uses_labels(p, "color") 68 | #' 69 | #' # The check will return TRUE for aesthetics with default labels 70 | #' uses_labels(p, "shape") 71 | #' 72 | #' # Named arguments check if the label matches an expected value 73 | #' uses_labels(p, x = "Weight") 74 | #' uses_labels(p, x = "Weight", y = "MPG", color = NULL) 75 | #' 76 | #' # You can check for default labels with default_label() 77 | #' uses_labels(p, shape = default_label(), x = default_label()) 78 | #' 79 | #' # The colo(u)r aesthetic can be matched with or without a u 80 | #' uses_labels(p, color = NULL) 81 | #' uses_labels(p, colour = NULL) 82 | #' 83 | #' # Inputs can be passed from a list, with or without the !!! operator 84 | #' label_list <- list(x = "Weight", y = "MPG", color = NULL) 85 | #' uses_labels(p, label_list) 86 | #' uses_labels(p, !!!label_list) 87 | #' @param p A ggplot object 88 | #' @param ... <[`dynamic-dots`][rlang::dyn-dots]> 89 | #' [Character][character] strings. 90 | #' Unnamed arguments will check whether a label exists for that aesthetic. 91 | #' Named arguments will check whether the aesthetic with the same name 92 | #' has a label with a matching value. 93 | #' Each argument should have a matching [ggplot][ggplot2::ggplot] 94 | #' [aesthetic][ggplot2::aes] or [label][ggplot2::labs]. 95 | #' Strings may be input as individual arguments or as list elements. 96 | #' 97 | #' @return A named logical vector of the same length as the number of inputs 98 | #' to `...`. 99 | #' 100 | #' @family functions for checking labels 101 | #' @export 102 | uses_labels <- function(p, ...) { 103 | stop_if_not_ggplot(p) 104 | 105 | args <- flatten_dots(...) 106 | 107 | if (length(args) == 0) { 108 | stop( 109 | "You must pass an argument to `...` in `uses_labels()`.", 110 | call. = FALSE 111 | ) 112 | } 113 | 114 | default_labels <- purrr::map_lgl(args, inherits, ".default_label") 115 | 116 | args[default_labels] <- purrr::map( 117 | names(args)[default_labels], ~ unlist(get_default_labels(p, .)) 118 | ) 119 | 120 | if (!all(is_scalar_string_or_null(args))) { 121 | stop( 122 | "All inputs to `...` must be character vectors of length 1 or `NULL`.", 123 | call. = FALSE 124 | ) 125 | } 126 | 127 | if (is.null(names(args))) { 128 | names(args) <- rep("", length(args)) 129 | named <- rep(FALSE, length(args)) 130 | } else { 131 | named <- names(args) != "" 132 | } 133 | 134 | result <- logical(length(args)) 135 | result[!named] <- check_labels_set(p, args[!named]) 136 | result[named] <- check_labels_match(p, args[named]) 137 | 138 | # Ensure names of result vector match names in `...`: 139 | # - Names of inputs for named inputs 140 | # - Values of inputs for unnamed inputs 141 | names(result) <- coalesce_chr(names(args), args) 142 | 143 | result 144 | } 145 | 146 | #' What is the default label for a plot aesthetic? 147 | #' 148 | #' @examples 149 | #' require(ggplot2) 150 | #' 151 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 152 | #' geom_point(mapping = aes(color = class, shape = drv)) + 153 | #' geom_smooth() + 154 | #' labs(title = "My plot", x = "Weight", y = "MPG", color = NULL) 155 | #' 156 | #' # Returns the label the ggplot would create by default for an aesthetic 157 | #' get_default_labels(p, "x") 158 | #' get_default_labels(p, c("x", "y")) 159 | #' get_default_labels(p) 160 | #' 161 | #' # If an aesthetic does not exist, returns NULL 162 | #' get_default_labels(p, "size") 163 | #' 164 | #' # Non-aesthetic labels have no default value, so they also return NULL 165 | #' get_default_labels(p, "title") 166 | #' get_default_labels(p, "comment") 167 | #' 168 | #' # The colo(u)r aesthetic can be matched with or without a u 169 | #' get_default_labels(p, "color") 170 | #' get_default_labels(p, "colour") 171 | #' @param p A [ggplot][ggplot2::ggplot] object 172 | #' @param aes If `aes` is a [character] vector, returns only the default labels 173 | #' (based on the plot `p`) that correspond to the included aesthetics. 174 | #' Defaults to [`NULL`], which returns the default values of all labels. 175 | #' 176 | #' @return A named [list] in which each element is a [character] string 177 | #' or [`NULL`]. 178 | #' Strings are returned for aesthetics with a default value. 179 | #' [`NULL`] is returned for aesthetics that do not exist in the plot, 180 | #' or non-aesthetic labels that do not have a default value, like `title`. 181 | #' 182 | #' @family functions for checking labels 183 | #' @export 184 | get_default_labels <- function(p, aes = NULL) { 185 | stop_if_not_ggplot(p) 186 | 187 | if (is.null(aes)) { 188 | aes <- names(p$labels) 189 | } 190 | 191 | if (!is.character(aes)) { 192 | rlang::abort("`aes` must be a character vector or NULL.") 193 | } 194 | 195 | names(aes) <- aes 196 | 197 | aes[aes == "color"] <- "colour" 198 | 199 | make_labels <- utils::getFromNamespace("make_labels", "ggplot2") 200 | 201 | purrr::map( 202 | aes, 203 | function(aes) { 204 | # If an aesthetic exists in multiple layers, ggplot gives it a default 205 | # label based on the lowest level of the plot in which it appears 206 | 207 | # First check if the aesthetic exists in the base plot, 208 | # and return that label if it does 209 | if (!is.null(p$mapping[[aes]])) { 210 | return(as.character(make_labels(p$mapping[aes]))) 211 | } 212 | 213 | # Then check if the aesthetic exists in any layer, 214 | # and return the label for the lowest layer is it does 215 | for (layer in p$layers) { 216 | if (!is.null(layer$mapping[[aes]])) { 217 | return(as.character(make_labels(layer$mapping[aes]))) 218 | } 219 | } 220 | 221 | # If the aesthetic doesn't exist in the base plot or any layer, 222 | # its default label is `NULL` 223 | # (this always applies to non-aesthetic labels, like `title`) 224 | NULL 225 | } 226 | ) 227 | } 228 | 229 | check_labels_set <- function(p, labels) { 230 | if (!length(labels)) { 231 | return(logical(0)) 232 | } 233 | 234 | labels <- as.character(labels) 235 | labels[labels == "color"] <- "colour" 236 | 237 | labels %in% names(p$labels) 238 | } 239 | 240 | check_labels_match <- function(p, label_values) { 241 | if (!length(label_values)) { 242 | return(logical(0)) 243 | } 244 | 245 | plot_labels <- get_labels(p, names(label_values)) 246 | 247 | purrr::map2_lgl( 248 | label_values, plot_labels, 249 | ~ isTRUE(all.equal(as.character(.x), as.character(.y))) 250 | ) 251 | } 252 | 253 | is_scalar_string_or_null <- function(x) { 254 | vapply( 255 | x, 256 | function(x) rlang::is_scalar_character(x) || length(x) == 0, 257 | logical(1) 258 | ) 259 | } 260 | 261 | coalesce_chr <- function(x, y) { 262 | x[x == ""] <- y[x == ""] 263 | x 264 | } 265 | -------------------------------------------------------------------------------- /R/mappings.R: -------------------------------------------------------------------------------- 1 | #' Are aesthetic mapping specifications "identical"? 2 | #' 3 | #' The ggplot2 package uses quosures to record aesthetic mappings. These record 4 | #' both the mapping described as well as the environment in which the mapping 5 | #' was described. As a result, it is difficult to compare mappings created by 6 | #' students in one environment to mappings created on the fly by graders in 7 | #' another environment. \code{identical_aes} facilitates comparison by ignoring 8 | #' the environments associated with an aesthetic mapping specification. If the 9 | #' two specifications contain identical expressions, e.g. \code{x = displ}, 10 | #' etc., \code{identical_aes} returns \code{TRUE}. 11 | #' 12 | #' @param a1 The output of \code{\link[ggplot2]{aes}}, perhaps extracted from a ggplot object. 13 | #' @param a2 The output of \code{\link[ggplot2]{aes}}, perhaps extracted from a ggplot object. 14 | #' 15 | #' @return \code{TRUE} or \code{FALSE} 16 | #' 17 | #' @family functions for checking mappings 18 | #' 19 | #' @export 20 | identical_aes <- function(a1, a2) { 21 | # strip environments associated with the aesthetics before comparing 22 | a1 <- lapply(a1, deparse) 23 | a2 <- lapply(a2, deparse) 24 | identical(a1, a2) 25 | } 26 | 27 | aes_c <- function(a1, a2) { 28 | # override the a1 aesthetics with the a2 aesthetics 29 | # NOTE: this is used internally for `get_mappings.layer_to_check` when 30 | # retrieving the aesthetics for a particular layer by overriding global aesthetics. 31 | aesthetics <- names(a2) 32 | a1[aesthetics] <- a2 33 | a1 34 | } 35 | 36 | #' Get aesthetic mappings from a layer or plot 37 | #' 38 | #' \code{get_mappings} returns the mappings used by a ggplot object or a single 39 | #' layer extracted from the object with \code{\link{get_geom_layer}} or \code{\link{get_stat_layer}}. 40 | #' 41 | #' When passed a ggplot object (i.e. a plot), \code{get_mappings} will return 42 | #' only the mappings that have been set globally with 43 | #' \code{\link[ggplot2]{ggplot}}. When passed a single layer from a plot, the 44 | #' behavior of \code{get_mappings} will depend on the value of 45 | #' \code{local_only}. If \code{local_only = TRUE}, \code{get_mappings} will 46 | #' return only the mappings defined locally in a layer. When \code{local_only = 47 | #' FALSE}, \code{get_mappings} will return the combination of global and local 48 | #' methods that will be used to plot a layer. 49 | #' 50 | #' @param p A ggplot object or a layer extracted from a ggplot object with 51 | #' \code{\link{get_geom_layer}} or \code{\link{get_stat_layer}}. 52 | #' @param local_only \code{TRUE} or \code{FALSE}. Should \code{get_mappings} 53 | #' return only the mappings defined locally in a layer. This has no effect 54 | #' when \code{p} is a ggplot object. 55 | #' 56 | #' @return A list with class uneval, as returned by \code{\link[ggplot2]{aes}} 57 | #' Components of the list are either quosures or constants. 58 | #' 59 | #' @family functions for checking mappings 60 | #' 61 | #' @export 62 | #' 63 | #' @examples 64 | #' require(ggplot2) 65 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 66 | #' geom_point(mapping = aes(color = class)) 67 | #' get_mappings(p) 68 | #' get_mappings(get_geom_layer(p, i = 1), local_only = FALSE) 69 | get_mappings <- function(p, local_only = FALSE) { 70 | UseMethod("get_mappings") 71 | } 72 | 73 | #' @export 74 | get_mappings.ggplot <- function(p, local_only = FALSE) { 75 | global_map <- p$mapping 76 | 77 | if (local_only) { 78 | return(global_map) 79 | } 80 | 81 | layer_maps <- purrr::map(p$layers, "mapping") 82 | 83 | if (length(layer_maps) < 1) { 84 | return(global_map) 85 | } 86 | 87 | layer_names <- purrr::reduce(purrr::map(layer_maps, names), intersect) 88 | 89 | if (length(layer_names) < 1) { 90 | return(global_map) 91 | } 92 | 93 | layer_names <- purrr::set_names(layer_names) 94 | 95 | layer_maps_ubiquitous <- purrr::map(layer_names, function(name) { 96 | # If the aesthetic has the same value across all layers, return its 97 | # value in the first layer; otherwise return NULL 98 | if (all_identical(purrr::map(layer_maps, name))) { 99 | layer_maps[[1]][[name]] 100 | } 101 | }) 102 | 103 | aes_map <- c(global_map, purrr::compact(layer_maps_ubiquitous)) 104 | class(aes_map) <- "uneval" 105 | aes_map 106 | } 107 | 108 | #' @export 109 | get_mappings.layer_to_check <- function(p, local_only = FALSE) { 110 | local_mappings <- p$layer$mapping 111 | if (local_only) { 112 | return(local_mappings) 113 | } else { 114 | return(aes_c(p$global_mapping, local_mappings)) 115 | } 116 | } 117 | 118 | #' Does a plot or layer use one or more mappings? 119 | #' 120 | #' \code{uses_mappings} checks whether the student used one or more mappings in 121 | #' their plot. By default, \code{uses_mappings} ignores whether or not the student 122 | #' also supplied additional mappings. Use \code{uses_extra_mappings} to check if they did. 123 | #' If \code{exact} is \code{TRUE}, then all of the mappings have to match exactly. 124 | #' 125 | #' @param p A ggplot object or a layer extracted from a ggplot object with 126 | #' \code{\link{get_geom_layer}} or \code{\link{get_stat_layer}}. 127 | #' @param mappings One or more aesthetic mappings created with 128 | #' \code{\link[ggplot2]{aes}}. 129 | #' @param local_only If \code{TRUE}, \code{uses_mappings} will check only the 130 | #' mappings defined locally in a layer for the presence of \code{mappings}. If 131 | #' \code{FALSE}, \code{uses_mappings} will check for \code{mappings} in the 132 | #' combination of global and local methods that will be used to plot a layer. 133 | #' @param exact If \code{TRUE}, mappings need to be mapped exactly 134 | #' 135 | #' @return A logical value. 136 | #' 137 | #' @family functions for checking mappings 138 | #' 139 | #' @export 140 | #' 141 | #' @examples 142 | #' require(ggplot2) 143 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 144 | #' geom_point(mapping = aes(color = class)) 145 | #' uses_mappings(p, aes(x = displ)) 146 | #' uses_mappings(get_geom_layer(p, i = 1), aes(x = displ, color = class), local_only = FALSE) 147 | #' uses_mappings(get_geom_layer(p, i = 1), aes(x = displ, color = class), local_only = TRUE) 148 | #' uses_mappings(p, aes(x = displ, y = hwy), exact = TRUE) 149 | uses_mappings <- function(p, mappings, local_only = FALSE, exact = FALSE) { 150 | aes_map <- get_mappings(p, local_only) 151 | mapping_names <- names(mappings) 152 | if (exact) { 153 | return(identical_aes(mappings, get_mappings(p, local_only))) 154 | } else { 155 | return( 156 | all(mapping_names %in% names(aes_map)) && identical_aes(mappings, aes_map[mapping_names]) 157 | ) 158 | } 159 | } 160 | 161 | #' Does the plot uses extra aesthetic mappings? 162 | #' 163 | #' \code{uses_extra_mappings} checks if a student's plot contains more than the 164 | #' required aesthetic mappings. Note that we still return \code{TRUE} if 165 | #' the student's plot differs from the required aesthetic mappings because they 166 | #' are technically extra mappings from required set. We recommend you use 167 | #' \code{uses_mapping} checks for checking required mappings before \code{uses_extra_mappings}. 168 | #' 169 | #' @param p A ggplot object or a layer extracted from a ggplot object with 170 | #' \code{\link{get_geom_layer}} or \code{\link{get_stat_layer}}. 171 | #' @param mappings One or more aesthetic mappings created with 172 | #' \code{\link[ggplot2]{aes}}. 173 | #' @param local_only If \code{TRUE}, \code{uses_extra_mappings} will check only the 174 | #' mappings defined locally in a layer for the presence of \code{mappings}. If 175 | #' \code{FALSE}, \code{uses_extra_mappings} will check for \code{mappings} in the 176 | #' combination of global and local methods that will be used to plot a layer. 177 | #' 178 | #' @return A logical value. 179 | #' @export 180 | #' 181 | #' @examples 182 | #' require(ggplot2) 183 | #' p <- ggplot(data = diamonds, aes(x = cut, sample = price)) + 184 | #' geom_qq() 185 | #' uses_extra_mappings(p, aes(sample = price)) 186 | uses_extra_mappings <- function(p, mappings, local_only = FALSE) { 187 | aes_map <- get_mappings(p, local_only) 188 | aes_names <- names(aes_map) 189 | mapping_names <- names(mappings) 190 | # the plot has any variables beyond target mappings 191 | any(!(aes_names %in% mapping_names)) 192 | } 193 | 194 | #' Does a plot use one or more aesthetics? 195 | #' 196 | #' \code{uses_aesthetics} checks whether the student used one or more aesthetics. 197 | #' 198 | #' By default, \code{uses_aesthetics} requires that only one of the 199 | #' aesthetics need to be used. Set \code{exact} to \code{TRUE} to check if all of 200 | #' the variables have to be matched exactly. 201 | #' 202 | #' @param p A ggplot object or a layer extracted from a ggplot object with 203 | #' \code{\link{get_geom_layer}} or \code{\link{get_stat_layer}}.. 204 | #' @param aesthetics character vector of variables to check for, e.g. "x" or c("x") 205 | #' @param exact If \code{TRUE}, variables need to be mapped exactly 206 | #' @param local_only \code{TRUE} or \code{FALSE}. Should \code{uses_aesthetics} only 207 | #' return mappings defined locally in the layer? 208 | #' 209 | #' @return A logical value. 210 | #' @export 211 | #' 212 | #' @examples 213 | #' require(ggplot2) 214 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 215 | #' geom_point(mapping = aes(color = class)) 216 | #' uses_aesthetics(p, "x") 217 | #' uses_aesthetics(p, c("x", "y")) 218 | #' uses_aesthetics(get_geom_layer(p, "point"), c("x", "y", "color"), local_only = TRUE) 219 | #' uses_aesthetics(get_geom_layer(p, "point"), c("x", "y"), local_only = FALSE) 220 | uses_aesthetics <- function(p, aesthetics, local_only = FALSE, exact = FALSE) { 221 | pmaps_names <- names(get_mappings(p, local_only = local_only)) 222 | # NOTE: ggplot2 seems to switch aesthetic color to colour, so we standardize it to 'color' 223 | pmaps_names[which(pmaps_names == "colour")] <- "color" 224 | aesthetics[which(aesthetics == "colour")] <- "color" 225 | if (exact) { 226 | return(identical(aesthetics, pmaps_names)) 227 | } else { 228 | return(any(aesthetics %in% pmaps_names)) 229 | } 230 | } 231 | 232 | #' Return the aesthetic mappings used by the ith layer 233 | #' 234 | #' \code{ith_mappings} returns the mappings used by a ggplot object or a single 235 | #' layer extracted from the object with \code{\link{get_geom_layer}} or \code{\link{get_stat_layer}}. 236 | #' 237 | #' Functions that use the \code{ith_} prefix are 238 | #' designed to eliminate the need to call \code{get_layer} to check a specific 239 | #' layer in a plot, e.g. \code{p %>% get_geom_layer(geom = "point") %>% get_mappings()}. 240 | #' 241 | #' @param p A ggplot object or a layer extracted from a ggplot object with 242 | #' \code{\link{get_geom_layer}} or \code{\link{get_stat_layer}}. 243 | #' @param i A numerical index that corresponds to the first layer of a plot (1), 244 | #' the second layer (2), and so on. \code{ith_mappings_use} will check the 245 | #' aesthetics used by the ith layer. 246 | #' @param local_only If \code{TRUE}, \code{ith_mappings_use} will check only the 247 | #' mappings defined locally in a layer for the presence of \code{mappings}. If 248 | #' \code{FALSE}, \code{ith_mappings_use} will check for \code{mappings} in the 249 | #' combination of global and local methods that will be used to plot a layer. 250 | #' 251 | #' @return A list with class uneval, as returned by \code{\link[ggplot2]{aes}} 252 | #' Components of the list are either quosures or constants. 253 | #' 254 | #' @family functions for checking mappings 255 | #' 256 | #' @export 257 | #' 258 | #' @examples 259 | #' require(ggplot2) 260 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 261 | #' geom_point(mapping = aes(color = class)) + 262 | #' geom_smooth() 263 | #' ith_mappings(p, i = 1, local_only = FALSE) 264 | #' ith_mappings(p, i = 1, local_only = TRUE) 265 | #' ith_mappings(p, i = 2, local_only = FALSE) 266 | ith_mappings <- function(p, i, local_only = FALSE) { 267 | stop_if_not_ggplot(p) 268 | get_mappings(get_layer(p, i = i), local_only) 269 | } 270 | 271 | #' Does the ith layer use one or more aesthetic mappings? 272 | #' 273 | #' \code{ith_mappings_use} checks whether the student uses the supplied mappings 274 | #' in the ith layer of their plot. 275 | #' 276 | #' \code{ith_mappings_use} ignores whether or not the student supplied 277 | #' additional mappings as well. Functions that use the \code{ith_} prefix are 278 | #' designed to eliminate the need to call \code{get_layer} to check a specific 279 | #' layer in a plot, e.g. \code{p %>% get_geom_layer(geom = "point") %>% 280 | #' uses_mappings(aes(color = class))}. 281 | #' 282 | #' @param p A ggplot object or a layer extracted from a ggplot object with 283 | #' \code{\link{get_geom_layer}} or \code{\link{get_stat_layer}}. 284 | #' @param mappings One or more aesthetic mappings created with 285 | #' \code{\link[ggplot2]{aes}}. 286 | #' @param i A numerical index that corresponds to the first layer of a plot (1), 287 | #' the second layer (2), and so on. \code{ith_mappings_use} will check the 288 | #' aesthetics used by the ith layer. 289 | #' @param local_only If \code{TRUE}, \code{ith_mappings_use} will check only the 290 | #' mappings defined locally in a layer for the presence of \code{mappings}. If 291 | #' \code{FALSE}, \code{ith_mappings_use} will check for \code{mappings} in the 292 | #' combination of global and local methods that will be used to plot a layer. 293 | #' @param exact If \code{TRUE}, mappings need to be mapped exactly 294 | #' 295 | #' @return A logical value 296 | #' 297 | #' @family functions for checking mappings 298 | #' 299 | #' @export 300 | #' 301 | #' @examples 302 | #' require(ggplot2) 303 | #' p <- ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 304 | #' geom_point(mapping = aes(color = class)) + 305 | #' geom_smooth() 306 | #' ith_mappings_use(p, i = 1, aes(x = displ), local_only = FALSE) 307 | #' ith_mappings_use(p, i = 1, aes(x = displ), local_only = TRUE) 308 | #' ith_mappings_use(p, i = 2, aes(x = displ, y = hwy), local_only = FALSE) 309 | ith_mappings_use <- function(p, mappings, i, local_only = FALSE, exact = FALSE) { 310 | layer <- get_layer(p, i = i) 311 | aes_map <- get_mappings(layer, local_only) 312 | if (exact) { 313 | return(identical_aes(mappings, aes_map)) 314 | } else { 315 | return( 316 | all(names(mappings) %in% names(aes_map)) && 317 | identical_aes(mappings, aes_map[names(mappings)]) 318 | ) 319 | } 320 | } 321 | --------------------------------------------------------------------------------