├── .github ├── .gitignore └── workflows │ ├── pkgdown.yaml │ ├── test-coverage.yaml │ ├── R-CMD-check.yaml │ ├── R-CMD-check-ggplot2-upstream.yaml │ └── pr-commands.yaml ├── vignettes ├── .gitignore └── ggside_aes_mapping.Rmd ├── LICENSE ├── inst ├── figures │ └── ggside.png └── WORDLIST ├── tests ├── testthat │ ├── Rplots.pdf │ ├── test_non_aes_mapping_legend.R │ ├── test_ops_meaningful.R │ ├── test_continuous_date_axis.R │ ├── test_vdiff_irisScatter.R │ ├── test_ggside_extended_themes.R │ ├── test_FacetNull_ggside_themes.R │ ├── test_add_gg.R │ ├── test_FacetWrap_ggside_themes.R │ ├── test_FacetGrid_ggside_themes.R │ ├── test_vdiff_diamondplots.R │ ├── test_ggside_axis_polts.R │ ├── test_axis_render_position.R │ ├── test_ggside_respect_labels.R │ ├── test_ggside_classes.R │ ├── _snaps │ │ └── ggside_axis_polts │ │ │ └── base-plot.svg │ └── test_ggside_scales.R └── testthat.R ├── man ├── figures │ ├── README-example-1.png │ ├── README-example-mix-scales-1.png │ └── README-example-side-themes-1.png ├── ggside_layout.Rd ├── scale_yfill.Rd ├── is_ggside.Rd ├── ggside_geom.Rd ├── ggside-deprecated.Rd ├── scale_ycolour.Rd ├── as_ggside.Rd ├── ggside-scales.Rd ├── ggside-ggproto-coord.Rd ├── ggside-package.Rd ├── scale_xfill.Rd ├── class_definitions.Rd ├── scale_xcolour.Rd ├── ggside-ggproto-facets.Rd ├── yside.Rd ├── xside.Rd ├── ggside-ggproto-geoms.Rd ├── position_rescale.Rd ├── ggside-options.Rd ├── ggside_layer.Rd ├── stat_summarise.Rd ├── ggside-scales-discrete.Rd └── geom_xsidepoint.Rd ├── .travis.yml ├── .gitignore ├── pkgdown └── _pkgdown.yml ├── R ├── ggside-package.r ├── geom-sidecol.r ├── geom-sidepath.r ├── geom-sidevline.r ├── geom-sidehline.r ├── geom-sidetext.r ├── geom-sidefreqpoly.r ├── ggside-ggproto.r ├── geom-sidelabel.r ├── geom-sideline.r ├── geom-sideabline.r ├── geom-sidehistogram.r ├── z-depricated.R ├── utils-ggproto.R ├── utils-constructors.R ├── geom-sidepoint.r ├── geom-sidedensity.r ├── geom-sidetile.r ├── geom-sidesegment.r ├── geom-sidebar.r ├── all_classes.r ├── geom-sideboxplot.r ├── ggplot_add.R ├── utils-calls.R ├── utils-ggplot2-reimpl-facet.R ├── geom-sideviolin.r ├── plot-construction.R ├── update_ggplot.R ├── geom-sidefunction.r ├── add_gg.R ├── utils-.R ├── utils-side-coord.R ├── side-layout-.r ├── side-facet_.R └── scales-xyfill.R ├── .Rbuildignore ├── ggside.Rproj ├── cran-comments.md ├── LICENSE.md ├── generate_ggside_hexsticker.R ├── DESCRIPTION ├── README.Rmd ├── README.md └── NAMESPACE /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2021 2 | COPYRIGHT HOLDER: ggside authors 3 | -------------------------------------------------------------------------------- /inst/figures/ggside.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jtlandis/ggside/HEAD/inst/figures/ggside.png -------------------------------------------------------------------------------- /tests/testthat/Rplots.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jtlandis/ggside/HEAD/tests/testthat/Rplots.pdf -------------------------------------------------------------------------------- /man/figures/README-example-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jtlandis/ggside/HEAD/man/figures/README-example-1.png -------------------------------------------------------------------------------- /man/figures/README-example-mix-scales-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jtlandis/ggside/HEAD/man/figures/README-example-mix-scales-1.png -------------------------------------------------------------------------------- /man/figures/README-example-side-themes-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jtlandis/ggside/HEAD/man/figures/README-example-side-themes-1.png -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # R for travis: see documentation at https://docs.travis-ci.com/user/languages/r 2 | 3 | language: R 4 | r: 5 | - release 6 | - devel 7 | cache: packages 8 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | doc 6 | Meta 7 | inst/doc 8 | revdep/** 9 | /doc/ 10 | /Meta/ 11 | .Rprofile 12 | README.qmd 13 | README_files/** 14 | -------------------------------------------------------------------------------- /pkgdown/_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://jtlandis.github.io/ggside 2 | 3 | title: ggside 4 | 5 | template: 6 | bootstrap: 5 7 | 8 | authors: 9 | Justin Landis: 10 | href: https://github.com/jtlandis 11 | -------------------------------------------------------------------------------- /R/ggside-package.r: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | 4 | 5 | #' @import ggplot2 6 | #' @importFrom ggplot2 ggplot_add guide_gengrob 7 | #' @import scales 8 | #' @import grid 9 | #' @import gtable 10 | #' @import rlang 11 | #' @importFrom vctrs vec_ptype2 vec_rbind data_frame 12 | #' @importFrom glue glue glue_collapse 13 | #' @importFrom stats setNames 14 | NULL 15 | -------------------------------------------------------------------------------- /man/ggside_layout.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/side-layout-.r 3 | \name{ggside_layout} 4 | \alias{ggside_layout} 5 | \title{Construct ggside layout} 6 | \usage{ 7 | ggside_layout(layout) 8 | } 9 | \arguments{ 10 | \item{layout}{a ggproto Layout object} 11 | } 12 | \description{ 13 | Creates a new layout object required for ggside functionality 14 | } 15 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | #^doc$ 4 | ^Meta$ 5 | ggside.Rmd 6 | cran-comments.md 7 | README.Rmd 8 | README.qmd 9 | README_files/* 10 | ^LICENSE\.md$ 11 | generate_ggside_hexsticker.R 12 | example-gganimate.R 13 | examples/* 14 | ^doc$ 15 | ^docs$ 16 | ^pkgdown$ 17 | examples.r 18 | Generate_Data.R 19 | ^\.travis\.yml$ 20 | revdep 21 | revdep/* 22 | ^\.github$ 23 | ^revdep$ 24 | ^CRAN-SUBMISSION$ 25 | -------------------------------------------------------------------------------- /ggside.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 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /man/scale_yfill.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scales-xyfill.R 3 | \name{scale_yfill_hue} 4 | \alias{scale_yfill_hue} 5 | \alias{scale_yfill_manual} 6 | \alias{scale_yfill_gradient} 7 | \alias{scale_yfill_discrete} 8 | \alias{scale_yfill_continuous} 9 | \title{scale_yfill_hue} 10 | \description{ 11 | scale_yfill_hue 12 | 13 | scale_yfill_manual 14 | 15 | scale_yfill_gradient 16 | 17 | scale_yfill_discrete 18 | 19 | scale_yfill_continuous 20 | } 21 | -------------------------------------------------------------------------------- /man/is_ggside.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggside.R 3 | \name{is_ggside} 4 | \alias{is_ggside} 5 | \alias{is_ggside_layer} 6 | \alias{is_ggside_options} 7 | \alias{is_ggside_scale} 8 | \title{Check ggside objects} 9 | \usage{ 10 | is_ggside(x) 11 | 12 | is_ggside_layer(x) 13 | 14 | is_ggside_options(x) 15 | 16 | is_ggside_scale(x) 17 | } 18 | \arguments{ 19 | \item{x}{Object to test} 20 | } 21 | \value{ 22 | A logical value 23 | } 24 | \description{ 25 | Check ggside objects 26 | } 27 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(ggplot2) 3 | library(ggside) 4 | 5 | if ((nzchar(Sys.getenv("CI")) || 6 | !nzchar(Sys.getenv("NOT_CRAN"))) && 7 | identical(Sys.getenv("VDIFFR_RUN_TESTS"), 'false')) { 8 | #if we are running tests remotely AND 9 | # we are opting out of using vdiffr 10 | # assigning a dummy function 11 | 12 | expect_doppelganger <- function(...) { 13 | testthat::skip("`VDIFFR_RUN_TESTS` set to false on this remote check") 14 | } 15 | } else { 16 | expect_doppelganger <- vdiffr::expect_doppelganger 17 | } 18 | 19 | test_check("ggside") 20 | -------------------------------------------------------------------------------- /man/ggside_geom.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/constructor-.R 3 | \name{ggside_geom} 4 | \alias{ggside_geom} 5 | \title{ggside geom constructor} 6 | \usage{ 7 | ggside_geom(class_name = NULL, geom = NULL, side = NULL, ...) 8 | } 9 | \arguments{ 10 | \item{class_name}{New class name for the ggproto object} 11 | 12 | \item{geom}{The Geom ggproto to inherit from} 13 | 14 | \item{side}{should the resulting object be configured for x or y} 15 | 16 | \item{...}{additional members to add to the ggproto class.} 17 | } 18 | \description{ 19 | utility function to make a ggside Geom 20 | } 21 | -------------------------------------------------------------------------------- /R/geom-sidecol.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include constructor-.R 3 | NULL 4 | ### INCLUDE END 5 | #' @rdname geom_xsidebar 6 | #' @export 7 | geom_xsidecol <- ggside_layer_function(fun = geom_col, side = "x") 8 | 9 | #' @rdname ggside-ggproto-geoms 10 | #' @usage NULL 11 | #' @format NULL 12 | #' @export 13 | GeomXsidecol <- ggside_geom("GeomXsidecol", GeomCol, "x") 14 | 15 | #' @rdname geom_xsidebar 16 | #' @export 17 | geom_ysidecol <- ggside_layer_function(fun = geom_col, side = "y", orientation = "y") 18 | 19 | #' @rdname ggside-ggproto-geoms 20 | #' @usage NULL 21 | #' @format NULL 22 | #' @export 23 | GeomYsidecol <- ggside_geom("GeomYsidecol", GeomCol, "y") 24 | -------------------------------------------------------------------------------- /R/geom-sidepath.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include constructor-.R 3 | NULL 4 | ### INCLUDE END 5 | #' @rdname geom_xsideline 6 | #' @export 7 | geom_xsidepath <- ggside_layer_function(fun = geom_path, side = "x") 8 | 9 | #' @rdname ggside-ggproto-geoms 10 | #' @usage NULL 11 | #' @format NULL 12 | #' @export 13 | GeomXsidepath <- ggside_geom("GeomXsidepath", GeomPath, "x") 14 | 15 | 16 | #' @rdname geom_xsideline 17 | #' @export 18 | geom_ysidepath <- ggside_layer_function(fun = geom_path, side = "y") 19 | 20 | #' @rdname ggside-ggproto-geoms 21 | #' @usage NULL 22 | #' @format NULL 23 | #' @export 24 | GeomYsidepath <- ggside_geom("GeomYsidepath", GeomPath, "y") 25 | -------------------------------------------------------------------------------- /tests/testthat/test_non_aes_mapping_legend.R: -------------------------------------------------------------------------------- 1 | library(vdiffr) 2 | 3 | test_that('params aes are not in legend', { 4 | p <- ggplot(iris, aes(x = Sepal.Length, y = Petal.Width)) + 5 | geom_point(color = "grey") + 6 | geom_smooth(aes(color = Species), formula = y ~ x, method = "lm", se = FALSE) 7 | 8 | p2 <- p + geom_xsidedensity(aes(x = Sepal.Length, y = after_stat(density)), color = "blue") 9 | p3 <- p + geom_xsidedensity(aes(x = Sepal.Length, y = after_stat(density)), xcolor = "red") 10 | 11 | expect_doppelganger("Base Plot", p) 12 | expect_doppelganger("non-aes-color-blue", p2) 13 | expect_doppelganger("non-aes-xcolor-red", p3) 14 | }) 15 | 16 | 17 | 18 | -------------------------------------------------------------------------------- /R/geom-sidevline.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include constructor-.R 3 | NULL 4 | ### INCLUDE END 5 | #' @aliases geom_*vline 6 | #' @rdname geom_xsideabline 7 | #' @export 8 | geom_xsidevline <- ggside_layer_function(fun = geom_vline, side = "x") 9 | 10 | #' @rdname geom_xsideabline 11 | #' @export 12 | geom_ysidevline <- ggside_layer_function(fun = geom_vline, side = "y") 13 | 14 | #' @rdname ggside-ggproto-geoms 15 | #' @format NULL 16 | #' @usage NULL 17 | #' @export 18 | GeomXsidevline <- ggside_geom("GeomXsidevline", GeomVline, "x") 19 | 20 | #' @rdname ggside-ggproto-geoms 21 | #' @format NULL 22 | #' @usage NULL 23 | #' @export 24 | GeomYsidevline <- ggside_geom("GeomYsidevline", GeomVline, "y") 25 | -------------------------------------------------------------------------------- /R/geom-sidehline.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include constructor-.R 3 | NULL 4 | ### INCLUDE END 5 | #' @aliases geom_*hline 6 | #' @rdname geom_xsideabline 7 | #' @export 8 | geom_xsidehline <- ggside_layer_function(fun = geom_hline, side = "x") 9 | 10 | 11 | #' @rdname geom_xsideabline 12 | #' @export 13 | geom_ysidehline <- ggside_layer_function(fun = geom_hline, side = "y") 14 | 15 | #' @rdname ggside-ggproto-geoms 16 | #' @format NULL 17 | #' @usage NULL 18 | #' @export 19 | GeomXsidehline <- ggside_geom("GeomXsidehline", GeomHline, "x") 20 | 21 | #' @rdname ggside-ggproto-geoms 22 | #' @format NULL 23 | #' @usage NULL 24 | #' @export 25 | GeomYsidehline <- ggside_geom("GeomYsidehline", GeomHline, "y") 26 | -------------------------------------------------------------------------------- /man/ggside-deprecated.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/z-depricated.R 3 | \name{ggside-deprecated} 4 | \alias{ggside-deprecated} 5 | \alias{as_ggsideFacet} 6 | \alias{as_ggsideCoord} 7 | \alias{is.ggside} 8 | \alias{is.ggside_layer} 9 | \alias{is.ggside_options} 10 | \alias{is.ggside_scale} 11 | \title{Deprecated Functions} 12 | \description{ 13 | The following functions have been deprecated. 14 | 15 | as_ggsideFacet <- \link{ggside_facet} 16 | as_ggsideCoord <- \link{ggside_coord} 17 | is.ggside <- \link{is_ggside} 18 | is.ggside_layer <- \link{is_ggside_layer} 19 | is.ggside_options <- \link{is_ggside_options} 20 | is.ggside_scale <- \link{is_ggside_scale} 21 | } 22 | -------------------------------------------------------------------------------- /man/scale_ycolour.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scales-xycolour.R 3 | \name{scale_ycolour_hue} 4 | \alias{scale_ycolour_hue} 5 | \alias{scale_ycolour_manual} 6 | \alias{scale_ycolor_manual} 7 | \alias{scale_ycolour_gradient} 8 | \alias{scale_ycolour_gradientn} 9 | \alias{scale_ycolor_gradientn} 10 | \alias{scale_ycolour_discrete} 11 | \alias{scale_ycolor_discrete} 12 | \alias{scale_ycolour_continuous} 13 | \alias{scale_ycolor_continuous} 14 | \title{scale_ycolour_hue} 15 | \description{ 16 | scale_ycolour_hue 17 | 18 | scale_ycolour_manual 19 | 20 | scale_ycolour_gradient 21 | 22 | scale_ycolour_discrete 23 | 24 | scale_ycolour_discrete 25 | 26 | scale_ycolour_continuous 27 | 28 | scale_ycolour_continuous 29 | } 30 | -------------------------------------------------------------------------------- /tests/testthat/test_ops_meaningful.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | p <- mtcars |> 4 | dplyr::mutate(cyl = as.factor(cyl)) |> 5 | ggplot(aes(mpg, hp)) + 6 | geom_point() 7 | 8 | 9 | 10 | test_that("non-mapping parameter works (alpha)", { 11 | .addSide <- function(p, my_alpha) { 12 | p + geom_ysideboxplot( 13 | aes(x = cyl, y = hp, fill = cyl), orientation = "x", 14 | alpha = my_alpha 15 | ) 16 | } 17 | expect_doppelganger("alpha-0.5", p + geom_ysideboxplot( 18 | aes(x = cyl, y = hp, fill = cyl), orientation = "x", 19 | alpha = 0.5 20 | )) 21 | expect_doppelganger("alpha-0.5-from-function", .addSide(p, 0.5)) 22 | }) 23 | 24 | 25 | test_that("No Ops meaningful warning", { 26 | 27 | p2 <- p + geom_ysideboxplot( 28 | aes(x = cyl, y = hp, fill = cyl), orientation = "x" 29 | ) 30 | expect_no_warning(invisible(ggplot_build(p2))) 31 | 32 | }) 33 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | This is a minor patch to `ggside`. A small error has been found in the plotting 2 | of some side geometries and facet combinations. It has been fixed with this 3 | update and additional tests have been added to check for this regression in 4 | the future. 5 | 6 | ## Test environments 7 | 8 | - local macOS 15.5, R 4.5.0 9 | - Github Actions (on travis-ci; devel, release) 10 | - MacOS-latest (release) 11 | - Windows-latest (release) 12 | - ubuntu-latest (release) 13 | - ubuntu-latest (oldrel-1) 14 | - win-builder (devel, release) 15 | 16 | ## R CMD checks results 17 | 18 | 0 errors | 0 warnings | 0 note 19 | 20 | ## Downstream dependencies 21 | ### revdepcheck results 22 | 23 | We checked 7 reverse dependencies (3 from CRAN + 4 from Bioconductor), comparing R CMD check results across CRAN and dev versions of this package. 24 | 25 | * We saw 0 new problems 26 | * We failed to check 0 packages 27 | -------------------------------------------------------------------------------- /man/as_ggside.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot-construction.R 3 | \name{as_ggside} 4 | \alias{as_ggside} 5 | \alias{as_ggside.default} 6 | \alias{as_ggside.ggplot} 7 | \alias{as_ggside.ggside::ggside} 8 | \alias{as_ggside.ggside} 9 | \title{Explicit conversion to ggside object} 10 | \usage{ 11 | as_ggside(x, ...) 12 | 13 | \method{as_ggside}{default}(x, ...) 14 | 15 | \method{as_ggside}{ggplot}(x, ggside = NULL, ...) 16 | 17 | \method{as_ggside}{`ggside::ggside`}(x, ggside = NULL, ...) 18 | 19 | \method{as_ggside}{ggside}(x, ggside = NULL, ...) 20 | } 21 | \arguments{ 22 | \item{x}{an object to convert} 23 | 24 | \item{...}{unused argument} 25 | 26 | \item{ggside}{new ggside object to add} 27 | } 28 | \description{ 29 | Function is only exported for possible extensions to ggside. ggplot2 objects 30 | are implicitly converted to ggside objects by 'adding' a ggside object 31 | such as a \code{ggside_layer} object. 32 | } 33 | -------------------------------------------------------------------------------- /R/geom-sidetext.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include constructor-.R 3 | NULL 4 | ### INCLUDE END 5 | #' @title Side text 6 | #' @description 7 | #' The [xside] and [yside] variants of \link[ggplot2]{geom_text}. 8 | #' @inheritParams ggplot2::geom_text 9 | #' @aliases geom_*sidetext 10 | #' @return XLayer or YLayer object to be added to a ggplot object 11 | #' @export 12 | geom_xsidetext <- ggside_layer_function(fun = geom_text, side = "x", force_missing = c("nudge_x","nudge_y","position")) 13 | 14 | #' @rdname ggside-ggproto-geoms 15 | #' @usage NULL 16 | #' @format NULL 17 | #' @export 18 | GeomXsidetext <- ggside_geom("GeomXsidetext", GeomText, "x") 19 | 20 | 21 | #' @rdname geom_xsidetext 22 | #' @export 23 | geom_ysidetext <- ggside_layer_function(fun = geom_text, side = "y", force_missing = c("nudge_x","nudge_y","position")) 24 | 25 | #' @rdname ggside-ggproto-geoms 26 | #' @usage NULL 27 | #' @format NULL 28 | #' @export 29 | GeomYsidetext <- ggside_geom("GeomYsidetext", GeomText, "y") 30 | -------------------------------------------------------------------------------- /man/ggside-scales.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scales-sides-.R 3 | \name{ggside-scales} 4 | \alias{ggside-scales} 5 | \alias{ggside_scales} 6 | \title{Specifying side scales} 7 | \description{ 8 | The \link{xside} and \link{yside} variants of \link[ggplot2:Geom]{geoms} are plotted 9 | along the x-axis and y-axis respectively of their main panel's data mapping. 10 | The positional scale here is shared between the main panel and the side 11 | panel. The related positional scale type of the side panel, i.e. the y axis 12 | of the xside panel (xsidey) or the x axis of the yside panel (ysidex), is 13 | determined automatically by \code{ggplot2} default scales. However, you can 14 | override this by using the \link[=ggside-scales-continuous]{continuous} or 15 | \link[=ggside-scales-discrete]{discrete} variants within \code{ggside}. This 16 | allows the user to select the scale type or transform most appropriate for 17 | their side panels. 18 | } 19 | -------------------------------------------------------------------------------- /man/ggside-ggproto-coord.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/side-coord-cartesian.R 3 | \name{ggside_coord} 4 | \alias{ggside_coord} 5 | \alias{ggside_coord.default} 6 | \alias{ggside_coord.CoordCartesian} 7 | \alias{ggside_coord.CoordSide} 8 | \alias{ggside_coord.CoordTrans} 9 | \alias{ggside_coord.CoordFixed} 10 | \title{Coord Compatible with ggside} 11 | \usage{ 12 | ggside_coord(coord) 13 | 14 | \method{ggside_coord}{default}(coord) 15 | 16 | \method{ggside_coord}{CoordCartesian}(coord) 17 | 18 | \method{ggside_coord}{CoordSide}(coord) 19 | 20 | \method{ggside_coord}{CoordTrans}(coord) 21 | 22 | \method{ggside_coord}{CoordFixed}(coord) 23 | } 24 | \arguments{ 25 | \item{coord}{coord ggproto Object to replace} 26 | } 27 | \description{ 28 | S3 class that converts old Coord into one that 29 | is compatible with ggside. Can also update 30 | ggside on the object. Typically, the new ggproto 31 | will inherit from the object being replaced. 32 | } 33 | -------------------------------------------------------------------------------- /R/geom-sidefreqpoly.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include constructor-.R 3 | NULL 4 | ### INCLUDE END 5 | #' @title Side Frequency Polygons 6 | #' @description 7 | #' The [xside] and [yside] variants of \link[ggplot2]{geom_freqpoly} is 8 | #' [geom_xsidefreqpoly] and [geom_ysidefreqpoly]. 9 | #' 10 | #' @inheritParams ggplot2::layer 11 | #' @inheritParams ggplot2::geom_freqpoly 12 | #' 13 | #' @aliases geom_*freqpoly 14 | #' @return XLayer or YLayer object to be added to a ggplot object 15 | #' @examples 16 | #' ggplot(diamonds, aes(price, carat, colour = cut)) + 17 | #' geom_point() + 18 | #' geom_xsidefreqpoly(aes(y=after_stat(count)),binwidth = 500) + 19 | #' geom_ysidefreqpoly(aes(x=after_stat(count)),binwidth = .2) 20 | #' @export 21 | geom_xsidefreqpoly <- ggside_layer_function(fun = geom_freqpoly, side = "x", stat_orientation = "x") 22 | 23 | #' @rdname geom_xsidefreqpoly 24 | #' @export 25 | geom_ysidefreqpoly <- ggside_layer_function(fun = geom_freqpoly, side = "y", stat_orientation = "y") 26 | -------------------------------------------------------------------------------- /man/ggside-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggside-package.r 3 | \docType{package} 4 | \name{ggside-package} 5 | \alias{ggside-package} 6 | \title{ggside: Side Grammar Graphics} 7 | \description{ 8 | The grammar of graphics as shown in 'ggplot2' has provided an expressive API for users to build plots. 'ggside' extends 'ggplot2' by allowing users to add graphical information about one of the main panel's axis using a familiar 'ggplot2' style API with tidy data. This package is particularly useful for visualizing metadata on a discrete axis, or summary graphics on a continuous axis such as a boxplot or a density distribution. 9 | } 10 | \seealso{ 11 | Useful links: 12 | \itemize{ 13 | \item \url{https://github.com/jtlandis/ggside} 14 | \item Report bugs at \url{https://github.com/jtlandis/ggside/issues} 15 | } 16 | 17 | } 18 | \author{ 19 | \strong{Maintainer}: Justin Landis \email{jtlandis314@gmail.com} (\href{https://orcid.org/0000-0001-5501-4934}{ORCID}) 20 | 21 | } 22 | \keyword{internal} 23 | -------------------------------------------------------------------------------- /R/ggside-ggproto.r: -------------------------------------------------------------------------------- 1 | #' @title Extending base ggproto classes for ggside 2 | #' @name ggside-ggproto-geoms 3 | #' @description 4 | #' These ggproto classes are slightly modified from their 5 | #' respective inherited \link[ggplot2]{ggproto} class. The 6 | #' biggest difference is exposing 'x/yfill', 'x/ycolour', and 7 | #' 'x/ycolor' as viable aesthetic mappings. 8 | #' 9 | #' 10 | #' @param data data passed internally 11 | #' @param params params available to ggproto object 12 | #' @return ggproto object that is usually passed to \link[ggplot2]{layer} 13 | NULL 14 | 15 | 16 | #' @title Extending base ggproto classes for ggside 17 | #' @name ggside-ggproto-facets 18 | #' @section Extended Facets: 19 | #' 20 | #' The following is a list \link[ggplot2]{ggplot2} facets that are 21 | #' available to use by ggside base. 22 | #' 23 | #' \itemize{ 24 | #' \item \link[ggplot2]{FacetNull} -> FacetSideNull 25 | #' \item \link[ggplot2]{FacetGrid} -> FacetSideGrid 26 | #' \item \link[ggplot2]{FacetWrap} -> FacetSideWrap 27 | #' } 28 | #' @return ggproto object that can be added to a ggplot object 29 | NULL 30 | -------------------------------------------------------------------------------- /R/geom-sidelabel.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include constructor-.R 3 | NULL 4 | ### INCLUDE END 5 | #' @title Side label 6 | #' @description 7 | #' The [xside] and [yside] variants of \link[ggplot2]{geom_label}. 8 | #' @inheritParams ggplot2::geom_label 9 | #' @aliases geom_*sidelabel 10 | #' @return XLayer or YLayer object to be added to a ggplot object 11 | #' @export 12 | geom_xsidelabel <- ggside_layer_function(fun = geom_label, side = "x", force_missing = c("nudge_x", "nudge_y", "position"), label.size = quote(lifecycle::deprecated())) 13 | 14 | #' @rdname ggside-ggproto-geoms 15 | #' @usage NULL 16 | #' @format NULL 17 | #' @export 18 | GeomXsidelabel <- ggside_geom("GeomXsidelabel", GeomLabel, "x") 19 | 20 | 21 | #' @rdname geom_xsidelabel 22 | #' @export 23 | geom_ysidelabel <- ggside_layer_function(fun = geom_label, side = "y", force_missing = c("nudge_x", "nudge_y", "position"), label.size = quote(lifecycle::deprecated())) 24 | 25 | #' @rdname ggside-ggproto-geoms 26 | #' @usage NULL 27 | #' @format NULL 28 | #' @export 29 | GeomYsidelabel <- ggside_geom("GeomYsidelabel", GeomLabel, "y") 30 | -------------------------------------------------------------------------------- /R/geom-sideline.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include constructor-.R 3 | NULL 4 | ### INCLUDE END 5 | #' @title Side line plot 6 | #' @description 7 | #' The [xside] and [yside] of \link[ggplot2]{geom_line}. 8 | #' The [xside] and [yside] variants of \link[ggplot2]{geom_path} 9 | #' @inheritParams ggplot2::geom_line 10 | #' 11 | #' @aliases geom_*sideline 12 | #' @return XLayer or YLayer object to be added to a ggplot object 13 | #' @examples 14 | #' #sideline 15 | #' ggplot(economics, aes(date, pop)) + 16 | #' geom_xsideline(aes(y = unemploy)) + 17 | #' geom_col() 18 | #' @export 19 | geom_xsideline <- ggside_layer_function(fun = geom_line, side = "x") 20 | 21 | #' @rdname ggside-ggproto-geoms 22 | #' @usage NULL 23 | #' @format NULL 24 | #' @export 25 | GeomXsideline <- ggside_geom("GeomXsideline", GeomLine, "x") 26 | 27 | 28 | #' @rdname geom_xsideline 29 | #' @export 30 | geom_ysideline <- ggside_layer_function(fun = geom_line, side = "y") 31 | 32 | 33 | #' @rdname ggside-ggproto-geoms 34 | #' @usage NULL 35 | #' @format NULL 36 | #' @export 37 | GeomYsideline <- ggside_geom("GeomYsideline", GeomLine, "y") 38 | 39 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2021 ggside 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/scale_xfill.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scales-xyfill.R 3 | \name{scale_xfill} 4 | \alias{scale_xfill} 5 | \alias{scale_yfill} 6 | \alias{scale_xfill_hue} 7 | \alias{scale_xfill_manual} 8 | \alias{scale_xfill_gradient} 9 | \alias{scale_xfill_gradientn} 10 | \alias{scale_xfill_discrete} 11 | \alias{scale_xfill_continuous} 12 | \alias{scale_yfill_gradientn} 13 | \title{Scales for the *fill aesthetics} 14 | \value{ 15 | returns a ggproto object to be added to a ggplot 16 | } 17 | \description{ 18 | These are the various scales that can be applied to the xsidebar or ysidebar 19 | fill aesthetics, such as xfill and yfill. They have the same usage as 20 | existing standard ggplot2 scales. 21 | } 22 | \section{Related Functions}{ 23 | 24 | 25 | \itemize{ 26 | \item scale_xfill_hue 27 | \item scale_yfill_hue 28 | \item scale_xfill_discrete 29 | \item scale_yfill_discrete 30 | \item scale_xfill_continuous 31 | \item scale_yfill_continuous 32 | \item scale_xfill_manual 33 | \item scale_yfill_manual 34 | \item scale_xfill_gradient 35 | \item scale_yfill_gradient 36 | \item scale_xfill_gradientn 37 | \item scale_yfill_gradientn 38 | } 39 | } 40 | 41 | -------------------------------------------------------------------------------- /R/geom-sideabline.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include constructor-.R 3 | NULL 4 | ### INCLUDE END 5 | 6 | #' @title Side Reference lines 7 | #' @description 8 | #' The [xside] and [yside] variants of \link[ggplot2]{geom_abline}, 9 | #' \link[ggplot2]{geom_hline} and \link[ggplot2]{geom_vline} are 10 | #' [geom_*abline], [geom_*hline], and [geom_*vline]. 11 | #' 12 | #' @aliases geom_*abline 13 | #' @inheritParams ggplot2::layer 14 | #' @inheritParams ggplot2::geom_point 15 | #' @param mapping Set of aesthetic mappings created by 16 | #' \link[ggplot2:aes]{aes()}. 17 | #' @param xintercept,yintercept,slope,intercept Parameters that control the 18 | #' position of the line specifically for the [xside] or [yside] variants. 19 | #' If these are set, `data`, `mapping` and `show.legend` are overridden. 20 | #' @export 21 | geom_xsideabline <- ggside_layer_function(fun = geom_abline, side = "x") 22 | 23 | #' @rdname geom_xsideabline 24 | #' @export 25 | geom_ysideabline <- ggside_layer_function(fun = geom_abline, side = "y") 26 | 27 | #' @rdname ggside-ggproto-geoms 28 | #' @format NULL 29 | #' @usage NULL 30 | #' @export 31 | GeomXsideabline <- ggside_geom("GeomXsideabline", GeomAbline, "x") 32 | 33 | #' @rdname ggside-ggproto-geoms 34 | #' @format NULL 35 | #' @usage NULL 36 | #' @export 37 | GeomYsideabline <- ggside_geom("GeomYsideabline", GeomAbline, "y") 38 | -------------------------------------------------------------------------------- /man/class_definitions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/all_classes.r 3 | \docType{data} 4 | \name{class_definitions} 5 | \alias{class_definitions} 6 | \alias{class_ggside_opt} 7 | \alias{class_ggside_layer} 8 | \alias{class_ggside_scale} 9 | \alias{class_ggside} 10 | \title{Class Definitions} 11 | \description{ 12 | This documentation provides an overview of the S7 and ggproto classes used in the \code{ggside} package. 13 | } 14 | \section{ggproto classes}{ 15 | 16 | \itemize{ 17 | \item \code{class_ggside_opt} is a subclass of \code{class_ggproto} and is 18 | more described in the \link[ggside:ggside]{ggside-options} documentation. 19 | } 20 | 21 | 22 | \itemize{ 23 | \item \code{class_ggside_layer} is a subclass of \code{class_ggproto} and is 24 | more described in the \link[ggside:ggside_layer]{ggside-layers} 25 | documentation. 26 | } 27 | 28 | 29 | \itemize{ 30 | \item \code{class_ggside_scale} is a subclass of \code{class_ggproto} and is 31 | more described in the \link[ggside:ggside_scales]{ggside-scales} 32 | documentation. 33 | } 34 | } 35 | 36 | \section{S7 classes}{ 37 | 38 | \itemize{ 39 | \item \code{class_ggside} is a subclass of 40 | \link[ggplot2:class_ggplot]{ggplot2's class_ggplot} and 41 | is used to represent a ggplot object with ggside options. 42 | } 43 | } 44 | 45 | \keyword{datasets} 46 | -------------------------------------------------------------------------------- /man/scale_xcolour.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scales-xycolour.R 3 | \name{scale_xcolour} 4 | \alias{scale_xcolour} 5 | \alias{scale_ycolour} 6 | \alias{scale_xcolor} 7 | \alias{scale_ycolor} 8 | \alias{scale_xcolour_hue} 9 | \alias{scale_xcolour_manual} 10 | \alias{scale_xcolor_manual} 11 | \alias{scale_xcolour_gradient} 12 | \alias{scale_xcolor_gradientn} 13 | \alias{scale_xcolour_gradientn} 14 | \alias{scale_xcolour_discrete} 15 | \alias{scale_xcolor_discrete} 16 | \alias{scale_xcolour_continuous} 17 | \alias{scale_xcolor_continuous} 18 | \title{Scales for the *colour aesthetics} 19 | \value{ 20 | returns a ggproto object to be added to a ggplot 21 | } 22 | \description{ 23 | These are the various scales that can be applied to the xsidebar or ysidebar 24 | colour aesthetics, such as xcolour and ycolour. They have the same usage as 25 | existing standard ggplot2 scales. 26 | } 27 | \section{Related Functions}{ 28 | 29 | 30 | \itemize{ 31 | \item scale_xcolour_hue 32 | \item scale_ycolour_hue 33 | \item scale_xcolour_discrete 34 | \item scale_ycolour_discrete 35 | \item scale_xcolour_continuous 36 | \item scale_ycolour_continuous 37 | \item scale_xcolour_manual 38 | \item scale_ycolour_manual 39 | \item scale_xcolour_gradient 40 | \item scale_ycolour_gradient 41 | \item scale_xcolour_gradientn 42 | \item scale_ycolour_gradientn 43 | } 44 | } 45 | 46 | -------------------------------------------------------------------------------- /R/geom-sidehistogram.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include constructor-.R 3 | NULL 4 | ### INCLUDE END 5 | 6 | #' Side Histograms 7 | #' 8 | #' The [xside] and [yside] variants of \link[ggplot2]{geom_histogram} is 9 | #' [geom_xsidehistogram] and [geom_ysidehistogram]. These variants both inherit 10 | #' from \link[ggplot2]{geom_histogram} and only differ on where they plot 11 | #' data relative to main panels. 12 | #' 13 | #' @section Aesthetics: 14 | #' `geom_*sidehistogram` uses the same aesthetics as [geom_*sidebar()] 15 | #' 16 | #' @inheritParams ggplot2::layer 17 | #' @inheritParams ggplot2::geom_histogram 18 | #' 19 | #' @aliases geom_*sidehistogram 20 | #' @return XLayer or YLayer object to be added to a ggplot object 21 | #' @examples 22 | #' 23 | #' p <-ggplot(iris, aes(Sepal.Width, Sepal.Length, color = Species, fill = Species)) + 24 | #' geom_point() 25 | #' 26 | #' #sidehistogram 27 | #' p + 28 | #' geom_xsidehistogram(binwidth = 0.1) + 29 | #' geom_ysidehistogram(binwidth = 0.1) 30 | #' p + 31 | #' geom_xsidehistogram(aes(y = after_stat(density)), binwidth = 0.1) + 32 | #' geom_ysidehistogram(aes(x = after_stat(density)), binwidth = 0.1) 33 | #' @export 34 | geom_xsidehistogram <- ggside_layer_function(fun = geom_histogram, side = "x") 35 | 36 | #' @rdname geom_xsidehistogram 37 | #' @aliases geom_ysidehistogram 38 | #' @export 39 | geom_ysidehistogram <- ggside_layer_function(fun = geom_histogram, side = "y") 40 | -------------------------------------------------------------------------------- /R/z-depricated.R: -------------------------------------------------------------------------------- 1 | deprecated_fun <- function(fun) { 2 | fun_sub <- substitute(fun) 3 | function(...) { 4 | .Deprecated(deparse1(fun_sub), package = "ggside") 5 | fun(...) 6 | } 7 | } 8 | 9 | 10 | #' @name ggside-deprecated 11 | #' @title Deprecated Functions 12 | #' 13 | #' @description 14 | #' The following functions have been deprecated. 15 | #' 16 | #' as_ggsideFacet <- [ggside_facet] 17 | #' as_ggsideCoord <- [ggside_coord] 18 | #' is.ggside <- [is_ggside] 19 | #' is.ggside_layer <- [is_ggside_layer] 20 | #' is.ggside_options <- [is_ggside_options] 21 | #' is.ggside_scale <- [is_ggside_scale] 22 | #' @aliases as_ggsideFacet 23 | #' 24 | 25 | #' @rdname ggside-deprecated 26 | #' @usage NULL 27 | #' @export 28 | as_ggsideFacet <- deprecated_fun(ggside_facet) 29 | 30 | #' @rdname ggside-deprecated 31 | #' @usage NULL 32 | #' @export 33 | as_ggsideCoord <- deprecated_fun(ggside_coord) 34 | 35 | 36 | #' @rdname ggside-deprecated 37 | #' @usage NULL 38 | #' @export 39 | is.ggside <- deprecated_fun(is_ggside) 40 | 41 | #' @rdname ggside-deprecated 42 | #' @usage NULL 43 | #' @export 44 | is.ggside_layer <- deprecated_fun(is_ggside_layer) 45 | 46 | 47 | #' @rdname ggside-deprecated 48 | #' @usage NULL 49 | #' @export 50 | is.ggside_options <- deprecated_fun(is_ggside_options) 51 | 52 | #' @rdname ggside-deprecated 53 | #' @usage NULL 54 | #' @export 55 | is.ggside_scale <- deprecated_fun(is_ggside_scale) 56 | -------------------------------------------------------------------------------- /R/utils-ggproto.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # injects the body with enexpr. 5 | # call_parent_method --> ggproto_parent_method(!!!args) 6 | # and then the proper formals of the function are made 7 | new_ggproto_fun <- function(ggproto_method, 8 | body) { 9 | body <- enexpr(body) 10 | inj <- list(call_parent_method = quote(ggproto_parent_method(!!!formals_))) 11 | body <- do.call(substitute, list(body, inj)) 12 | ggproto_parent_method <- environment(ggproto_method)$f 13 | formals_ <- ggproto_formals0(ggproto_method) 14 | body <- inject(expr(!!body)) 15 | fun <- new_function( 16 | args = formals(ggproto_parent_method), 17 | body = body 18 | ) 19 | fun 20 | 21 | } 22 | 23 | # grabs the formals of an inner function from 24 | # a ggproto method accessed via `$` or `[[` 25 | ggproto_formals <- function(x) formals(environment(x)$f) 26 | 27 | # uses formals input and renames the values to 28 | # match their own names 29 | formals_as_defaults <- function(formals_) { 30 | names_ <- names(formals_) 31 | for (i in seq_along(formals_)) { 32 | formals_[[i]] <- as.name(names_[i]) 33 | } 34 | if ("..." %in% names_) 35 | names(formals_)[names_ %in% "..."] <- "" 36 | formals_ 37 | } 38 | 39 | # like ggproto_formals except they values 40 | # get renamed 41 | ggproto_formals0 <- function(ggproto_method) { 42 | formals_ <- ggproto_formals(ggproto_method) 43 | formals_as_defaults(formals_ = formals_) 44 | } 45 | 46 | -------------------------------------------------------------------------------- /inst/WORDLIST: -------------------------------------------------------------------------------- 1 | asn 2 | abline 3 | atanh 4 | behaviour 5 | boxcox 6 | colorbar 7 | colour 8 | coord 9 | Coord 10 | extensibility 11 | FacetSideGrid 12 | FacetSideNull 13 | FacetSideWrap 14 | ggplot 15 | ggplots 16 | ggproto 17 | ggside's 18 | grey 19 | hline 20 | pts 21 | rect 22 | th 23 | Github 24 | gradientn 25 | hms 26 | jointy 27 | jtlandis 28 | mitre 29 | params 30 | readme 31 | README 32 | unscaled 33 | xcolour 34 | xfill 35 | XLayer 36 | xside 37 | xsidebar 38 | xsidehistogram 39 | ycolor 40 | ycolour 41 | yfill 42 | YLayer 43 | yside 44 | ysidebar 45 | ysideboxplot 46 | ysidecol 47 | ysidedensity 48 | ysidefreqpoly 49 | ysidehistogram 50 | api 51 | GeomBar 52 | GeomBoxplot 53 | GeomDensity 54 | GeomFreqpoly 55 | GeomHistogram 56 | GeomLine 57 | GeomPath 58 | GeomPoint 59 | geoms 60 | Geoms 61 | GeomText 62 | GeomTile 63 | GeomViolin 64 | rescale 65 | Rescale 66 | rescaled 67 | rescaling 68 | rlang 69 | ScaleContinuousPosition 70 | ScaleDiscretePosition 71 | summarise 72 | Summarise 73 | Summarising 74 | walkthrough 75 | CMD 76 | vectorised 77 | dev 78 | plotmath 79 | vline 80 | Codecov 81 | geom's 82 | geom’s 83 | GeomCol 84 | ggsideCoord 85 | ggsideFacet 86 | LayerInstance 87 | centimetres 88 | millimetres 89 | ORCID 90 | picas 91 | ScaleBinnedPosition 92 | subclassed 93 | subclasses 94 | subclassing 95 | ysidex 96 | unmapped 97 | cran 98 | nameing #from ggplot2 99 | data's 100 | xsidey 101 | -------------------------------------------------------------------------------- /R/utils-constructors.R: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include utils-.R 3 | NULL 4 | ### INCLUDE END 5 | 6 | aes_to_map <- function(ggproto, side) { 7 | resolve_arg(side, c("x", "y"), null.ok = FALSE) 8 | other_side <- switch(side, x = "y", y = "x") 9 | req_aes <- pull_aes(ggproto$required_aes) 10 | opt_aes <- pull_aes(ggproto$optional_aes) 11 | non_mis <- pull_aes(ggproto$non_missing_aes) 12 | def_aes <- names(ggproto$default_aes) 13 | all_aes <- unique(c(req_aes, opt_aes, non_mis, def_aes)) 14 | if (is_ggside_subclass(ggproto)) { 15 | class_ <- sprintf("%sside", side) 16 | aes_map <- sub(class_, "", all_aes[grepl(class_, all_aes)]) 17 | # if (!length(aes_map)) { 18 | # cli::cli_abort("argument {.arg ggproto} of class {.class {class(ggproto)}} could not find any expected {.val {class_}} aesthetics") 19 | # } 20 | } else { 21 | aes_map <- all_aes[all_aes %in% .ggside_global[[sprintf(".%s_aes", other_side)]]] 22 | # if (!length(aes_map)) { 23 | # cli::cli_abort("could not find any positional aesthetics to map. have you tried to register with {.fun ggside_register_aesthetics}") 24 | # } 25 | } 26 | aes_map 27 | } 28 | 29 | data_unmap <- function(data, side) { 30 | names(data) <- sub(sprintf("%sside", side), "", names(data)) 31 | data 32 | } 33 | 34 | data_map <- function(data, side, map) { 35 | x <- names(data) 36 | aes <- x %in% map 37 | x[aes] <- sprintf("%sside%s", side, x[aes]) 38 | names(data) <- x 39 | data 40 | } 41 | 42 | -------------------------------------------------------------------------------- /R/geom-sidepoint.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include constructor-.R 3 | NULL 4 | ### INCLUDE END 5 | #' @title Side Points 6 | #' 7 | #' @description 8 | #' The ggside variants of \link[ggplot2]{geom_point} is [geom_xsidepoint()] and 9 | #' [geom_ysidepoint()]. Both variants inherit from \link[ggplot2]{geom_point}, 10 | #' thus the only difference is where the data is plotted. The `xside` variant will 11 | #' plot data along the x-axis, while the `yside` variant will plot data along the 12 | #' y-axis. 13 | #' 14 | #' @inheritParams ggplot2::layer 15 | #' @inheritParams ggplot2::geom_point 16 | #' 17 | #' @aliases geom_*sidepoint 18 | #' @return XLayer or YLayer object to be added to a ggplot object 19 | #' @examples 20 | #' ggplot(diamonds, aes(depth, table, alpha = .2)) + 21 | #' geom_point() + 22 | #' geom_ysidepoint(aes(x = price)) + 23 | #' geom_xsidepoint(aes(y = price)) + 24 | #' theme( 25 | #' ggside.panel.scale = .3 26 | #' ) 27 | #' @export 28 | geom_xsidepoint <- ggside_layer_function(fun = geom_point, side = "x") 29 | 30 | #' @rdname ggside-ggproto-geoms 31 | #' @usage NULL 32 | #' @format NULL 33 | #' @export 34 | GeomXsidepoint <- ggside_geom("GeomXsidepoint", GeomPoint, "x") 35 | 36 | #' @rdname geom_xsidepoint 37 | #' @export 38 | geom_ysidepoint <- ggside_layer_function(fun = geom_point, side = "y") 39 | 40 | #' @rdname ggside-ggproto-geoms 41 | #' @usage NULL 42 | #' @format NULL 43 | #' @export 44 | GeomYsidepoint <- ggside_geom("GeomYsidepoint", GeomPoint, "y") 45 | 46 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # taken from https://github.com/r-lib/pkgdown/blob/main/.github/workflows/pkgdown.yaml 3 | on: 4 | push: 5 | branches: [main] 6 | pull_request: 7 | release: 8 | types: [published] 9 | workflow_dispatch: 10 | 11 | name: pkgdown.yaml 12 | 13 | permissions: read-all 14 | 15 | jobs: 16 | pkgdown: 17 | runs-on: ubuntu-latest 18 | # Only restrict concurrency for non-PR jobs 19 | concurrency: 20 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 21 | env: 22 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 23 | permissions: 24 | contents: write 25 | steps: 26 | - uses: actions/checkout@v4 27 | 28 | - uses: r-lib/actions/setup-pandoc@v2 29 | 30 | - uses: r-lib/actions/setup-r@v2 31 | with: 32 | use-public-rspm: true 33 | 34 | - uses: r-lib/actions/setup-r-dependencies@v2 35 | with: 36 | extra-packages: any::pkgdown, local::. 37 | needs: website 38 | 39 | - uses: r-lib/actions/setup-tinytex@v2 40 | 41 | - name: Build site 42 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 43 | shell: Rscript {0} 44 | 45 | - name: Deploy to GitHub pages 🚀 46 | if: github.event_name != 'pull_request' 47 | uses: JamesIves/github-pages-deploy-action@v4.5.0 48 | with: 49 | clean: false 50 | branch: gh-pages 51 | folder: docs 52 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.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, dev] 6 | pull_request: 7 | branches: [main, dev] 8 | 9 | name: test-coverage 10 | 11 | jobs: 12 | test-coverage: 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | 17 | steps: 18 | - uses: actions/checkout@v4 19 | 20 | - uses: r-lib/actions/setup-r@v2 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v2 25 | with: 26 | extra-packages: any::covr 27 | needs: coverage 28 | 29 | - name: Test coverage 30 | run: | 31 | covr::codecov( 32 | quiet = FALSE, 33 | clean = FALSE, 34 | install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") 35 | ) 36 | shell: Rscript {0} 37 | 38 | - name: Show testthat output 39 | if: always() 40 | run: | 41 | ## -------------------------------------------------------------------- 42 | find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true 43 | shell: bash 44 | 45 | - name: Upload test results 46 | if: failure() 47 | uses: actions/upload-artifact@v4 48 | with: 49 | name: coverage-test-failures 50 | path: ${{ runner.temp }}/package 51 | -------------------------------------------------------------------------------- /R/geom-sidedensity.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include constructor-.R 3 | NULL 4 | ### INCLUDE END 5 | #' @title Side density distributions 6 | #' 7 | #' @description 8 | #' The [xside] and [yside] variants of \link[ggplot2]{geom_density} is 9 | #' [geom_xsidedensity] and [geom_ysidedensity]. 10 | #' 11 | #' @inheritParams ggplot2::layer 12 | #' @inheritParams ggplot2::geom_bar 13 | #' @inheritParams ggplot2::geom_ribbon 14 | #' @param stat Use to override the default connection between 15 | #' `geom_density()` and `stat_density()`. 16 | #' @aliases geom_*sidedensity 17 | #' @return XLayer or YLayer object to be added to a ggplot object 18 | #' @examples 19 | #' 20 | #' ggplot(mpg, aes(displ, hwy, colour = class)) + 21 | #' geom_point(size = 2) + 22 | #' geom_xsidedensity() + 23 | #' geom_ysidedensity() + 24 | #' theme(axis.text.x = element_text(angle = 90, vjust = .5)) 25 | #' 26 | #' ggplot(mpg, aes(displ, hwy, colour = class)) + 27 | #' geom_point(size = 2) + 28 | #' geom_xsidedensity(aes(y = after_stat(count)),position = "stack") + 29 | #' geom_ysidedensity(aes(x = after_stat(scaled))) + 30 | #' theme(axis.text.x = element_text(angle = 90, vjust = .5)) 31 | #' 32 | #' @export 33 | geom_xsidedensity <- ggside_layer_function(fun = geom_density, side = "x") 34 | 35 | #' @rdname ggside-ggproto-geoms 36 | #' @usage NULL 37 | #' @format NULL 38 | #' @export 39 | GeomXsidedensity <- ggside_geom("GeomXsidedensity", GeomDensity, "x") 40 | 41 | #' @rdname geom_xsidedensity 42 | #' @export 43 | geom_ysidedensity <- ggside_layer_function(fun = geom_density, side = "y") 44 | 45 | #' @rdname ggside-ggproto-geoms 46 | #' @usage NULL 47 | #' @format NULL 48 | #' @export 49 | GeomYsidedensity <- ggside_geom("GeomYsidedensity", GeomDensity, "y") 50 | -------------------------------------------------------------------------------- /R/geom-sidetile.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include constructor-.R 3 | NULL 4 | ### INCLUDE END 5 | #' @title Side tile plot 6 | #' @description 7 | #' The [xside] and [yside] variants of \link[ggplot2]{geom_tile} 8 | #' @inheritParams ggplot2::geom_tile 9 | #' @aliases geom_*sidetile 10 | #' @return XLayer or YLayer object to be added to a ggplot object 11 | #' @examples 12 | #' library(dplyr) 13 | #' library(tidyr) 14 | #' df <- mutate(diamonds, 15 | #' colclar = interaction(color, clarity, sep = "_", drop = TRUE)) %>% 16 | #' group_by(color, clarity, colclar, cut) %>% 17 | #' summarise(m_price = mean(price)) 18 | #' 19 | #' xside_data <- df %>% 20 | #' ungroup() %>% 21 | #' select(colclar, clarity, color) %>% 22 | #' mutate_all(~factor(as.character(.x), levels = levels(.x))) %>% 23 | #' pivot_longer(cols = c(clarity, color)) %>% distinct() 24 | #' 25 | #' 26 | #' p <- ggplot(df, aes(x = colclar, cut)) + 27 | #' geom_tile(aes(fill = m_price)) + 28 | #' viridis::scale_fill_viridis(option = "magma") + 29 | #' theme(axis.text.x = element_blank()) 30 | #' 31 | #' p + geom_xsidetile(data = xside_data, aes(y = name, xfill = value)) + 32 | #' guides(xfill = guide_legend(nrow = 8)) 33 | #' @export 34 | geom_xsidetile <- ggside_layer_function(fun = geom_tile, side = "x") 35 | 36 | #' @rdname ggside-ggproto-geoms 37 | #' @usage NULL 38 | #' @format NULL 39 | #' @export 40 | GeomXsidetile <- ggside_geom("GeomXsidetile", GeomTile, "x") 41 | 42 | #' @rdname geom_xsidetile 43 | #' @export 44 | geom_ysidetile <- ggside_layer_function(fun = geom_tile, side = "y") 45 | 46 | #' @rdname ggside-ggproto-geoms 47 | #' @usage NULL 48 | #' @format NULL 49 | #' @export 50 | GeomYsidetile <- ggside_geom("GeomYsidetile", GeomTile, "y") 51 | -------------------------------------------------------------------------------- /.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 | on: 4 | push: 5 | branches: [main, dev] 6 | pull_request: 7 | branches: [main, dev] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ${{ matrix.config.os }} 14 | 15 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 16 | 17 | strategy: 18 | fail-fast: false 19 | matrix: 20 | config: 21 | - {os: macos-latest, r: 'release'} 22 | - {os: windows-latest, r: 'release'} 23 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 24 | - {os: ubuntu-latest, r: 'release'} 25 | - {os: ubuntu-latest, r: 'oldrel-1'} 26 | 27 | env: 28 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 29 | R_KEEP_PKG_SOURCE: yes 30 | # Runs vdiffr test only on the latest version of R 31 | VDIFFR_RUN_TESTS: ${{ matrix.config.r == 'release' || matrix.config.r == 'devel' }} 32 | # VDIFFR_RUN_TESTS: true 33 | VDIFFR_LOG_PATH: "../vdiffr.Rout.fail" 34 | 35 | steps: 36 | - uses: actions/checkout@v4 37 | 38 | - uses: r-lib/actions/setup-pandoc@v2 39 | 40 | - uses: r-lib/actions/setup-r@v2 41 | with: 42 | r-version: ${{ matrix.config.r }} 43 | http-user-agent: ${{ matrix.config.http-user-agent }} 44 | use-public-rspm: true 45 | 46 | - uses: r-lib/actions/setup-r-dependencies@v2 47 | with: 48 | extra-packages: any::rcmdcheck 49 | needs: check 50 | 51 | - uses: r-lib/actions/check-r-package@v2 52 | with: 53 | upload-snapshots: true 54 | -------------------------------------------------------------------------------- /tests/testthat/test_continuous_date_axis.R: -------------------------------------------------------------------------------- 1 | suppressMessages(library(dplyr)) 2 | library(vdiffr) 3 | 4 | set.seed(1234) 5 | 6 | df <- data.frame( 7 | year = sample(2000:2020, 300, replace = T), 8 | month = sample(1:12, 300, replace = T), 9 | day = sample(1:28, 300, replace = T), 10 | temperature = rnorm(300, 70, 8) 11 | ) %>% 12 | mutate( 13 | month_name = month.name[month], 14 | date = as.Date(sprintf("%04d-%02d-%02d", year, month, day)) 15 | ) 16 | 17 | test_that("default ggplot2 warning", { 18 | p <- ggplot(df, aes(y = temperature)) + 19 | geom_line(aes(x = date)) + 20 | geom_histogram(orientation = "y", binwidth = 0.5) 21 | expect_warning(ggplot_build(p), regexp = "A value was passed to a Date scale") 22 | }) 23 | 24 | p <- ggplot(df, aes(x = date, y = temperature)) + 25 | geom_line() + 26 | geom_point(aes(color = month_name)) 27 | p_yside <- p + geom_ysidehistogram(bins = 30) 28 | 29 | test_that("ggside work-around works", { 30 | expect_doppelganger("date_x_yside_no_scale", p_yside) 31 | }) 32 | 33 | p_yside <- p_yside + scale_ysidex_continuous() 34 | 35 | test_that("ggside adding ysidex continuous scale", { 36 | expect_doppelganger("date_x_yside", p_yside) 37 | }) 38 | 39 | p_xside <- p + geom_xsidehistogram(bins = 30) + scale_xsidey_continuous(trans = "sqrt", breaks = c(0, 5, 10, 20)) 40 | 41 | test_that("ggside xsidey scales", { 42 | expect_doppelganger("date_x_xside", p_xside) 43 | }) 44 | 45 | p_both <- p_yside + geom_xsidehistogram(bins = 30) 46 | 47 | test_that("ggside xsidey and ysidex scales", { 48 | expect_doppelganger("date_x_both", p_both) 49 | }) 50 | 51 | p_wrap <- p_both + facet_wrap(~month) + ggside(collapse = "all") 52 | 53 | 54 | test_that("ggside xsidey and ysidex no message", { 55 | expect_no_message(p_wrap) 56 | }) 57 | -------------------------------------------------------------------------------- /man/ggside-ggproto-facets.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-side-facet.R, R/side-facet_.R, 3 | % R/ggside-ggproto.r 4 | \name{check_scales_collapse} 5 | \alias{check_scales_collapse} 6 | \alias{sidePanelLayout} 7 | \alias{ggside_facet} 8 | \alias{ggside-ggproto-facets} 9 | \title{Extending base ggproto classes for ggside} 10 | \usage{ 11 | check_scales_collapse(data, params) 12 | 13 | sidePanelLayout(layout, ggside) 14 | 15 | ggside_facet(facet, ggside) 16 | } 17 | \arguments{ 18 | \item{data}{data passed through ggproto object} 19 | 20 | \item{params}{parameters passed through ggproto object} 21 | 22 | \item{layout}{layout computed by inherited ggproto Facet compute_layout method} 23 | 24 | \item{ggside}{ggside object to update} 25 | 26 | \item{facet}{Facet ggproto Object to replace} 27 | } 28 | \value{ 29 | ggproto object that can be added to a ggplot object 30 | } 31 | \description{ 32 | \code{check_scales_collapse} is a helper function that 33 | is meant to be called after the inherited Facet's 34 | compute_layout method 35 | 36 | \code{sidePanelLayout} is a helper function that 37 | is meant to be called after the inherited Facet's 38 | compute_layout method and after \code{check_scales_collapse} 39 | 40 | S3 class that converts old Facet into one that 41 | is compatible with ggside. Can also update 42 | ggside on the object. Typically, the new ggproto 43 | will inherit from the object being replaced. 44 | } 45 | \section{Extended Facets}{ 46 | 47 | 48 | The following is a list \link[ggplot2]{ggplot2} facets that are 49 | available to use by ggside base. 50 | 51 | \itemize{ 52 | \item \link[ggplot2]{FacetNull} -> FacetSideNull 53 | \item \link[ggplot2]{FacetGrid} -> FacetSideGrid 54 | \item \link[ggplot2]{FacetWrap} -> FacetSideWrap 55 | } 56 | } 57 | 58 | -------------------------------------------------------------------------------- /generate_ggside_hexsticker.R: -------------------------------------------------------------------------------- 1 | library(ggside) 2 | library(hexSticker) 3 | library(dplyr) 4 | 5 | gg <- mutate(iris, 6 | Species2 = rep(c("A","B"), 75), 7 | Species3 = interaction(Species, Species2, lex.order = T, drop = T)) 8 | 9 | p <- ggplot(gg, aes(Sepal.Width, Petal.Width, color = Species3)) + 10 | geom_point(size = .04) + 11 | geom_xsidedensity(aes(y = after_stat(density), fill = Species3), position = "stack", lwd=0.009) + 12 | geom_ysideboxplot(aes(x = as.numeric(Species), fill = NULL), orientation = "x", outlier.size = .0375, lwd=.09) + 13 | #geom_ysidedensity(aes(x = after_stat(density), fill = Species3), position = "stack") + 14 | #geom_ysidehistogram(aes(x = after_stat(count), fill = Species3),binwidth = .1, position = "stack") + 15 | facet_grid(cols = vars(Species), rows = vars(Species2)) + 16 | ggside(collapse = "all") + 17 | scale_color_brewer(palette = "PuRd")+ 18 | scale_fill_brewer(palette = "PuRd") + 19 | theme_void() + 20 | theme( 21 | panel.spacing = unit(1.01, "points"), 22 | strip.text = element_blank(), 23 | plot.background = element_rect(fill = "#2A78B5", color = "#2A78B5"), 24 | panel.background = element_rect(fill = "#87C2F0", color = "#87C2F0"), 25 | panel.grid.major = element_line(colour = "#2A78B5", size = .05), 26 | panel.grid.minor = element_blank(), 27 | ggside.panel.scale = .2 28 | ) + 29 | guides(color = F, fill = F) 30 | p 31 | 32 | sticker(p, package = "ggside", 33 | p_size = 6, 34 | p_x = 1, 35 | p_y = 1.7, 36 | s_x =1, s_y=1, s_width = 1.6, s_height = 1, 37 | h_fill = "#2A78B5", 38 | h_color = "#87C2F0",filename="inst/figures/ggside.png", 39 | url = "https://github.com/jtlandis/ggside", 40 | u_size = .8, 41 | u_color = "#FFFFFF", 42 | u_y = 0.045, 43 | spotlight = T) 44 | -------------------------------------------------------------------------------- /tests/testthat/test_vdiff_irisScatter.R: -------------------------------------------------------------------------------- 1 | library(vdiffr) 2 | i2 <- within(iris, { 3 | Species2 <- rep(c("A", "B"), 75) 4 | }) 5 | p <- ggplot(i2, aes(Sepal.Width, Sepal.Length, fill = Species)) + 6 | geom_point(aes(color = Species)) 7 | 8 | test_that("sidedensities plot correctly", { 9 | p1 <- p + 10 | geom_xsidedensity(aes(y = after_stat(density)), alpha = .3) + 11 | geom_ysidedensity(aes(x = after_stat(density)), alpha = .3) 12 | expect_doppelganger("Basic Side Density", p1) 13 | p2 <- p + 14 | geom_xsidedensity(aes(y = after_stat(density)), position = "stack") + 15 | geom_ysidedensity(aes(x = after_stat(density), yfill = Species2), 16 | position = "stack" 17 | ) 18 | expect_doppelganger("Stacked Side Density", p2) 19 | p3 <- p2 + 20 | facet_grid(cols = vars(Species), rows = vars(Species2)) + 21 | scale_yfill_manual(values = c("darkred", "darkblue")) 22 | expect_doppelganger("FacetGrid Side Density", p3) 23 | p4 <- p3 + ggside(collapse = "all") 24 | expect_doppelganger("FacetGrid Collapsed Density", p4) 25 | }) 26 | 27 | test_that("sidehistograms plot correctly", { 28 | p1 <- p + 29 | geom_xsidehistogram(aes(y = after_stat(count)), bins = 30) + 30 | geom_ysidehistogram(aes(x = after_stat(count)), bins = 30) 31 | expect_doppelganger("Basic Side histo", p1) 32 | p2 <- p + 33 | geom_ysidehistogram(aes(x = after_stat(count), yfill = Species2), bins = 30) 34 | expect_doppelganger("yside histo", p2) 35 | p3 <- p2 + 36 | geom_xsidehistogram(aes(xfill = Species, y = after_stat(count)), 37 | bins = 30 38 | ) + 39 | facet_grid(cols = vars(Species), rows = vars(Species2)) + 40 | scale_yfill_manual(values = c("darkred", "darkblue")) + 41 | guides(fill = "none") 42 | expect_doppelganger("FacetGrid histo", p3) 43 | p4 <- p3 + ggside(collapse = "all") + 44 | scale_xfill_manual(values = c("tan2", "gold", "grey")) 45 | expect_doppelganger("Collapsed histo", p4) 46 | }) 47 | -------------------------------------------------------------------------------- /man/yside.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggside.R 3 | \name{yside} 4 | \alias{yside} 5 | \title{The yside geometries} 6 | \value{ 7 | geom_yside* return a YLayer object to be added to a ggplot 8 | } 9 | \description{ 10 | \code{yside} refers to the api of ggside. Any \code{geom_} with 11 | \code{yside} will plot its respective geometry along the y-axis per 12 | facet panel. The yside panel will plot to the right of the main 13 | panel by default. This yside panel will always share the same scale 14 | as it's main panel, but is expected to have a separate x-axis scaling. 15 | } 16 | \section{New Aesthetics}{ 17 | 18 | 19 | All \code{yside} Geometries have \code{yfill}, \code{ycolour}/\code{ycolor} available for 20 | aesthetic mappings. These mappings behave exactly like the default 21 | counterparts except that they are considered separate scales. All 22 | \code{yside} geometries will use \code{yfill} over \code{fill}, but will default 23 | to \code{fill} if \code{yfill} is not provided. The same goes for \code{ycolour} in 24 | respects to \code{colour}. This comes in handy if you wish to map both \code{fill} 25 | to one geometry as continuous, you can still map \code{yfill} for a separate 26 | \code{yside} geometry without conflicts. See more information in 27 | \code{vignette("ggside")}. 28 | 29 | #' @section Exported Geometries: 30 | 31 | The following are the \code{yside} variants of the \link[ggplot2]{ggplot2} 32 | Geometries 33 | 34 | \itemize{ 35 | \item \link{geom_ysidebar} 36 | \item \link{geom_ysideboxplot} 37 | \item \link{geom_ysidecol} 38 | \item \link{geom_ysidedensity} 39 | \item \link{geom_ysidefreqpoly} 40 | \item \link{geom_ysidehistogram} 41 | \item \link{geom_ysideline} 42 | \item \link{geom_ysidepath} 43 | \item \link{geom_ysidepoint} 44 | \item \link{geom_ysidetext} 45 | \item \link{geom_ysidetile} 46 | \item \link{geom_ysideviolin} 47 | } 48 | } 49 | 50 | \seealso{ 51 | \link{xside} 52 | } 53 | -------------------------------------------------------------------------------- /man/xside.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggside.R 3 | \name{xside} 4 | \alias{xside} 5 | \title{The xside geometries} 6 | \value{ 7 | geom_xside* return a XLayer object to be added to a ggplot 8 | } 9 | \description{ 10 | \code{xside} refers to the api of ggside. Any \code{geom_} with 11 | \code{xside} will plot its respective geometry along the x-axis 12 | per facet panel. By default the xside panel will plot above the main 13 | panel. This xside panel will always share the same scale as it's main 14 | panel, but is expected to have a separate y-axis scaling. 15 | } 16 | \section{New Aesthetics}{ 17 | 18 | 19 | All \code{xside} Geometries have \code{xfill}, \code{xcolour}/\code{xcolor} available for 20 | aesthetic mappings. These mappings behave exactly like the default 21 | counterparts except that they are considered separate scales. All 22 | \code{xside} geometries will use \code{xfill} over \code{fill}, but will default 23 | to \code{fill} if \code{xfill} is not provided. The same goes for \code{xcolour} in 24 | respects to \code{colour}. This comes in handy if you wish to map both \code{fill} 25 | to one geometry as continuous, you can still map \code{xfill} for a separate 26 | \code{xside} geometry without conflicts. See more information in 27 | \code{vignette("ggside")}. 28 | } 29 | 30 | \section{Exported Geometries}{ 31 | 32 | 33 | The following are the \code{xside} variants of the \link[ggplot2]{ggplot2} 34 | Geometries 35 | 36 | \itemize{ 37 | \item \link{geom_xsidebar} 38 | \item \link{geom_xsideboxplot} 39 | \item \link{geom_xsidecol} 40 | \item \link{geom_xsidedensity} 41 | \item \link{geom_xsidefreqpoly} 42 | \item \link{geom_xsidehistogram} 43 | \item \link{geom_xsideline} 44 | \item \link{geom_xsidepath} 45 | \item \link{geom_xsidepoint} 46 | \item \link{geom_xsidetext} 47 | \item \link{geom_xsidetile} 48 | \item \link{geom_xsideviolin} 49 | } 50 | } 51 | 52 | \seealso{ 53 | \link{yside} 54 | } 55 | -------------------------------------------------------------------------------- /man/ggside-ggproto-geoms.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/side-layer.R, R/geom-sideabline.r, 3 | % R/geom-sidebar.r, R/geom-sideboxplot.r, R/geom-sidecol.r, 4 | % R/geom-sidedensity.r, R/geom-sidefunction.r, R/geom-sidehline.r, 5 | % R/geom-sidelabel.r, R/geom-sideline.r, R/geom-sidepath.r, 6 | % R/geom-sidepoint.r, R/geom-sidesegment.r, R/geom-sidetext.r, 7 | % R/geom-sidetile.r, R/geom-sideviolin.r, R/geom-sidevline.r, 8 | % R/ggside-ggproto.r 9 | \docType{data} 10 | \name{parse_side_aes} 11 | \alias{parse_side_aes} 12 | \alias{GeomXsideabline} 13 | \alias{GeomYsideabline} 14 | \alias{GeomXsidebar} 15 | \alias{GeomYsidebar} 16 | \alias{GeomXsideboxplot} 17 | \alias{GeomYsideboxplot} 18 | \alias{GeomXsidecol} 19 | \alias{GeomYsidecol} 20 | \alias{GeomXsidedensity} 21 | \alias{GeomYsidedensity} 22 | \alias{GeomXsidefunction} 23 | \alias{GeomYsidefunction} 24 | \alias{GeomXsidehline} 25 | \alias{GeomYsidehline} 26 | \alias{GeomXsidelabel} 27 | \alias{GeomYsidelabel} 28 | \alias{GeomXsideline} 29 | \alias{GeomYsideline} 30 | \alias{GeomXsidepath} 31 | \alias{GeomYsidepath} 32 | \alias{GeomXsidepoint} 33 | \alias{GeomYsidepoint} 34 | \alias{GeomXsidesegment} 35 | \alias{GeomYsidesegment} 36 | \alias{GeomXsidetext} 37 | \alias{GeomYsidetext} 38 | \alias{GeomXsidetile} 39 | \alias{GeomYsidetile} 40 | \alias{GeomXsideviolin} 41 | \alias{GeomYsideviolin} 42 | \alias{GeomXsidevline} 43 | \alias{GeomYsidevline} 44 | \alias{ggside-ggproto-geoms} 45 | \title{Extending base ggproto classes for ggside} 46 | \usage{ 47 | parse_side_aes(data, params) 48 | } 49 | \arguments{ 50 | \item{data}{data passed internally} 51 | 52 | \item{params}{params available to ggproto object} 53 | } 54 | \value{ 55 | ggproto object that is usually passed to \link[ggplot2]{layer} 56 | } 57 | \description{ 58 | These ggproto classes are slightly modified from their 59 | respective inherited \link[ggplot2]{ggproto} class. The 60 | biggest difference is exposing 'x/yfill', 'x/ycolour', and 61 | 'x/ycolor' as viable aesthetic mappings. 62 | } 63 | \keyword{datasets} 64 | -------------------------------------------------------------------------------- /R/geom-sidesegment.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include constructor-.R 3 | NULL 4 | ### INCLUDE END 5 | #' @title Side line Segments 6 | #' @description 7 | #' The [xside] and [yside] of \link[ggplot2]{geom_segment}. 8 | #' @inheritParams ggplot2::geom_segment 9 | #' 10 | #' @aliases geom_*sidesegment 11 | #' @return XLayer or YLayer object to be added to a ggplot object 12 | #' @examples 13 | #' library(dplyr) 14 | #' library(tidyr) 15 | #' library(ggdendro) 16 | #' #dendrogram with geom_*sidesegment 17 | #' df0 <- mutate(diamonds, 18 | #' colclar = interaction(color, clarity, 19 | #' sep = "_", drop = TRUE)) 20 | #' df1 <- df0 %>% 21 | #' group_by(color, clarity, colclar, cut) %>% 22 | #' summarise(m_price = mean(price)) 23 | #' df <- df1 %>% 24 | #' pivot_wider(id_cols = colclar, 25 | #' names_from = cut, 26 | #' values_from = m_price, 27 | #' values_fill = 0L) 28 | #' 29 | #' mat <- as.matrix(df[,2:6]) 30 | #' rownames(mat) <- df[["colclar"]] 31 | #' dst <- dist(mat) 32 | #' hc_x <- hclust(dst) 33 | #' lvls <- rownames(mat)[hc_x$order] 34 | #' df1[["colclar"]] <- factor(df1[["colclar"]], levels = lvls) 35 | #' dendrox <- dendro_data(hc_x) 36 | #' 37 | #' p <- ggplot(df1, aes(x = colclar, cut)) + 38 | #' geom_tile(aes(fill = m_price)) + 39 | #' viridis::scale_fill_viridis(option = "magma") + 40 | #' theme(axis.text.x = element_text(angle = 90, vjust = .5)) 41 | #' p + 42 | #' geom_xsidesegment(data = dendrox$segments,aes(x = x, y = y, xend = xend, yend = yend)) 43 | #' @export 44 | geom_xsidesegment <- ggside_layer_function(fun = geom_segment, side = "x") 45 | 46 | #' @rdname ggside-ggproto-geoms 47 | #' @usage NULL 48 | #' @format NULL 49 | #' @export 50 | GeomXsidesegment <- ggside_geom("GeomXsidesegment", GeomSegment, "x") 51 | 52 | #' @rdname geom_xsidesegment 53 | #' @export 54 | geom_ysidesegment <- ggside_layer_function(fun = geom_segment, side = "y") 55 | 56 | #' @rdname ggside-ggproto-geoms 57 | #' @usage NULL 58 | #' @format NULL 59 | #' @export 60 | GeomYsidesegment <- ggside_geom("GeomYsidesegment", GeomSegment, "y") 61 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check-ggplot2-upstream.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, dev] 6 | pull_request: 7 | branches: [main, dev] 8 | 9 | name: R-CMD-check-ggplot-dev 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ${{ matrix.config.os }} 14 | 15 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 16 | 17 | strategy: 18 | fail-fast: false 19 | matrix: 20 | config: 21 | - { os: macos-latest, r: "release" } 22 | - { os: windows-latest, r: "release" } 23 | - { os: ubuntu-latest, r: "devel", http-user-agent: "release" } 24 | - { os: ubuntu-latest, r: "release" } 25 | - { os: ubuntu-latest, r: "oldrel-1" } 26 | 27 | env: 28 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 29 | R_KEEP_PKG_SOURCE: yes 30 | # Runs vdiffr test only on the latest version of R 31 | VDIFFR_RUN_TESTS: ${{ matrix.config.r == 'release' || matrix.config.r == 'devel' }} 32 | # VDIFFR_RUN_TESTS: true 33 | VDIFFR_LOG_PATH: "../vdiffr.Rout.fail" 34 | 35 | steps: 36 | - uses: actions/checkout@v4 37 | 38 | - uses: r-lib/actions/setup-pandoc@v2 39 | 40 | - uses: r-lib/actions/setup-r@v2 41 | with: 42 | r-version: ${{ matrix.config.r }} 43 | http-user-agent: ${{ matrix.config.http-user-agent }} 44 | use-public-rspm: true 45 | 46 | - uses: r-lib/actions/setup-r-dependencies@v2 47 | with: 48 | extra-packages: any::rcmdcheck 49 | needs: check 50 | 51 | - name: Install-remotes 52 | run: | 53 | Rscript -e "install.packages('remotes', repos = 'https://cloud.r-project.org')" 54 | 55 | - name: Install R package from GitHub 56 | run: | 57 | Rscript -e "remotes::install_github('tidyverse/ggplot2')" 58 | 59 | - uses: r-lib/actions/check-r-package@v2 60 | with: 61 | upload-snapshots: true 62 | -------------------------------------------------------------------------------- /tests/testthat/test_ggside_extended_themes.R: -------------------------------------------------------------------------------- 1 | 2 | library(ggplot2) 3 | library(ggside) 4 | 5 | p <- ggplot(iris, aes(Sepal.Width, Petal.Length, color = Species)) + 6 | geom_point() + 7 | geom_xsidedensity() + 8 | geom_ysidedensity() + 9 | theme_test() 10 | 11 | 12 | test_that("ggside themes functions work", { 13 | 14 | expect_doppelganger("grey", p + theme_ggside_grey()) 15 | expect_doppelganger("gray", p + theme_ggside_gray()) 16 | expect_doppelganger("bw", p + theme_ggside_bw()) 17 | expect_doppelganger("linedraw", p + theme_ggside_linedraw()) 18 | expect_doppelganger("light", p + theme_ggside_light()) 19 | expect_doppelganger("dark", p + theme_ggside_dark()) 20 | expect_doppelganger("minimal", p + theme_ggside_minimal()) 21 | expect_doppelganger("classic", p + theme_ggside_classic()) 22 | expect_doppelganger("void", p + theme_ggside_void()) 23 | 24 | }) 25 | 26 | 27 | test_that("ggside theme inheritence work", { 28 | 29 | 30 | expect_doppelganger("side panel grid", p + theme(ggside.panel.scale = 0.3, 31 | ggside.panel.grid = element_line(linetype = "dotted", color = NA), 32 | ggside.xside.panel.grid.major.x = element_line(color = "red"), 33 | ggside.yside.panel.grid.major.y = element_line(color = "blue"))) 34 | 35 | expect_doppelganger("side panel border", p + theme(ggside.panel.scale = 0.3, 36 | ggside.panel.border = element_rect(linetype = "dotted", fill = NA), 37 | ggside.xside.panel.border = element_rect(color = "red"), 38 | ggside.yside.panel.border = element_rect(color = "blue"))) 39 | 40 | expect_doppelganger("side panel background", p + theme(ggside.panel.scale = 0.3, 41 | ggside.panel.background = element_rect(linewidth = 10), 42 | ggside.xside.panel.background = element_rect(fill = alpha("red", .1)), 43 | ggside.yside.panel.background = element_rect(fill = alpha("blue", .1)))) 44 | }) 45 | -------------------------------------------------------------------------------- /R/geom-sidebar.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include constructor-.R 3 | NULL 4 | ### INCLUDE END 5 | 6 | #' @title Side bar Charts 7 | #' 8 | #' @description 9 | #' 10 | #' The [xside] and [yside] variants of \link[ggplot2]{geom_bar} is 11 | #' [geom_xsidebar] and [geom_ysidebar]. These variants both inherit 12 | #' from \link[ggplot2]{geom_bar} and only differ on where they plot 13 | #' data relative to main panels. 14 | #' 15 | #' The [xside] and [yside] variants of \link[ggplot2]{geom_col} is 16 | #' [geom_xsidecol] and [geom_ysidecol]. These variants both inherit 17 | #' from \link[ggplot2]{geom_col} and only differ on where they plot 18 | #' data relative to main panels. 19 | #' 20 | #' @inheritParams ggplot2::layer 21 | #' @inheritParams ggplot2::geom_bar 22 | #' 23 | #' @section Aesthetics: 24 | #' 25 | #' Required aesthetics are in bold. 26 | #' 27 | #' \itemize{ 28 | #' \item \strong{`x`} 29 | #' \item \strong{`y`} 30 | #' \item \emph{`fill` or `xfill`} Fill color of the xsidebar 31 | #' \item \emph{`fill` or `yfill`} Fill color of the ysidebar 32 | #' \item \emph{`width`} specifies the width of each bar 33 | #' \item \emph{`height`} specifies the height of each bar 34 | #' \item \emph{`alpha`} Transparency level of `xfill` or `yfill` 35 | #' \item \emph{`size`} size of the border line. 36 | #' } 37 | #' 38 | #' @seealso [geom_xsidehistogram], [geom_ysidehistogram] 39 | #' @return XLayer or YLayer object to be added to a ggplot object 40 | #' @aliases geom_*sidebar 41 | #' @examples 42 | #' 43 | #' p <-ggplot(iris, aes(Sepal.Width, Sepal.Length, color = Species, fill = Species)) + 44 | #' geom_point() 45 | #' 46 | #' #sidebar - uses StatCount 47 | #' p + 48 | #' geom_xsidebar() + 49 | #' geom_ysidebar() 50 | #' 51 | #' #sidecol - uses Global mapping 52 | #' p + 53 | #' geom_xsidecol() + 54 | #' geom_ysidecol() 55 | #' 56 | #' @export 57 | geom_xsidebar <- ggside_layer_function(fun = geom_bar, side = "x") 58 | 59 | #' @rdname ggside-ggproto-geoms 60 | #' @usage NULL 61 | #' @format NULL 62 | #' @export 63 | GeomXsidebar <- ggside_geom("GeomXsidebar", GeomBar, "x") 64 | 65 | 66 | #' @rdname geom_xsidebar 67 | #' @export 68 | geom_ysidebar <- ggside_layer_function(fun = geom_bar, side = "y") 69 | 70 | #' @rdname ggside-ggproto-geoms 71 | #' @usage NULL 72 | #' @format NULL 73 | #' @export 74 | GeomYsidebar <- ggside_geom("GeomYsidebar", GeomBar, "y") 75 | -------------------------------------------------------------------------------- /tests/testthat/test_FacetNull_ggside_themes.R: -------------------------------------------------------------------------------- 1 | library(vdiffr) 2 | df <- data.frame(x = 1:10, y = 21:30, 3 | a = rep(c("g1","g2"), 5), 4 | b = rep(c("t1","t2"), each = 5)) 5 | p <- ggplot(df, aes(x, y)) + 6 | geom_point() 7 | px <- p + geom_xsidecol() 8 | py <- p + geom_ysidecol() 9 | pxy <- px + geom_ysidecol() 10 | test_that("ggside.panel.scale facetNULL",{ 11 | expect_doppelganger("xside ggside.panel.scale.x .5", px + theme(ggside.panel.scale.x = .5)) 12 | expect_doppelganger("xside ggside.panel.scale.y .5", px + theme(ggside.panel.scale.y = .5)) 13 | expect_doppelganger("xside ggside.panel.scale .5", px + theme(ggside.panel.scale = .5)) 14 | expect_doppelganger("yside ggside.panel.scale.x .5", py + theme(ggside.panel.scale.x = .5)) 15 | expect_doppelganger("yside ggside.panel.scale.y .5", py + theme(ggside.panel.scale.y = .5)) 16 | expect_doppelganger("yside ggside.panel.scale .5", py + theme(ggside.panel.scale = .5)) 17 | expect_doppelganger("xyside ggside.panel.scale.x .5", pxy + theme(ggside.panel.scale.x = .5)) 18 | expect_doppelganger("xyside ggside.panel.scale.y .5", pxy + theme(ggside.panel.scale.y = .5)) 19 | expect_doppelganger("xyside ggside.panel.scale .5", pxy + theme(ggside.panel.scale = .5)) 20 | }) 21 | 22 | test_that("ggside.panel.spacing facetNULL",{ 23 | expect_doppelganger("xside ggside.panel.spacing.x 10pt", px + theme(ggside.panel.spacing.x = unit(10, "pt"))) 24 | expect_doppelganger("xside ggside.panel.spacing.y 10pt", px + theme(ggside.panel.spacing.y = unit(10, "pt"))) 25 | expect_doppelganger("xside ggside.panel.spacing 10pt", px + theme(ggside.panel.spacing = unit(10, "pt"))) 26 | expect_doppelganger("yside ggside.panel.spacing.x 10pt", py + theme(ggside.panel.spacing.x = unit(10, "pt"))) 27 | expect_doppelganger("yside ggside.panel.spacing.y 10pt", py + theme(ggside.panel.spacing.y = unit(10, "pt"))) 28 | expect_doppelganger("yside ggside.panel.spacing 10pt", py + theme(ggside.panel.spacing = unit(10, "pt"))) 29 | expect_doppelganger("xyside ggside.panel.spacing.x 10pt", pxy + theme(ggside.panel.spacing.x = unit(10, "pt"))) 30 | expect_doppelganger("xyside ggside.panel.spacing.y 10pt", pxy + theme(ggside.panel.spacing.y = unit(10, "pt"))) 31 | expect_doppelganger("xyside ggside.panel.spacing 10pt", pxy + theme(ggside.panel.spacing = unit(10, "pt"))) 32 | }) 33 | 34 | -------------------------------------------------------------------------------- /tests/testthat/test_add_gg.R: -------------------------------------------------------------------------------- 1 | test_that("Overwritten `+.gg` still adds layers as expected", { 2 | p <- ggplot(iris, aes(Sepal.Width, Sepal.Length, color = Species)) 3 | expect_equal(length(p$layers), 0L) 4 | p1 <- p + geom_point() 5 | expect_s3_class(p1, "ggplot") 6 | expect_s3_class(p1, "gg") 7 | expect_equal(length(p1$layers), 1L) 8 | p2 <- p1 + geom_rug() 9 | expect_equal(length(p2$layers), 2L) 10 | expect_identical( 11 | { 12 | p2 + theme_bw() 13 | }$theme, 14 | theme_bw() 15 | ) 16 | p3 <- p2 + facet_wrap(~Species) 17 | expect_s3_class(p3$facet, "FacetWrap") 18 | p4 <- p2 + facet_wrap(~Species, scales = "free_y") 19 | expect_s3_class(p4$facet, "FacetWrap") 20 | expect_false(identical(p3$facet, p4$facet)) 21 | expect_false(identical(p3$scales, p4$scales)) 22 | }) 23 | 24 | p <- ggplot(iris, aes(Sepal.Width, Sepal.Length, color = Species)) + 25 | geom_point() 26 | 27 | test_that("New ggside layers are added correctly", { 28 | expect_s3_class(p, "ggplot") 29 | expect_s3_class(ggside(), "ggside_options") 30 | p1 <- p + geom_xsidedensity(aes(y = after_stat(density))) 31 | expect_s3_class(p1, "ggside::ggside") 32 | expect_s7_class(p1, class_ggside) 33 | expect_s3_class(p1, "ggplot") 34 | expect_s3_class(p1$layers[[2]], "ggside_layer") 35 | expect_s3_class(p1$layers[[2]]$geom, "GeomXsidedensity") 36 | p2 <- p1 + facet_wrap(~Species, ncol = 1) 37 | expect_s3_class(p1, "ggside::ggside") 38 | expect_s7_class(p1, class_ggside) 39 | expect_s3_class(p2$facet, "FacetWrap") 40 | p3 <- p2 + ggside(collapse = "all") 41 | expect_warning(ggplot_build(p3), regexp = "only x used") 42 | expect_warning(ggplot_build(p + ggside(collapse = "all")), 43 | regexp = "no side geometry used" 44 | ) 45 | expect_warning(ggplot_build(p1 + ggside(collapse = "y")), regex = "no yside geometry used") 46 | }) 47 | 48 | 49 | test_that("add_gg errors", { 50 | expect_error(+p, "argument \"e2\" is missing, with no default") 51 | expect_error(p + "", "Can't add `\"\"` to a") 52 | fake_theme <- structure(numeric(), class = "theme") 53 | expect_error(theme() + fake_theme, "to a theme object") 54 | expect_error(ggproto() + p, "Cannot add objects together") 55 | }) 56 | 57 | test_that("add_gg identities", { 58 | expect_identical(p + NULL, p) 59 | expect_identical(theme() + theme_bw(), theme_bw()) 60 | }) 61 | -------------------------------------------------------------------------------- /R/all_classes.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include side-coord-cartesian.R 3 | #' @include side-facet_.R 4 | #' @include side-layout-.r 5 | #' @include ggside.R 6 | NULL 7 | ### INCLUDE END 8 | 9 | #' @title Class Definitions 10 | #' @name class_definitions 11 | #' @description 12 | #' This documentation provides an overview of the S7 and ggproto classes used in the `ggside` package. 13 | #' @section ggproto classes: 14 | #' * `class_ggside_opt` is a subclass of `class_ggproto` and is 15 | #' more described in the \link[ggside:ggside]{ggside-options} documentation. 16 | #' @export 17 | #' @format NULL 18 | #' @usage NULL 19 | class_ggside_opt <- S7::new_S3_class("ggside_options") 20 | 21 | #' @rdname class_definitions 22 | #' @section ggproto classes: 23 | #' * `class_ggside_layer` is a subclass of `class_ggproto` and is 24 | #' more described in the \link[ggside:ggside_layer]{ggside-layers} 25 | #' documentation. 26 | #' @export 27 | #' @format NULL 28 | #' @usage NULL 29 | class_ggside_layer <- S7::new_S3_class("ggside_layer") 30 | 31 | #' @rdname class_definitions 32 | #' @section ggproto classes: 33 | #' * `class_ggside_scale` is a subclass of `class_ggproto` and is 34 | #' more described in the \link[ggside:ggside_scales]{ggside-scales} 35 | #' documentation. 36 | #' @export 37 | #' @format NULL 38 | #' @usage NULL 39 | class_ggside_scale <- S7::new_S3_class("ggside_scale") 40 | 41 | 42 | #' @rdname class_definitions 43 | #' @section S7 classes: 44 | #' * `class_ggside` is a subclass of 45 | #' \link[ggplot2:class_ggplot]{ggplot2's class_ggplot} and 46 | #' is used to represent a ggplot object with ggside options. 47 | #' @export 48 | #' @format NULL 49 | #' @usage NULL 50 | class_ggside <- S7::new_class( 51 | name = "ggside", parent = ggplot2::class_ggplot, 52 | package = "ggside", 53 | properties = list( 54 | ggside_opt = class_ggside_opt 55 | ), 56 | constructor = function(ggplot = NULL, 57 | ggside_opt = new_ggside()) { 58 | old_class <- class(ggplot) 59 | obj <- S7::new_object(ggplot, ggside_opt = ggside_opt) 60 | class(obj) <- c(setdiff(class(obj), old_class), old_class) 61 | S7::set_props(obj, 62 | facet = ggside_facet(S7::prop(obj, "facet"), ggside = ggside_opt), 63 | coordinates = ggside_coord(S7::prop(obj, "coordinates")), 64 | layout = ggside_layout(S7::prop(obj, "layout")) 65 | ) 66 | } 67 | ) 68 | -------------------------------------------------------------------------------- /man/position_rescale.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/position_rescale.r 3 | \docType{data} 4 | \name{position_rescale} 5 | \alias{position_rescale} 6 | \alias{PositionRescale} 7 | \alias{position_yrescale} 8 | \alias{position_xrescale} 9 | \title{Rescale x or y onto new range in margin} 10 | \format{ 11 | An object of class \code{PositionRescale} (inherits from \code{Position}, \code{ggproto}, \code{gg}) of length 10. 12 | } 13 | \usage{ 14 | position_rescale( 15 | rescale = "y", 16 | midpoint = NULL, 17 | range = NULL, 18 | location = NULL, 19 | instance = NULL 20 | ) 21 | 22 | position_yrescale( 23 | rescale = "y", 24 | midpoint = NULL, 25 | range = NULL, 26 | location = NULL, 27 | instance = NULL 28 | ) 29 | 30 | position_xrescale( 31 | rescale = "x", 32 | midpoint = NULL, 33 | range = NULL, 34 | location = NULL, 35 | instance = NULL 36 | ) 37 | } 38 | \arguments{ 39 | \item{rescale}{character value of "x" or "y". specifies which mapping data will be rescaled} 40 | 41 | \item{midpoint}{default set to NULL. Center point about which the rescaled x/y values will reside.} 42 | 43 | \item{range}{default set to NULL and auto generates from main mapping range. Specifies the size of the rescaled range.} 44 | 45 | \item{location}{specifies where position_rescale should try to place midpoint. If midpoint is specified, location 46 | is ignored and placed at the specified location.} 47 | 48 | \item{instance}{integer that indexes rescaled axis calls. instance may be specified and if a previous 49 | layer with the same instance exists, then the same midpoint and range are used for rescaling. x and y are 50 | indexed independently.} 51 | } 52 | \value{ 53 | a ggproto object inheriting from 'Position' and can be added to a ggplot 54 | } 55 | \description{ 56 | Take the range of the specified axis and rescale it to a new range about a midpoint. By default 57 | the range will be calculated from the associated main plot axis mapping. The range will either be the resolution 58 | or 5\% of the axis range, depending if original data is discrete or continuous respectively. Each layer called 59 | with position_rescale will possess an instance value that indexes with axis rescale. By default, each 60 | position_rescale will dodge the previous call unless instance is specified to a previous layer. 61 | } 62 | \keyword{datasets} 63 | -------------------------------------------------------------------------------- /tests/testthat/test_FacetWrap_ggside_themes.R: -------------------------------------------------------------------------------- 1 | df <- data.frame( 2 | x = 1:10, y = 21:30, 3 | a = rep(c("g1", "g2"), 5), 4 | b = rep(c("t1", "t2"), each = 5) 5 | ) 6 | p <- ggplot(df, aes(x, y)) + 7 | geom_point() + 8 | facet_wrap(a ~ b) 9 | px <- p + geom_xsidecol(width = 0.9) 10 | py <- p + geom_ysidecol(width = 0.9) 11 | pxy <- px + geom_ysidecol(width = 0.9) 12 | test_that("ggside.panel.scale facetWrap", { 13 | expect_doppelganger("wrap xside ggside.panel.scale.x .5", px + theme(ggside.panel.scale.x = .5)) 14 | expect_doppelganger("wrap xside ggside.panel.scale.y .5", px + theme(ggside.panel.scale.y = .5)) 15 | expect_doppelganger("wrap xside ggside.panel.scale .5", px + theme(ggside.panel.scale = .5)) 16 | expect_doppelganger("wrap yside ggside.panel.scale.x .5", py + theme(ggside.panel.scale.x = .5)) 17 | expect_doppelganger("wrap yside ggside.panel.scale.y .5", py + theme(ggside.panel.scale.y = .5)) 18 | expect_doppelganger("wrap yside ggside.panel.scale .5", py + theme(ggside.panel.scale = .5)) 19 | expect_doppelganger("wrap xyside ggside.panel.scale.x .5", pxy + theme(ggside.panel.scale.x = .5)) 20 | expect_doppelganger("wrap xyside ggside.panel.scale.y .5", pxy + theme(ggside.panel.scale.y = .5)) 21 | expect_doppelganger("wrap xyside ggside.panel.scale .5", pxy + theme(ggside.panel.scale = .5)) 22 | }) 23 | 24 | test_that("ggside.panel.spacing facetWrap", { 25 | expect_doppelganger("wrap xside ggside.panel.spacing.x 10pt", px + theme(ggside.panel.spacing.x = unit(10, "pt"))) 26 | expect_doppelganger("wrap xside ggside.panel.spacing.y 10pt", px + theme(ggside.panel.spacing.y = unit(10, "pt"))) 27 | expect_doppelganger("wrap xside ggside.panel.spacing 10pt", px + theme(ggside.panel.spacing = unit(10, "pt"))) 28 | expect_doppelganger("wrap yside ggside.panel.spacing.x 10pt", py + theme(ggside.panel.spacing.x = unit(10, "pt"))) 29 | expect_doppelganger("wrap yside ggside.panel.spacing.y 10pt", py + theme(ggside.panel.spacing.y = unit(10, "pt"))) 30 | expect_doppelganger("wrap yside ggside.panel.spacing 10pt", py + theme(ggside.panel.spacing = unit(10, "pt"))) 31 | expect_doppelganger("wrap xyside ggside.panel.spacing.x 10pt", pxy + theme(ggside.panel.spacing.x = unit(10, "pt"))) 32 | expect_doppelganger("wrap xyside ggside.panel.spacing.y 10pt", pxy + theme(ggside.panel.spacing.y = unit(10, "pt"))) 33 | expect_doppelganger("wrap xyside ggside.panel.spacing 10pt", pxy + theme(ggside.panel.spacing = unit(10, "pt"))) 34 | }) 35 | -------------------------------------------------------------------------------- /man/ggside-options.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggside.R 3 | \name{ggside} 4 | \alias{ggside} 5 | \alias{ggside-options} 6 | \alias{ggside_options} 7 | \title{ggside options} 8 | \usage{ 9 | ggside( 10 | x.pos = NULL, 11 | y.pos = NULL, 12 | scales = NULL, 13 | collapse = NULL, 14 | draw_x_on = NULL, 15 | draw_y_on = NULL, 16 | strip = NULL, 17 | respect_side_labels = NULL 18 | ) 19 | } 20 | \arguments{ 21 | \item{x.pos}{x side panel can either take "top" or "bottom"} 22 | 23 | \item{y.pos}{y side panel can either take "right" or "left"} 24 | 25 | \item{scales}{Determines side panel's unaligned axis 26 | scale. Inputs are similar to facet_* scales function. Default 27 | is set to "fixed", but "free_x", "free_y" and "free" are 28 | acceptable inputs. For example, xside panels are aligned to 29 | the x axis of the main panel. Setting "free" or "free_y" will 30 | cause all y scales of the x side Panels to be independent.} 31 | 32 | \item{collapse}{Determines if side panels should be collapsed into 33 | a single panel. Set "x" to collapse all x side panels, set "y" to 34 | collapse all y side panels, set "all" to collapse both x and y 35 | side panels.} 36 | 37 | \item{draw_x_on, draw_y_on}{Determines where the axis is rendered. 38 | For example: 39 | By default, the bottom x-axis is rendered on the bottom most panel 40 | per column. If set to "main", then the axis is rendered on the bottom 41 | of the bottom most main panel. If set to "side", then the x-axis is rendered 42 | on the bottom of the bottom most side panel(s). You may apply this logic 43 | to all axis positions.} 44 | 45 | \item{strip}{Determines if the strip should be rendered on the main plot or 46 | on their default locations. Only has an effect on \code{facet_grid}.} 47 | 48 | \item{respect_side_labels}{Valid arguments are "default", "x", "y", 49 | "all", and "none" Indicates if panel spacing should respect the axis 50 | labels. The default is to respect side panel labels except when xside 51 | labels are on the same side as the yside panel. Note: setting this 52 | parameter to "x" is to "respect the labels of the xside panel" and 53 | consequently the yside labels, if present, are not respected.} 54 | } 55 | \value{ 56 | a object of class 'ggside_options' or to be added to a ggplot 57 | } 58 | \description{ 59 | Set characteristics of side panels 60 | } 61 | \seealso{ 62 | For more information regarding the ggside api: see \link{xside} or \link{yside} 63 | } 64 | -------------------------------------------------------------------------------- /tests/testthat/test_FacetGrid_ggside_themes.R: -------------------------------------------------------------------------------- 1 | library(vdiffr) 2 | df <- data.frame( 3 | x = 1:10, y = 21:30, 4 | a = rep(c("g1", "g2"), 5), 5 | b = rep(c("t1", "t2"), each = 5) 6 | ) 7 | p <- ggplot(df, aes(x, y)) + 8 | geom_point() + 9 | facet_grid(vars(a), vars(b)) 10 | px <- p + geom_xsidecol(width = 0.9) 11 | py <- p + geom_ysidecol(width = 0.9) 12 | pxy <- px + geom_ysidecol(width = 0.9) 13 | test_that("ggside.panel.scale facetGrid", { 14 | expect_doppelganger("grid xside ggside.panel.scale.x .5", px + theme(ggside.panel.scale.x = .5)) 15 | expect_doppelganger("grid xside ggside.panel.scale.y .5", px + theme(ggside.panel.scale.y = .5)) 16 | expect_doppelganger("grid xside ggside.panel.scale .5", px + theme(ggside.panel.scale = .5)) 17 | expect_doppelganger("grid yside ggside.panel.scale.x .5", py + theme(ggside.panel.scale.x = .5)) 18 | expect_doppelganger("grid yside ggside.panel.scale.y .5", py + theme(ggside.panel.scale.y = .5)) 19 | expect_doppelganger("grid yside ggside.panel.scale .5", py + theme(ggside.panel.scale = .5)) 20 | expect_doppelganger("grid xyside ggside.panel.scale.x .5", pxy + theme(ggside.panel.scale.x = .5)) 21 | expect_doppelganger("grid xyside ggside.panel.scale.y .5", pxy + theme(ggside.panel.scale.y = .5)) 22 | expect_doppelganger("grid xyside ggside.panel.scale .5", pxy + theme(ggside.panel.scale = .5)) 23 | }) 24 | 25 | test_that("ggside.panel.spacing facetGrid", { 26 | expect_doppelganger("grid xside ggside.panel.spacing.x 10pt", px + theme(ggside.panel.spacing.x = unit(10, "pt"))) 27 | expect_doppelganger("grid xside ggside.panel.spacing.y 10pt", px + theme(ggside.panel.spacing.y = unit(10, "pt"))) 28 | expect_doppelganger("grid xside ggside.panel.spacing 10pt", px + theme(ggside.panel.spacing = unit(10, "pt"))) 29 | expect_doppelganger("grid yside ggside.panel.spacing.x 10pt", py + theme(ggside.panel.spacing.x = unit(10, "pt"))) 30 | expect_doppelganger("grid yside ggside.panel.spacing.y 10pt", py + theme(ggside.panel.spacing.y = unit(10, "pt"))) 31 | expect_doppelganger("grid yside ggside.panel.spacing 10pt", py + theme(ggside.panel.spacing = unit(10, "pt"))) 32 | expect_doppelganger("grid xyside ggside.panel.spacing.x 10pt", pxy + theme(ggside.panel.spacing.x = unit(10, "pt"))) 33 | expect_doppelganger("grid xyside ggside.panel.spacing.y 10pt", pxy + theme(ggside.panel.spacing.y = unit(10, "pt"))) 34 | expect_doppelganger("grid xyside ggside.panel.spacing 10pt", pxy + theme(ggside.panel.spacing = unit(10, "pt"))) 35 | }) 36 | -------------------------------------------------------------------------------- /R/geom-sideboxplot.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include constructor-.R 3 | NULL 4 | ### INCLUDE END 5 | 6 | #' @title Side boxplots 7 | #' @description 8 | #' The [xside] and [yside] variants of \link[ggplot2]{geom_boxplot} 9 | #' is [geom_xsideboxplot] and [geom_ysideboxplot]. 10 | #' 11 | #' @inheritParams ggplot2::layer 12 | #' @inheritParams ggplot2::geom_boxplot 13 | #' 14 | #' @seealso [geom_*sideviolin] 15 | #' @aliases geom_*sideboxplot 16 | #' @return XLayer or YLayer object to be added to a ggplot object 17 | #' @examples 18 | #' 19 | #' df <- expand.grid(UpperCase = LETTERS, LowerCase = letters) 20 | #' df$Combo_Index <- as.integer(df$UpperCase)*as.integer(df$LowerCase) 21 | #' 22 | #' p1 <- ggplot(df, aes(UpperCase, LowerCase)) + 23 | #' geom_tile(aes(fill = Combo_Index)) 24 | #' 25 | #' #sideboxplots 26 | #' 27 | #' p1 + geom_xsideboxplot(aes(y = Combo_Index)) + 28 | #' geom_ysideboxplot(aes(x = Combo_Index)) + 29 | #' #when mixing continuous/discrete scales 30 | #' #use the following helper functions 31 | #' scale_xsidey_continuous() + 32 | #' scale_ysidex_continuous() 33 | #' 34 | #' #sideboxplots with swapped orientation 35 | #' #Note: They order of the layers are affects the default 36 | #' # scale type. If you were to omit the last two scales, the 37 | #' # data labels may be affected 38 | #' ggplot(iris, aes(Sepal.Width, Sepal.Length, color = Species)) + 39 | #' geom_xsideboxplot(aes(y = Species), orientation = "y") + 40 | #' geom_point() + 41 | #' scale_y_continuous() + scale_xsidey_discrete() 42 | #' 43 | #' #If using the scale_(xsidey|ysidex)_* functions are a bit cumbersome, 44 | #' # Take extra care to recast your data types. 45 | #' ggplot(iris, aes(Sepal.Width, Sepal.Length, color = Species))+ 46 | #' geom_point() + 47 | #' geom_xsideboxplot(aes(y = as.numeric(Species)), orientation = "y") + 48 | #' geom_ysideboxplot(aes(x = as.numeric(Species)), orientation = "x") 49 | #' 50 | #' @export 51 | geom_xsideboxplot <- ggside_layer_function(fun = geom_boxplot, side = "x") 52 | 53 | #' @rdname ggside-ggproto-geoms 54 | #' @usage NULL 55 | #' @format NULL 56 | #' @export 57 | GeomXsideboxplot <- ggside_geom("GeomXsideboxplot", GeomBoxplot, "x") 58 | 59 | 60 | #' @rdname geom_xsideboxplot 61 | #' @export 62 | geom_ysideboxplot <- ggside_layer_function(fun = geom_boxplot, side = "y") 63 | 64 | #' @rdname ggside-ggproto-geoms 65 | #' @usage NULL 66 | #' @format NULL 67 | #' @export 68 | GeomYsideboxplot <- ggside_geom("GeomYsideboxplot", GeomBoxplot, "y") 69 | 70 | -------------------------------------------------------------------------------- /tests/testthat/test_vdiff_diamondplots.R: -------------------------------------------------------------------------------- 1 | suppressMessages({ 2 | library(dplyr, quietly = T) 3 | library(tidyr, quietly = T) 4 | library(vdiffr) 5 | library(ggdendro, quietly = T) 6 | }) 7 | 8 | df0 <- mutate(diamonds, 9 | colclar = interaction(color, clarity, 10 | sep = "_", drop = T)) 11 | df1 <- df0 %>% 12 | group_by(color, clarity, colclar, cut) %>% 13 | summarise(m_price = mean(price)) 14 | df <- df1 %>% 15 | pivot_wider(id_cols = colclar, 16 | names_from = cut, 17 | values_from = m_price, 18 | values_fill = 0L) 19 | 20 | mat <- as.matrix(df[,2:6]) 21 | rownames(mat) <- df[["colclar"]] 22 | dst <- dist(mat) 23 | hc_x <- hclust(dst) 24 | lvls <- rownames(mat)[hc_x$order] 25 | 26 | df1[["colclar"]] <- factor(df1[["colclar"]], levels = lvls) 27 | dst <- dist(t(mat)) 28 | hc_y <- hclust(dst) 29 | lvls <- colnames(mat)[hc_y$order] 30 | df1[["cut"]] <- factor(df1[["cut"]], levels = lvls) 31 | dendrox <- dendro_data(hc_x) 32 | dendroy <- dendro_data(hc_y) 33 | 34 | p <- ggplot(df1, aes(x = colclar, cut)) + 35 | geom_tile(aes(fill = m_price)) + 36 | viridis::scale_fill_viridis(option = "magma") + 37 | theme(axis.text.x = element_text(angle = 90, vjust = .5)) 38 | 39 | test_that("Testing Heatmap Base is consistent",{ 40 | expect_doppelganger("Heatmap Base",p) 41 | }) 42 | 43 | # test_that("geom_sidesegment",{ 44 | # p0 <- p + 45 | # geom_xsidetile(aes(y = "Color", xfill = color)) + 46 | # geom_xsidetile(aes(y = "Clarity", xfill = clarity)) + 47 | # geom_xsidesegment(data = dendrox$segments, 48 | # aes(x = x, y = y, xend = xend, yend = yend), 49 | # position = position_yrescale(midpoint = 4.5, range = 4, location = "top")) + 50 | # geom_ysidesegment(data = dendroy$segments, 51 | # aes(y = x, yend = xend, x = y, xend = yend)) + 52 | # theme_minimal() + 53 | # theme(axis.text.x=element_blank(), panel.grid = element_blank()) + 54 | # scale_y_discrete(expand = expansion()) + 55 | # scale_xsidey_discrete(expand = expansion()) + 56 | # guides(xfill = "none") 57 | # expect_doppelganger(title = "xySideSegments & xSideTile", p0) 58 | # }) 59 | 60 | test_that("geom_sideboxplot", { 61 | p0 <- p + 62 | geom_xsideboxplot(data = df0, aes(y = price)) + 63 | geom_ysideboxplot(data = df0, aes(x = price)) + 64 | theme( 65 | ggside.panel.scale = .2 66 | ) 67 | expect_doppelganger(title = "xySideBoxplots", p0) 68 | }) 69 | 70 | -------------------------------------------------------------------------------- /.github/workflows/pr-commands.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 | issue_comment: 5 | types: [created] 6 | 7 | name: Commands 8 | 9 | jobs: 10 | document: 11 | if: ${{ github.event.issue.pull_request && (github.event.comment.author_association == 'MEMBER' || github.event.comment.author_association == 'OWNER') && startsWith(github.event.comment.body, '/document') }} 12 | name: document 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | steps: 17 | - uses: actions/checkout@v4 18 | 19 | - uses: r-lib/actions/pr-fetch@v2 20 | with: 21 | repo-token: ${{ secrets.GITHUB_TOKEN }} 22 | 23 | - uses: r-lib/actions/setup-r@v2 24 | with: 25 | use-public-rspm: true 26 | 27 | - uses: r-lib/actions/setup-r-dependencies@v2 28 | with: 29 | extra-packages: any::roxygen2 30 | needs: pr-document 31 | 32 | - name: Document 33 | run: roxygen2::roxygenise() 34 | shell: Rscript {0} 35 | 36 | - name: commit 37 | run: | 38 | git config --local user.name "$GITHUB_ACTOR" 39 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 40 | git add man/\* NAMESPACE 41 | git commit -m 'Document' 42 | 43 | - uses: r-lib/actions/pr-push@v2 44 | with: 45 | repo-token: ${{ secrets.GITHUB_TOKEN }} 46 | 47 | style: 48 | if: ${{ github.event.issue.pull_request && (github.event.comment.author_association == 'MEMBER' || github.event.comment.author_association == 'OWNER') && startsWith(github.event.comment.body, '/style') }} 49 | name: style 50 | runs-on: ubuntu-latest 51 | env: 52 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 53 | steps: 54 | - uses: actions/checkout@v4 55 | 56 | - uses: r-lib/actions/pr-fetch@v2 57 | with: 58 | repo-token: ${{ secrets.GITHUB_TOKEN }} 59 | 60 | - uses: r-lib/actions/setup-r@v2 61 | 62 | - name: Install dependencies 63 | run: install.packages("styler") 64 | shell: Rscript {0} 65 | 66 | - name: Style 67 | run: styler::style_pkg() 68 | shell: Rscript {0} 69 | 70 | - name: commit 71 | run: | 72 | git config --local user.name "$GITHUB_ACTOR" 73 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 74 | git add \*.R 75 | git commit -m 'Style' 76 | 77 | - uses: r-lib/actions/pr-push@v2 78 | with: 79 | repo-token: ${{ secrets.GITHUB_TOKEN }} 80 | -------------------------------------------------------------------------------- /R/ggplot_add.R: -------------------------------------------------------------------------------- 1 | # ### INCLUDE BEGIN 2 | #' @include side-facet_.R 3 | # #' @include add_gg.R 4 | # #' @include all_classes.r 5 | # #' @include ggside.R 6 | # #' @include plot-construction.R 7 | # NULL 8 | # ### INCLUDE END 9 | 10 | 11 | # S7::method(`+`, list(class_ggside, S7::class_any)) <- function(e1, e2) { 12 | # p <- S7::super(e1, class_ggplot) + e2 13 | # p <- clone_ggside_plot(p) 14 | # validate_ggside(e2, plot = p) 15 | # } 16 | 17 | 18 | clone_ggside_plot <- function(plot) { 19 | # does not clone scales, we should assume they 20 | # have been already 21 | ggside_opt <- clone_ggside(S7::prop(plot, "ggside_opt")) 22 | S7::set_props( 23 | plot, 24 | ggside_opt = ggside_opt, 25 | facet = ggside_facet(S7::prop(plot, "facet"), ggside_opt) 26 | ) 27 | } 28 | 29 | clone_ggside <- function(ggside) { 30 | new_ggside <- ggside( 31 | x.pos = ggside$x.pos, 32 | y.pos = ggside$y.pos, 33 | scales = ggside$scales, 34 | collapse = ggside$collapse, 35 | draw_x_on = ggside$draw_x_on, 36 | draw_y_on = ggside$draw_y_on, 37 | strip = ggside$strip, 38 | respect_side_labels = ggside$respect_side_labels 39 | ) 40 | if (!is.null(ggside$xsidey)) { 41 | new_ggside$xsidey <- ggside$xsidey$clone() 42 | } 43 | if (!is.null(ggside$ysidex)) { 44 | new_ggside$ysidex <- ggside$ysidex$clone() 45 | } 46 | if (!is.null(ggside$sides_used)) { 47 | new_ggside$sides_used <- ggside$sides_used 48 | } 49 | new_ggside 50 | } 51 | 52 | 53 | 54 | # #' @importFrom ggplot2 ggplot_add 55 | # #' @export 56 | # ggplot_add.ggside_layer <- function(object, plot, ...) { 57 | # plot <- NextMethod("ggplot_add") 58 | # if (is_ggside(plot)) { 59 | # plot <- clone_ggside_plot(plot) 60 | # } 61 | # as_ggside(plot) 62 | # } 63 | 64 | # #' @export 65 | # ggplot_add.ggside_options <- function(object, plot, ...) { 66 | # ## adding a ggside_options object to a ggplot 67 | # # will update the ggside options on the plot 68 | # # since ggside_options is a ggproto, we do not 69 | # # know where the resulting plot will be used. 70 | # # we must clone the ggside_opt field so that 71 | # # the ggside options are not shared between plots. 72 | 73 | # if (is_ggside(plot)) { 74 | # plot <- clone_ggside_plot(plot) 75 | # } 76 | # as_ggside(plot, ggside = object) 77 | # } 78 | 79 | 80 | # #' @export 81 | # ggplot_add.ggside_scale <- function(object, plot, ...) { 82 | # is_ggside_obj <- is_ggside(plot) 83 | # ggside_opt <- if (is_ggside_obj) { 84 | # plot <- clone_ggside_plot(plot) 85 | # plot$ggside_opt 86 | # } else { 87 | # ggside() 88 | # } 89 | # # save scale in appropriate place 90 | # ggside_opt[[intersect(c("xsidey", "ysidex"), object$aesthetics)]] <- object 91 | # new_scale <- object$clone() 92 | # new_scale$guide <- waiver() 93 | # plot$scales$add(new_scale) 94 | # if (!is_ggside_obj) { 95 | # plot <- as_ggside(plot, ggside = ggside_opt) 96 | # } 97 | # plot 98 | # } 99 | -------------------------------------------------------------------------------- /tests/testthat/test_ggside_axis_polts.R: -------------------------------------------------------------------------------- 1 | library(vdiffr) 2 | 3 | df <- data.frame(x = 1:10, y = 21:30, 4 | a = rep(c("g1","g2"), 5), 5 | b = rep(c("t1","t2"), each = 5)) 6 | p <- ggplot(df, aes(x, y)) + 7 | geom_point() 8 | test_that("base plot did not change",{ 9 | expect_doppelganger("base plot", p) 10 | }) 11 | 12 | px <- p + geom_xsidecol(width = 0.9) 13 | py <- p + geom_ysidecol(width = 0.9) 14 | 15 | test_that("ggside x-axis plotting",{ 16 | expect_doppelganger("xside top", px) 17 | pxb <- px + ggside(x.pos = "bottom") 18 | expect_doppelganger("xside bottom", pxb) 19 | expect_doppelganger("xside top-pos-top", px + scale_x_continuous(position = "top")) 20 | expect_doppelganger("xside bot-pos-top", pxb + scale_x_continuous(position = "top")) 21 | expect_doppelganger("xside top-pos-top-wrap", px + scale_x_continuous(position = "top") + facet_wrap(a~b)) 22 | expect_doppelganger("xside bot-pos-top-grid", pxb + scale_x_continuous(position = "top") + facet_grid(vars(a), vars(b))) 23 | expect_doppelganger("xside top-noaxis", px + theme(axis.text.x = element_blank())) 24 | }) 25 | 26 | test_that("ggside y-axis plotting",{ 27 | expect_doppelganger("yside right", py) 28 | pyl <- py + ggside(y.pos = "left") 29 | expect_doppelganger("yside left", pyl) 30 | expect_doppelganger("yside right-pos-right", py + scale_y_continuous(position = "right")) 31 | expect_doppelganger("yside left-pos-right", pyl + scale_y_continuous(position = "right")) 32 | expect_doppelganger("yside right-pos-right-wrap", py + scale_y_continuous(position = "right") + facet_wrap(a~b)) 33 | expect_doppelganger("yside left-pos-right-grid", pyl + scale_y_continuous(position = "right") + facet_grid(vars(a), vars(b))) 34 | expect_doppelganger("yside right-noaxis", py + theme(axis.text.y = element_blank())) 35 | }) 36 | 37 | pxy <- p + geom_xsidecol(width = 0.9) + geom_ysidecol(width = 0.9) 38 | 39 | test_that("ggside xy-axis plotting", { 40 | expect_doppelganger("xyside", pxy) 41 | pxy_l <- pxy + ggside(y.pos = "left") 42 | pxy_b <- pxy + ggside(x.pos = "bottom") 43 | expect_doppelganger("xyside yl", pxy_l) 44 | expect_doppelganger("xyside yl-pos-right", pxy_l + scale_y_continuous(position = "right")) 45 | expect_doppelganger("xyside xb", pxy_b) 46 | expect_doppelganger("xyside xb-pos-top", pxy_b + scale_x_continuous(position = "top")) 47 | pxy_lb <- pxy + ggside(y.pos = "left", x.pos = "bottom") 48 | expect_doppelganger("xyside lb", pxy_lb) 49 | expect_doppelganger("xyside lb-pos-swap", pxy_lb + scale_x_continuous(position = "top")+scale_y_continuous(position = "right")) 50 | expect_doppelganger("xyside no-x-text", pxy + theme(axis.text.x = element_blank())) 51 | expect_doppelganger("xyside no-y-text", pxy + theme(axis.text.y = element_blank())) 52 | expect_doppelganger("xyside facet-Grid", pxy + facet_grid(vars(a), vars(b))) 53 | }) 54 | 55 | 56 | test_that("ggside FacetGrid strip option works", { 57 | 58 | expect_doppelganger("xyside strip main", pxy + facet_grid(vars(a), vars(b)) + ggside(strip = "main")) 59 | }) 60 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: ggside 2 | Type: Package 3 | Title: Side Grammar Graphics 4 | Version: 0.4.1 5 | Authors@R: 6 | person(given = "Justin", 7 | family = "Landis", 8 | role = c("aut", "cre"), 9 | email = "jtlandis314@gmail.com", 10 | comment = c(ORCID = "0000-0001-5501-4934")) 11 | Maintainer: Justin Landis 12 | Description: The grammar of graphics as shown in 'ggplot2' has provided 13 | an expressive API for users to build plots. 'ggside' extends 'ggplot2' 14 | by allowing users to add graphical information about one of the main panel's 15 | axis using a familiar 'ggplot2' style API with tidy data. This package is 16 | particularly useful for visualizing metadata on a discrete axis, or summary 17 | graphics on a continuous axis such as a boxplot or a density distribution. 18 | License: MIT + file LICENSE 19 | URL: https://github.com/jtlandis/ggside 20 | BugReports: https://github.com/jtlandis/ggside/issues 21 | Encoding: UTF-8 22 | Roxygen: list(markdown = TRUE) 23 | RoxygenNote: 7.3.3 24 | VignetteBuilder: knitr 25 | Depends: 26 | R (>= 4.1), 27 | ggplot2 (>= 4.0.0) 28 | Imports: 29 | grid, 30 | gtable, 31 | rlang, 32 | scales (>= 1.3.0), 33 | cli, 34 | glue, 35 | stats, 36 | tibble, 37 | vctrs, 38 | S7, 39 | lifecycle 40 | Suggests: 41 | tidyr, 42 | dplyr, 43 | testthat (>= 3.0.3), 44 | knitr, 45 | rmarkdown, 46 | vdiffr (>= 1.0.0), 47 | ggdendro, 48 | viridis, 49 | waldo 50 | Config/testthat/edition: 3 51 | Config/testthat/parallel: true 52 | Config/testthat/start-first: all_ggside_layers, *themes 53 | Collate: 54 | 'utils-ggproto.R' 55 | 'utils-calls.R' 56 | 'utils-ggplot2-reimpl-.R' 57 | 'utils-constructors.R' 58 | 'side-layer.R' 59 | 'constructor-.R' 60 | 'utils-.R' 61 | 'ggside.R' 62 | 'utils-side-facet.R' 63 | 'side-facet_.R' 64 | 'utils-side-coord.R' 65 | 'side-coord-cartesian.R' 66 | 'add_gg.R' 67 | 'ggplot_add.R' 68 | 'side-layout-.r' 69 | 'all_classes.r' 70 | 'geom-sideabline.r' 71 | 'geom-sidebar.r' 72 | 'geom-sideboxplot.r' 73 | 'geom-sidecol.r' 74 | 'geom-sidedensity.r' 75 | 'geom-sidefreqpoly.r' 76 | 'geom-sidefunction.r' 77 | 'geom-sidehistogram.r' 78 | 'geom-sidehline.r' 79 | 'geom-sidelabel.r' 80 | 'geom-sideline.r' 81 | 'geom-sidepath.r' 82 | 'geom-sidepoint.r' 83 | 'geom-sidesegment.r' 84 | 'geom-sidetext.r' 85 | 'geom-sidetile.r' 86 | 'geom-sideviolin.r' 87 | 'geom-sidevline.r' 88 | 'ggside-ggproto.r' 89 | 'ggside-package.r' 90 | 'ggside-themes.R' 91 | 'plot-construction.R' 92 | 'position_rescale.r' 93 | 'scales-sides-.R' 94 | 'scales-xycolour.R' 95 | 'scales-xyfill.R' 96 | 'utils-ggplot2-reimpl-facet.R' 97 | 'side-facet-wrap.R' 98 | 'side-facet-grid.R' 99 | 'side-facet-null.R' 100 | 'stats.r' 101 | 'update_ggplot.R' 102 | 'z-depricated.R' 103 | 'zzz.R' 104 | -------------------------------------------------------------------------------- /tests/testthat/test_axis_render_position.R: -------------------------------------------------------------------------------- 1 | library(vdiffr) 2 | 3 | test_that("axis may be rendered in between plots", { 4 | p <- ggplot(iris, aes(Sepal.Width, Sepal.Length)) + 5 | geom_point() + 6 | geom_xsidedensity(aes(color = Species)) + 7 | geom_ysidedensity() 8 | 9 | expect_doppelganger("default", p) 10 | 11 | expect_doppelganger("x-on-side", p + ggside(draw_x_on = "side")) 12 | 13 | ## broken 14 | expect_doppelganger("x-on-main-top", p + ggside(draw_x_on = "main") + 15 | scale_x_continuous(position = "top")) 16 | ## broken 17 | expect_doppelganger( 18 | "x-on-side-pos-bot", 19 | p + ggside(draw_x_on = "side", x.pos = "bottom") + 20 | scale_x_continuous(position = "top") 21 | ) 22 | expect_doppelganger("x-on-main-pos-bot", p + ggside(draw_x_on = "main", x.pos = "bottom")) 23 | 24 | expect_doppelganger("y-on-side", p + ggside(draw_y_on = "side")) 25 | 26 | expect_doppelganger("y-on-main-right", p + ggside(draw_y_on = "main") + 27 | scale_y_continuous(position = "right")) 28 | expect_doppelganger("y-on-side-pos-left", p + ggside(draw_y_on = "side", y.pos = "left") + 29 | scale_y_continuous(position = "right")) 30 | expect_doppelganger("y-on-main-pos-left", p + ggside(draw_y_on = "main", y.pos = "left")) 31 | 32 | # Facet-wrap 33 | .p <- p 34 | p <- p + facet_wrap(~Species) 35 | expect_doppelganger("wrap-default", p) 36 | 37 | expect_doppelganger("wrap-x-on-side", p + ggside(draw_x_on = "side")) 38 | 39 | expect_doppelganger("wrap-x-on-main-top", p + ggside(draw_x_on = "main") + 40 | scale_x_continuous(position = "top")) 41 | expect_doppelganger("wrap-x-on-side-pos-bot", p + ggside(draw_x_on = "side", x.pos = "bottom") + 42 | scale_x_continuous(position = "top")) 43 | expect_doppelganger("wrap-x-on-main-pos-bot", p + ggside(draw_x_on = "main", x.pos = "bottom")) 44 | 45 | expect_doppelganger("wrap-y-on-side", p + ggside(draw_y_on = "side")) 46 | 47 | expect_doppelganger("wrap-y-on-main-right", p + ggside(draw_y_on = "main") + 48 | scale_y_continuous(position = "right")) 49 | expect_doppelganger("wrap-y-on-side-pos-left", p + ggside(draw_y_on = "side", y.pos = "left") + 50 | scale_y_continuous(position = "right")) 51 | expect_doppelganger("wrap-y-on-main-pos-left", p + ggside(draw_y_on = "main", y.pos = "left")) 52 | 53 | # Facet-grid 54 | p <- .p + facet_grid(rows = vars(Species)) + ggside(collapse = "all") 55 | expect_doppelganger("grid-default", p) 56 | 57 | expect_doppelganger("grid-x-on-side", p + ggside(draw_x_on = "side")) 58 | 59 | expect_doppelganger("grid-x-on-main-top", p + ggside(draw_x_on = "main") + 60 | scale_x_continuous(position = "top")) 61 | expect_doppelganger("grid-x-on-side-pos-bot", p + ggside(draw_x_on = "side", x.pos = "bottom") + 62 | scale_x_continuous(position = "top")) 63 | expect_doppelganger("grid-x-on-main-pos-bot", p + ggside(draw_x_on = "main", x.pos = "bottom")) 64 | 65 | expect_doppelganger("grid-y-on-side", p + ggside(draw_y_on = "side")) 66 | 67 | expect_doppelganger("grid-y-on-main-right", p + ggside(draw_y_on = "main") + 68 | scale_y_continuous(position = "right")) 69 | expect_doppelganger("grid-y-on-side-pos-left", p + ggside(draw_y_on = "side", y.pos = "left") + 70 | scale_y_continuous(position = "right")) 71 | expect_doppelganger("grid-y-on-main-pos-left", p + ggside(draw_y_on = "main", y.pos = "left")) 72 | }) 73 | -------------------------------------------------------------------------------- /R/utils-calls.R: -------------------------------------------------------------------------------- 1 | zap_dots <- function(call, zap = character(), ...) { 2 | # force dots to be evaluated... 3 | dots <- enquos(...) |> 4 | lapply(rlang::eval_tidy) 5 | # remove dots and splice them in 6 | call <- call_modify(call, ... = zap(), !!!dots) 7 | if (length(zap) > 0) { 8 | to_zap <- rep_named(zap, list(zap())) 9 | call <- call_modify(call, !!!to_zap) 10 | } 11 | call 12 | } 13 | 14 | call_layer_param_aware <- 15 | function(expr, 16 | zap = character(), 17 | ..., 18 | env = caller_env()) { 19 | call <- match.call()$expr 20 | call <- zap_dots(call, zap = zap, ...) 21 | layer <- eval(call, envir = env) 22 | any_zap <- length(zap) > 0 23 | dot_names <- ...names() 24 | if (length(intersect(dot_names, zap)) > 0) { 25 | ind <- which(dot_names %in% zap) 26 | new_name <- sub("color", "colour", dot_names[ind], fixed = TRUE) 27 | lst <- vector("list", length(ind)) 28 | for (i in seq_along(lst)) { 29 | lst[[i]] <- ...elt(ind[i]) 30 | } 31 | layer$aes_params[new_name] <- lst 32 | } 33 | layer 34 | } 35 | 36 | modify_body <- function(call_body, from, to) { 37 | for (i in seq_along(call_body)) { 38 | call <- call_body[[i]] 39 | if (!rlang::is_missing(call)) { 40 | if (identical(call, from)) { 41 | call_body[[i]] <- to 42 | } else if (length(call) > 1) { 43 | call_body[[i]] <- modify_body(call, from, to) 44 | } 45 | } 46 | } 47 | call_body 48 | } 49 | 50 | # list_of_calls <- function(x) { 51 | # vapply(x, function(y) is.call(y) || is.name(y) || (length(y) == 1 && is.character(y)), logical(1)) 52 | # } 53 | 54 | mod_ggproto_fun <- function(ggproto_method, ...) { 55 | call <- match.call(expand.dots = F) 56 | formulas <- vapply(call$..., rlang::is_formula, logical(1)) 57 | if (!all(formulas)) stop("all `...` should be formulas") 58 | proto_env <- environment(ggproto_method) 59 | body <- body(proto_env$f) 60 | len <- ...length() 61 | for (i in seq_len(len)) { 62 | spec <- ...elt(i) 63 | body <- modify_body(body, spec[[2]], spec[[3]]) 64 | } 65 | rlang::new_function( 66 | args = formals(proto_env$f), 67 | body = body, 68 | env = proto_env 69 | ) 70 | } 71 | 72 | mod_fun_at <- function(fun, insert, at) { 73 | body(fun) <- insert_call_at(body(fun), insert, at) 74 | fun 75 | } 76 | 77 | insert_call_at <- function(call, insert, at) { 78 | stopifnot( 79 | "`call` isnt a call" = is.call(call), 80 | "`at` isnt integer" = is.numeric(at) 81 | ) 82 | len <- length(call) 83 | at <- as.integer(at) 84 | if (at < 0) { 85 | at <- len + at 86 | } 87 | if (at <= 0) { 88 | at <- 1L 89 | } else if (at > len) { 90 | at <- len 91 | } 92 | 93 | seq_args <- seq_along(call)[-1] 94 | seq_upto <- seq_args[seq_len(at - 1)] 95 | seq_after <- setdiff(seq_args, seq_upto) 96 | 97 | new_call <- as.call(list(call[[1]])) 98 | for (i in seq_upto) { 99 | new_call[[i]] <- call[[i]] 100 | } 101 | new_call[[at + 1]] <- insert 102 | 103 | for (i in seq_after) { 104 | new_call[[i + 1]] <- call[[i]] 105 | } 106 | 107 | new_call 108 | } 109 | 110 | browse_fun <- function(fun, at = 1) { 111 | body(fun) <- insert_call_at(body(fun), quote(browser()), at) 112 | fun 113 | } 114 | -------------------------------------------------------------------------------- /R/utils-ggplot2-reimpl-facet.R: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include utils-ggplot2-reimpl-.R 3 | NULL 4 | ### INCLUDE END 5 | 6 | 7 | eval_facet <- function (facet, data, possible_columns = NULL) { 8 | if (quo_is_symbol(facet)) { 9 | facet <- as.character(quo_get_expr(facet)) 10 | if (facet %in% names(data)) { 11 | out <- data[[facet]] 12 | } 13 | else { 14 | out <- NULL 15 | } 16 | return(out) 17 | } 18 | env <- new_environment(data) 19 | missing_columns <- setdiff(possible_columns, names(data)) 20 | undefined_error <- function(e) abort("", class = "ggplot2_missing_facet_var") 21 | bindings <- rep_named(missing_columns, list(undefined_error)) 22 | env_bind_active(env, !!!bindings) 23 | mask <- new_data_mask(env) 24 | mask$.data <- as_data_pronoun(mask) 25 | tryCatch(eval_tidy(facet, mask), ggplot2_missing_facet_var = function(e) NULL) 26 | } 27 | 28 | eval_facets <- function (facets, data, possible_columns = NULL) { 29 | vars <- compact(lapply(facets, eval_facet, data, possible_columns = possible_columns)) 30 | data_frame0(tibble::as_tibble(vars)) 31 | } 32 | 33 | 34 | reshape_margins <- function (vars, margins = NULL) { 35 | if (is.null(margins) || identical(margins, FALSE)) 36 | return(NULL) 37 | all_vars <- unlist(vars) 38 | if (isTRUE(margins)) { 39 | margins <- all_vars 40 | } 41 | dims <- lapply(vars, intersect, margins) 42 | dims <- mapply(function(vars, margin) { 43 | lapply(margin, downto, vars) 44 | }, vars, dims, SIMPLIFY = FALSE, USE.NAMES = FALSE) 45 | seq_0 <- function(x) c(0, seq_along(x)) 46 | indices <- expand.grid(lapply(dims, seq_0), KEEP.OUT.ATTRS = FALSE) 47 | lapply(seq_len(nrow(indices)), function(i) { 48 | unlist(mapply("[", dims, indices[i, ], SIMPLIFY = FALSE)) 49 | }) 50 | } 51 | 52 | reshape_add_margins <- function (df, vars, margins = TRUE) { 53 | margin_vars <- reshape_margins(vars, margins) 54 | if (length(margin_vars) == 0) 55 | return(df) 56 | addAll <- function(x) { 57 | x <- addNA(x, TRUE) 58 | factor(x, levels = c(levels(x), "(all)"), exclude = NULL) 59 | } 60 | vars <- unique(unlist(margin_vars)) 61 | df[vars] <- lapply(df[vars], addAll) 62 | rownames(df) <- NULL 63 | margin_dfs <- lapply(margin_vars, function(vars) { 64 | df[vars] <- rep(list(factor("(all)")), length(vars)) 65 | df 66 | }) 67 | data_frame0(!!!margin_dfs) 68 | } 69 | 70 | 71 | width_cm <- function (x) 72 | { 73 | if (is.grob(x)) { 74 | convertWidth(grobWidth(x), "cm", TRUE) 75 | } 76 | else if (is.unit(x)) { 77 | convertWidth(x, "cm", TRUE) 78 | } 79 | else if (is.list(x)) { 80 | vapply(x, width_cm, numeric(1)) 81 | } 82 | else { 83 | cli::cli_abort("Don't know how to get width of {.cls {class(x)}} object") 84 | } 85 | } 86 | 87 | height_cm <- function (x) 88 | { 89 | if (is.grob(x)) { 90 | convertHeight(grobHeight(x), "cm", TRUE) 91 | } 92 | else if (is.unit(x)) { 93 | convertHeight(x, "cm", TRUE) 94 | } 95 | else if (is.list(x)) { 96 | vapply(x, height_cm, numeric(1)) 97 | } 98 | else { 99 | cli::cli_abort("Don't know how to get height of {.cls {class(x)}} object") 100 | } 101 | } 102 | 103 | downto <- function(a, b){ 104 | rev(upto(a, rev(b))) 105 | } 106 | 107 | upto <- function(a, b) { 108 | b[seq_len(match(a, b, nomatch = 0))] 109 | } 110 | -------------------------------------------------------------------------------- /tests/testthat/test_ggside_respect_labels.R: -------------------------------------------------------------------------------- 1 | library(vdiffr) 2 | 3 | df <- data.frame(x = 1:10, y = 21:30, 4 | a = rep(c("g1","g2"), 5), 5 | b = rep(c("t1","t2"), each = 5)) 6 | p <- ggplot(df, aes(x, y)) + 7 | geom_point() 8 | 9 | # removing y axis from main to see 10 | # the affects of the spacing more clearly 11 | px <- p + geom_xsidecol(width = 0.9) + 12 | theme(axis.text.y = element_blank(), axis.ticks.y = element_blank()) + 13 | theme_ggside_gray() 14 | 15 | py <- p + geom_ysidecol(width = 0.9) + 16 | theme(ggside.axis.text.x = element_text(angle = 90, vjust = .5)) 17 | 18 | pxy <- p + geom_xsidecol(width = 0.9) + 19 | geom_ysidecol(width = 0.9) + 20 | theme(ggside.axis.text.x = element_text(angle = 90, vjust = .5)) 21 | 22 | test_that("ggside `respect_side_labels` works on xsides", { 23 | expect_doppelganger("xside respect default", px) 24 | expect_doppelganger("xside respect x", px + ggside(respect_side_labels = "x")) 25 | expect_doppelganger("xside respect y", px + ggside(respect_side_labels = "y")) 26 | expect_doppelganger("xside respect all", px + ggside(respect_side_labels = "all")) 27 | expect_doppelganger("xside respect none", px + ggside(respect_side_labels = "none")) 28 | }) 29 | 30 | 31 | test_that("ggside `respect_side_labels` works on ysides", { 32 | expect_doppelganger("yside respect default", py) 33 | expect_doppelganger("yside respect x", py + ggside(respect_side_labels = "x")) 34 | expect_doppelganger("yside respect y", py + ggside(respect_side_labels = "y")) 35 | expect_doppelganger("yside respect all", py + ggside(respect_side_labels = "all")) 36 | expect_doppelganger("yside respect none", py + ggside(respect_side_labels = "none")) 37 | }) 38 | 39 | 40 | test_that("ggside `respect_side_labels` works as expected on x and y sides", { 41 | expect_doppelganger("xyside respect long ysidex label", pxy) 42 | pxy_l <- pxy + ggside(y.pos = "left") 43 | pxy_b <- pxy + ggside(x.pos = "bottom") + theme(axis.text.y = element_blank(), axis.ticks.y = element_blank()) + 44 | theme_ggside_gray() 45 | expect_doppelganger("xyside yl respect default", pxy_l) 46 | expect_doppelganger("xyside yl respect x", pxy_l + ggside(respect_side_labels = "x")) 47 | expect_doppelganger("xyside yl respect y", pxy_l + ggside(respect_side_labels = "y")) 48 | expect_doppelganger("xyside yl respect all", pxy_l + ggside(respect_side_labels = "all")) 49 | expect_doppelganger("xyside yl respect none", pxy_l + ggside(respect_side_labels = "none")) 50 | expect_doppelganger("xyside xb respect default", pxy_b) 51 | expect_doppelganger("xyside xb respect x", pxy_b + ggside(respect_side_labels = "x")) 52 | expect_doppelganger("xyside xb respect y", pxy_b + ggside(respect_side_labels = "y")) 53 | expect_doppelganger("xyside xb respect all", pxy_b + ggside(respect_side_labels = "all")) 54 | expect_doppelganger("xyside xb respect none", pxy_b + ggside(respect_side_labels = "none")) 55 | 56 | 57 | }) 58 | 59 | test_that("ggside `respect_side_labels` works as expected with other parameters and facets", { 60 | pxyf <- pxy + facet_grid(vars(a), vars(b)) 61 | expect_doppelganger("xyside facet-Grid respect default", pxyf) 62 | expect_doppelganger("xyside facet-Grid respect none", pxyf + ggside(respect_side_labels = "none")) 63 | expect_doppelganger("xyside facet-Grid respect none free scales", pxyf + ggside(respect_side_labels = "none", scales = "free")) 64 | expect_doppelganger("xyside facet-Grid respect default free scales", pxyf + ggside(respect_side_labels = "default", scales = "free")) 65 | }) 66 | -------------------------------------------------------------------------------- /vignettes/ggside_aes_mapping.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Global Aesthetics Mappings and Side Geometries" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Global Aesthetics Mappings and Side Geometries} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r knitr_setup, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>", 14 | fig.width = 8, 15 | fig.height = 6, 16 | out.width = '100%' 17 | ) 18 | ``` 19 | 20 | ```{r setup} 21 | library(ggside) 22 | ``` 23 | 24 | ```{r} 25 | p <- ggplot(mpg, aes(displ, hwy, colour = class)) + 26 | geom_point(size = 2) + 27 | theme_bw() 28 | ``` 29 | 30 | The purpose of this vignette is to document a _slight_ change in API expectation with certain `geom_*side*` when there are global aesthetic mappings for both `x` and `y`. 31 | 32 | In `ggside (<0.1.0)`, the user was expected to explicitly map all computed aesthetics, especially in the case when `x` and `y` are mapped globally for the main panel. The nature of `ggside` is generally to plot supplemental data, and the user will likely want to inherit the `x` global mapping if they use a `geom_xside*` geometry, but map something different to `y`. 33 | 34 | This decision was made in order to keep all `geom_*side*` geometries as similar to their `ggplot2::geom_*` geometry counterparts. However, using `ggside` becomes a tad bit annoying when you must specify _*every*_ positional aesthetic, especially when it obvious what the user may want. 35 | 36 | In `ggside (>=0.1.0)`, certain `geom_*side*` geometries will use the default aesthetic mapping of the associated `Stat`, depending on the `orientation` parameter. 37 | 38 | For example, `geom_xsidedensity` will ignore the `y` global mapping and assign `y = after_stat(density)` to that layer's aesthetic mappings if no `y` mapping was specified. The same can be said for `geom_ysidedensity`, it will ignore the `x` global mapping and assign `x = after_stat(density)` if no `x` mapping was specified. 39 | 40 | This should be much less typing. 41 | 42 | ```{r ggside_updated_aes_usage} 43 | p + 44 | geom_xsidedensity() + 45 | geom_ysidedensity() 46 | ``` 47 | 48 | 49 | Of course, if you would like to use a different computed variables, you will need to specify it like normal. 50 | 51 | ```{r ggside_aes_stats} 52 | p + 53 | geom_xsidedensity(aes(y = after_stat(count))) + 54 | geom_ysidedensity(aes(x = after_stat(scaled))) 55 | ``` 56 | 57 | 58 | You can even use `geom_xsidedensity(orientation = "y")` to force it to inherit the `y` global mapping and map `x = after_stat(density)`. I don't expect many users will do this, but the option is available nonetheless. 59 | 60 | ```{r ggside_off_usage_example} 61 | # 62 | p + 63 | geom_xsidedensity(orientation = "y") #just use geom_ysidedensity() 64 | ``` 65 | 66 | 67 | ## Side Geometries With Functionality 68 | 69 | The following `geom_*side*` geometries have been updated such that the default expected behavior is easier to use. 70 | 71 | * `geom_*sidedensity` 72 | * `geom_*sidebar` 73 | * `geom_*sidefreqpoly` 74 | * `geom_*sidehistogram` 75 | 76 | This can only be applied to geometries that have a `stat` other than `"identity"` with a `default_aes`. If the geometries have an `orientation` parameter, this can control which aesthetic is inherited. `geom_*sideboxplot` and `geom_*sideviolin` are *not* included in this update because the `orientation` largely depends the aesthetic mapping of the layer, and these two geometries could go either way depending on position scales of `x` and `y`. 77 | 78 | All other `geom_*side*` geometries will need their mappings to be explicitly assigned or they will try to inherit from the global mapping (so long as `inherit.aes = TRUE`). 79 | -------------------------------------------------------------------------------- /R/geom-sideviolin.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include constructor-.R 3 | NULL 4 | ### INCLUDE END 5 | #' @title Side Violin plots 6 | #' @description 7 | #' The [xside] and [yside] variants of \link[ggplot2]{geom_violin} 8 | #' @inheritParams ggplot2::layer 9 | #' @inheritParams ggplot2::geom_bar 10 | #' @param draw_quantiles If `not(NULL)` (default), draw horizontal lines 11 | #' at the given quantiles of the density estimate. 12 | #' @param trim If `TRUE` (default), trim the tails of the violins 13 | #' to the range of the data. If `FALSE`, don't trim the tails. 14 | #' @param scale if "area" (default), all violins have the same area 15 | #' (before trimming the tails). If "count", areas are scaled proportionally 16 | #' to the number of observations. If "width", all violins have the same 17 | #' maximum width. 18 | #' @param stat Use to override the default connection between 19 | #' `geom_violin()` and `stat_ydensity()`. 20 | #' @param bounds Known lower and upper bounds for estimated data. Default 21 | #' c(-Inf, Inf) means that there are no (finite) bounds. If any bound is 22 | #' finite, boundary effect of default density estimation will be corrected 23 | #' by reflecting tails outside bounds around their closest edge. Data points 24 | #' outside of bounds are removed with a warning 25 | #' @param quantile.colour,quantile.color,quantile.linewidth,quantile.linetype 26 | #' Default aesthetics for the quantile lines. Set to `NULL` to inherit from 27 | #' the data's aesthetics. By default, quantile lines are hidden and can be 28 | #' turned on by changing `quantile.linetype`. 29 | #' @param draw_quantiles `r lifecycle::badge("deprecated")` Previous 30 | #' specification of drawing quantiles. 31 | #' @aliases geom_*sideviolin 32 | #' @seealso [geom_*sideboxplot] 33 | #' @examples 34 | #' df <- expand.grid(UpperCase = LETTERS, LowerCase = letters) 35 | #' df$Combo_Index <- as.integer(df$UpperCase) * as.integer(df$LowerCase) 36 | #' 37 | #' p1 <- ggplot(df, aes(UpperCase, LowerCase)) + 38 | #' geom_tile(aes(fill = Combo_Index)) 39 | #' 40 | #' # sideviolins 41 | #' # Note - Mixing discrete and continuous axis scales 42 | #' # using xsideviolins when the y aesthetic was previously 43 | #' # mapped with a continuous varialbe will prevent 44 | #' # any labels from being plotted. This is a feature that 45 | #' # will hopefully be added to ggside in the future. 46 | #' 47 | #' p1 + geom_xsideviolin(aes(y = Combo_Index)) + 48 | #' geom_ysideviolin(aes(x = Combo_Index)) 49 | #' 50 | #' # sideviolins with swapped orientation 51 | #' # Note - Discrete before Continuous 52 | #' # If you are to mix Discrete and Continuous variables on 53 | #' # one axis, ggplot2 prefers the discrete variable to be mapped 54 | #' # BEFORE the continuous. 55 | #' ggplot(iris, aes(Sepal.Width, Sepal.Length, color = Species)) + 56 | #' geom_xsideviolin(aes(y = Species), orientation = "y") + 57 | #' geom_point() 58 | #' 59 | #' # Alternatively, you can recast the value as a factor and then 60 | #' # a numeric 61 | #' 62 | #' ggplot(iris, aes(Sepal.Width, Sepal.Length, color = Species)) + 63 | #' geom_point() + 64 | #' geom_xsideviolin(aes(y = as.numeric(Species)), orientation = "y") + 65 | #' geom_ysideviolin(aes(x = as.numeric(Species)), orientation = "x") 66 | #' 67 | #' @return XLayer or YLayer object to be added to a ggplot object 68 | #' @export 69 | geom_xsideviolin <- ggside_layer_function(fun = geom_violin, side = "x", draw_quantiles = quote(lifecycle::deprecated())) 70 | 71 | #' @rdname ggside-ggproto-geoms 72 | #' @usage NULL 73 | #' @format NULL 74 | #' @export 75 | GeomXsideviolin <- ggside_geom("GeomXsideviolin", GeomViolin, "x") 76 | 77 | #' @rdname geom_xsideviolin 78 | #' @export 79 | geom_ysideviolin <- ggside_layer_function( 80 | fun = geom_violin, side = "y", orientation = "y", 81 | draw_quantiles = quote(lifecycle::deprecated()) 82 | ) 83 | 84 | #' @rdname ggside-ggproto-geoms 85 | #' @usage NULL 86 | #' @format NULL 87 | #' @export 88 | GeomYsideviolin <- ggside_geom("GeomYsideviolin", GeomViolin, "y") 89 | -------------------------------------------------------------------------------- /R/plot-construction.R: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include side-coord-cartesian.R 3 | #' @include ggside.R 4 | #' @include side-facet_.R 5 | #' @include side-layout-.r 6 | NULL 7 | ### INCLUDE END 8 | 9 | #' @title Explicit conversion to ggside object 10 | #' @name as_ggside 11 | #' @description 12 | #' Function is only exported for possible extensions to ggside. ggplot2 objects 13 | #' are implicitly converted to ggside objects by 'adding' a ggside object 14 | #' such as a `ggside_layer` object. 15 | #' 16 | #' @param x an object to convert 17 | #' @param ... unused argument 18 | #' @export 19 | as_ggside <- function(x, ...) UseMethod("as_ggside") 20 | 21 | #' @rdname as_ggside 22 | #' @export 23 | as_ggside.default <- function(x, ...) cli::cli_abort("No as_ggside() method for class {.cls {class(x)}}") 24 | 25 | #' @rdname as_ggside 26 | #' @param ggside new ggside object to add 27 | #' @export 28 | as_ggside.ggplot <- function(x, ggside = NULL, ...) { 29 | if (inherits(x[["coordinates"]], "CoordFlip") || inherits(x[["coordinates"]], "CoordPolar")) { 30 | abort("ggside is not currently compatable with CoordFlip or CoordPolar") 31 | } 32 | ggside <- ggside %||% ggside() 33 | if (!is_ggside_options(ggside)) stop("argument ggside must be of class `ggside_options` or NULL") 34 | class_ggside(ggplot = x, ggside) 35 | } 36 | 37 | #' @rdname as_ggside 38 | #' @export 39 | `as_ggside.ggside::ggside` <- function(x, ggside = NULL, ...) { 40 | ggside <- ggside %||% x[["ggside_opt"]] %||% ggside() 41 | if (!is_ggside_options(ggside)) stop("argument ggside must be of class `ggside_options` or NULL") 42 | update_ggside(x, ggside) 43 | } 44 | 45 | #' @rdname as_ggside 46 | #' @export 47 | as_ggside.ggside <- function(x, ggside = NULL, ...) { 48 | ggside <- ggside %||% x[["ggside_opt"]] %||% ggside() 49 | if (!is_ggside_options(ggside)) stop("argument ggside must be of class `ggside_options` or NULL") 50 | update_ggside(x, ggside) 51 | } 52 | 53 | #' @keywords internal 54 | update_ggside <- function(object, ggside) UseMethod("update_ggside") 55 | 56 | #' @keywords internal 57 | update_ggside.default <- function(object, ggside) abort(glue("No update_ggside() method for class <", glue_collapse(class(object), sep = "/"), ">")) 58 | 59 | #' @keywords internal 60 | update_ggside.ggplot <- function(object, ggside = NULL) { 61 | object$ggside_opt$x.pos <- ggside$x.pos %||% object$ggside_opt$x.pos %||% "top" 62 | if (!object$ggside_opt$x.pos %in% c("top", "bottom")) { 63 | abort("x.pos may only be \"top\" or \"bottom\".") 64 | } 65 | object$ggside_opt$y.pos <- ggside$y.pos %||% object$ggside_opt$y.pos %||% "right" 66 | if (!object$ggside_opt$y.pos %in% c("right", "left")) { 67 | abort("y.pos may only be \"right\" or \"left\".") 68 | } 69 | object$ggside_opt$scales <- ggside$scales %||% object$ggside_opt$scales %||% "fixed" 70 | if (!object$ggside_opt$scales %in% c("fixed", "free", "free_x", "free_y")) { 71 | abort("scales may only be \"fixed\", \"free\", \"free_x\" or \"free_y\".") 72 | } 73 | object$ggside_opt$sides_used <- get_sides(object[["layers"]]) 74 | object$ggside_opt$collapse <- ggside$collapse %||% object$ggside_opt$collapse %||% NULL 75 | object$ggside_opt$xsidey <- ggside$xsidey %||% object$ggside_opt$xsidey %||% NULL 76 | object$ggside_opt$ysidex <- ggside$ysidex %||% object$ggside_opt$ysidex %||% NULL 77 | object$ggside_opt$draw_x_on <- ggside$draw_x_on %||% object$ggside_opt$draw_x_on %||% "default" 78 | object$ggside_opt$draw_y_on <- ggside$draw_y_on %||% object$ggside_opt$draw_y_on %||% "default" 79 | object$ggside_opt$strip <- ggside$strip %||% object$ggside_opt$strip %||% "default" 80 | object$ggside_opt$respect_side_labels <- ggside$respect_side_labels %||% object$ggside_opt$respect_side_labels %||% "default" 81 | 82 | object$facet <- ggside_facet(object$facet, object$ggside_opt) 83 | object$coordinates <- ggside_coord(object$coordinates) 84 | object$layout <- ggside_layout(object$layout) 85 | object 86 | } 87 | 88 | 89 | get_sides <- function(layers) { 90 | layer_mappings <- lapply(layers, layer_type) 91 | sides_used <- unlist(layer_mappings) 92 | sides_used <- unique(sides_used[!sides_used %in% "main"]) 93 | sides_used 94 | } 95 | -------------------------------------------------------------------------------- /R/update_ggplot.R: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include all_classes.r 3 | #' @include ggplot_add.R 4 | #' @include ggside.R 5 | #' @include plot-construction.R 6 | #' @include side-coord-cartesian.R 7 | #' @include utils-.R 8 | NULL 9 | ### INCLUDE END 10 | 11 | # update_ggside_opt <- S7::new_generic( 12 | # "update_ggside_opt", 13 | # dispatch_args = c("object", "ggside_opt") 14 | # ) 15 | 16 | # S7::method( 17 | # update_ggside_opt, 18 | # list(class_ggside_layer, class_ggside_opt) 19 | # ) <- 20 | # function(object, ggside_opt) { 21 | # ggside_opt$sides_used <- get_sides(gg) 22 | # NULL 23 | # } 24 | 25 | layer_update_plot <- S7::method( 26 | update_ggplot, 27 | class = list(class_layer, class_ggplot) 28 | ) 29 | 30 | # whenever we add a ggside object to a ggplot, we 31 | # will get a new ggside object 32 | 33 | S7::method( 34 | update_ggplot, 35 | list(class_ggside_opt, class_ggplot) 36 | ) <- 37 | function(object, plot, ...) { 38 | # incase the user just adds a vanilla ggside object 39 | # we need to make sure we update NULL values to defaults 40 | class_ggside(plot, ggside_opt = new_ggside()) |> 41 | update_ggside(ggside = object) 42 | } 43 | 44 | S7::method( 45 | update_ggplot, 46 | list(class_ggside_opt, class_ggside) 47 | ) <- 48 | function(object, plot, ...) { 49 | clone_ggside_plot(plot) |> 50 | update_ggside(ggside = object) 51 | } 52 | 53 | S7::method( 54 | update_ggplot, 55 | list(class_ggside_layer, class_ggplot) 56 | ) <- 57 | function(object, plot, ...) { 58 | ggside_opt <- new_ggside() 59 | ggside_opt$sides_used <- layer_type(object) 60 | layer_update_plot(object = object, plot = plot, ...) |> 61 | class_ggside(ggside_opt = ggside_opt) 62 | } 63 | 64 | S7::method( 65 | update_ggplot, 66 | list(class_ggside_layer, class_ggside) 67 | ) <- 68 | function(object, plot, ...) { 69 | plot <- clone_ggside_plot(plot) 70 | plot <- layer_update_plot(object = object, plot = plot, ...) 71 | ggside_opt <- S7::prop(plot, "ggside_opt") 72 | ggside_opt$sides_used <- get_sides(S7::prop(plot, "layers")) 73 | plot 74 | } 75 | 76 | S7::method( 77 | update_ggplot, 78 | list(class_ggside_scale, class_ggplot) 79 | ) <- 80 | function(object, plot, ...) { 81 | ggside_opt <- new_ggside() 82 | member <- intersect(c("xsidey", "ysidex"), object$aesthetics) 83 | ggside_opt[[member]] <- object 84 | new_scale <- object$clone() 85 | new_scale$guide <- waiver() 86 | plot$scales$add(new_scale) 87 | plot 88 | } 89 | 90 | 91 | S7::method( 92 | update_ggplot, 93 | list(class_ggside_scale, class_ggside) 94 | ) <- 95 | function(object, plot, ...) { 96 | plot <- clone_ggside_plot(plot) 97 | ggside_opt <- S7::prop(plot, "ggside_opt") 98 | member <- intersect(c("xsidey", "ysidex"), object$aesthetics) 99 | ggside_opt[[member]] <- object 100 | new_scale <- object$clone() 101 | new_scale$guide <- waiver() 102 | plot$scales$add(new_scale) 103 | plot 104 | } 105 | 106 | S7::method( 107 | update_ggplot, 108 | list(class_facet, class_ggside) 109 | ) <- 110 | function(object, plot, ...) { 111 | plot <- update_ggplot( 112 | object = object, 113 | plot = S7::super(plot, class_ggplot), 114 | ... 115 | ) 116 | clone_ggside_plot(plot) 117 | } 118 | 119 | S7::method( 120 | update_ggplot, 121 | list(S7::class_any, class_ggside) 122 | ) <- 123 | function(object, plot, ...) { 124 | plot <- clone_ggside_plot(plot) 125 | update_ggside( 126 | object = object, 127 | plot = S7::super(plot, class_ggplot), 128 | ... 129 | ) 130 | } 131 | 132 | S7::method( 133 | update_ggplot, 134 | list(class_coord, class_ggside) 135 | ) <- function(object, plot, ...) { 136 | plot <- clone_ggside_plot(plot) 137 | update_ggplot( 138 | object = ggside_coord(object), 139 | plot = S7::super(plot, class_ggplot), 140 | ... 141 | ) 142 | } 143 | 144 | 145 | S7::method( 146 | ggplot_build, 147 | class_ggside 148 | ) <- function(plot, ...) { 149 | plot <- clone_ggside_plot(plot) 150 | NextMethod() 151 | } 152 | -------------------------------------------------------------------------------- /tests/testthat/test_ggside_classes.R: -------------------------------------------------------------------------------- 1 | test_that("geom_*side* returns ggside_layer", { 2 | expect_s3_class(geom_xsidebar(), "ggside_layer") 3 | expect_s3_class(geom_xsideboxplot(), "ggside_layer") 4 | expect_s3_class(geom_xsidecol(), "ggside_layer") 5 | expect_s3_class(geom_xsidedensity(), "ggside_layer") 6 | expect_s3_class(geom_xsidefreqpoly(), "ggside_layer") 7 | expect_s3_class(geom_xsidehistogram(), "ggside_layer") 8 | expect_s3_class(geom_xsideline(), "ggside_layer") 9 | expect_s3_class(geom_xsidepath(), "ggside_layer") 10 | expect_s3_class(geom_xsidepoint(), "ggside_layer") 11 | expect_s3_class(geom_xsidesegment(), "ggside_layer") 12 | expect_s3_class(geom_xsidetext(), "ggside_layer") 13 | expect_s3_class(geom_xsidetile(), "ggside_layer") 14 | expect_s3_class(geom_xsideviolin(), "ggside_layer") 15 | expect_s3_class(geom_ysidebar(), "ggside_layer") 16 | expect_s3_class(geom_ysideboxplot(), "ggside_layer") 17 | expect_s3_class(geom_ysidecol(), "ggside_layer") 18 | expect_s3_class(geom_ysidedensity(), "ggside_layer") 19 | expect_s3_class(geom_ysidefreqpoly(), "ggside_layer") 20 | expect_s3_class(geom_ysidehistogram(), "ggside_layer") 21 | expect_s3_class(geom_ysideline(), "ggside_layer") 22 | expect_s3_class(geom_ysidepath(), "ggside_layer") 23 | expect_s3_class(geom_ysidepoint(), "ggside_layer") 24 | expect_s3_class(geom_ysidesegment(), "ggside_layer") 25 | expect_s3_class(geom_ysidetext(), "ggside_layer") 26 | expect_s3_class(geom_ysidetile(), "ggside_layer") 27 | expect_s3_class(geom_ysideviolin(), "ggside_layer") 28 | }) 29 | 30 | test_that("ggside function returns ggside_options", { 31 | expect_s3_class(ggside(), "ggside_options") 32 | }) 33 | 34 | p <- ggplot(NULL) + 35 | geom_blank() 36 | 37 | test_that("adding ggside_layer to ggplot makes ggside object", { 38 | expect_s3_class(p, "ggplot") 39 | expect_is_ggside <- function(p, l) { 40 | p_ <- p + l 41 | expect_s7_class(p_, class_ggside) 42 | } 43 | expect_is_ggside(p, ggside()) 44 | expect_is_ggside(p, geom_xsidebar()) 45 | expect_is_ggside(p, geom_xsideboxplot()) 46 | expect_is_ggside(p, geom_xsidecol()) 47 | expect_is_ggside(p, geom_xsidedensity()) 48 | expect_is_ggside(p, geom_xsidefreqpoly()) 49 | expect_is_ggside(p, geom_xsidehistogram()) 50 | expect_is_ggside(p, geom_xsideline()) 51 | expect_is_ggside(p, geom_xsidepath()) 52 | expect_is_ggside(p, geom_xsidepoint()) 53 | expect_is_ggside(p, geom_xsidesegment()) 54 | expect_is_ggside(p, geom_xsidetext()) 55 | expect_is_ggside(p, geom_xsidetile()) 56 | expect_is_ggside(p, geom_xsideviolin()) 57 | expect_is_ggside(p, geom_ysidebar()) 58 | expect_is_ggside(p, geom_ysideboxplot()) 59 | expect_is_ggside(p, geom_ysidecol()) 60 | expect_is_ggside(p, geom_ysidedensity()) 61 | expect_is_ggside(p, geom_ysidefreqpoly()) 62 | expect_is_ggside(p, geom_ysidehistogram()) 63 | expect_is_ggside(p, geom_ysideline()) 64 | expect_is_ggside(p, geom_ysidepath()) 65 | expect_is_ggside(p, geom_ysidepoint()) 66 | expect_is_ggside(p, geom_ysidesegment()) 67 | expect_is_ggside(p, geom_ysidetext()) 68 | expect_is_ggside(p, geom_ysidetile()) 69 | expect_is_ggside(p, geom_ysideviolin()) 70 | }) 71 | 72 | test_that("ggside() class operates correctly", { 73 | obj <- ggside() 74 | expect_s3_class(obj, "ggside_options") 75 | expect_equal(obj$collapse, NULL) 76 | expect_equal(obj$draw_x_on, NULL) 77 | expect_equal(obj$draw_y_on, NULL) 78 | expect_equal(obj$scales, NULL) 79 | expect_equal(obj$sides_used, NULL) 80 | expect_equal(obj$respect_side_labels, NULL) 81 | expect_equal(obj$strip, NULL) 82 | expect_equal(obj$x.pos, NULL) 83 | expect_equal(obj$y.pos, NULL) 84 | expect_equal(obj$xsidey, NULL) 85 | expect_equal(obj$ysidex, NULL) 86 | p2 <- p + obj 87 | obj2 <- p2$ggside_opt 88 | expect_s3_class(obj2, "ggside_options") 89 | expect_equal(obj2$collapse, NULL) 90 | expect_equal(obj2$draw_x_on, "default") 91 | expect_equal(obj2$draw_y_on, "default") 92 | expect_equal(obj2$scales, "fixed") 93 | expect_equal(obj2$sides_used, character()) 94 | expect_equal(obj2$respect_side_labels, "default") 95 | expect_equal(obj2$strip, "default") 96 | expect_equal(obj2$x.pos, "top") 97 | expect_equal(obj2$y.pos, "right") 98 | expect_equal(obj2$xsidey, NULL) 99 | expect_equal(obj2$ysidex, NULL) 100 | }) 101 | -------------------------------------------------------------------------------- /R/geom-sidefunction.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include utils-ggplot2-reimpl-.R 3 | #' @include constructor-.R 4 | #' @include side-layer.R 5 | NULL 6 | ### INCLUDE END 7 | #' @title Side function plot 8 | #' @description 9 | #' The [xside] and [yside] variants of \link[ggplot2]{geom_function} 10 | #' @inheritParams ggplot2::geom_function 11 | #' @param ylim Optionally, restrict the range of the function to this range (y-axis) 12 | #' @aliases geom_*sidefunction 13 | #' @return XLayer or YLayer object to be added to a ggplot object 14 | #' @examples 15 | #' x<- rweibull(100, 2.6, 3) 16 | #' y<- rweibull(100, 1.8, 3) 17 | #' xy.df<- data.frame(cbind(x,y)) 18 | #' p <- ggplot(xy.df, aes(x, y)) + 19 | #' geom_point(colour = "blue", size = 0.25) + 20 | #' geom_density2d() + 21 | #' geom_xsidedensity(fill = "blue", alpha = .3) + 22 | #' geom_ysidedensity(fill = "blue", alpha = .3) + 23 | #' stat_xsidefunction(fun = dweibull, args = list(shape = 1.8, scale = 3), colour = "red") + 24 | #' stat_ysidefunction(fun = dweibull, args = list(shape = 2.6, scale = 3), colour = "red") + 25 | #' theme_classic() 26 | #' p 27 | #' @export 28 | geom_xsidefunction <- ggside_layer_function(fun = geom_function, side = "x") 29 | 30 | #' @rdname geom_xsidefunction 31 | #' @export 32 | stat_xsidefunction <- ggside_layer_function(fun = stat_function, side = "x") 33 | 34 | #' @rdname ggside-ggproto-geoms 35 | #' @usage NULL 36 | #' @format NULL 37 | #' @export 38 | GeomXsidefunction <- ggside_geom("GeomXsidefunction", GeomFunction, "x") 39 | 40 | # # @rdname geom_xsidefunction 41 | # # @export 42 | # geom_ysidefunction2 <- ggside_layer_function(fun = geom_function, side = "y") 43 | # 44 | # # @rdname geom_xsidefunction 45 | # # @export 46 | # stat_ysidefunction2 <- ggside_layer_function(fun = stat_function, side = "y") 47 | 48 | #' @rdname geom_xsidefunction 49 | #' @export 50 | geom_ysidefunction <- function(mapping = NULL, data = NULL, 51 | stat = "ysidefunction", position = "identity", 52 | ..., 53 | na.rm = FALSE, 54 | show.legend = NA, 55 | inherit.aes = TRUE) { 56 | 57 | ggside_layer( 58 | data = data, 59 | mapping = mapping, 60 | stat = stat, 61 | geom = GeomYsidefunction, 62 | position = position, 63 | show.legend = show.legend, 64 | inherit.aes = inherit.aes, 65 | params = list( 66 | na.rm = na.rm, 67 | ... 68 | ), side = "y" 69 | ) 70 | } 71 | 72 | #' @rdname geom_xsidefunction 73 | #' @export 74 | stat_ysidefunction <- function(mapping = NULL, data = NULL, geom = "ysidefunction", position = "identity", 75 | ..., fun, ylim = NULL, n = 101, args = list(), na.rm = FALSE, 76 | show.legend = NA, inherit.aes = TRUE) { 77 | 78 | ggside_layer(data = data, mapping = mapping, stat = StatYsidefunction, 79 | geom = geom, position = position, show.legend = show.legend, 80 | inherit.aes = inherit.aes, 81 | params = list(fun = fun, n = n, 82 | args = args, na.rm = na.rm, ylim = ylim, ...), side = "y") 83 | } 84 | 85 | #' @rdname ggside-ggproto-geoms 86 | #' @usage NULL 87 | #' @format NULL 88 | #' @export 89 | GeomYsidefunction <- ggside_geom("GeomYsidefunction", GeomFunction, "y") 90 | 91 | 92 | 93 | StatYsidefunction <- ggplot2::ggproto( 94 | "StatYsidefunction", 95 | ggplot2::StatFunction, 96 | compute_group = function (data, scales, fun, ylim = NULL, n = 101, args = list()) { 97 | if (is.null(scales$y)) { 98 | range <- ylim %||% c(0, 1) 99 | yseq <- seq(range[1], range[2], length.out = n) 100 | y_trans <- yseq 101 | } 102 | else { 103 | range <- ylim %||% scales$y$dimension() 104 | yseq <- seq(range[1], range[2], length.out = n) 105 | if (scales$y$is_discrete()) { 106 | y_trans <- yseq 107 | } 108 | else { 109 | y_trans <- scales$y$get_transformation()$inverse(yseq) 110 | } 111 | } 112 | if (is.formula(fun)) 113 | fun <- as_function(fun) 114 | x_out <- inject(fun(y_trans, !!!args)) 115 | if (!is.null(scales$x) && !scales$x$is_discrete()) { 116 | x_out <- scales$x$get_transformation()$transform(x_out) 117 | } 118 | data_frame0(x = x_out, y = yseq) 119 | }) 120 | 121 | -------------------------------------------------------------------------------- /R/add_gg.R: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include side-coord-cartesian.R 3 | #' @include side-facet_.R 4 | NULL 5 | ### INCLUDE END 6 | 7 | 8 | 9 | #' @keywords internal 10 | validate_ggside <- function(e2, plot) UseMethod("validate_ggside") 11 | #' @keywords internal 12 | validate_ggside.default <- function(e2, plot) plot 13 | #' @keywords internal 14 | validate_ggside.Facet <- function(e2, plot) { 15 | plot[["facet"]] <- ggside_facet(plot[["facet"]], plot[["ggside_opt"]]) 16 | plot 17 | } 18 | #' @keywords internal 19 | validate_ggside.Coord <- function(e2, plot) { 20 | plot[["coordinates"]] <- ggside_coord(plot[["coordinates"]]) 21 | plot 22 | } 23 | 24 | plot_clone <- function(plot) { 25 | p <- plot 26 | p$scales <- plot$scales$clone() 27 | 28 | p 29 | } 30 | 31 | # # @export 32 | # `+.gg` <- function(e1, e2) { 33 | # if (missing(e2)) { 34 | # abort("Cannot use `+.gg()` with a single argument. Did you accidentally put + on a new line?") 35 | # } 36 | # e2name <- deparse(substitute(e2)) 37 | # add_gg(e1 = e1, e2 = e2, e2name = e2name) 38 | # } 39 | 40 | # # @keywords internal 41 | # add_gg <- function(e1, e2, e2name) { 42 | # UseMethod("add_gg") 43 | # } 44 | 45 | # # @keywords internal 46 | # add_gg.default <- function(e1, e2, e2name) { 47 | # abort(glue("No method defined for class {paste(class(e1),collapse = ', ')}.")) 48 | # } 49 | 50 | # # @keywords internal 51 | # add_gg.ggplot <- function(e1, e2, e2name){ 52 | # if (is.null(e2)) return(e1) 53 | 54 | # p <- plot_clone(e1) 55 | # p <- ggplot_add(object = e2, plot = p, object_name = e2name) 56 | # set_last_plot(p) 57 | # p 58 | # } 59 | 60 | # # @importFrom ggplot2 merge_element 61 | # # @keywords internal 62 | # add_gg.theme <- function(e1, e2, e2name) { 63 | # if (!is.list(e2)) { # in various places in the code base, simple lists are used as themes 64 | # abort(glue("Can't add `{e2name}` to a theme object.")) 65 | # } 66 | 67 | # # If e2 is a complete theme or e1 is NULL, just return e2 68 | # if (is_theme_complete(e2) || is.null(e1)) 69 | # return(e2) 70 | 71 | # # Iterate over the elements that are to be updated 72 | # for (item in names(e2)) { 73 | # x <- merge_element(e2[[item]], e1[[item]]) 74 | 75 | # # Assign it back to e1 76 | # # This is like doing e1[[item]] <- x, except that it preserves NULLs. 77 | # # The other form will simply drop NULL values 78 | # e1[item] <- list(x) 79 | # } 80 | 81 | # # make sure the "complete" attribute is set; this can be missing 82 | # # when e1 is an empty list 83 | # attr(e1, "complete") <- is_theme_complete(e1) 84 | 85 | # # Only validate if both themes should be validated 86 | # attr(e1, "validate") <- 87 | # is_theme_validate(e1) && is_theme_validate(e2) 88 | 89 | # e1 90 | # } 91 | 92 | # #' @keywords internal 93 | # add_gg.ggproto <- function(e1, e2, e2name) { 94 | # abort("Cannot add ggproto objects together. Did you forget to add this object to a ggplot object?") 95 | # } 96 | 97 | # #' @keywords internal 98 | # add_gg.ggside <- function(e1, e2, e2name) { 99 | # p <- NextMethod("add_gg") 100 | # p <- clone_ggside_plot(p) 101 | # validate_ggside(e2, plot = p) 102 | # } 103 | 104 | # is_theme_complete <- function(x) isTRUE(attr(x, "complete", exact = TRUE)) 105 | 106 | # is_theme_validate <- function(x) { 107 | # validate <- attr(x, "validate", exact = TRUE) 108 | # if (is.null(validate)) 109 | # TRUE # we validate by default 110 | # else 111 | # isTRUE(validate) 112 | # } 113 | 114 | 115 | 116 | 117 | # # @export 118 | # merge_element.default <- function(new, old) { 119 | # if (is.null(old) || inherits(old, "element_blank")) { 120 | # return(new) 121 | # } 122 | # else if (is.null(new) || is.character(new) || is.numeric(new) || 123 | # is.unit(new) || is.logical(new)) { 124 | # return(new) 125 | # } 126 | # cli::cli_abort("No method for merging {.cls {class(new)[1]}} into {.cls {class(old)[1]}}.") 127 | # } 128 | # 129 | # merge_element.element <- function(new, old) { 130 | # if (is.null(old) || inherits(old, "element_blank")) { 131 | # return(new) 132 | # } 133 | # if (!inherits(new, class(old)[1])) { 134 | # cli::cli_abort("Only elements of the same class can be merged.") 135 | # } 136 | # idx <- vapply(new, is.null, logical(1)) 137 | # idx <- names(idx[idx]) 138 | # new[idx] <- old[idx] 139 | # new 140 | # } 141 | # 142 | # merge_element.element_blank <- function(new, old) { 143 | # # If new is element_blank, just return it 144 | # new 145 | # } 146 | -------------------------------------------------------------------------------- /R/utils-.R: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include constructor-.R 3 | #' @include utils-ggplot2-reimpl-.R 4 | NULL 5 | ### INCLUDE END 6 | 7 | 8 | 9 | # global variables to pass RMD checks 10 | NO_PANEL <- -1L 11 | PANEL_TYPE <- c("x", "y", "main") 12 | self <- NULL 13 | call_parent_method <- function(...) cli::cli_abort("method not implemented") 14 | orientation <- NULL 15 | `!<-` <- `(<-` <- function(x, value) cli::cli_abort("function not meant to be called") 16 | 17 | force_panel_type_mapping <- function(mapping, type) { 18 | if ("PANEL_TYPE" %in% names(mapping)) { 19 | return(mapping) 20 | } 21 | switch(type, 22 | x = aes(!!!mapping, PANEL_TYPE = "x"), 23 | y = aes(!!!mapping, PANEL_TYPE = "y") 24 | ) 25 | } 26 | 27 | .ggside_global <- new.env(parent = emptyenv()) 28 | .ggside_global$.y_aes <- c( 29 | "y", "ymin", "ymax", "yend", "yintercept", "ymin_final", 30 | "ymax_final", "lower", "middle", "upper", "y0" 31 | ) 32 | .ggside_global$.x_aes <- c( 33 | "x", "xmin", "xmax", "xend", "xintercept", "xmin_final", 34 | "xmax_final", "xlower", "xmiddle", "xupper", "x0" 35 | ) 36 | 37 | `%NA%` <- function(a, b) { 38 | if (all(is.na(a))) b else a 39 | } 40 | 41 | use_side_aes <- function(data, side) { 42 | data[["fill"]] <- data[[sprintf("%sfill", side)]] %NA% data[["fill"]] 43 | data[["colour"]] <- data[[sprintf("%scolour", side)]] %NA% data[["colour"]] 44 | data 45 | } 46 | 47 | rename_side <- function(str, side) { 48 | other <- switch(side, 49 | x = "y", 50 | y = "x" 51 | ) 52 | is_or <- grepl("|", str, fixed = T) 53 | aes <- .ggside_global[[paste0(".", other, "_aes")]] 54 | rename_aes <- function(x) { 55 | to_rename <- x %in% aes 56 | if (any(to_rename)) { 57 | x[to_rename] <- sprintf("%sside%s", side, x[to_rename]) 58 | } 59 | x 60 | } 61 | if (any(is_or)) { 62 | or <- str[is_or] 63 | splits <- strsplit(or, "|", T) 64 | splits <- lapply(splits, rename_aes) 65 | str[!is_or] <- rename_aes(str[!is_or]) 66 | str[is_or] <- vapply(splits, paste, character(1), collapse = "|") 67 | } else { 68 | str <- rename_aes(str) 69 | } 70 | str 71 | } 72 | 73 | 74 | # utility to pull out an aesthetic we care about. 75 | # helps code around the `|` aesthetics 76 | # @return a character vector 77 | pull_aes <- function(x) { 78 | if (any(is_or <- grepl("|", x, fixed = T))) { 79 | splits <- strsplit(x[is_or], "|", T) 80 | out <- unlist(splits) 81 | x <- c(x[!is_or], out) 82 | } 83 | x 84 | } 85 | 86 | 87 | # utility to recode default aesthetics of a geom. 88 | # @returns an object of class 'uneval' 89 | new_default_aes <- function(geom, side) { 90 | defaults <- geom$default_aes 91 | names(defaults) <- rename_side(names(defaults), side) 92 | new_defaults <- list(NA, NA, PANEL_TYPE = side) 93 | names(new_defaults)[c(1, 2)] <- paste0(side, c("colour", "fill")) 94 | args <- dots_list(!!!defaults, !!!new_defaults, .homonyms = "first") 95 | do.call("aes", args) 96 | } 97 | 98 | assert_lgl <- function(arg) { 99 | arg_sym <- caller_arg(arg) 100 | vctrs::vec_assert( 101 | x = arg, 102 | ptype = logical(), size = 1L, 103 | arg = arg_sym, 104 | call = parent.frame() 105 | ) 106 | if (is.na(arg)) { 107 | cli::cli_abort("{.arg {arg_sym}} cannot be {.obj_type_friendly {NA}}", call = parent.frame()) 108 | } 109 | } 110 | 111 | resolve_arg <- function(arg, opt, several.ok = FALSE, null.ok = TRUE) { 112 | assert_lgl(several.ok) 113 | assert_lgl(null.ok) 114 | arg_sym <- caller_arg(arg) 115 | if (!is.null(arg)) { 116 | arg <- opt[opt %in% arg] 117 | len <- length(arg) 118 | opt_len <- length(opt) 119 | if (len == 0) { 120 | cli::cli_abort("valid {cli::qty(opt_len)} option{?s} for argument {.arg {arg_sym}} {?is/are} {.val {opt}}", 121 | call = parent.frame() 122 | ) 123 | } 124 | if (length(arg) > 1 && !several.ok) { 125 | cli::cli_abort("you specified {length(arg)} value{?s} to argument {.arg {arg_sym}}, but only one of {.or {.val {opt}}} are allowed", 126 | call = parent.frame() 127 | ) 128 | } 129 | } else if (!null.ok) { 130 | cli::cli_abort("argument {.arg {arg_sym}} cannot be {.obj_type_friendly {NULL}}", call = parent.frame()) 131 | } 132 | arg 133 | } 134 | 135 | layer_type <- function(layer) { 136 | layer_class <- str_extr(class(layer), "(X|Y)Layer") 137 | val <- if (all(is.na(layer_class))) { 138 | "main" 139 | } else { 140 | layer_class <- layer_class[!is.na(layer_class)] 141 | to_lower_ascii(substr(layer_class, 1, 1)) 142 | } 143 | return(val) 144 | } 145 | 146 | is_ggside_subclass <- function(obj) { 147 | class_ <- class(obj) 148 | any(grepl("((X|Y)Layer|(X|Y)side)", class_)) 149 | } 150 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "README" 3 | author: "Justin Landis" 4 | date: "07/20/2022" 5 | output: github_document 6 | --- 7 | 8 | ```{r setup, include=FALSE} 9 | knitr::opts_chunk$set( 10 | collapse = TRUE, 11 | comment = "#>", 12 | fig.path = "man/figures/README-" 13 | ) 14 | ``` 15 | 16 |
17 | # ggside 18 | 19 | 20 | [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version-ago/ggside)](https://cran.r-project.org/package=ggside) 21 | [![CRAN_Download_Badge](http://cranlogs.r-pkg.org/badges/ggside)](https://cran.r-project.org/package=ggside) 22 | [![CRAN_Download_Badge](http://cranlogs.r-pkg.org/badges/grand-total/ggside)](https://cran.r-project.org/package=ggside) 23 | [![R-CMD-check](https://github.com/jtlandis/ggside/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/jtlandis/ggside/actions/workflows/R-CMD-check.yaml) 24 | [![Codecov test coverage](https://codecov.io/gh/jtlandis/ggside/branch/main/graph/badge.svg)](https://app.codecov.io/gh/jtlandis/ggside?branch=main) 25 | 26 | 27 |
28 | 29 | ## Overview 30 | 31 | The R package ggside expands on the ggplot2 package. This package allows the user to add graphical information about one of the main panel's axis. This is particularly useful for metadata for discrete axis, or summary graphics on a continuous axis such as a boxplot or a density distribution. 32 | 33 | ## Installation 34 | 35 | Please install from CRAN for the latest stable version of `ggside`. You can also install from the Github as seen below. 36 | 37 | ```{r, eval = FALSE} 38 | #CRAN 39 | utils::install.packages("ggside") 40 | #Github 41 | devtools::install_github("jtlandis/ggside") 42 | ``` 43 | 44 | ## Usage 45 | 46 | Using this package is similar to adding any additional layer to a ggplot. All geometries supported by ggside follow a pattern like `geom_xside*` or `geom_yside*` which will add that geometry to either the x side panel or the y side panel respectively. If you add `geom_xsidedensity` to a plot, then this places a density geometry in its own panel that is positioned by default above the main panel. This panel will share the same x axis of the main panel but will have an independent y axis. Take the following example from the ggplot2 readme. 47 | 48 | ```{r example} 49 | library(ggplot2) 50 | library(ggside) 51 | 52 | ggplot(mpg, aes(displ, hwy, colour = class)) + 53 | geom_point(size = 2) + 54 | geom_xsidedensity(aes(y = after_stat(density)), position = "stack") + 55 | geom_ysidedensity(aes(x = after_stat(density)), position = "stack") + 56 | theme(axis.text.x = element_text(angle = 90, vjust = .5)) 57 | 58 | ``` 59 | 60 | After version `0.3.0` you no longer __need__ to use `scale_(y|x)side(x|y)_*()` to mix discrete and continuous axes. `ggside` geom's have their default positional aesthetics `x` and `y` aesthetics to be prepended with `ysidex` and `xsidey` respectively under the hood. Now you may mix discrete and continuous axes with ease. 61 | 62 | ```{r example-mix-scales} 63 | ggplot(mpg, aes(displ, hwy, colour = class)) + 64 | geom_point(size = 2) + 65 | geom_xsideboxplot(aes(y =class), orientation = "y") + 66 | geom_ysidedensity(aes(x = after_stat(density)), position = "stack") + 67 | scale_ysidex_continuous(guide = guide_axis(angle = 90), minor_breaks = NULL) + 68 | theme(ggside.panel.scale = .3) 69 | ``` 70 | 71 | With version 0.2.0, more theme elements allow for better control over how side panels are rendered. 72 | 73 | ```{r example-side-themes, warning=F} 74 | ggplot(iris, aes(Sepal.Width, Sepal.Length, fill = Species)) + 75 | geom_point(aes(color = Species)) + 76 | geom_xsidedensity(alpha = .3, position = "stack") + 77 | geom_ysideboxplot(aes(x = Species), orientation = "x") + 78 | scale_ysidex_discrete(guide = guide_axis(angle = 45)) + 79 | theme_dark() + 80 | theme(ggside.panel.scale = .3, 81 | ggside.panel.border = element_rect(NA, "red", linewidth = 2), 82 | ggside.panel.grid = element_line("black", linewidth = .1, linetype = "dotted"), 83 | ggside.panel.background = element_blank()) + 84 | guides(color = "none", fill = "none") 85 | ``` 86 | 87 | 88 | For a more detailed guide please see `vignette('ggside_basic_usage')` for more information. 89 | 90 | 91 | 92 | ## Issues and Bug Reporting 93 | 94 | If you find any issues or want to suggest an enhancement, please make a post at [jtlandis/ggside](https://github.com/jtlandis/ggside/issues). 95 | 96 | ## Known Issues 97 | 98 | 99 | The following section will summarize issues that are present on the current CRAN release. These will either be fixed on the main branch of this git repository, or currently in development to be fixed on one of the development branches. The current CRAN version of `ggside` is v0.3.1. 100 | 101 | -------------------------------------------------------------------------------- /R/utils-side-coord.R: -------------------------------------------------------------------------------- 1 | ggname <- function(prefix, grob) { 2 | grob$name <- grobName(grob, prefix) 3 | grob 4 | } 5 | 6 | panel_guides_grob <- function(guides, position, theme, labels = NULL) { 7 | if (!inherits(guides, "Guides")) { 8 | return(zeroGrob()) 9 | } 10 | pair <- guides$get_position(position) 11 | pair$params$draw_label <- labels %||% NULL 12 | pair$guide$draw(theme, params = pair$params) 13 | } 14 | 15 | 16 | 17 | clone_guide <- function(guide) { 18 | ggproto(NULL, guide) 19 | } 20 | 21 | ggside_panel_guides_grob <- function(guides, position, theme, labels = NULL) { 22 | if (!inherits(guides, "Guides")) { 23 | return(zeroGrob()) 24 | } 25 | pair <- guides$get_position(position) 26 | pair$guide <- clone_guide(pair$guide) 27 | pair$params$draw_label <- labels %||% NULL 28 | # only use ggside themes if specified... 29 | ggside_eles <- names(theme)[grep("^ggside", names(theme))] 30 | to_rename <- apply(vapply(pair$guide$elements, 31 | grepl, 32 | x = ggside_eles, 33 | logical(length(ggside_eles)) 34 | ), 2, any) 35 | if (any(to_rename)) { 36 | pair$guide$elements[to_rename] <- paste("ggside", pair$guide$elements[to_rename], sep = ".") 37 | } 38 | pair$guide$draw(theme, params = pair$params) 39 | } 40 | 41 | 42 | use_ggside_ele <- function(ele, side = NULL, family = NULL, theme) { 43 | theme_nms <- names(theme) 44 | 45 | # most specific 46 | if (!is.null(side)) { 47 | .lgl <- grepl(paste("^ggside", side, ele, sep = "\\."), theme_nms) 48 | 49 | if (any(.lgl)) { 50 | return(paste("ggside", side, ele, sep = ".")) 51 | } 52 | } 53 | 54 | 55 | .lgl <- Reduce(`|`, lapply(paste("^ggside", c(ele, family), sep = "\\."), grepl, x = theme_nms)) 56 | 57 | if (any(.lgl)) { 58 | return(paste("ggside", ele, sep = ".")) 59 | } else { 60 | return(ele) 61 | } 62 | } 63 | 64 | 65 | guide_grid <- function(theme, x.minor, x.major, y.minor, y.major) { 66 | x.minor <- setdiff(x.minor, x.major) 67 | y.minor <- setdiff(y.minor, y.major) 68 | ggname( 69 | "grill", 70 | grobTree( 71 | element_render(theme, "panel.background"), 72 | if (length(y.minor) > 0) { 73 | element_render(theme, "panel.grid.minor.y", 74 | x = rep(0:1, length(y.minor)), y = rep(y.minor, each = 2), 75 | id.lengths = rep(2, length(y.minor)) 76 | ) 77 | }, 78 | if (length(x.minor) > 0) { 79 | element_render(theme, "panel.grid.minor.x", 80 | x = rep(x.minor, each = 2), y = rep(0:1, length(x.minor)), 81 | id.lengths = rep(2, length(x.minor)) 82 | ) 83 | }, 84 | if (length(y.major) > 0) { 85 | element_render(theme, "panel.grid.major.y", 86 | x = rep(0:1, length(y.major)), y = rep(y.major, each = 2), 87 | id.lengths = rep(2, length(y.major)) 88 | ) 89 | }, 90 | if (length(x.major) > 0) { 91 | element_render(theme, "panel.grid.major.x", 92 | x = rep(x.major, each = 2), y = rep(0:1, length(x.major)), 93 | id.lengths = rep(2, length(x.major)) 94 | ) 95 | } 96 | ) 97 | ) 98 | } 99 | 100 | 101 | ggside_guide_grid <- function(theme, x.minor, x.major, y.minor, y.major, side = NULL) { 102 | x.minor <- setdiff(x.minor, x.major) 103 | y.minor <- setdiff(y.minor, y.major) 104 | side <- paste0(side, "side") 105 | ele <- use_ggside_ele("panel.grid", side = side, family = "line", theme = theme) 106 | ggname( 107 | "grill", 108 | grobTree( 109 | element_render(theme, use_ggside_ele("panel.background", side = side, family = "rect", theme = theme)), 110 | if (length(y.minor) > 0) { 111 | element_render(theme, paste0(ele, ".minor.y"), 112 | x = rep(0:1, length(y.minor)), y = rep(y.minor, each = 2), 113 | id.lengths = rep(2, length(y.minor)) 114 | ) 115 | }, 116 | if (length(x.minor) > 0) { 117 | element_render(theme, paste0(ele, ".minor.x"), 118 | x = rep(x.minor, each = 2), y = rep(0:1, length(x.minor)), 119 | id.lengths = rep(2, length(x.minor)) 120 | ) 121 | }, 122 | if (length(y.major) > 0) { 123 | element_render(theme, paste0(ele, ".major.y"), 124 | x = rep(0:1, length(y.major)), y = rep(y.major, each = 2), 125 | id.lengths = rep(2, length(y.major)) 126 | ) 127 | }, 128 | if (length(x.major) > 0) { 129 | element_render(theme, paste0(ele, ".major.x"), 130 | x = rep(x.major, each = 2), y = rep(0:1, length(x.major)), 131 | id.lengths = rep(2, length(x.major)) 132 | ) 133 | } 134 | ) 135 | ) 136 | } 137 | 138 | 139 | 140 | ggside_render_fg <- function(panel_params, theme) { 141 | panel_type <- panel_params$ggside_panel_type 142 | if (is.element(panel_type, c("x", "y"))) { 143 | element_render(theme, use_ggside_ele("panel.border", side = paste0(panel_type, "side"), family = "rect", theme = theme), fill = NA) 144 | } else { 145 | element_render(theme, "panel.border", fill = NA) 146 | } 147 | } 148 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/ggside_axis_polts/base-plot.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 22.5 44 | 25.0 45 | 27.5 46 | 30.0 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 2.5 56 | 5.0 57 | 7.5 58 | 10.0 59 | x 60 | y 61 | base plot 62 | 63 | 64 | -------------------------------------------------------------------------------- /tests/testthat/test_ggside_scales.R: -------------------------------------------------------------------------------- 1 | library(vdiffr) 2 | 3 | ggproto_members <- function(proto) { 4 | members <- ls(envir = proto) 5 | super <- proto$super 6 | while (!is.null(super)) { 7 | members <- union(members, ls(envir = super())) 8 | super <- super()$super 9 | } 10 | setdiff(members, "super") 11 | } 12 | 13 | extract_ggproto_members <- function(proto, members) { 14 | objs <- lapply(members, function(mem, x) x[[mem]], x = proto) 15 | for (i in seq_along(objs)) { 16 | obj <- objs[[i]] 17 | if (is_ggproto(obj)) { 18 | objs[[i]] <- extract_ggproto_members(obj, ggproto_members(obj)) 19 | } 20 | if (is.function(obj)) { 21 | objs[[i]] <- environment(obj)$f 22 | } 23 | } 24 | objs 25 | } 26 | 27 | expect_ggproto_id <- function(object, expected) { 28 | act <- quasi_label(enquo(object), arg = "object") 29 | exp <- quasi_label(enquo(expected), arg = "expected") 30 | 31 | members_act <- ggproto_members(act$val) 32 | members_exp <- ggproto_members(exp$val) 33 | identical_members <- all(members_exp %in% members_act) && 34 | all(members_act %in% members_exp) 35 | 36 | vals_act <- extract_ggproto_members(act$val, members_exp) 37 | vals_exp <- extract_ggproto_members(exp$val, members_exp) 38 | 39 | comp <- waldo::compare( 40 | x = vals_act, y = vals_exp, 41 | x_arg = "object", y_arg = "expected" 42 | ) 43 | testthat::expect(length(comp) == 0, 44 | sprintf( 45 | "%s (%s) not %s to %s (%s).\n\n%s", 46 | act$lab, "`actual`", "identical", exp$lab, "`expected`", 47 | paste0(comp, collapse = "\n\n") 48 | ), 49 | info = NULL, trace_env = parent.frame() 50 | ) 51 | } 52 | 53 | p <- ggplot(mpg, aes(displ, hwy, colour = class)) + 54 | geom_point(size = 2) + 55 | geom_xsidedensity(aes(y = after_stat(density)), position = "stack") + 56 | geom_ysidedensity(aes(x = after_stat(density)), position = "stack") + 57 | theme(axis.text.x = element_text(angle = 90, vjust = .5)) 58 | 59 | test_that("xsidey and ysidex are null", { 60 | expect_null(p$ggside$xsidey) 61 | expect_null(p$ggside$ysidex) 62 | }) 63 | 64 | test_that("xsidey and ysidex appear", { 65 | xsidey_scale <- scale_xsidey_continuous(breaks = c(0, 1, 2)) 66 | p2 <- p + xsidey_scale 67 | 68 | expect_ggproto_id(p2$ggside_opt$xsidey, xsidey_scale) 69 | 70 | ysidex_scale <- scale_ysidex_continuous(breaks = NULL, labels = NULL) 71 | p2 <- p + ysidex_scale 72 | 73 | expect_ggproto_id(p2$ggside_opt$ysidex, ysidex_scale) 74 | }) 75 | 76 | test_that("xsidey and ysidex plot", { 77 | p <- p + 78 | scale_xsidey_continuous(breaks = c(0, 1, 2)) + 79 | scale_ysidex_continuous(breaks = NULL, labels = NULL) 80 | 81 | expect_doppelganger("xsidey-ysidex-FacetNull", p) 82 | 83 | p <- p + ggside(collapse = "all") 84 | 85 | expect_doppelganger("xsidey-ysidex-FacetWrap", p + facet_wrap(~manufacturer)) 86 | 87 | expect_doppelganger("xsidey-ysidex-FacetGrid", p + facet_grid(rows = vars(class))) 88 | }) 89 | 90 | 91 | 92 | test_that("xsidey and ysidex no warning", { 93 | p <- ggplot(iris, aes(Sepal.Width, Sepal.Length, fill = Species)) + 94 | geom_point(aes(color = Species)) + 95 | geom_xsidedensity(alpha = .3, position = "stack") + 96 | geom_ysideboxplot(aes(x = Species), orientation = "x") 97 | 98 | # adding a scale no longer converts the scale object 99 | # expect_false(inherits(p$scales, "ggsideScalesList")) 100 | 101 | p <- p + 102 | scale_ysidex_discrete(guide = guide_axis(angle = 45)) 103 | 104 | # expect_true(inherits(p$scales, "ggsideScalesList")) 105 | 106 | expect_warning(p, NA) 107 | 108 | p <- ggplot(iris, aes(Species, Sepal.Length, color = Species)) + 109 | geom_boxplot() + 110 | geom_ysidepoint(aes(x = Petal.Length)) + 111 | scale_ysidex_continuous() 112 | 113 | expect_warning(p, NA) 114 | }) 115 | 116 | test_that("side scales can use transforms", { 117 | df <- data.frame( 118 | x = seq(from = 20, to = 60, by = 1), 119 | y1 = seq(from = 0.001, to = 1, length.out = 41), 120 | y2 = seq(from = 5000, to = 1, length.out = 41) 121 | ) 122 | 123 | p <- ggplot(data = df) + 124 | geom_line(mapping = aes(x = x, y = y1, group = "obs1")) + 125 | geom_xsideline(mapping = aes(x = x, y = y2)) + 126 | scale_xsidey_log10(expand = c(0, 0)) 127 | 128 | expect_doppelganger("transformation works", p) 129 | }) 130 | 131 | test_that("side scales can use guide's argument", { 132 | p <- ggplot(mpg, aes(displ, hwy, colour = class)) + 133 | geom_point(size = 2) + 134 | geom_xsideboxplot(aes(y = class), orientation = "y") + 135 | geom_ysidedensity(aes(x = after_stat(density)), position = "stack") + 136 | theme(ggside.panel.scale = .3) + 137 | scale_xsidey_discrete() + 138 | scale_ysidex_continuous(guide = guide_axis(angle = 90), minor_breaks = NULL) 139 | expect_warning(p, NA) 140 | }) 141 | 142 | test_that("coord_cartesian(xlim = , ylim = ) works", { 143 | p <- ggplot(mpg, aes(displ, hwy, colour = class)) + 144 | geom_point(size = 2) + 145 | geom_xsidedensity(aes(y = after_stat(density)), position = "stack") + 146 | geom_ysidedensity(aes(x = after_stat(density)), position = "stack") + 147 | theme(axis.text.x = element_text(angle = 90, vjust = .5)) + 148 | coord_cartesian(xlim = c(3, 6), ylim = c(20, 30)) 149 | expect_doppelganger("coord_cartesian-no-zoom", p) 150 | }) 151 | -------------------------------------------------------------------------------- /R/side-layout-.r: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include ggplot_add.R 3 | #' @include utils-ggplot2-reimpl-.R 4 | #' @include utils-calls.R 5 | NULL 6 | ### INCLUDE END 7 | 8 | 9 | find_positional_side_scale <- function(aes, x, env = parent.frame()) { 10 | if (!aes %in% c("xsidey", "ysidex") || is.null(x) || (is_atomic(x) && all(is.infinite(x)))) { 11 | return(NULL) 12 | } 13 | type <- scale_type(x) 14 | candidates <- paste("scale", aes, type, sep = "_") 15 | for (scale in candidates) { 16 | scale_f <- find_global(scale, env, mode = "function") 17 | if (!is.null(scale_f)) { 18 | sc <- scale_f() 19 | sc$call <- parse_expr(paste0(scale, "()")) 20 | return(sc) 21 | } 22 | } 23 | return(NULL) 24 | } 25 | 26 | find_side_scale <- function(side, data) { 27 | lapply(data, function(layer_data, side) { 28 | aesthetics <- names(layer_data) 29 | aesthetics <- aesthetics[grep(side, aesthetics)] 30 | if (length(aesthetics) == 0) { 31 | return(NULL) 32 | } 33 | sc <- NULL 34 | for (aes in aesthetics) { 35 | sc <- find_positional_side_scale(side, layer_data[[aes]]) 36 | if (!is.null(sc)) { 37 | return(sc) 38 | } 39 | } 40 | sc 41 | }, side = side) 42 | } 43 | 44 | #' @title Construct ggside layout 45 | #' @name ggside_layout 46 | #' @description 47 | #' Creates a new layout object required for ggside functionality 48 | #' 49 | #' @param layout a ggproto Layout object 50 | #' @export 51 | ggside_layout <- function(layout) UseMethod("ggside_layout") 52 | 53 | #' @export 54 | ggside_layout.Layout <- function(layout) { 55 | new_ggside_layout(layout = layout) 56 | } 57 | 58 | #' @export 59 | ggside_layout.ggsideLayout <- function(layout) layout 60 | 61 | #' @export 62 | ggside_layout.default <- function(layout) cli::cli_abort("cannot create ggside layout from {.cls {class(layout)}}") 63 | 64 | new_ggside_layout <- function(layout) { 65 | parent_layout <- layout 66 | 67 | ggproto( 68 | "ggsideLayout", 69 | parent_layout, 70 | train_position = mod_ggproto_fun(parent_layout$train_position) |> 71 | mod_fun_at(quote(self$find_ggside_scales(data)), at = -1), 72 | find_ggside_scales = function(self, data) { 73 | params <- self$facet_params 74 | # ggside_opt <- clone_ggside(params$ggside) 75 | # self$facet$params[["ggside"]] <- ggside_opt 76 | # params$ggside <- ggside_opt 77 | # self$facet_params <- params 78 | layout <- self$layout 79 | x_scale <- lapply(self$panel_scales_x, mod_scale_map_method) 80 | y_scale <- lapply(self$panel_scales_y, mod_scale_map_method) 81 | 82 | if ("y" %in% params$ggside$sides_used && 83 | is.null(params$ggside$ysidex)) { 84 | ysidex <- find_side_scale("ysidex", data) 85 | ysidex <- unlist(ysidex)[[1]] 86 | # assume that if it being added this way 87 | # we follow the x_scale's position 88 | if (!is.null(ysidex) && !is_empty(x_scale)) { 89 | ysidex$position <- x_scale[[1]]$position 90 | } 91 | params$ggside$ysidex <- ysidex 92 | } 93 | 94 | if ("x" %in% params$ggside$sides_used && 95 | is.null(params$ggside$xsidey)) { 96 | xsidey <- find_side_scale("xsidey", data) 97 | xsidey <- unlist(xsidey)[[1]] 98 | if (!is.null(xsidey) && !is_empty(y_scale)) { 99 | xsidey$position <- y_scale[[1]]$position 100 | } 101 | params$ggside$xsidey <- xsidey 102 | } 103 | 104 | if (!is_empty(x_scale) && !is.null(params$ggside$ysidex) && 105 | !any(vapply(x_scale, function(scale) "ysidex" %in% scale$aesthetics, logical(1)))) { 106 | side_indx <- layout[layout$PANEL_TYPE == "y", ]$SCALE_X 107 | x_scale[side_indx] <- lapply(side_indx, function(i) params$ggside$ysidex$clone()) 108 | self$panel_scales_x <- x_scale 109 | } 110 | 111 | if (!is_empty(y_scale) && !is.null(params$ggside$xsidey) && 112 | !any(vapply(y_scale, function(scale) "xsidey" %in% scale$aesthetics, logical(1)))) { 113 | side_indx <- layout[layout$PANEL_TYPE == "x", ]$SCALE_Y 114 | y_scale[side_indx] <- lapply(side_indx, function(i) params$ggside$xsidey$clone()) 115 | self$panel_scales_y <- y_scale 116 | } 117 | invisible() 118 | }, 119 | map_position = mod_ggproto_fun( 120 | parent_layout$map_position, 121 | self$panel_scales_x[[1]]$aesthetics ~ unique(unlist(lapply(self$panel_scales_x, `[[`, "aesthetics"))), 122 | self$panel_scales_y[[1]]$aesthetics ~ unique(unlist(lapply(self$panel_scales_y, `[[`, "aesthetics"))) 123 | ), 124 | setup_panel_params = mod_ggproto_fun(parent_layout$setup_panel_params) |> 125 | mod_fun_at(quote(self$panel_params <- Map( 126 | \(param, type) { 127 | param$ggside_panel_type <- type 128 | names(param) <- sub("(x|y)side", "", names(param)) 129 | is_proto <- vapply(param, is_ggproto, logical(1)) 130 | param[is_proto] <- lapply(param[is_proto], \(x) { 131 | x$aesthetics <- sub("(x|y)side", "", x$aesthetics) 132 | x 133 | }) 134 | param 135 | }, 136 | self$panel_params, self$layout$PANEL_TYPE 137 | )), at = -1), 138 | setup_panel_guides = mod_ggproto_fun(parent_layout$setup_panel_guides), 139 | get_scales = mod_ggproto_fun(parent_layout$get_scales) 140 | ) 141 | } 142 | -------------------------------------------------------------------------------- /man/ggside_layer.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/side-layer.R 3 | \name{ggside_layer} 4 | \alias{ggside_layer} 5 | \alias{as_ggside_layer} 6 | \title{New ggside layer} 7 | \usage{ 8 | ggside_layer( 9 | geom = NULL, 10 | stat = NULL, 11 | data = NULL, 12 | mapping = NULL, 13 | position = NULL, 14 | params = list(), 15 | inherit.aes = TRUE, 16 | check.aes = TRUE, 17 | check.param = TRUE, 18 | show.legend = NA, 19 | key_glyph = NULL, 20 | side = NULL 21 | ) 22 | 23 | as_ggside_layer(layer, side) 24 | } 25 | \arguments{ 26 | \item{geom}{The geometric object to use to display the data for this layer. 27 | When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument 28 | can be used to override the default coupling between stats and geoms. The 29 | \code{geom} argument accepts the following: 30 | \itemize{ 31 | \item A \code{Geom} ggproto subclass, for example \code{GeomPoint}. 32 | \item A string naming the geom. To give the geom as a string, strip the 33 | function name of the \code{geom_} prefix. For example, to use \code{geom_point()}, 34 | give the geom as \code{"point"}. 35 | \item For more information and other ways to specify the geom, see the 36 | \link[ggplot2:layer_geoms]{layer geom} documentation. 37 | }} 38 | 39 | \item{stat}{The statistical transformation to use on the data for this layer. 40 | When using a \verb{geom_*()} function to construct a layer, the \code{stat} 41 | argument can be used to override the default coupling between geoms and 42 | stats. The \code{stat} argument accepts the following: 43 | \itemize{ 44 | \item A \code{Stat} ggproto subclass, for example \code{StatCount}. 45 | \item A string naming the stat. To give the stat as a string, strip the 46 | function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, 47 | give the stat as \code{"count"}. 48 | \item For more information and other ways to specify the stat, see the 49 | \link[ggplot2:layer_stats]{layer stat} documentation. 50 | }} 51 | 52 | \item{data}{The data to be displayed in this layer. There are three 53 | options: 54 | 55 | If \code{NULL}, the default, the data is inherited from the plot 56 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 57 | 58 | A \code{data.frame}, or other object, will override the plot 59 | data. All objects will be fortified to produce a data frame. See 60 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 61 | 62 | A \code{function} will be called with a single argument, 63 | the plot data. The return value must be a \code{data.frame}, and 64 | will be used as the layer data. A \code{function} can be created 65 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 66 | 67 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and 68 | \code{inherit.aes = TRUE} (the default), it is combined with the default mapping 69 | at the top level of the plot. You must supply \code{mapping} if there is no plot 70 | mapping.} 71 | 72 | \item{position}{A position adjustment to use on the data for this layer. This 73 | can be used in various ways, including to prevent overplotting and 74 | improving the display. The \code{position} argument accepts the following: 75 | \itemize{ 76 | \item The result of calling a position function, such as \code{position_jitter()}. 77 | This method allows for passing extra arguments to the position. 78 | \item A string naming the position adjustment. To give the position as a 79 | string, strip the function name of the \code{position_} prefix. For example, 80 | to use \code{position_jitter()}, give the position as \code{"jitter"}. 81 | \item For more information and other ways to specify the position, see the 82 | \link[ggplot2:layer_positions]{layer position} documentation. 83 | }} 84 | 85 | \item{params}{Additional parameters to the \code{geom} and \code{stat}.} 86 | 87 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 88 | rather than combining with them. This is most useful for helper functions 89 | that define both data and aesthetics and shouldn't inherit behaviour from 90 | the default plot specification, e.g. \code{\link[ggplot2:annotation_borders]{annotation_borders()}}.} 91 | 92 | \item{check.aes, check.param}{If \code{TRUE}, the default, will check that 93 | supplied parameters and aesthetics are understood by the \code{geom} or 94 | \code{stat}. Use \code{FALSE} to suppress the checks.} 95 | 96 | \item{show.legend}{logical. Should this layer be included in the legends? 97 | \code{NA}, the default, includes if any aesthetics are mapped. 98 | \code{FALSE} never includes, and \code{TRUE} always includes. 99 | It can also be a named logical vector to finely select the aesthetics to 100 | display. To include legend keys for all levels, even 101 | when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, 102 | but unobserved levels are omitted.} 103 | 104 | \item{key_glyph}{A legend key drawing function or a string providing the 105 | function name minus the \code{draw_key_} prefix. See \link[ggplot2]{draw_key} for details.} 106 | 107 | \item{side}{should the resulting \code{ggplot2_layer} be configured for x or y side} 108 | 109 | \item{layer}{a LayerInstance object made from \link[ggplot2]{layer}} 110 | } 111 | \description{ 112 | utility function to make a ggside layer compatible with 113 | \code{ggside} internals 114 | } 115 | -------------------------------------------------------------------------------- /R/side-facet_.R: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include utils-side-facet.R 3 | #' @include ggside.R 4 | #' @include utils-.R 5 | #' @include utils-calls.R 6 | #' @include utils-ggproto.R 7 | NULL 8 | ### INCLUDE END 9 | 10 | #' @rdname ggside-ggproto-facets 11 | #' @description 12 | #' S3 class that converts old Facet into one that 13 | #' is compatible with ggside. Can also update 14 | #' ggside on the object. Typically, the new ggproto 15 | #' will inherit from the object being replaced. 16 | #' @param facet Facet ggproto Object to replace 17 | #' @param ggside ggside object to update 18 | #' @export 19 | ggside_facet <- 20 | function(facet, ggside) { 21 | UseMethod("ggside_facet", facet) 22 | } 23 | 24 | #' @exportS3Method ggside::ggside_facet 25 | ggside_facet.default <- function(facet, ggside = ggside()) { 26 | abort(sprintf( 27 | "No %s() method for object of class <%s>", 28 | "ggside_facet", 29 | class(facet)[1] 30 | ), ) 31 | } 32 | 33 | find_super_facet <- function(facet, class = "ggsideFacet") { 34 | while (class(facet)[1] != class) { 35 | facet <- facet$super() 36 | } 37 | 38 | while (class(facet)[1] == class) { 39 | candidate <- facet 40 | facet <- facet$super() 41 | } 42 | candidate 43 | } 44 | 45 | #' @exportS3Method ggside::ggside_facet 46 | ggside_facet.ggsideFacet <- function(facet, ggside = ggside()) { 47 | facet_dispatch <- find_super_facet(facet, "ggsideFacet")$super() 48 | ggside_facet( 49 | facet_dispatch, 50 | ggside = ggside 51 | ) 52 | } 53 | 54 | #' @exportS3Method ggside::ggside_facet 55 | ggside_facet.FacetNull <- function(facet, ggside = ggside()) { 56 | new_facet <- new_ggside_facet(facet, ggside) 57 | check_facet( 58 | ggproto( 59 | "FacetSideNull", 60 | new_facet, 61 | draw_panels = sideFacetNull_draw_panels, 62 | map_data = sideFacetNull_map_data 63 | ) 64 | ) 65 | } 66 | 67 | #' @exportS3Method ggside::ggside_facet 68 | ggside_facet.FacetGrid <- function(facet, ggside = ggside()) { 69 | new_facet <- new_ggside_facet(facet, ggside) 70 | check_facet( 71 | ggproto( 72 | "FacetSideGrid", 73 | new_facet, 74 | draw_panels = sideFacetGrid_draw_panels, 75 | map_data = sideFacetGrid_map_data 76 | ) 77 | ) 78 | } 79 | 80 | #' @exportS3Method ggside::ggside_facet 81 | ggside_facet.FacetWrap <- function(facet, ggside = ggside()) { 82 | new_facet <- new_ggside_facet(facet, ggside) 83 | check_facet( 84 | ggproto( 85 | "FacetSideWrap", 86 | new_facet, 87 | draw_panels = sideFacetWrap_draw_panels, 88 | map_data = sideFacetWrap_map_data 89 | ) 90 | ) 91 | } 92 | 93 | new_ggside_facet <- function(facet, ggside) { 94 | force(facet) 95 | params <- facet$params 96 | params[["ggside"]] <- ggside 97 | ggproto( 98 | "ggsideFacet", 99 | facet, 100 | params = params, 101 | compute_layout = ggside_compute_layout(facet), 102 | train_scales = mod_ggproto_fun( 103 | facet$train_scales, 104 | x_scales[[1]]$aesthetics ~ unique(unlist(lapply( 105 | x_scales, `[[`, "aesthetics" 106 | ))), 107 | y_scales[[1]]$aesthetics ~ unique(unlist(lapply( 108 | y_scales, `[[`, "aesthetics" 109 | ))) 110 | ), 111 | finish_data = new_ggproto_fun(facet$finish_data, { 112 | if ("PANEL_TYPE" %in% names(data) && 113 | all(data$PANEL_TYPE != "main")) { 114 | data <- use_side_aes(data, unique(data$PANEL_TYPE)) 115 | } 116 | call_parent_method 117 | }) 118 | ) 119 | } 120 | 121 | 122 | ggside_compute_layout <- function(facet) { 123 | force(facet) 124 | function(data, params) { 125 | layout <- facet$compute_layout(data, params) 126 | layout <- check_scales_collapse(layout, params) 127 | layout <- sidePanelLayout(layout, ggside = params$ggside) 128 | layout 129 | } 130 | } 131 | 132 | check_facet <- function(facet) { 133 | fp <- facet$params 134 | # this proto should be the same as the one on the plot 135 | ggside <- facet$ggside 136 | col <- ggside$collapse 137 | if (!is.null(fp$free) && 138 | !is.null(col) && 139 | inherits(facet, "FacetWrap") && 140 | any(.lgl <- vapply(fp$free, identity, logical(1)))) { 141 | # if ggside collapse all - but scales is free - prioritize the scale and dont 142 | # collapse 143 | # i.e. facet_wrap(..., scales='free_y') + ggside(collapse="y") --> warning 144 | # main plots may have different y scales and thus we cannot collapse y. 145 | s <- sum(c(1, 2) * .lgl) 146 | new_col <- switch(s, 147 | free_x = { 148 | .f <- "free_x" 149 | switch(col, 150 | all = "y", 151 | x = NULL, 152 | col 153 | ) 154 | }, 155 | free_y = { 156 | .f <- "free_y" 157 | switch(col, 158 | all = "x", 159 | y = NULL, 160 | col 161 | ) 162 | }, 163 | free = { 164 | .f <- "free" 165 | NULL 166 | } 167 | ) 168 | 169 | warning( 170 | glue( 171 | "Plot's Facet parameter `scales = \"{.f}\"` is ", 172 | "incompatible with `ggside(..., collapse = \"{col}\")`.", 173 | " Setting collapse to ", 174 | if (is.null(new_col)) { 175 | "NULL" 176 | } else { 177 | glue('"{new_col}"') 178 | } 179 | ), 180 | call. = F 181 | ) 182 | ggside$collapse <- new_col 183 | } 184 | invisible(facet) 185 | } 186 | -------------------------------------------------------------------------------- /man/stat_summarise.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stats.r 3 | \docType{data} 4 | \name{stat_summarise} 5 | \alias{stat_summarise} 6 | \alias{stat_summarize} 7 | \alias{StatSummarise} 8 | \alias{StatSummarize} 9 | \title{Summarise by grouping variable} 10 | \format{ 11 | An object of class \code{StatSummarise} (inherits from \code{Stat}, \code{ggproto}, \code{gg}) of length 5. 12 | 13 | An object of class \code{StatSummarize} (inherits from \code{Stat}, \code{ggproto}, \code{gg}) of length 5. 14 | } 15 | \usage{ 16 | stat_summarise( 17 | mapping = NULL, 18 | data = NULL, 19 | geom = "bar", 20 | position = "identity", 21 | ..., 22 | fun = NULL, 23 | args = list(), 24 | show.legend = NA, 25 | inherit.aes = TRUE 26 | ) 27 | 28 | stat_summarize( 29 | mapping = NULL, 30 | data = NULL, 31 | geom = "bar", 32 | position = "identity", 33 | ..., 34 | fun = NULL, 35 | args = list(), 36 | show.legend = NA, 37 | inherit.aes = TRUE 38 | ) 39 | } 40 | \arguments{ 41 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and 42 | \code{inherit.aes = TRUE} (the default), it is combined with the default mapping 43 | at the top level of the plot. You must supply \code{mapping} if there is no plot 44 | mapping.} 45 | 46 | \item{data}{The data to be displayed in this layer. There are three 47 | options: 48 | 49 | If \code{NULL}, the default, the data is inherited from the plot 50 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 51 | 52 | A \code{data.frame}, or other object, will override the plot 53 | data. All objects will be fortified to produce a data frame. See 54 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 55 | 56 | A \code{function} will be called with a single argument, 57 | the plot data. The return value must be a \code{data.frame}, and 58 | will be used as the layer data. A \code{function} can be created 59 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 60 | 61 | \item{geom}{The geometric object to use to display the data for this layer. 62 | When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument 63 | can be used to override the default coupling between stats and geoms. The 64 | \code{geom} argument accepts the following: 65 | \itemize{ 66 | \item A \code{Geom} ggproto subclass, for example \code{GeomPoint}. 67 | \item A string naming the geom. To give the geom as a string, strip the 68 | function name of the \code{geom_} prefix. For example, to use \code{geom_point()}, 69 | give the geom as \code{"point"}. 70 | \item For more information and other ways to specify the geom, see the 71 | \link[ggplot2:layer_geoms]{layer geom} documentation. 72 | }} 73 | 74 | \item{position}{A position adjustment to use on the data for this layer. This 75 | can be used in various ways, including to prevent overplotting and 76 | improving the display. The \code{position} argument accepts the following: 77 | \itemize{ 78 | \item The result of calling a position function, such as \code{position_jitter()}. 79 | This method allows for passing extra arguments to the position. 80 | \item A string naming the position adjustment. To give the position as a 81 | string, strip the function name of the \code{position_} prefix. For example, 82 | to use \code{position_jitter()}, give the position as \code{"jitter"}. 83 | \item For more information and other ways to specify the position, see the 84 | \link[ggplot2:layer_positions]{layer position} documentation. 85 | }} 86 | 87 | \item{...}{additional arguments to pass to \link[ggplot2]{layer}.} 88 | 89 | \item{fun}{Summarising function to use. If no function provided 90 | it will default to \link[base]{length}.} 91 | 92 | \item{args}{List of additional arguments passed to the function.} 93 | 94 | \item{show.legend}{logical. Should this layer be included in the legends? 95 | \code{NA}, the default, includes if any aesthetics are mapped. 96 | \code{FALSE} never includes, and \code{TRUE} always includes. 97 | It can also be a named logical vector to finely select the aesthetics to 98 | display. To include legend keys for all levels, even 99 | when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, 100 | but unobserved levels are omitted.} 101 | 102 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 103 | rather than combining with them. This is most useful for helper functions 104 | that define both data and aesthetics and shouldn't inherit behaviour from 105 | the default plot specification, e.g. \code{\link[ggplot2:annotation_borders]{annotation_borders()}}.} 106 | } 107 | \value{ 108 | A Layer object to be added to a ggplot 109 | } 110 | \description{ 111 | Applies a function to a specified grouping variable 112 | } 113 | \section{Aesthetics}{ 114 | 115 | Using stat_summarise requires that you use \code{domain} as an aesthetic 116 | mapping. This allows you to summarise other data instead of assuming 117 | that \code{x} is the function's \code{domain}. 118 | } 119 | 120 | \examples{ 121 | library(tidyr) 122 | i <- gather(iris,"key","value",-Species) 123 | ggplot(i, aes(Species, fill = key, domain = value)) + 124 | geom_bar(aes(y = after_stat(summarise)), stat = "summarise", fun = mean) + 125 | stat_summarise(aes(y = after_stat(summarise), 126 | label = after_stat(summarise)), 127 | position = position_stack(vjust = .5), geom = "text", fun = mean) 128 | } 129 | \keyword{datasets} 130 | -------------------------------------------------------------------------------- /man/ggside-scales-discrete.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scales-sides-.R 3 | \name{ggside-scales-discrete} 4 | \alias{ggside-scales-discrete} 5 | \alias{scale_xsidey_discrete} 6 | \alias{scale_ysidex_discrete} 7 | \title{Position scales for discrete data ggside scales} 8 | \arguments{ 9 | \item{...}{ 10 | Arguments passed on to \code{\link[ggplot2:discrete_scale]{discrete_scale}} 11 | \describe{ 12 | \item{\code{breaks}}{One of: 13 | \itemize{ 14 | \item \code{NULL} for no breaks 15 | \item \code{waiver()} for the default breaks (the scale limits) 16 | \item A character vector of breaks 17 | \item A function that takes the limits as input and returns breaks 18 | as output. Also accepts rlang \link[rlang:as_function]{lambda} function 19 | notation. 20 | }} 21 | \item{\code{limits}}{One of: 22 | \itemize{ 23 | \item \code{NULL} to use the default scale values 24 | \item A character vector that defines possible values of the scale and their 25 | order 26 | \item A function that accepts the existing (automatic) values and returns 27 | new ones. Also accepts rlang \link[rlang:as_function]{lambda} function 28 | notation. 29 | }} 30 | \item{\code{drop}}{Should unused factor levels be omitted from the scale? 31 | The default, \code{TRUE}, uses the levels that appear in the data; 32 | \code{FALSE} includes the levels in the factor. Please note that to display 33 | every level in a legend, the layer should use \code{show.legend = TRUE}.} 34 | \item{\code{na.translate}}{Unlike continuous scales, discrete scales can easily show 35 | missing values, and do so by default. If you want to remove missing values 36 | from a discrete scale, specify \code{na.translate = FALSE}.} 37 | \item{\code{na.value}}{If \code{na.translate = TRUE}, what aesthetic value should the 38 | missing values be displayed as? Does not apply to position scales 39 | where \code{NA} is always placed at the far right.} 40 | \item{\code{aesthetics}}{The names of the aesthetics that this scale works with.} 41 | \item{\code{minor_breaks}}{One of: 42 | \itemize{ 43 | \item \code{NULL} for no minor breaks 44 | \item \code{waiver()} for the default breaks (none for discrete, one minor break 45 | between each major break for continuous) 46 | \item A numeric vector of positions 47 | \item A function that given the limits returns a vector of minor breaks. Also 48 | accepts rlang \link[rlang:as_function]{lambda} function notation. When 49 | the function has two arguments, it will be given the limits and major 50 | break positions. 51 | }} 52 | \item{\code{labels}}{One of the options below. Please note that when \code{labels} is a 53 | vector, it is highly recommended to also set the \code{breaks} argument as a 54 | vector to protect against unintended mismatches. 55 | \itemize{ 56 | \item \code{NULL} for no labels 57 | \item \code{waiver()} for the default labels computed by the 58 | transformation object 59 | \item A character vector giving labels (must be same length as \code{breaks}) 60 | \item An expression vector (must be the same length as breaks). See ?plotmath for details. 61 | \item A function that takes the breaks as input and returns labels 62 | as output. Also accepts rlang \link[rlang:as_function]{lambda} function 63 | notation. 64 | }} 65 | \item{\code{call}}{The \code{call} used to construct the scale for reporting messages.} 66 | \item{\code{super}}{The super class to use for the constructed scale} 67 | }} 68 | 69 | \item{expand}{For position scales, a vector of range expansion constants used to add some 70 | padding around the data to ensure that they are placed some distance 71 | away from the axes. Use the convenience function \code{\link[ggplot2:expansion]{expansion()}} 72 | to generate the values for the \code{expand} argument. The defaults are to 73 | expand the scale by 5\% on each side for continuous variables, and by 74 | 0.6 units on each side for discrete variables.} 75 | 76 | \item{guide}{A function used to create a guide or its name. See 77 | \code{\link[ggplot2:guides]{guides()}} for more information.} 78 | 79 | \item{position}{For position scales, The position of the axis. 80 | \code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} 81 | } 82 | \value{ 83 | ggside_scale object inheriting from ggplot2::ScaleDiscretePosition 84 | } 85 | \description{ 86 | The \link{xside} and \link{yside} variants of \link[ggplot2]{scale_x_discrete}/\link[ggplot2]{scale_y_discrete}. 87 | \link{scale_xsidey_discrete} enables better control on how the y-axis is rendered on the xside panel and 88 | \link{scale_ysidex_discrete} enables better control on how the x-axis is rendered on the yside panel. 89 | } 90 | \examples{ 91 | 92 | library(ggside) 93 | library(ggplot2) 94 | # adding discrete y-scale to the x-side panel, when main panel mapped to continuous data 95 | ggplot(mpg, aes(displ, hwy, colour = class)) + 96 | geom_point() + 97 | geom_xsideboxplot(aes(y = class), orientation = "y") + 98 | theme(ggside.panel.scale = .3) + 99 | scale_xsidey_discrete(guide = guide_axis(angle = 45)) 100 | 101 | # If you need to specify the main scale, but need to prevent this from 102 | # affecting the side scale. Simply add the appropriate `scale_*side*_*()` 103 | # function. 104 | ggplot(mpg, aes(class, displ)) + 105 | geom_boxplot() + 106 | geom_ysideboxplot(aes(x = "all"), orientation = "x") + 107 | scale_x_discrete(guide = guide_axis(angle = 90)) + # rotate the main panel text 108 | scale_ysidex_discrete() # leave side panel as default 109 | } 110 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # README 2 | Justin Landis 3 | 2025-11-24 4 | 5 | # ggside plyxp website 6 | 7 | 8 | 9 | [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version-ago/ggside)](https://cran.r-project.org/package=ggside) 10 | [![CRAN_Download_Badge](http://cranlogs.r-pkg.org/badges/ggside)](https://cran.r-project.org/package=ggside) 11 | [![CRAN_Download_Badge](http://cranlogs.r-pkg.org/badges/grand-total/ggside)](https://cran.r-project.org/package=ggside) 12 | [![R-CMD-check](https://github.com/jtlandis/ggside/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/jtlandis/ggside/actions/workflows/R-CMD-check.yaml) 13 | [![Codecov test 14 | coverage](https://codecov.io/gh/jtlandis/ggside/branch/main/graph/badge.svg)](https://app.codecov.io/gh/jtlandis/ggside?branch=main) 15 | 16 | 17 | The R package ggside expands on the ggplot2 package. This package allows 18 | the user to add graphical information about one of the main panel’s 19 | axis. This is particularly useful for metadata for discrete axis, or 20 | summary graphics on a continuous axis such as a boxplot or a density 21 | distribution. 22 | 23 | ## Installation 24 | 25 | Please install from CRAN for the latest stable version of `ggside`. You 26 | can also install from the Github as seen below. 27 | 28 | ``` r 29 | #CRAN 30 | utils::install.packages("ggside") 31 | #Github 32 | devtools::install_github("jtlandis/ggside") 33 | ``` 34 | 35 | ## Usage 36 | 37 | Using this package is similar to adding any additional layer to a 38 | ggplot. All geometries supported by ggside follow a pattern like 39 | `geom_xside*` or `geom_yside*` which will add that geometry to either 40 | the x side panel or the y side panel respectively. If you add 41 | `geom_xsidedensity` to a plot, then this places a density geometry in 42 | its own panel that is positioned by default above the main panel. This 43 | panel will share the same x axis of the main panel but will have an 44 | independent y axis. Take the following example from the ggplot2 readme. 45 | 46 | ``` r 47 | library(ggplot2) 48 | library(ggside) 49 | 50 | ggplot(mpg, aes(displ, hwy, colour = class)) + 51 | geom_point(size = 2) + 52 | geom_xsidedensity(aes(y = after_stat(density)), position = "stack") + 53 | geom_ysidedensity(aes(x = after_stat(density)), position = "stack") + 54 | theme(axis.text.x = element_text(angle = 90, vjust = .5)) 55 | ``` 56 | 57 | ![](man/figures/README-example-1.png) 58 | 59 | After version `0.3.0` you no longer **need** to use 60 | `scale_(y|x)side(x|y)_*()` to mix discrete and continuous axes. `ggside` 61 | geom’s have their default positional aesthetics `x` and `y` aesthetics 62 | to be prepended with `ysidex` and `xsidey` respectively under the hood. 63 | Now you may mix discrete and continuous axes with ease. 64 | 65 | ``` r 66 | ggplot(mpg, aes(displ, hwy, colour = class)) + 67 | geom_point(size = 2) + 68 | geom_xsideboxplot(aes(y =class), orientation = "y") + 69 | geom_ysidedensity(aes(x = after_stat(density)), position = "stack") + 70 | scale_ysidex_continuous(guide = guide_axis(angle = 90), minor_breaks = NULL) + 71 | theme(ggside.panel.scale = .3) 72 | ``` 73 | 74 | ![](man/figures/README-example-mix-scales-1.png) 75 | 76 | With version 0.2.0, more theme elements allow for better control over 77 | how side panels are rendered. 78 | 79 | ``` r 80 | ggplot(iris, aes(Sepal.Width, Sepal.Length, fill = Species)) + 81 | geom_point(aes(color = Species)) + 82 | geom_xsidedensity(alpha = .3, position = "stack") + 83 | geom_ysideboxplot(aes(x = Species), orientation = "x") + 84 | scale_ysidex_discrete(guide = guide_axis(angle = 45)) + 85 | theme_dark() + 86 | theme(ggside.panel.scale = .3, 87 | ggside.panel.border = element_rect(NA, "red", linewidth = 2), 88 | ggside.panel.grid = element_line("black", linewidth = .1, linetype = "dotted"), 89 | ggside.panel.background = element_blank()) + 90 | guides(color = "none", fill = "none") 91 | ``` 92 | 93 | ![](man/figures/README-example-side-themes-1.png) 94 | 95 | For a more detailed guide please see `vignette('ggside_basic_usage')` 96 | for more information. 97 | 98 | ## Issues and Bug Reporting 99 | 100 | If you find any issues or want to suggest an enhancement, please make a 101 | post at [jtlandis/ggside](https://github.com/jtlandis/ggside/issues). 102 | 103 | ## Known Issues 104 | 105 | The following section will summarize issues that are present on the 106 | current CRAN release. These will either be fixed on the main branch of 107 | this git repository, or currently in development to be fixed on one of 108 | the development branches. The current CRAN version of `ggside` is 109 | v0.4.0. 110 | 111 | - When using layer that requires its some positional scale on the main 112 | panel to be computed later, but the same positional scale is present 113 | on the parallel side layer that is meant to be discrete, you may see 114 | a warning and the data may be missing. Below is an example: 115 | 116 | ``` r 117 | ggplot(iris, aes(Sepal.Width)) + 118 | # main panel y scale initializes later 119 | geom_density() + 120 | # xsidey scale is discrete but misses initial training 121 | geom_xsidepoint(aes(y = Species)) 122 | ``` 123 | 124 | To remedy this, please explicitly declare the scale for the main 125 | panels: 126 | 127 | ``` r 128 | ggplot(iris, aes(Sepal.Width)) + 129 | geom_density() + 130 | geom_xsidepoint(aes(y = Species)) + 131 | scale_y_continuous() 132 | ``` 133 | -------------------------------------------------------------------------------- /R/scales-xyfill.R: -------------------------------------------------------------------------------- 1 | ### INCLUDE BEGIN 2 | #' @include utils-ggplot2-reimpl-.R 3 | NULL 4 | ### INCLUDE END 5 | #' Scales for the *fill aesthetics 6 | #' 7 | #' These are the various scales that can be applied to the xsidebar or ysidebar 8 | #' fill aesthetics, such as xfill and yfill. They have the same usage as 9 | #' existing standard ggplot2 scales. 10 | #' 11 | #' @name scale_xfill 12 | #' @aliases scale_yfill 13 | #' 14 | #' @section Related Functions: 15 | #' 16 | #' \itemize{ 17 | #' \item scale_xfill_hue 18 | #' \item scale_yfill_hue 19 | #' \item scale_xfill_discrete 20 | #' \item scale_yfill_discrete 21 | #' \item scale_xfill_continuous 22 | #' \item scale_yfill_continuous 23 | #' \item scale_xfill_manual 24 | #' \item scale_yfill_manual 25 | #' \item scale_xfill_gradient 26 | #' \item scale_yfill_gradient 27 | #' \item scale_xfill_gradientn 28 | #' \item scale_yfill_gradientn 29 | #' } 30 | #' @return returns a ggproto object to be added to a ggplot 31 | NULL 32 | 33 | #' scale_xfill_hue 34 | #' @rdname scale_xfill 35 | #' @usage NULL 36 | #' @export 37 | scale_xfill_hue <- function(name = waiver(), ..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, 38 | direction = 1, na.value = "grey50", aesthetics = "xfill") 39 | { 40 | ggplot2::discrete_scale(aesthetics = aesthetics, 41 | name = name, 42 | palette = scales::hue_pal(h, c, l, h.start, direction), 43 | na.value = na.value, 44 | ...) 45 | } 46 | 47 | #' scale_xfill_manual 48 | #' @rdname scale_xfill 49 | #' @usage NULL 50 | #' @export 51 | scale_xfill_manual <- function(..., values, aesthetics = "xfill", breaks = waiver(), na.value = "grey50") { 52 | manual_scale(aesthetics, values, breaks, ..., na.value = na.value) 53 | } 54 | 55 | #' scale_xfill_gradient 56 | #' @rdname scale_xfill 57 | #' @usage NULL 58 | #' @export 59 | scale_xfill_gradient <- function (name = waiver(), ..., low = "#132B43", high = "#56B1F7", 60 | space = "Lab", na.value = "grey50", 61 | guide = guide_colorbar(available_aes = "xfill"), aesthetics = "xfill") 62 | { 63 | continuous_scale(aesthetics = aesthetics, 64 | name = name, 65 | palette = scales::seq_gradient_pal(low, high, space), 66 | na.value = na.value, guide = guide, ...) 67 | } 68 | 69 | #' @rdname scale_xfill 70 | #' @usage NULL 71 | #' @export 72 | scale_xfill_gradientn <- function (name = waiver(), ..., colours, values = NULL, 73 | space = "Lab", na.value = "grey50", 74 | guide = guide_colorbar(available_aes = "xfill"), aesthetics = "xfill", colors) 75 | { 76 | colours <- if (missing(colours)) 77 | colors 78 | else colours 79 | continuous_scale(aesthetics = aesthetics, "gradientn", name = name, 80 | palette = scales::gradient_n_pal(colours, values, space), 81 | na.value = na.value, guide = guide, ...) 82 | } 83 | 84 | #' scale_xfill_discrete 85 | #' @rdname scale_xfill 86 | #' @usage NULL 87 | #' @export 88 | scale_xfill_discrete <- scale_xfill_hue 89 | 90 | #' scale_xfill_continuous 91 | #' @rdname scale_xfill 92 | #' @usage NULL 93 | #' @export 94 | scale_xfill_continuous <- scale_xfill_gradient 95 | 96 | 97 | #' scale_yfill_hue 98 | #' @rdname scale_yfill 99 | #' @usage NULL 100 | #' @export 101 | scale_yfill_hue <- function(name = waiver(), ..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, 102 | direction = 1, na.value = "grey50", aesthetics = "yfill") 103 | { 104 | ggplot2::discrete_scale(aesthetics = aesthetics, name = name, 105 | palette = scales::hue_pal(h, c, l, h.start, direction), na.value = na.value, ...) 106 | } 107 | 108 | #' scale_yfill_manual 109 | #' @rdname scale_yfill 110 | #' @usage NULL 111 | #' @export 112 | scale_yfill_manual <- function(..., values, aesthetics = "yfill", breaks = waiver()) { 113 | manual_scale(aesthetics, values, breaks, ...) 114 | } 115 | 116 | #' scale_yfill_gradient 117 | #' @rdname scale_yfill 118 | #' @usage NULL 119 | #' @export 120 | scale_yfill_gradient <- function (name = waiver(), ..., low = "#132B43", high = "#56B1F7", 121 | space = "Lab",na.value = "grey50", 122 | guide = guide_colorbar(available_aes = "yfill"), aesthetics = "yfill") 123 | { 124 | continuous_scale(aesthetics = aesthetics, 125 | name = name, 126 | palette = scales::seq_gradient_pal(low, high, space), 127 | na.value = na.value, guide = guide, ...) 128 | } 129 | 130 | #' @rdname scale_xfill 131 | #' @usage NULL 132 | #' @export 133 | scale_yfill_gradientn <- function (name = waiver(), ..., colours, values = NULL, 134 | space = "Lab", na.value = "grey50", 135 | guide = guide_colorbar(available_aes = "yfill"), aesthetics = "yfill", colors) 136 | { 137 | colours <- if (missing(colours)) 138 | colors 139 | else colours 140 | continuous_scale(aesthetics = aesthetics, name = name, 141 | palette = scales::gradient_n_pal(colours,values, space), 142 | na.value = na.value, guide = guide, ...) 143 | } 144 | 145 | #' scale_yfill_discrete 146 | #' @rdname scale_yfill 147 | #' @usage NULL 148 | #' @export 149 | scale_yfill_discrete <- scale_yfill_hue 150 | 151 | #' scale_yfill_continuous 152 | #' @rdname scale_yfill 153 | #' @usage NULL 154 | #' @export 155 | scale_yfill_continuous <- scale_yfill_gradient 156 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(as_ggside,"ggside::ggside") 4 | S3method(as_ggside,default) 5 | S3method(as_ggside,ggplot) 6 | S3method(as_ggside,ggside) 7 | S3method(as_ggside_layer,LayerInstance) 8 | S3method(as_ggside_layer,ggside_layer) 9 | S3method(ggside::ggside_facet,FacetGrid) 10 | S3method(ggside::ggside_facet,FacetNull) 11 | S3method(ggside::ggside_facet,FacetWrap) 12 | S3method(ggside::ggside_facet,default) 13 | S3method(ggside::ggside_facet,ggsideFacet) 14 | S3method(ggside_coord,CoordCartesian) 15 | S3method(ggside_coord,CoordFixed) 16 | S3method(ggside_coord,CoordSide) 17 | S3method(ggside_coord,CoordTrans) 18 | S3method(ggside_coord,default) 19 | S3method(ggside_layout,Layout) 20 | S3method(ggside_layout,default) 21 | S3method(ggside_layout,ggsideLayout) 22 | S3method(single_value,default) 23 | S3method(single_value,factor) 24 | export(GeomXsideabline) 25 | export(GeomXsidebar) 26 | export(GeomXsideboxplot) 27 | export(GeomXsidecol) 28 | export(GeomXsidedensity) 29 | export(GeomXsidefunction) 30 | export(GeomXsidehline) 31 | export(GeomXsidelabel) 32 | export(GeomXsideline) 33 | export(GeomXsidepath) 34 | export(GeomXsidepoint) 35 | export(GeomXsidesegment) 36 | export(GeomXsidetext) 37 | export(GeomXsidetile) 38 | export(GeomXsideviolin) 39 | export(GeomXsidevline) 40 | export(GeomYsideabline) 41 | export(GeomYsidebar) 42 | export(GeomYsideboxplot) 43 | export(GeomYsidecol) 44 | export(GeomYsidedensity) 45 | export(GeomYsidefunction) 46 | export(GeomYsidehline) 47 | export(GeomYsidelabel) 48 | export(GeomYsideline) 49 | export(GeomYsidepath) 50 | export(GeomYsidepoint) 51 | export(GeomYsidesegment) 52 | export(GeomYsidetext) 53 | export(GeomYsidetile) 54 | export(GeomYsideviolin) 55 | export(GeomYsidevline) 56 | export(PositionRescale) 57 | export(StatSummarise) 58 | export(StatSummarize) 59 | export(as_ggside) 60 | export(as_ggsideCoord) 61 | export(as_ggsideFacet) 62 | export(as_ggside_layer) 63 | export(check_scales_collapse) 64 | export(class_ggside) 65 | export(class_ggside_layer) 66 | export(class_ggside_opt) 67 | export(class_ggside_scale) 68 | export(geom_xsideabline) 69 | export(geom_xsidebar) 70 | export(geom_xsideboxplot) 71 | export(geom_xsidecol) 72 | export(geom_xsidedensity) 73 | export(geom_xsidefreqpoly) 74 | export(geom_xsidefunction) 75 | export(geom_xsidehistogram) 76 | export(geom_xsidehline) 77 | export(geom_xsidelabel) 78 | export(geom_xsideline) 79 | export(geom_xsidepath) 80 | export(geom_xsidepoint) 81 | export(geom_xsidesegment) 82 | export(geom_xsidetext) 83 | export(geom_xsidetile) 84 | export(geom_xsideviolin) 85 | export(geom_xsidevline) 86 | export(geom_ysideabline) 87 | export(geom_ysidebar) 88 | export(geom_ysideboxplot) 89 | export(geom_ysidecol) 90 | export(geom_ysidedensity) 91 | export(geom_ysidefreqpoly) 92 | export(geom_ysidefunction) 93 | export(geom_ysidehistogram) 94 | export(geom_ysidehline) 95 | export(geom_ysidelabel) 96 | export(geom_ysideline) 97 | export(geom_ysidepath) 98 | export(geom_ysidepoint) 99 | export(geom_ysidesegment) 100 | export(geom_ysidetext) 101 | export(geom_ysidetile) 102 | export(geom_ysideviolin) 103 | export(geom_ysidevline) 104 | export(ggside) 105 | export(ggside_coord) 106 | export(ggside_facet) 107 | export(ggside_geom) 108 | export(ggside_layer) 109 | export(ggside_layout) 110 | export(is.ggside) 111 | export(is.ggside_layer) 112 | export(is.ggside_options) 113 | export(is.ggside_scale) 114 | export(is_ggside) 115 | export(is_ggside_layer) 116 | export(is_ggside_options) 117 | export(is_ggside_scale) 118 | export(parse_side_aes) 119 | export(position_rescale) 120 | export(position_xrescale) 121 | export(position_yrescale) 122 | export(scale_xcolor_continuous) 123 | export(scale_xcolor_discrete) 124 | export(scale_xcolor_gradientn) 125 | export(scale_xcolor_manual) 126 | export(scale_xcolour_continuous) 127 | export(scale_xcolour_discrete) 128 | export(scale_xcolour_gradient) 129 | export(scale_xcolour_gradientn) 130 | export(scale_xcolour_hue) 131 | export(scale_xcolour_manual) 132 | export(scale_xfill_continuous) 133 | export(scale_xfill_discrete) 134 | export(scale_xfill_gradient) 135 | export(scale_xfill_gradientn) 136 | export(scale_xfill_hue) 137 | export(scale_xfill_manual) 138 | export(scale_xsidey_binned) 139 | export(scale_xsidey_continuous) 140 | export(scale_xsidey_discrete) 141 | export(scale_xsidey_log10) 142 | export(scale_xsidey_reverse) 143 | export(scale_xsidey_sqrt) 144 | export(scale_ycolor_continuous) 145 | export(scale_ycolor_discrete) 146 | export(scale_ycolor_gradientn) 147 | export(scale_ycolor_manual) 148 | export(scale_ycolour_continuous) 149 | export(scale_ycolour_discrete) 150 | export(scale_ycolour_gradient) 151 | export(scale_ycolour_gradientn) 152 | export(scale_ycolour_hue) 153 | export(scale_ycolour_manual) 154 | export(scale_yfill_continuous) 155 | export(scale_yfill_discrete) 156 | export(scale_yfill_gradient) 157 | export(scale_yfill_gradientn) 158 | export(scale_yfill_hue) 159 | export(scale_yfill_manual) 160 | export(scale_ysidex_binned) 161 | export(scale_ysidex_continuous) 162 | export(scale_ysidex_discrete) 163 | export(scale_ysidex_log10) 164 | export(scale_ysidex_reverse) 165 | export(scale_ysidex_sqrt) 166 | export(sidePanelLayout) 167 | export(stat_summarise) 168 | export(stat_summarize) 169 | export(stat_xsidefunction) 170 | export(stat_ysidefunction) 171 | export(theme_ggside_bw) 172 | export(theme_ggside_classic) 173 | export(theme_ggside_dark) 174 | export(theme_ggside_gray) 175 | export(theme_ggside_grey) 176 | export(theme_ggside_light) 177 | export(theme_ggside_linedraw) 178 | export(theme_ggside_minimal) 179 | export(theme_ggside_void) 180 | import(ggplot2) 181 | import(grid) 182 | import(gtable) 183 | import(rlang) 184 | import(scales) 185 | importFrom(ggplot2,ggplot_add) 186 | importFrom(ggplot2,guide_gengrob) 187 | importFrom(glue,glue) 188 | importFrom(glue,glue_collapse) 189 | importFrom(stats,setNames) 190 | importFrom(vctrs,data_frame) 191 | importFrom(vctrs,vec_ptype2) 192 | importFrom(vctrs,vec_rbind) 193 | -------------------------------------------------------------------------------- /man/geom_xsidepoint.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-sidepoint.r 3 | \name{geom_xsidepoint} 4 | \alias{geom_xsidepoint} 5 | \alias{geom_*sidepoint} 6 | \alias{geom_ysidepoint} 7 | \title{Side Points} 8 | \usage{ 9 | geom_xsidepoint( 10 | mapping = NULL, 11 | data = NULL, 12 | stat = "identity", 13 | position = "identity", 14 | ..., 15 | na.rm = FALSE, 16 | show.legend = NA, 17 | inherit.aes = TRUE 18 | ) 19 | 20 | geom_ysidepoint( 21 | mapping = NULL, 22 | data = NULL, 23 | stat = "identity", 24 | position = "identity", 25 | ..., 26 | na.rm = FALSE, 27 | show.legend = NA, 28 | inherit.aes = TRUE 29 | ) 30 | } 31 | \arguments{ 32 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and 33 | \code{inherit.aes = TRUE} (the default), it is combined with the default mapping 34 | at the top level of the plot. You must supply \code{mapping} if there is no plot 35 | mapping.} 36 | 37 | \item{data}{The data to be displayed in this layer. There are three 38 | options: 39 | 40 | If \code{NULL}, the default, the data is inherited from the plot 41 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 42 | 43 | A \code{data.frame}, or other object, will override the plot 44 | data. All objects will be fortified to produce a data frame. See 45 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 46 | 47 | A \code{function} will be called with a single argument, 48 | the plot data. The return value must be a \code{data.frame}, and 49 | will be used as the layer data. A \code{function} can be created 50 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 51 | 52 | \item{stat}{The statistical transformation to use on the data for this layer. 53 | When using a \verb{geom_*()} function to construct a layer, the \code{stat} 54 | argument can be used to override the default coupling between geoms and 55 | stats. The \code{stat} argument accepts the following: 56 | \itemize{ 57 | \item A \code{Stat} ggproto subclass, for example \code{StatCount}. 58 | \item A string naming the stat. To give the stat as a string, strip the 59 | function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, 60 | give the stat as \code{"count"}. 61 | \item For more information and other ways to specify the stat, see the 62 | \link[ggplot2:layer_stats]{layer stat} documentation. 63 | }} 64 | 65 | \item{position}{A position adjustment to use on the data for this layer. This 66 | can be used in various ways, including to prevent overplotting and 67 | improving the display. The \code{position} argument accepts the following: 68 | \itemize{ 69 | \item The result of calling a position function, such as \code{position_jitter()}. 70 | This method allows for passing extra arguments to the position. 71 | \item A string naming the position adjustment. To give the position as a 72 | string, strip the function name of the \code{position_} prefix. For example, 73 | to use \code{position_jitter()}, give the position as \code{"jitter"}. 74 | \item For more information and other ways to specify the position, see the 75 | \link[ggplot2:layer_positions]{layer position} documentation. 76 | }} 77 | 78 | \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These 79 | arguments broadly fall into one of 4 categories below. Notably, further 80 | arguments to the \code{position} argument, or aesthetics that are required 81 | can \emph{not} be passed through \code{...}. Unknown arguments that are not part 82 | of the 4 categories below are ignored. 83 | \itemize{ 84 | \item Static aesthetics that are not mapped to a scale, but are at a fixed 85 | value and apply to the layer as a whole. For example, \code{colour = "red"} 86 | or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} 87 | section that lists the available options. The 'required' aesthetics 88 | cannot be passed on to the \code{params}. Please note that while passing 89 | unmapped aesthetics as vectors is technically possible, the order and 90 | required length is not guaranteed to be parallel to the input data. 91 | \item When constructing a layer using 92 | a \verb{stat_*()} function, the \code{...} argument can be used to pass on 93 | parameters to the \code{geom} part of the layer. An example of this is 94 | \code{stat_density(geom = "area", outline.type = "both")}. The geom's 95 | documentation lists which parameters it can accept. 96 | \item Inversely, when constructing a layer using a 97 | \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters 98 | to the \code{stat} part of the layer. An example of this is 99 | \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation 100 | lists which parameters it can accept. 101 | \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through 102 | \code{...}. This can be one of the functions described as 103 | \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. 104 | }} 105 | 106 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed with 107 | a warning. If \code{TRUE}, missing values are silently removed.} 108 | 109 | \item{show.legend}{logical. Should this layer be included in the legends? 110 | \code{NA}, the default, includes if any aesthetics are mapped. 111 | \code{FALSE} never includes, and \code{TRUE} always includes. 112 | It can also be a named logical vector to finely select the aesthetics to 113 | display. To include legend keys for all levels, even 114 | when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, 115 | but unobserved levels are omitted.} 116 | 117 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 118 | rather than combining with them. This is most useful for helper functions 119 | that define both data and aesthetics and shouldn't inherit behaviour from 120 | the default plot specification, e.g. \code{\link[ggplot2:annotation_borders]{annotation_borders()}}.} 121 | } 122 | \value{ 123 | XLayer or YLayer object to be added to a ggplot object 124 | } 125 | \description{ 126 | The ggside variants of \link[ggplot2]{geom_point} is \code{\link[=geom_xsidepoint]{geom_xsidepoint()}} and 127 | \code{\link[=geom_ysidepoint]{geom_ysidepoint()}}. Both variants inherit from \link[ggplot2]{geom_point}, 128 | thus the only difference is where the data is plotted. The \code{xside} variant will 129 | plot data along the x-axis, while the \code{yside} variant will plot data along the 130 | y-axis. 131 | } 132 | \examples{ 133 | ggplot(diamonds, aes(depth, table, alpha = .2)) + 134 | geom_point() + 135 | geom_ysidepoint(aes(x = price)) + 136 | geom_xsidepoint(aes(y = price)) + 137 | theme( 138 | ggside.panel.scale = .3 139 | ) 140 | } 141 | --------------------------------------------------------------------------------