ggalluvial/0000755000176200001440000000000014375362512012411 5ustar liggesusersggalluvial/NAMESPACE0000644000176200001440000000233314367761413013635 0ustar liggesusers# Generated by roxygen2: do not edit by hand export(GeomAlluvium) export(GeomFlow) export(GeomLode) export(GeomStratum) export(StatAlluvium) export(StatFlow) export(StatStratum) export(data_to_alluvium) export(geom_alluvium) export(geom_flow) export(geom_lode) export(geom_stratum) export(is_alluvia_form) export(is_alluvial) export(is_alluvial_alluvia) export(is_alluvial_lodes) export(is_lodes_form) export(lode_backfront) export(lode_backward) export(lode_forward) export(lode_frontback) export(lode_leftright) export(lode_leftward) export(lode_rightleft) export(lode_rightward) export(lode_zagzig) export(lode_zigzag) export(positions_to_flow) export(self_adjoin) export(stat_alluvium) export(stat_flow) export(stat_stratum) export(to_alluvia) export(to_alluvia_form) export(to_lodes) export(to_lodes_form) import(ggplot2) importFrom(rlang,"%||%") importFrom(rlang,.data) importFrom(rlang,enexpr) importFrom(rlang,enexprs) importFrom(rlang,enquo) importFrom(rlang,enquos) importFrom(rlang,have_name) importFrom(rlang,is_character) importFrom(rlang,is_empty) importFrom(rlang,is_integerish) importFrom(rlang,is_quosures) importFrom(rlang,quo_name) importFrom(rlang,quos) importFrom(tidyselect,vars_pull) importFrom(tidyselect,vars_select) ggalluvial/README.md0000644000176200001440000001727014367761413013703 0ustar liggesusers # ggalluvial [![Travis](https://travis-ci.org/corybrunson/ggalluvial.svg?branch=main)](https://travis-ci.org/corybrunson/ggalluvial) [![CRAN](http://www.r-pkg.org/badges/version/ggalluvial)](https://cran.r-project.org/package=ggalluvial) [![downloads](https://cranlogs.r-pkg.org/badges/ggalluvial)](https://cran.r-project.org/package=ggalluvial) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.3836748.svg)](https://doi.org/10.5281/zenodo.3836748) [![JOSS](https://joss.theoj.org/papers/10.21105/joss.02017/status.svg)](https://doi.org/10.21105/joss.02017) This is a [**ggplot2** extension](https://exts.ggplot2.tidyverse.org/) for alluvial plots. ## Design The alluvial plots implemented here can be used to visualize frequency distributions over time or frequency tables involving several categorical variables. The design is inspired by the [**alluvial**](https://github.com/mbojan/alluvial) package, but the **ggplot2** framework induced several conspicuous differences: - **alluvial** understands a variety of inputs (vectors, lists, data frames), whereas **ggalluvial** requires a single data frame; - **alluvial** uses each variable of these inputs as a dimension of the data, whereas **ggalluvial** requires the user to specify the dimensions, either as separate aesthetics or as [key-value pairs](https://tidyr.tidyverse.org/); - **alluvial** produces both the *alluvia*, which link cohorts across multiple dimensions, and (what are here called) the *strata*, which partition the data along each dimension, in a single function; whereas **ggalluvial** relies on separate layers (stats and geoms) to produce strata, alluvia, and alluvial segments called *lodes* and *flows*. Additionally, **ggalluvial** arranges these layers vertically without gaps, so that the secondary plotting axis indicates the cumulative values of the strata at each dimension. ## Installation The latest stable release can be installed from CRAN: ``` r install.packages("ggalluvial") ``` The [`cran` branch](https://github.com/corybrunson/ggalluvial/tree/cran) will contain the version most recently submitted to [CRAN](https://cran.r-project.org/package=ggalluvial). It is duplicated in the `master` branch, from which source the [website](https://corybrunson.github.io/ggalluvial/) is built. The development version can be installed from the (default) `main` branch on GitHub: ``` r remotes::install_github("corybrunson/ggalluvial@main", build_vignettes = TRUE) ``` Note that, in order to build the vignettes, the imported packages **alluvial**, **ggfittext**, and **ggrepel** must be installed. To skip this step, leave `build_vignettes` unspecified or set it to `FALSE`. The [`optimization` branch](https://github.com/corybrunson/ggalluvial/tree/optimization) contains a development version with experimental functions to reduce the number or area of alluvial overlaps (see issue [\#6](https://github.com/corybrunson/ggalluvial/issues/6)). Install it as follows: ``` r remotes::install_github("corybrunson/ggalluvial", ref = "optimization") ``` Note, however, that this branch has not kept pace with the `main` branch or with recent upgrades on CRAN. ## Usage ### Example Here is how to generate an alluvial plot representation of the multi-dimensional categorical dataset of passengers on the Titanic: ``` r titanic_wide <- data.frame(Titanic) head(titanic_wide) #> Class Sex Age Survived Freq #> 1 1st Male Child No 0 #> 2 2nd Male Child No 0 #> 3 3rd Male Child No 35 #> 4 Crew Male Child No 0 #> 5 1st Female Child No 0 #> 6 2nd Female Child No 0 ggplot(data = titanic_wide, aes(axis1 = Class, axis2 = Sex, axis3 = Age, y = Freq)) + scale_x_discrete(limits = c("Class", "Sex", "Age"), expand = c(.2, .05)) + xlab("Demographic") + geom_alluvium(aes(fill = Survived)) + geom_stratum() + geom_text(stat = "stratum", aes(label = after_stat(stratum))) + theme_minimal() + ggtitle("passengers on the maiden voyage of the Titanic", "stratified by demographics and survival") ``` ![](man/figures/README-unnamed-chunk-6-1.png) The data is in “wide” format, but **ggalluvial** also recognizes data in “long” format and can convert between the two: ``` r titanic_long <- to_lodes_form(data.frame(Titanic), key = "Demographic", axes = 1:3) head(titanic_long) #> Survived Freq alluvium Demographic stratum #> 1 No 0 1 Class 1st #> 2 No 0 2 Class 2nd #> 3 No 35 3 Class 3rd #> 4 No 0 4 Class Crew #> 5 No 0 5 Class 1st #> 6 No 0 6 Class 2nd ggplot(data = titanic_long, aes(x = Demographic, stratum = stratum, alluvium = alluvium, y = Freq, label = stratum)) + geom_alluvium(aes(fill = Survived)) + geom_stratum() + geom_text(stat = "stratum") + theme_minimal() + ggtitle("passengers on the maiden voyage of the Titanic", "stratified by demographics and survival") ``` ![](man/figures/README-unnamed-chunk-7-1.png) ### Documentation For detailed discussion of the data formats recognized by **ggalluvial** and several examples that illustrate its flexibility and limitations, read the technical vignette: ``` r vignette(topic = "ggalluvial", package = "ggalluvial") ``` Several additional vignettes offer detailed solutions to specific needs: - “Labeling small strata” (`"labels"`) for how to elegantly label strata of a wide range of heights in an alluvial plot; - “The Order of the Rectangles” (`"order-rectangles"`) for how to control the positioning of strata and lodes in an alluvial plot; and - “Tooltips for ggalluvial plots in Shiny apps” (`"shiny"`) for how to incorporate alluvial plots into interactive apps. The object documentation includes several more examples. Use `help()` to call forth more detail on - any layer (`stat_*` or `geom_*`), - the conversion functions (`to_*_form`), and - the data sets installed with the package (`vaccinations` and `majors`). ### Short form For some more digestible guidance on using **ggalluvial**, check out three cheat sheets and demos by students in Joyce Robbins’s [Exploratory Data Analysis and Visualization Community Contribution Project](https://jtr13.github.io/cc21fall2/index.html): - an [introduction](https://jtr13.github.io/cc21fall2/ggalluvial-cheatsheet.html) by Meggie Wen (Chapter 33) - a [cheat sheet](https://cheatography.com/seleven/cheat-sheets/ggalluvial/) by Qingyi Zhang (Chapter 14) - a [blog about how this package implements alluvial plots](https://medium.com/@arnavsaxena96/all-about-alluvial-diagrams-21da1505520b) by Arnav Saxena (Chapter 134) ## Acknowledgments ### Resources Development of this package benefitted from the use of equipment and the support of colleagues at [UConn Health](https://health.uconn.edu/) and at [UF Health](https://ufhealth.org/). ### Contribute Contributions in any form are more than welcome! Pretty much every fix and feature of this package derives from a problem or question posed by someone with datasets or design goals i hadn’t anticipated. See the [CONTRIBUTING](https://github.com/corybrunson/ggalluvial/blob/main/CONTRIBUTING.md) file for guidance, and please respect the [Code of Conduct](https://github.com/corybrunson/ggalluvial/blob/main/CODE_OF_CONDUCT.md). ### Cite If you use **ggalluvial**-generated figures in publication, i’d be grateful to hear about it! You can also cite the package according to `citation("ggalluvial")`. ggalluvial/data/0000755000176200001440000000000014025146066013316 5ustar liggesusersggalluvial/data/majors.rda0000644000176200001440000000056514025146066015307 0ustar liggesusersUn@2}%tKivN CIB4QcQ3>ps5BXCrtԁ{+ 7R<(;d:?\ 4E`E0RD[C̺}j\_$"]˴Y~ JlXbx>9Da-Nn1BExJ8=nق w i('dDd|kH wY %K3:ft~ i^9\}s5~VW! X~ݱHf4DLGPsK8gIPkOfL;,po*ؚAzs%4OYP ggalluvial/data/vaccinations.rda0000644000176200001440000000106014025146066016464 0ustar liggesusersWN@'$Q myBi*ZؕPJlqرT_ E3VBE^ϝϝ;QxTdeY?Hvgx c[7Ni=0 ymr4;쀗I[}vv󜾶luN+tBsMԐI]-ξ ߮ [V_UFjydT7oT=1r|[J9 N{ns 93wN;L9 N{|.@9sYR=Qӿd䷰|=!]G =T" h܂^3h6,'|$X ggalluvial/man/0000755000176200001440000000000014371217533013162 5ustar liggesusersggalluvial/man/lode-guidance-functions.Rd0000644000176200001440000000410214367761414020163 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lode-guidance-functions.r \name{lode-guidance-functions} \alias{lode-guidance-functions} \alias{lode_zigzag} \alias{lode_zagzig} \alias{lode_forward} \alias{lode_rightward} \alias{lode_backward} \alias{lode_leftward} \alias{lode_frontback} \alias{lode_rightleft} \alias{lode_backfront} \alias{lode_leftright} \title{Lode guidance functions} \usage{ lode_zigzag(n, i) lode_zagzig(n, i) lode_forward(n, i) lode_rightward(n, i) lode_backward(n, i) lode_leftward(n, i) lode_frontback(n, i) lode_rightleft(n, i) lode_backfront(n, i) lode_leftright(n, i) } \arguments{ \item{n}{Numeric, a positive integer} \item{i}{Numeric, a positive integer at most \code{n}} } \description{ These functions control the order of lodes within strata in an alluvial diagram. They are invoked by \code{\link[=stat_alluvium]{stat_alluvium()}} and can be passed to the \code{lode.guidance} parameter. } \details{ Each function orders the numbers 1 through \code{n}, starting at index \code{i}. The choice of function made in \code{\link[=stat_alluvium]{stat_alluvium()}} determines the order in which the other axes contribute to the sorting of lodes within each index axis. After starting at \code{i}, the functions order the remaining axes as follows: \itemize{ \item \code{zigzag}: Zigzag outward from \code{i}, starting in the outward direction \item \code{zigzag}: Zigzag outward from \code{i}, starting in the inward direction \item \code{forward}: Increasing order (alias \code{rightward}) \item \code{backward}: Decreasing order (alias \code{leftward}) \item \code{frontback}: Proceed forward from \code{i} to \code{n}, then backward to 1 (alias \code{rightleft}) \item \code{backfront}: Proceed backward from \code{i} to 1, then forward to \code{n} (alias \code{leftright}) } An extended discussion of how strata and lodes are arranged in alluvial plots, including the effects of different lode guidance functions, can be found in the vignette "The Order of the Rectangles" via \code{vignette("order-rectangles", package = "ggalluvial")}. } ggalluvial/man/majors.Rd0000644000176200001440000000114514025146066014743 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.r \name{majors} \alias{majors} \title{Students' declared majors across several semesters} \format{ A data frame with 80 rows and 3 variables: \describe{ \item{\code{student}}{student identifier} \item{\code{semester}}{character tag for odd-numbered semesters} \item{\code{curriculum}}{declared major program} } } \description{ This data set follows the major curricula of 10 students across 8 academic semesters. Missing values indicate undeclared majors. The data were kindly contributed by Dario Bonaretti. } \keyword{datasets} ggalluvial/man/self-adjoin.Rd0000644000176200001440000000521014025146066015640 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/self-adjoin.r \name{self-adjoin} \alias{self-adjoin} \alias{self_adjoin} \title{Adjoin a dataset to itself} \usage{ self_adjoin( data, key, by = NULL, link = NULL, keep.x = NULL, keep.y = NULL, suffix = c(".x", ".y") ) } \arguments{ \item{data}{A data frame in lodes form (repeated measures data; see \code{\link{alluvial-data}}).} \item{key}{Column of \code{data} indicating sequential collection; handled as in \code{\link[tidyr:spread]{tidyr::spread()}}.} \item{by}{Character vector of variables to self-adjoin by; passed to \code{\link[dplyr:mutate-joins]{dplyr::mutate-joins}} functions.} \item{link}{Character vector of variables to adjoin. Will be replaced by pairs of variables suffixed by \code{suffix}.} \item{keep.x, keep.y}{Character vector of variables to associate with the first (respectively, second) copy of \code{data} after adjoining. These variables can overlap with each other but cannot overlap with \code{by} or \code{link}.} \item{suffix}{Suffixes to add to the adjoined \code{link} variables; passed to \code{\link[dplyr:mutate-joins]{dplyr::mutate-joins}} functions.} } \description{ This function binds a dataset to itself along adjacent pairs of a \code{key} variable. It is invoked by \code{\link[=geom_flow]{geom_flow()}} to convert data in lodes form to something similar to alluvia form. } \details{ \code{self_adjoin} invokes \code{\link[dplyr:mutate-joins]{dplyr::mutate-joins}} functions in order to convert a dataset with measures along a discrete \code{key} variable into a dataset consisting of column bindings of these measures (by any \code{by} variables) along adjacent values of \code{key}. } \examples{ # self-adjoin `majors` data data(majors) major_changes <- self_adjoin(majors, key = semester, by = "student", link = c("semester", "curriculum")) major_changes$change <- major_changes$curriculum.x == major_changes$curriculum.y head(major_changes) # self-adjoin `vaccinations` data data(vaccinations) vaccination_steps <- self_adjoin(vaccinations, key = survey, by = "subject", link = c("survey", "response"), keep.x = c("freq")) head(vaccination_steps) vaccination_steps <- self_adjoin(vaccinations, key = survey, by = "subject", link = c("survey", "response"), keep.x = c("freq"), keep.y = c("start_date", "end_date")) head(vaccination_steps) } \seealso{ Other alluvial data manipulation: \code{\link{alluvial-data}} } \concept{alluvial data manipulation} ggalluvial/man/geom_alluvium.Rd0000644000176200001440000002513014367761414016326 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-alluvium.r \name{geom_alluvium} \alias{geom_alluvium} \alias{data_to_alluvium} \title{Alluvia across strata} \usage{ geom_alluvium( mapping = NULL, data = NULL, stat = "alluvium", position = "identity", width = 1/3, knot.pos = 1/4, knot.prop = TRUE, curve_type = NULL, curve_range = NULL, segments = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) data_to_alluvium( data, knot.prop = TRUE, curve_type = "spline", curve_range = NULL, segments = NULL ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data; override the default.} \item{position}{Position adjustment, either as a string naming the adjustment (e.g. \code{"jitter"} to use \code{position_jitter}), or the result of a call to a position adjustment function. Use the latter if you need to change the settings of the adjustment.} \item{width}{Numeric; the width of each stratum, as a proportion of the distance between axes. Defaults to 1/3.} \item{knot.pos}{The horizontal distance of x-spline knots from each stratum (\code{width/2} from its axis), either (if \code{knot.prop = TRUE}, the default) as a proportion of the length of the x-spline, i.e. of the gap between adjacent strata, or (if \code{knot.prop = FALSE}) on the scale of the \code{x} direction.} \item{knot.prop}{Logical; whether to interpret \code{knot.pos} as a proportion of the length of each flow (the default), rather than on the \code{x} scale.} \item{curve_type}{Character; the type of curve used to produce flows. Defaults to \code{"xspline"} and can be alternatively set to one of \code{"linear"}, \code{"cubic"}, \code{"quintic"}, \code{"sine"}, \code{"arctangent"}, and \code{"sigmoid"}. \code{"xspline"} produces approximation splines using 4 points per curve; the alternatives produce interpolation splines between points along the graphs of functions of the associated type. See the \strong{Curves} section.} \item{curve_range}{For alternative \code{curve_type}s based on asymptotic functions, the value along the asymptote at which to truncate the function to obtain the shape that will be scaled to fit between strata. See the \strong{Curves} section.} \item{segments}{The number of segments to be used in drawing each alternative curve (each curved boundary of each flow). If less than 3, will be silently changed to 3.} \item{na.rm}{Logical: if \code{FALSE}, the default, \code{NA} lodes are not included; if \code{TRUE}, \code{NA} lodes constitute a separate category, plotted in grey (regardless of the color scheme).} \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to display.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} \item{...}{Additional arguments passed to \code{\link[ggplot2:layer]{ggplot2::layer()}}.} } \description{ \code{geom_alluvium} receives a dataset of the horizontal (\code{x}) and vertical (\code{y}, \code{ymin}, \code{ymax}) positions of the \strong{lodes} of an alluvial plot, the intersections of the alluvia with the strata. It plots both the lodes themselves, using \code{\link[=geom_lode]{geom_lode()}}, and the flows between them, using \code{\link[=geom_flow]{geom_flow()}}. } \details{ The helper function \code{data_to_alluvium()} takes internal \strong{ggplot2} data (mapped aesthetics) and curve parameters for a single alluvium as input and returns a data frame of \code{x}, \code{y}, and \code{shape} used by \code{\link[grid:grid.xspline]{grid::xsplineGrob()}} to render the alluvium. } \section{Aesthetics}{ \code{geom_alluvium}, \code{geom_flow}, \code{geom_lode}, and \code{geom_stratum} understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{\code{x}} \item \strong{\code{y}} \item \strong{\code{ymin}} \item \strong{\code{ymax}} \item \code{alpha} \item \code{colour} \item \code{fill} \item \code{linetype} \item \code{size} \item \code{group} } \code{group} is used internally; arguments are ignored. } \section{Curves}{ By default, \code{geom_alluvium()} and \code{geom_flow()} render flows between lodes as filled regions between parallel x-splines. These graphical elements, generated using \code{\link[grid:grid.xspline]{grid::xsplineGrob()}}, are parameterized by the relative location of the knot (\code{knot.pos}). They are quick to render and clear to read, but users may prefer plots that use differently-shaped ribbons. A variety of such options are documented at, e.g., \href{https://easings.net/}{this easing functions cheat sheet} and \href{https://www.dataplusscience.com/Sigmoid.html}{this blog post by Jeffrey Shaffer}. Easing functions are not (yet) used in ggalluvial, but several alternative curves are available. Each is encoded as a continuous, increasing, bijective function from the unit interval \eqn{[0,1]} to itself, and each is rescaled so that its endpoints meet the corresponding lodes. They are rendered piecewise-linearly, by default using \code{segments = 48}. Summon each curve type by passing one of the following strings to \code{curve_type}: \itemize{ \item \code{"linear"}: \eqn{f(x)=x}, the unique degree-1 polynomial that takes 0 to 0 and 1 to 1 \item \code{"cubic"}: \eqn{f(x)=3x^{2}-2x^{3}}{f(x)=3x^2-2x^3}, the unique degree-3 polynomial that also is flat at both endpoints \item \code{"quintic"}: \eqn{f(x)=10x^{3}-15x^{4}+6x^{5}}{f(x)=10x^3-15x^4+6x^5}, the unique degree-5 polynomial that also has zero curvature at both endpoints \item \code{"sine"}: the unique sinusoidal function that is flat at both endpoints \item \code{"arctangent"}: the inverse tangent function, scaled and re-centered to the unit interval from the interval centered at zero with radius \code{curve_range} \item \code{"sigmoid"}: the sigmoid function, scaled and re-centered to the unit interval from the interval centered at zero with radius \code{curve_range} } Only the (default) \code{"xspline"} option uses the \verb{knot.*} parameters, while only the alternative curves use the \code{segments} parameter, and only \code{"arctangent"} and \code{"sigmoid"} use the \code{curve_range} parameter. (Both are ignored if not needed.) Larger values of \code{curve_range} result in greater compression and steeper slopes. The \code{NULL} default will be changed to \code{2+sqrt(3)} for \code{"arctangent"} and to \code{6} for \code{"sigmoid"}. These package-specific options set global values for \code{curve_type}, \code{curve_range}, and \code{segments} that will be defaulted to when not manually set: \itemize{ \item \code{ggalluvial.curve_type}: defaults to \code{"xspline"}. \item \code{ggalluvial.curve_range}: defaults to \code{NA}, which triggers the curve-specific default values. \item \code{ggalluvial.segments}: defaults to \code{48L}. } See \code{\link[base:options]{base::options()}} for how to use options. } \section{Defunct parameters}{ The previously defunct parameters \code{axis_width} and \code{ribbon_bend} have been discontinued. Use \code{width} and \code{knot.pos} instead. } \examples{ # basic ggplot(as.data.frame(Titanic), aes(y = Freq, axis1 = Class, axis2 = Sex, axis3 = Age, fill = Survived)) + geom_alluvium() + scale_x_discrete(limits = c("Class", "Sex", "Age")) gg <- ggplot(alluvial::Refugees, aes(y = refugees, x = year, alluvium = country)) # time series bump chart (quintic flows) gg + geom_alluvium(aes(fill = country, colour = country), width = 1/4, alpha = 2/3, decreasing = FALSE, curve_type = "sigmoid") # time series line plot of refugees data, sorted by country gg + geom_alluvium(aes(fill = country, colour = country), decreasing = NA, width = 0, knot.pos = 0) \donttest{ # irregular spacing between axes of a continuous variable refugees_sub <- subset(alluvial::Refugees, year \%in\% c(2003, 2005, 2010, 2013)) gg <- ggplot(data = refugees_sub, aes(x = year, y = refugees, alluvium = country)) + theme_bw() + scale_fill_brewer(type = "qual", palette = "Set3") # proportional knot positioning (default) gg + geom_alluvium(aes(fill = country), alpha = .75, decreasing = FALSE, width = 1/2) + geom_stratum(aes(stratum = country), decreasing = FALSE, width = 1/2) # constant knot positioning gg + geom_alluvium(aes(fill = country), alpha = .75, decreasing = FALSE, width = 1/2, knot.pos = 1, knot.prop = FALSE) + geom_stratum(aes(stratum = country), decreasing = FALSE, width = 1/2) # coarsely-segmented curves gg + geom_alluvium(aes(fill = country), alpha = .75, decreasing = FALSE, width = 1/2, curve_type = "arctan", segments = 6) + geom_stratum(aes(stratum = country), decreasing = FALSE, width = 1/2) # custom-ranged curves gg + geom_alluvium(aes(fill = country), alpha = .75, decreasing = FALSE, width = 1/2, curve_type = "arctan", curve_range = 1) + geom_stratum(aes(stratum = country), decreasing = FALSE, width = 1/2) } } \seealso{ \code{\link[ggplot2:layer]{ggplot2::layer()}} for additional arguments and \code{\link[=stat_alluvium]{stat_alluvium()}} and \code{\link[=stat_flow]{stat_flow()}} for the corresponding stats. Other alluvial geom layers: \code{\link{geom_flow}()}, \code{\link{geom_lode}()}, \code{\link{geom_stratum}()} } \concept{alluvial geom layers} ggalluvial/man/stat_alluvium.Rd0000644000176200001440000003721014371217533016345 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stat-alluvium.r \name{stat_alluvium} \alias{stat_alluvium} \title{Alluvial positions} \usage{ stat_alluvium( mapping = NULL, data = NULL, geom = "alluvium", position = "identity", decreasing = NULL, reverse = NULL, absolute = NULL, discern = FALSE, negate.strata = NULL, aggregate.y = NULL, cement.alluvia = NULL, lode.guidance = NULL, lode.ordering = NULL, aes.bind = NULL, infer.label = FALSE, min.y = NULL, max.y = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{The geometric object to use display the data; override the default.} \item{position}{Position adjustment, either as a string naming the adjustment (e.g. \code{"jitter"} to use \code{position_jitter}), or the result of a call to a position adjustment function. Use the latter if you need to change the settings of the adjustment.} \item{decreasing}{Logical; whether to arrange the strata at each axis in the order of the variable values (\code{NA}, the default), in ascending order of totals (largest on top, \code{FALSE}), or in descending order of totals (largest on bottom, \code{TRUE}).} \item{reverse}{Logical; if \code{decreasing} is \code{NA}, whether to arrange the strata at each axis in the reverse order of the variable values, so that they match the order of the values in the legend. Ignored if \code{decreasing} is not \code{NA}. Defaults to \code{TRUE}.} \item{absolute}{Logical; if some cases or strata are negative, whether to arrange them (respecting \code{decreasing} and \code{reverse}) using negative or absolute values of \code{y}.} \item{discern}{Passed to \code{\link[=to_lodes_form]{to_lodes_form()}} if \code{data} is in alluvia format.} \item{negate.strata}{A vector of values of the \code{stratum} aesthetic to be treated as negative (will ignore missing values with a warning).} \item{aggregate.y}{Deprecated alias for \code{cement.alluvia}.} \item{cement.alluvia}{Logical value indicating whether to aggregate \code{y} values over equivalent alluvia before computing lode and flow positions.} \item{lode.guidance}{The function to prioritize the axis variables for ordering the lodes within each stratum, or else a character string identifying the function. Character options are "zigzag", "frontback", "backfront", "forward", and "backward" (see \code{\link{lode-guidance-functions}}).} \item{lode.ordering}{\strong{Deprecated in favor of the \code{order} aesthetic.} A list (of length the number of axes) of integer vectors (each of length the number of rows of \code{data}) or NULL entries (indicating no imposed ordering), or else a numeric matrix of corresponding dimensions, giving the preferred ordering of alluvia at each axis. This will be used to order the lodes within each stratum by sorting the lodes first by stratum, then by the provided vectors, and lastly by remaining factors (if the vectors contain duplicate entries and therefore do not completely determine the lode orderings).} \item{aes.bind}{At what grouping level, if any, to prioritize differentiation aesthetics when ordering the lodes within each stratum. Defaults to \code{"none"} (no aesthetic binding) with intermediate option \code{"flows"} to bind aesthetics after stratifying by axes linked to the index axis (the one adjacent axis in \code{stat_flow()}; all remaining axes in \code{stat_alluvium()}) and strongest option \code{"alluvia"} to bind aesthetics after stratifying by the index axis but before stratifying by linked axes (only available for \code{stat_alluvium()}). Stratification by any axis is done with respect to the strata at that axis, after separating positive and negative strata, consistent with the values of \code{decreasing}, \code{reverse}, and \code{absolute}. Thus, if \code{"none"}, then lode orderings will not depend on aesthetic variables. All aesthetic variables are used, in the order in which they are specified in \code{aes()}.} \item{infer.label}{Logical; whether to assign the \code{stratum} or \code{alluvium} variable to the \code{label} aesthetic. Defaults to \code{FALSE}, and requires that no \code{label} aesthetic is assigned. This parameter is intended for use only with data in alluva form, which are converted to lode form before the statistical transformation. Deprecated; use \code{\link[ggplot2:aes_eval]{ggplot2::after_stat()}} instead.} \item{min.y, max.y}{Numeric; bounds on the heights of the strata to be rendered. Use these bounds to exclude strata outside a certain range, for example when labeling strata using \code{\link[ggplot2:geom_text]{ggplot2::geom_text()}}.} \item{na.rm}{Logical: if \code{FALSE}, the default, \code{NA} lodes are not included; if \code{TRUE}, \code{NA} lodes constitute a separate category, plotted in grey (regardless of the color scheme).} \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to display.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} \item{...}{Additional arguments passed to \code{\link[ggplot2:layer]{ggplot2::layer()}}.} } \description{ Given a dataset with alluvial structure, \code{stat_alluvium} calculates the centroids (\code{x} and \code{y}) and heights (\code{ymin} and \code{ymax}) of the lodes, the intersections of the alluvia with the strata. It leverages the \code{group} aesthetic for plotting purposes (for now). } \section{Aesthetics}{ \code{stat_alluvium}, \code{stat_flow}, and \code{stat_stratum} require one of two sets of aesthetics: \itemize{ \item \strong{\code{x}} and at least one of \strong{\code{alluvium}} and \strong{\code{stratum}} \item any number of \strong{\verb{axis[0-9]*}} (\code{axis1}, \code{axis2}, etc.) } Use \code{x}, \code{alluvium}, and/or \code{stratum} for data in lodes format and \verb{axis[0-9]*} for data in alluvia format (see \code{\link{alluvial-data}}). Arguments to parameters inconsistent with the format will be ignored. Additionally, each \verb{stat_*()} accepts the following optional aesthetics: \itemize{ \item \code{y} \item \code{weight} \item \code{order} \item \code{group} \item \code{label} } \code{y} controls the heights of the alluvia, and may be aggregated across equivalent observations. \code{weight} applies to the computed variables (see that section below) but does not affect the positional aesthetics. \code{order}, recognized by \code{stat_alluvium()} and \code{stat_flow()}, is used to arrange the lodes within each stratum. It tolerates duplicates and takes precedence over the differentiation aesthetics (when \code{aes.bind} is not \code{"none"}) and lode guidance with respect to the remaining axes. (It replaces the deprecated parameter \code{lode.ordering}.) \code{group} is used internally; arguments are ignored. \code{label} is used to label the strata or lodes and must take a unique value across the observations within each stratum or lode. These and any other aesthetics are aggregated as follows: Numeric aesthetics, including \code{y}, are summed. Character and factor aesthetics, including \code{label}, are assigned to strata or lodes provided they take unique values across the observations within each (and are otherwise assigned \code{NA}). } \section{Computed variables}{ These can be used with \code{\link[ggplot2:aes_eval]{ggplot2::after_stat()}} to \href{https://ggplot2.tidyverse.org/reference/aes_eval.html}{control aesthetic evaluation}. \describe{ \item{\code{n}}{number of cases in lode} \item{\code{count}}{cumulative weight of lode} \item{\code{prop}}{weighted proportion of lode} \item{\code{stratum}}{value of variable used to define strata} \item{\code{deposit}}{order in which (signed) strata are deposited} \item{\code{lode}}{lode label distilled from alluvia (\code{stat_alluvium()} and \code{stat_flow()} only)} \item{\code{flow}}{direction of flow \code{"to"} or \code{"from"} from its axis (\code{stat_flow()} only)} } The numerical variables \code{n}, \code{count}, and \code{prop} are calculated after the data are grouped by \code{x} and weighted by \code{weight} (in addition to \code{y}). The integer variable \code{deposit} is used internally to sort the data before calculating heights. The character variable \code{lode} is obtained from \code{alluvium} according to \code{distill}. } \section{Package options}{ \code{stat_stratum}, \code{stat_alluvium}, and \code{stat_flow} order strata and lodes according to the values of several parameters, which must be held fixed across every layer in an alluvial plot. These package-specific options set global values for these parameters that will be defaulted to when not manually set: \itemize{ \item \code{ggalluvial.decreasing} (each \verb{stat_*}): defaults to \code{NA}. \item \code{ggalluvial.reverse} (each \verb{stat_*}): defaults to \code{TRUE}. \item \code{ggalluvial.absolute} (each \verb{stat_*}): defaults to \code{TRUE}. \item \code{ggalluvial.cement.alluvia} (\code{stat_alluvium}): defaults to \code{FALSE}. \item \code{ggalluvial.lode.guidance} (\code{stat_alluvium}): defaults to \code{"zigzag"}. \item \code{ggalluvial.aes.bind} (\code{stat_alluvium} and \code{stat_flow}): defaults to \code{"none"}. } See \code{\link[base:options]{base::options()}} for how to use options. } \section{Defunct parameters}{ The previously defunct parameters \code{weight} and \code{aggregate.wts} have been discontinued. Use \code{y} and \code{cement.alluvia} instead. } \examples{ # illustrate positioning ggplot(as.data.frame(Titanic), aes(y = Freq, axis1 = Class, axis2 = Sex, axis3 = Age, color = Survived)) + stat_stratum(geom = "errorbar") + geom_line(stat = "alluvium") + stat_alluvium(geom = "pointrange") + geom_text(stat = "stratum", aes(label = after_stat(stratum))) + scale_x_discrete(limits = c("Class", "Sex", "Age")) # lode ordering examples gg <- ggplot(as.data.frame(Titanic), aes(y = Freq, axis1 = Class, axis2 = Sex, axis3 = Age)) + geom_stratum() + geom_text(stat = "stratum", aes(label = after_stat(stratum))) + scale_x_discrete(limits = c("Class", "Sex", "Age")) # use of lode controls gg + geom_flow(aes(fill = Survived, alpha = Sex), stat = "alluvium", lode.guidance = "forward") # prioritize aesthetic binding gg + geom_flow(aes(fill = Survived, alpha = Sex), stat = "alluvium", aes.bind = "alluvia", lode.guidance = "forward") # use of custom lode order gg + geom_flow(aes(fill = Survived, alpha = Sex, order = sample(x = 32)), stat = "alluvium") # use of custom luide guidance function lode_custom <- function(n, i) { stopifnot(n == 3) switch( i, `1` = 1:3, `2` = c(2, 3, 1), `3` = 3:1 ) } gg + geom_flow(aes(fill = Survived, alpha = Sex), stat = "alluvium", aes.bind = "flow", lode.guidance = lode_custom) # omit missing elements & reverse the `y` axis ggplot(ggalluvial::majors, aes(x = semester, stratum = curriculum, alluvium = student, y = 1)) + geom_alluvium(fill = "darkgrey", na.rm = TRUE) + geom_stratum(aes(fill = curriculum), color = NA, na.rm = TRUE) + theme_bw() + scale_y_reverse() \donttest{ # alluvium cementation examples gg <- ggplot(ggalluvial::majors, aes(x = semester, stratum = curriculum, alluvium = student, fill = curriculum)) + geom_stratum() # diagram with outlined alluvia and labels gg + geom_flow(stat = "alluvium", color = "black") + geom_text(aes(label = after_stat(lode)), stat = "alluvium") # cemented diagram with default distillation (first most common alluvium) gg + geom_flow(stat = "alluvium", color = "black", cement.alluvia = TRUE) + geom_text(aes(label = after_stat(lode)), stat = "alluvium", cement.alluvia = TRUE) # cemented diagram with custom label distillation gg + geom_flow(stat = "alluvium", color = "black", cement.alluvia = TRUE) + geom_text(aes(label = after_stat(lode)), stat = "alluvium", cement.alluvia = TRUE, distill = function(x) paste(x, collapse = "; ")) } \donttest{ data(babynames, package = "babynames") # a discontiguous alluvium bn <- subset(babynames, prop >= .01 & sex == "F" & year > 1962 & year < 1968) ggplot(data = bn, aes(x = year, alluvium = name, y = prop)) + geom_alluvium(aes(fill = name, color = name == "Tammy"), decreasing = TRUE, show.legend = FALSE) + scale_color_manual(values = c("#00000000", "#000000")) # expanded to include missing values bn2 <- merge(bn, expand.grid(year = unique(bn$year), name = unique(bn$name)), all = TRUE) ggplot(data = bn2, aes(x = year, alluvium = name, y = prop)) + geom_alluvium(aes(fill = name, color = name == "Tammy"), decreasing = TRUE, show.legend = FALSE) + scale_color_manual(values = c("#00000000", "#000000")) # with missing values filled in with zeros bn2$prop[is.na(bn2$prop)] <- 0 ggplot(data = bn2, aes(x = year, alluvium = name, y = prop)) + geom_alluvium(aes(fill = name, color = name == "Tammy"), decreasing = TRUE, show.legend = FALSE) + scale_color_manual(values = c("#00000000", "#000000")) } # use negative y values to encode deaths versus survivals titanic <- as.data.frame(Titanic) titanic <- transform(titanic, Lives = Freq * (-1) ^ (Survived == "No")) ggplot(subset(titanic, Class != "Crew"), aes(axis1 = Class, axis2 = Sex, axis3 = Age, y = Lives)) + geom_alluvium(aes(alpha = Survived, fill = Class), absolute = FALSE) + geom_stratum(absolute = FALSE) + geom_text(stat = "stratum", aes(label = after_stat(stratum)), absolute = FALSE) + scale_x_discrete(limits = c("Class", "Sex", "Age"), expand = c(.1, .05)) + scale_alpha_discrete(range = c(.25, .75), guide = "none") # faceting with common alluvia ggplot(titanic, aes(y = Freq, axis1 = Class, axis2 = Sex, axis3 = Age)) + facet_wrap(~ Survived) + geom_alluvium() + geom_stratum() + geom_text(stat = "stratum", aes(label = after_stat(stratum))) ggplot(transform(alluvial::Refugees, id = 1), aes(y = refugees, x = year, alluvium = id)) + facet_wrap(~ country) + geom_alluvium(alpha = .75, color = "darkgrey") + scale_x_continuous(breaks = seq(2004, 2012, 4)) } \seealso{ \code{\link[ggplot2:layer]{ggplot2::layer()}} for additional arguments and \code{\link[=geom_alluvium]{geom_alluvium()}}, \code{\link[=geom_lode]{geom_lode()}}, and \code{\link[=geom_flow]{geom_flow()}} for the corresponding geoms. Other alluvial stat layers: \code{\link{stat_flow}()}, \code{\link{stat_stratum}()} } \concept{alluvial stat layers} ggalluvial/man/stat_flow.Rd0000644000176200001440000003002114371217533015447 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stat-flow.r \name{stat_flow} \alias{stat_flow} \title{Flow positions} \usage{ stat_flow( mapping = NULL, data = NULL, geom = "flow", position = "identity", decreasing = NULL, reverse = NULL, absolute = NULL, discern = FALSE, negate.strata = NULL, aes.bind = NULL, infer.label = FALSE, min.y = NULL, max.y = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{The geometric object to use display the data; override the default.} \item{position}{Position adjustment, either as a string naming the adjustment (e.g. \code{"jitter"} to use \code{position_jitter}), or the result of a call to a position adjustment function. Use the latter if you need to change the settings of the adjustment.} \item{decreasing}{Logical; whether to arrange the strata at each axis in the order of the variable values (\code{NA}, the default), in ascending order of totals (largest on top, \code{FALSE}), or in descending order of totals (largest on bottom, \code{TRUE}).} \item{reverse}{Logical; if \code{decreasing} is \code{NA}, whether to arrange the strata at each axis in the reverse order of the variable values, so that they match the order of the values in the legend. Ignored if \code{decreasing} is not \code{NA}. Defaults to \code{TRUE}.} \item{absolute}{Logical; if some cases or strata are negative, whether to arrange them (respecting \code{decreasing} and \code{reverse}) using negative or absolute values of \code{y}.} \item{discern}{Passed to \code{\link[=to_lodes_form]{to_lodes_form()}} if \code{data} is in alluvia format.} \item{negate.strata}{A vector of values of the \code{stratum} aesthetic to be treated as negative (will ignore missing values with a warning).} \item{aes.bind}{At what grouping level, if any, to prioritize differentiation aesthetics when ordering the lodes within each stratum. Defaults to \code{"none"} (no aesthetic binding) with intermediate option \code{"flows"} to bind aesthetics after stratifying by axes linked to the index axis (the one adjacent axis in \code{stat_flow()}; all remaining axes in \code{stat_alluvium()}) and strongest option \code{"alluvia"} to bind aesthetics after stratifying by the index axis but before stratifying by linked axes (only available for \code{stat_alluvium()}). Stratification by any axis is done with respect to the strata at that axis, after separating positive and negative strata, consistent with the values of \code{decreasing}, \code{reverse}, and \code{absolute}. Thus, if \code{"none"}, then lode orderings will not depend on aesthetic variables. All aesthetic variables are used, in the order in which they are specified in \code{aes()}.} \item{infer.label}{Logical; whether to assign the \code{stratum} or \code{alluvium} variable to the \code{label} aesthetic. Defaults to \code{FALSE}, and requires that no \code{label} aesthetic is assigned. This parameter is intended for use only with data in alluva form, which are converted to lode form before the statistical transformation. Deprecated; use \code{\link[ggplot2:aes_eval]{ggplot2::after_stat()}} instead.} \item{min.y, max.y}{Numeric; bounds on the heights of the strata to be rendered. Use these bounds to exclude strata outside a certain range, for example when labeling strata using \code{\link[ggplot2:geom_text]{ggplot2::geom_text()}}.} \item{na.rm}{Logical: if \code{FALSE}, the default, \code{NA} lodes are not included; if \code{TRUE}, \code{NA} lodes constitute a separate category, plotted in grey (regardless of the color scheme).} \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to display.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} \item{...}{Additional arguments passed to \code{\link[ggplot2:layer]{ggplot2::layer()}}.} } \description{ Given a dataset with alluvial structure, \code{stat_flow} calculates the centroids (\code{x} and \code{y}) and heights (\code{ymin} and \code{ymax}) of the flows between each pair of adjacent axes. } \section{Aesthetics}{ \code{stat_alluvium}, \code{stat_flow}, and \code{stat_stratum} require one of two sets of aesthetics: \itemize{ \item \strong{\code{x}} and at least one of \strong{\code{alluvium}} and \strong{\code{stratum}} \item any number of \strong{\verb{axis[0-9]*}} (\code{axis1}, \code{axis2}, etc.) } Use \code{x}, \code{alluvium}, and/or \code{stratum} for data in lodes format and \verb{axis[0-9]*} for data in alluvia format (see \code{\link{alluvial-data}}). Arguments to parameters inconsistent with the format will be ignored. Additionally, each \verb{stat_*()} accepts the following optional aesthetics: \itemize{ \item \code{y} \item \code{weight} \item \code{order} \item \code{group} \item \code{label} } \code{y} controls the heights of the alluvia, and may be aggregated across equivalent observations. \code{weight} applies to the computed variables (see that section below) but does not affect the positional aesthetics. \code{order}, recognized by \code{stat_alluvium()} and \code{stat_flow()}, is used to arrange the lodes within each stratum. It tolerates duplicates and takes precedence over the differentiation aesthetics (when \code{aes.bind} is not \code{"none"}) and lode guidance with respect to the remaining axes. (It replaces the deprecated parameter \code{lode.ordering}.) \code{group} is used internally; arguments are ignored. \code{label} is used to label the strata or lodes and must take a unique value across the observations within each stratum or lode. These and any other aesthetics are aggregated as follows: Numeric aesthetics, including \code{y}, are summed. Character and factor aesthetics, including \code{label}, are assigned to strata or lodes provided they take unique values across the observations within each (and are otherwise assigned \code{NA}). } \section{Computed variables}{ These can be used with \code{\link[ggplot2:aes_eval]{ggplot2::after_stat()}} to \href{https://ggplot2.tidyverse.org/reference/aes_eval.html}{control aesthetic evaluation}. \describe{ \item{\code{n}}{number of cases in lode} \item{\code{count}}{cumulative weight of lode} \item{\code{prop}}{weighted proportion of lode} \item{\code{stratum}}{value of variable used to define strata} \item{\code{deposit}}{order in which (signed) strata are deposited} \item{\code{lode}}{lode label distilled from alluvia (\code{stat_alluvium()} and \code{stat_flow()} only)} \item{\code{flow}}{direction of flow \code{"to"} or \code{"from"} from its axis (\code{stat_flow()} only)} } The numerical variables \code{n}, \code{count}, and \code{prop} are calculated after the data are grouped by \code{x} and weighted by \code{weight} (in addition to \code{y}). The integer variable \code{deposit} is used internally to sort the data before calculating heights. The character variable \code{lode} is obtained from \code{alluvium} according to \code{distill}. } \section{Package options}{ \code{stat_stratum}, \code{stat_alluvium}, and \code{stat_flow} order strata and lodes according to the values of several parameters, which must be held fixed across every layer in an alluvial plot. These package-specific options set global values for these parameters that will be defaulted to when not manually set: \itemize{ \item \code{ggalluvial.decreasing} (each \verb{stat_*}): defaults to \code{NA}. \item \code{ggalluvial.reverse} (each \verb{stat_*}): defaults to \code{TRUE}. \item \code{ggalluvial.absolute} (each \verb{stat_*}): defaults to \code{TRUE}. \item \code{ggalluvial.cement.alluvia} (\code{stat_alluvium}): defaults to \code{FALSE}. \item \code{ggalluvial.lode.guidance} (\code{stat_alluvium}): defaults to \code{"zigzag"}. \item \code{ggalluvial.aes.bind} (\code{stat_alluvium} and \code{stat_flow}): defaults to \code{"none"}. } See \code{\link[base:options]{base::options()}} for how to use options. } \section{Defunct parameters}{ The previously defunct parameters \code{weight} and \code{aggregate.wts} have been discontinued. Use \code{y} and \code{cement.alluvia} instead. } \examples{ # illustrate positioning ggplot(as.data.frame(Titanic), aes(y = Freq, axis1 = Class, axis2 = Sex, axis3 = Age, color = Survived)) + stat_stratum(geom = "errorbar") + geom_line(stat = "flow") + stat_flow(geom = "pointrange") + geom_text(stat = "stratum", aes(label = after_stat(stratum))) + scale_x_discrete(limits = c("Class", "Sex", "Age")) # alluvium--flow comparison data(vaccinations) gg <- ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_stratum(alpha = .5) + geom_text(aes(label = response), stat = "stratum") # rightward alluvial aesthetics for vaccine survey data gg + geom_flow(stat = "alluvium", lode.guidance = "forward") # memoryless flows for vaccine survey data gg + geom_flow() # size filter examples gg <- ggplot(vaccinations, aes(y = freq, x = survey, stratum = response, alluvium = subject, fill = response, label = response)) + stat_stratum(alpha = .5) + geom_text(stat = "stratum") # omit small flows gg + geom_flow(min.y = 50) # omit large flows gg + geom_flow(max.y = 100) # negate missing entries ggplot(vaccinations, aes(y = freq, x = survey, stratum = response, alluvium = subject, fill = response, label = response, alpha = response != "Missing")) + stat_stratum(negate.strata = "Missing") + geom_flow(negate.strata = "Missing") + geom_text(stat = "stratum", alpha = 1, negate.strata = "Missing") + scale_alpha_discrete(range = c(.2, .6)) + guides(alpha = "none") \donttest{ # aesthetics that vary betwween and within strata data(vaccinations) vaccinations$subgroup <- LETTERS[1:2][rbinom( n = length(unique(vaccinations$subject)), size = 1, prob = .5 ) + 1][vaccinations$subject] ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response, label = response)) + geom_flow(aes(alpha = subgroup)) + scale_alpha_discrete(range = c(1/3, 2/3)) + geom_stratum(alpha = .5) + geom_text(stat = "stratum") # can even set aesthetics that vary both ways ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, label = response)) + geom_flow(aes(fill = interaction(response, subgroup)), aes.bind = "flows") + scale_alpha_discrete(range = c(1/3, 2/3)) + geom_stratum(alpha = .5) + geom_text(stat = "stratum") } } \seealso{ \code{\link[ggplot2:layer]{ggplot2::layer()}} for additional arguments and \code{\link[=geom_alluvium]{geom_alluvium()}} and \code{\link[=geom_flow]{geom_flow()}} for the corresponding geoms. Other alluvial stat layers: \code{\link{stat_alluvium}()}, \code{\link{stat_stratum}()} } \concept{alluvial stat layers} ggalluvial/man/alluvial-data.Rd0000644000176200001440000002010214367761414016173 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/alluvial-data.r \name{alluvial-data} \alias{alluvial-data} \alias{is_lodes_form} \alias{is_alluvia_form} \alias{to_lodes_form} \alias{to_alluvia_form} \title{Check for alluvial structure and convert between alluvial formats} \usage{ is_lodes_form( data, key, value, id, weight = NULL, site = NULL, logical = TRUE, silent = FALSE ) is_alluvia_form( data, ..., axes = NULL, weight = NULL, logical = TRUE, silent = FALSE ) to_lodes_form( data, ..., axes = NULL, key = "x", value = "stratum", id = "alluvium", diffuse = FALSE, discern = FALSE ) to_alluvia_form(data, key, value, id, distill = FALSE) } \arguments{ \item{data}{A data frame.} \item{key, value, id}{In \code{to_lodes_form}, handled as in \code{\link[tidyr:gather]{tidyr::gather()}} and used to name the new axis (key), stratum (value), and alluvium (identifying) variables. In \code{to_alluvia_form}, handled as in \code{\link[tidyr:spread]{tidyr::spread()}} and used to identify the fields of \code{data} to be used as the axis (key), stratum (value), and alluvium (identifying) variables.} \item{weight}{Optional field of \code{data}, handled using \code{\link[rlang:topic-defuse]{rlang::enquo()}}, to be used as heights or depths of the alluvia or lodes.} \item{site}{Optional vector of fields of \code{data}, handled using \code{\link[rlang:topic-defuse]{rlang::enquos()}}, to be used to group rows before testing for duplicate and missing id-axis pairings. Variables intended for faceting should be passed to \code{site}.} \item{logical}{Defunct. Whether to return a logical value or a character string indicating the type of alluvial structure ("none", "lodes", or "alluvia").} \item{silent}{Whether to print messages.} \item{...}{Used in \code{is_alluvia_form} and \code{to_lodes_form} as in \code{\link[dplyr:select]{dplyr::select()}} to determine axis variables, as an alternative to \code{axes}. Ignored when \code{axes} is provided.} \item{axes}{In \verb{*_alluvia_form}, handled as in \code{\link[dplyr:select]{dplyr::select()}} and used to identify the field(s) of \code{data} to be used as axes.} \item{diffuse}{Fields of \code{data}, handled using \code{\link[tidyselect:vars_select]{tidyselect::vars_select()}}, to merge into the reshapen data by \code{id}. They must be a subset of the axis variables. Alternatively, a logical value indicating whether to merge all (\code{TRUE}) or none (\code{FALSE}) of the axis variables.} \item{discern}{Logical value indicating whether to suffix values of the variables used as axes that appear at more than one variable in order to distinguish their factor levels. This forces the levels of the combined factor variable \code{value} to be in the order of the axes.} \item{distill}{A logical value indicating whether to include variables, other than those passed to \code{key} and \code{value}, that vary within values of \code{id}. Alternatively, a function (or its name) to be used to distill each such variable to a single value. In addition to existing functions, \code{distill} accepts the character values \code{"first"} (used if \code{distill} is \code{TRUE}), \code{"last"}, and \code{"most"} (which returns the first modal value).} } \description{ Alluvial plots consist of multiple horizontally-distributed columns (axes) representing factor variables, vertical divisions (strata) of these axes representing these variables' values; and splines (alluvial flows) connecting vertical subdivisions (lodes) within strata of adjacent axes representing subsets or amounts of observations that take the corresponding values of the corresponding variables. This function checks a data frame for either of two types of alluvial structure: } \details{ \itemize{ \item One row per \strong{lode}, wherein each row encodes a subset or amount of observations having a specific profile of axis values, a \code{key} field encodes the axis, a \code{value} field encodes the value within each axis, and a \code{id} column identifies multiple lodes corresponding to the same subset or amount of observations. \code{is_lodes_form} tests for this structure. \item One row per \strong{alluvium}, wherein each row encodes a subset or amount of observations having a specific profile of axis values and a set \code{axes} of fields encodes its values at each axis variable. \code{is_alluvia_form} tests for this structure. } \code{to_lodes_form} takes a data frame with several designated variables to be used as axes in an alluvial plot, and reshapes the data frame so that the axis variable names constitute a new factor variable and their values comprise another. Other variables' values will be repeated, and a row-grouping variable can be introduced. This function invokes \code{\link[tidyr:gather]{tidyr::gather()}}. \code{to_alluvia_form} takes a data frame with axis and axis value variables to be used in an alluvial plot, and reshape the data frame so that the axes constitute separate variables whose values are given by the value variable. This function invokes \code{\link[tidyr:spread]{tidyr::spread()}}. } \examples{ # Titanic data in alluvia format titanic_alluvia <- as.data.frame(Titanic) head(titanic_alluvia) is_alluvia_form(titanic_alluvia, weight = "Freq") # Titanic data in lodes format titanic_lodes <- to_lodes_form(titanic_alluvia, key = "x", value = "stratum", id = "alluvium", axes = 1:4) head(titanic_lodes) is_lodes_form(titanic_lodes, key = "x", value = "stratum", id = "alluvium", weight = "Freq") # again in lodes format, this time diffusing the `Class` variable titanic_lodes2 <- to_lodes_form(titanic_alluvia, key = variable, value = value, id = cohort, 1:3, diffuse = Class) head(titanic_lodes2) is_lodes_form(titanic_lodes2, key = variable, value = value, id = cohort, weight = Freq) # use `site` to separate data before lode testing is_lodes_form(titanic_lodes2, key = variable, value = value, id = Class, weight = Freq) is_lodes_form(titanic_lodes2, key = variable, value = value, id = Class, weight = Freq, site = cohort) # curriculum data in lodes format data(majors) head(majors) is_lodes_form(majors, key = "semester", value = "curriculum", id = "student") # curriculum data in alluvia format majors_alluvia <- to_alluvia_form(majors, key = "semester", value = "curriculum", id = "student") head(majors_alluvia) is_alluvia_form(majors_alluvia, tidyselect::starts_with("CURR")) # distill variables that vary within `id` values set.seed(1) majors$hypo_grade <- LETTERS[sample(5, size = nrow(majors), replace = TRUE)] majors_alluvia2 <- to_alluvia_form(majors, key = "semester", value = "curriculum", id = "student", distill = "most") head(majors_alluvia2) # options to distinguish strata at different axes gg <- ggplot(majors_alluvia, aes(axis1 = CURR1, axis2 = CURR7, axis3 = CURR13)) gg + geom_alluvium(aes(fill = as.factor(student)), width = 2/5, discern = TRUE) + geom_stratum(width = 2/5, discern = TRUE) + geom_text(stat = "stratum", discern = TRUE, aes(label = after_stat(stratum))) gg + geom_alluvium(aes(fill = as.factor(student)), width = 2/5, discern = FALSE) + geom_stratum(width = 2/5, discern = FALSE) + geom_text(stat = "stratum", discern = FALSE, aes(label = after_stat(stratum))) # warning when inappropriate ggplot(majors[majors$semester \%in\% paste0("CURR", c(1, 7, 13)), ], aes(x = semester, stratum = curriculum, alluvium = student, label = curriculum)) + geom_alluvium(aes(fill = as.factor(student)), width = 2/5, discern = TRUE) + geom_stratum(width = 2/5, discern = TRUE) + geom_text(stat = "stratum", discern = TRUE) } \seealso{ Other alluvial data manipulation: \code{\link{self-adjoin}} } \concept{alluvial data manipulation} ggalluvial/man/stat_stratum.Rd0000644000176200001440000003026614371217533016212 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stat-stratum.r \name{stat_stratum} \alias{stat_stratum} \title{Stratum positions} \usage{ stat_stratum( mapping = NULL, data = NULL, geom = "stratum", position = "identity", decreasing = NULL, reverse = NULL, absolute = NULL, discern = FALSE, distill = "first", negate.strata = NULL, infer.label = FALSE, label.strata = NULL, min.y = NULL, max.y = NULL, min.height = NULL, max.height = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{The geometric object to use display the data; override the default.} \item{position}{Position adjustment, either as a string naming the adjustment (e.g. \code{"jitter"} to use \code{position_jitter}), or the result of a call to a position adjustment function. Use the latter if you need to change the settings of the adjustment.} \item{decreasing}{Logical; whether to arrange the strata at each axis in the order of the variable values (\code{NA}, the default), in ascending order of totals (largest on top, \code{FALSE}), or in descending order of totals (largest on bottom, \code{TRUE}).} \item{reverse}{Logical; if \code{decreasing} is \code{NA}, whether to arrange the strata at each axis in the reverse order of the variable values, so that they match the order of the values in the legend. Ignored if \code{decreasing} is not \code{NA}. Defaults to \code{TRUE}.} \item{absolute}{Logical; if some cases or strata are negative, whether to arrange them (respecting \code{decreasing} and \code{reverse}) using negative or absolute values of \code{y}.} \item{discern}{Passed to \code{\link[=to_lodes_form]{to_lodes_form()}} if \code{data} is in alluvia format.} \item{distill}{A function (or its name) to be used to distill alluvium values to a single lode label, accessible via \code{\link[ggplot2:aes_eval]{ggplot2::after_stat()}} (similar to its behavior in \code{\link[=to_alluvia_form]{to_alluvia_form()}}). It recognizes three character values: \code{"first"} (the default) and \code{"last"} \link[dplyr:nth]{as defined} in \strong{dplyr}; and \code{"most"} (which returns the first modal value).} \item{negate.strata}{A vector of values of the \code{stratum} aesthetic to be treated as negative (will ignore missing values with a warning).} \item{infer.label}{Logical; whether to assign the \code{stratum} or \code{alluvium} variable to the \code{label} aesthetic. Defaults to \code{FALSE}, and requires that no \code{label} aesthetic is assigned. This parameter is intended for use only with data in alluva form, which are converted to lode form before the statistical transformation. Deprecated; use \code{\link[ggplot2:aes_eval]{ggplot2::after_stat()}} instead.} \item{label.strata}{Defunct; alias for \code{infer.label}.} \item{min.y, max.y}{Numeric; bounds on the heights of the strata to be rendered. Use these bounds to exclude strata outside a certain range, for example when labeling strata using \code{\link[ggplot2:geom_text]{ggplot2::geom_text()}}.} \item{min.height, max.height}{Deprecated aliases for \code{min.y} and \code{max.y}.} \item{na.rm}{Logical: if \code{FALSE}, the default, \code{NA} lodes are not included; if \code{TRUE}, \code{NA} lodes constitute a separate category, plotted in grey (regardless of the color scheme).} \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to display.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} \item{...}{Additional arguments passed to \code{\link[ggplot2:layer]{ggplot2::layer()}}.} } \description{ Given a dataset with alluvial structure, \code{stat_stratum} calculates the centroids (\code{x} and \code{y}) and heights (\code{ymin} and \code{ymax}) of the strata at each axis. } \section{Aesthetics}{ \code{stat_alluvium}, \code{stat_flow}, and \code{stat_stratum} require one of two sets of aesthetics: \itemize{ \item \strong{\code{x}} and at least one of \strong{\code{alluvium}} and \strong{\code{stratum}} \item any number of \strong{\verb{axis[0-9]*}} (\code{axis1}, \code{axis2}, etc.) } Use \code{x}, \code{alluvium}, and/or \code{stratum} for data in lodes format and \verb{axis[0-9]*} for data in alluvia format (see \code{\link{alluvial-data}}). Arguments to parameters inconsistent with the format will be ignored. Additionally, each \verb{stat_*()} accepts the following optional aesthetics: \itemize{ \item \code{y} \item \code{weight} \item \code{order} \item \code{group} \item \code{label} } \code{y} controls the heights of the alluvia, and may be aggregated across equivalent observations. \code{weight} applies to the computed variables (see that section below) but does not affect the positional aesthetics. \code{order}, recognized by \code{stat_alluvium()} and \code{stat_flow()}, is used to arrange the lodes within each stratum. It tolerates duplicates and takes precedence over the differentiation aesthetics (when \code{aes.bind} is not \code{"none"}) and lode guidance with respect to the remaining axes. (It replaces the deprecated parameter \code{lode.ordering}.) \code{group} is used internally; arguments are ignored. \code{label} is used to label the strata or lodes and must take a unique value across the observations within each stratum or lode. These and any other aesthetics are aggregated as follows: Numeric aesthetics, including \code{y}, are summed. Character and factor aesthetics, including \code{label}, are assigned to strata or lodes provided they take unique values across the observations within each (and are otherwise assigned \code{NA}). } \section{Computed variables}{ These can be used with \code{\link[ggplot2:aes_eval]{ggplot2::after_stat()}} to \href{https://ggplot2.tidyverse.org/reference/aes_eval.html}{control aesthetic evaluation}. \describe{ \item{\code{n}}{number of cases in lode} \item{\code{count}}{cumulative weight of lode} \item{\code{prop}}{weighted proportion of lode} \item{\code{stratum}}{value of variable used to define strata} \item{\code{deposit}}{order in which (signed) strata are deposited} \item{\code{lode}}{lode label distilled from alluvia (\code{stat_alluvium()} and \code{stat_flow()} only)} \item{\code{flow}}{direction of flow \code{"to"} or \code{"from"} from its axis (\code{stat_flow()} only)} } The numerical variables \code{n}, \code{count}, and \code{prop} are calculated after the data are grouped by \code{x} and weighted by \code{weight} (in addition to \code{y}). The integer variable \code{deposit} is used internally to sort the data before calculating heights. The character variable \code{lode} is obtained from \code{alluvium} according to \code{distill}. } \section{Package options}{ \code{stat_stratum}, \code{stat_alluvium}, and \code{stat_flow} order strata and lodes according to the values of several parameters, which must be held fixed across every layer in an alluvial plot. These package-specific options set global values for these parameters that will be defaulted to when not manually set: \itemize{ \item \code{ggalluvial.decreasing} (each \verb{stat_*}): defaults to \code{NA}. \item \code{ggalluvial.reverse} (each \verb{stat_*}): defaults to \code{TRUE}. \item \code{ggalluvial.absolute} (each \verb{stat_*}): defaults to \code{TRUE}. \item \code{ggalluvial.cement.alluvia} (\code{stat_alluvium}): defaults to \code{FALSE}. \item \code{ggalluvial.lode.guidance} (\code{stat_alluvium}): defaults to \code{"zigzag"}. \item \code{ggalluvial.aes.bind} (\code{stat_alluvium} and \code{stat_flow}): defaults to \code{"none"}. } See \code{\link[base:options]{base::options()}} for how to use options. } \section{Defunct parameters}{ The previously defunct parameters \code{weight} and \code{aggregate.wts} have been discontinued. Use \code{y} and \code{cement.alluvia} instead. } \examples{ data(vaccinations) # only `stratum` assignment is necessary to generate strata ggplot(vaccinations, aes(y = freq, x = survey, stratum = response, fill = response)) + stat_stratum(width = .5) # lode data, positioning with y labels ggplot(vaccinations, aes(y = freq, x = survey, stratum = response, alluvium = subject, label = after_stat(count))) + stat_stratum(geom = "errorbar") + geom_text(stat = "stratum") # alluvium data, positioning with stratum labels ggplot(as.data.frame(Titanic), aes(y = Freq, axis1 = Class, axis2 = Sex, axis3 = Age, axis4 = Survived)) + geom_text(stat = "stratum", aes(label = after_stat(stratum))) + stat_stratum(geom = "errorbar") + scale_x_discrete(limits = c("Class", "Sex", "Age", "Survived")) # omit labels for strata outside a y range ggplot(vaccinations, aes(y = freq, x = survey, stratum = response, fill = response, label = response)) + stat_stratum(width = .5) + geom_text(stat = "stratum", min.y = 100) # date-valued axis variables ggplot(vaccinations, aes(x = end_date, y = freq, stratum = response, alluvium = subject, fill = response)) + stat_alluvium(geom = "flow", lode.guidance = "forward", width = 30) + stat_stratum(width = 30) + labs(x = "Survey date", y = "Number of respondents") admissions <- as.data.frame(UCBAdmissions) admissions <- transform(admissions, Count = Freq * (-1) ^ (Admit == "Rejected")) # use negative y values to encode rejection versus acceptance ggplot(admissions, aes(y = Count, axis1 = Dept, axis2 = Gender)) + geom_alluvium(aes(fill = Dept), width = 1/12) + geom_stratum(width = 1/12, fill = "black", color = "grey") + geom_label(stat = "stratum", aes(label = after_stat(stratum)), min.y = 200) + scale_x_discrete(limits = c("Department", "Gender"), expand = c(.05, .05)) # computed variable 'deposit' indicates order of each signed stratum ggplot(admissions, aes(y = Count, axis1 = Dept, axis2 = Gender)) + geom_alluvium(aes(fill = Dept), width = 1/12) + geom_stratum(width = 1/12, fill = "black", color = "grey") + geom_text(stat = "stratum", aes(label = after_stat(deposit)), color = "white") + scale_x_discrete(limits = c("Department", "Gender"), expand = c(.05, .05)) # fixed-width strata with acceptance and rejection totals ggplot(admissions, aes(y = sign(Count), weight = Count, axis1 = Dept, axis2 = Gender)) + geom_alluvium(aes(fill = Dept), width = 1/8) + geom_stratum(width = 1/8, fill = "black", color = "grey") + geom_text(stat = "stratum", aes(label = paste0(stratum, ifelse(nchar(as.character(stratum)) == 1L, ": ", "\n"), after_stat(n))), color = "white", size = 3) + scale_x_discrete(limits = c("Department", "Gender"), expand = c(.05, .05)) } \seealso{ \code{\link[ggplot2:layer]{ggplot2::layer()}} for additional arguments and \code{\link[=geom_stratum]{geom_stratum()}} for the corresponding geom. Other alluvial stat layers: \code{\link{stat_alluvium}()}, \code{\link{stat_flow}()} } \concept{alluvial stat layers} ggalluvial/man/figures/0000755000176200001440000000000014367761414014635 5ustar liggesusersggalluvial/man/figures/README-unnamed-chunk-7-1.png0000644000176200001440000020635614367761414021351 0ustar liggesusersPNG  IHDRz4iCCPkCGColorSpaceGenericRGB8U]hU>sg#$Sl4t? % V46nI6"dΘ83OEP|1Ŀ (>/ % (>P苦;3ie|{g蹪X-2s=+WQ+]L6O w[C{_F qb Uvz?Zb1@/zcs>~if,ӈUSjF 1_Mjbuݠpamhmçϙ>a\+5%QKFkm}ۖ?ޚD\!~6,-7SثŜvķ5Z;[rmS5{yDyH}r9|-ăFAJjI.[/]mK 7KRDrYQO-Q||6 (0 MXd(@h2_f<:”_δ*d>e\c?~,7?& ك^2Iq2"y@g|U\ 8eXIfMM*i_@IDATx}xޫ\nl `B3 @(@Z !!jp\06VlY\kֳ]iWڕvW,?Q˄ 3?,^ӯ Ȑ}O&M>^mRZ" 3 riӮkϨ\?+v%>賜:/#<"YYY_-[̽q ڵkg >;=;wia=Z" !FU^u9cC\V3HRR6B4˗/SO=U^z%3D_Zo˳>+G}۬+}L6q "ZVV&iii'ׯ={QG%!O?Th<׃ad̘12c Sw@޽g9IOOm>}ǎ'eĉ4ZZZdΜ9` vmc}lw]B- ֭̀j6Jcc^ZqƹoBΖ>ؘs+VCzh/LsfYm۶^͛7 ٳgKqq)]vyi%ȏ8{ǚmڴIo.cǎ5Ϛgffz7d'}`}AW)e=IbL- ۥ?;{_ޱO RXXhEivJ ,ʕ+ ||:7m~= 퍋3Uwoy~q _z"Ds$uWZsy+''z衇<_^^nӓZ@͚ה`tI95z'uRT-WZgn׿]7v6-r[0l 㬏۷~]4|mT7aF4k^XDfgyUWW>f fIG<'-ʼn1?rVryq_B&>gn/<׆ւuqǹ;ydW_rssMYٲ`u;蠃,/~Swa`RRRo~r=6δ}͚5vfV,w\O}1wUe{f 1j(s]Q .48{]絗-[淽<){0|>Dof͚e<(QDqۃj:_lA9;]xVjjH"m4ĉ-Pnܸh9La$ЀYjY1|w̵m`bq]ʔCp)-:, B)kD4g?op`,X ,p_&$D$0Y`\㮻rkg>j΃Ⱥ͹l|I8~a7$Ж겶njB!<`sbO^z)7w} =v{Ia4L]$$|~HGmqphlY#79Nz7OX$I@`f.-_|H*)s>$߷z]Y#̐\@ ;Ѡ @_7-Y? V81hAr݅ko&al70>X,~}tO)@#0(LO[`^7$O6_$IN IX[̏fWe`5ds]YSźϟ$&l 6i>Ԟrv͵ -eD&?`6$9p s6 3jp%pK{=οku} vAI<%n$NNQ.`_^ #&56$|0e…5\ qW>[G>Ny96 Ov75_t7;@9O7ƆLb>(V~xm'P~,%Yx9 _!(<߶ |r]v7 cBН{n(@!#K, T>k &hNRn"@+J>qQo2uTyk aR} yܠ4 I8[H-h:.vaaf9hW_'g }(.LnS~zT^x9.\Ӈ#@[f5- MݜbLIxΜ9'}umڂS`|>nINNO<,Ecƾۦ*>kg;?c '`}޼& t i \G[otω@3-|x Ȑׅ(Vzl}٧ e~q@`Yg݃n}O ˌ!=cPC`DP_'$40K$xoɩ"$rw2( 'x1h-׾5aT) .0[;$d+ЄnL&Ȼo2pOwQ!9c0S`:vM-ӷ0 ?^Qv_I Za+*].5ɽ9q}Uv^y ISSu]g>dHJlΛ7^+dwqbhLe< D~_4/_I=i%PFO0}%>v;]zoxs}wb_YFE zQѩg !I, ?{s|71IvU`dP@ .2Qk|{ҫPG`gu734 \@h&Q9&30'mJiBM/$ PRSC(ԜR+C0M85ۨ] FqEdV)0S?"T'0  $)GԪdPkwmnt t&$cHC^hvtMnI%KLqC Hf0v>Í]Xh&5s/$bw >;g#ڞY_ |ScaXEPE@9O.]t!(LL#ƎZ*[cWWHwF>Dsm h>IX>lcf=$S+#L&M 0ͣs_RlMw]c2fo"$_JA.Mr 4Y9a8c4\4ѲaIm3Z 5`.tpUwC_rcnYÅ~}|6m\Ys8#N=G }i͏$[U߁`Ķ%jo/G+C|2j?#47E oD0)@̂zw=iA#g"|q, & 7&2.qcMqJe\09#F:1̵-e&[`2q.<ܦx@eOG0k,; ´?Ąq!̑I $՜ǾhPܧѭw95Y=a,/F}keZ#u}3gvkF2J8^2j>7L9`ۤyg0xa O(l }O_iFѳO0ۻ:PX8G#z~'~ùwOll\_um:.z~OIEP86/u 5*4gPC+(X;>5圁x)òԆQs4dߚl+ M[m:.>ߚ~(\UsxQJB-1`5kFZo!%C'zWJX ;h;Yw{`Ӳ"0H:4"9ICS:.Q*@"+i~сY߁@r" ?J@@rǛ)oATvlH.(!B30ҙzfgb @PsE@F t&M #ucUhRg?f92I1˒[ET\̣;،D]v)"!_"("(ÅJ4\ uE@PE@P#t?("("0("("(P RE@PE@z E@PE@P(ݏn)"(" J@{@L,&nkk3|rg/}Iy3k֭[ǃ|< Oy,;4.q:$?~L@xsD]Lio~;xOc4{ruc\s9-[ȶmL[اzʮʬi[ t[Nwyqr]w oJ{{x_xr뭷2zr79 p rg˃>KkYEGߵFͺɊ+=^=#ć;O.Ry뭷BmS~… .'0|?,Y/U۽/,ZHFIʝ_IHIN:$yw #YΖ3fm3g1g$$qeG>hMI&/WJJP;oH'4r }'Ix',^!kn &k$ I6FG 8 3G߾Gs[_/o uLMw6gu}k? "~hhݻo&kԨQO "gCeZ ,f de= X1@j=cE3?,d Z[&Zpxm9s"k~666Yh#-{=~)S4 )-~ 7ےf )--_oLY=ǟ=4gq{m?[0#9Uo>t '` 4f .>8v+1h wXj("1P BM˴iӌI)O1HD;w e"i:g95evԻ].5ŬkLkOM%5ԤQCM-&M Okjt=GcrFؘQZn4flд^\\, 8C<ISSLὠ[frJ6j8"@?[{HM-쁴?͚kjj YH 5b-lcc"))4ؚjw2t)HXGuu$i0Ml#0rЅ66R6 QPP`L.$$4ӜLs-jǚffL6o'KkI0 Ea678ICuq: +ϙ0aWFHX3ݔwYƉ}.Ouc ϞHl=$nN }}kSs?g?IUc>]E  _u>E@PB`Dh@7nh|5I<41؇>~ =Ԑvm&ҷ-S:I.y`a#3f{'$I(RSS#Kv!3/A$r5'DQE@_J_B_LnjѨ85gW:ujT:+$=堃2ZIg=Ԕ%=i7ql}r~Gu7MJ-jAB_a49~ @#ﰿyN Ϟm۟yyBZ');Z+­I>7]%K) ,E@P%$\&q$%9M4GӼ΁[s9`RC1 I#MM@jFSi猢R.^شQ߁G&#4w~_ukEiRg@#5MRKh%cS _8;MqN-#NҚ=ăA-} IK]} =lCALߟcǿQBk~E@PE`DP1E}d:SH0D/D2}i&9č~j1ifYd-!b]}#'&:)tI"؟V}!a ׇzh4K$,ޟ0*d~$c$wJw d0f;P $V"d pk_נNE ɴMǾ<7fEΙGm1,f~ytȳ,k]zw曍6WY}$ć>t`:V2}rw|Fm v]VE@^⠵7mۤ[+/!#6ƗPcG5rq i| 5u4}ҿ3Pa q|Lԟ9>d_رL tGƛmQJ"c 3݀e<82Zl t[ Ezmc.7¾j}*? ,6WPEF/\4R#HVl&.RFUr?4qP("(@ @ ۙ웉i6Ν; qfJ,0PS#H3SUE@PՀF˝ q;gJZPZ"(" %NOTE@PE@#" ~ 9"("(A@ hxpZE@PE@P 0[PE@PE <( Z"("(Fw&das@-d2(A" ӣ%Q}uuu™TFZ8c"0|rl^[6zaE@PE@PF&J@G}^+"("0l(6Š"("LVE@PE`P:lE@PE@(]{("(!tؠ +"("02P:2ZPE@PaC pa]Yۇjz_tttH\\$%%:!C $11qȮR|< 999zA@W:?EJ$;;{h/WS3!;"02PȸKE@PE@P"%s+!"(" TE@PE bP1B("(@@ ȸKE@PE@P"C1b|rٲeː\A%33sHwˬYZz#pB|E԰w^l":(4iR-" / Lna|}}OII L ,!^DMB1||1RYQ=~aW^ɾZ:Ib[{ιGM㏍e~{ｃEOWBj@CcT)7|R, 7 Vy ߋc:kha- 8$oIc xDB9$KH%%cA&ӏW'g ڞ۬[[ZLU?\veTe:lihCQx0M?s1Q8C ")()wbt\Kr$65U$3\q^$L.=f~jvI5Wu[,/{::e>t:ps"g clI b"]THB@ h$ mK RapD4J_XVq^ji H)U ^DzeɆx0:`V[d4Izhkj^5R^cC1ދ;vObRQ" %t7-{^օ=43C3t an becchmmɂo*Rm$ONի瞓[v]wu]''Nt3 {TnnnCF]6&$b-ba!AX@N5%IhN\(@>;z̔ 32vstZgbUK\҅(_o9M)aEV;O-Z$̜9Sz-y 9'''Gj93 :K.Z{G7ސѣGE]ԫP %vǴ@_ HZH֞"thRrY߳k͚AC 吜lIKSٵn-Amw# iOf{T%QP.=SO-&n .Pgٲe#N:x衇n8IeJdF[\_җ@$'k֬01XEfFӶ+!@SEH4MjkzjR$L#τȤI+/MV͗ _~j}yTq~JdoR C@ k#΀$VX`LL{G%r; YOFwޟ̙3GH>)x'8epyyy1:g䓅O9>у@4 4QM Atha:;Lܦ?*[rd.6eH= s ,L3༢8K NƾŲ67q[6$MČ\K Yckƥ@CEM,az3+W="dʤ-[ȴizv뭷O7hwJ>2<)HFr,OIlO])QШmhE`pl ,'#xhQ7>44.h?ILk emv4p:X9 %c/In<.`XXl NjR1Cr.{frnp+^e4YmwΩ{Ny'?tAAoʕ+eܹ ]DGHkGPBg^ j=1luNqI ;{QiYUT"iS8dv2.¢A2=WI%d9h'$Kvjh1},tr0[U.1N'xI2R_rQG 4 F͛gL$?P#H`EgB 1-na_@:_ 3 s+$A>;mjd'Ғ1vC &t*Zp/+:C>I)ȩ!8lU"Ζ6YZ"Ӡ=EUIc9FG ߄ܹv5)A?u K/"K3?rXWqݧD J@ViC#1t<, ED:Ղt#S; }Fy ЗSe!`?O==ՐUF_*OM-) ڟ/)͘GZ+;F\P4K NbS^xO{]~…B_Qo L'O<>iTXAϱ(V:PF"A:_l Xuع?ROHRu)'/ jуFwdIcEJWͅLJ0[7*;qW[>3yέ\0eޘqu$TcO>:zQ_)THA@ h m"BۓO]Me^3Ӵ0@;yx@{Js"0l:&.菴npTS)3IiFs]|mYЌ aQLXo M*@ 4RC@NF**<v6emq,U$4~I,ORQ"O@<MYKaOіQDLp#sQޟ9?p f;V/-uI+}~D7MCm_b)~e<4 ;,0amK3H> ƒXs; $ Nм$c*|uG{꠺aQ4".rܞ^)+FI)vc΃D8]xB!go,iXӏy73;?@UD+J@Epx ͕SO=5Vr6^:PdH} Jy B43}g@KՍ%;% <٘v2)^2ѷp@_^f.AoKTFLY[ÚѲq:C$*@ oB"u$}A>`u2ߑh鷶S6F+;`{n9M<0{#~%n1|&}t kxGQQ@@ hd܇oAl /ûC|W2I'M$_rM7qާff8:s "5-ԜAsJr*К&OZP39=ȁUY!.R%s"9U56,H+_۷fyx3=JMQr7#%#Ns\s5Hc̕|WE]$/ʕ+eƌrG3p?fw%p#!#{+VAd`N7l ۷o9ssZ'9'N4&set;2Ȑe˖?n|Dϧ~:H~m"]R RS0#`)^]+F`|US?q& P_USP 0$?/O= :oۦ LYnю=# WZ%wyr)V?xyN(IuӠ~`,_\GԂ71IC-Lyt1MA5{rlq .Jk,(Cׁr%X~- Hzx1Ӭɀ| Dz͈ߑ&Q|ڷ9똻lY"0?.L܎N sXw *^L3`An`93f&J@:K~Mg酒z>bƧf9P;L)x3$[_c"/aOL/\.bꪫd/!r?!~<XfϞm_3A'' ߍHhC81@G&3k)}Eds r ̣Hk:l6,Gfd)`Nc${m1Xd|< '?.6T$v]";;hƪ aufY3;N4#jQ*}[H,0%省˽+?G`L? 8y|'#@RǎL!\[/.%, f~ѽР6V`_Q`x|j1`:\ʳs3'r L  |e)H'ޟ ?Id.ІīQ% 2LbY2Cƞ(d(~ eG8S=c;Lߨuj&uF⽟y,Bc9B?Hl339[xJJ s6ýPI<>畯ty=7O6t XSI&@ iV\U-GʹHW zP` bq5C7> ~UG!ɎeI&YfO/&I,T| ~yxކ[wLFPЙKn L-4OLm׃vѵֆnvd; =>uoiҒ};2$#F%4S7D5K_Szߏd Iɲ2o&OIJp vXC6 뮻Ln~1Y6o@IDAT_#8¼  /yw$//,X( Ѐ-/ gQe2~dM }R?M0 #mG"L2vu0ض4t d*P!@/pBIT*t; Z$2 X7uʕUND&W"@ '21$12ʗ]v)s˭*>^2%tGe0Kx?p$'p >t/TTN#a dZ ۴qفanPj4EԒ2DaM )vk#v|$PUִ=Y'~~9lwIP'2m,Lf\q 7R\aN Wv:0>& ]WE$>rjEZ'>SI2OSxwk~E/v" ['=>}3cu]T]#Ertd !U+U5.+RIs?n856!L1enfʵ'}1Pˆ?j6Qws~58ze&sZĦhrؼܫzss%.9v]+"=sIuk%"m<:666aH,?Iךb92>3e)ZHt.Af1q?( fRfTR\(}.0:1#BN4 xDs-΅Bmc>ծ} vq &щHZX*r?WF ="D/A@>my,!^L˔36lBrDT^i"FˇR\e?-+@>S|Tbf4SC!B ׉X8%7 RDH:`L|S~PN|(t'J;p!9k68Υ'-\I*MAȖ1RF B@ 4Jn6shrR0}fO~pR % 95h"j)R._R f}YB.V v0K( $)9 bڌg&pheŦ$ڄw OE[-$x<|<[ Z"0D("2уR MҹmS$ud;_E{yk+2.&”K-ٸz) ..W ٸX&Tmܰ\k D$d&.f!&5,nm1ylǠ]~RE=(ÌazD7:}.I4nmb2)Z{ڹC\K'"1 fQ:GnNuB<>&RMMj#oY%A5D$f&I :v c[OE@FM&UH߃b@7*>_mBau}ev}<ƴmLzH~ntcş0અ$S|67e: 9x~k32%?u"](b6?&iL'U/*Y1ejwZynMPҳdO$sw3zZE.W3H\+-Ф@ s ZU_^~%r٪g_H1E P]K[; p6I4I 'dYH})EWJszFiQ ?0a> eRE $#(~k~[:\\xHZ0AT;J.,Lie wgIwq6nb.{E@ z(Fm,O)>i~J&xog48<@`n |NMV\Xb[l˗ WQE 6؈ƽ@#W*\B-wuS5*@$!4%bM:_V#_ٌAsa2 e^OsDswލ#|vM`a9}DmІ0S $`RQA@ hKI ?Bѧ~jj:9Fh54Dt2h,h\-eqxɃy05ې:= %e92/*bj(ݏn)n\ L~]Ys7-k@xܸq2wTLt̿II:S"pҜ]|3\eȗ|1э@` |7 S>"J@c~jo1gPKW!$-MIaڗ< ,JN#0&@Id̽I9ݘn EE%r<|})0!-MD-0LA/ %a6+fڞŋ˝w 0+P;NvIjd{v$]=.sv6glsLHt5feGy3<50s KL]<*1$a{x)9s z"5'W|FHӴ""hK.e˖Ecl,U 3Q. "bL , $"0 4t5W}A`TTP(J51эA` >&S;Ӟ(P:Lsݵ=S(\s5e^NՙRmeU{vKR0%C%ĔOZt64Њ\,oQ%]yBR$"a@SmڦV(XN@TpfU*ÍbIV p"4|WoD%'yvSijinO az csHjh@N+ݰ\q^[mT[ѓF ; KXF)Arf^iutvuu&лjjE6K9:01эB`>75lw5(عړ(E pyp"kRR1 ;I"`9L͈Oȧ6]07A@64Jw"* I'8 $<Vn3:*=NePWmy{) ~ڐ:h y ]"%Э򗀄6q-4&h)Yaj#25U# 1Z]d!P grnʑIx/#WE@P__0ɟm@}#!ޓ> v"SH/)׍kj8| E&mQ(퍉̄I\$ ʧ GyV\ЀRОH8?:@gX@`>S >(_F4&Bx>Lj^6a!̂ϧ]Dž%R sc[[yWJ@=#q $"ZJ&攟*Gz1һ gj?l;4AܧF~s"0H4 c =($! Im]UUbu32DxJj?1)gejK‚)L;Q;0i't8BckNiLm|cgsva!‰mN~O'oOD,<o6Y CfJ&K mI&_ ggMTQ!4D@j5$ ǁ!PV" UY=#GK=L \Rߋ>-Ud6%&IcB4X `frwKΟ1"f>z# ݧ< D5 5K:Hjk:izgdbgkۅIv`Yh">J@ck\:M hSke@ b̈́=o=H9Cal&Z C}-Z`bQ>K*46 Hjc%' NI:뎦&#PV9R,Bna t9!ղƂ߮2XYԅ2c.\pם^bo;HgAjb3ܑf%Lܓ,CR%$D5 YvT<۩E P{T{BN O؟l~.xh W }# o>p8!Bjc𵫂ټdȟ0+@nr䂤fcBL, c@$f,f--4dhbY2пa"5t?(ZA8[qZfܯfܫ7.$iJLG,|µKz2DK _fdWx.@Z͂MxFm3a .!}$>гfIL<Y=,|TS?Dş&>SdR;?E PqDiAX]B+<7_.A6TPv%3frˡ͢v[c |;A:= Oaz(I*US^ m5B*Ij$Uh}T~z4<}+hR$}?j&RA<;eoEd '# UD_[u"D-m"Zt3LCssZ2X](RL  DHsr<3GӤW4  hH eĵcXts$ @.>$^6BcDn)Ou35akR\ %yx}T~:;R@T/ .w!~33@" X'0k8"(=&lѢEf?~\~咕oH/o]rssREX!a;?ᴃ|]ڡv)釀r#=d8@<)s >au4!%I`6 S0(h?HRfx6Mm3ɥD:)xZVV.GM fu|WЏ%eUDL Bi*-@LfϞ-rw{ߗG7믿~ICL!ӡać-IΝmvdTɲ\Y %0ErP)_ jp ZJ.Th>-9! |10f D'MAKmlgE{5w(v> EXcXxhlݙH я:PfAU] J3A ~B} >mR_aMnX[İ 'ý@1rٰ*%cu ##"OWXX(?ܕ͛7Ovgdy3ΐ~X***drmIn)#o!G.8 8i ZX hw{louIHiH%4@[􌃤:g3Rԩ -g)m[wK׺bsχ@Z, FxcMxǀug5Q4NiQq{_ i#A@D|of6ޒ߲e7'|R.25k}҄=?OMk֐ϛnI6o,W\qG( A0m|4~]N/ Dִ #{zg8>Dsz)!8pR,̺Խ~>PVu)A"P pRb'qTQ=>NkgC@fKKn}в-^ؐOܵk5kkS>wҤ<?ԂsjHTJ5JyB:ڎNܶEzB t98'[&5} D'ҽ36`L99S*@#4`$siJ)|>`]pzj)**rO˜};?*@$"xx*ۍ9Hۤ%a86/_~tnd%;Kr饗ʴiӌ[n+Vx 'sc%B Yc_4% )X}㐋3ARza?|WkنK;f@s\@^' r(ݫWN4tE \*nib\bj֫(D@ h8э'O_7R;S797M0A.]jLdҏ~#U35B;; gs)P^-k޵ԝp R*W3w^ώnUQ"2|!Wg >$қS0 4 j#PPZ InGJ@l L3P-A p # ;w@N`vY9r>s`DI*@ !Uw{heNE \jaC .#8J@ +*mntPS\FH>sROdӡ ҵ=%U:qViP`Q"Ъc"ڦ@ Ϲ_ӝG9Е{QrT.8sю>] oΕXӵm۾ #D(цŭ-RsfF[󵽊""h@RSˌu2~w"g)4&YADO,%aF̬ Ul%0t6}AF+dTqDeh8~FmӶ*!G@ h! #5|"2qXQ&YmcܩdYNklaӟ\Thx~ˮ?)().9EI>k@>gt78&!=Հ JPh@I@g'?H%sO!p t8Pk){y\ S2kjC@D5 ;[?yK>kj-T3?ca@]2m1۶Jw֧ۊ@4"Ps@޿q1#YT:5# fsxY^:Q\{%x9NڳtcLY=D@5#k{@@ -.--n8#^+,n+NfTVDT:k ¹&d)MKǔH:fXr4Iݙ4ZK`5B:XGoH3z"J@Bg@Ms%9BP/% 5D>N P[H:/I7 $C h)AQ $D"O@Phwd ߭j?GS?QsQb 2)yǻ,c(@( +ٰwg?3Ku.@$}.h9jw{-oIY(iֵ"{t#?g2M^_G"J@)&K%!g-sOLk}Wѫ`;f0V4~0@Y t)r͒t49HB91##秫6\|#z~m}K"0gdfxb9E@%}biN 6 K@ +]kGQ3b>\oBFCWǝ`,--B ڹ[{>_tGB[*=iMME ﹰH$g]"0p;=3 RX d FRCcK"Qz"|:eINLS/>SRmM'd_#J ׬pIgK"3T!.'!^yObE@ K G-Ymz` JʽrRJ&PONOj;{qFs؎TMo!矓)SP-E3!ݼ:R͗"X1F4.ÄyOb9E@PFyǪԃL>z, 2|*Ξ Ӭ{7:9FGcqRuu2j|d><+V~)=aw݊"05='$I=0@Y$d\PDzH*7kpnO+(m4'KA&ϲ}F3r#.hO;Z% mSQb́g-~)F@ 耡}TOr`*LфC*,_~t5#f:Vf658Їt4n)HrLX,:3 QE3?ǩg,^"0(t|Q~r  I Yiq"h`͚M1w>ueNq)Ԃ>]8}3u"tKOb?@tB[(@i@ pR6/ q;4C ;ew4_2TE Vcɘ݂?7#V{R@R$Gv!˖-s/6mr_]6\Mn/ +KEED Q^ TYRe ,MޓS3$s&$'iy͞33|}<}Ʒ_'QQZ&9~Lh C Z6tN*@"p /iNCf E@P z7ʃ>1;C~<`,[l1رCXfrovۄm.2!UQzǓ}h/y.:((WGmQvIƆbF՛OI(_@1˦U@P>,_$++X[orf(r_^.Bϗc(w //vw-]w3ڃ$Tv,9IRrsXBҟv5B3|)61ގG:"+W~)Kr'>c3viii^:,)--HdݺuFۢ"I#{}}9rNIٰa%Јz:TGZ{Dy& ^/^4]xHhHCjFyJ||`ř##pg MdI`gv"B-*@8 0)-pB?Ц&!!/k0-Cj%%%~*R\qwu _s24y!j:yfqhթ )B32=" !%]]]r5&#>#rgJ"r)C8?ƍe׮]R[[k~a9OG#nyK*S,-#0oN/  Th@wr,>] !}D:E oҥX LL~7p_ypt 7ن㊊ 袋 thtNG0Ңlyi5>lc Nttߋl oEG(LG ڝU^F"02ʝU.⋅I~$fl!rȹkq]Q| po@kۿ/-CV{TbA@W^p[c~AAƯ@ `zˋ8E j 5ViEN>} \PiD&3}|ADsL^sNz.E P I;(T.E@B‚F!:(Gͬq!lo#b7-g-HRXt'})(+mx p-h c]6&S/B\ :#u%`AIRr:\E ( >z(A` bm.${33LMX5+|:U{[[5EF"a=^"%^lqJ+w dM 3]SX`H.NWJ@g0^c (Ȝk^4Ջ.^s,jQ?!ϑI D"(+ #.`w+ Go FC}'Hhz$ І{"@X̓Ɠ9AIg>;ށ"tC#֋} IL>#ۏЦ{`p(ƫ}?[ nX'|7߹/+q?a]Oï XOp$)IHߕd%9F$yxD\q5J1("0-v@r@dy85M J )  aihiDH\:@>:#>Q:A.{10E:yS~# $t IaM RjEiC\Is$m: ܏iФC%55}pթCA@p `t",.Ko9`QȔ%cf2$ԏ&/6& KŹOS[IBЬ&\L0} /6"J@"5 FrщIIWCA@W 48(&:hN kɩH:wk }{tIC_b_~_t7Ǿz@9 '@.X Si/v(>0Um,G^~ƴX qI>tQQ TE Ǟ&%A6a.1mG]x%ZQ%[JO2:|zj&u}JYY٤!`2DZ p@G@hTg@.6;cin"f=BB$$*`gmx2΃ |PG:qx޵rv[I/IVv!=200 r3ϔ+BƺuVKo|jn0oǃ$EP/"J@Wu#ʦ<#p㧥}d*s|}LH0>lq b.O=q/ 4+ D3O#uMP:}-t4uKA2<.0U\0'NcE@{QhUrߢ3DYFnImNwH /S@E`Nk|NЃB?,FhK91(] K| d0K[qGP'}@] ;`ql7Idb (iS"qy@$ .F$<<(0-[{͕[m&wq۷O^|Ec?#21ܹS_.'4}۷o_ Q_)_ڽhkB6#X'h'|#~2HgX!,\p!lc0 ,潪( п3K*3A`{n kßlP>}N@ ?yODr$&\,yl7Sn>dӛE>>4?}Hl>$p')io} }W&0gggK ^L9s'}~2%PPN@υA Gm04, lMtUP#ݡ(TT2 ԯu Rm$!XwaMIY @ x=_V)'( e)RX0hmmmWsA>'{V;#Q$9nmRܼy>|x<:G5Qi|ʒBO>imq?%səf,>Џ؛,=oqz~R/=LB"ĬIt"(!t:t"0KH2>E ^~;mld<%o0WsKYقާi9iЖ-H%iiRmM놀Lā WcABgsZ3ꫯ8Ev)))GvLTSS#?c4.LH_JwSjJD}I" =$m~4f/j]jU8*lXb/TE@%"Y @RNl7hگ`8f/ =h#𠸡xo̒gJJD PbgPþ*-~q< κZ$47P#3|ӟ6Hw]b#iVOԔ~_4:,Yq"!mKIjJ{Ey[(+,ŔaE̷Rwel{I%IORڋ}t ̞SP"J@U9 rA:{-P藤m?<طWv$sW2L'dgɆlIiGț3򶷽 y'f͔Ki.׿gjvc2K|?8n7.O"ͱ d|1biLjQפ&K?MO*T/".+Q&oOZmr;_l | ~& ϴ)Id4 构 ۏ[@[b:&PTʞ@IDAT"3c997Gʜ0'D]DHDY_T+*MF7j6kuE`rK->hRG2xXc\2j/[CGf?`N|g5/f{pr}u]?ʉq7E` @I$3iG?;S׿J&L!̇\\\)ʢ}`ҟ}3(Wbo+1E~[\Μ{;ByyUh7>S(<ٮxA ?G&%{i+0$|A2 #٣1}+MiCZ;nG^AqLR*]w<;X>̉bls$׾5K媫s._\N?taQ~fsO&8֏EMsAOG >#{L?tIL mI Xb?Zc2FfzDb:Wsg%`U/S]5Gڎqr@қ j 3F$zo[#O6,A,ပOİ]ZPPR&e~RImY˜!}$''G~Ȯ]r$sՀA=(qț7ol<3FN3 ă5M9t5n1fx.]#AK,DpQ|tєNqlߦs8/ꡭOp UE`zHH6K&'?`KSN9e|AM$,1LٴiN]xnyc,uV#̍̅Vqkf[fxw|YPN;KkqW_oM 7u')Cƍ8Ӭc,l߃?l/NNKN:'"ѱxhP7΅5Ǜb#-v($ܮS1p89vL_^jؑ9d> 4Ee ҄sTUU_n,|N2Mw1//lj|~SBm(I%}8InB {uI/Kee|C8eT#hm6XчzHz)o͌m$|Ns=Y]z ٥>F5(LM(R~is-ʛJ`USϷ=τdLyg:F2 /||@m}җm;hlq+31qFNB]Ҽ\6,RL!o~e-L_|,̗fD{AG};QЏ:^.܃9=қ!WvX;y_YxJp(((0s_||6J˷-` JKK _Kê8(K"+6 Mt 05,7L 7`hd.]j={y .Fbo(2S}ij{?|nG'&뿌_F×^z)D[IƧ5Ȩ/E-* Rs,'*ô!8$4ɋ9k )FT/4"в;; U)^g#q nTlPH<#׭[g馛[?74 ,Rs\r%!pN' FbI)|bt>?xCID 'MT|OQS[*! B$7xC;94P6l0^v5qBVE@ۼ[D>sz4KfRY__//64'ƛr)//bHRii}Ԁˆ;t!׿eO$U5v0ouTwl4aHv'@96  ~ 2BU$SC>G>@M/5&Wa|o) j>|u?p5/9EԈXD!@7i6sB=~ ťjPl@f( % tL8dWjD3+Ԅ2Η1 PYԊF %K`hOn6 ġg!0xF-./*4B!P"PLj@K(\lFj5I"O(wj:}7lVV))!Iv})ۇ@$_CT; Kd74\4P ڀhH tmdA{}+mÞOB+[li ȖŲQ*3Gq g`=BP/M@W^m{c]"8<\P$3XϼjPDlnR"Ɋry׺@NRTM||wfcYcg GmB6?RPn}{|F9a M6nhF=11q"з.7OgA#afn h䄖 3 eز Z<(Fgc0`P_~Νva~E/]nIGR56R~uY{Ԕ7 >ܬ@ 0lB0Q1J6E3gTVxKN@m(7q+Çmp@ّ* E "~w>>Cѡ_tvd&0N kxuE  v"pǎdadz+uRϘi'͒^g`L _J)-՛ ԉS=Y! ͪ=HP~TXAA,A@z`%3(زLW2KhVCzBkCYҜR u^mUE`nP^(DKp L=ZP]w%Uʚ,'eV'?i$QD y6DtT0:=/W?6^$yI(?wv6JYjtvyY@] z=nT@#fj~ z"VUUɶmd֭ oy[dݺu.uU=ӜYT;Q=ZXR5N!ŬcM 3|RC ͢ZTuwPjt'];,;cssQ{PE`Y30OPG gK%^ܬֶMGB4| ROoR\Fr"ث[{ݦ"L"03`{Wo1'64wOSf@|MEjK*'OS( j,;+1mV4v*Gc u]+g HҘ~"M@#LF饗-bD_6^B*"`" yfA|fIi}OjAM@@TL|v3=FO=\x{_퇟ٖ-[ {ffL=6,D",4'H0NܭSRŅ=S*arN9awk1UQ N8ۙcE@0~V:::| ý{" q~=աou]vycer)|M kW_5G(} ~y1!@5rAI\0*E\e ^k{]*qxu͌FU`' uE5xCY*@,O?<Cn2/lGm{/AWΓO>Y5뿿ɮ{ڿ"0d@ȊD ( -)Uf5uncrL#UH}ݨ ~p sGoxeisPj@`_}#FNw_j۵X^yy jEY"h6;Cz$&g`.S21:)%.#*G$3?@UKɩ2 AgD:{~|_Jiiܹs|} 3'wq|GAE \Hd2~Lɨ&DJϹl73A81C-U7 h-HJ?FT* :Ui4<ԓGE`tzGEI,hh^'kjj2pG>"wqFuZ,LL@!M:؈LNMsjSqLj|89I['g~#AP)X2''Arz!' x޸@h3'o4Y#P- {٬i!dG&??M)]]]=>\r9H5)9oѢEGV?1sK5^{?jmIuTB5M\\5GLJ-1_cS(w1~S;Hě] 3U@ =␤$YH,B5jigK/ɣ>*_mT9VєZYYivdEB3(xCꫯ4 . M7$_׍I{_@XMXEo0!' .C1[H[ wJ֊߇JHκZ߉~A#És>$qU >'`A@do*9u4?.4s2~:6R+p Liv4{zz.wuW(Ʈ#0{| 7VW*ʡ"G`U!uK$#O?%΃FM閜xq5AP IG@$tLA\Qy28o%*'I*#8iڸnyoFh{nR67aFy{N>OJk+=vUC`Jʰ}(i1~3IOOX񦬢#} q%5McJ e_a "=rzCL۷y$|7gahfǪ\Gu[4@U:aDQ@0ٷL!A Ftْ&O|FE]$/<J(dr? 6$:0?*^^lL&lALI@ؽ{0Jt AH m7=rjlTN]Hs)P~|<8YZ!= "9^rsnIDAGe9}^c`?!hk'f.SaA(܇}H7t\zFg}v|Z4ͳ5^ve}r|YbtI K.Pxm ~ˀu䴷 <ڜIcvT;r}63K6ײЄV5t7ꮏ45J,k[ВaqkL ~ c>mwRr*SO$H/8ԶMW"~>/۷ *,,4` eǎrgJ%ifWn?ft"ݨeQeeQXd:9y#zI)%AU[6J Hl ?kƻă?ǥL1ef$>l:^MQaç_f@f!^7TGqw0 M(e#IK7 GlHgkt2[wE DÌtZʼnO}KR^#xX hEOj%>#|Ib-5k UmhOZ.1qJhIz uƏmK> GD:S) ${k, b^ECF3G'Io~#͆ 䡇MIɬUs1 Tmu_m?,_Y,=i}@?o,wqtvv_5^a3۷OxI|t޴ip]|cohR998/,*b AlZqZB {My;]G$M&S jʱdV*'[yDj0qL@T^ԕcz؂w洒OnυW2 0d.5?)3+s~>#S癇U>USjtڵ*H[n55k֌>0gSO<Mov :g3O}Jo$Əuxױzy)#~'KJIYjt`E.i`M&"UIz-JtL51qa(C 7ov=EQxĨ/d?O3faCfh]s5Fy *g?+|qSss5r7Ϳ/n]W")M2 ԯ}ke,fՈe`Q3n*}j֯_/^x\~r :W?Y#"#]u: <v,,*mdÊrޑÒ Iކ1BM(ր$Kro(M #}!T ٵ"E=y5#1]nA>dIvRKo }GӿV 佑"MZs^ظĹ8)9Rg;C uR?Ҿ<&6;J9)^"4M' ҈3ʁD9Iܖrid3$4&-q0BOkn~? L38s9G vq*|ӆҤ\]ŋ},s2Sg&.qMn[@Pqg{ohhЈ-$Hk}CݾضBjXmF)4CY)/{[$ ~]A#"ϴw#zKI,RN;])Acm3*-16cjI-94 C >E):,qs/?^hb1#E}zkCҭF (נI Ah 5to~c>o3}G4n 鹿ɮ$#uөH]'?(LyV~S~&Օ󻡅yubB?ǵee? .bޱeؖ jؒ"kGg$PPTxEgc^'p/3wjtamY",G7A*@8 QPP`h5,))W\qμi,g|i+r<VncT ?E`pKb-+dW/,-?cЂ~1,5rlnf="c=zcZbidUe;F R6B TAӯ(/Ka A742-lٲeǛr#ӂ9kݻwafƆг:KX .4==}" (@yK3k]O۷I1EBKJB[`dDu.R~\cHrTᏆo: rf!LǴۙe4"0.ꂋGͧI)H>ʒ%KFU<#I݆ܵ@tgҥK 43E|HX<m%։J311o6A-#oO (yD#dDZ%J*L$92aNUpA~I_YӔ7Ja(=YK 4Mue#@/T~#O|r'ې:?? $syןz)Cy뭷f{1#:?ILKac*j@cڧ" pg Wf94K;ۥ!3߆ #0g$ys>IH&yRs䠸W^1-GTF"ѓ耿4fP&4 *1aOJËwE@ZPT_K?@u>Vbo}[FueEJ_ ¹t@ 4-nÒːpze[vg=wW8w!qVI~ag{"xL\lQpML͊@"`bUҏfyZ)dٲeСCs_W9ӌꓬJh |')S!-E"\+{-4С0&X)X^͗cYBdl>LJrk~i 6 0k NT^Y2ѣGSO5d6F8@OVZ%(>t>P>#F'ΕkdkYof_ϣB'<ƻ\p .Pk{I?P7tQ"ivkL^x ~ϕ+W{χi;>@qrF2SNYcۇPjjN3&|?M5= w>QZ)?r@ =JhTwUEb:&j7iJ'ZCRzGm)sh8}Tψp:`EOXm d5; (A5UqNj)KK&3[S5Q{Mb4fy)YQC VوI]cQ烄DB5Mp!gG+ZVqL'Ln IxiQ=¸:KE+a $<>wE` Nh[\&/U.'x_s56")΀vҚnhMex~شF:&1(8-dw14$)XB[JV /QxdA_'(C@ h39.Waji~8$CJڴܨDj"~'mBZy 3>>A\sEjх@#^cBEg(B@ h?\t>$C*-}U-K&jkMyHjǿo T*mf#0 bDÃYɅ`)~*c0MW2LEQE XhRx)':>Z^%A{Y1 yQt1 pTX\LU--oiژTi*FPnɣpՌ $ԲnV+xQt 7N"Bzw?y _Yl􎕀FGڂJ>?OKgFiqvdA;XDfDA)Y,]c$&^>*Y$f2$UT@Ur}Pa:utuH]Y74óD'⓳UJDT2`ɩToE@J@CzrM6K)P̔u(0<"Ma.zŋC)ɜJ#TLP=QTW{OՍ>tDUA^}gI؜:2/*ýS'ͅEXS +E B$39\_-˥^*K 嬁~8kD>Zv930(u }*ՅRVyEڟ!rItJֶ޾:jP3(wPNC J"|隡(@(P AE0O+\>2򕳕h,!hց25ϳ%2(uFŏi+XJ,'RDR6֏ab̜^3;J3/Gt>"1(K @h dl*P#8YeMJ՘홎9A+c.q 50nLEd=gp"(@@ h(PsWQKПAJN׋Jlj\Ձ9Cy(7Fxr8FMrAJVԣ﷥2 hË=!A}ܵ +ᄀp:! ^‹]6CKyNM@la1L07ºKtL.$7Z%`UQzjυ@#ºbܲxM\(aа:P#r~Ò`hSs ]^>meL񛙠ASlTZHr]R !Rf 1(Ue!0F3t-|E <PAGf3S.v;9SKs`nEPD'2C GIUi- j }\͵th>8m1043d#ka\s"( + 9|'4edkvx#(.)$قb8)ABqK` I(%Y}9Ti@; x4鉼UE@J@C9B`!nʚfv.(99qN L˔N{PALjM4F@<`VzL3z4" M|?L7hIP"%qt!FAJN߉IAEى4F0S]VXEɋϨ_k:N-r]S2{l~* 1HԐxXhE (W@1PQ>Қ>ԃ zeE FO69:1U>cҘ>[ H|tLS; /wJy)@d 422L0N1VIze$_ZPvy0ſRnqMQoHdqF iA: Alԏ'D , 9 hp("j #d`R'FF&GקЂ2z efI3p5B :EU ZtL01lkL z4&Ѐi>P wѧYEPP#4W@dbt9'ArB"x|XD+(8]DHw҄An hg R,17h: V5ۂhb8;h?9PGkފ._(Z$S,ŷx5_)gĤJm_!/q?0lfY3T O0^ŽHjpfٝ# S `x:hNp~)(F@g+] 4zzS7} k~6Ь) ȷ4M42DlĎx\V.< >[E$ k.L0 U7Ȑt+ľ}L; }0?hCu0ٽ7v2=I^ʢY[ P4sk&z"0'ҡ^7 K= kBǷ`yx8qgHT|zC۞1mYyJFgUHSF蹮:E ZP-WRVз >wSiAmfv9 A0o)Ax 3)M0Yi1gǷGN%+Qqb 9Z%(*&PF@ hD_>|#ZvR1 *BՑ\ÚZ΄> 9=t h9?CH@BgWh@@ h4\ECX#PGs]}3оXRNk#l\YϧYcbd{ fӮe>,/FE8PjAH>zJZFԑ+Q(:@^rre;Gmcgd >4JpNxD4 ([0*#59JZ "x>1QNّzu܊@#40 @[i^$[9AǢYYN/J| gʑ /&Vfor^r/[8]Ǧ( % zlCTzH-ۛĐE:|6/F|T ?)070O(*{S4%\۠1>T%؇hUg@m~y+@4#4-` h ;Q#~^ױ:A$A s@pk~}UΑL4KUɚ"[4:AxYFp}SS7%EQh 1IF18N!BrRG6hW(*"$NqW@mDWGZfAB+(unqf  b´P[m3k ᓥ9]7U욱dvb   aFЕ]iH ̩%@,õ'B,ƧKqo$ }ViT.M}a= }rD˕k*s*4QcAT!h-_t)t"d="`q@IDATE`# hy^ (M4>N-*nhݖ"/10 L) s>%1|lۉ@z)EzA79yR!uH?y[K6 >2)x`:-ֻ AfTmK jW3pt:qdBIj:Hjʰz{+"0' >=X9ԂKĭ.3[J'sI^<oAp5GbPzlwS6vJ2|'W郉7 .d̓´A{(h36K+|M A@g*L 8|V/- H:*L$Фf@sjTSdVE@PA@ ?(iE  ̛o+(J@ɅLYYv2:3x>#r20 Z42eK{$SoԳ[.plV)F  \݇K 5gO{ Duzt[&1IФ&2]S,J@׉jAbixGAZBg[\@;0֏* &ymg!uI ' ԇfʫERG6 K4}pȚ3j'^l&4{IMjOjR闚JT,i\h"(щ>I"0m[Q=GPDP3t%@19MAnBSDU83›&uUb${ql h/6Kuh& @7KRPU4~+DL5ܗc }MK! q㱝1hX3@ Xl嶱uOEPagR<1}5H6-Ah,;32ADv1~P<)|KwI3^Fʚ'z*ah9_Y7~2y%#KV7vh P|S3zdD^4b.3ISNz-vNԱ,8.N8ϒ~ 'n/kcl\NDB9mY5CBtLU ''ͪ}_E@Q ` .:3;wvkz֊"0-mh!WbM\m4=$d:5]`F?ӣMhPL =%)I\UvdP(L:6Cց("0q(" %ƺfW$jT,DHmqxU곲e?SP.r_wЏ&P.*aZ4e} gȧ3,PE`NV?]Ȕ!ν + $wf|;A2kp:Wkq^J&g :V# ,50S2zJV MȜPxE@P" %ttQ)^C  ΙܨV,L&ONmu^?X{۳rl-1x;dl;HWjkYlVU#iTE@$FұF-%ue^kY9qPvx߰}3R!>oB.5zGԺޠ ڶjd1HeL~!LA^O(D˓-kW"7|A@7uT1-R|{#=gN ) ж1-J`ڥV\nigM 􌊀"P5`P1lGMwF E܏d&KoqD `ٷxW5{Cj~9A@hdب^"ћr~E ( +6z@AycAC[12zc7~,+nh|I?(}@B~j_}gaXuuJ3 $?7GE@>J@Qrh@s݆ !B!Gw2|2S @ ,L7s~7=j@9P AbG%\ӻ.VPʚU*"D&J@#騣oZ&$C9Monڇ<;%MK in˂MfcN0 9F}h6[$&=ȨHg'>kLid,h>3F(@"4R;jX^ҷx{qPh*[eR$x4t9 ֘F啄Ҁ r uQ''o)}x hEj?(D@ h0s)~ /GA"[ћL\jLNoB,CЪnsz!m?h,xPS\93H>ċEVTjٴi۷o|۞x aE XE Gbz7Ƞ 2%˥B:smZ6br2i}X -BBcd!A"2HjrbonAu:]89X#(!G ;˖-[ Pv!ԧdrLnvۄm.2!UQ {тD$wm9G=0r}¼n<[t;ڹ&BVWFA MGaHJ4 %RF@Tf@? |RAGpuZf}z"(@Ƚة[r- //\?|9v옼 rK,.{}ruy+@#p"6DX,(,3k'M M$51L:A]Bp]byA4Oɒ=!I@usИ 956ۗ =N%@B@Ӫtm@|I^zU຦)3T[+@"'D?ڑǰEy9묳Txxɺu $)Gȑ#vOʆ G5myjۣ 람Km7AHN2K $W[ĕVQO/в3|1J+y]Sħ '@ r5ƒAZ+~\.J!}IOg_'x]^Om |,٪.IG;wZk^+Ar~>,,S|BJ@:$CmꫯJ j~'JZv"++ dffJh3?C5?*D"jzUz:V7-)1GNڸ%3GNm37M|u &r߉7 biJ,Fu Hg48ooSLd3M bɣwͪ& IU") 5)䱏7mAHi34`$n1 %ϵo  0b>D,/ДzD{싂 EXA6CR)/0fۇY4#k32%].fEmi]TQ k0#șgiHN9y衇?$ƍe׮]R[[k>r'yz:E x@X.;sA^FMۇD-Y#~ɇUz@t@PIƴ4{*H# MMw* e= H"%}eONi l~ E94@TE+ Z!'u߻3u-4UJ>E *tҥX L4p7^y门AlECEE\tEQq1t/6 kNvrӡe|ă2r=~M%90`Z^([ } IuJ']K6'b1' s hv-\MrTV/VZ[$n kpxm|B,I#!@h*"J Dt-kUY뮺b{/_tյCHBi}L2 3̝y̼^&g{Jumï`%l`G! `& (|:uU>}ձ5@zE1cdUO>2sLA֏?X=@2@?q=bUjPP.JT#\w9>CtV@  8һTTf&K/WV/V(:onNJunФR9G u4f9CV6 F8<'WU.PkEiK~ΕJ0ti=C AUJBu)}3*ސ1$@A ֘(q.bS}jƍܬxruW衖0(*U h*yP4-@ ѴHUx"fE$:Um 5RvUwϗ8p\ve ϯ|^q$:H(ֹ+[ $Iɇx;aR )Se h}{M<HK hs(rrV>㡇2@'xBz)SNm娣]:L~&3wഛo=SMrʐxuZAҲZ,5)aWni4z| zBLvYj߫JgEIPe$K-w5hƝc` ,a^-zURZ,+K֩6F^Nz$E-ԖWw$r2ꙦV&asn. )=j^(Q*nH6Yh7WO?O<쳎YfSO=%=z$nIhR R3La(&L'R@{9JkKF`ilnPSKH w]j/ݥڪw,O%zlZh.# {wrAJLWUf5ejj LՀ4PVv|E9E&kEt)*EpZ.^7gʬ_zejD1KPy@zH`'$&"\-M,#gU#sd*\M'0Fa&߬)(OO3GHJ h޹V7|:_3!!$4=h{)tɝ ^zjVVB+VS=?h yg{5mP@QtAKrmV\>OMoE3M""M$KQ*< r{gM&>]\Rǵ-R:@ Xom[Y($@C]A\W :PyLժ'|"ѺN>i$A"{qȴi7ި rin` E,{w܆ɚ+*yxV9 *_;%Rdu/ L=W1OO,QU _j JM1]ϮSk66Kpiq+ gzf=n;VU2yfrgO?H4o<юs-",U%蠋g׊N]X]†O%"͝eFH.T-~gegJSiN3Ct_Bb更AJJҿd 4r4uT'??j:x,O/N CnW-M;+(ΝǭT#]"ӹ @^U$k  *GB璀 ԩsZy1YA[>nE5kKͮ^p%HBomsX;Rhe䴤 @K Pm)9G>&0K-Z ?PrְvhT;ZwLY&I1}s`/V/^$= xK x .L^";}S˃/h99hHUr\4--S*vJ-2KnHHiT@f#HvʓZHn|>/jf&sn_O+Z2ҝEuN.RWuHjPHHK hsx!e9d^BM*^ zX9g*~r_O+IZޝh'RҤy2H  h*͡cIfd 4ʝTvf)h=ZY wHF/ԃ|.eT_W22* {8$@$@$`^H lTnZ})bd Xt.k4=ƍB+.RI뾝/c4()ER xCPo(!-x~żGj<N੃eegI^B$@$@M!'ؑ"S3Ž-/L'+hZ%{j^rt%OR|H֗Tdő(YA/޷W"~)RHHH1T@}$C;:$tP+ k$DE [:&{ʡ1S&"7G{I>o\Nzh$ x"@ qV 7J#>:[/4ӳve:]q.9]m_͕e%rjjJ$3 @hnEXvH*?[>)%jm?t(Mb#VP=E@_ГUlJJ"#n=()YjVK˥!A-  p&/^'8"[Sc]vo]yDz<9V-fhz{T)]|$*hD7QW_Y48)y|>HHBА? KːIZ',TLR ($i:R:jSje IhO鈌tF_U$GokVea  g@VTmewG%N ^GdM} ,YJt=~>kY#'v.hG2Zs$sY[<HlI -o+'ՖUfd}OJhtvtvS$t'iRU#Eu{ʥfi9>JK٣lSRQ!4oVQ%KqHH`YCZ Z"pBCڣTKMŴzz<4Oڴ^KK_|FQL]vC|_l&KĞP\$_+z榸K=pP[#5E% VF@ky (OYJK5GgSJNnE%snH!!@u8*6&J\/%]ċHi[|WQo 6 [^{RW9d9-#9}*\,mCZ`$vyer":F6yeg0m{ 1s$ۜ-y9SYծ+LSR(Ҙ/>AJI0Jh"N23PjĂOZ߬u矗-[X{+䨣,X ӧO{oWtrR@a?&Xʫ3M I@ćIJNVi ӈww)͘Qc$xW|*גQQUaQrH-dȑꫯTm55> @ DS8TV.jU-馛?f~dԨQ/ѣ2k,?~̜9SƎ+K,s9G?|IOOSN9Ejꫯ9ׯUYY)_ 0@|I;}:i= @}!a?e~"u`Sd/!UA`8O%"{j^Pww0KZHpPz-G"'ac %X]6l c=&V^zI|MK!ƍ<:u`Q}\9Gq(s̑ɓ'СCeڵr嗛~_xᅲk.; "^4~$ P> !IFbMcTN]vۡpD#WrJJ 0gmqvnrJmRWR,NAaXZd2Er%F.4fe>/\Pj [AE kO7Y)>Jaai?3e2c Y|XB>sK^tHH DV=`BT^JԲY0( X  ߑӗ5hDoV6++2y $lsedK9E.IOVa:ZVV&Qٗo6I\+QPB EKp^qߐ #@`p5}J!5}'% CN+TuKRZ"1Qϓ0 rK4pܬLYP!3UysBpQFݏ1(_Oz-_|#(믿6^IH΄96!P6L .S[pw$InTnhNӼ giKͪ-*R'|' 6lKYt M:-DɗI"w5}^IHrnAI.]֠#@TA]u;!h|͊rhgRtZM\?T}DuH&MCo߾~ӦM$Pȭj=q>|Cz)iӦq @8:kdgJfnq[_'$J>,k~z5HuSM駙S%om\,}k$wy^OУG7o 3A uD; -O}ĉ[֭ *VP|Eos5\#,iq|% hH hC&l!6!*G4'?u./.+}n305+G.ִL1-H0vPFտ@uްWT1*MB+JNٷn?߿/F!@h pq$}&󑏤E!i)َnO. dU%%}.eޥ;>G}O_+1LQH 4s* j ij0V RHHH" rlN\iMEoԠRHHH" >崏iپ=о/Z.F%5"};"F$@$`gT@|w9%5I{8ߕ<"=RS>#ɇ-G:WO$@$ж-^=D <\2_SӚ z7&4n1m#@$@$ۊZ=.u{%Kޔv.P7;tm ЖqY$"xl-؇'.Q^DhVy佞}4>0jbaW$@$@>$@ԇ0 4F`XOmƮ}4') 4չSoi<HH P ϩ(PHu Ou-9ݩz Ǒ @`%v8Mݏ ˧+XAwUU<~Fcbe*]ZWK.s @hn%gT~VJ/?s5O[Hu3"^S6Ȓt],O  *QPmtZj.vF hvRA=c!VVJ={$gwDi-x @z33v:# '_EGLD-<=SU Ŵj >! ؄PHN#0$hܶkGw 52g]_PoVeԮ ,veL*,! '14J443g 9Zki; \ h$@$@v&@wsk5SenvBO wJM3Ά# PYHh@ Ni^lpr6rQ2i{.W,8l  $DmIj4o:I tePOe:v,OV? 0Z@Cs-#pl-a!x:Q_YR'3v~Tr$@$@"gcWI띇ә{,wTM vB"B$@$@ P̆{H@ӳ >^V+_*6Ґ8y$T~,#UTDb !@ ReZ9{e@^fwA2L`)^Վ~,#%5y  -T@C~sn /SP:NLjV%Pl[T UF 6#& j;y%vQ-&Tw,32D? **dc~)e?+ U@WZ%6mKjjj[@@& 곙:tKܕq>5" %)'ȍ _}DTU]ϚM؟I˯.\ xG (ЧzJ-[& /s=';wn<*$IT qN*vp}۱jTP(W !t ƍeܹK.;[ow:x pH7Փ>Ag1C3~gɭ0m@ _^kO~譨r5\ZiN2PgϞ`_07SN |}Zr2S_ck7B{553/^_!VVVA{8 n׮N[ :tǎvݛ}Ɂ X8qOc%JM. N ,8RәڢW   AOc'$`'T@t7[i.v#ȕW^)>+nGpYnۿw^YvCqvzj<3##C~a~'?tEO8~zpjjB#;v7$ },--5u~UWW ,qZJv!%xVǖ-[L~_׻]w% Lsy'?c'RRRkgq"ߐMPɍli@YԩtfttGKXTvvر(ӟO?믿^N=T"l2s0`\{O;|>l>|9?qJA=묳Z`߼yyN|& GMJJBQڱ_0'7x:$u ڵd}2k,k9#cƌ1|E)s =LJJJL!@`i3O6J&etϞ=lIcϨu _I.:t \pQ6%#Xtygɮ]%~/^?ԟgcU;4墳^@$''/lHgꫯ)` +A hoAi@K re l!5oD{>ƞі@ | ߝJu§ i3KCСCqE /݋/Xz)y7l|<;$رcMr!9VP""֨g}XL n#Џ7ӥN `/x׿ա"G(۶m3{zFu$`a+?mp#j XFU1A:D! TPN]#=7v#gpW>X($lL "5V,3j] PHHr##mȑf|XX-) /T@E < rqIZZ#L$@Ԟ"   %(5 4 IDAT ؓP{WΊHHH0H  sDUڵk\hQo&L7DpT @hqΗD ??֭IsNٸq 9Smf'Zʜ2i&W\qY2|opѣGU.\(W^yO?(R: k2QHHrN$@233MV#={cփ7hiSeGujqts=Խ+Ϛ0.))׆}uZ햨k*[TQˤUjOOO7Uj=EǻJJJJ&kU(PbOgҥGK0&V^|׌۹IHhH @e !u]O.?ٺud޼y-?>XGS]h|(H fcKw)?ı555&@H"Yf̘!r6WCk)/w1shn<H/?y @P9w\/M7]w 9~ߛv,q e>%GQ^^Ϧ `2>G(rC 1C$R?TQKyMzc@haam$!y Y+`,5WN>dӧa~zٵk5 9 *v !DuC:t ,<_r [o%HL$999s9i,]#]H,˗/7?gΜ) & w馛%p;飏>jPdO/X`V꥗^Ç[~‹KP5Dcܧ  *DABJ#|UرHeJ2,Vp7B,G U<;%%%& /HJ ܮH,R>1[x:+h4IrgNY7בO)6P>,:=|!&T@nq$@&$#<,Hvͳ쾜O;)$@$@'%3$@AJADJ! h[T@ۖ?N$@$@$@!GK!w9a   h[T@ۖ?N$@$@$@!G hrNHHHږжϫ @r&   %;[w]IENDB`ggalluvial/man/figures/README-unnamed-chunk-6-1.png0000644000176200001440000021344414367761414021344 0ustar liggesusersPNG  IHDRz4iCCPkCGColorSpaceGenericRGB8U]hU>sg#$Sl4t? % V46nI6"dΘ83OEP|1Ŀ (>/ % (>P苦;3ie|{g蹪X-2s=+WQ+]L6O w[C{_F qb Uvz?Zb1@/zcs>~if,ӈUSjF 1_Mjbuݠpamhmçϙ>a\+5%QKFkm}ۖ?ޚD\!~6,-7SثŜvķ5Z;[rmS5{yDyH}r9|-ăFAJjI.[/]mK 7KRDrYQO-Q||6 (0 MXd(@h2_f<:”_δ*d>e\c?~,7?& ك^2Iq2"y@g|U\ 8eXIfMM*i_@IDATx}|U͖-E.؎ CBOB@ B 4} Zz tmll{,[}w#w{9[n.$Xz ~5tu`RWW'$9yo37S gv +g=" 8]&>wlSCC5܋ӜPYg}f03*X:ןe~9F&%%P>/>#NwKQACq&(Y\ruaYa ߫۷oKI-@͜gy9/k޼yf~͜e=SB9?ux-[yO9\`gE]d,9f dgy\:^@\,Nݮ?Hf?̈fk+Ln{)X555s-l,ihprn'^ֻ9waɒ%csx=>3_uUPsBς]'|O'gqN2zWxᇭBs}lY0z5kž}YgmoVS-bf& ceddX^{zoAcfVCshLݗ-[faX0?P⁑|̅}&S^~>XV{>'?`#G4ҿ{?uu^O> X_J߄{>D<7_W_TE 8{XU L;< < /qgmeffI$8\R(oAaI5k сÔ1,$0 Z- 3L,n߶mu饗`ͼYXMMM 1M@I2z ,c\&$D$0Y ˗?ss- l΃Ⱥ̹~p>?7$Ж+l6nhB!a91\`ϛ=Mb`[IH)_N6etf/"[h_`6$9p s2 3J!:ꫯ6"$Y_F ^Dž]_pq;?"¤ƆҖoۆ[_uqW^igk/d޻đS^~esM@Cm]MM#~=U~g{->ap{a>*V~xm&P~,'$^N9s !'F@sߗo}o߹ /{R!γME 7p8}@L )\oKRn"@+J>~QG}TNj"}8xIÈeg/y\4 ^I8[H-h:&ﾽaqЮNQx]ͦL{~z_WT^x9餓>9)1%FNj0Z4.91e[(͝9s'ON?6}Ym S`|>nIOOc9LEcƾۦ(k{/_np<ꨣ1?|@yn7~Na6U|͐X 4ӂ ]hMbg9mYv g $ u=P7̷?1,3^.m(@BP'$40Kt7xTdp_$r2( '_w}!bZGo~¨R10 _a@E@fN0A#r| o  ӱsU`7QLhZN$?x(ZD$۾Bb ڰDb>.9ɽsf-~U6|$));!)役L-"NBm) r[(xC{:+)vs|tMu7D?(bgTi}N-1{=/Ծy9E;]y.+@"Pѩgϗ!I'0$$R$Bq"Iӽ~ s`0 ,CFk55N A_sl'Pj߄R1Qvˤ\`It"<ݟ1_Tp>FD$6Üx)A 5uxi&IB14 JmShZڥpWDzY_j²9!LuH8J SNA ͐O"|D IN!ygYF1.$d,t?zwyh;o>2E<Ǚ% 97j?ЅaH[cny!0|=m h?Ӏ vo}y~D "/ E@b&59C*ң025~ d;jlmM^y/$;x͹?\_ h>IXO=Tcf9$,C+#L&M 0ͣs_RlM_oLƬ;MCDdW2ݥo2e:f{>&&|(ˎgB01ys2;@3iBV 4;7;40f0 #epcYoK`o՗is)v?gl&֌e>qd_2j>fAn8ߨ`nۤyg0xa M*ެ }OiBsa &Mf*V<8πW%zVBmݟpng7u^'r8Q,÷Mg7~g;vwIEP$VjTh2"G_P ~X79Džr 6+ߠ!G[/5H oje݀>5Fڮ }x5-~O]]Ns֗פknC B &&ߺ /`/MX[{o;m6 <=VP$C{k@,ST>4SB@A*fxj)=NPG@ ADjt\J@+bn/?g36/]ԋ=h9ߞpJ@{iک$7h v!g%ر}#}:L+" 1C|+L]]^Są^(lYlyrM.V g% E@PxC a4K,/\=X?Ӳm6LDjQz袋<_+”q%ȫj|f[o7xC,X Ͷ[nE8׼6 |ժU7m߾ݳ \yrlbd;{<_"v)cÆ i&S?]7(?=FͲ~ŋ=ݏ|{<j48 7*x>?O=gk裏塇r-_~|D]QE@YuQiHFRR|_5p2~xΖ

$G$<&$$n$?￿!6q2G"}zq,x8SRR&^gѤHHX2p衇 (IS?3üy>0d)??_f̘aj4}ܹƜvcSIHiI~u>?{!6A1~ycg(?vZVQE@rmhj BcY fAk=<۠]iZm0X0ÛukĈٴ~uẖe}`7?n3ӧOcx-ls.l#G6Z mbjzd0[ 3&6WTTm}bVs>?܂ͬBiYnY=M`m9s"kVM<h#-{Os;94 )-v fuʲ@\:Ȱ"h7&Lj5\cLY}ݏǿ=֋4gqξh-|yuAYv*HQsYgYC`֝ -| Z/{}#W7EuAPE fHPliӦ.5S4%a3BF}pviNMnbUZZj̴TRKM?2yd ^;FZ_[q4&gj@ꫯ܍ƌuKJJdzКoD 15B--5>h쨍NϖI={ﶰc{)d9j ˵ZX/ƒEZZ9bk8 hQ~ ޣfZ^ ƍͬ/bH{yqe/_׍6 9s3Zmjwѕ e"(@!ƊzEF4;4/@h){A_rJ7?QYYi^4T&f֑H҅66R6 X)..6&K{]WFAiNݗ]v}לffL6䆾o'O r# 4C-F{syM#8˜I}] xĉ93Br|cҌczýC|Eg 9%J|L 8vbryG?!Y}0ЏE  e6E@PB !4k֬1$HC>K3{!я~d*}5NGrFK/f3?jHjƎ+կtnr_ jG &;Z/أI=#4]%K9$X^KE@PЀZ.FZ8٦`i^Ws¤F&bFPShY4#,/[֏aF3ºSK9|SoF}Bt`yUWy43 &'41)I/BWdžLqN-#YOҚ>ăA-$R3Ia)vrԖ8Fv Sk0Isq gOJyP=i |B?:+XK/>~ }ݓlCAL,?c|,0 ,]S+" . A@¤)G- չN!v2ƿз dF?ӔM2Cs"}(bH.Z8BŲF8F^3#)/Mt6SOD/BL2g^iHx _Q$s$#ieSP#a5O@ NNm%iL'w jZĐLD|>yp4(r|kvW6jIf=/0H_P=G|FXn~$ć>t`:V@2}y㸝?y ,t("0$Ak۹oh2(WIW/`BGJm?ƎjN<95oL O S.v<[dj94 ÎUP5mI>la5$21/S< Y˃S-HjIة& LŠ -{m@Y_]~Wy?ΏֶH`i"(}#poHEI,5mex^? C@5C}\M@*++#(@WWN#(x1"("(q8@"("(x1"("(q8@"("(x1"("(q8@"("(x1"("(q8@"("(@FRַY=MASx+&@#߂IMՁ3n[&ɪOPPP`~{?=Fȍ5ޤsE nعsdeeI~~~ܶA+OR7bPPB@?⪻"("?J@"("J@㪻"("?J@"("J@㪻"("?$Bϟ?5f+5$Q쳏^f`XdZ*B}}I['IIIr 'HQQQt/ /444 굻Qrss==si kE?h6D\r= Շszը"𝣎-kDV*\{]UK3@`)wҥKekcՀD7V j!'O$/8?+e/W#_I,%Y$&`v9a9%'R SI8sYq6CCé ɳ[9 oʯ^8FK+8QZ[e=, * h!)O>wqëq~ZpB9enݤА`8 'pTi.hG{JGBg̓9 ˑ̓23{3 *YdR\RNWqL`(3MI[RܮS\$i^^^B:C%1-Iz4TǨ%qp: ْ#I'zv2L:SloiC2sY.̐B-YgGyDr;sg 䯿r-~[nf),,{nThe',т几w֜SIiE8Zh*WlwOM՜'vF:qosE|q;ȑG)3gΔ7|S^yL9}eر 諯*ņ~$5H뮻kQw tH`׋&44[4ũE) y5 KA:W66 !|A[;-7G&dK)&vm,n4B7)@\p´d6mi^{\}rᇇ' @#4{HxLO1瓔ҬO9}SÐ ֳ;2{\Vߞy jHMb55q=TP!qFyg_"<;DٺuZl)((.LN>dS}g5_~.׎QKKKsunP%^K(?ў-i@P4RsH~0Š),#8h'U6cJ/(]k׈kjo 0ׁ,ףLHmE`DjuBu{j&Ԇ',u ~>lٲE;s7&qZ>HM5{ ?4alAQk3~ DCMr[޺_ijDxG~TlV#U5o#_{d9}+pX@N5BMJP(++3R>7lh-[& `bpK)_w3}Fc"00~}!/LJ7mrP[cj'駗Ɏ(Yd6p{$LII,WւB=-C9X@[I/I-xsSN@B]) %vq+&33<ۓ̠ ܇CA0 =c"Oa!dD:/;wxq̕<{lپ}{8b56|st"mFa-_b6ݼYzLG"0 _bX>̐Bs;VP$3)3['rB*4JuFa> (c$+'HVPOBj#6|=&3+#|= mq5tv'!x!5J^_^߀4e'$mްaL6W!7t}rI'}IQg^gP__o.3E "08("\ZO"@ j&Bq/gQuDR\c, '&[/>{#? 0Y:p 0#1 4)~qs aȪ: Y#v8wNqBN2k,気Ir> =A$J@#_̳] [.ZOxJUrBu1"@a@RFNܗplk[9QY˩^ATȨ)ei:LZ]uQ2A?gHrg؂bxXi S=I< Ԉ2^EJ%zmE 0 h=ivRx,g@s; ͍1CO:`|t,>јft"^6F*e *R9rQmjwF!#XaC+dL*𓞱BRyHL v(}U4AUo +a71D;*e <ݶYRo GQ%i˶WmG)S"Q28T" (^:(D`+Dh0}"_9=OB:qmF/s^'3?xI6qlɳ|rʛ T,izBG9Wh1eDb]+I .s#GU$y+dD46#&f~*ˌh5džڵ˘G "_9=O"v@ *irT@熢d]B6fwa1_0Yj%/q\d;0ǧAӉ.;h k '^ah)yn8[ gY?~m~q́}I=P%:Lwtu=?t*.择?3yz0aUE:,i=RR 9ԞTTQx@ზmC[aE`Xb)$mq /S@f>F;ɧ"0hËz/F9r+|= 3c' )C '-@Pa@㽸zJ N)ŃwA%Y4 łaϊ׶ׄĕ-IAAA.9 4^j<K0hR-!S6WƎ,vlI/ɩ(v*;VW#sQ_ o!-7[9MQ %C}]ߖ/XhF `r^ר~Ԩ $Y1@L"KhAA!hAń ,"!kb|uI!m(ay grz4FI폒O/Xte OR yU;df1c哢BӞxƏ='B6m"F.=cpn@saBjRd-GqQZ N)ўү, 4yMnOr #Fʫ cL Ν>l3"{}`G(VrF\v^6Y"'yN_EP"cw%ra/1|@-w)~1ϛ7OZiiinXo'/>֩ID!.  xО@{i!Z]^֓capP,flwlj4|gŒ,؈QתiAs l3)R!c̝g.OomH!4dkti_x iowF~I̺r|gxeee^x` L-xVw$Ӗۡ!r?% KM HPA,`*8޽mnsR:v<#I݃;U.}$q|>[~g!40`uڅc23dRN|Ӓ3Yiyʇ4#ȶf#Ƶٹ"*JϾ.G6|:F0e[v]KX}=z֦2}bZAB+~#;5L9vAc fX˓<3'I+Pimr2TϬ(F03xi1RCي@hRʟ|E :pӵ~Goݟ4EA>O‡ %à Pxb5kzzjټy̝;WVWWs&M$Ժ9%9ct9208cg}Vz!%}O\ Ka^Mˡ,rs$#+D(01 ^6'ڝ/G ůsfhfyk&L̍uGM0eL)ؗ9WUxC`,L-֖M҉@>!w:&c]EPA!??#8g̘!M+/dڴi< %\dvmrG3 z6tW VhOȩ*'x7[oU~_F}4 =eeH&Bhq!@!9$oH2uFva{֑P˝ U]c>_Xn2,iE46I3]|=' 0~^xC*گ@ lc+|P[gZ˕M*5pW5Nu) R@ ?mrEy'^z#EoH)Ӽ0oY^/~!{ｷ9SN9Eo𜨡CHHL.׿U>/RQQ!cƌ(R-Zd4LbIyA5GJʄ 2d*ZBrچns.ieTˆfYbh&JtTݫJ y' .vʥGu%Mg(jX{Nrby!< !f;,#dZ7~3z&kX&+ۙ=M"d`=D;z[39n,;^6 <|=;6)C@ (#~aCVHӄ@ S揜3g' MLԅmc>JIIe\6ns`]P7t?ĉ920tIr%H4HHJ9yRMϜ/ PBh;}ɩAj{cRڈhy3{iSyF$~dzL'5=oA֖,SDU^l wZVg8=FxN4`;0#5~Y[<3-倰fC;hFQ= JT$,4v;uV@0>p/ /Va6n~ìfgi]X\ǃߋQ'l5ejX7HS.}=I+(`hD4?)1es2͛ibv h+x̟?_#5`w+b4eeE^{ہHM7/}ADhP&Q}4qdNb4 $[;daC47?x Ӂ+1 YRX8h[_yiO4!QXl;%K]9H'VG"~e+%YGs0"Xj}h[@Oϒo36/#mrhmVb\Dxw"QA!(PK#)Ԏ:5q&c//V}9<&|b-!aLb%81uYJB,gN$95c6jvr+ҬkwLnj+SƔHz®(I=4$9w`d% SzFnis$1Xeq$0NG&@kUfC *jI- xF4'! 33=r,3 ZZRHnm׌BeԚG?qԫ|7@IDATƙvΦ&mٲe3dȑ#&)7vXٱcsF牉nMom?QyD7WEw'M V At/ =k& L=2*L_8jN̟cwvBqe0 UL ,ur?SRY܆8'`J$XS0%9rsYF޽ͳn|Xu8FyDH.nǜ:cBi=W9l+׋| aUҊ@"7dB 5>A:*ҭM MOj=JN-IL,P;.J=$+=CNc܇~d$MӖ!Y B ʂF)4kfPv % p?ycԚ݅>p;NO@:.Nmގ6|xcs'jC8筘TKnǏ/pjEGciCF`4ʼ-[Ch~ s58v9 hC)c~|fL";ٹdbNSS"H'IJ""JkmýԂ̛Ӱ#h656CK.~-@@ez~@b!4;![v>CHХuFƘR~a 4[US7ٹr:4Hh ߺ8 > i44am$Q͔f&|t5s!M& K@-49~T³?G*"{(>Euxe4MN!vT*sUШ"n;V,u<ZW~F8E ( ZT| 6H qi1)hC望biRN_Oj. n =ByךUQ F%YۣG!@"g 'BS䷺prAm2=, ] ԅs5)db*,0 ewryÛZ*iCEPC@ hxx; njjQR -䲆F>1Z մ@8SI{- 4ddʛ%r咲m^E ؀b*L00dCA& 'ƝE`E`!tu6'48~BC %g6seCC<)΃GxfV`GG ѤB^Hdz۩yl`N(XA3A&T|v{x+"[( NDA!NH҄1Td F(=M-ϐ'4-4s# T8jwF}U2֘'u:'FqCTE P=_uub[+K[DsΩݞ¾D>/Zbmꔅ-r8ȹitnq֥?~ H zN!je1Ǐ5e xF@ hٳeR_6jن LTa0#`hMNj& LhOzěNz6?OIÁo jP,ݕs6#cɁ3,inհ4B[NWx7 e9G:ʖF ۋ4RW)ǟ'r+!|(@PcqRm˗-zQݩ(A@ hD`BY0]D2FBOӥi>HZf׎ ~/r2ȵKk5]84#ܦ[嵾@#4oxo>}ALh ƚ@"r#/ٲ  GIHo!hӹ"F˜ߛdrPAot"(ꅆ@!@sx(P %FSio!DZݎ[e.HAҾPM=Di9 \<1UZ9E/J@¢N̼fsP23K:든m| $VZ¡@5mH6t=HPh!%І^K 'jio=)h8ĈG@c);77Z,ri/k;=csA.CxcH=@>))ǣ$Nrd *"(>#Yܷ$~;0|!|6 Fݦ~!B);1%òQ @$$PEhЎ"FːڥAAj2ӵm8:>sSHNŃt#XʹJGjc[:9' Ѕ9[ \{] u7xCJ$OG_g"VR uReq1PfNY:Fz*'c)!r0WHZS!ف̠ { 0\:ګ(7u: fƖF jއswqR@@>cцї~*3S&FL - F\T^wgXiB7>ENQyBL̳0mv'Fn, {g#qH9Se!j=Z"0(tC_'hB7HBi~_-e7qԈ"@>*d.[="]'5 Ef i9M9Sh*A by2ȍsS ?BSH{pF9rPʉ`jݸ'-2Z W5ŘSwkc2p.ubs.p5vQ>jZs0墔lU'gNQQAJp@W m{-%W);G)1Rt q"{,)UBʴ /]Y W0*=qe^{zQ!Y ٕ+9yRfLi+iX*`r‹>d%g2yV!s75ʹ-jA* $/88M}ODtDG׆>mr+n-j1QS$+㺿z[Hs@sI9E|`tKnШ}OR:E6`YSEPߪV" IO%JW/Zwv2hCroM(}ցl٬ΑlVB#FK}2tdTbR#6 ^:8cQm@?h+*)4R+R5^j= L{Z֞{4 ĵIjVſo/w储I0Oy;}7:q./(~ı*"]F_-=`У@B H+/l"y I@l] e/u}w#95w }M fu9A:GaNf_b׋}][#hG_GJNEݺπ $!$I%YM&fN=D M1D}w=d=YaZf⹛lmZ+A6hpV\wH;"ʝ0IX-&9p>W/;11hi^4 cP1 %ITbUW4E,a# 9xXho،&$j[d4C TO!]哧IQqFɀ*<әp<5.iy:ؖ:Ak`{ e( tpp٫\R}Y($RSO3grw7,P~_r@'2=fEZAR d{*Ъԋ&N0>ELH2FfMwհ;MVe.CUE zSVkDŽSKpi| g}'?{L=~AU]w%\sM (rGFI+A}I]&3%+  srOx:ab~81: /*ޭD#[Nƹ`>KM:z^Ί{q_/U b~6<yiܴຌ6^ wlO@%YN*@BV6,ZH^yٲe;@sW_o |0Eݾu!ҽ/`k~(+$m / ښ*;[vpV *Bn3[quߟ9>(ј3qh-jFLK҆ P!z= >*:pxhѭЖވ+eЂ&/X=A\|{Y='Mz,<{LW\#kx$׹-IT[aq|2aoގxBl9ŻdB )ٵkyr;0yᇑAc{Wȭ*>=Cn68q_>RZZ*sN)'/&`$@ oAeȌ9AA\4cPQ Ҹp|:fUX AsWW٤41@nq y kh<2}UޟTh}?yҺ:YT$,b-ȍu%q+B(A !hwq)?M 壏>*uQrE< ͓իW W_m 7 aҽ⋝r1t}ImjfR BZstTwDu|9KAZd"@cA6${kAgFP-F6c :sELE@Fs̟?_>#wa͘1C8co@.HjKWX \bu]u~ЂNԻrre#:G4ݫNܝ v>DQI~ F- ȮMŵzH8B U;ېG-Ъ*/J@}Io]~O?-pԈ2a،+K.ѣG{'wq7ρVepbA.aNH1m D_m%pb;vۣE׎  GS&FLQTTd3ґҭEϬ2 0Fы4?SꫯQ0JNNg:3/m_TXԩLrBЁ#4htWhf w]%%v祸l|^X6~PɧstX11B"0؄r"R8,/o0k6GHb1$ji$ˇ~(g>sΕj~sz뭰&,8*TFvb6Ny :{L^* Y y7AViBO "$|x|/'BևS7Zp}Wۭa6@~KwX4X$J@㬣-H7|Iӟ$H{y=C=ˁh'i(e|o|/#!D.q=~AJ7> qmV\.{+v]nеKqoHUkا pA76ұ:pTm"@@ xXtG`C[YGʴ'LГ+%\t`^l4EddhI߮O@D1B-*(4_پMQu9=]Fv$2jĵ #9; \-@Sٚqҏ8F"%_;2dQiR̮! .㡩5e,)\ mUղ!"}cpbaԕL 9͐LG|mm)8˖478B7+-h?~O'J@G#}HdKU#S"z|A9[w[D2 ZңF,h*Ck.C>-ZI{ 5m `2Q}NvдP:j0ڮ+@#P'\s\E@~q[[lOIKe#$rRVQ0@7oT"n:|]!eoeA"/Gl4\_͎vq}D:y[ɧ 2Q|dPQ@誡~mU#I/#'H@ae)'$r9rD7r2kg~CBAPNY:4?Py_'Dj)E@@CgTgd$z?@U(MنqW&sFlLpΙGzA:ˡu#f7F7Z MFz7^&m;ɒkNK>v;4dwkB%}{jCD`3?75H2FV@~)`#F\u0ӣK|9pzI=wWedykzNoo5Y6~_d?T)˰))52x^xv#Iׯj +46@"F`+x6cd3]R+J@g`.=ZQ_?_WlhC!@e)_`α ^hBT.P;4(eLh =qx-D'ޱD׋{u53ht"B`+ p)BI+%ç/%E G[.9]2d9P'F,ʖz^B/R#Y ? u=d޲5j+dlč`%ז-&ROfơ9gGo%lMMQQ"@+av"uڞpz"(ӎKjr? ⥵DQ-Т8%$#C3% )_ffd.T&Κ-3wL ruXnHn) `E 4]x,T@ӣ8G@ߓqށR6h/YT55iRS][ RBv$.,Eis{/q#Qx὎/k0~y%pre}Of&3B} +""^._AWDoe=AES$B  I&?OMפ{ғ~_*u}WOUO=QHOr߽!M|m"l$=mLgu",MtAIByu % $mQ*MϴJ;ZeDusyU)gFSH\UR*yƼ kp bӶJ7+hF`_),A|c#pP/v 3'iw&49̃v332+cNT!b>PLWq8D@\wBy4I>^q} N_}ƨ<{c^f!NENfR$C-uIP J@NFA쒦nؘ\ QX6$n9dnY1 ~r d IW9$ZoB3>flOAJ@!OڰV5'6,dqS,pGsޥ0Uu["qAkqK d [=q@"PlpɈS}H>zݑȼsթ Eڦ~7RӤfWcbt1R>i~*"pXƑ6-n-~*ۛ6PpA`N hlٲ:Zܺuo߾(yO޽{' SO ۨ(! |FXn* FDnFGA̎u(^(9,-pQ@ݨ(aaXȃ>xmf߱c\qRYY)]w<[o[nE+XE`:yHü 7h=꺻hyQ:6Sզ&-jzzAlv$Cpл0$/@˹oSJwٚ+6WQ1LQ)^Q~=Yq\CW<n'yNHR9D⏄;555෎=~8Ë {e=OHL0Jtƺ F~ Gm;WCdpSVMR@4̑&yGq5J}^zqq kJx$JNNB .9Mh 0m5kPY\\,yceS\5*L`K^ArzO~>h&c=|!̉EB`^ h_{ GyD8 Nzȸ%)tΝ;0e=òqezD`"HM P:ۍ`$R[p6-گU@!&_BTQ y5/]T>W_mIoFpo}6lϨlYx\r%ᅺ6x/A ѸO9rVOģV<t ȨUp\24E}ŔAl6/iZ~3F`N (9YS|4~${Li=D.9s Sy@+G@6%+mR}7#"I ǂx>D$;DTơE\EP `zC`+})D"̫ ބN+4sn'8Qi"p<^y^:a⫽YFy4L1y]b7aD*)5{CGE*pk@_l#nE  I뵆&!# hD v)XNO"D H3R^"*EL}*.@"@mL Yv" Wlaԇ)~/Zb4Â;/ȫ/H} TE 7^DaD[(i $Ƒh3t~+o/:G+D ׫T| 092ȇsMfubtiD*hqD$L#>|u$$IHG_FʝA@cl|'s"? l-'6E `0^аt'TE rP^x1s}4AZ0 ;x07A&D(@> $FTE P_ǁ`}A{TpqԮF f-%S=OчTc=8nV"(oE@l@dz.K]YD Y:߲p\> 1 JܪgrPE'Z'4#t-ڽ /ϡI1^D!1E=S9iFe->0.DDz&DATHL ma8:JFѶ7̰gk~r:(xkD8py jˉub{,cQS9Gc\ب$ X4ϗ #ҏP2UEP"(+^(KSLҋsoJl6 p榔W;tL%DlNs|Y;@ ًm= ĉOD k30r5;BO\kl>D5 iBAV@RnL# J@I=9.^տ(ᅀ_:9FxP~wF*Q#QZ!wI<@LK0'4mYҔ*M ܅+_y:}pLfYӍdCRMMQMQUԔ!4M E %MS"%sBfAs3Qsh2fʥDL)x2)b6Z5G0^Zͻ_ңftazh.G4zZO|HH*j**4IE^ )c$&XNVEݬDJ@#~a.|ަܝ)0:C;x4 z<hmtPp7H<z;F`$S;k| 32 R 'iHQu5c @T᧚@eE@νБ( l'5]Nm7h o˗&v@'rn1},Յ4[wҷ>r@0JļC{ ]v;td&A#:/-q2aC:8VkQ5TauHA$IpH4P?թ#-", Yw @]JН0GVh949f.trY38LB[h=I)Va삉*7?naeɏ~#)../S7 Do[>Iyy}AEN21Llk5H>7 5V%b[k<|V S wׯ_AbK YAl~Йt$*J/=U@Z8gJ,~Mʊ\6Hed"TE0EThklc}dO=DCzzht`D4-_rwI] ӊիn2)--]7=0'B]mOf +؋y.,wbꀖsE@^:Xk|1`^deya&pSKZ}xjTju ָg_<ˎ; /nhhHn&cg!W_}TVVzl߾]>O駟.\sXw벟c++<'я "ڿ۷ ۶m=;;[.ywݻW6olgUF0ƷzK k_.ȯLqbk|靷CYiq''"Y+;8v;.9n8ڲ(ry 6c1 ֙gӾ~("`E@  ]V@1HD2>hh2A)B.&\bޏ*.C3r,;pJe{Z$1Cg4 2 998#݉=WGz{'\`|4|4iꩧ䢋.HH2NRJ)bhBnz{.4g"TRRs=wYr,DC0-c#.aGPL s ?SຒDEP+J@h"k@X‹a^1=W\VBt4^zK|GB@"KY>d@IDAT2LC `EIRBW`h7yN࠸Z!Nl|"/ODv,m@I.3]wu݊;ZI o~Fybk;uQ!n=K_{hrl%@QHLY!`H)nPSܤX8Lݥ-..YdLe\02Ecd={~]V׍.ySQ"VR$$|A B"GG!c Vҁw61|pAqLR,_<;X>̉bls$07 xM| ~_69/_.'|G>P}'>}YPl[ k3tIFNř^O~9 =s=T |W;y&O%-4=`E? =h8 洼) ;^S9Hp% ӽ|tqz"ߑ7iLe,A,1i_%BK-(I( )K 2nR[j0yHF_xʒsN1f+-a~|+M-Zdc1l'҇a÷[ 3Ф j@ -[ 5 tZSk6DXEťӓOސW_Q9t, u0{8PwHH6K&?N8 j"QdaʓO>)T&DoGyuwg۷ .7xHCf͚nM.f!"4T_۫:_8W\)/5|_ʹ?2޿P ,-)$ܝ$3"qx w O("S3I$ŞCɎQɋC.B9);S?@>Z)mF"mpl3r—0@\Dgsxow(_8ߜPel4EG#,B_0arUW?y#MMAg\q_ %'ɭ]hZ;ψg>XG%I5㢦ę&{ \' b?~Q+*xA$A I%RO&L{^tȫDR帎v2XRHA ${|Lr-2h?NDb36QBsv3CӁ.7+cPޭ :I׾5)//.ȣe˖?nl3}1?bBjjjEs`7z!yg|%Y=S6~./6 P/_2/"(N.Ihaz <_>*g}ֈc2g'Ut'PƁ/ 3@]A_7};{GLQ%_'k<:U?; tL%ӣA:O͑d?tWWt!T8x:ԟ@j30$;!f3`ofUup'//xWRw+_}{/|\)@cHKfE@C(rF[ ?C3z 7LB_,2dSSt5#1~<1:G}h&}*hh#rDS[JЀ *b4>!k1.{Æ _r&&r:(#iQvLM$م?Z {^B H~12lv;[M V/:3/W*RLc;ػg&O(Ň5pthڙ"Ps7"}fi6 KfRـ % J!S|yyu1$˵^+bƁХv_r+DRJ lE l\@B??pR6 (SHBggl')93:N6eɩM`! b\r 踔`a:Ԓ)}Y[3}#ݫD!rK]O)a I|ȘnxB@fu9ɬCW/amYf[S(sr徕kق"WvDNJbVό.9&$*L\)yOo붠"1#Cғ"J@v,.8k`d}S|M4^tػ>F1@dԊFɓ:J*FM1\º cS$hB */3Ll7#A[PRaFicE gDEP!&!3'٦Mc1:|m9|]7hib q ay5+GݤzM 5if$BI>m)BZ"K[{0cKm"04BY'SQE`:NN3+|x\ TV _|>rHvgJBj,Ӡ1`h4;о$]ܤ2ڡ峠me>ϲ$)}ԀHƑLg?ePXE/X#6WQEpM@W$Ls8GVk{] ߓLU2d.÷sFGr& (wafhw W64{~.˺(1#-H[dfN>9 D*_EOI7V C(\APh2^M/}IXÔ){HH{9#䗿y2RpҏDm86NMirۇ0 Q?8 ڌt^;#\:M&=MrwL !}q@> @@ZhhB p@/ ;JYH@v.}kp bNo&qe/i]~j¿{JKbyjnA;&W*k$6E%e:(}捀2)\$bt8j~;QB hEEk}vjz׻dݺu}:F \2 .GyO)+R=h-4#--&lSNξ^ILFs?ϣ𱤢(M@!z "X)99R|Vɀ Ypj,Y:>A R~5#ɼ .-pwųٚ=ώ/!CPF`FH>TVV K8666&yVQQ" xBY '_iL6SeU+^٨Da|J J@a_mZ!@-4c2gb7G8~v-LFM7dD mnn)G>aZTy|hQg[jmhc&u!hMuDt UPDeg;A?C";w}7[:;;l ~+RN:$imm҉@?O&F_S\L̒r9 Ĭ`#S_ҙ`&cR-שׂ!f-*3 .t+E{'4J@Ch"gyF.by=/ihh6_+! \mGa {GS٥rf^S(rCcjI)l?}>3LS QW+.UH,+3Yϭˊ@ 8"Ni_"03k.2ў={d]g KM'S/e׮]>v]WLmΒO~IiC>ϸYb4Uat65Y7!)fv|:I>Q֔Z☎ܠsE D u:Ȫ0E@䬳Βs9 rQGɧ?is)~xYkW_}%-{rz.E `Ā\Zp^yUb9ElN~} ݀v''sn%l8dˊ!0-}srj zfE0g?_F?OG7ߔ^zw?OMw.]tlܸQ&cOv "Hy^b@<$4B?W:G'O-I$ (|TaTq"~f]SMFV>MבE`:X8跿\}riM6}t_tڵ_J ֭[eӦM,IE%X D3#.֘3(4s0gi̹Fy5llP|čm$e8UY2˱dtG?h:&XF&rpt>y{#_'A())zkr}%F\?\xr:9:yҼ|VjKGh03Cޓ'd,D"DS 4a*A*GiFB4Qxwb *@ F,Q[B+#0?D^|EZj]piT!Xo x#>޺X>1; J7(G =@hb?Y***䳟 裏ʥ^* *a S2Ұͷmk3cj?!w \ 0-<%>0T0'ZDXU`"0 Rۈ 63[V\*^y RbTʐ" 52f{IqTf"(gEIqOAx|YDC4 1ˊ@`@ ~GɩR`;9\r76Gw1 '۷Ou.R K,?]Q i }0!qAH^X/@ y<#t4-])n[\!mY\xg=M)W"\hwZ =sbuUC-"ЀB~\P:LPH@.̸/HwsM^WU덜۲e?dC?XXL\*| | Nϩ/d´iRwKGV4ILӬ.4`+HZkJlŔ* xkZ$Fl8(]XbWF՛##Mp6R(U6vId=m :.)/%Tș(}8}9z@ݦuxvIOW?BPxby׍J,2vrY\y"чCtd?,%t3EHn &u 1H)S\(FF_ꇆzNjGwUH1H.Y"Xy~1+VJUFu1|"xϔm 0ި O|`tb[\ a:]LLr Qdfl}ga)gss>hX> ݆booݧˊ|#hLt578&F[T"ǖXq@j}I1+W6gnY Mh4;'=%fݹ:Gfg#>$'+GQEQSr&Zh:ϲ <"5W]3,B7>2 {GW_z4H{#U6>Srg~jL?я ' 6T[*j$__,P]k?%w}Q S>9Aӡ36o+)SNؽw^CS^r+Wc<Jd!@f]1L.vsei h長0uC|z!'vwʪF<>3h^ȫwU 1Nͧe}- 6׳&6NV0kqȦ ]ɀICX~օB~"yjp T43ݞr)9?n~^;Sy;aVXaIX?OdT_fzf\3,ZhLJvQG m߾ݘH>0'3t>G[oUnٱc\yRWWgW\!Fx`8_L6ЅGOIzوIWU,/*|h z2} ѿ!h`2֛2vZױM/x%M*U[Uxz$պ阜63u.+BI>.u X ~YՏHɧ?ioQ;<va!܍<&2#㯹IL&ldY?.|j]SՀ{ 7 ɀ)555F`Q".knì_^.bꪫh=&eoǘ\0`< 챈/d CJ>,VcX;D+y84Gt(MEj0T h4QMCbe"TX!Wf壤[tA)ϯJ`X@Hߦgj;hz{{ֶ\{p?I*^ ߡLaE\5\#07 eXug9HL׭[gOL<Ƒ>n/@u~T>oǰ/pj#Ma謅}@**Ւ@ R-nixy\Ϋx7IG867k$ߣ=WH~\ԻM4wH)SVt2euCv<_ 2Q O28#Ȱ@@9x.zI+醐cyyy>Ow%'dUpP"r.tt5焀]C#nVTa{k 5tuGǶjWggoVx(9s4KLg*( 0S#D{ACեtdA( = svQŏs.:TK9ȉ PS%RLh)0ßVŚև(DW ߣpX)@͡,v,uK{U߭'AgP_?Sc};s+.ǘ}x-+Neg"wҿhC3s ^쒭^V>yڵSbO;]u&N|DzQrڽ7i^G&F) `Fw51$hq?k#*HP AKSd~T$m&TeeeTu#04#Pi $''0SX̙41й"/L4V#'$DGRA~Q3@;i'L۶L}[GؓZL$Xi 1͟vw+Ah57#XH(AD̞`W<v4 J@}sN7yeƍ/#z!#)W'_DŽ:CHNd" oh"G >79F)hFaTW2t2 =Y6<=(Fq(C >7+Ҏ}Zyҗq?OdyX׿'T_}FdP0%\bވt纙;;fS1H+C30de`esEҐNm)|Fz}eɩ1s2)}H\ . :ٓU3 ]v,L17yv2$q~ ΦYov5T̙y*\p{Bs{ ..@QlOkL3foS\] %ӌ &Er65]wJ>!Y 4PbbZ6 xrn0sVm}:W0.KPӟH>%K'{g Y?9Ytaf>x zw?J>ɧoc6 qӼ d.Z$]L>vqx&hi$bόliFvJx:vdJRDOc05fӂ $5 Їg.mh@fPN`"p饗UN;4ʤ5,23<#{쑛oeL_ĴD22`\@yHW> f"9{24%cR4Iՙ~vX56qĬcK||~xxPJb,RZQ=A-tLX1U 0obx渢$RdyAODG΃ F:=~="jA+**&cj[[[l޼YhgyW s*|{3D,+RR?%O{D R[:4(K@ s(1P94uTWIP5Ɂ\~7:F*["8/E-.5;1/f>Xz=T/L$33%{?IU#Њ$+s(ᇀ&+ےW"ԈҚLaee˖Ҫ*ytIFIjE-S퐁>V_F]ݨVb_iueG I !]>s@f03(i2%>^K}Ν'[44ϫnʊ.rP"(@,iVN![R\\SӅF4lRZqDj0hBs]?K%x%CSI VJM ?f5G<{l.+"KcxUǮO",mN^kg⋥]ragx0DM@UWHB$qD667I~Oc—%:,Ia#'JwF/Aڇ$9Prw7gM:iX\n3ʑASy+ rBo߭늀"NO64FVj{'dpp8eу% "xV#=J呥+[IOLHx~qvtLOsΞ$̑/ J̓w" 4jPqko}1ǜS"(j6cjġCD@?/%'y<ZQAJ>Cb `OK[Vu9 tIxuBbQM6'J8HDKVg *)>DQClj4L63Y .K $gBK@69p=4exp&g׶' KAp_郬(@PhDyCZO_2:4$_ Mnw!j AB~5,ZKK.c1S<~Z}>k坎@{t+ oQh?&"p$~[Ioz"0PͷerD%- WGۥ˿/ٹMb-leΔ vu+.9H0hf7I bi1͛fl6Ϧ5\8!EKA4tGү(Ubnӹ"tRafg mkA9LPmd?J'/z_<;[[$4eHL-.GIOLdmxM~9r-ƹ;Ag!X1KY^t ~GFob8R3:Y B jMHln7\`&PMT@P I>z"F@ olBnOuut RK_Rȍ-XʒcTI+Hg3hn$om&}\$32ᙚ+*V(-Wr咈"LS;"Pˤ ۩l6čG=G!X75@^ͩ(" ;8ceR@B"abBUEErЀ|1*K@΀ɻ,D,P;9E 0ip< EHROPw%YYf{W#͓ L)ǵS2p^S3Z!q%s0/;*" %BV 8[.}9&hl{ֲ $9N ?%8c{ /ޚJ:VBMIB{AP}~HuV&Z:)1V|ٞřE@%ӡBjS׸ig} v"Qv9 o5HӅ2i#[^}0eN6:6}L9YAEP "4jsҗ]2z4'&_͗LyN#.r!ɒ Fia0Ҥoielw%m1:WAq0m(P:cPGUNjhEz1Ӈs:qL?lK *ȻJGcJ̡b1óv|ΔL֜ $PY{eE }YMjڬK"%AU; HĎDTљ$ED^K+d]\3pW2s)-Hr!Vk'w@i }Sضb?6k4 R| !_: X[PfYC:$lA> Q lJ"_).{<+$ePѓc$U {jig5^ߨ6 <6:"9|TE@.J@B$ z!]>nޚ1QRlb@:}hL0-**FC7;ys[k`'1U3$D#(ЈB5~ME`(-z|!\BҖV%z2>|<YO靈2>e5{Gi@31,LeSPIE x~ ~.fҷUEJ@<'G\˶ ťbD xI&OĹ^˗ԞwTK ' 9Ao9MZU(J犀w3A+iyH*@PpHpA -DBdAԍ%FZV_h]s fr2F@c CI+܁H&\M9I=0 HgzF{l\:؏BD(C@ hԎSABO=o\a8 %.ԉIv VT[r 25jJփK9M1|AO,dRXGit*D( Љ @2 φkԐL gw#O5%ow o5כmtW*"J@e=GX %K$%@WczʝifM|URAc-I mjܧS M?E@9f -vFP #4kY <M'lN'gϕ &{_%=ۊ|t!{Nă),rzZjKtn};ikC|Saw':8O!nxL @/Xg Ӈ.,y4 I+g{;IyЂäZ"# ֠Y*"5z$A<B(}!IyvªA0Χ@O&y~@Kj.v- &"})E:qZO#%02}B*LDG""9h߈q/FHsk%iaHq[L̇A>]~T ~Ȑ "~z#o3Gp47 3M`?R3_0S@YCSA{?|~ أ|($G\h--erv8& c ā2uk`۟eЃhsbIЉ02; b!23veQޛ-Ṋ<;s9S]b"P$ >.(ByA@en5`x9W0xo0s_$k[EE+ y)sH?m 5S4|L,>+pv~!-3%>^uSpNPa#ԷRҼ߭E6wY%=]R&Q>zي#t 8/ JPy=#KRɛ0Hme}4-A.B'&SYɞۚG?GU"j$*<|TE@zΰEg"ܛ0H%$H\SAB7gJ'Ђ2=eMc?9E\3*ۧ2}?+#B CrKCtIP#4KADϼwԉЂ!9Ds4O,Z,65GQf\@TcD}(t'VsQxfzyNZJ!A?Ej'LJ?L]•M_ ЈtMfj^DE@]ё0`tW$MHMuq]sLHz2 W3.֪Hl9N\6UW* F<7ٛ#},؋ SC@ hP F9:-HKԂ:? 4q-4|KaBw64JcI?dnbjgk~/s¤OzxoTP؁O]R.K,n :E P^KGBĝ rMa⬁ɗgJ)tlJ"1> 4qK~e[~|t"8>BrcQ#/I@P%a~ujP_Ηr FD eu#$灄 }g>M ZTG-cgDR4|NrM 'د#yjnz9cWfxY(a0I:FLaޝ?yA+g PS DtQAITIꃆfU~TSWĤ{O(eU  +;;*B6E@O}Q,&M\H ж㌊Iu͌_ 3U]d Y=)4zw"0v?'0q2}T$ w%V{۵?)Ie(!AcV.Rg!<y$=^z@!8xCS;ER3@ni:n"cxmy wlAeͲ'5U{g4`=EX64dƋs@F 3| 1ZHd$ᾘ8鏎D:"Ix+^ Ol~D~>F`~,"}R9gauhAYS#/əckў5m(@P`@DI.5ð65O Q H*{pHOp8M o,,|Ȋ]ń$`O1:5vKZ"UӁX7(^j%6JNFBaDx*Ǒ +s"='9HƔvIANSe!etLF/S"5TE@4J@; ^C6#QP(jl }Ac$쀉׃ yK` !}Fb}kO )  b ?DU+ՙ"PP6Ќܠ/xт-GJ<^vaNPsJCE#? `Foʅ[\9ao>hh/H.BVMЃژQ@vZrii!ȸC,藷se] *TB:i$ IF5A53 z"Po^!p ^oظ4M;<t&?ABVig=HB9@4ɚ#=R _D{ӂ6#.yaIA d/ޤdIGS\ )b xFz`Uh\8g^ϩV5&CJ?)Ш&aJUE`"t[y@y'(Ϲ5ՉQb#x6Hww:#W rTd>hA:y>n`{@_ʆ/'H%k0$/Lp.2=8w\7 0{F~)$&$ɣ=g"J@^H q1V{Qx_+,Sk^ :NցDnZУr)F) oB8+ (ԂSXHl1*@ :A y|k sZ5/L}]pMsLX<,33-sjacAjc28c6јb8F8f2]XUm0UEJG~z"0g^oB;y,H_Ȕ`vd(șǝ%:^#(hj}!:exA/}^ ׸D 9Iª`5B')=Q<2G{δHXQ( (ڙ"0}/K0مǯBKՌ|ogһ郖D5>.|& }I.4L[ 31=/Q+,">|z盇T[*C8O|ڳ"PPP^G!pӛZPovij_ EdM)c܉<]^R+QJNn az!q^A*"*J@C '1͋?)҅M.hy0_ X¡@*g * {a4C 0nS|< #UB*%Ac-v2-("_P3:@&d-vq4ZPW;"g`gDPJ٢gjtG$%}8&ce0^E5 ؃ jtk٠wos>@="(A@ a݊@` ©[\kAG⥮B-(.,B+ czHh 53:i#">} ~&) ٜm؏SJ,#3z﹚sHPfG+3B],&ѩ&^5#w7q9;@B#1+d }1x*0'$҉JL,ٖ9B ,= Ԉ$_AEʇ%Yҏ4ͻ/TϪ(xo{E`*I7ypZi l!AtDܐ PF4n`@H'Ϯ oRl -ƑQ)= B 8PQE \wZWW'[n7];<䓲wm=S6*@8!p,h-h=4 `M\sx`tR)r!,I(.Tѱ ,-vs'27h2&H%L|B:q)BʥQ܃JhA(Y..E ;~'0m۶׷c+R:cyzr-6W^yĪ(u2 ɛl+fdiSSMd =yLN\2Y2p$/ L:7q R M(sj&;j]' gЅHT `T{MP("nxKM8@7,eee䦛n_,W]u(6m_{KzuEeփni ZzR/?M-htDRB-O;Bhl8?|iylf KL$7 Qs0΃s{x+abLqZ ]إ,]X.$BH$CBB 6c\bM ظ>-U(*XĺZqE\hD'e{uhgٛh:h{v*>Kaxo V^rZ%繿ofTرC/UVI~s=f}ĉŔ4#VKKK˖JU7u:| wpv=\ N% n:^[e\*k4}4z%REa[vPruh Ms#&-1quI줞6i&XЯQJzJ"#~.SZ}@F NݙMBww<{v@}޷X7CUx&Ijih&j,hwm3`  9eeeAl4=z06lɓ'K; ^xD6xd WSf>ʶH2q!\ u.XLg[_`j<:{i|mW1󐯮}?YyH#*t&P[LkZTz7wF%]#Ct}?dݢH#H^q׎t>U{ʰ_| 喫~ve-=Szbz5N`7 TjBaͪ(@; :4Cֺu줰ڰq=Xօ)j ?W: _:*AvpЪoCWZC=ąFK5&BK8!^tkl'LPA[|ThmF?9MLpA:\nH-yLK7㙍:j*iu)(ҿeC4ֿĆ VH7RH{ gm@z2oo]gY0*|KgNi'HG4ڦb@ELR\ &*|TDbP]h:jYrKPCoG*r43$f!dCy7,WቪTC|f+nOH@@=C+RΝk$\? ;^~ G?Y}?35D &0JgJ9 ­Yْ-M8ħBXݾ窨:YCY!rv#T|f;$,$vH lT7,7x w%|h_|̜9 #V ?aņ?J]G ŅpMKT/' ǒ4N5^PKb;b1AsHz*TbhM&{wKށhPO]֤TiBպ/گUۤm=W2PR-\l fV)(t8R=ʹ:+ WZC@@j)yզǴ6Oj+^ld?I@((>:Ok!1&Oߑ}{ҥKMØ1cdѢEzK/i߇F m6t)<9 lYFHT!h:ZF3ˊ5t`qQ*:mӃKP$]*;uUJ#ې(HIY?3s254]HBЃdY#GAfEstuUHI!{T/0P*5w5We?)BQ"ѢYߛ>~,c&+e}HHg\]w9jnV鐩e?o3ѽ'x”BRz)9r,X=c2vXYzW_d<2bAq^lP=nj/)R׮]k&MM8/Jp=s{'ihWAt{pl(KEI%){8Q CpԪgtIJ|bvr8lWTOn p*eSK) q?7T9HK'QZc`gH P=/(ۇ~h<s1o&9MłLK.&Q<}55+[}!8y14[?+I"1C*61cq{xW㚣~߯\a}f?Llgú,xi_Ú=Cj/L'2PPl*82t>ni4Q^vZN2i,P3TTȌ՗xOGٮkwb@qbH \ P/** MVAof|4i}?L_|aٳgmjY}}tA5)OQ+qj]v u ˖-3V{|JfU2ĈOlfl鰶Syjp+СHbbww(sμs1AY gE_˲}"T, P+֕v!گ: $DĻg sxw;i؇똙Uuobm@3;4]`=f²y_>4(T`HzF7Uĉ%77WPLGC~3hZFhxkle[^0jgoZ݉@̄w="*亘 J05-b9g xGǷKIB9#+SU8r&+mͮ#q|P=u7XBPB~"@'Ё< b:!g̘a(_"~i&(1M$5 C嗿<#f(96mY:8qo "uX0[~hH)Xbte64W1q<.y@xA uc9y2i&p8Z3Q@;wu|at%>]T9"P5HzF7_ώAB^3i CJw%΍`A *Qk5;s=@ mЙy;#waRB|Z'q\wf`EX!:Hw@|>Oː}{Ŧx2 9 w8ʼn!W(8 @%xBM?yl۷IBc)wޅIHH P0B6@83i"+4IȻCɮYO>'?OԂ6Q} C\=_I۪enw    P`d#$ԘOLSK* I@cUEdL걚m )!2žLdwbOSӥVkۚUF"qF$@$@"лoD_@@O wpuQ%+Rڹoz='dd({XZu"ۖr[|'  -9G8k',A+uS*koRW&ۯIzI}J;;XGL++S]k&WVhbձ\G$@$@t tK6)Y(E=Z!88Lnm,Jߔ\* תtT锏Z"U9C&-h\ 0UI[2 xO{Vܓ"Pqo} <7T(T֙RپkV4ƃP^sӕR""f{p'  | ={RK3.w7z 5ME2L.xO \E$@$ ~{tI{ub9*tw"vɈdfַwINGUGEl~ט432yjHH—h{Gȼ%QA&>09W'H  o۰}gq6PB8_RV3qHH<DHtS 9$)I$'uj Cvر]lȰ?'lIsfd˲AZ,[*592Mq 3 Pg"L^X޾4E.] UfHңu#WY4[1Z|7Ș/VM)R&Sߛ6 @x ^@z  )| Tg1]sޑ\rdFib]X(yEB52'-E<$D9e  #@~=>ͱq1Uagf&R!<=hٕ;JJǮ]IפTzkGu%1R"0ݺj95)QO#  Gfpe@JK6t gQ|Z9&5E$}݈׉a9I2!ɾAeCIȽ{՟*(e<4M$@$@!H4o*{[4/:%/Ugp+չܿPj7$Sۧ.˕C Xk )+thYqzZh[Z%QܹE~" E=v E x Цb%CecBv'3ane:B>KIzIMM]Y+l J~wA/ϓ7P 5ٵCFȨ&PY.i6S%rQ3ߞ&] ؑ@YkG. xA H%< Tk& A݊tn$%y.,G깝mKm+l55ҶzDzjEg'e{Bt}B8XSW+CUHVMķyLh"~X!`{ ^*ޒ@gy Hw%s-3*>!,1>5A: ֘8993KTw6~%Q'8ęV!w:Ň#z@ꫤEZ(]\^߯V\s ~%5~L.O(@Cβ_"p #Shg A|lr|i^\_S- kV]'LQdnmuu]}}W m @_˾}\6yM7رZJ.\(ޫ#aSR<nXH'(@{B,jpL>bJ̞O\tFlOK/k^݁dʞ]]9سGTlFO*0$~rվs'^27n\SXv}B]e&څoU╖OYF:\|`ٲT_!C,qZd'؅^(gy|ᇲqFٴi.=i t!@ WGұ^ej]8-Hi85>9g{]2*Uf+KdYV{{QV*%jpP:pSZ^[[+13¡\wmѭ]ŧZcmC MQ # `woo? $@$@Pv?l՞VW1Z{ѵ9:e_Z^WaA&)EuJ́:+QM{vWd^D& W$ZF =}V-5sL#q&}Q=z,^؞rJӮs{}q~s3 2&! ae_"mD@F˾Xm},>s8=BMjreҶci}i߸Ar6E䆁E:O}T@Q$=c&c^䫪L$xE]믛;IH f ^o$ s4f yׁӲܨWAä]nN4c}i]XZ/ܝ;䊄XMT*6^z1;HNbY>@P>/w{{xĆ>& ~w?alHfRh=S7iњC`tkU*  &3oD>K;^*HT,Oz[5rK^U#F+Va<D!0n{Z_~ekQ*ȊDX;sm ^uw~k? t%@ڕ א K8DGmEWwۯ-RޠH\hmdj(cŰ}iB=?C'L;r&=l} C%12@=#@gPONIT͌?iߞ;YS8?h+-RV$@fyr? |E$@Y}Β$>z%):\߃f#ȧIc|B$@$@KTeÞ[E~ˆAI&qjY_rzD?ON&#kdСJ4= @$@$(@6"+?O?j6Km uElTFdȀv$E$FtNt @x tǨ\BR_T/R&[OPZ=LJ3?)ED_QE4EZBȃl㻲NNyw#?M4w"0D/"bԮJ}&-5Dْ$qD P`H_<[(KJ8ODR$E; @4xԏPs IiѦksb ieV{8>3  >Cˆx+ o`8ۈd(-GN$@$C>ɦ@$NDSS$"̅Q/%ŲV>>T%mbwe  ^4ZPsfK1L\{9yge~Ɠ@ؤռ*{j a=(eG)H ݻ壏>7xC"u^W_}Uz`k7Qre?'p@;.X<d?kqr@ Н;wʸq` {YiY{ {MKtR bSoM Azo63zruIBBBuЩG7n4kZZZhLUˏ}C hiiiJUU#ۄ h<(3fxOVIDRIDAT:Kk%ZHXoy^\h0jyv ',j02gݪV >;Hb4_A͎Lxř"Ie=g_ “ }xN !C#FT"n&~| ZH5'prrrWAA;Dk(x_hǏwǾ\Y[[+ 4tdffJ@0SL˾}Wn2u`bk%   &tPx-Ν+vWRR"_}XDvHHH@fee = /%!KCͳ[j!A<$,|'   !t1WJ$@$@$@$+*\G$@$@$@$g(@ -&   pE#   3} "@ ב  >CˆIHHH\uEHHHHhe$@$@$@$@Pu$@$@$@$@}Fвa    W"lj6p z@*$   pK-n     }Am %@ 7  о6IHHHvB@GGl۶M+̔N;MRRRL׭['III2tА?;9"+VJQQQ;{ޅ*EeĈE+ f7G'xB>lD跿mYj!?trawC@MM̝;W.]*0m&!;v! ߿_~_/~p> kRev9S?+]ijj24ζookk={ze_XX(@ g^^'? ʍ7h=zT8`iddmll4  'W\! ,۷˰a:];}$++K"""3gz;$`>ʕ+?]|guL8Q?\5͛7O^~e2dlܸwKEEs=~(k7o,wy\pVs|'>'o?S9S$&&Fqf޲eu]rE.o䥗^[oՌ3ϯ' wߗzJM>{uuy~>D(/\=$sΝ;M,%X1z _b(C?rʿ +V~g{=;s5_6l; ɓ<3r!7n\|2c s~zY_s1 ޽{ͳN[Ɠx FSa?)pKCC\y=H/wkjkk%77e˖_Q 9eӟ$7|L6ٳgoe~z$̍}EK/ve<eeeD2 C~(tIrwh ~9kK(] 㹽zL:,#s>$``E"LޑEtG[n [뛛ͯ;vbDyk믿.w}~`=gΜ)o˗/7C@~ x2a %Kur%aJ U"V0x# 1uUUUf!@M3ΐwy\\222dرw$+!>46P[>Es&MnA 'ʋ}f JY޺u]\xAeРA&%AOrM+E<(Oˋ/h!/q 9B,2H|"d^P=/,(I);j([wϹI?_D aW_(!}1L'!!ӡhEY ~`9DanL9]js=f sב @(|(UD,^L}ٶcnSiz~uGx1$@$@O< l7oܹS^x{1YȬYL.a'xB>3f#?1SO=%!fF/LyW!jߎozA8p e lb㼘UΓn [׿Vs]tEfYLlk֬o\33P578fbTtL$J(@Cn/$ `L劘Gf:Sp_m۶9w\ԱC~W2sL3uO>i?(ʍ9'O,?Odvf{13K Q9#UOoS{9lΜ9j*s^wޢѾru4NuuufO>YF-?яĺ۷}y'1F0-F$@!ISqHHD <ئe3:Gmf?nYl:g}_˳i ^6:M{i }XtkY$4;ֺ~۴.]j߮c4QȬSj1bM=}~a~;gm87/_6L_m*vG~`5\cSm+654ףsЛMab_ ̂ɟ /rGV< sX+t5Dͪh?~Yx@srr|L0qqqf"oeEE9 `k2Wjxe1e>9[o%7okJSS477[o< L!w0]-M4ITxZV?0C7bn #٨D4f$0aB2CH$8TK? (B-++3 HHB6<_|E34w`$,8 3faFC@HH PeH wg ???~UlRAAh2 0@}Y>=Y5%!m#qFSc(ѢEb0?˜Ǻ2ĝ?5GYē"3LZlzC(+ˌ3^C&Cl~\/2i$@$8R(UD#}5U'a'o"J$A,ZB$k%GpZG"P/~wܯUUU& F$@J 2T;~ |J|tX\pD%bC1:v'>q Description: Alluvial plots use variable-width ribbons and stacked bar plots to represent multi-dimensional or repeated-measures data with categorical or ordinal variables; see Riehmann, Hanfler, and Froehlich (2005) and Rosvall and Bergstrom (2010) . Alluvial plots are statistical graphics in the sense of Wilkinson (2006) ; they share elements with Sankey diagrams and parallel sets plots but are uniquely determined from the data and a small set of parameters. This package extends Wickham's (2010) layered grammar of graphics to generate alluvial plots from tidy data. Depends: R (>= 3.6), ggplot2 (>= 2.2) Imports: stats, dplyr (>= 0.7), tidyr (>= 0.7), lazyeval, rlang, tidyselect Suggests: grid, alluvial, testthat, knitr, rmarkdown, babynames, sessioninfo, ggrepel, shiny (>= 1.4.0.2), htmltools, sp (>= 1.4-0), ggfittext (>= 0.6), vdiffr (>= 0.2) License: GPL-3 LazyData: true URL: http://corybrunson.github.io/ggalluvial/ BugReports: https://github.com/corybrunson/ggalluvial/issues VignetteBuilder: knitr RoxygenNote: 7.2.3 Encoding: UTF-8 NeedsCompilation: no Packaged: 2023-02-13 15:44:19 UTC; jason.brunson Author: Jason Cory Brunson [aut, cre], Quentin D. Read [aut] Repository: CRAN Date/Publication: 2023-02-22 09:50:02 UTC ggalluvial/build/0000755000176200001440000000000014372455323013510 5ustar liggesusersggalluvial/build/vignette.rds0000644000176200001440000000047114372455323016051 0ustar liggesusersRMO0 M?kc0 \ÚeҴJnpp;g: *g} !1I 5 K!RT%b\M̓sǴP No Yes 1.00 1.25 1.50 1.75 2.00 1.00 1.25 1.50 1.75 2.00 0 500 1000 1500 Freq Age Child Adult `geom_alluvium`: facets ggalluvial/tests/testthat/_snaps/geom-alluvium/geom-alluvium-bump-plot.svg0000644000176200001440000025223114367761414026714 0ustar liggesusers 0e+00 2e+06 4e+06 6e+06 8e+06 2002.5 2005.0 2007.5 2010.0 2012.5 year refugees country Afghanistan Burundi Congo DRC Iraq Myanmar Palestine Somalia Sudan Syria Vietnam `geom_alluvium`: bump plot ggalluvial/tests/testthat/_snaps/geom-alluvium/geom-alluvium-sine-curve.svg0000644000176200001440000034644714367761414027072 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_alluvium`: 'sine' curve ggalluvial/tests/testthat/_snaps/geom-alluvium/geom-alluvium-basic.svg0000644000176200001440000033470214367761414026062 0ustar liggesusers 0 500 1000 1500 2000 1.0 1.5 2.0 2.5 3.0 Freq Survived No Yes `geom_alluvium`: basic ggalluvial/tests/testthat/_snaps/geom-alluvium/geom-alluvium-quintic-curve.svg0000644000176200001440000034640314367761414027600 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_alluvium`: 'quintic' curve ggalluvial/tests/testthat/_snaps/geom-alluvium/geom-alluvium-unscaled-knot-positions.svg0000644000176200001440000035202414367761414031572 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_alluvium`: unscaled knot positions ggalluvial/tests/testthat/_snaps/geom-alluvium/geom-alluvium-arctangent-curve-with-custom-range.svg0000644000176200001440000034657714367761414033641 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_alluvium`: 'arctangent' curve with custom range ggalluvial/tests/testthat/_snaps/geom-alluvium/geom-alluvium-cubic-curve.svg0000644000176200001440000034646114367761414027215 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_alluvium`: 'cubic' curve ggalluvial/tests/testthat/_snaps/geom-alluvium/geom-alluvium-linear-curve.svg0000644000176200001440000034661414367761414027402 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_alluvium`: 'linear' curve ggalluvial/tests/testthat/_snaps/geom-alluvium/geom-alluvium-line-plot.svg0000644000176200001440000026421614367761414026706 0ustar liggesusers 0e+00 2e+06 4e+06 6e+06 8e+06 2002.5 2005.0 2007.5 2010.0 2012.5 year refugees country Afghanistan Burundi Congo DRC Iraq Myanmar Palestine Somalia Sudan Syria Vietnam `geom_alluvium`: line plot ggalluvial/tests/testthat/_snaps/geom-alluvium/geom-alluvium-sigmoid-curve-with-custom-range.svg0000644000176200001440000034651114367761414033132 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_alluvium`: 'sigmoid' curve with custom range ggalluvial/tests/testthat/_snaps/geom-alluvium/geom-alluvium-sigmoid-curve.svg0000644000176200001440000034630114367761414027554 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_alluvium`: 'sigmoid' curve ggalluvial/tests/testthat/_snaps/geom-alluvium/geom-alluvium-arctangent-curve.svg0000644000176200001440000034637214367761414030257 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_alluvium`: 'arctangent' curve ggalluvial/tests/testthat/_snaps/geom-lode/0000755000176200001440000000000014367761414020553 5ustar liggesusersggalluvial/tests/testthat/_snaps/geom-lode/geom-lode-lodes-and-alluvia.svg0000644000176200001440000036274114367761414026460 0ustar liggesusers 0 500 1000 1500 2000 1.0 1.5 2.0 2.5 3.0 Freq Survived No Yes `geom_lode`: lodes and alluvia ggalluvial/tests/testthat/_snaps/geom-lode/geom-lode-lodes-as-strata.svg0000644000176200001440000035433314367761414026160 0ustar liggesusers 0 500 1000 1500 2000 1.0 1.5 2.0 2.5 3.0 Freq Survived No Yes `geom_lode`: lodes as strata ggalluvial/tests/testthat/_snaps/geom-lode/geom-lode-one-axis.svg0000644000176200001440000003013714367761414024671 0ustar liggesusers 0 500 1000 1500 2000 Class Freq Class 1st 2nd 3rd Crew Survived No Yes `geom_lode`: one axis ggalluvial/tests/testthat/_snaps/geom-stratum/0000755000176200001440000000000014367761414021327 5ustar liggesusersggalluvial/tests/testthat/_snaps/geom-stratum/geom-stratum-basic.svg0000644000176200001440000001342114367761414025554 0ustar liggesusers 0 500 1000 1500 2000 1 2 3 4 Freq `geom_stratum`: basic ggalluvial/tests/testthat/_snaps/geom-stratum/geom-stratum-facets.svg0000644000176200001440000002346014367761414025744 0ustar liggesusers Child Adult 0.8 1.2 1.6 2.0 0.8 1.2 1.6 2.0 0 500 1000 1500 2000 0 30 60 90 Freq `geom_stratum`: facets ggalluvial/tests/testthat/_snaps/geom-stratum/geom-stratum-axis-labels.svg0000644000176200001440000001346614367761414026710 0ustar liggesusers 0 500 1000 1500 2000 Class Sex Age Survived Freq `geom_stratum`: axis labels ggalluvial/tests/testthat/_snaps/geom-stratum/geom-stratum-inferred-text-labels.svg0000644000176200001440000001353214367761414030516 0ustar liggesusers Crew 3rd 2nd 1st Female Male Adult Child Yes No 0 500 1000 1500 2000 1 2 3 4 Freq `geom_stratum`: inferred text labels ggalluvial/tests/testthat/_snaps/geom-stratum/geom-stratum-facets-and-axis-labels.svg0000644000176200001440000002126714367761414030711 0ustar liggesusers Child Adult Class Sex Class Sex 0 500 1000 1500 2000 0 30 60 90 Freq `geom_stratum`: facets and axis labels ggalluvial/tests/testthat/_snaps/geom-stratum/geom-stratum-extended-width.svg0000644000176200001440000001343214367761414027412 0ustar liggesusers 0 500 1000 1500 2000 1 2 3 4 Freq `geom_stratum`: extended width ggalluvial/tests/testthat/_snaps/geom-flow/0000755000176200001440000000000014367761414020577 5ustar liggesusersggalluvial/tests/testthat/_snaps/geom-flow/geom-flow-basic.svg0000644000176200001440000005726614367761414024313 0ustar liggesusers 0 500 1000 1500 2000 1.0 1.5 2.0 2.5 3.0 Freq `geom_flow`: basic ggalluvial/tests/testthat/_snaps/geom-flow/geom-flow-linear-curve.svg0000644000176200001440000014350014367761414025611 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: 'linear' curve ggalluvial/tests/testthat/_snaps/geom-flow/geom-flow-forward-orientation.svg0000644000176200001440000021552514367761414027221 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: forward orientation ggalluvial/tests/testthat/_snaps/geom-flow/geom-flow-unscaled-knot-positions.svg0000644000176200001440000014666114367761414030024 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: unscaled knot positions ggalluvial/tests/testthat/_snaps/geom-flow/geom-flow-backward-orientation.svg0000644000176200001440000021552614367761414027334 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: backward orientation ggalluvial/tests/testthat/_snaps/geom-flow/geom-flow-arctangent-curve.svg0000644000176200001440000014337414367761414026476 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: 'arctangent' curve ggalluvial/tests/testthat/_snaps/geom-flow/geom-flow-cubic-curve.svg0000644000176200001440000014342414367761414025431 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: 'cubic' curve ggalluvial/tests/testthat/_snaps/geom-flow/geom-flow-facets.svg0000644000176200001440000015113014367761414024460 0ustar liggesusers No Yes 0.8 1.2 1.6 2.0 0.8 1.2 1.6 2.0 0 500 1000 1500 Freq Age Child Adult `geom_flow`: facets ggalluvial/tests/testthat/_snaps/geom-flow/geom-flow-sine-curve.svg0000644000176200001440000014341714367761414025304 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: 'sine' curve ggalluvial/tests/testthat/_snaps/geom-flow/geom-flow-aesthetic.svg0000644000176200001440000012573114367761414025174 0ustar liggesusers 0 500 1000 1500 2000 1.0 1.5 2.0 2.5 3.0 Freq Survived No Yes `geom_flow`: aesthetic ggalluvial/tests/testthat/_snaps/geom-flow/geom-flow-sigmoid-curve.svg0000644000176200001440000014334114367761414025775 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: 'sigmoid' curve ggalluvial/tests/testthat/_snaps/geom-flow/geom-flow-arctangent-curve-with-custom-range.svg0000644000176200001440000014350314367761414032043 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: 'arctangent' curve with custom range ggalluvial/tests/testthat/_snaps/geom-flow/geom-flow-quintic-curve.svg0000644000176200001440000014340214367761414026014 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: 'quintic' curve ggalluvial/tests/testthat/_snaps/geom-flow/geom-flow-sigmoid-curve-with-custom-range.svg0000644000176200001440000014345114367761414031352 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: 'sigmoid' curve with custom range ggalluvial/tests/testthat/test-geom-flow.r0000644000176200001440000001065114367761414020457 0ustar liggesuserscontext("geom-flow") # curve tests test_that("`positions_to_flow` computes as expected", { # spline curve spline_curve <- positions_to_flow(1, 2, 0, 1, 1, 2, 1.3, 1.7, FALSE, "spline", NULL, NULL) expect_equal(nrow(spline_curve), 8L) expect_equal(spline_curve$x, c(1, 2.3, 0.3, 2, 2, 0.3, 2.3, 1)) expect_equal(unique(spline_curve$y), c(0, 1, 2)) expect_equal(unique(spline_curve$shape), c(0, 1)) # cubic curve cubic_curve <- positions_to_flow(1, 2, 0, 1, 1, 2, 1.3, 1.7, FALSE, "cubic", NULL, 8L) expect_equal(nrow(cubic_curve), 2L * 8L + 2L) expect_equal(unique(cubic_curve$x), seq(1, 2, .125)) expect_equal(unique(cubic_curve$shape), 0) }) # visual tests test_that("`geom_flow` draws correctly", { d <- as.data.frame(Titanic) a1 <- aes(y = Freq, axis1 = Class, axis2 = Sex, axis3 = Age) a2 <- aes(y = Freq, axis1 = Class, axis2 = Sex) skip_on_cran() skip_if_not_installed("vdiffr") vdiffr::expect_doppelganger( "`geom_flow`: basic", ggplot(d, a1) + geom_flow() ) vdiffr::expect_doppelganger( "`geom_flow`: aesthetic", ggplot(d, a1) + geom_flow(aes(fill = Survived)) ) vdiffr::expect_doppelganger( "`geom_flow`: facets", ggplot(d, a2) + geom_flow(aes(fill = Age), width = .4) + facet_wrap(~ Survived, scales = "fixed") ) }) data(vaccinations) test_that("`geom_flow` orients flows correctly", { skip_on_cran() skip_if_not_installed("vdiffr") vdiffr::expect_doppelganger( "`geom_flow`: forward orientation", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_lode() + geom_flow() ) vdiffr::expect_doppelganger( "`geom_flow`: backward orientation", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_lode() + geom_flow(aes.flow = "backward") ) }) test_that("`geom_flow()` recognizes alternative curves", { skip_on_cran() skip_if_not_installed("vdiffr") vdiffr::expect_doppelganger( "`geom_flow`: unscaled knot positions", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_stratum() + geom_flow(knot.prop = FALSE) ) vdiffr::expect_doppelganger( "`geom_flow`: 'linear' curve", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_stratum() + geom_flow(curve_type = "linear") ) vdiffr::expect_doppelganger( "`geom_flow`: 'cubic' curve", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_stratum() + geom_flow(curve_type = "cubic") ) vdiffr::expect_doppelganger( "`geom_flow`: 'quintic' curve", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_stratum() + geom_flow(curve_type = "quintic") ) vdiffr::expect_doppelganger( "`geom_flow`: 'sine' curve", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_stratum() + geom_flow(curve_type = "sine") ) vdiffr::expect_doppelganger( "`geom_flow`: 'arctangent' curve", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_stratum() + geom_flow(curve_type = "arctan") ) vdiffr::expect_doppelganger( "`geom_flow`: 'arctangent' curve with custom range", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_stratum() + geom_flow(curve_type = "arctan", curve_range = 1) ) vdiffr::expect_doppelganger( "`geom_flow`: 'sigmoid' curve", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_stratum() + geom_flow(curve_type = "sigmoid") ) vdiffr::expect_doppelganger( "`geom_flow`: 'sigmoid' curve with custom range", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_stratum() + geom_flow(curve_type = "sigmoid", curve_range = 3) ) }) ggalluvial/tests/figs/0000755000176200001440000000000014025146066014477 5ustar liggesusersggalluvial/tests/figs/geom-alluvium/0000755000176200001440000000000014025146066017262 5ustar liggesusersggalluvial/tests/figs/geom-alluvium/geom-alluvium-facets.svg0000644000176200001440000017724114025146066024045 0ustar liggesusers No Yes 1.00 1.25 1.50 1.75 2.00 1.00 1.25 1.50 1.75 2.00 0 500 1000 1500 Freq Age Child Adult `geom_alluvium`: facets ggalluvial/tests/figs/geom-alluvium/geom-alluvium-bump-plot.svg0000644000176200001440000026107614025146066024517 0ustar liggesusers 0e+00 2e+06 4e+06 6e+06 8e+06 2002.5 2005.0 2007.5 2010.0 2012.5 year refugees country Afghanistan Burundi Congo DRC Iraq Myanmar Palestine Somalia Sudan Syria Vietnam `geom_alluvium`: bump plot ggalluvial/tests/figs/geom-alluvium/geom-alluvium-sine-curve.svg0000644000176200001440000035610114025146066024652 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_alluvium`: 'sine' curve ggalluvial/tests/figs/geom-alluvium/geom-alluvium-basic.svg0000644000176200001440000034320114025146066023650 0ustar liggesusers 0 500 1000 1500 2000 1.0 1.5 2.0 2.5 3.0 Freq Survived No Yes `geom_alluvium`: basic ggalluvial/tests/figs/geom-alluvium/geom-alluvium-quintic-curve.svg0000644000176200001440000035603514025146066025376 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_alluvium`: 'quintic' curve ggalluvial/tests/figs/geom-alluvium/geom-alluvium-unscaled-knot-positions.svg0000644000176200001440000036145514025146066027376 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_alluvium`: unscaled knot positions ggalluvial/tests/figs/geom-alluvium/geom-alluvium-cubic-curve.svg0000644000176200001440000035611314025146066025004 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_alluvium`: 'cubic' curve ggalluvial/tests/figs/geom-alluvium/geom-alluvium-linear-curve.svg0000644000176200001440000035624614025146066025200 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_alluvium`: 'linear' curve ggalluvial/tests/figs/geom-alluvium/geom-alluvium-line-plot.svg0000644000176200001440000027306314025146066024502 0ustar liggesusers 0e+00 2e+06 4e+06 6e+06 8e+06 2002.5 2005.0 2007.5 2010.0 2012.5 year refugees country Afghanistan Burundi Congo DRC Iraq Myanmar Palestine Somalia Sudan Syria Vietnam `geom_alluvium`: line plot ggalluvial/tests/figs/geom-alluvium/geom-alluvium-sigmoid-curve.svg0000644000176200001440000035573314025146066025361 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_alluvium`: 'sigmoid' curve ggalluvial/tests/figs/geom-alluvium/geom-alluvium-arctangent-curve.svg0000644000176200001440000035602414025146066026046 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_alluvium`: 'arctangent' curve ggalluvial/tests/figs/deps.txt0000644000176200001440000000010314025146066016165 0ustar liggesusers- vdiffr-svg-engine: 1.0 - vdiffr: 0.3.1 - freetypeharfbuzz: 0.2.5 ggalluvial/tests/figs/geom-lode/0000755000176200001440000000000014025146066016347 5ustar liggesusersggalluvial/tests/figs/geom-lode/geom-lode-lodes-and-alluvia.svg0000644000176200001440000040006014025146066024237 0ustar liggesusers 0 500 1000 1500 2000 1.0 1.5 2.0 2.5 3.0 Freq Survived No Yes `geom_lode`: lodes and alluvia ggalluvial/tests/figs/geom-lode/geom-lode-lodes-as-strata.svg0000644000176200001440000037145214025146066023755 0ustar liggesusers 0 500 1000 1500 2000 1.0 1.5 2.0 2.5 3.0 Freq Survived No Yes `geom_lode`: lodes as strata ggalluvial/tests/figs/geom-lode/geom-lode-one-axis.svg0000644000176200001440000003601414025146066022465 0ustar liggesusers 0 500 1000 1500 2000 Class Freq Survived No Yes Class 1st 2nd 3rd Crew `geom_lode`: one axis ggalluvial/tests/figs/geom-stratum/0000755000176200001440000000000014025146066017123 5ustar liggesusersggalluvial/tests/figs/geom-stratum/geom-stratum-basic.svg0000644000176200001440000001570714025146066023361 0ustar liggesusers 0 500 1000 1500 2000 1 2 3 4 Freq `geom_stratum`: basic ggalluvial/tests/figs/geom-stratum/geom-stratum-facets.svg0000644000176200001440000003031114025146066023531 0ustar liggesusers Child Adult 0.8 1.2 1.6 2.0 0.8 1.2 1.6 2.0 0 500 1000 1500 2000 0 30 60 90 Freq `geom_stratum`: facets ggalluvial/tests/figs/geom-stratum/geom-stratum-axis-labels.svg0000644000176200001440000001575414025146066024506 0ustar liggesusers 0 500 1000 1500 2000 Class Sex Age Survived Freq `geom_stratum`: axis labels ggalluvial/tests/figs/geom-stratum/geom-stratum-inferred-text-labels.svg0000644000176200001440000001631614025146066026315 0ustar liggesusers Crew 3rd 2nd 1st Female Male Adult Child Yes No 0 500 1000 1500 2000 1 2 3 4 Freq `geom_stratum`: inferred text labels ggalluvial/tests/figs/geom-stratum/geom-stratum-facets-and-axis-labels.svg0000644000176200001440000002526414025146066026506 0ustar liggesusers Child Adult Class Sex Class Sex 0 500 1000 1500 2000 0 30 60 90 Freq `geom_stratum`: facets and axis labels ggalluvial/tests/figs/geom-stratum/geom-stratum-extended-width.svg0000644000176200001440000001572014025146066025210 0ustar liggesusers 0 500 1000 1500 2000 1 2 3 4 Freq `geom_stratum`: extended width ggalluvial/tests/figs/geom-flow/0000755000176200001440000000000014025146066016373 5ustar liggesusersggalluvial/tests/figs/geom-flow/geom-flow-basic.svg0000644000176200001440000006244114025146066022076 0ustar liggesusers 0 500 1000 1500 2000 1.0 1.5 2.0 2.5 3.0 Freq `geom_flow`: basic ggalluvial/tests/figs/geom-flow/geom-flow-linear-curve.svg0000644000176200001440000015324014025146066023407 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: 'linear' curve ggalluvial/tests/figs/geom-flow/geom-flow-forward-orientation.svg0000644000176200001440000023442014025146066025010 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: forward orientation ggalluvial/tests/figs/geom-flow/geom-flow-unscaled-knot-positions.svg0000644000176200001440000015642014025146066025612 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: unscaled knot positions ggalluvial/tests/figs/geom-flow/geom-flow-backward-orientation.svg0000644000176200001440000023442114025146066025123 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: backward orientation ggalluvial/tests/figs/geom-flow/geom-flow-arctangent-curve.svg0000644000176200001440000015313414025146066024265 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: 'arctangent' curve ggalluvial/tests/figs/geom-flow/geom-flow-cubic-curve.svg0000644000176200001440000015316414025146066023227 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: 'cubic' curve ggalluvial/tests/figs/geom-flow/geom-flow-facets.svg0000644000176200001440000016054014025146066022261 0ustar liggesusers No Yes 0.8 1.2 1.6 2.0 0.8 1.2 1.6 2.0 0 500 1000 1500 Freq Age Child Adult `geom_flow`: facets ggalluvial/tests/figs/geom-flow/geom-flow-sine-curve.svg0000644000176200001440000015315714025146066023102 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: 'sine' curve ggalluvial/tests/figs/geom-flow/geom-flow-aesthetic.svg0000644000176200001440000013332214025146066022763 0ustar liggesusers 0 500 1000 1500 2000 1.0 1.5 2.0 2.5 3.0 Freq Survived No Yes `geom_flow`: aesthetic ggalluvial/tests/figs/geom-flow/geom-flow-sigmoid-curve.svg0000644000176200001440000015310114025146066023564 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: 'sigmoid' curve ggalluvial/tests/figs/geom-flow/geom-flow-quintic-curve.svg0000644000176200001440000015314214025146066023612 0ustar liggesusers 0 250 500 750 1000 ms153_NSA ms432_NSA ms460_NSA survey freq response Missing Never Sometimes Always `geom_flow`: 'quintic' curve ggalluvial/tests/testthat.R0000644000176200001440000000010014025146066015521 0ustar liggesuserslibrary(testthat) library(ggalluvial) test_check("ggalluvial") ggalluvial/vignettes/0000755000176200001440000000000014372455323014421 5ustar liggesusersggalluvial/vignettes/img/0000755000176200001440000000000014367761414015202 5ustar liggesusersggalluvial/vignettes/img/hover_stratum.png0000644000176200001440000003501714367761414020620 0ustar liggesusersPNG  IHDRj`zTXtRaw profile type exifxڭivcr0;HReYI7=W}&Rs/|EϿ~;}sxu}y>5T-گ_zu4"ϋj 译V)<x^;wpLp^߼)!?٘]Sa~6u:sV5gv=fL_zOý-SM.S ;q~k[}n2%^E` qǗk>Lx~nJqw4 F6tB9[?lŸasz*"7mǜpxY(y΅{$Fa`Dm)AB%*Q^qұtsMyq׍e vsֶgq05I&@<?3Э#N&R; $pJ{nb/uPMt-$/xQS }7Q&z5 yǸ7V݀o7eN4e4FSoʼo2?2]o2?G?iJWֻMuyPճŀr󨘹O < vJe4?5$tZ 9ȤGJ,DꝒe܋7R.0/NfAiEO BR,-eJi YɫQ`B`* 0(ۥwP[Oɓlr<벴Kء[R2SFgaj!ʎ3``oIQٗ/sG Sls8UT L| =>fDiLخ6~#Qk8lPFq\ 7u-قo:na#jZn*CwTBK"A C7HZWn\xr>%)$ԐwUKչNL0R7U[fKR.hbA L ~JWef;t^U?F|o4Pf]G=Sנ6U86tBsqgB5x Ŝ S̬ӕ3 =ʴ[ʪH(ю.<{06ȧZa(˵(Rm!Ml{ꃅk Yn4D\]xN=:\c%v1W1Br%8!-ٔy{4?E8$Aw`J ;uI7@dR!|iՓ#i3cp 1FF0ʺ/$xzRTKO<\P={2HEP+KUG_%Sq7D& pp@$:QS)"hD&_A2ulD C>"嵐GDhϙ}QipqكmDcA6P70=2jDp&?Bɟbtk=!*~Q:b fO^qv$Dn8$^ckjaY%̝!7Zor(("MY "UhIKM`dߨXlٴTb+Yk$*ϒLAzX",sp;x0jXLQ yH[7DACC{TTbEeOs (kJ412gY@]܇k ".az̰@Y^z[hH !0V`ly\H TZƠX`wr<ԝ@JrCuwďW1/f&$AHj@'Z.h>$bwQ U#2:{5b \zB1]n$"A[P P\㖸@\{<F4Ov9b{QEL5m*Db"+dbM)Ww ,)(P2,]k_iP\;^D %3vZ/)]0>"bd3*`XNːinĜ̬'(>v-vڅڝhҶ]/Xmf\.i\br; m!S  E3 |?z@"_ }LJv^&D#?5rB}W8& rLM',d}nA1$BAʱeU?H<\%: 1|2}6JNQu0"b_$"vh:yDEGVc2# EıvH4u xʳ&ψQz7E:@5/}OI lMG LaCQzL"`G;ǘE:@۠"=$SyHug%wFt`xϩ&6-+ Cwb:MLqK'=h?6ۑ.D tş6뤼?qc\,g Q̛dxT*ǜyk6yWGvMM)\PpJ{$ r ukX-#M{p\i/6΍։qyb-Rau]#+|S b(+0f u,8J9T)E xݳLT/ TMCN).agKy`!+-SkHBa]Ifw CV<F:T koD*(_kVV0UצG M-2?Po67^iN{Fׅ Wl T<VH^*Sj=id`#Z&FEL4'^=+ARnGxn!El(ds." !@>Z~25?Tɺ89I֙ܓĪCi|7zOv6Cꎲ>; i}#֞%ٞj?6&I\ccj~MGjuQ'.j)6YMطؙd~"i.=DȮAbRd!Ye%xlzOǶLF9ZfsyarDYWW bbwuܟ\s0pY.T46h0R7ZZH\(@ G6lH-G>vU9YGvElKt`)i?MShƪe+X=\j1ᵞFV zo1,J<~T8fb=DraĞJp*k]c`XO:8kC!#t+HN"}BAٵwࢹQ᝕3yTTsiGʆd݃*RB" -[)r½8[cI69;*@'db܈\RJ@>QS#JBJҮj1̓a:']n{uTu^x>umnvSRĤܐ O-G$%&=gе ]";m Ci ӑװ&5^]>ϡBn(+BQ|X8<=l8c g TKBGU-ʻ& +!NQl,qZa{KMNNuwU${ϼI;̿M;\1qPWZ:G(@zLFV,ey?𜉱ﯘrz壎gƷ %YpDo#}!dscf9D]DL-hg4S( dBduR&>b!N-E¾ẲmrD;)n7 *{ rЊeH7B]E @p'*:b$~ lKMt8Bw;Zƚږ |QͥJZkA%PK,+8n3w07DӶ)_Ꮵ=(#KL II=1}DmDKȊ%HDD[6{v:Kʥ׃&.uH <FÎq`9 q'"lLX{qa"Å1Dm olT "KK/ňB٬Η:@3o隩aʈŅ˨覀%'OR_,yOWxWiRܢ[e^-Zi:9z(:(9ggM!잵Z.'-g 9Y2_arH;riv<,qq,ۍ4on&x[ze~OlkˑgSG_ARPo3sLRV>w3dľX ÈO@[!PnGϠrn55p:$"VỀ+ZF/> 'uFh4sxIk|P:R  źIttr Eĉwc[U6h9u Є4J <> )}h柜VT=6Ucjܓ ()zM5^ۂbҩyuTg]A*! 8t}㺜s:HT{X:{XϠYy 2ʴmh+M >$mLnSllȝy&Nφ:F>KҼԗ4_>d?2Ȓ5fYt970s.V}uȜN5<~u|{+uѿy!kSx`6sձHJO|$4' /ww\oCH3r?MP6̯1߹o= ƙ|-i5{7}@.mҍl`N hMSGl颅XO/Bed#bP/Ԓ ZI_h6}\.2xm~EQ To- GQ&9k0yR4=:]Sb̘(Bh D9ThX^3þqf/,j P%)ֈ)Zj# R6^>d]ȩbRr:JJZl-*%gP̎OY67_<4SkA%BWCzK(qm %Cv:3&[m"NCxIuL}hN ښC+#tvL[ :|< $s!3N5v`,aVb.F6( c8&fȃTM'5 !m׻eŢbhaV=A|!R"$yp3yhY Vl;hHxMҷ㶸(HkNi]"Ng%Dn#ٴRJ~!9P(gM9]s:Y-X=9{Z,rG!iTXtXML:com.adobe.xmp pHYs+tIME /# IDATx]H[ivB !Ym A0ze7f/b":sc7 [2Brd4P/V- g/Ny9Mr^9'.-sSYD4M\.L ~WSnͬ& Auq;@w q;@Aw @u}X_C_ikk[[[ ^HrlXW?b7p}n4^i^ @EOUhPUk׮ /o/nfoh&$~ÿN0CK"%KE;'=4;]/]q/y2a*7qʹ/;Eq;jQwX9Uɓ>sD"GTw qGml:\:::b+4q?{d29;z#gYzG" 7>S_i3r7hKl 7&8؜|tc04h3onu&߬\2tu縡u<4sl=oٯN/fE$7NV$ܢ)5۟(KYt܋Q?+Tnz˼ƥ ŝ56'qL?2;>GCk$9qj֏Ii;xS-\ߎ}=+"}d,+36 &Ed+&w;}{%6Ѣ3}w?"Twko|jkKc.$6o0@u;P̯(*La=/I$`3Ҍ5oss o3?w$?|C /DCtNޑnӥtOn/;hPwttd×YX04ZB_p?'6oD( ;Pw{n_{G"}O>[ᕝճJSawWY ~YT!xh?wXqhzxYw=jm9(9y8<ĽJޥx,v0EɄ㝝oް1I; 3}C wS`F,dԻ%^fKxwN(K]C~Nܭ?9=ws#ˠ\\%l>g߭{~zUDdcceF$ qLzWh0˪yY[[fu)cccee=,תE*;]ݍj U&Uĸh^ G//ٛذ',|z9+v1իbY%;;`դiZٱPJ?8qwwBXC]\CwĽE]Y}iW|wǝɌTf2*#MCw0v f TwF?>UpF@eoU86{5yήpPiˢs w OZ;VtoFfh;@p*v;1ݬfO|Wawlʉ;e;`X_La⯴4ak_j,%}fmm7~J'MMo nG?r㞝.717~G+tæ MgbB\q;@w @ z&NKLdž^'qG3 OhUtNT*,PpXci%m566Ŧ|"Zn?x,.̿NjzQ0_&70k[\ȌV|'hO胆SD(񓬋&=SFSѬGSN fw'"iأ U91H"Zp^㉬#h:bI:'m~q7yEDvvS|BD:'b}o4>2s$SlLn-תo/7eG8UxEDvUQ=q=SVݶFᑚw$;4)zk3DOTw;v43()Ns>:q ,HgI-O_1LL)<0w>)eq*ΉĂr28~LЮ/հFY+SF_D,1ғ|>QUc:ᴀSU: |nϞ3?DZ{SϢSf27= >Iu)b\awTw q;@Aw @fHIENDB`ggalluvial/vignettes/img/hover_alluvium.png0000644000176200001440000003735014367761414020761 0ustar liggesusersPNG  IHDRjzTXtRaw profile type exifxڭWv$DYX9Y\C$E~]T2# s3c_5lb*5-bw~u3[oO@u>~keDA+^@?j| c??f?cz+1O~,u&t~pCBo U^yoxWcow{kO3>/j1i~ۭܟp`p]ߍ/;tyr\tuwܾM{?qޫcQ%kqwv2r\9y\W~89 yl}8ː/Ww(]K~ x0]3Wn 1{Ŗ(\G.L>z ;.$-c?\RUB9knSܽ' fr("FXB)JŜr% z %Tr)Vz 5Ts-jo1Jޙ3r۝ z~GyQG}>34,f_~Nʪ&vi]vmCpI'ri{͙ǭ^so^S{6$ xh/bFldE29cx0nq/~31\~~kKf`2 ޾v8AV}W3q ZO_9msAǽz0՘~@+7 S[#Xڻ"gdp*F:|í>v[m>3JЋXEO[0YX'` DNRă}'7Pک>6: O{0B _D(54Q(o B<,e 㱠n*Ü0iDO3sR(VpOvfa':K]&JJmENd`I08 ]ttE[Rl<-zkOmMC &hmPp+g`l,vw~oy8PLMU"J2gTj"1 fc0kTX̍`T*@k3$⮎ؓS?*  =݆y!B&Q#AV{rO"S-,-L5TN9|&)G^Œ9Gd w')XkE>bS_%1Գ2Ј4UVu9;( 8p.OEDZ, bNDž$-><^TOq =nSHBp(F9fWPK(V mUr rŚߋ}e] )BBcv4_W Mu. DenJ0$%X)dW4@ɁSFnb $%Q*^E e` dh`q̈,S9S|*#p# BM#G("H[d,P*FP X; Q)`(}  \3[EiB 6GŧN C(j[dcQ,kh`.nY J&xr^i2sa6pEfHE\FJ+3S|eF`M$x*LBa`e@P0h覣ex/jmlV^-u1Tj-cܧJycE#g S>>5_?&A+3!-a8'wې=5[|S4B+AFzLfG.dMy~ 58p%ypRM`RBxjXN]9k;bf֩28M$7%qI\Pv]5D#  /AA3xZ\R$wnB% %ªKEzLP ˻lme fdBhTd[Wq,̆o};Pu^aiְ@LjB[U|s|@abvH1sf&G ] bˎfAYQiy.@HZɊD^`{qyA>F&sGgy\!%KLGK|RF*A܌Qj 5tfZ\#lY|(%|pOyR(mZjc\la/*| J$,B ;zBQFj ZcH E.zA9_`xTiRk>\(K\iR/R|鮖2Q:Ej+BW*ɯv 91 ujNbn?a58{U ] s}I| y~wT! ֨dSRGG$mKEyXaV1V7y5١6:=mBR^Gx$mO? \bކ7w \!9eF|(Ggr66uPٙA6b96HW~i?i[CwI 4CqSxT.P Nde- |+Hh ق(܂D#tS tyt@!4њ, * 0W֮}Xl@q㳽)PƎh2v0C|=! S( i SN+';3`Uu_qGnuԑ~$=c  CBun/M#~+j 1X̒@FO}:wh!4j>z{7Ȯ=)Cmo7d]DlAU˱O)a/(KݮRu_nLXÖe%QGZcV]%8oW M x Uz\5$nf%kC'xRmjWaZWߟ;4iUR *'o.#FrO_h~'҂*y#ߡ(`gB@L0Q_Ƚh~Ma9 #:䓲X8ea|TNV/JIFg3bm z[e"֧6v<~_f+<^~P[d&JGO$l(t+kdfQ̪_x( V=!}`芇tRf]luTʫB6jv'PT!;1fwc ADNDKN?+k7qo(P<iB76Qtju Kvrt^  05#IAkwˉT)~8hC - QM32 TzH|X'o*:l"Ę>%e'P(&ϙ>Q{Ve,|7`Pvw@PGadTi\}e"By@- [ vuon^9sO rQ[e6ʃ# 2O y6v^jw6$7&bZ:+dfץvVیTBOҐ,ɞРRcy|f3w(Rg MxB"I&c w.*9;펊4LXT(/Iz[]?jW j*B~#?P60\;5M&kpl慈Ml[OưTxҋO{̵㐁A~!p#cj` 7"}s d $y(,c? Cjz@D@n,lD ;KguF=d2YQ[=:tiO!;kJ{›"FT<2]O5'YI)3-AѠ.@N O^Rt|s< 8EaT=yDqF)1 )$޶: Hkc aՀ/17л~4X-ʺ%9Θk:΄XQr-x3"Pu.h^vT@pRԜrTp9J%Uz4<E {lR)`XVcP 玗wFN>npʌZ4$PioA$^"ؚQ/0:6uV+n:F+]ۆߠKCIUyjўJljNվ92ЁNDT]a o}w˔ @CQQ\jZ:3PNt<l6 L>lRIS*lDH&`bz׵>7d'?Or7Q:}tE2/Maԕ)8"(y:j$w*}.@ gЃ"HB(EM 7F4 x qPWtZl-x1JRw2|+DK,&$6Ǜg.懌U{ >ðtx'{Su櫬{}>^!Wէ up1\١oTmUz>g1ӟᛍp+B?%;;jv祔s^KGN0mO:tJ<Ucy{-2WZ*9=~'Go'))>M*e^ ҧ2zpW~QZW3Bw}ݺ?KOO9|yu[;ُk+dJnq2=m2ʥG9gUfsݍC1w~?` ])ؿ߁t c*=L*yAb cOwaކGtwSD}"4&7PuLB(|bHEuX&k[AurWcm( ?X*Xp %FP<`_qD^[k+ݓϞT*9nTZO]XYZ] -L(<֗\Q%)`(`M%]e>KFlϡ]z5h|4y&|łNO5*>xVNyD:͟qs=2]DFn-xnʮ)uvd~Aw.+D"#]ƒ$IIv]0E{COT@O5-$dqWvnJ…RW'[4D'ԅ3|cH,4|=U+]Eᜈ˞Mx6,[G@VPƉB䧉 z\FOobXPF+UӨ F@Ǫ5]Gf}:v 9ewC:0Υ%M279:o{rG-=Fө%:tN-JsFɻl"rc p\-gfS{$=;s[x}?(9 G2dbVO6έڙSFܚ7v{1͝Ca&X࿈vWGHI fNL)쇌ƫz2Ŀ .=%֌2=}16( tJ:6Df%+>o+*f(W=X"8=niCCPICC profilex}=HPOS"-VuP,8J`Zu0y4iHR\ׂ?Ug]\AIEJ/)}wQa5e11[a! @'ҋx=uSEywߟR&|" xxf9YIRω #e8xfȤbf%C%&(FBegRc{JFHBʨBv):y\2`X@*$gk&ݤ` ~Q 4}l \im~^ok#onkp >!9P(gM9]s:Y-X=9{Z,rG!iTXtXML:com.adobe.xmp Ï pHYs+tIME -aN FIDATx]h[_&q=cD֔AY Y7!-Z7řх TCuєE0v%0K=7QJJjbjmi:HtG?y>lXK0R}fsS<`輞Fw t,!!&xjwt@wt@wt@wt@wt@w@wt@wt@wFj@`*KW" 0PIHT۷1Һדlhq:V N ݸ*1NwTn+": 4X(/O+wW>[wW4{Ա:@Mt/;_Q$$*D9hwНUD9=XZ;WbEzғJ F+33`tj`AwDΞ !}uN*]W:J^'y)%B;;{H|w7SBDDy?XFM'N@w+++scN6LT7GDdeIGw(FWWioAp>f_wMu5 8d/޵*ׅXs]|fisۏ}UPEU5{.=f/x/JXWZr;W&o gYlED^8nxu9לGҶ,ɵR.OΊ֚UK#(7BΉH?v^w}Vt%eQȢx|ζ쭾Vja6ڋ/O^,+HM򎭈~ۮyfζ֢Ff^>2vNY9ݾ)}~5,reFդ-꓈]ظͭA$wwE?O3`#tJ-UڙJ_=1.fntdw`F\ ^fX~}}k<@׋u16>~]xd7ة)HGN`9+wLbL.︳53 8>? tQ [uۛʾ<{LmG)d"c=בV t3bk}}u-^*{nY:Hkެ&S˴d^lD?qŒ#"YyO0TZJv/ XZIHVlLܾ}ty榈ē`bNyX:A\ф-;00^z6᧯Y`a`3dj^?z`b!ES|~p,%P̀T3Fz9t4V.`$wqTze ^ *$sttLʈH0 K r\m ZGD`!+ B 0 b̩O >X;n|g)zz}AB@y5yty;}]ff+e ea;;;@ `<TjP܀!V4@w'1̈́dwt@wt@wt@wt@wt۫J+t=bsȧGD߿Ov@wt@wt%\;;;;DBĤy&sl?ip8'ϝ=QDṅA,Cg|8c#MID~bM$[7.#Xx/33VlEp] ;D$f+ݭ%wGñYWNODnߍbB 9e~tj(LwkFZq;C$8:ѐݡ~ŸՄZeh0q]DbHpthJ:5TUH882-N6eFb"%aDX8Qm0 8ZZRJ&XZZt^~ﴋ7c>""uF)| %2oGwXq O'PfyDWtCDdk3&"PXs~qCmu-j:4s]ŭKA!3 %eOݡ2;Xtt@wCCW)q.%hIENDB`ggalluvial/vignettes/img/hover_empty_area.png0000644000176200001440000004321614367761414021247 0ustar liggesusersPNG  IHDRj'SzTXtRaw profile type exifxڭi7s`?C)&UB{O\^O5?w|.K~>?./Ͽ }(iDׅׅR"|]`|f?NaN_Wכl.'xRH1?dѧ~k u??xyϋY~[;X~η=ٍ\Y5oSy?ɒ__g{;#{!~zv󾯰b'"zWe 7ZiM%w7ށwłR_^^|}_+ CWE@G-𷿿Q\,o~~.1K-QzNSkX"]LHDאJ[؈BzRf1T N7K fj2B V`#,7rhTr)+2jZU߰dيU3kmr+6k͵F=nঃ+>=x34,Nm9*.[ͭƎ;mpbm T:SvT[nvw|ZpߏZ"7Qo7Eo!:HU("F =vDos "rN9n,܋PwmZ@nU]lNa{Jڭxn[ #O,7*jt(5a:k薊mb,yrhF/;:i>4]*Wf3VH)XQbc(mJ8;B[R'Xs5UM͏:z轄<R=P3kh%K]>:Xl󅬯 UeC+9]biq9ۓ59:sɪɗ;ST`^yj) Aed7kxcgI=mF^==InX ; |/.כˈ;vbQEۨj͓rv:ZgF2f# yoVTQme=E^dc3iw2ڛl'b7ykhaȐc{;"s7ruE[ٖsa!nYjP*mo0;F)greT]uRn=\?nb9<Ʉ%ύtpzlr-)Jr4jQ8;DS^`#ҩ@$TFuj:|J$GkQ6K' mߨNw;(jwvW@ڀ bfku!(uibnxg}p@`'^u@2nةodIy=wvn|=42y՘Y3r5x7ejղ9@8|6Ȟ*,%H~7`I>kkŸ)EnFWCfNe @>^ XeZh'VU|JrZCD:f#PV>/Rp~i=1 ^_팜.ѡ?Jo?iK+g ϓzBN}P˱@_Xyt"*yp@ &%Dz7ƍY^+@Qwd6_elrBJJJɈ. ^`%x&#$l#G5<h0p#s`A!q57㠊Y a9ئ硊s.0މ XZH ;0ZG#=5hc:>5jH*/c*+> mK!P:eIQdn>8AkrjL ^ RT:K%^dvʐ O.(F%$zxHۓCZ&R:;9ޡQ n[e`hR:(5zeA* ̲@i,H(8#d,v΂E ņ37n= \EU"4Ƈ"5dZCk5I?=c^tJ*Q?|]fH&A8AOK^ o2QKL*y K@͐Ĥ5Qk/Z,6S؏%톇!P|>ƞs1I;4x$3w{k"xs_ש&QM y] o+r+,aYڤK.z Dž yi<IJrAv ϋ :>qp~C9*%D΍N4uiD+ttUc1a:iE |9͈jA3jrxN imbQԚ}O8%>>‚cv1$0Y3mI)ę)V܍)c1Ρ}Щ CZmr[2 dtIGQL*Wt[uv6K4yuAg;6y+γL!%Bw2Lk:Š LrAWGGѢg?UM=R=sRMo)U2ކ+u-h(-mQDuOe%bReb8oυqV͆kpM]c[4joP}gd,d  9`&5WA6%rMҚMn%e!STaO};2d_g먒~fO+eSR pZI SF;1ƭz#rd&5)}r0R- n&9qr͘PgAm\Fxgn4L e M<+SvHxu^g[iLj{<[葞SFI$gsi K{}0v;yuK\FvN_I(V]51NvCɣ/i%K:f3 z@!#L1yȿ|vw^(Ǡ"D8+mO2`,>7 ^5vIqpߓ81v=-tXEg"ӠVlѩ щK*Z"qu8pJ]5"0CTf_MOS5p"G3᠕B>" ":r|uj4ߏDHrJk]D97BgtBZДǮbAv yw9`0\[zg~ ДT oS]5|*}V#ȡ)BqZO#5؄89B!qtO=Xξn4Ӆ}w~5LPE;]/o$GQ gUT:i]=?Q^,Jﬧl$f:h]v%ZHM')b]|գήKc?L.P| 'X%B sxb A QAL(!œz h YzGYGhtx;6d~:M{L *B CxP1}_TRϯ9>ީ7k`'Qi:oA ['dyՔzyz]exuơG Bj , A͇^Srj 'SJb%'8mO)\d)֨UbF&V2DŽVT(O&C#jU2,!OAq|LX"HcE#ؾ3֤Bv;d΋/~&60H{T;=sj}gk8`ZRw.nT!Ҧ+"I=%kOq1_rF2]-Vھ7C"cQв -pzzTuqC=3L̴I'lmq:f=qֳ,GUW&1K!tδayM\ژ !0x%5d3L:=S4 OgY=`Wrw`Y%k.MKlD1ԕ[S+schsF֑)+he V$z>\\'jw>|JtTg݀D?orG jz MZm'r&Q[tP@*ZDW&m\h[ ,:)0%dS8z(kQ^s@ۋ^IPtnׁt1:e wܟ pjA'jAn +Q]Q7E;m8ZٝFXxB |R fTudx>A! <-7dҡշ)&Ans:H2=żg2IjG ʊ5YV`e 勉vЪ:NhUh,7jO7b]GBKmf3Jm#AXNoh[/OԍmH%TY مtGd;eGJHpױq$tH?Zy#O$o88"xY{sh:zC3!l@z S}Q4^`: O  A1Q]Hь,LQw.?zxQ覧q'#C{^;:ye? ,,rK힔F\[v!?s>v4`ג6X=Xpqq r|y^]ϗ[?_ Y[i=,܌=$:z>MsURk˖95Y̒8׹XA]nB!/Yc^hAL:u=a(ʫ 7Ԣi]o( =/ <ɷ-;dQ/GO g7LA#""x Haqˮ(=FԓyŷB|=} 8gQ ֵ9Arnje_6^}%T쏪]XY錉} FMf/w>'ԣyG68=N'u 㾼 $I`~P؛ՄG PTt_OOǿoCo/~s1ӋE\U8Ӌ z1r?ww/N[b?u1_]J߮'5O$08sTuyQ.IiCCPICC profilex}=HPOS"-VuP,8J`Zu0y4iHR\ׂ?Ug]\AIEJ/)}wQa5e11[a! @'ҋx=uSEywߟR&|" xxf9YIRω #e8xfȤbf%C%&(FBegRc{JFHBʨBv):y\2`X@*$gk&ݤ` ~Q 4}l \im~^ok#onkp >!9P(gM9]s:Y-X=9{Z,rG!iTXtXML:com.adobe.xmp uH pHYs+tIME N2g IDATxOV30Pfe@pMd).;E ]v;WU,]Zp1EtVE被d7T`릐@`i"ad\}{<|7ft޹ZЂ0~ī=B{3-%(w$k#áKwotXFtso{jn"*Kz&Dc֎{&aZ5>ݹH(ʽ^-=}g1WϽY~~rO ρ{{O7ʽGy&܃B_~gcW)? |߼!x|lNRCdb|s)Яg,?UK[,FS>c]A[UC )~)ܟf6b[OT qLJ_^U|]xG1.PƘyCbAp yߝ<\|b~³r4d$VD|{cLQlA93nZS^:R򎎾ߊ׃VŤBMwJ:< }n \> @=({!su;?rtZ<GΒΌO~__]}L?}opcѲ9r=$\=x̓I>zuqc1sWɓ?1؇vRq)TVAw,\do7mM Ies*3{/#S܇/ݺߜ$.ù:=Dwdwr0{ DJ.ΐDKnm-;޴3f=TT#o{޾'s}13J7vW+uflf=%~^}'~:ͮ߸ϊ%^7uv>}aiG&ݕJRЭZ iҹ~o!G#ߝ5Ž_7S@pO˙Zs7n[z@SMic>nwKhROC/"jWc~̾6{j`!2}to `<&ǯ{ofH::E2AÉOWYPAEqtYUf}z/Wݿ<&nbH=r3^Ч/yGC/ֽ=ޱD M?%wkDt^o^zi1>{4 wЏ|< lV$~CŴ 5Ţ}M>3_L[yV)zI@ПnЇ^2=& }U1etVKX =sF/yUְ[.w֕pyuSq#/{N1;#<1<{Th'giM7Ƚ/nQ7;/c{]0on{8͇ۺ7kbK0{=OTf0n7h4nq8GK5pYt-MgTZj>g_w3dcv+{+Эx8b{s_l~½8ҖX^'ɩ]˂jx0F}ЇUZZށ B]z3`0+ޜM>i%;iw54. .}|;?d M9wOw{j!i]Kۉ@/;{5ZÈ~\*6\4ݫC^VhbaJ5p}fKЍF&z@=,, =?z=|t{6=})]f3'n*=3=3M{q)s۵টgxFӧO|~?^$9L:hw;wB;INh$p'Ĺ>$9% ՝wBN ;!p'wwBN ;!p'wBN ;!p'D[N8U TwBlxMwBN ;!p'wBN ;!p'2+pWA}68IENDB`ggalluvial/vignettes/labels.rmd0000644000176200001440000001537114367761414016403 0ustar liggesusers--- title: "Labeling small strata" author: "Jason Cory Brunson" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{labeling small strata} %\VignetteEngine{knitr::rmarkdown} \usepackage[utf8]{inputenc} --- ## Setup This brief vignette uses the `vaccinations` dataset included in {ggalluvial}. As in [the technical introduction](http://corybrunson.github.io/ggalluvial/articles/ggalluvial.html), the order of the levels is reversed to be more intuitive. Objects from other {ggplot2} extensions are accessed via `::` and `:::`. ```{r setup} knitr::opts_chunk$set(fig.width = 6, fig.height = 4, fig.align = "center") library(ggalluvial) data(vaccinations) vaccinations <- transform(vaccinations, response = factor(response, rev(levels(response)))) ``` ## Problem The issue on the table: Strata are most helpful when they're overlaid with text labels. Yet the strata often vary in height, and the labels in length, to such a degree that fitting the text inside the strata at a uniform size renders them illegible. In principle, the user could treat `size` as a variable aesthetic and manually fit text to strata, but this is cumbersome, and doesn't help anyway in cases where large text is needed. To illustrate the problem, check out the plot below. It's by no means an egregious case, but it'll do. (For a more practical example, see [this question on StackOverflow](https://stackoverflow.com/questions/50720718/labelling-and-theme-of-ggalluvial-plot-in-r), which prompted this vignette.) ```{r raw} ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response, label = response)) + scale_x_discrete(expand = c(.1, 0)) + geom_flow(width = 1/4) + geom_stratum(alpha = .5, width = 1/4) + geom_text(stat = "stratum", size = 4) + theme(legend.position = "none") + ggtitle("vaccination survey responses", "labeled using `geom_text()`") ``` ### Fix One option is to simply omit those labels that don't fit within their strata. In response to [an issue](https://github.com/corybrunson/ggalluvial/issues/27), `v0.9.2` includes parameters in `stat_stratum()` to exclude strata outside a specified height range; while few would use this to omit the rectangles themselves, it can be used in tandem with `geom_text()` to shirk this problem, at least when the labels are concise: ```{r omit} ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response, label = response)) + scale_x_discrete(expand = c(.1, 0)) + geom_flow(width = 1/4) + geom_stratum(alpha = .5, width = 1/4) + geom_text(stat = "stratum", size = 4, min.y = 100) + theme(legend.position = "none") + ggtitle( "vaccination survey responses", "labeled using `geom_text()` with `min.y = 100`" ) ``` This is a useful fix for some cases. Still, if the goal is a publication-ready graphic, then it reaffirms the need for more adaptable and elegant solutions. Fortunately, two wonderful packages deliver with, shall we say, flowing colors. ## Solutions Two {ggplot2} extensions are well-suited to this problem: [{ggrepel}](https://github.com/slowkow/ggrepel) and [{ggfittext}](https://github.com/wilkox/ggfittext). They provide new geom layers that use the output of existing stat layers to situate text: `ggrepel::geom_text_repel()` takes the same aesthetics as `ggplot2::geom_text()`, namely `x`, `y`, and `label`. In contrast, `ggfittext::geom_fit_text()` only specifically requires `label` but also needs enough information to determine the rectangle that will contain the text. This can be encoded as `xmin` and `xmax` or as `x` and `width` for the horizontal direction, and as `ymin` and `ymax` or as `y` and `height` for the vertical direction. Conveniently, `ggalluvial::stat_stratum()` produces more than enough information for both geoms, including `x`, `xmin`, `xmax`, and their vertical counterparts. All this can be gleaned from the `ggproto` objects that construct the layers: ```{r aesthetics} print(ggrepel::GeomTextRepel$required_aes) print(ggfittext:::GeomFitText$required_aes) print(ggfittext:::GeomFitText$setup_data) print(StatStratum$compute_panel) ``` I reached the specific solutions through trial and error. They may not be the best tricks for most cases, but they demonstrate what these packages can do. For many more examples, see the respective package vignettes: [for {ggrepel}](https://CRAN.R-project.org/package=ggrepel/vignettes/ggrepel.html), and [for {ggfittext}](https://CRAN.R-project.org/package=ggfittext/vignettes/introduction-to-ggfittext.html). ### Solution 1: {ggrepel} {ggrepel} is most often (in my experience) used to repel text away from symbols in a scatterplot, in whatever directions prevent them from overlapping the symbols and each other. In this case, however, it makes much more sense to align them vertically a fixed horizontal distance (`nudge_x`) away from the strata and repel them vertically from each other (`direction = "y"`) just enough to print them without overlap. It takes an extra bit of effort to render text _only_ for the strata at the first (or at the last) axis, but the result is worth it. ```{r ggrepel} ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + scale_x_discrete(expand = c(.4, 0)) + geom_flow(width = 1/4) + geom_stratum(alpha = .5, width = 1/4) + scale_linetype_manual(values = c("blank", "solid")) + ggrepel::geom_text_repel( aes(label = ifelse(as.numeric(survey) == 1, as.character(response), NA)), stat = "stratum", size = 4, direction = "y", nudge_x = -.5 ) + ggrepel::geom_text_repel( aes(label = ifelse(as.numeric(survey) == 3, as.character(response), NA)), stat = "stratum", size = 4, direction = "y", nudge_x = .5 ) + theme(legend.position = "none") + ggtitle("vaccination survey responses", "labeled using `geom_text_repel()`") ``` ### Solution 2: {ggfittext} {ggfittext} is simplicity itself: The strata are just rectangles, so no more parameter specifications are necessary to fit the text into them. One key parameter is `min.size`, which defaults to `4` and controls how small the text is allowed to get without being omitted. ```{r ggfittext} ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response, label = response)) + scale_x_discrete(expand = c(.1, 0)) + geom_flow(width = 1/4) + geom_stratum(alpha = .5, width = 1/4) + ggfittext::geom_fit_text(stat = "stratum", width = 1/4, min.size = 3) + theme(legend.position = "none") + ggtitle("vaccination survey responses", "labeled using `geom_fit_text()`") ``` Note that this solution requires {ggfittext} v0.6.0. ## Appendix ```{r session info} sessioninfo::session_info() ``` ggalluvial/vignettes/ggalluvial.rmd0000644000176200001440000004061114367761414017263 0ustar liggesusers--- title: "Alluvial Plots in ggplot2" author: "Jason Cory Brunson" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{alluvial plots in ggplot2} %\VignetteEngine{knitr::rmarkdown} \usepackage[utf8]{inputenc} --- The {ggalluvial} package is a {ggplot2} extension for producing alluvial plots in a [{tidyverse}](https://github.com/tidyverse) framework. The design and functionality were originally inspired by the [{alluvial}](https://github.com/mbojan/alluvial) package and have benefitted from the feedback of many users. This vignette - defines the essential components of alluvial plots as used in the naming schemes and documentation (_axis_, _alluvium_, _stratum_, _lode_, _flow_), - describes the alluvial data structures recognized by {ggalluvial}, - illustrates the new stats and geoms, and - showcases some popular variants on the theme and how to produce them. Unlike most alluvial and related diagrams, the plots produced by {ggalluvial} are uniquely determined by the data set and statistical transformation. The distinction is detailed in [this blog post](https://corybrunson.github.io/2019/09/13/flow-taxonomy/). Many other resources exist for visualizing categorical data in R, including several more basic plot types that are likely to more accurately convey proportions to viewers when the data are not so structured as to warrant an alluvial plot. In particular, check out Michael Friendly's [{vcd} and {vcdExtra} packages](https://friendly.github.io/vcdExtra/) for a variety of statistically-motivated categorical data visualization techniques, Hadley Wickham's [{productplots} package](https://github.com/hadley/productplots) and Haley Jeppson and Heike Hofmann's descendant [{ggmosaic} package](https://CRAN.R-project.org/package=ggmosaic/vignettes/ggmosaic.html) for product or mosaic plots, and Nicholas Hamilton's [{ggtern} package](http://www.ggtern.com/) for ternary coordinates. Other related packages are mentioned below. ```{r setup, echo=FALSE, message=FALSE, results='hide'} library(ggalluvial) knitr::opts_chunk$set(fig.width = 6, fig.height = 4, fig.align = "center") ``` ## Alluvial plots Here's a quintessential alluvial plot: ```{r example alluvial plot using Titanic dataset, echo=FALSE} ggplot(data = to_lodes_form(as.data.frame(Titanic), key = "Demographic", axes = 1:3), aes(x = Demographic, stratum = stratum, alluvium = alluvium, y = Freq, label = stratum)) + scale_x_discrete(expand = c(.05, .05)) + geom_alluvium(aes(fill = Survived)) + geom_stratum() + geom_text(stat = "stratum") + ggtitle("passengers on the maiden voyage of the Titanic", "stratified by demographics and survival") ``` The next section details how the elements of this image encode information about the underlying dataset. For now, we use the image as a point of reference to define the following elements of a typical alluvial plot: - An _axis_ is a dimension (variable) along which the data are vertically arranged at a fixed horizontal position. The plot above uses three categorical axes: `Class`, `Sex`, and `Age`. - The groups at each axis are depicted as opaque blocks called _strata_. For example, the `Class` axis contains four strata: `1st`, `2nd`, `3rd`, and `Crew`. - Horizontal (x-) splines called _alluvia_ span the width of the plot. In this plot, each alluvium corresponds to a fixed value of each axis variable, indicated by its vertical position at the axis, as well as of the `Survived` variable, indicated by its fill color. - The segments of the alluvia between pairs of adjacent axes are _flows_. - The alluvia intersect the strata at _lodes_. The lodes are not visualized in the above plot, but they can be inferred as filled rectangles extending the flows through the strata at each end of the plot or connecting the flows on either side of the center stratum. As the examples in the next section will demonstrate, which of these elements are incorporated into an alluvial plot depends on both how the underlying data is structured and what the creator wants the plot to communicate. ## Alluvial data {ggalluvial} recognizes two formats of "alluvial data", treated in detail in the following subsections, but which basically correspond to the "wide" and "long" formats of categorical repeated measures data. A third, tabular (or array), form is popular for storing data with multiple categorical dimensions, such as the `Titanic` and `UCBAdmissions` datasets.[^tableform] For consistency with tidy data principles and {ggplot2} conventions, {ggalluvial} does not accept tabular input; `base::as.data.frame()` converts such an array to an acceptable data frame. [^tableform]: See Friendly's tutorial, linked above, for a discussion. ### Alluvia (wide) format The wide format reflects the visual arrangement of an alluvial plot, but "untwisted": Each row corresponds to a cohort of observations that take a specific value at each variable, and each variable has its own column. An additional column contains the quantity of each row, e.g. the number of observational units in the cohort, which may be used to control the heights of the strata.[^weight-y] Basically, the wide format consists of _one row per alluvium_. This is the format into which the base function `as.data.frame()` transforms a frequency table, for instance the 3-dimensional `UCBAdmissions` dataset: ```{r alluvia format of Berkeley admissions dataset} head(as.data.frame(UCBAdmissions), n = 12) is_alluvia_form(as.data.frame(UCBAdmissions), axes = 1:3, silent = TRUE) ``` This format is inherited from the first release of {ggalluvial}, which modeled it after usage in {alluvial}: The user declares any number of axis variables, which `stat_alluvium()` and `stat_stratum()` recognize and process in a consistent way: ```{r alluvial plot of UC Berkeley admissions dataset} ggplot(as.data.frame(UCBAdmissions), aes(y = Freq, axis1 = Gender, axis2 = Dept)) + geom_alluvium(aes(fill = Admit), width = 1/12) + geom_stratum(width = 1/12, fill = "black", color = "grey") + geom_label(stat = "stratum", aes(label = after_stat(stratum))) + scale_x_discrete(limits = c("Gender", "Dept"), expand = c(.05, .05)) + scale_fill_brewer(type = "qual", palette = "Set1") + ggtitle("UC Berkeley admissions and rejections, by sex and department") ``` An important feature of these plots is the meaningfulness of the vertical axis: No gaps are inserted between the strata, so the total height of the plot reflects the cumulative quantity of the observations. The plots produced by {ggalluvial} conform (somewhat; keep reading) to the "grammar of graphics" principles of {ggplot2}, and this prevents users from producing "free-floating" visualizations like the Sankey diagrams showcased [here](https://developers.google.com/chart/interactive/docs/gallery/sankey).[^ggforce] {ggalluvial} parameters and native {ggplot2} functionality can also produce [parallel sets](https://eagereyes.org/parallel-sets) plots, illustrated here using the `HairEyeColor` dataset:[^ggparallel][^crayola] [^ggforce]: [The {ggforce} package](https://github.com/thomasp85/ggforce) includes parallel set geom and stat layers to produce similar diagrams that can be allowed to free-float. [^ggparallel]: A greater variety of parallel sets plots are implemented in the [{ggparallel}](https://github.com/heike/ggparallel) and [{ggpcp}](https://github.com/yaweige/ggpcp) packages. [^crayola]: Eye color hex codes are taken from [Crayola's Colors of the World crayons](https://en.wikipedia.org/wiki/List_of_Crayola_crayon_colors). ```{r parallel sets plot of hair and eye color dataset} ggplot(as.data.frame(HairEyeColor), aes(y = Freq, axis1 = Hair, axis2 = Eye, axis3 = Sex)) + geom_alluvium(aes(fill = Eye), width = 1/8, knot.pos = 0, reverse = FALSE) + scale_fill_manual(values = c(Brown = "#70493D", Hazel = "#E2AC76", Green = "#3F752B", Blue = "#81B0E4")) + guides(fill = "none") + geom_stratum(alpha = .25, width = 1/8, reverse = FALSE) + geom_text(stat = "stratum", aes(label = after_stat(stratum)), reverse = FALSE) + scale_x_continuous(breaks = 1:3, labels = c("Hair", "Eye", "Sex")) + coord_flip() + ggtitle("Eye colors of 592 subjects, by sex and hair color") ``` (The warning is due to the "Hair" and "Eye" axes having the value "Brown" in common.) This format and functionality are useful for many applications and will be retained in future versions. They also involve some conspicuous deviations from {ggplot2} norms: - The `axis[0-9]*` position aesthetics are non-standard: they are not an explicit set of parameters but a family based on a regular expression pattern; and at least one, but no specific one, is required. - `stat_alluvium()` ignores any argument to the `group` aesthetic; instead, `StatAlluvium$compute_panel()` uses `group` to link the rows of the internally-transformed dataset that correspond to the same alluvium. - The horizontal axis must be manually corrected (using `scale_x_discrete()` or `scale_x_continuous()`) to reflect the implicit categorical variable identifying the axis. Furthermore, format aesthetics like `fill` are necessarily fixed for each alluvium; they cannot, for example, change from axis to axis according to the value taken at each. This means that, although they can reproduce the branching-tree structure of parallel sets, this format cannot be used to produce alluvial plots with color schemes such as those featured [here](https://developers.google.com/chart/interactive/docs/gallery/sankey) ("Controlling colors"), which are "reset" at each axis. Note also that the `stratum` variable produced by `stat_stratum()` (called by `geom_text()`) is computed during the statistical transformation and must be recovered using `after_stat()` as a [calculated aesthetic](https://corybrunson.github.io/2020/04/17/calculate-aesthetics/). ### Lodes (long) format The long format recognized by {ggalluvial} contains _one row per lode_, and can be understood as the result of "gathering" (in a deprecated {dplyr} sense) or "pivoting" (in the Microsoft Excel or current {dplyr} sense) the axis columns of a dataset in the alluvia format into a key-value pair of columns encoding the axis as the key and the stratum as the value. This format requires an additional indexing column that links the rows corresponding to a common cohort, i.e. the lodes of a single alluvium: ```{r lodes format of Berkeley admissions dataset} UCB_lodes <- to_lodes_form(as.data.frame(UCBAdmissions), axes = 1:3, id = "Cohort") head(UCB_lodes, n = 12) is_lodes_form(UCB_lodes, key = x, value = stratum, id = Cohort, silent = TRUE) ``` The functions that convert data between wide (alluvia) and long (lodes) format include several parameters that help preserve ancillary information. See `help("alluvial-data")` for examples. The same stat and geom can receive data in this format using a different set of positional aesthetics, also specific to {ggalluvial}: - `x`, the "key" variable indicating the axis to which the row corresponds, which are to be arranged along the horizontal axis; - `stratum`, the "value" taken by the axis variable indicated by `x`; and - `alluvium`, the indexing scheme that links the rows of a single alluvium. Heights can vary from axis to axis, allowing users to produce bump charts like those showcased [here](https://imgur.com/gallery/gI5p7).[^geom-area] In these cases, the strata contain no more information than the alluvia and often are not plotted. For convenience, both `stat_alluvium()` and `stat_flow()` will accept arguments for `x` and `alluvium` even if none is given for `stratum`.[^arguments] As an example, we can group countries in the `Refugees` dataset by region, in order to compare refugee volumes at different scales: [^geom-area]: If bumping is unnecessary, consider using [`geom_area()`](https://r-graph-gallery.com/136-stacked-area-chart) instead. [^arguments]: `stat_stratum()` will similarly accept arguments for `x` and `stratum` without `alluvium`. If both strata and either alluvia or flows are to be plotted, though, all three parameters need arguments. ```{r time series alluvia plot of refugees dataset} data(Refugees, package = "alluvial") country_regions <- c( Afghanistan = "Middle East", Burundi = "Central Africa", `Congo DRC` = "Central Africa", Iraq = "Middle East", Myanmar = "Southeast Asia", Palestine = "Middle East", Somalia = "Horn of Africa", Sudan = "Central Africa", Syria = "Middle East", Vietnam = "Southeast Asia" ) Refugees$region <- country_regions[Refugees$country] ggplot(data = Refugees, aes(x = year, y = refugees, alluvium = country)) + geom_alluvium(aes(fill = country, colour = country), alpha = .75, decreasing = FALSE) + scale_x_continuous(breaks = seq(2003, 2013, 2)) + theme_bw() + theme(axis.text.x = element_text(angle = -30, hjust = 0)) + scale_fill_brewer(type = "qual", palette = "Set3") + scale_color_brewer(type = "qual", palette = "Set3") + facet_wrap(~ region, scales = "fixed") + ggtitle("refugee volume by country and region of origin") ``` The format allows us to assign aesthetics that change from axis to axis along the same alluvium, which is useful for repeated measures datasets. This requires generating a separate graphical object for each flow, as implemented in `geom_flow()`. The plot below uses a set of (changes to) students' academic curricula over the course of several semesters. Since `geom_flow()` calls `stat_flow()` by default (see the next example), we override it with `stat_alluvium()` in order to track each student across all semesters: ```{r alluvial plot of majors dataset} data(majors) majors$curriculum <- as.factor(majors$curriculum) ggplot(majors, aes(x = semester, stratum = curriculum, alluvium = student, fill = curriculum, label = curriculum)) + scale_fill_brewer(type = "qual", palette = "Set2") + geom_flow(stat = "alluvium", lode.guidance = "frontback", color = "darkgray") + geom_stratum() + theme(legend.position = "bottom") + ggtitle("student curricula across several semesters") ``` The stratum heights `y` are unspecified, so each row is given unit height. This example demonstrates one way {ggalluvial} handles missing data. The alternative is to set the parameter `na.rm` to `TRUE`.[^na.rm] Missing data handling (specifically, the order of the strata) also depends on whether the `stratum` variable is character or factor/numeric. [^na.rm]: Be sure to set `na.rm` consistently in each layer, in this case both the flows and the strata. Finally, lode format gives us the option to aggregate the flows between adjacent axes, which may be appropriate when the transitions between adjacent axes are of primary importance. We can demonstrate this option on data from the influenza vaccination surveys conducted by the [RAND American Life Panel](https://alpdata.rand.org/). The data, including one question from each of three surveys, has been aggregated by response profile: Each "subject" (mapped to `alluvium`) actually represents a cohort of subjects who responded the same way on all three questions, and the size of each cohort (mapped to `y`) is recorded in "freq". ```{r alluvial plot of vaccinations dataset} data(vaccinations) vaccinations <- transform(vaccinations, response = factor(response, rev(levels(response)))) ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response, label = response)) + scale_x_discrete(expand = c(.1, .1)) + geom_flow() + geom_stratum(alpha = .5) + geom_text(stat = "stratum", size = 3) + theme(legend.position = "none") + ggtitle("vaccination survey responses at three points in time") ``` This plot ignores any continuity between the flows between axes. This "memoryless" statistical transformation yields a less cluttered plot, in which at most one flow proceeds from each stratum at one axis to each stratum at the next, but at the cost of being able to track each cohort across the entire plot. ## Appendix ```{r session info} sessioninfo::session_info() ``` [^weight-y]: Previously, quantities were passed to the `weight` aesthetic rather than to `y`. This prevented `scale_y_continuous()` from correctly transforming scales, and anyway it was inconsistent with the behavior of `geom_bar()`. As of version 0.12.0, `weight` is an optional parameter used only by computed variables intended for labeling, not by polygonal graphical elements. ggalluvial/vignettes/shiny.Rmd0000644000176200001440000005112114367761414016224 0ustar liggesusers--- title: "Tooltips for ggalluvial plots in Shiny apps" author: "Quentin D. Read" date: "`r Sys.Date()`" output: rmarkdown::html_vignette: self_contained: no runtime: shiny vignette: > %\VignetteIndexEntry{ggalluvial in Shiny apps} %\VignetteEngine{knitr::rmarkdown} \usepackage[utf8]{inputenc} --- ```{r setup, echo = FALSE, message = FALSE, warning = FALSE} knitr::opts_chunk$set(fig.width = 6, fig.height = 3, fig.align = "center") library(ggalluvial) pdf(NULL) ``` ## Problem In an interactive visualization, it is visually cleaner and better for interpretation if labels and other information appear as "tooltips" when the user hovers over or clicks on elements of the plot, rather than displaying all the labels on the plot at one time. However, the {ggalluvial} package does not natively include this functionality. It is possible to enable this using functions from several other packages. This vignette illustrates how to create Shiny apps that display an alluvial plot with tooltips that appear when the user hovers over two different plot elements: strata created with `geom_stratum()` and alluvia created with `geom_alluvium()`. An example is provided for wide-format alluvial data (the `UCBAdmissions` dataset) and long-format alluvial data (the `vaccinations` dataset). The tooltips that appear when the user hovers over elements of the plot show a text label and the count in each group. If the user hovers or clicks somewhere inside a ggplot panel, Shiny automatically returns information about the location of the mouse cursor *in plot coordinates*. That means the main work we have to do is to extract or manually recalculate the coordinates of the different plot elements. With that information, we can determine which plot element the cursor is hovering over and display the appropriate information in the tooltip or other output method. _Note:_ The app demonstrated here depends on the packages {htmltools} and {sp}, in addition of course to {ggalluvial} and {shiny}. Please be aware that all of these packages will need to be installed on the server where your Shiny app is running. ### Hovering over and clicking on strata Enabling hovering over and clicking on strata is straightforward because of their rectangular shape. We only need the minimum and maximum `x` and `y` coordinates for each of the rectangles. The rectangles are evenly spaced along the x-axis, centered on positive integers beginning with 1. The width is set in `geom_stratum()` so, for example, we know that the x-coordinates of the first stratum are `c(1 - width/2, 1 + width/2)`. The y-coordinates can be determined from the number of rows in the input data multiplied by their weights. ### Hovering over and clicking on alluvia Hovering over and clicking on alluvia are more difficult because the shapes of the alluvia are more complex. The default shape of the polygons includes an `xspline` curve drawn using the {grid} package. We need to manually reconstruct the coordinates of the polygons, then use `sp::pointInPolygon()` to detect which, if any, polygons the cursor is over. ## App with wide-format alluvial data The app is embedded below, followed by a walkthrough of the source code. If you aren't connected to the internet, or if you loaded this vignette using `vignette('shiny', package = 'ggalluvial')` rather than `browseVignettes(package = 'ggalluvial')`, the app will not display in the window above. You can view the app locally by running this line of code in your console: ```{r run wide app locally, eval = FALSE} shiny::shinyAppDir(system.file("examples/ex-shiny-wide-data", package="ggalluvial")) ``` ## Structure of the example app Here, we will go over each section of the code in detail. The full source code is included in the package's `examples` directory. The app first (1) loads the data and (2) builds the plot. Then, (3) information is extracted from the built plot object to (4) manually recalculate the coordinates of the polygons that make up the plot. Internally, {ggalluvial} uses the {grid} package to draw the polygons, so the next steps are (5) to define the minima and maxima of the x and y axes in {grid} units and the units that appear on the plot's coordinate system, and (6) to convert the polygon coordinates from {grid} units plot units. Next, the user interface is defined, including output of (7) the plot image and (8) the tooltip. The final block of code is the server function, which first (9) renders the plot. Finally, the tooltip is defined. This includes (10) logic to determine whether the mouse cursor is inside the plot panel, then (11) whether it is hovering over a stratum, (12) an alluvium, or neither, based on the mouse coordinates provided by Shiny. If the mouse is hovering over a plot element, the app finds appropriate information and prints it in a small "tooltip" box next to the mouse cursor (11b and 12b). This is the structure of the app in pseudocode. ```{r pseudocode, eval = FALSE} '<(1) Load data.>' '<(2) Create "ggplot" object for alluvial plot and build it.>' '<(3) Extract data from built plot object used to create alluvium polygons.>' for (polygon in polygons) { '<(4) Use polygon splines to generate coordinates of alluvium boundaries.>' } '<(5) Define range of coordinates in grid units and plot units.>' for (polygon in polygons) { '<(6) Convert coordinates from grid units to plot units.>' } ui <- fluidPage( '<(7) Output plot with hovering enabled.>' '<(8) Output tooltip.>' ) server <- function(input, output, session) { output$alluvial_plot <- renderPlot({ '<(9) Render the plot.>' }) output$tooltip <- renderText({ if ('<(10) mouse cursor is within the plot panel>') { if ('<(11) mouse cursor is within a stratum box>') { '<(11b) Render stratum tooltip.>' } else { if ('<(12) mouse cursor is within an alluvium polygon>') { '<(12b) Render alluvium tooltip.>' } } } }) } ``` ### Loading data The UC-Berkeley admissions dataset, `UCBAdmissions`, is used in this example. After loading the necessary packages, the first thing we do in the app is load the data and coerce from array to data frame. ```{r load dataset, eval = FALSE} data(UCBAdmissions) ucb_admissions <- as.data.frame(UCBAdmissions) ``` Next we set `offset`, the distance from cursor to tooltip, in pixels, in both x and y directions. We also set `node_width` and `alluvium_width` here, which are used as arguments to `geom_stratum()` and `geom_alluvium()` below, and again later to determine whether the mouse cursor is hovering over a stratum/alluvium. ```{r set options, eval = FALSE} # Offset, in pixels, for location of tooltip relative to mouse cursor, # in both x and y direction. offset <- 5 # Width of node boxes node_width <- 1/4 # Width of alluvia alluvium_width <- 1/3 ``` ### Drawing the plot and extracting coordinates Next, we create the `ggplot` object for the alluvial plot, then we call the `ggplot_build()` function to build the plot without displaying it. ```{r draw and build plot, eval = FALSE} # Draw plot. p <- ggplot(ucb_admissions, aes(y = Freq, axis1 = Gender, axis2 = Dept)) + geom_alluvium(aes(fill = Admit), knot.pos = 1/4, width = alluvium_width) + geom_stratum(width = node_width, reverse = TRUE, fill = 'black', color = 'grey') + geom_label(aes(label = after_stat(stratum)), stat = "stratum", reverse = TRUE, size = rel(2)) + theme_bw() + scale_fill_brewer(type = "qual", palette = "Set1") + scale_x_discrete(limits = c("Gender", "Dept"), expand = c(.05, .05)) + scale_y_continuous(expand = c(0, 0)) + ggtitle("UC Berkeley admissions and rejections", "by sex and department") + theme(plot.title = element_text(size = rel(1)), plot.subtitle = element_text(size = rel(1)), legend.position = 'bottom') # Build the plot. pbuilt <- ggplot_build(p) ``` Now for the hard part: reverse-engineering the coordinates of the alluvia polygons. This makes use of `pbuilt$data[[1]]`, a data frame with the individual elements of the alluvial plot. We add an additional column for `width` using the value we set above, then split the data frame by group (groups correspond to the individual alluvium polygons). We apply the function `data_to_alluvium()` to each element of the list to get the coordinates of the "skeleton" of the x-spline curve. Then, we pass these coordinates to the function `grid::xsplineGrob()` to fill in the smooth spline curves and convert them into a {grid} object. We pass the resulting object to `grid::xsplinePoints()`, which converts back into numeric vectors. At this point we now have the coordinates of the alluvium polygons. The object `xspline_points` is a list with length equal to the number of alluvium polygons in the plot. Each element of the list is a list with elements `x` and `y`, which are numeric vectors. ```{r get xsplines and draw curves, eval = FALSE} # Add width parameter, and then convert built plot data to xsplines data_draw <- transform(pbuilt$data[[1]], width = alluvium_width) groups_to_draw <- split(data_draw, data_draw$group) group_xsplines <- lapply(groups_to_draw, data_to_alluvium) # Convert xspline coordinates to grid object. xspline_coords <- lapply( group_xsplines, function(coords) grid::xsplineGrob(x = coords$x, y = coords$y, shape = coords$shape, open = FALSE) ) # Use grid::xsplinePoints to draw the curve for each polygon xspline_points <- lapply(xspline_coords, grid::xsplinePoints) ``` The coordinates we have are in {grid} plotting units but we need to convert them into the same units as the axes on the plot. We do this by determining the range of the x and y-axes in {grid} units (`xrange_old` and `yrange_old`). Then we fix the range of the x axis as 1 to the number of strata, adjusted by half the alluvium width on each side. Next we fix the range of the y-axis to the sum of the counts across all alluvia at one node. ```{r get coordinate ranges, eval = FALSE} # Define the x and y axis limits in grid coordinates (old) and plot # coordinates (new) xrange_old <- range(unlist(lapply( xspline_points, function(pts) as.numeric(pts$x) ))) yrange_old <- range(unlist(lapply( xspline_points, function(pts) as.numeric(pts$y) ))) xrange_new <- c(1 - alluvium_width/2, max(pbuilt$data[[1]]$x) + alluvium_width/2) yrange_new <- c(0, sum(pbuilt$data[[2]]$count[pbuilt$data[[2]]$x == 1])) ``` We define a function `new_range_transform()` inline and apply it to each set of coordinates. This returns another list, `polygon_coords`, with the same structure as `xspline_points`. Now we have the coordinates of the polygons in plot units! ```{r transform coordinates, eval = FALSE} # Define function to convert grid graphics coordinates to data coordinates new_range_transform <- function(x_old, range_old, range_new) { (x_old - range_old[1])/(range_old[2] - range_old[1]) * (range_new[2] - range_new[1]) + range_new[1] } # Using the x and y limits, convert the grid coordinates into plot coordinates. polygon_coords <- lapply(xspline_points, function(pts) { x_trans <- new_range_transform(x_old = as.numeric(pts$x), range_old = xrange_old, range_new = xrange_new) y_trans <- new_range_transform(x_old = as.numeric(pts$y), range_old = yrange_old, range_new = yrange_new) list(x = x_trans, y = y_trans) }) ``` ### User interface The app includes a minimal user interface with two output elements. ```{r ui, eval = FALSE} ui <- fluidPage( fluidRow(tags$div( style = "position: relative;", plotOutput("alluvial_plot", height = "650px", hover = hoverOpts(id = "plot_hover") ), htmlOutput("tooltip"))) ) ``` The elements are: - a `plotOutput` with the argument `hover` defined, to enable behavior determined by the cursor's plot coordinates whenever the user hovers over the plot. - an `htmlOutput` for the tooltip that appears next to the cursor on hover. The elements are wrapped in a `fluidRow()` and a `div()` tag. _Note:_ This vignette only illustrates how to display output when the user hovers over an element. If you want to display output when the user clicks on an element, the corresponding argument to `plotOutput()` is `click = clickOpts(id = "plot_click")`. This will return the location of the mouse cursor in plot coordinates when the user clicks somewhere within the plot panel. _Also Note:_ In the example presented here, all of the plot drawing and coordinate extracting code is outside the `server()` function, because the plot itself does not change with user input. However if you are building an app where the plot changes in response to user input, for example a menu of options of which variables to display, the plot drawing code has to be inside the `renderPlot()` expression. This means that the coordinates may need to be recalculated each time the user input changes as well. In that case, you may need to use the global assignment operator `<<-` so that the coordinates are accessible outside the `renderPlot()` expression. ### Server function In the server function, we first call `renderPlot()` to draw the plot in the app window. ```{r renderPlot, eval = FALSE} output$alluvial_plot <- renderPlot(p, res = 200) ``` Next, we define the tooltip with a `renderText()` expression. Within that expression, we first extract the cursor's plot coordinates from the user input. We determine whether the cursor is hovering over a stratum and if so, display the appropriate tooltip. ![screenshot of tooltip on stratum](https://raw.githubusercontent.com/corybrunson/ggalluvial/main/vignettes/img/hover_stratum.png) If the mouse cursor is not hovering over a stratum, we determine whether it is hovering over an alluvium polygon and if so, display different information in the tooltip. ![screenshot of tooltip on alluvium](https://raw.githubusercontent.com/corybrunson/ggalluvial/main/vignettes/img/hover_alluvium.png) If the mouse cursor is hovering over an empty region of the plot, `renderText()` returns nothing and no tooltip appears. ![screenshot of cursor over empty region](https://raw.githubusercontent.com/corybrunson/ggalluvial/main/vignettes/img/hover_empty_area.png) Let's take a deeper dive into the logic used to determine the text that appears in the tooltip. First, we check whether the cursor is inside the plot panel. If it is not, the element `plot_hover` of the input will be `NULL`. In that case `renderText()` will return nothing and no tooltip will appear. ```{r, eval = FALSE} output$tooltip <- renderText( if(!is.null(input$plot_hover)) { ... } ... ) ``` #### Hovering over a stratum Next, we check whether the cursor is over a stratum. We round the x-coordinate of the mouse cursor in data units to the nearest integer, then determine whether the x-coordinate is within `node_width/2` of that integer. If so, the mouse cursor is horizontally within the box. Here the `if`-`else` statement includes behavior to display the tooltip for a stratum if true, and an alluvium if false. ```{r, eval = FALSE} hover <- input$plot_hover x_coord <- round(hover$x) if(abs(hover$x - x_coord) < (node_width / 2)) { ... } else { ... } ``` If the condition is true, we need to find the index of the row of the input data that goes with the stratum the cursor is on. The data frame `pbuilt$data[[2]]` includes columns `x`, `ymin`, and `ymax` that define the x-coordinate of the center of the stratum, and the minimum and maximum y-coordinates of the stratum. We find the row index of that data frame where `x` is equal to the rounded x-coordinate of the cursor, and the y-coordinate of the cursor falls between `ymin` and `ymax`. ```{r, eval = FALSE} node_row <- pbuilt$data[[2]]$x == x_coord & hover$y > pbuilt$data[[2]]$ymin & hover$y < pbuilt$data[[2]]$ymax ``` To find the information to display in the tooltip, we get the name of the stratum as well as its width from the data in `pbuilt`. ```{r, eval = FALSE} node_label <- pbuilt$data[[2]]$stratum[node_row] node_n <- pbuilt$data[[2]]$count[node_row] ``` Finally, we render a tooltip using the `div` tag. We provide the text to display as arguments to `htmltools::renderTags()`. We also paste CSS style information together and pass it to the `style` argument. Note that the tooltip positioning is provided in CSS coordinates (pixels), not data coordinates. This does not require any additional effort on our part because `plot_hover` also includes an element called `coords_css`, which contains the mouse cursor location in pixel units. ```{r render strata tooltip, eval = FALSE} renderTags( tags$div( node_label, tags$br(), "n =", node_n, style = paste0( "position: absolute; ", "top: ", hover$coords_css$y + offset, "px; ", "left: ", hover$coords_css$x + offset, "px; ", "background: gray; ", "padding: 3px; ", "color: white; " ) ) )$html ``` #### Hovering over an alluvium If the cursor is not over a stratum, the next nested `if`-statement checks whether it is over an alluvium. This is done using the function `sp::point.in.polygon()` applied across each of the polygons for which we defined the coordinates inside the `renderPlot()` expression. ```{r test within polygon, eval = FALSE} hover_within_flow <- sapply( polygon_coords, function(pol) point.in.polygon(point.x = hover$x, point.y = hover$y, pol.x = pol$x, pol.y = pol$y) ) ``` If at least one polygon is beneath the mouse cursor, we locate the corresponding row in the input data and extract information to display in the tooltip. (If the condition is not met, that means the cursor is hovering over an empty area of the plot, so no tooltip appears.) ```{r, eval = FALSE} if (any(hover_within_flow)) { ... } ``` In the situation where there are more than one polygon overlapping, we get the information for the polygon that is plotted last by calling `rev()` on the logical vector returned by `point.in.polygon()`. This means that the tooltip will display information from the alluvium that appears "on top" in the plot. In this example, we display the names of the nodes that the alluvium connects, with arrows between them, and the width of the alluvium. ```{r info for alluvia tooltip, eval = FALSE} coord_id <- rev(which(hover_within_flow == 1))[1] flow_label <- paste(groups_to_draw[[coord_id]]$stratum, collapse = ' -> ') flow_n <- groups_to_draw[[coord_id]]$count[1] ``` We render a tooltip using identical syntax to the one above. ```{r render alluvia tooltip, eval = FALSE} renderTags( tags$div( flow_label, tags$br(), "n =", flow_n, style = paste0( "position: absolute; ", "top: ", hover$coords_css$y + offset, "px; ", "left: ", hover$coords_css$x + offset, "px; ", "background: gray; ", "padding: 3px; ", "color: white; " ) ) )$html ``` ## App with long-format alluvial data The `vaccinations` dataset is used for long-format alluvial data. The app is embedded at the bottom of this document, but we don't need to walk through the source code because it's almost identical to the code above. The output of `ggplot_build()` that is used to find the polygon coordinates and information for the tooltips has a consistent structure regardless of the initial format of the input data. Therefore, the calculation of polygon coordinates, user interface, and server functions of the two apps are identical. The only difference is in the initial creation of the `ggplot()` object. Refer back to the [primary vignette](ggalluvial.html) for several example plots made both with long and with wide data. The app is embedded below. Again, if the app doesn't display in the window above for whatever reason, you can view it locally by running this line of code in your console: ```{r run long app locally, eval = FALSE} shiny::shinyAppDir(system.file("examples/ex-shiny-long-data", package="ggalluvial")) ``` ## Conclusion This vignette demonstrates how to enable tooltips for {ggalluvial} plots in Shiny apps. This is one of many possible ways to do that. It may not be the optimal way — other solutions are certainly possible! The full source code for both of these Shiny apps is included with the {ggalluvial} package in the 'examples' subdirectory where the package is installed: the source files are `ggalluvial/examples/ex-shiny-wide-data/app.R` and `ggalluvial/examples/ex-shiny-long-data/app.R`. ggalluvial/vignettes/order-rectangles.rmd0000644000176200001440000005314014367761414020375 0ustar liggesusers--- title: "The Order of the Rectangles" author: "Jason Cory Brunson" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{order of rectangles} %\VignetteEngine{knitr::rmarkdown} \usepackage[utf8]{inputenc} --- How the strata and lodes at each axis are ordered, and how to control their order, is a complicated but essential part of {ggalluvial}'s functionality. This vignette explains the motivations behind the implementation and explores the functionality in greater detail than the examples. ## Setup ```{r setup} knitr::opts_chunk$set(fig.width = 6, fig.height = 3, fig.align = "center") library(ggalluvial) ``` All of the functionality discussed in this vignette is exported by {ggalluvial}. We'll also need a toy data set to play with. I conjured the data frame `toy` to be nearly as small as possible while complex enough to illustrate the positional controls: ```{r data} # toy data set set.seed(0) toy <- data.frame( subject = rep(LETTERS[1:5], times = 4), collection = rep(1:4, each = 5), category = rep( sample(c("X", "Y"), 16, replace = TRUE), rep(c(1, 2, 1, 1), times = 4) ), class = c("one", "one", "one", "two", "two") ) print(toy) ``` The subjects are classified into categories at each collection point but are also members of fixed classes. Here's how {ggalluvial} visualizes these data under default settings: ```{r plot} ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + geom_alluvium(aes(fill = class)) + geom_stratum() ``` ## Motivations The amount of control the stat layers `stat_alluvial()` and `stat_flow()` exert over the [positional aesthetics](https://ggplot2.tidyverse.org/reference/aes_position.html) of graphical objects (grobs) is unusual, by the standards of {ggplot2} and many of its extensions. In [the layered grammar of graphics framework](https://www.tandfonline.com/doi/abs/10.1198/jcgs.2009.07098), the role of a statistical transformation is usually to summarize the original data, for example by binning (`stat_bin()`) or by calculating quantiles (`stat_qq()`). These transformed data are then sent to geom layers for positioning. The positions of grobs may be adjusted after the statistical transformation, for example when points are jittered (`geom_jitter()`), but the numerical data communicated by the plot are still the product of the stat. In {ggalluvial}, the stat layers exert slightly more control. For one thing, the transformation is more sophisticated than a single value or a fixed-length vector, such as a mean, standard deviation, or five-number summary. Instead, the values of `y` (which default to `1`) within each collection are, after reordering, transformed using `cumsum()` and some additional arithmetic to obtain coordinates for the centers `y` and lower and upper limits `ymin` and `ymax` of the strata representing the categories. Additionally, the reordering of lodes within each collection relies on a hierarchy of sorting variables, based on the strata at nearby axes as well as the present one and, optionally, on the values of differentiation aesthetics like `fill`. How this hierarchy is invoked depends on the choices of several plotting parameters (`decreasing`, `reverse`, and `absolute`). Thus, the results of the statistical transformations are not as intrinsically meaningful as others and are subject to much more intervention by the user. Only once the transformations have produced these coordinates do the geom layers use them to position the rectangles and splines that constitute the plot. There are two key reasons for this division of labor: 1. The coordinates returned by some stat layers can be coupled with multiple geom layers. For example, all four geoms can couple with the `alluvium` stat. Moreover, as showcased in [the examples](http://corybrunson.github.io/ggalluvial/reference/index.html), the stats can also meaningfully couple with exogenous geoms like `text`, `pointrange`, and `errorbar`. (In principle, the geoms could also couple with exogenous stats, but i haven't done this or seen it done in the wild.) 2. Different parameters control the calculations of the coordinates (e.g. `aes.bind` and `cement.alluvia`) and the rendering of the graphical elements (`width`, `knot.pos`, and `aes.flow`), and it makes intuitive sense to handle these separately. For example, the heights of the strata and lodes convey information about the underlying data, whereas their widths are arbitrary. (If the data are provided in alluvia format, then `Stat*$setup_data()` converts them to lodes format in preparation for the main transformation. This can be done manually using [the exported conversion functions](http://corybrunson.github.io/ggalluvial/reference/alluvial-data.html), and this vignette will assume the data are already in lodes format.) ## Positioning strata Each stat layer demarcates one stack for each data collection point and one rectangle within each stack for each (non-empty) category.[^yneg] In [{ggalluvial} terms](http://corybrunson.github.io/ggalluvial/articles/ggalluvial.html), the collection points are axes and the rectangles are strata or lodes. [^yneg]: The one exception, discussed below, is for stratum variables that take both positive and negative values. To generate a sequence of stacked bar plots with no connecting flows, only the aesthetics `x` (standard) and `stratum` (custom) are required: ```{r strata} # collection point and category variables only data <- structure(toy[, 2:3], names = c("x", "stratum")) # required fields for stat transformations data$y <- 1 data$PANEL <- 1 # stratum transformation StatStratum$compute_panel(data) ``` Comparing this output to `toy`, notice first that the data have been aggregated: Each distinct combination of `x` and `stratum` occupies only one row. `x` encodes the axes and is subject to layers specific to this positional aesthetic, e.g. `scale_x_*()` transformations. `ymin` and `ymax` are the lower and upper bounds of the rectangles, and `y` is their vertical centers. Each stacked rectangle begins where the one below it ends, and their heights are the numbers of subjects (or the totals of their `y` values, if `y` is passed a numerical variable) that take the corresponding category value at the corresponding collection point. Here's the plot this strata-only transformation yields: ```{r strata plot} ggplot(toy, aes(x = collection, stratum = category)) + stat_stratum() + stat_stratum(geom = "text", aes(label = category)) ``` In this vignette, i'll use the `stat_*()` functions to add layers, so that the parameters that control their behavior are accessible via tab-completion. ### Reversing the strata Within each axis, `stratum` defaults to reverse order so that the bars proceed in the original order from top to bottom. This can be overridden by setting `reverse = FALSE` in `stat_stratum()`: ```{r strata reverse} # stratum transformation with strata in original order StatStratum$compute_panel(data, reverse = FALSE) ggplot(toy, aes(x = collection, stratum = category)) + stat_stratum(reverse = FALSE) + stat_stratum(geom = "text", aes(label = category), reverse = FALSE) ``` **Warning:** The caveat to this is that, _if `reverse` is declared in any layer, then it must be declared in every layer_, lest the layers be misaligned. This includes any `alluvium`, `flow`, and `lode` layers, since their graphical elements are organized within the bounds of the strata. ### Sorting the strata by size When the strata are defined by a character or factor variable, they default to the order of the variable (lexicographic in the former case). This can be overridden by the `decreasing` parameter, which defaults to `NA` but can be set to `TRUE` or `FALSE` to arrange the strata in decreasing or increasing order in the `y` direction: ```{r strata decreasing} # stratum transformation with strata in original order StatStratum$compute_panel(data, reverse = FALSE) ggplot(toy, aes(x = collection, stratum = category)) + stat_stratum(decreasing = TRUE) + stat_stratum(geom = "text", aes(label = category), decreasing = TRUE) ``` **Warning:** The same caveat applies to `decreasing` as to `reverse`: Make sure that all layers using alluvial stats are passed the same values! Henceforth, we'll use the default (reverse and categorical) ordering of the strata themselves. ## Positioning lodes within strata ### Alluvia and flows In the strata-only plot, each subject is represented once at each axis. _Alluvia_ are x-splines that connect these multiple representations of the same subjects across the axes. In order to avoid having these splines overlap at the axes, the `alluvium` stat must stack the alluvial cohorts---subsets of subjects who have a common profile across all axes---within each stratum. These smaller cohort-specific rectangles are the _lodes_. This calculation requires the additional custom `alluvium` aesthetic, which identifies common subjects across the axes: ```{r alluvia} # collection point, category, and subject variables data <- structure(toy[, 1:3], names = c("alluvium", "x", "stratum")) # required fields for stat transformations data$y <- 1 data$PANEL <- 1 # alluvium transformation StatAlluvium$compute_panel(data) ``` The transformed data now contain _one row per cohort_---instead of per category---_per collection point_. The vertical positional aesthetics describe the lodes rather than the strata, and the `group` variable encodes the `alluvia` (a convenience for the geom layer, and the reason that {ggalluvial} stat layers ignore variables passed to `group`). Here's how this transformation translates into the alluvial plot that began the vignette, labeling the subject of each alluvium at each intersection with a stratum: ```{r alluvia plot} ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_alluvium(aes(fill = class)) + stat_stratum(alpha = .25) + stat_alluvium(geom = "text", aes(label = subject)) ``` The `flow` stat differs from the `alluvium` stat by allowing the orders of the lodes within strata to differ from one side of an axis to the other. Put differently, the `flow` stat allows _mixing_ at the axes, rather than requiring that each case or cohort is follows a continuous trajectory from one end of the plot to the other. As a result, flow plots are often much less cluttered, the trade-off being that cases or cohorts cannot be tracked through them. ```{r flows} # flow transformation StatFlow$compute_panel(data) ``` The `flow` stat transformation yields _one row per cohort per side per flow_. Each intermediate axis appears twice in the data, once for the incoming flow and once for the outgoing flow. (The starting and ending axes only have rows for outgoing and incoming flows, respectively.) Here is the flow version of the preceding alluvial plot, labeling each side of each flow with the corresponding subject: ```{r flows plot} ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_stratum() + stat_flow(aes(fill = class)) + stat_flow(geom = "text", aes(label = subject, hjust = after_stat(flow) == "to")) ``` The [computed variable](https://ggplot2.tidyverse.org/reference/aes_eval.html) `flow` indicates whether each row of the `compute_panel()` output corresponds to a flow _to_ or _from_ its axis; the values are used to nudge the labels toward their respective flows (to avoid overlap). Mismatches between adjacent labels indicate where lodes are ordered differently on either side of a stratum. ### Lode guidance As the number of strata at each axis grows, heterogeneous cases or cohorts can produce highly complex alluvia and very messy plots. {ggalluvial} mitigates this by strategically arranging the lodes---the intersections of the alluvia with the strata---so as to reduce their crossings between adjacent axes. This strategy is executed locally: At each axis (call it the _index_ axis), the order of the lodes is guided by several totally or partially ordered variables. In order of priority: 1. the strata at the index axis 2. the strata at the other axes to which the index axis is linked by alluvia or flows---namely, all other axes in the case of an alluvium, or a single adjacent axis in the case of a flow 3. the alluvia themselves, i.e. the variable passed to `alluvium` In the alluvium case, the prioritization of the remaining axes is determined by a _lode guidance function_. A lode guidance function can be passed to the `lode.guidance` parameter, which defaults to `"zigzag"`. This function puts the nearest (adjacent) axes first, then zigzags outward from there, initially (the "zig") in the direction of the closer extreme: ```{r lode zigzag} for (i in 1:4) print(lode_zigzag(4, i)) ``` Several alternative `lode_*()` functions are available: - `"zagzig"` behaves like `"zigzag"` except initially "zags" toward the farther extreme. - `"frontback"` and `"backfront"` behave like `"zigzag"` but extend completely in one outward direction from the index axis before the other. - `"forward"` and `"backward"` put the remaining axes in increasing and decreasing order, regardless of the relative position of the index axis. Two alternatives are illustrated below: ```{r alluvia plot w/ backfront guidance} for (i in 1:4) print(lode_backfront(4, i)) ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_alluvium(aes(fill = class), lode.guidance = "backfront") + stat_stratum() + stat_alluvium(geom = "text", aes(label = subject), lode.guidance = "backfront") ``` The difference between `"backfront"` guidance and `"zigzag"` guidance can be seen in the order of the lodes of the `"Y"` stratum at axis `3`: Whereas `"zigzag"` minimized the crossings between axes `3` and `4`, locating the distinctive class-`"one"` case above the others, `"backfront"` minimized the crossings between axes `2` and `3` (axis `2` being immediately before axis `3`), locating this case below the others. ```{r alluvia plot w/ backward guidance} for (i in 1:4) print(lode_backward(4, i)) ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_alluvium(aes(fill = class), lode.guidance = "backward") + stat_stratum() + stat_alluvium(geom = "text", aes(label = subject), lode.guidance = "backward") ``` The effect of `"backward"` guidance is to keep the right part of the plot as tidy as possible while allowing the left part to become as messy as necessary. (`"forward"` has the opposite effect.) ### Aesthetic binding It often makes sense to bundle together the cases and cohorts that fall into common groups used to assign differentiation aesthetics: most commonly `fill`, but also `alpha`, which controls the opacity of the `fill` colors, and `colour`, `linetype`, and `size`, which control the borders of the alluvia, flows, and lodes. The `aes.bind` parameter defaults to `"none"`, in which case aesthetics play no role in the order of the lodes. Setting the parameter to `"flows"` prioritizes any such aesthetics _after_ the strata of any other axes but _before_ the alluvia of the index axis (effectively ordering the flows at each axis by aesthetic), while setting it to `"alluvia"` prioritizes aesthetics _before_ the strata of any other axes (effectively ordering the alluvia). In the toy example, the stronger option results in the lodes within each stratum being sorted first by class: ```{r alluvia plot w/ strong aesthetic binding} ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_alluvium(aes(fill = class, label = subject), aes.bind = "alluvia") + stat_stratum() + stat_alluvium(geom = "text", aes(fill = class, label = subject), aes.bind = "alluvia") ``` The more flexible option groups the lodes by class only after they've been ordered according to the strata at the remaining axes: ```{r alluvia plot w/ weak aesthetic binding} ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_alluvium(aes(fill = class, label = subject), aes.bind = "flows") + stat_stratum() + stat_alluvium(geom = "text", aes(fill = class, label = subject), aes.bind = "flows") ``` **Warning:** In addition to parameters like `reverse`, _when aesthetic variables are prioritized at all, overlaid alluvial layers must include the same aesthetics in the same order_. (This can produce warnings when the aesthetics are not recognized by the geom.) Try removing `fill = class` from the text geom above to see the risk posed by neglecting this check. Rather than ordering lodes _within_, the `flow` stat separately orders the flows _into_ and _out from_, each stratum. (This precludes a corresponding `"alluvia"` option for `aes.bind`.) By default, the flows are ordered with respect first to the orders of the strata at the present axis and second to those at the adjacent axis. Setting `aes.bind` to the non-default option `"flows"` tells `stat_flow()` to prioritize flow aesthetics after the strata of the index axis but before the strata of the adjacent axis: ```{r flows plots w/ aesthetic binding} ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_flow(aes(fill = class, label = subject), aes.bind = "flows") + stat_stratum() + stat_flow(geom = "text", aes(fill = class, label = subject, hjust = after_stat(flow) == "to"), aes.bind = "flows") ``` Note: The `aes.flow` parameter tells `geom_flow()` how flows should inherit differentiation aesthetics from adjacent axes---`"forward"` or `"backward"`. It does _not_ influence their positions. ### Manual lode ordering Finally, one may wish to put the lodes at each axis in a predefined order, subject to their being located in the correct strata. This can be done by passing a data column to the `order` aesthetic. For the toy example, we can pass a vector that puts the cases in the order of their IDs in the data at every axis: ```{r alluvia plot w/ manual lode ordering} lode_ord <- rep(seq(5), times = 4) ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_alluvium(aes(fill = class, order = lode_ord)) + stat_stratum() + stat_alluvium(geom = "text", aes(fill = class, order = lode_ord, label = subject)) ``` ```{r flows plot w/ manual lode ordering} ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_flow(aes(fill = class, order = lode_ord)) + stat_stratum() + stat_flow(geom = "text", aes(fill = class, order = lode_ord, label = subject, hjust = after_stat(flow) == "to")) ``` Within each stratum at each axis, the cases are now in order from top to bottom. ## Negative strata In response to an elegant real-world use case, {ggalluvial} can now handle negative observations in the same way as `geom_bar()`: by grouping these observations into negative strata and stacking these strata in the negative `y` direction (i.e. in the opposite direction of the positive strata). This new functionality complicates the above discussion in two ways: 1. _Positioning strata:_ The negative strata could be reverse-ordered with respect to the positive strata, as in `geom_bar()`, or ordered in the same way (vertically, without regard for sign). 2. _Positioning lodes within strata:_ Two strata may correspond to the same stratum variable at an axis (one positive and one negative), which under-determines the ordering of lodes within strata. The first issue is binary: Once `decreasing` and `reverse` are chosen, there are only two options for the negative strata. The choice is made by setting the new `absolute` parameter to either `TRUE` (the default), which yields a mirror-image ordering, or `FALSE`, which adopts the same vertical ordering. This setting also influences the ordering of lodes within strata at the same nexus as `reverse`, namely at the level of the alluvium variable. The second issue is then handled by creating a `deposit` variable with unique values corresponding to each _signed_ stratum variable value, in the order prescribed by `decreasing`, `reverse`, and `absolute`. The `deposit` variable is then used in place of `stratum` for all of the lode-ordering tasks above. As a point of reference, here is a bar plot of the toy data, with a randomized sign variable used to indicate negative-valued observations: ```{r bar plot with negative observations} set.seed(78) toy$sign <- sample(c(-1, 1), nrow(toy), replace = TRUE) print(toy) ggplot(toy, aes(x = collection, y = sign)) + geom_bar(aes(fill = class), stat = "identity") ``` The default behavior, illustrated here with flows, is for the positive strata to proceed downward and the negative strata to proceed upward, in both cases from larger absolute values to zero: ```{r flows plot w/ negative strata} ggplot(toy, aes(x = collection, stratum = category, alluvium = subject, y = sign)) + geom_flow(aes(fill = class)) + geom_stratum() + geom_text(stat = "stratum", aes(label = category)) ``` To instead have the strata proceed downward at each axis, and the lodes downward within each stratum, set `absolute = FALSE` (now plotting alluvia): ```{r alluvia plot w/ negative strata} ggplot(toy, aes(x = collection, stratum = category, alluvium = subject, y = sign)) + geom_alluvium(aes(fill = class), absolute = FALSE) + geom_stratum(absolute = FALSE) + geom_text(stat = "alluvium", aes(label = subject), absolute = FALSE) ``` Note again that the labels are consistent with the alluvia and flows, despite the omission of the `fill` aesthetic from the text geom, because the aesthetic variables are not prioritized in the ordering of the lodes. ## More examples More examples of all of the functionality showcased here can be found in the documentation for the `stat_*()` functions, [browsable on the package website](http://corybrunson.github.io/ggalluvial/reference/index.html). ## Appendix ```{r session info} sessioninfo::session_info() ``` ggalluvial/R/0000755000176200001440000000000014371217533012610 5ustar liggesusersggalluvial/R/stat-utils.r0000644000176200001440000001042414371217533015105 0ustar liggesusers# Identify elements in a character vector that fit the pattern of axis aesthetic # names, and return their indices in the numerical order of the axis numbers # (with `axis` first, if present). Only non-negative integers are allowed. get_axes <- function(x) { if (anyDuplicated(x)) { dupes <- unique(x[duplicated(x)]) stop("Duplicated variables: ", paste(dupes, collapse = ", ")) } axis_ind <- grep("^axis[0-9]*$", x) axis_ind[order(as.numeric(gsub("^axis", "", x[axis_ind])), na.last = FALSE)] } get_alluvial_type <- function(data) { # ensure that data is alluvial if (!is.null(data$x) | !is.null(data$stratum) | !is.null(data$alluvium)) { if (is.null(data$x) | is.null(data$stratum) | is.null(data$alluvium)) { stop("Parameters `x`, `stratum`, and `alluvium` are required ", "for data in lodes form.") } if (is_lodes_form(data, key = "x", value = "stratum", id = "alluvium", weight = "y", site = if ("PANEL" %in% names(data)) "PANEL", silent = TRUE)) return("lodes") } else { axis_ind <- get_axes(names(data)) if (is_alluvia_form(data, axes = axis_ind, weight = "y", silent = TRUE)) return("alluvia") } return("none") } # incorporate any missing values into factor levels na_keep <- function(data, type) { if (type == "lodes") { if (is.factor(data$stratum)) { data$stratum <- addNA(data$stratum, ifany = TRUE) } else { data$stratum[is.na(data$stratum)] <- "" } } else if (type == "alluvia") { axis_ind <- get_axes(names(data)) for (i in axis_ind) { if (any(is.na(data[[i]]))) { if (is.factor(data[[i]])) { data[[i]] <- addNA(data[[i]], ifany = TRUE) } else { data[[i]][is.na(data[[i]])] <- "" } } } } data } # replace a vector `x` of any type with # a numeric vector of *contiguous* integers that sort in the same order as `x` contiguate <- function(x) { x <- xtfrm(x) match(x, sort(unique(x))) } # define 'deposit' variable to rank strata vertically deposit_data <- function(data, decreasing, reverse, absolute) { if (is.na(decreasing)) { deposits <- unique(data[, c("x", "yneg", "stratum"), drop = FALSE]) deposits$deposit <- order(order( deposits$x, -deposits$yneg, xtfrm(deposits$stratum) * (-1) ^ (deposits$yneg * absolute + reverse) )) } else { deposits <- stats::aggregate( x = data$y, by = data[, c("x", "yneg", "stratum"), drop = FALSE], FUN = sum ) names(deposits)[ncol(deposits)] <- "y" deposits$deposit <- order(order( deposits$x, -deposits$yneg, xtfrm(deposits$y) * (-1) ^ (deposits$yneg * absolute + decreasing), xtfrm(deposits$stratum) * (-1) ^ (deposits$yneg * absolute + reverse) )) deposits$y <- NULL } merge(data, deposits, all.x = TRUE, all.y = FALSE) } # calculate cumulative 'y' values, accounting for sign cumulate <- function(x) { if (length(x) == 0) return(x) s <- setdiff(unique(sign(x)), 0) stopifnot(length(s) == 1 && s %in% c(-1, 1)) if (s == 1) { cumsum(x) - x / 2 } else { rev(cumsum(rev(x)) - rev(x) / 2) } } # choose a function via the `cement` parameter distill_vals <- c("first", "last", "most") distill_fun <- function(distill) { if (is.function(distill)) { return(distill) } else if (distill %in% distill_vals) { return(switch( distill, first = dplyr::first, last = dplyr::last, most = most )) } else if (is.character(distill)) { return(get(distill)) } else { stop("Please pass either a function or its name to `distill`.") } } # arrange data by aesthetics for consistent (reverse) z-ordering z_order_aes <- function(data, aesthetics) { # `aesthetics` and 'group' are fixed within contiguous alluvial segments aes_data <- data[! duplicated(data[, c("alluvium", "group"), drop = FALSE]), c("alluvium", aesthetics, "group")] if (length(aes_data) == 2) return(data) aes_data <- aes_data[do.call(order, aes_data[, c(aesthetics, "alluvium")]), ] # ensure order of "group" respects aesthetics data$group <- match(data$group, unique(aes_data$group)) data[with(data, order(x, group)), , drop = FALSE] } ggalluvial/R/stat-flow.r0000644000176200001440000003035114371217533014715 0ustar liggesusers#' Flow positions #' #' Given a dataset with alluvial structure, `stat_flow` calculates the centroids #' (`x` and `y`) and heights (`ymin` and `ymax`) of the flows between each pair #' of adjacent axes. #' @template stat-aesthetics #' @template computed-variables #' @template order-options #' @template defunct-stat-params #' #' @import ggplot2 #' @family alluvial stat layers #' @seealso [ggplot2::layer()] for additional arguments and #' [geom_alluvium()] and #' [geom_flow()] for the corresponding geoms. #' @inheritParams stat_stratum #' @param aes.bind At what grouping level, if any, to prioritize differentiation #' aesthetics when ordering the lodes within each stratum. Defaults to #' `"none"` (no aesthetic binding) with intermediate option `"flows"` to bind #' aesthetics after stratifying by axes linked to the index axis (the one #' adjacent axis in `stat_flow()`; all remaining axes in `stat_alluvium()`) #' and strongest option `"alluvia"` to bind aesthetics after stratifying by #' the index axis but before stratifying by linked axes (only available for #' `stat_alluvium()`). Stratification by any axis is done with respect to the #' strata at that axis, after separating positive and negative strata, #' consistent with the values of `decreasing`, `reverse`, and `absolute`. #' Thus, if `"none"`, then lode orderings will not depend on aesthetic #' variables. All aesthetic variables are used, in the order in which they are #' specified in `aes()`. #' @example inst/examples/ex-stat-flow.r #' @export stat_flow <- function(mapping = NULL, data = NULL, geom = "flow", position = "identity", decreasing = NULL, reverse = NULL, absolute = NULL, discern = FALSE, negate.strata = NULL, aes.bind = NULL, infer.label = FALSE, min.y = NULL, max.y = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( stat = StatFlow, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list( decreasing = decreasing, reverse = reverse, absolute = absolute, discern = discern, negate.strata = negate.strata, aes.bind = aes.bind, infer.label = infer.label, min.y = min.y, max.y = max.y, na.rm = na.rm, ... ) ) } #' @rdname ggalluvial-ggproto #' @usage NULL #' @export StatFlow <- ggproto( "StatFlow", Stat, required_aes = c("x"), optional_aes = c("order"), # ` = NULL` prevents "unknown aesthetics" warnings default_aes = aes(weight = 1, stratum = NULL, alluvium = NULL, order = NULL), setup_params = function(data, params) { # remove null parameter values (see #103) params[vapply(params, is.null, NA)] <- NULL params }, setup_data = function(data, params) { # assign `alluvium` to `stratum` if `stratum` not provided if (is.null(data$stratum) && ! is.null(data$alluvium)) { data$stratum <- data$alluvium } # assign unit amounts if not provided if (is.null(data$y)) { data$y <- rep(1, nrow(data)) } else { data <- remove_missing( data, na.rm = params$na.rm, vars = "y", name = "stat_flow", finite = TRUE ) } type <- get_alluvial_type(data) if (type == "none") { stop("Data is not in a recognized alluvial form ", "(see `help('alluvial-data')` for details).") } if (params$na.rm) { data <- na.omit(object = data) } else { data <- na_keep(data = data, type = type) } # ensure that data is in lode form if (type == "alluvia") { axis_ind <- get_axes(names(data)) data <- to_lodes_form(data = data, axes = axis_ind, discern = params$discern) # positioning requires numeric `x` data <- data[with(data, order(x, stratum, alluvium)), , drop = FALSE] data$x <- contiguate(data$x) } else { if (! is.null(params$discern) && ! (params$discern == FALSE)) { warning("Data is already in lodes format, ", "so `discern` will be ignored.") } } # negate strata if (! is.null(params$negate.strata)) { if (! all(params$negate.strata %in% unique(data$stratum))) { warning("Some values of `negate.strata` are not among strata.") } wneg <- which(data$stratum %in% params$negate.strata) if (length(wneg) > 0) data$y[wneg] <- -data$y[wneg] } data }, compute_panel = function(self, data, scales, decreasing = NULL, reverse = NULL, absolute = NULL, discern = FALSE, distill = "first", negate.strata = NULL, aes.bind = NULL, infer.label = FALSE, min.y = NULL, max.y = NULL) { # parameter defaults if (is.null(decreasing)) decreasing <- ggalluvial_opt("decreasing") if (is.null(reverse)) reverse <- ggalluvial_opt("reverse") if (is.null(absolute)) absolute <- ggalluvial_opt("absolute") if (is.null(aes.bind)) aes.bind <- ggalluvial_opt("aes.bind") # introduce label if (infer.label) { deprecate_parameter("infer.label", msg = "Use `aes(label = after_stat(lode))`.") if (is.null(data$label)) { data$label <- data$alluvium } else { warning("Aesthetic `label` is specified, ", "so parameter `infer.label` will be ignored.") } } # differentiation and text aesthetics (in prescribed order) diff_aes <- intersect(c(.color_diff_aesthetics, .text_aesthetics), names(data)) # match arguments for `aes.bind` if (! is.null(aes.bind)) { if (is.logical(aes.bind)) { aes.bind.rep <- if (aes.bind) "flow" else "none" warning("Logical values of `aes.bind` are deprecated; ", "replacing ", aes.bind, " with '", aes.bind.rep, "'.") aes.bind <- aes.bind.rep } aes.bind <- match.arg(aes.bind, c("none", "flows", "alluvia")) if (aes.bind == "alluvia") { warning("`aes.bind = 'alluvia'` only available for `geom_alluvium()`; ", "changing to 'flows'.") aes.bind <- "flows" } } # sign variable (sorts positives before negatives) data$yneg <- data$y < 0 # lode variable (before co-opting 'alluvium') data$lode <- data$alluvium # specify distillation function from `distill` distill <- distill_fun(distill) # transform 'order' according to `absolute` and `reverse` params if (! is.null(data$order)) data$order <- xtfrm(data$order) * (-1) ^ (data$yneg * absolute + reverse) # define 'deposit' variable to rank strata vertically data <- deposit_data(data, decreasing, reverse, absolute) # identify fissures at aesthetics that vary within strata n_lodes <- nrow(unique(data[, c("x", "stratum")])) fissure_aes <- diff_aes[which(sapply(diff_aes, function(x) { nrow(unique(data[, c("x", "stratum", x)])) }) > n_lodes)] data$fissure <- if (length(fissure_aes) == 0) { 1 } else { # order by aesthetics in order as.integer(interaction(data[, rev(fissure_aes)], drop = TRUE)) * (-1) ^ (data$yneg * absolute + reverse) } # stack positions of flows to strata, using 'alluvium' to link them # (does not assume that 'x' is continuous or regularly-spaced) ran_x <- range(data$x) uniq_x <- sort(unique(data$x)) # ensure that 'alluvium' ranges simply from 1 to max data$alluvium <- contiguate(data$alluvium) alluvium_max <- max(data$alluvium) data <- rbind( transform(data[data$x != ran_x[2], , drop = FALSE], alluvium = alluvium + alluvium_max * (match(as.character(x), as.character(uniq_x)) - 1), link = match(as.character(x), as.character(uniq_x)), flow = factor("from", levels = c("from", "to"))), transform(data[data$x != ran_x[1], , drop = FALSE], alluvium = alluvium + alluvium_max * (match(as.character(x), as.character(uniq_x)) - 2), link = match(as.character(x), as.character(uniq_x)) - 1, flow = factor("to", levels = c("from", "to"))) ) # flag flows between common pairs of strata and of aesthetics # (induces NAs for one-sided flows) lnk_vars <- intersect(c("deposit", "order", "fissure"), names(data)) adj_vars <- paste0("adj_", lnk_vars) # interactions of link:from:to for (i in seq(lnk_vars)) { data <- match_flows(data, lnk_vars[[i]], adj_vars[[i]]) #data[[adj_vars[i]]] <- xtfrm(data[[adj_vars[i]]]) } # designate these flow pairings the alluvia data$alluvium <- as.integer(interaction(data[, adj_vars], drop = TRUE)) # initiate variables for `after_stat()` weight <- data$weight data$weight <- NULL if (is.null(weight)) weight <- 1 data$n <- weight data$count <- data$y * weight # aggregate variables over 'alluvium', 'x', 'yneg', and 'stratum': # sum of computed variables and unique-or-bust values of aesthetics by_vars <- intersect(c("alluvium", "x", "yneg", "stratum", "deposit", "order", "fissure", "link", "flow", "adj_deposit", "adj_order", "adj_fissure"), names(data)) only_vars <- c(diff_aes) sum_vars <- c("y", "n", "count") data <- dplyr::group_by(data, dplyr::across(by_vars)) # keep `NA`s in order to correctly position flows: # `distill()`, `only()`, and `sum(na.rm = TRUE)` agg_lode <- dplyr::summarize_at(data, "lode", distill) if (length(only_vars) > 0) { agg_only <- dplyr::summarize_at(data, only_vars, only) } data <- dplyr::summarize_at(data, sum_vars, sum, na.rm = TRUE) data <- dplyr::ungroup(data) # merges forget tibble classes data <- merge(data, agg_lode) if (length(only_vars) > 0) { data <- merge(data, agg_only) } # redefine 'group' to be used to control grobs in the geom step data$group <- data$alluvium # calculate variables for `after_stat()` x_sums <- tapply(abs(data$count), data$x, sum, na.rm = TRUE) data$prop <- data$count / x_sums[match(as.character(data$x), names(x_sums))] # sort data in preparation for `y` sums sort_fields <- c( "link", "x", "deposit", if (! is.null(data$order)) "order", #if (aes.bind != "none") "fissure", if (aes.bind == "flows") "adj_fissure", "adj_deposit", "alluvium", "flow" ) data <- data[do.call(order, data[, sort_fields]), , drop = FALSE] # calculate `y` sums data$ycum <- NA for (ll in unique(data$link)) { for (ss in unique(data$flow)) { for (yn in c(FALSE, TRUE)) { ww <- which(data$link == ll & data$flow == ss & data$yneg == yn) data$ycum[ww] <- cumulate(data$y[ww]) } } } # calculate y bounds data$fissure <- NULL data$adj_deposit <- NULL data$adj_fissure <- NULL data$link <- NULL data$ymin <- data$ycum - abs(data$y) / 2 data$ymax <- data$ycum + abs(data$y) / 2 data$y <- data$ycum data$yneg <- NULL data$ycum <- NULL # impose height restrictions if (! is.null(min.y)) data <- subset(data, ymax - ymin >= min.y) if (! is.null(max.y)) data <- subset(data, ymax - ymin <= max.y) # arrange data by aesthetics for consistent (reverse) z-ordering data <- z_order_aes(data, diff_aes) data } ) match_flows <- function(data, var, var_col) { adj <- tidyr::spread(data[, c("alluvium", "link", "flow", var)], key = "flow", value = var) adj[[var_col]] <- interaction(adj$link, adj$from, adj$to, drop = TRUE) merge(data, adj[, c("alluvium", var_col)], by = "alluvium", all.x = TRUE, all.y = FALSE) } ggalluvial/R/alluvial-data.r0000644000176200001440000003026414371217533015520 0ustar liggesusers#' Check for alluvial structure and convert between alluvial formats #' #' Alluvial plots consist of multiple horizontally-distributed columns (axes) #' representing factor variables, vertical divisions (strata) of these axes #' representing these variables' values; and splines (alluvial flows) connecting #' vertical subdivisions (lodes) within strata of adjacent axes representing #' subsets or amounts of observations that take the corresponding values of the #' corresponding variables. This function checks a data frame for either of two #' types of alluvial structure: #' #' - One row per **lode**, wherein each row encodes a subset or amount of #' observations having a specific profile of axis values, a `key` field #' encodes the axis, a `value` field encodes the value within each axis, and a #' `id` column identifies multiple lodes corresponding to the same subset or #' amount of observations. `is_lodes_form` tests for this structure. #' - One row per **alluvium**, wherein each row encodes a subset or amount of #' observations having a specific profile of axis values and a set `axes` of #' fields encodes its values at each axis variable. `is_alluvia_form` tests #' for this structure. #' #' `to_lodes_form` takes a data frame with several designated variables to #' be used as axes in an alluvial plot, and reshapes the data frame so that #' the axis variable names constitute a new factor variable and their values #' comprise another. Other variables' values will be repeated, and a #' row-grouping variable can be introduced. This function invokes #' [tidyr::gather()]. #' #' `to_alluvia_form` takes a data frame with axis and axis value variables #' to be used in an alluvial plot, and reshape the data frame so that the #' axes constitute separate variables whose values are given by the value #' variable. This function invokes [tidyr::spread()]. #' #' @name alluvial-data #' @importFrom rlang enquo enquos enexpr enexprs quos is_empty quo_name #' is_character is_integerish is_quosures have_name #' @importFrom tidyselect vars_pull vars_select #' @family alluvial data manipulation #' @param data A data frame. #' @param logical Defunct. Whether to return a logical value or a character #' string indicating the type of alluvial structure ("none", "lodes", or #' "alluvia"). #' @param silent Whether to print messages. #' @param key,value,id In `to_lodes_form`, handled as in #' [tidyr::gather()] and used to name the new axis (key), stratum #' (value), and alluvium (identifying) variables. In `to_alluvia_form`, #' handled as in [tidyr::spread()] and used to identify the fields #' of `data` to be used as the axis (key), stratum (value), and alluvium #' (identifying) variables. #' @param axes In `*_alluvia_form`, handled as in #' [dplyr::select()] and used to identify the field(s) of #' `data` to be used as axes. #' @param ... Used in `is_alluvia_form` and `to_lodes_form` as in #' [dplyr::select()] to determine axis variables, as an alternative #' to `axes`. Ignored when `axes` is provided. #' @param weight Optional field of `data`, handled using #' [`rlang::enquo()`][rlang::nse-defuse], to be used as heights or depths of #' the alluvia or lodes. #' @param site Optional vector of fields of `data`, handled using #' [`rlang::enquos()`][rlang::nse-defuse], to be used to group rows before #' testing for duplicate and missing id-axis pairings. Variables intended for #' faceting should be passed to `site`. #' @param diffuse Fields of `data`, handled using #' [tidyselect::vars_select()], to merge into the reshapen data by #' `id`. They must be a subset of the axis variables. Alternatively, a #' logical value indicating whether to merge all (`TRUE`) or none #' (`FALSE`) of the axis variables. #' @param distill A logical value indicating whether to include variables, other #' than those passed to `key` and `value`, that vary within values #' of `id`. Alternatively, a function (or its name) to be used to distill #' each such variable to a single value. In addition to existing functions, #' `distill` accepts the character values `"first"` (used if #' `distill` is `TRUE`), `"last"`, and `"most"` (which #' returns the first modal value). #' @param discern Logical value indicating whether to suffix values of the #' variables used as axes that appear at more than one variable in order to #' distinguish their factor levels. This forces the levels of the combined #' factor variable `value` to be in the order of the axes. #' @example inst/examples/ex-alluvial-data.r #' @rdname alluvial-data #' @export is_lodes_form <- function(data, key, value, id, weight = NULL, site = NULL, logical = TRUE, silent = FALSE) { if (! isTRUE(logical)) defunct_parameter("logical") key_var <- vars_pull(names(data), !! enquo(key)) value_var <- vars_pull(names(data), !! enquo(value)) id_var <- vars_pull(names(data), !! enquo(id)) # test id-axis pairings within each site (see issue #65) if (! is.null(enexprs(site))) { site_vars <- vars_select(names(data), !!! enquos(site)) data[[id_var]] <- interaction(data[c(id_var, site_vars)], drop = FALSE) } if (any(duplicated(cbind(data[c(key_var, id_var)])))) { if (! silent) message("Duplicated id-axis pairings", if (! is.null(enexprs(site))) "." else "; should `site` have been specified?") return(if (logical) FALSE else "none") } n_pairs <- dplyr::n_distinct(data[key_var]) * dplyr::n_distinct(data[id_var]) if (nrow(data) < n_pairs) { if (! silent) warning("Missing id-axis pairings (at some sites).") } # if `weight` is not `NULL`, use NSE to identify `weight_var` if (! is.null(enexpr(weight))) { weight_var <- vars_select(names(data), !! enquo(weight)) if (! is.numeric(data[[weight_var]])) { if (! silent) message("Lode weights are non-numeric.") return(if (logical) FALSE else "none") } } if (logical) TRUE else "lodes" } #' @rdname alluvial-data #' @export is_alluvia_form <- function(data, ..., axes = NULL, weight = NULL, logical = TRUE, silent = FALSE) { if (! isTRUE(logical)) defunct_parameter("logical") if (is.null(enexpr(weight))) { weight_var <- NULL } else { weight_var <- vars_select(names(data), !! enquo(weight)) if (! is.numeric(data[[weight_var]])) { if (! silent) message("Alluvium weights are non-numeric.") return(if (logical) FALSE else "none") } } if (! is.null(enexpr(axes))) { axes <- data_at_vars(data, axes) } else { quos <- quos(...) if (is_empty(quos)) { axes <- setdiff(names(data), c(weight_var)) } else { axes <- unname(vars_select(names(data), !!! quos)) } } n_alluvia <- nrow(dplyr::distinct(data[axes])) n_combns <- do.call(prod, lapply(data[axes], dplyr::n_distinct)) if (n_alluvia < n_combns) { if (! silent) message("Missing alluvia for some stratum combinations.") } if (logical) TRUE else "alluvia" } #' @rdname alluvial-data #' @export to_lodes_form <- function(data, ..., axes = NULL, key = "x", value = "stratum", id = "alluvium", diffuse = FALSE, discern = FALSE) { key_var <- quo_name(enexpr(key)) value_var <- quo_name(enexpr(value)) id_var <- quo_name(enexpr(id)) if (! is.null(enexpr(axes))) { axes <- data_at_vars(data, axes) } else { quos <- quos(...) if (is_empty(quos)) { axes <- names(data) } else { axes <- unname(vars_select(names(data), !!! quos)) } } stopifnot(is_alluvia_form(data, axes, silent = TRUE)) if (! is.data.frame(data)) data <- as.data.frame(data) if (is.logical(enexpr(diffuse))) { diffuse <- if (diffuse) axes else NULL } else { diffuse <- unname(vars_select(names(data), !! enquo(diffuse))) if (! all(diffuse %in% axes)) { stop("All `diffuse` variables must be `axes` variables.") } } # combine factor levels cat_levels <- unname(unlist(lapply(lapply(data[axes], as.factor), levels))) if (any(duplicated(cat_levels)) & is.null(discern)) { warning("Some strata appear at multiple axes.") } if (isTRUE(discern)) { data <- discern_data(data, axes) # uniquify strata separately from `discern_data` as a validation step strata <- make.unique(unname(cat_levels)) } else { strata <- unique(unname(cat_levels)) } # format data in preparation for `gather()` data[[id_var]] <- 1:nrow(data) if (! is.null(diffuse)) { diffuse_data <- data[, c(id_var, diffuse), drop = FALSE] } for (i in axes) data[[i]] <- as.character(data[[i]]) # `gather()` by `axes` res <- tidyr::gather(data, key = !! key_var, value = !! value_var, axes, factor_key = TRUE) res[[value_var]] <- factor(res[[value_var]], levels = strata) # recombine with `diffuse_data` if (! is.null(diffuse)) { res <- merge(diffuse_data, res, by = id_var, all.x = FALSE, all.y = TRUE) } res } #' @rdname alluvial-data #' @export to_alluvia_form <- function(data, key, value, id, distill = FALSE) { key_var <- vars_pull(names(data), !! enquo(key)) value_var <- vars_pull(names(data), !! enquo(value)) id_var <- vars_pull(names(data), !! enquo(id)) stopifnot(is_lodes_form(data, key_var, value_var, id_var, silent = TRUE)) # handle any variables that vary within `id`s uniq_id <- length(unique(data[[id_var]])) uniq_data <- unique(data[setdiff(names(data), c(key_var, value_var))]) if (! uniq_id == nrow(uniq_data)) { distill_vars <- names(which(sapply( setdiff(names(uniq_data), id_var), function(x) nrow(unique(uniq_data[c(id_var, x)])) ) > uniq_id)) if (is.logical(distill)) { if (isTRUE(distill)) { distill <- "first" } else { warning("The following variables vary within `id`s ", "and will be dropped: ", paste(distill_vars, collapse = ", ")) distill <- NULL } # } else if (is.character(distill)) { # distill <- get(distill) } else { distill <- distill_fun(distill) } if (! is.null(distill)) { stopifnot(is.function(distill)) message("Distilled variables: ", paste(distill_vars, collapse = ", ")) distill_data <- stats::aggregate( data[distill_vars], data[id_var], distill ) if (length(distill_vars) == 1) names(distill_data)[-1] <- distill_vars } data <- data[setdiff(names(data), distill_vars)] } else { distill <- NULL } # `spread()` by designated `key` and `value` res <- tidyr::spread(data, key = !! key_var, value = !! value_var) # recombine with `distill_data` if (! is.null(distill)) { res <- merge(distill_data, res, by = id_var, all.x = FALSE, all.y = TRUE) } res } # require different character strings to represent strata at different axes discern_data <- function(data, axes, sep = ".") { # strata at each axis in order list_levels <- lapply(lapply(data[axes], as.factor), levels) # concatenated vector of strata at all axes cat_levels <- unlist(list_levels) # vector of uniquified strata across all axes new_levels <- make.unique(unname(cat_levels)) # cumulative number of strata before each axis i_levels <- cumsum(c(0, sapply(list_levels, length))) # characterized, uniquified strata at each axis for (i in seq_along(axes)) { axis_levels <- as.numeric(as.factor(data[[axes[i]]])) level_inds <- (i_levels[i] + 1):i_levels[i + 1] data[[axes[i]]] <- new_levels[level_inds][axis_levels] } data } # mimic the behavior of `tbl_at_vars()` in `select_at()` data_at_vars <- function(data, vars) { data_vars <- names(data) if (is_character(vars)) { vars } else if (is_integerish(vars)) { data_vars[vars] } else if (is_quosures(vars)) { out <- dplyr::select_vars(data_vars, !!! vars) if (! any(have_name(vars))) { names(out) <- NULL } out } else { stop("Either a character or numeric vector ", "or a `vars()` object ", "is required.") } } ggalluvial/R/utils.r0000644000176200001440000000066614371217533014143 0ustar liggesusers# color and differentiation aesthetics .color_diff_aesthetics <- c( "fill", "bg", "alpha", "fg", "col", "colour", "color", "lty", "linetype", "cex", "lwd", "linewidth", "size", "pch", "shape" ) # text aesthetics .text_aesthetics <- c( "label", "vjust", "hjust", "angle", "family", "fontface", "lineheight" ) # distilling functions most <- function(x) { x[which(factor(x) == names(which.max(table(factor(x)))))[1]] } ggalluvial/R/lode-guidance-functions.r0000644000176200001440000000570214367761413017513 0ustar liggesusers#' Lode guidance functions #' #' These functions control the order of lodes within strata in an alluvial #' diagram. They are invoked by [stat_alluvium()] and can be passed to #' the `lode.guidance` parameter. #' #' Each function orders the numbers 1 through `n`, starting at index #' `i`. The choice of function made in [stat_alluvium()] #' determines the order in which the other axes contribute to the sorting of #' lodes within each index axis. After starting at `i`, the functions order #' the remaining axes as follows: #' #' - `zigzag`: Zigzag outward from `i`, starting in the outward direction #' - `zigzag`: Zigzag outward from `i`, starting in the inward direction #' - `forward`: Increasing order (alias `rightward`) #' - `backward`: Decreasing order (alias `leftward`) #' - `frontback`: Proceed forward from `i` to `n`, then backward to 1 #' (alias `rightleft`) #' - `backfront`: Proceed backward from `i` to 1, then forward to `n` #' (alias `leftright`) #' #' An extended discussion of how strata and lodes are arranged in alluvial #' plots, including the effects of different lode guidance functions, can be #' found in the vignette "The Order of the Rectangles" via #' `vignette("order-rectangles", package = "ggalluvial")`. #' #' @name lode-guidance-functions #' @param n Numeric, a positive integer #' @param i Numeric, a positive integer at most `n` NULL lode_zz <- function(n, i, outward) { # radii r1 <- i - 1 r2 <- n - i r <- min(r1, r2) # attempt cohesion in the direction of the closer end backward <- (i <= n / 2) == outward # setup sgn <- if(r1 == r2) 0 else (r2 - r1) / abs(r2 - r1) rem <- (i + sgn * (r + 1)):((n+1)/2 + sgn * (n-1)/2) zz <- (1 - 2 * backward) * c(1, -1) # order c(i, if(r == 0) c() else sapply(1:r, function(j) i + j * zz), if(sgn == 0) c() else rem) } #' @rdname lode-guidance-functions #' @export lode_zigzag <- function(n, i) { lode_zz(n, i, outward = TRUE) } #' @rdname lode-guidance-functions #' @export lode_zagzig <- function(n, i) { lode_zz(n, i, outward = FALSE) } #' @rdname lode-guidance-functions #' @export lode_forward <- function(n, i) { if (i == 1) 1:n else if (i == n) c(n, 1:(n-1)) else c(i, 1:(i-1), (i+1):n) } #' @rdname lode-guidance-functions #' @export lode_rightward <- lode_forward #' @rdname lode-guidance-functions #' @export lode_backward <- function(n, i) { if (i == 1) c(i, n:2) else if (i == n) n:1 else c(i, n:(i+1), (i-1):1) } #' @rdname lode-guidance-functions #' @export lode_leftward <- lode_backward #' @rdname lode-guidance-functions #' @export lode_frontback <- function(n, i) { if (i == 1) 1:n else if (i == n) n:1 else c(i, (i+1):n, (i-1):1) } #' @rdname lode-guidance-functions #' @export lode_rightleft <- lode_frontback #' @rdname lode-guidance-functions #' @export lode_backfront <- function(n, i) { if (i == 1) 1:n else if (i == n) n:1 else c(i, (i-1):1, (i+1):n) } #' @rdname lode-guidance-functions #' @export lode_leftright <- lode_backfront ggalluvial/R/geom-stratum.r0000644000176200001440000000461214367761413015430 0ustar liggesusers#' Strata at axes #' #' `geom_stratum` receives a dataset of the horizontal (`x`) and vertical (`y`, #' `ymin`, `ymax`) positions of the strata of an alluvial plot. It plots #' rectangles for these strata of a provided `width`. #' @template geom-aesthetics #' @template defunct-geom-params #' #' @import ggplot2 #' @family alluvial geom layers #' @seealso [ggplot2::layer()] for additional arguments and #' [stat_stratum()] for the corresponding stat. #' @inheritParams geom_lode #' @example inst/examples/ex-geom-stratum.r #' @export geom_stratum <- function(mapping = NULL, data = NULL, stat = "stratum", position = "identity", show.legend = NA, inherit.aes = TRUE, width = 1/3, na.rm = FALSE, ...) { layer( geom = GeomStratum, mapping = mapping, data = data, stat = stat, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list( width = width, na.rm = na.rm, ... ) ) } #' @rdname ggalluvial-ggproto #' @usage NULL #' @export GeomStratum <- ggproto( "GeomStratum", GeomRect, required_aes = c("x", "y", "ymin", "ymax"), default_aes = aes(size = .5, linewidth = .5, linetype = 1, colour = "black", fill = "white", alpha = 1), setup_data = function(data, params) { width <- params$width if (is.null(width)) width <- 1/3 transform(data, xmin = x - width / 2, xmax = x + width / 2) }, draw_panel = function(self, data, panel_params, coord, width = 1/3) { # taken from GeomRect strat_aes <- setdiff( names(data), c("x", "y", "xmin", "xmax", "ymin", "ymax") ) # construct polygon grobs polys <- lapply(split(data, seq_len(nrow(data))), function(row) { poly <- rect_to_poly(row$xmin, row$xmax, row$ymin, row$ymax) aes <- as.data.frame(row[strat_aes], stringsAsFactors = FALSE)[rep(1, 5), ] GeomPolygon$draw_panel(cbind(poly, aes, group = 1), panel_params, coord) }) # combine polygon grobs grob <- do.call(grid::grobTree, polys) grob$name <- grid::grobName(grob, "bar") grob }, draw_key = draw_key_polygon ) ggalluvial/R/data.r0000644000176200001440000000313214025146066013701 0ustar liggesusers#' Influenza vaccination survey responses #' #' This data set is aggregated from three RAND American Life Panel (ALP) surveys #' that asked respondents their probability of vaccinating for influenza. Their #' responses were discretized to "Never" (0%), "Always" (100%), or "Sometimes" #' (any other value). After merging, missing responses were coded as "Missing" #' and respondents were grouped and counted by all three coded responses. The #' pre-processed data were kindly contributed by Raffaele Vardavas, and the #' complete surveys are freely available at the ALP website. #' #' @keywords datasets #' @format A data frame with 117 rows and 5 variables: #' \describe{ #' \item{`freq`}{number of respondents represented in each row} #' \item{`subject`}{identifier linking respondents across surveys} #' \item{`survey`}{survey designation from the ALP website} #' \item{`start_date`}{start date of survey} #' \item{`end_date`}{end date of survey} #' \item{`response`}{discretized probability of vaccinating for influenza} #' } #' @source \url{https://alpdata.rand.org/} "vaccinations" #' Students' declared majors across several semesters #' #' This data set follows the major curricula of 10 students across 8 academic #' semesters. Missing values indicate undeclared majors. The data were kindly #' contributed by Dario Bonaretti. #' #' @name majors #' @keywords datasets #' @format A data frame with 80 rows and 3 variables: #' \describe{ #' \item{`student`}{student identifier} #' \item{`semester`}{character tag for odd-numbered semesters} #' \item{`curriculum`}{declared major program} #' } NULL ggalluvial/R/ggalluvial-package.r0000644000176200001440000000206214367761413016521 0ustar liggesusers#' @keywords internal #' #' @section Acknowledgments: #' #' Many users identified problems and suggested improvements via email and the #' GitHub issue tracker. #' #' Development benefitted from the use of equipment and the support of #' colleagues at [UConn Health](https://health.uconn.edu/) and at [UF #' Health](https://ufhealth.org/). #' "_PACKAGE" #' @importFrom rlang "%||%" # stratum and lode ordering options are documented in the `stat_*()` topics # curve options are documented in the `geom_*()` topics op.ggalluvial <- list( # stratum and lode ordering ggalluvial.decreasing = NA, ggalluvial.reverse = TRUE, ggalluvial.absolute = TRUE, ggalluvial.cement.alluvia = FALSE, ggalluvial.lode.guidance = "zigzag", ggalluvial.aes.bind = "none", # curves ggalluvial.curve_type = "xspline", ggalluvial.curve_range = NA_real_, ggalluvial.segments = 48L ) ggalluvial_opt <- function(x) { x_ggalluvial <- paste0("ggalluvial.", x) res <- getOption(x_ggalluvial) if (! is.null(res)) { return(res) } op.ggalluvial[[x_ggalluvial]] } ggalluvial/R/devel.r0000644000176200001440000000456214025146066014077 0ustar liggesusers deprecate_parameter <- function(old, new = NA, type = "parameter", msg = NULL) { .Deprecated(msg = paste0( "The ", type, " `", old, "` is deprecated.", if (is.null(new)) { "\nPass unparameterized arguments instead." } else if (! is.na(new)) { paste0("\nPass arguments to `", new, "` instead.") } else if (! is.null(msg)) { paste0("\n", msg) } else { "" } )) } defunct_parameter <- function(old, new = NA, type = "parameter", msg = NULL) { .Defunct(msg = paste0( "The ", type, " `", old, "` is defunct.", if (is.null(new)) { "\nPass unparameterized arguments instead." } else if (! is.na(new)) { paste0("\nPass arguments to `", new, "` instead.") } else if (! is.null(msg)) { paste0("\n", msg) } else { "" } )) } release_questions <- function() { c( "Have previous CRAN NOTEs been addressed?" ) } #' Deprecated functions #' #' These functions are deprecated in the current version and may be removed in a #' future version. #' #' Use `is_*_form` instead of `is_alluvial` and `is_alluvial_*`. #' Use `to_*_form` instead of `to_*`. #' #' @name ggalluvial-deprecated #' @keywords internal NULL #' @rdname ggalluvial-deprecated #' @export is_alluvial <- function(data, ..., silent = FALSE) { .Deprecated(msg = paste0( "The function `is_alluvial()` is deprecated; ", "use `is_lodes_form()` or `is_alluvia_form()`." )) # determine method based on arguments given dots <- lazyeval::lazy_dots(...) if (! is.null(dots$key) | ! is.null(dots$value) | ! is.null(dots$id)) { if (! is.null(dots$axes)) { stop("Arguments to `key`, `value`, and `id` are mutually exclusive ", "with an argument to `axes`.") } is_lodes_form(data = data, ..., silent = silent) } else { is_alluvia_form(data = data, ..., silent = silent) } } #' @rdname ggalluvial-deprecated #' @export is_alluvial_lodes <- function(...) { .Deprecated("is_lodes_form") is_lodes_form(...) } #' @rdname ggalluvial-deprecated #' @export is_alluvial_alluvia <- function(...) { .Deprecated("is_alluvia_form") is_alluvia_form(...) } #' @rdname ggalluvial-deprecated #' @export to_lodes <- function(...) { .Deprecated("to_lodes_form") to_lodes_form(...) } #' @rdname ggalluvial-deprecated #' @export to_alluvia <- function(...) { .Deprecated("to_alluvia_form") to_alluvia_form(...) } ggalluvial/R/stat-alluvium.r0000755000176200001440000004216114371217533015611 0ustar liggesusers#' Alluvial positions #' #' Given a dataset with alluvial structure, `stat_alluvium` calculates the #' centroids (`x` and `y`) and heights (`ymin` and `ymax`) of the lodes, the #' intersections of the alluvia with the strata. It leverages the `group` #' aesthetic for plotting purposes (for now). #' @template stat-aesthetics #' @template computed-variables #' @template order-options #' @template defunct-stat-params #' #' @import ggplot2 #' @importFrom rlang .data #' @family alluvial stat layers #' @seealso [ggplot2::layer()] for additional arguments and [geom_alluvium()], #' [geom_lode()], and [geom_flow()] for the corresponding geoms. #' @inheritParams stat_flow #' @param cement.alluvia Logical value indicating whether to aggregate `y` #' values over equivalent alluvia before computing lode and flow positions. #' @param aggregate.y Deprecated alias for `cement.alluvia`. #' @param lode.guidance The function to prioritize the axis variables for #' ordering the lodes within each stratum, or else a character string #' identifying the function. Character options are "zigzag", "frontback", #' "backfront", "forward", and "backward" (see [`lode-guidance-functions`]). #' @param lode.ordering **Deprecated in favor of the `order` aesthetic.** A list #' (of length the number of axes) of integer vectors (each of length the #' number of rows of `data`) or NULL entries (indicating no imposed ordering), #' or else a numeric matrix of corresponding dimensions, giving the preferred #' ordering of alluvia at each axis. This will be used to order the lodes #' within each stratum by sorting the lodes first by stratum, then by the #' provided vectors, and lastly by remaining factors (if the vectors contain #' duplicate entries and therefore do not completely determine the lode #' orderings). #' @example inst/examples/ex-stat-alluvium.r #' @export stat_alluvium <- function(mapping = NULL, data = NULL, geom = "alluvium", position = "identity", decreasing = NULL, reverse = NULL, absolute = NULL, discern = FALSE, negate.strata = NULL, aggregate.y = NULL, cement.alluvia = NULL, lode.guidance = NULL, lode.ordering = NULL, aes.bind = NULL, infer.label = FALSE, min.y = NULL, max.y = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( stat = StatAlluvium, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list( decreasing = decreasing, reverse = reverse, absolute = absolute, discern = discern, negate.strata = negate.strata, aggregate.y = aggregate.y, cement.alluvia = cement.alluvia, lode.guidance = lode.guidance, lode.ordering = lode.ordering, aes.bind = aes.bind, infer.label = infer.label, min.y = min.y, max.y = max.y, na.rm = na.rm, ... ) ) } #' @rdname ggalluvial-ggproto #' @usage NULL #' @export StatAlluvium <- ggproto( "StatAlluvium", Stat, required_aes = c("x"), # ` = NULL` prevents "unknown aesthetics" warnings default_aes = aes(weight = 1, stratum = NULL, alluvium = NULL), setup_params = function(data, params) { if (! is.null(params$lode.ordering)) { if (is.list(params$lode.ordering)) { # replace any null entries with uniform `NA` vectors wh_null <- which(sapply(params$lode.ordering, is.null)) len <- unique(sapply(params$lode.ordering[wh_null], length)) if (length(len) > 1) stop("Lode orderings have different lengths.") for (w in wh_null) params$lode.ordering[[w]] <- rep(NA, len) # convert list to array (requires equal-length numeric entries) params$lode.ordering <- do.call(cbind, params$lode.ordering) } } # remove null parameter values (see #103) params[vapply(params, is.null, NA)] <- NULL params }, setup_data = function(data, params) { # assign `alluvium` to `stratum` if `stratum` not provided if (is.null(data$stratum) && ! is.null(data$alluvium)) { data$stratum <- data$alluvium } # assign unit amounts if not provided if (is.null(data$y)) { data$y <- rep(1, nrow(data)) } else { data <- remove_missing( data, na.rm = params$na.rm, vars = "y", name = "stat_alluvium", finite = TRUE ) } type <- get_alluvial_type(data) if (type == "none") { stop("Data is not in a recognized alluvial form ", "(see `help('alluvial-data')` for details).") } if (params$na.rm) { data <- na.omit(object = data) } else { data <- na_keep(data = data, type = type) } # ensure that data is in lode form if (type == "alluvia") { axis_ind <- get_axes(names(data)) data <- to_lodes_form(data = data, axes = axis_ind, discern = params$discern) # positioning requires numeric `x` data <- data[with(data, order(x, stratum, alluvium)), , drop = FALSE] data$x <- contiguate(data$x) } else { if (! is.null(params$discern) && ! (params$discern == FALSE)) { warning("Data is already in lodes format, ", "so `discern` will be ignored.") } } # negate strata if (! is.null(params$negate.strata)) { if (! all(params$negate.strata %in% unique(data$stratum))) { warning("Some values of `negate.strata` are not among strata.") } wneg <- which(data$stratum %in% params$negate.strata) if (length(wneg) > 0) data$y[wneg] <- -data$y[wneg] } data }, compute_panel = function(data, scales, decreasing = NULL, reverse = NULL, absolute = NULL, discern = FALSE, distill = "first", negate.strata = NULL, aggregate.y = NULL, cement.alluvia = NULL, lode.guidance = NULL, lode.ordering = NULL, aes.bind = NULL, infer.label = FALSE, min.y = NULL, max.y = NULL) { # parameter defaults if (is.null(decreasing)) decreasing <- ggalluvial_opt("decreasing") if (is.null(reverse)) reverse <- ggalluvial_opt("reverse") if (is.null(absolute)) absolute <- ggalluvial_opt("absolute") if (is.null(cement.alluvia)) cement.alluvia <- ggalluvial_opt("cement.alluvia") if (is.null(lode.guidance)) lode.guidance <- ggalluvial_opt("lode.guidance") if (is.null(aes.bind)) aes.bind <- ggalluvial_opt("aes.bind") # introduce label if (infer.label) { deprecate_parameter("infer.label", msg = "Use `aes(label = after_stat(lode))`.") if (is.null(data$label)) { data$label <- data$alluvium } else { warning("Aesthetic `label` is specified, ", "so parameter `infer.label` will be ignored.") } } # ensure that `lode.ordering` is a matrix with column names if (! is.null(lode.ordering)) { deprecate_parameter("lode.ordering", msg = "Use the `order` aesthetic instead.") if (is.null(data$order)) { # bind a vector to itself to create a matrix if (is.vector(lode.ordering)) { lode.ordering <- matrix(lode.ordering, nrow = length(lode.ordering), ncol = length(unique(data$x))) } # flatten `lode.ordering` into an 'order' column data$order <- as.vector(lode.ordering) } else { warning("Aesthetic `order` is specified, ", "so parameter `lode.ordering` will be ignored.") } } # differentiation aesthetics (in prescribed order) diff_aes <- intersect(c(.color_diff_aesthetics, .text_aesthetics), names(data)) # match arguments for `aes.bind` if (! is.null(aes.bind)) { if (is.logical(aes.bind)) { aes.bind.rep <- if (aes.bind) "flows" else "none" warning("Logical values of `aes.bind` are deprecated; ", "replacing ", aes.bind, " with '", aes.bind.rep, "'.") aes.bind <- aes.bind.rep } aes.bind <- match.arg(aes.bind, c("none", "flows", "alluvia")) } # sign variable (sorts positives before negatives) data$yneg <- data$y < 0 # lode variable (before co-opting 'alluvium') data$lode <- data$alluvium # specify distillation function from `distill` distill <- distill_fun(distill) # initiate variables for `after_stat()` weight <- data$weight data$weight <- NULL if (is.null(weight)) weight <- 1 data$n <- weight data$count <- data$y * weight # transform 'order' according to `absolute` and `reverse` params if (! is.null(data$order)) data$order <- xtfrm(data$order) * (-1) ^ (data$yneg * absolute + reverse) # cement (aggregate) `y` over otherwise equivalent alluvia if (! is.null(aggregate.y)) { deprecate_parameter("aggregate.y", "cement.alluvia") cement.alluvia <- aggregate.y } if (cement.alluvia) { # -+- need to stop depending on 'group' and 'PANEL' -+- only_vars <- intersect(c(diff_aes, "group", "PANEL"), names(data)) bind_vars <- intersect(c("yneg", "stratum", only_vars), names(data)) sum_vars <- c("y", "n", "count") # interaction of all variables to aggregate over (without dropping NAs) # -+- need to stop depending on 'group' -+- data$binding <- as.numeric(interaction(lapply( data[, bind_vars, drop = FALSE], addNA, ifany = FALSE ), drop = TRUE)) # convert to alluvia format with 'binding' entries luv_dat <- alluviate(data, "x", "binding", "alluvium") # sort by all axes (everything except 'alluvium') luv_dat <- luv_dat[do.call( order, luv_dat[, setdiff(names(luv_dat), "alluvium"), drop = FALSE] ), , drop = FALSE] # define map from original to aggregated 'alluvium' column luv_orig <- luv_dat$alluvium luv_agg <- cumsum(! duplicated(interaction( luv_dat[, setdiff(names(luv_dat), "alluvium"), drop = FALSE], drop = TRUE ))) # transform 'alluvium' in `data` accordingly data$alluvium <- luv_agg[match(data$alluvium, luv_orig)] # aggregate variables over 'x', 'yneg', and 'stratum': # sum of computed variables and unique-or-bust values of aesthetics by_vars <- c("x", "yneg", "stratum", "alluvium", "binding") agg_lode <- stats::aggregate(data[, "lode", drop = FALSE], data[, by_vars], distill) if (length(only_vars) > 0) { agg_only <- stats::aggregate(data[, only_vars, drop = FALSE], data[, by_vars], only) } agg_dat <- stats::aggregate(data[, sum_vars], data[, by_vars], sum) agg_dat <- merge(agg_dat, agg_lode) if (length(only_vars) > 0) { agg_dat <- merge(agg_dat, agg_only) } # merge into `data`, ensuring that no `key`-`id` pairs are duplicated data <- unique(merge( agg_dat, data[, setdiff(names(data), sum_vars)], all.x = TRUE, all.y = FALSE )) data$binding <- NULL } # define 'deposit' variable to rank strata vertically data <- deposit_data(data, decreasing, reverse, absolute) # ensure that `lode.guidance` is a function if (is.character(lode.guidance)) { lode.guidance <- get(paste0("lode_", lode.guidance)) } stopifnot(is.function(lode.guidance)) # invoke surrounding axes in the order prescribed by `lode.guidance` lode_ord <- guide_lodes(data, lode.guidance) # convert `lode_ord` into a single sorting variable 'rem_deposit' # that orders index lodes by remaining / remote deposits names(lode_ord) <- sort(unique(data$x)) lode_ord$alluvium <- if (is.null(rownames(lode_ord))) { if (is.factor(data$alluvium)) { levels(data$alluvium) } else if (is.numeric(data$alluvium)) { sort(unique(data$alluvium)) } else { unique(data$alluvium) } } else { rownames(lode_ord) } # match `lode_ord$x` back to `data$x` uniq_x <- sort(unique(data$x)) lode_ord <- tidyr::gather(lode_ord, key = "x", value = "rem_deposit", as.character(uniq_x)) match_x <- match(lode_ord$x, as.character(uniq_x)) lode_ord$x <- uniq_x[match_x] # merge `lode_ord` back into `data` data <- merge(data, lode_ord, by = c("x", "alluvium"), all.x = TRUE, all.y = FALSE) # identify fissures at aesthetics that vary within strata n_lodes <- nrow(unique(data[, c("x", "stratum")])) fissure_aes <- diff_aes[which(sapply(diff_aes, function(x) { nrow(unique(data[, c("x", "stratum", x)])) }) > n_lodes)] data$fissure <- if (length(fissure_aes) == 0) { 1 } else { # order by aesthetics in order as.integer(interaction(data[, rev(fissure_aes)], drop = TRUE)) * (-1) ^ (data$yneg * absolute + reverse) } # calculate variables for `after_stat()` x_sums <- tapply(abs(data$count), data$x, sum, na.rm = TRUE) data$prop <- data$count / x_sums[match(as.character(data$x), names(x_sums))] # reverse alluvium order data$fan <- xtfrm(data$alluvium) * (-1) ^ reverse # sort data in preparation for `y` sums sort_fields <- c( "x", "deposit", if (! is.null(data$order)) "order", if (aes.bind == "alluvia") "fissure", "rem_deposit", if (aes.bind == "flows") "fissure", "fan" ) data <- data[do.call(order, data[, sort_fields]), , drop = FALSE] # calculate `y` sums data$ycum <- NA for (xx in unique(data$x)) { for (yn in c(FALSE, TRUE)) { ww <- which(data$x == xx & data$yneg == yn) data$ycum[ww] <- cumulate(data$y[ww]) } } # calculate y bounds data$rem_deposit <- NULL data$order <- NULL data$fissure <- NULL data$fan <- NULL data$ymin <- data$ycum - abs(data$y) / 2 data$ymax <- data$ycum + abs(data$y) / 2 data$y <- data$ycum data$yneg <- NULL data$ycum <- NULL # within each alluvium, indices at which subsets are contiguous data <- data[with(data, order(x, alluvium)), , drop = FALSE] data$cont <- duplicated(data$alluvium) & ! duplicated(data[, c("x", "alluvium")]) data$axis <- contiguate(data$x) # within each alluvium, group contiguous subsets # (data is sorted by `x` and `alluvium`; group_by() does not reorder it) data <- dplyr::ungroup(dplyr::mutate(dplyr::group_by(data, alluvium), flow = axis - cumsum(cont))) # add 'group' to group contiguous alluvial subsets data <- transform(data, group = as.numeric(interaction(alluvium, flow))) # remove unused fields data$cont <- NULL data$axis <- NULL data$flow <- NULL # impose height restrictions if (! is.null(min.y)) data <- subset(data, ymax - ymin >= min.y) if (! is.null(max.y)) data <- subset(data, ymax - ymin <= max.y) # arrange data by aesthetics for consistent (reverse) z-ordering data <- z_order_aes(data, diff_aes) data } ) # apply lode guidance function to produce ordering matrix guide_lodes <- function(data, guidance_fun) { # summary data of alluvial deposits alluv_dep <- alluviate(data, "x", "deposit", "alluvium") # axis indices alluv_x <- setdiff(names(alluv_dep), "alluvium") # initialize ordering matrix ord_mat <- matrix(NA_integer_, nrow = nrow(alluv_dep), ncol = length(alluv_x)) dimnames(ord_mat) <- list(alluv_dep$alluvium, alluv_x) # calculate orderings from `guidance_fun` for (xx in alluv_x) { ii <- match(xx, alluv_x) ord_x <- guidance_fun(length(alluv_x), match(xx, alluv_x)) # order by prescribed ordering and by aesthetics in order ord_mat[, xx] <- interaction(alluv_dep[, alluv_x[rev(ord_x)]], drop = TRUE) } # check that array has correct dimensions stopifnot(dim(ord_mat) == c(length(unique(data$alluvium)), length(unique(data$x)))) # return ordering matrix as a data aframe as.data.frame(ord_mat) } # build alluvial dataset for reference during lode-ordering alluviate <- function(data, key, value, id) { to_alluvia_form( data[, c(key, value, id), drop = FALSE], key = key, value = value, id = id ) } ggalluvial/R/self-adjoin.r0000644000176200001440000000435514367761413015203 0ustar liggesusers#' Adjoin a dataset to itself #' #' This function binds a dataset to itself along adjacent pairs of a `key` #' variable. It is invoked by [geom_flow()] to convert data in lodes #' form to something similar to alluvia form. #' #' `self_adjoin` invokes [`dplyr::mutate-joins`] functions in order to convert #' a dataset with measures along a discrete `key` variable into a dataset #' consisting of column bindings of these measures (by any `by` variables) along #' adjacent values of `key`. #' @name self-adjoin #' @importFrom rlang enquo #' @importFrom tidyselect vars_pull #' @family alluvial data manipulation #' @param data A data frame in lodes form (repeated measures data; see #' [`alluvial-data`]). #' @param key Column of `data` indicating sequential collection; handled as in #' [tidyr::spread()]. #' @param by Character vector of variables to self-adjoin by; passed to #' [`dplyr::mutate-joins`] functions. #' @param link Character vector of variables to adjoin. Will be replaced by #' pairs of variables suffixed by `suffix`. #' @param keep.x,keep.y Character vector of variables to associate with the #' first (respectively, second) copy of `data` after adjoining. These #' variables can overlap with each other but cannot overlap with `by` or #' `link`. #' @param suffix Suffixes to add to the adjoined `link` variables; passed to #' [`dplyr::mutate-joins`] functions. #' @example inst/examples/ex-self-adjoin.r #' @export self_adjoin <- function( data, key, by = NULL, link = NULL, keep.x = NULL, keep.y = NULL, suffix = c(".x", ".y") ) { key_var <- vars_pull(names(data), !! enquo(key)) # ensure that `key` is coercible to numeric #key_num <- data[[key_var]] #if (is.character(key_num)) key_num <- as.factor(key_num) #key_num <- as.numeric(key_num) # identify unique values of `key` in order uniq_key <- sort(unique(data[[key_var]])) key_num <- match(data[[key_var]], uniq_key) # select datasets `x` and `y` x <- transform(data, step = key_num)[, c("step", by, link, keep.x)] y <- transform(data, step = key_num - 1)[, c("step", by, link, keep.y)] # return inner join of `x` and `y` adj <- dplyr::inner_join( x, y, by = c("step", by), suffix = suffix ) adj$step <- uniq_key[adj$step] adj } ggalluvial/R/ggproto.r0000644000176200001440000000021214025146066014445 0ustar liggesusers#' Base ggproto classes for ggalluvial #' #' @name ggalluvial-ggproto #' @seealso [`ggplot2::ggplot2-ggproto`] #' @keywords internal NULL ggalluvial/R/geom-lode.r0000644000176200001440000000530514367761413014654 0ustar liggesusers#' Lodes at intersections of alluvia and strata #' #' `geom_alluvium` receives a dataset of the horizontal (`x`) and vertical (`y`, #' `ymin`, `ymax`) positions of the **lodes** of an alluvial plot, the #' intersections of the alluvia with the strata. It plots rectangles for these #' lodes of a provided `width`. #' @template geom-aesthetics #' @template defunct-geom-params #' #' @import ggplot2 #' @family alluvial geom layers #' @seealso [ggplot2::layer()] for additional arguments and #' [stat_alluvium()] and #' [stat_stratum()] for the corresponding stats. #' @inheritParams ggplot2::layer #' @template layer-params #' @param stat The statistical transformation to use on the data; #' override the default. #' @param width Numeric; the width of each stratum, as a proportion of the #' distance between axes. Defaults to 1/3. #' @example inst/examples/ex-geom-lode.r #' @export geom_lode <- function(mapping = NULL, data = NULL, stat = "alluvium", position = "identity", width = 1/3, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( geom = GeomLode, mapping = mapping, data = data, stat = stat, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list( width = width, na.rm = na.rm, ... ) ) } #' @rdname ggalluvial-ggproto #' @usage NULL #' @export GeomLode <- ggproto( "GeomLode", Geom, required_aes = c("x", "y", "ymin", "ymax"), default_aes = aes(size = .5, linewidth = .5, linetype = 1, colour = "transparent", fill = "gray", alpha = .5), setup_data = function(data, params) { width <- params$width if (is.null(width)) width <- 1/3 transform(data, xmin = x - width / 2, xmax = x + width / 2) }, draw_panel = function(data, panel_params, coord, width = 1/3) { # taken from GeomRect lode_aes <- setdiff( names(data), c("x", "y", "xmin", "xmax", "ymin", "ymax") ) # construct polygon grobs polys <- lapply(split(data, seq_len(nrow(data))), function(row) { poly <- rect_to_poly(row$xmin, row$xmax, row$ymin, row$ymax) aes <- as.data.frame(row[lode_aes], stringsAsFactors = FALSE)[rep(1, 5), ] GeomPolygon$draw_panel(cbind(poly, aes, group = 1), panel_params, coord) }) # combine polygon grobs grob <- do.call(grid::grobTree, polys) grob$name <- grid::grobName(grob, "bar") grob }, draw_key = draw_key_polygon ) ggalluvial/R/geom-flow.r0000644000176200001440000001566714367761413014714 0ustar liggesusers#' Flows between lodes or strata #' #' `geom_flow` receives a dataset of the horizontal (`x`) and vertical (`y`, #' `ymin`, `ymax`) positions of the **lodes** of an alluvial plot, the #' intersections of the alluvia with the strata. It reconfigures these into #' alluvial segments connecting pairs of corresponding lodes in adjacent strata #' and plots filled x-splines between each such pair, using a provided knot #' position parameter `knot.pos`, and filled rectangles at either end, using a #' provided `width`. #' #' The helper function `positions_toflow()` takes the corner and knot positions #' and curve parameters for a single flow as input and returns a data frame of #' `x`, `y`, and `shape` used by [grid::xsplineGrob()] to render the flow. #' @template geom-aesthetics #' @template geom-curves #' @template defunct-geom-params #' #' @import ggplot2 #' @family alluvial geom layers #' @seealso [ggplot2::layer()] for additional arguments and #' [stat_alluvium()] and #' [stat_flow()] for the corresponding stats. #' @inheritParams geom_alluvium #' @param aes.flow Character; how inter-lode flows assume aesthetics from lodes. #' Options are "forward" and "backward". #' @param x0,x1,ymin0,ymax0,ymin1,ymax1,kp0,kp1 Numeric corner and knot position #' data for the ribbon of a single flow. #' @example inst/examples/ex-geom-flow.r #' @export geom_flow <- function(mapping = NULL, data = NULL, stat = "flow", position = "identity", width = 1/3, knot.pos = 1/4, knot.prop = TRUE, curve_type = NULL, curve_range = NULL, segments = NULL, aes.flow = "forward", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { aes.flow <- match.arg(aes.flow, c("forward", "backward")) layer( geom = GeomFlow, mapping = mapping, data = data, stat = stat, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list( width = width, knot.pos = knot.pos, knot.prop = knot.prop, curve_type = curve_type, curve_range = curve_range, segments = segments, aes.flow = aes.flow, na.rm = na.rm, ... ) ) } #' @rdname ggalluvial-ggproto #' @usage NULL #' @export GeomFlow <- ggproto( "GeomFlow", Geom, required_aes = c("x", "y", "ymin", "ymax"), default_aes = aes(linewidth = .5, linetype = 1, colour = "transparent", fill = "gray", alpha = .5), setup_data = function(data, params) { width <- params$width if (is.null(width)) { width <- 1/3 } knot.pos <- params$knot.pos if (is.null(knot.pos)) knot.pos <- 1/4 # positioning parameters transform(data, xmin = x - width / 2, xmax = x + width / 2, knot.pos = knot.pos) }, draw_panel = function(self, data, panel_params, coord, width = 1/3, aes.flow = "forward", knot.pos = 1/4, knot.prop = TRUE, curve_type = NULL, curve_range = NULL, segments = NULL) { # parameter defaults if (is.null(curve_type)) curve_type <- ggalluvial_opt("curve_type") if (is.null(curve_range)) curve_range <- ggalluvial_opt("curve_range") if (is.null(segments)) segments <- ggalluvial_opt("segments") # exclude one-sided flows data <- data[complete.cases(data), ] # adjoin data with itself by alluvia along adjacent axes flow_pos <- intersect(names(data), c("x", "xmin", "xmax", "width", "knot.pos", "y", "ymin", "ymax")) flow_aes <- intersect(names(data), c("linewidth", "size", "linetype", "colour", "fill", "alpha")) flow_fore <- if (aes.flow != "backward") flow_aes else NULL flow_back <- if (aes.flow != "forward") flow_aes else NULL data <- self_adjoin( data = data, key = "x", by = "alluvium", link = flow_pos, keep.x = flow_fore, keep.y = flow_back, suffix = c(".0", ".1") ) # aesthetics (in prescribed order) aesthetics <- intersect(.color_diff_aesthetics, names(data)) # arrange data by aesthetics for consistent (reverse) z-ordering data <- data[do.call(order, lapply( data[, c("step", aesthetics)], function(x) factor(x, levels = unique(x)) )), ] # construct x-spline grobs grobs <- lapply(split(data, seq_len(nrow(data))), function(row) { # path of spline or unit curve f_path <- positions_to_flow( row$xmax.0, row$xmin.1, row$ymin.0, row$ymax.0, row$ymin.1, row$ymax.1, row$knot.pos.0, row$knot.pos.1, knot.prop = knot.prop, curve_type = curve_type, curve_range = curve_range, segments = segments ) # aesthetics aes <- as.data.frame(row[flow_aes], stringsAsFactors = FALSE) # join aesthetics to path f_data <- cbind(f_path, aes[rep(1, nrow(f_path)), ]) # transform (after calculating spline paths) f_coords <- coord$transform(f_data, panel_params) # single spline grob grid::xsplineGrob( x = f_coords$x, y = f_coords$y, shape = f_coords$shape, open = FALSE, gp = grid::gpar( col = f_coords$colour, fill = f_coords$fill, alpha = f_coords$alpha, lty = f_coords$linetype, lwd = (f_coords$linewidth %||% f_coords$size) * .pt ) ) }) # combine spline grobs grob <- do.call(grid::grobTree, grobs) grob$name <- grid::grobName(grob, "xspline") grob }, draw_key = draw_key_polygon, non_missing_aes = "size", rename_size = TRUE ) #' @rdname geom_flow #' @export positions_to_flow <- function( x0, x1, ymin0, ymax0, ymin1, ymax1, kp0, kp1, knot.prop, curve_type, curve_range, segments ) { if (curve_type %in% c("spline", "xspline")) { # x-spline path k_fore <- c(0, kp0, -kp1, 0) if (knot.prop) k_fore <- k_fore * (x1 - x0) x_fore <- rep(c(x0, x1), each = 2) + k_fore data.frame( x = c(x_fore, rev(x_fore)), y = c(ymin0, ymin0, ymin1, ymin1, ymax1, ymax1, ymax0, ymax0), shape = rep(c(0, 1, 1, 0), times = 2) ) } else { # default to 48 segments per curve, ensure the minimum number of segments if (is.null(segments)) segments <- 48 else if (segments < 3) { #warning("Must use at least 3 segments; substituting `segments = 3`.") segments <- 3 } # unit curve path curve_fun <- make_curve_fun(curve_type, curve_range) i_fore <- seq(0, 1, length.out = segments + 1) f_fore <- curve_fun(i_fore) x_fore <- x0 + (x1 - x0) * i_fore data.frame( x = c(x_fore, rev(x_fore)), y = c(ymin0 + (ymin1 - ymin0) * f_fore, ymax1 + (ymax0 - ymax1) * f_fore), shape = 0 ) } } ggalluvial/R/geom-alluvium.r0000644000176200001440000002154614367761413015574 0ustar liggesusers#' Alluvia across strata #' #' `geom_alluvium` receives a dataset of the horizontal (`x`) and vertical (`y`, #' `ymin`, `ymax`) positions of the **lodes** of an alluvial plot, the #' intersections of the alluvia with the strata. It plots both the lodes #' themselves, using [geom_lode()], and the flows between them, using #' [geom_flow()]. #' #' The helper function `data_to_alluvium()` takes internal **ggplot2** data #' (mapped aesthetics) and curve parameters for a single alluvium as input and #' returns a data frame of `x`, `y`, and `shape` used by [grid::xsplineGrob()] #' to render the alluvium. #' @template geom-aesthetics #' @template geom-curves #' @template defunct-geom-params #' #' @import ggplot2 #' @family alluvial geom layers #' @seealso [ggplot2::layer()] for additional arguments and #' [stat_alluvium()] and #' [stat_flow()] for the corresponding stats. #' @inheritParams geom_lode #' @param knot.pos The horizontal distance of x-spline knots from each stratum #' (`width/2` from its axis), either (if `knot.prop = TRUE`, the default) as a #' proportion of the length of the x-spline, i.e. of the gap between adjacent #' strata, or (if `knot.prop = FALSE`) on the scale of the `x` direction. #' @param knot.prop Logical; whether to interpret `knot.pos` as a proportion of #' the length of each flow (the default), rather than on the `x` scale. #' @param curve_type Character; the type of curve used to produce flows. #' Defaults to `"xspline"` and can be alternatively set to one of `"linear"`, #' `"cubic"`, `"quintic"`, `"sine"`, `"arctangent"`, and `"sigmoid"`. #' `"xspline"` produces approximation splines using 4 points per curve; the #' alternatives produce interpolation splines between points along the graphs #' of functions of the associated type. See the **Curves** section. #' @param curve_range For alternative `curve_type`s based on asymptotic #' functions, the value along the asymptote at which to truncate the function #' to obtain the shape that will be scaled to fit between strata. See the #' **Curves** section. #' @param segments The number of segments to be used in drawing each alternative #' curve (each curved boundary of each flow). If less than 3, will be silently #' changed to 3. #' @example inst/examples/ex-geom-alluvium.r #' @export geom_alluvium <- function(mapping = NULL, data = NULL, stat = "alluvium", position = "identity", width = 1/3, knot.pos = 1/4, knot.prop = TRUE, curve_type = NULL, curve_range = NULL, segments = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( geom = GeomAlluvium, mapping = mapping, data = data, stat = stat, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list( width = width, knot.pos = knot.pos, knot.prop = knot.prop, curve_type = curve_type, curve_range = curve_range, segments = segments, na.rm = na.rm, ... ) ) } #' @rdname ggalluvial-ggproto #' @usage NULL #' @export GeomAlluvium <- ggproto( "GeomAlluvium", Geom, required_aes = c("x", "y", "ymin", "ymax"), default_aes = aes(linewidth = .5, linetype = 1, colour = "transparent", fill = "gray", alpha = .5), setup_data = function(data, params) { if (! is.null(params$aes.flow)) { warning("Parameter `aes.flow` cannot be used in `geom_alluvium`, ", "and will be ignored; ", "use `geom_lode` and `geom_flow` instead.") params$aes.flow <- NULL } # check whether color or differentiation aesthetics vary within alluvia aesthetics <- intersect(.color_diff_aesthetics, names(data)) if (nrow(unique(data[, c("alluvium", aesthetics), drop = FALSE])) != length(unique(data$alluvium))) { warning("Some differentiation aesthetics vary within alluvia, ", "and will be diffused by their first value.\n", "Consider using `geom_flow()` instead.") } knot.pos <- params$knot.pos if (is.null(knot.pos)) knot.pos <- 1/4 # positioning parameters transform(data, knot.pos = knot.pos) }, draw_group = function(self, data, panel_scales, coord, width = 1/3, knot.pos = 1/4, knot.prop = TRUE, curve_type = NULL, curve_range = NULL, segments = NULL) { # parameter defaults if (is.null(curve_type)) curve_type <- ggalluvial_opt("curve_type") if (is.null(curve_range)) curve_range <- ggalluvial_opt("curve_range") if (is.null(segments)) segments <- ggalluvial_opt("segments") # add width to data data <- transform(data, width = width) first_row <- data[1, setdiff(names(data), c("x", "xmin", "xmax", "width", "knot.pos", "y", "ymin", "ymax")), drop = FALSE] rownames(first_row) <- NULL # default to 48 segments per curve, ensure the minimum number of segments if (is.null(segments)) segments <- 48 else if (segments < 3) { #warning("Must use at least 3 segments; substituting `segments = 3`.") segments <- 3 } curve_data <- data_to_alluvium( data, knot.prop = knot.prop, curve_type = curve_type, curve_range = curve_range, segments = segments ) data <- data.frame(first_row, curve_data) # transform (after calculating spline paths) coords <- coord$transform(data, panel_scales) # graphics object grid::xsplineGrob( x = coords$x, y = coords$y, shape = coords$shape, open = FALSE, gp = grid::gpar( col = coords$colour, fill = coords$fill, alpha = coords$alpha, lty = coords$linetype, lwd = (coords$linewidth %||% coords$size) * .pt ) ) }, draw_key = draw_key_polygon, non_missing_aes = "size", rename_size = TRUE ) #' @rdname geom_alluvium #' @export data_to_alluvium <- function( data, knot.prop = TRUE, curve_type = "spline", curve_range = NULL, segments = NULL ) { if (nrow(data) == 1L) { # spline coordinates (one axis) with(data, data.frame( x = x + width / 2 * c(-1, 1, 1, -1), y = ymin + (ymax - ymin) * c(0, 0, 1, 1), shape = rep(0, 4L) )) } else if (curve_type %in% c("spline", "xspline")) { # spline coordinates (more than one axis) # calculate control point coordinates for x-splines: # left side, right side, foreward knot, rearward knot, left side, right side w_fore <- rep(data$width, c(3, rep(4, nrow(data) - 2L), 3)) k_fore <- rep(data$knot.pos, c(3, rep(4, nrow(data) - 2L), 3)) if (knot.prop) { # distances between strata b_fore <- rep(data$x, c(1, rep(2, nrow(data) - 2L), 1)) + c(1, -1) * rep(data$width / 2, c(1, rep(2, nrow(data) - 2L), 1)) d_fore <- diff(b_fore)[seq(length(b_fore) - 1L) %% 2L] # scale `k_fore` to these distances k_fore <- k_fore * c(0, rep(d_fore, rep(4, nrow(data) - 1L)), 0) } # axis position +/- corresponding width +/- relative knot position x_fore <- rep(data$x, c(3, rep(4, nrow(data) - 2L), 3)) + w_fore / 2 * c(-1, rep(c(1, 1, -1, -1), nrow(data) - 1L), 1) + k_fore * c(0, rep(c(0, 1, -1, 0), nrow(data) - 1L), 0) # vertical positions are those of lodes ymin_fore <- rep(data$ymin, c(3, rep(4, nrow(data) - 2L), 3)) ymax_fore <- rep(data$ymax, c(3, rep(4, nrow(data) - 2L), 3)) shape_fore <- c(0, rep(c(0, 1, 1, 0), nrow(data) - 1L), 0) data.frame( x = c(x_fore, rev(x_fore)), y = c(ymin_fore, rev(ymax_fore)), shape = rep(shape_fore, 2L) ) } else { # unit curve coordinates (more than one axis) # specs for a single flow curve curve_fun <- make_curve_fun(curve_type, curve_range) i_once <- seq(0L, 1L, length.out = segments + 1L) f_once <- curve_fun(i_once) # coordinates for a full curve b_fore <- as.vector(rbind(data$x - data$w / 2, data$x + data$w / 2)) x_fore <- c( b_fore[1], t(b_fore[seq(nrow(data) - 1L) * 2L] + outer(diff(b_fore)[seq(nrow(data) - 1L) * 2L], i_once, "*")), b_fore[nrow(data) * 2L] ) ymin_fore <- c( data$ymin[1L], t(data$ymin[-nrow(data)] + outer(diff(data$ymin), f_once, "*")), data$ymin[nrow(data)] ) ymax_fore <- c( data$ymax[1L], t(data$ymax[-nrow(data)] + outer(diff(data$ymax), f_once, "*")), data$ymax[nrow(data)] ) data.frame( x = c(x_fore, rev(x_fore)), y = c(ymin_fore, rev(ymax_fore)), shape = 0 ) } } ggalluvial/R/stat-stratum.r0000644000176200001440000002507314371217533015452 0ustar liggesusers#' Stratum positions #' #' Given a dataset with alluvial structure, `stat_stratum` calculates the #' centroids (`x` and `y`) and heights (`ymin` and `ymax`) of the strata at each #' axis. #' @template stat-aesthetics #' @template computed-variables #' @template order-options #' @template defunct-stat-params #' #' @import ggplot2 #' @family alluvial stat layers #' @seealso [ggplot2::layer()] for additional arguments and [geom_stratum()] for #' the corresponding geom. #' @inheritParams ggplot2::layer #' @template layer-params #' @param geom The geometric object to use display the data; override the #' default. #' @param decreasing Logical; whether to arrange the strata at each axis in the #' order of the variable values (`NA`, the default), in ascending order of #' totals (largest on top, `FALSE`), or in descending order of totals (largest #' on bottom, `TRUE`). #' @param reverse Logical; if `decreasing` is `NA`, whether to arrange the #' strata at each axis in the reverse order of the variable values, so that #' they match the order of the values in the legend. Ignored if `decreasing` #' is not `NA`. Defaults to `TRUE`. #' @param absolute Logical; if some cases or strata are negative, whether to #' arrange them (respecting `decreasing` and `reverse`) using negative or #' absolute values of `y`. #' @param discern Passed to [to_lodes_form()] if `data` is in alluvia format. #' @param distill A function (or its name) to be used to distill alluvium values #' to a single lode label, accessible via #' [`ggplot2::after_stat()`][ggplot2::aes_eval] (similar to its behavior in #' [to_alluvia_form()]). It recognizes three character values: `"first"` (the #' default) and `"last"` [as defined][dplyr::nth()] in **dplyr**; and `"most"` #' (which returns the first modal value). #' @param negate.strata A vector of values of the `stratum` aesthetic to be #' treated as negative (will ignore missing values with a warning). #' @param infer.label Logical; whether to assign the `stratum` or `alluvium` #' variable to the `label` aesthetic. Defaults to `FALSE`, and requires that #' no `label` aesthetic is assigned. This parameter is intended for use only #' with data in alluva form, which are converted to lode form before the #' statistical transformation. Deprecated; use #' [`ggplot2::after_stat()`][ggplot2::aes_eval] instead. #' @param label.strata Defunct; alias for `infer.label`. #' @param min.y,max.y Numeric; bounds on the heights of the strata to be #' rendered. Use these bounds to exclude strata outside a certain range, for #' example when labeling strata using [ggplot2::geom_text()]. #' @param min.height,max.height Deprecated aliases for `min.y` and `max.y`. #' @example inst/examples/ex-stat-stratum.r #' @export stat_stratum <- function(mapping = NULL, data = NULL, geom = "stratum", position = "identity", decreasing = NULL, reverse = NULL, absolute = NULL, discern = FALSE, distill = "first", negate.strata = NULL, infer.label = FALSE, label.strata = NULL, min.y = NULL, max.y = NULL, min.height = NULL, max.height = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( stat = StatStratum, mapping = mapping, data = data, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list( decreasing = decreasing, reverse = reverse, absolute = absolute, discern = discern, distill = distill, negate.strata = negate.strata, infer.label = infer.label, label.strata = label.strata, min.y = min.y, max.y = max.y, min.height = min.height, max.height = max.height, na.rm = na.rm, ... ) ) } #' @rdname ggalluvial-ggproto #' @usage NULL #' @export StatStratum <- ggproto( "StatStratum", Stat, required_aes = c("x"), # ` = NULL` prevents "unknown aesthetics" warnings default_aes = aes(weight = 1, stratum = NULL, alluvium = NULL), setup_data = function(data, params) { # if `alluvium` not provided, assign each row its own, grouped by `x` if (is.null(data$alluvium) && ! is.null(data$x)) { data$alluvium <- NA for (xx in unique(data$x)) { ww <- which(data$x == xx) data$alluvium[ww] <- 1:length(ww) } } # assign unit amounts if not provided if (is.null(data$y)) { data$y <- rep(1, nrow(data)) } else { data <- remove_missing( data, na.rm = params$na.rm, vars = "y", name = "stat_stratum", finite = TRUE ) } type <- get_alluvial_type(data) if (type == "none") { stop("Data is not in a recognized alluvial form ", "(see `help('alluvial-data')` for details).") } if (params$na.rm) { data <- na.omit(object = data) } else { data <- na_keep(data = data, type = type) } # ensure that data is in lode form if (type == "alluvia") { axis_ind <- get_axes(names(data)) data <- to_lodes_form(data = data, axes = axis_ind, discern = params$discern) # positioning requires numeric `x` data <- data[with(data, order(x, stratum, alluvium)), , drop = FALSE] data$x <- contiguate(data$x) } else { if (! is.null(params$discern) && ! (params$discern == FALSE)) { warning("Data is already in lodes format, ", "so `discern` will be ignored.") } } # negate strata if (! is.null(params$negate.strata)) { if (! all(params$negate.strata %in% unique(data$stratum))) { warning("Some values of `negate.strata` are not among strata.") } wneg <- which(data$stratum %in% params$negate.strata) if (length(wneg) > 0) data$y[wneg] <- -data$y[wneg] } # nullify `group` and `alluvium` fields (to avoid confusion with geoms) data$group <- NULL #data$alluvium <- NULL data }, compute_panel = function(self, data, scales, decreasing = NULL, reverse = NULL, absolute = NULL, discern = FALSE, distill = "first", negate.strata = NULL, infer.label = FALSE, label.strata = NULL, min.y = NULL, max.y = NULL, min.height = NULL, max.height = NULL) { # parameter defaults if (is.null(decreasing)) decreasing <- ggalluvial_opt("decreasing") if (is.null(reverse)) reverse <- ggalluvial_opt("reverse") if (is.null(absolute)) absolute <- ggalluvial_opt("absolute") # introduce label if (! is.null(label.strata)) { defunct_parameter("label.strata", msg = "use `aes(label = after_stat(stratum))`.") infer.label <- label.strata } if (infer.label) { deprecate_parameter("infer.label", msg = "Use `aes(label = after_stat(stratum))`.") if (is.null(data$label)) { data$label <- data$stratum } else { warning("Aesthetic `label` is specified, ", "so parameter `infer.label` will be ignored.") } } # differentiation aesthetics (in prescribed order) diff_aes <- intersect(c(.color_diff_aesthetics, .text_aesthetics), names(data)) # sign variable (sorts positives before negatives) data$yneg <- data$y < 0 # lode variable (before co-opting 'alluvium') data$lode <- data$alluvium # specify distillation function from `distill` distill <- distill_fun(distill) # initiate variables for `after_stat()` weight <- data$weight data$weight <- NULL if (is.null(weight)) weight <- 1 data$n <- weight data$count <- data$y * weight # aggregate variables over 'x', 'yneg', and 'stratum': # sum of computed variables and unique-or-bust values of aesthetics by_vars <- c("x", "yneg", "stratum") only_vars <- c(diff_aes) sum_vars <- c("y", "n", "count") if (! is.null(data$lode)) { agg_lode <- stats::aggregate(data[, "lode", drop = FALSE], data[, by_vars], distill) } if (length(only_vars) > 0) { agg_only <- stats::aggregate(data[, only_vars, drop = FALSE], data[, by_vars], only) } data <- stats::aggregate(data[, sum_vars], data[, by_vars], sum) if (! is.null(data$lode)) { data <- merge(data, agg_lode) } if (length(only_vars) > 0) { data <- merge(data, agg_only) } # remove empty lodes (including labels) data <- subset(data, y != 0) # define 'deposit' variable to rank strata vertically data <- deposit_data(data, decreasing, reverse, absolute) # calculate variables for `after_stat()` x_sums <- tapply(abs(data$count), data$x, sum, na.rm = TRUE) data$prop <- data$count / x_sums[match(as.character(data$x), names(x_sums))] # sort data in preparation for `y` sums data <- data[with(data, order(deposit)), , drop = FALSE] # calculate `y` sums data$ycum <- NA for (xx in unique(data$x)) { for (yn in c(FALSE, TRUE)) { ww <- which(data$x == xx & data$yneg == yn) data$ycum[ww] <- cumulate(data$y[ww]) } } # calculate y bounds data$ymin <- data$ycum - abs(data$y) / 2 data$ymax <- data$ycum + abs(data$y) / 2 data$y <- data$ycum data$yneg <- NULL data$ycum <- NULL # impose height restrictions if (! is.null(min.height)) { deprecate_parameter("min.height", "min.y") min.y <- min.height } if (! is.null(max.height)) { deprecate_parameter("max.height", "max.y") max.y <- max.height } if (! is.null(min.y)) data <- subset(data, ymax - ymin >= min.y) if (! is.null(max.y)) data <- subset(data, ymax - ymin <= max.y) data } ) # single unique value, or else NA only <- function(x) { uniq <- unique(x) if (length(uniq) == 1L) { uniq } else { switch( class(x), integer = NA_integer_, numeric = NA_real_, character = NA_character_, factor = factor(NA_character_, levels = levels(x)) ) } } ggalluvial/R/geom-utils.r0000644000176200001440000000326314025146066015062 0ustar liggesusers# convert rectangle to polygon # (lifted from [ggplot2::geom_rect()]) rect_to_poly <- function(xmin, xmax, ymin, ymax) { data.frame( y = c(ymax, ymax, ymin, ymin, ymax), x = c(xmin, xmax, xmax, xmin, xmin) ) } # alternative curve options # each is a function that takes [0,1] to [0,1] # degree-3 polynomial with degree-1 critical endpoints unit_cubic <- function(x) 3*x^2 - 2*x^3 # degree-5 polynomial with degree-2 critical endpoints unit_quintic <- function(x) 10*x^3 - 15*x^4 + 6*x^5 # sinusoidal function with crests at endpoints unit_sine <- function(x) { t <- (x - .5) * pi sin(t) / 2 + .5 } # inverse tangent function compressed from a specified symmetric domain unit_arctangent <- function(x, curve_range) { if (is.na(curve_range)) curve_range <- 2 + sqrt(3) t <- (x - .5) * 2 * curve_range atan(t) / 2 / atan(curve_range) + .5 } # sigmoid function compressed from a specified symmetric domain unit_sigmoid <- function(x, curve_range) { if (is.na(curve_range)) curve_range <- 6 t <- (x - .5) * 2 * curve_range (stats::plogis(t) - stats::plogis(-curve_range)) / diff(stats::plogis(c(-1, 1) * curve_range)) } # return the desired flow curve function make_curve_fun <- function(curve_type, curve_range) { curve_type <- match.arg( curve_type, c("linear", "cubic", "quintic", "sine", "arctangent", "sigmoid") ) switch( curve_type, # polynomial curves linear = identity, cubic = unit_cubic, quintic = unit_quintic, # sinusoidal curve sine = unit_sine, # asymptotic curves (compressed from a specifiable range) arctangent = function(x) unit_arctangent(x, curve_range), sigmoid = function(x) unit_sigmoid(x, curve_range) ) } ggalluvial/NEWS.md0000644000176200001440000004433614372455170013521 0ustar liggesusers# ggalluvial 0.12.5 This patch fixes a bug involivng the {dplyr} functions `first()` and `last()` that was shifted but not fixed in 0.12.4. Rather than being imported during build, they are accessed internally and thus imported during use. See issues #107 and #108 on GitHub for details. # ggalluvial 0.12.4 ## `linewidth` aesthetic (breaking change) An upcoming release of *ggplot2* controls stroke width using the new `linewidth` aesthetic rather than `size`. This release adapts to this change internally by updating row and column layers as recommended here: ## Curve constructors Various curve constructors for alluvia and flows are consolidated into `data_to_alluvium()` and `positions_to_flow()`, which are now exported to the user as well as used internally by `GeomAlluvium$draw_group` and `GeomFlow$draw_panel`, respectively. ## Error handling Rather than throw an error when `y` values are `NA`, the stat layers now follow **ggplot2** convention, using `remove_missing()` at the setup step with the `na.rm` parameter passed to each layer. ## Aesthetic defaults To address #78 and for clarity, the legacy default `colour = 0` of three `Geom*()`s is changed to `colour = "transparent"`. ## Skipping examples `\dontrun` markers have been replace by `\donttest`, per the advice here: . More have been added in order to reduce the time required to run. ## Vignette revisions The primary vignette now uses the `HairEyeColor` data set, rather than over-using `Titanic`, to illustrate the parallel sets plot. The Shiny vignette includes an embedded app using IFrame. ## Dependency upgrades The deprecated `.dots` argument of `dplyr::group_by()` has been replaced with `dplyr::across()`, preventing a warning. # ggalluvial 0.12.3 ## Shiny vignette A new vignette by Quentin D. Read shows how to build interactive Shiny apps with tooltips sensitive to the locations of graphical elements. This is especially important for the spline boundaries of flows and alluvia. ## Examples using `vaccinations` data Corrections have been made to erroneous legacy code, found in one example and two vignettes, to reorder the factor levels of the `"response"` field in the data set `vaccinations`. The documentation is updated accordingly. Also, an explanation of the (misleading) column names of this data set has been added to the main vignette. # ggalluvial 0.12.2 This patch addresses a bug introduced in v0.12.0 that had `is_lodes_form()` return an error when a data frame contains duplicate id-axis pairings, which may be appropriate for producing faceted plots. The new `site` parameter can be passed one or more grouping variables for this purpose, and internally it is passed `"PANEL"` to prevent this error from being thrown. # ggalluvial 0.12.1 This patch corrects a bug introduced in v0.12.0 that dropped missing values used internally by `StatFlow$compute_panel()` to keep track of flowless lodes. The problem was illustrated in issue #64. # ggalluvial 0.12.0 ## Data sets Both installed data sets, `vaccinations` and `majors`, are better documented. The `a` field of `vaccinations` (the within-survey fraction of respondents, which can be computed from the other fields) has been removed, and the `start_date` and `end_date` fields (`Date`s, obtained from the ALP website) have been added. ## Warning and error messages The following changes broke no examples or tests but could change behavior in rare cases: * `is_lodes_form()` now returns `FALSE` if any axis-alluvium pairs are duplicated, and throws the previous warning as a message. This should be more helpful than the previous behavior of suppressing the warning and leaving `tidyr::gather()` to throw an error referring to rows of the already-transformed internal data. * Default aesthetic specifications `stratum = NULL` and `alluvium = NULL` have been added to the stats. This prevents the "unknown aesthetics" warnings that print when these aesthetics are passed to layers rather than to the plot initialization. ## Ordering of lodes/alluvia ### Behavior of `lode.ordering` For consistency with the behavior of `aes.bind`, `stat_alluvium()` now invokes `lode.ordering` together with `lode.guidance`: If the vectors of `lode.ordering` include duplicates, i.e. they do not completely determine an order, then the remaining deposits are used to refine the order. Previously, `lode.ordering` was assumed to consist of permutation vectors, so the two parameters were mutually exclusive. Additionally, for consistency with other influences on the lode order, the vectors of `lode.ordering` are reversed if `reverse = TRUE` (the default). **This will change some plots but will not produce new errors.** ### Controlling lode order before guidance and aesthetics The `lode.ordering` parameter of `stat_alluvium()` has been deprecated. Instead, the new `order` aesthetic gives priority to its argument over the differentiation aesthetics in arranging the lodes within each stratum, without producing graphical artifacts. This aesthetic can also be used in `stat_flow()`. ### Order of alluvia in negative strata Alluvia within "deposits" are now consistently ordered in positive and negative strata, rather than according to `absolute`. This avoids the "twisting" of flows between strata of different signs. Whereas the orderings of the deposits matter to the stacked-histogram reading of the plot, the orderings of the alluvia should simply maximize its elegance and readability. **This will change some plots but will not produce new errors.** ## Computed variables The alluvial stats now compute four variables for use with `after_stat()`: numeric variables `n`, `count`, and `prop`; and character variables `lode` (when the `alluvium` aesthetic is specified) and `flow` (when using the flow stat). The numerical variables can be weighted using the `weight` aesthetic, which is dropped during computation (so that it does not confuse the geoms), while `lode` is distilled according to a new `distill` parameter. This use of `weight` may cause confusion with its use by the `is_*_form()` functions until they are upgraded in the next version. These new variables complement the already-computed but heretofore undocumented variables `stratum` and `deposit`. `stratum` obviates the need for the `infer.label` parameter, which is deprecated. Its alias, `label.strata`, is now defunct. (The variable `alluvium` is often computed, but it is manipulated to be used by the geom layers and should not be passed to an aesthetic.) `deposit` takes contiguous integer values forward along the axes and upward along the (signed) strata at each axis. ## Flow upgrades and extensions The `knot.pos` parameter of `geom_alluvium()` and `geom_flow()` is now interpreted as a proportion of the total length of each flow, i.e. of the gap between adjacent strata (_not_ axes). This means that values will vary with axis positions and stratum widths. Setting the new `knot.prop` parameter to `FALSE` prevents this by interpreting `knot.pos` as a constant value in the `x` direction. These flows are rendered using `grid::xsplineGrob()` with four control points each: the endpoints and the two knots. To complement them, several other curves are now available: linear (equivalent to `knot.pos = 0`), cubic, quintic, sinusoidal, arctangent, and sigmoid, summoned by the new `curve_type` parameter (which defaults to the x-spline). (The asymptotic functions, arctangent and sigmoid, are compressed according to the new `curve_range` parameter.) The new curves are rendered piecewise linearly, with resolution controlled by the new `segments` parameter (similar to `ggplot2::stat_ellipse()`). ## Options The stratum and lode ordering parameters now default to `NULL`, in which case they are reassigned to global options internally. This simplifies their documentation. The new curve parameters `curve_type`, `curve_range`, and `segments` can also be set as options and are documented in the same way. # ggalluvial 0.11.3 ## Dependencies In response to **ggplot2** v3.2.0, which removes the **plyr** dependency, the dependency has been removed from **ggalluvial** as well. # ggalluvial 0.11.2 The function `self_adjoin()` is debugged for use with a continuous-valued `x` variable. An example, taking `x` to be the date of each vaccination survey in `vaccinations`, is documented with `stat_stratum()`. # ggalluvial 0.11.1 This patch fixes a bug with including negative observations in alluvia-form data due to outdated code that prohibited negative `y` values. This was discovered while drafting two examples of this usage, which are included in the documentation. # ggalluvial 0.11.0 ## Parameter renamings, deprecations, and additions - The `min.height` and `max.height` parameters of `stat_stratum()` are deprecated in favor of `min.y` and `max.y` (which better adhere to **ggplot2** conventions) and extended to the other `stat_*()` layers. - The `label.strata` parameter of `stat_stratum()` is deprecated in favor of `infer.label`, which is extended to the other `stat_*()` layers and sets `label` to `alluvium` in those cases rather than to `stratum`. - The `aggregate.y` parameter of `stat_alluvium()` is deprecated in favor of `cement.alluvia`, and the underlying procedure is debugged. - The `aes.bind` parameter of `stat_flow()` and `stat_alluvium()` now prefers character string options to logical values, described in the lode ordering vignette: `"none"`, `"flows"`, and `"alluvia"`. The default `"none"` produces different behavior than the previous default `FALSE`, in that under this setting the aesthetic variables are _not at all_ prioritized. - The previously defunct stat parameters `weight` and `aggregate.wts` are discontinued. ## Negative observations Negative values can now be meaningfully passed to `y`, producing behavior that mimics that of `geom_bar()`. The new logical parameter `absolute` controls whether negative strata, and lodes within them, are ordered vertically in the same way as positive strata and lodes (`FALSE`) or in the opposite way (`TRUE`). Additionally, the `negate.strata` parameter can be used to negate the observations associated with specific strata, in order to situate them below rather than above the `x` axis. ## New lode guidance function The new lode guidance function `lode_zagzig()` mimics the behavior of `lode_zigzag()` except in initially "zagging" toward the farther end rather than "zigging" toward the closer end. ## Stat layer consistency `stat_*()` internals have been simplified and standardized, in particular the manner in which lodes are ordered within strata. ## Layer tests Tests have been added for the statistical transformations. Visual regression tests using **vdiffr** have been added for the geoms. # ggalluvial 0.10.0 ## Lode guidance and ordering The lode guidance functions have been renamed as follows and their original names retained as aliases: | original | renamed | |-----------|-----------| | rightward | forward | | leftward | backward | | rightleft | frontback | | leftright | backfront | Additionally, `lode.ordering` now accepts a single integer vector of length the number of cases (alluvia), and will use the vector to sort the lodes within strata at each axis. Finally, a new vignette showcases this and related functionality using a small example. ## Defunct parameters The following parameters, deprecated in previous versions, are now defunct (with informative messages): - `weight` in the `stat_*()`s (replaced with `y`) - `aggregate.wts` in `stat_alluvium()` (replaced with `aggregate.y`) - `logical` in the `is_*_form()`s ## Default geom layer parameters The `width` and `knot.pos` parameters sometimes required by `Geom*$setup_data()` are now set to the same defaults as in the `geom_*()`s when called from a stat. Previously-implemented warnings have been removed. ## Custom lode guidance functions The `lode.guidance` argument of `stat_alluvial()` now accepts functions as input, making the use of custom functions easier as demonstrated in an example. # ggalluvial 0.9.2 ## Height limits on strata Parameters `min.height` and `max.height` are introduced to `stat_stratum()` to allow users to omit strata outside a given height range. This is probably most relevant for stratum labeling, as illustrated in the updated vignette. # ggalluvial 0.9.1 ## Suggest **sessioninfo** for `session_info()` Because the only functional (e.g. out `README.md`) occurrence of **devtools** is to call `session_info()` at the ends of the vignettes, this suggestion and usage are switched to **sessioninfo**. ## markdown formatting Documentation is slightly reformatted due to switching **roxygen** syntax to markdown. ## z-ordering patch The internal z-ordering function `z_order_aes` failed to recognize contiguous segments of alluvia, thereby assigning later segments missing values of `'group'` and preventing them from being rendered. This has been corrected. # ggalluvial 0.9.0 ## `geom_alluvium()` patch An occurrence of `weight` in `geom_alluvium()` was not updated for v0.8.0 and caused `geom_alluvium()` to throw an error in some cases. This has been corrected. ## `geom_flow()` patch An earlier solution to the z-ordering problem sufficed for matched layers (`*_alluvium()` and `*_flow()`) but failed for the combination of `stat_alluvium()` with `geom_flow()`. This is been corrected in the code for `GeomFlow$draw_panel()`, though a more elegant and general solution is preferred. ## Deprecated parameters removed The deprecated parameters `axis_width` (all geom layers) and `ribbon_bend` (`geom_alluvium()` and `geom_flow()`) are removed and an explanatory note added to the layers' documentation. ## Vignette on labeling small strata A vignette illustrating two methods for labeling small strata, using other **ggplot2** extensions, is included. ## `self_adjoin()` export The internal function `self_adjoin()`, invoked by `geom_flow()`, is revised, exported, documented, and exemplified. # ggalluvial 0.8.0 ## Stat layer functionality - The `weight` aesthetic for the three `stat_*()` functions is replaced by the `y` aesthetic, so that `scale_y_continuous()` will correctly transform the vertical scales of the layers. An example is provided in the documentation for `stat_alluvium()`. _The `y` aesthetic must be present in order for scales to be correctly transformed._ The `weight` parameter is still available but deprecated. - For consistency with the switch from `weight` to `y`, the `aggregate.wts` parameter to `stat_alluvium()` is replaced with `aggregate.y`; `aggregate.wts` is deprecated. ## Alluvial data functionality - Tests for alluvial format are silenced inside the `stat_*()` functions. # ggalluvial 0.7.0 ## Alluvial data functionality These changes make the functions that test for and convert between alluvial formats behave more like popular functions in the **tidyverse**. Some of the changes introduce backward incompatibilities, but most result in deprecation warnings. - The functions `is_alluvial_*()` and `to_*()` are renamed to `is_*_form()` and `to_*_form()` for consistency. Their old names are deprecated. - `is_alluvial()` is deprecated and will be removed in a future version. - The parameter `logical` is deprecated. In a future version, the functions `is_*_form()` will only return logical values. - The setting `silent = TRUE` now silences all messages. - The functions `is_*_form()` now return `FALSE` if any weights are negative, with a message to this effect. - These functions now accept unquoted variable names for the `key`, `value`, `id`, `weight`, and `diffuse` parameters, using up-to-date **rlang** and **tidyselect** functionality. - The `axes` parameter in `is_alluvia_form()` and `to_lodes_form()` now accepts `dplyr::vars()` objects, as in `dplyr::select_at()`. Alternatively, variables can be fed to these functions as in `dplyr::select()`, to be collected by `rlang::quos(...)` and used as axis variables. If `axes` is not `NULL`, then such additional arguments are ignored. - The functions `to_*_form()` now merge their internal reshapen data frames with the distilled or diffused variables in a consistent order, placing the distilled or diffused variables to the left. # ggalluvial 0.6.0 ## CRAN checks for v0.5.0 - The package now `Depends` on R `v3.3.0` (patch number zero) instead of `v3.3.1`. I've been unable to install this version locally, so there is a slight chance of incompatibility that i'll be watchful for going forward. - The **grid** and **alluvial** packages are now `Suggests` rather than `Imports`. ## Alluvial data functionality - Source files and documentation for `is_alluvial_*()` and `to_*()` functions are combined; see `help("alluvial-data")`. - `is_alluvial_alluvia` now prints a message rather than a warning when some combinations of strata are not linked by any alluvia. - `to_lodes()` now has a `diffuse` parameter to join any original variables to the reformatted data by the `id` variable (alluvium). This makes it possible to assign original variables to aesthetics after reformatting, as illustrated in a new example. - `to_alluvia()` now has a `distill` parameter to control the inclusion of any original variables that vary within values of `id` into the reformatted data, based on a distilling function that returns a single value from a vector. - `to_lodes()` now has a logical `discern` parameter that uses `make.unique()` to make stratum values that appear at different axes distinct. The `stat_*()` functions can pass the same parameter internally and print a warning if the data is already in lodes form. ## Layer internals - `GeomFlow$draw_panel()` now begins by restricting to `complete.cases()`, corresponding to flows with both starting and terminating axes. (This is not done in `StatFlow$compute_panel()`, which would have the effect of excluding missing aesthetic values from legends.) - `GeomAlluvium$setup_data()` now throws a warning if some color or differentiation aesthetics vary within alluvia. - A bug in the processing of a custom `lode.ordering` argument by `StatAlluvium$compute_panel()` has been fixed. # ggalluvial 0.5.0 ## Backward incompatibilities The `ggalluvial()` shortcut function, which included a formula interface, deprecated in version 0.4.0, is removed. # ggalluvial < 0.5.0 I only started maintaining `NEWS.md` with version 0.5.0. ggalluvial/MD50000644000176200001440000002555414375362512012734 0ustar liggesusersddf43fd0e8a14b0be601c399bc1b604b *DESCRIPTION 947c2ff6d4ef7c772a7586d61c33356b *NAMESPACE f4476ad52fb3d68fd6e47dd9375a884e *NEWS.md 30239fb35f4261f9114fa04f747c2b75 *R/alluvial-data.r 09aa353f212a485fffb576bf09e1ecb0 *R/data.r 24daa41e0bdd5707c1db36376153527a *R/devel.r 1d32b078b961b79f0d490c36a336bb5e *R/geom-alluvium.r 977f5fd264f793a1c51e5129dbe70dee *R/geom-flow.r 0a60428818cb1cfc61c3f1db794401ee *R/geom-lode.r a4e8b9abbbbd94e21805d138b0bebc7a *R/geom-stratum.r 381ec3f04c84b1356150879f98e27945 *R/geom-utils.r 403e922be3cc939f512c75ca55d8453d *R/ggalluvial-package.r 7d53688cdfb70ea93e4e951348f65837 *R/ggproto.r 94433385ca501998e4d3720d3a3b8e6c *R/lode-guidance-functions.r 3cd997dcccb780025a8274ee3f371346 *R/self-adjoin.r 6855e92a5d30dc11632698c0daf3eb7f *R/stat-alluvium.r 57a8c22f410d626c753881410e5b331b *R/stat-flow.r 92e07812291b85e8f9982be6515ceea8 *R/stat-stratum.r 55393a79b952a8be27f121e30f61d051 *R/stat-utils.r c41b7a5ef3d87b0334851e3a6aef2ace *R/utils.r 443ff5e55e6a77cb9d9d5a38387ef863 *README.md 0c6ad5b3446721162c89589e8077ab1c *build/partial.rdb 49c5ea44e919a40baba2c5319d9a5f9c *build/vignette.rds 96bce82e0f24d1ff28ed6c6b5205ad52 *data/majors.rda 5223231efa77767c267893a6105952c8 *data/vaccinations.rda b397890005f835604a3d9bc10f0bab73 *inst/CITATION 49a4d9088fdfcdfaf17493d4c8106e70 *inst/doc/ggalluvial.R c74ddb6cd139c3db8c3b9ea6d6f297c8 *inst/doc/ggalluvial.html 2a043df84b067e89f67c1f4db5352377 *inst/doc/ggalluvial.rmd ca77b0132eeacfb09a95e62de751c7fb *inst/doc/labels.R 7365f8d420948b5b5da295ab1016efe9 *inst/doc/labels.html 64137b3b858d1d240456dc435f40b6a8 *inst/doc/labels.rmd 86bc5c624c58cb785e4cd24f4f86fdcb *inst/doc/order-rectangles.R cfc8cab4810ef0219da3f3aac977bedc *inst/doc/order-rectangles.html d9376fc182b778ae52fd8423a80ebd54 *inst/doc/order-rectangles.rmd b0e7e07a4e50923a08d4a449411cccf4 *inst/doc/shiny.R c10b9409498bac0e674b1dcaa3d3549c *inst/doc/shiny.Rmd df0a9a647b55d018a4ccc9dffdd7c130 *inst/doc/shiny.html f0396a001c5dbff3e569c43e69996dac *inst/examples/ex-alluvial-data.r 6e690519a888c627d605d95d374b5e4b *inst/examples/ex-geom-alluvium.r d0bed29ee9893909490a9055eff90a39 *inst/examples/ex-geom-flow.r 06afb1bd496c895cd59d3a13de627bb1 *inst/examples/ex-geom-lode.r ca574ad27ff9e108d2e0b27a4228fbda *inst/examples/ex-geom-stratum.r ee0c1aeb45783b02702d73ba0eab71a8 *inst/examples/ex-self-adjoin.r b52699325b149e6d3e61df9c2845f8cf *inst/examples/ex-shiny-long-data/app.R b206e3baa0b99245bc0a420a3d92cf24 *inst/examples/ex-shiny-wide-data/app.R fc83ce98dee106452d2825d4e53ba871 *inst/examples/ex-stat-alluvium.r 6d37af8af13de17a748f804e04ec2798 *inst/examples/ex-stat-flow.r 4d355ce9ca7dfeede6d9c11ec1b58384 *inst/examples/ex-stat-stratum.r 6a68b662b2fa0df6fc56c4b421ba3d42 *man/alluvial-data.Rd b3f0b0b2dfeece07d4d1de26fffecfe3 *man/figures/README-unnamed-chunk-6-1.png 7e12643eac9dddaf5601ce8cf1b85b3a *man/figures/README-unnamed-chunk-7-1.png 2e05114460ceef6192d9c157fd9b8ca4 *man/geom_alluvium.Rd 56d7c1a239c3da82265a77e097af06bf *man/geom_flow.Rd b5126b7b534ab4fefa9392413144a36b *man/geom_lode.Rd 7278178c05a900beac050d0a60549912 *man/geom_stratum.Rd 77310f20634ab54c42172859d5b23065 *man/ggalluvial-deprecated.Rd db003803ce31ab013cfa1b023c608e3a *man/ggalluvial-ggproto.Rd 7ead7dc12053d9afabed15b5d3ceffa1 *man/ggalluvial-package.Rd c5617b37eb2966c87406083b2412772b *man/lode-guidance-functions.Rd 642665787614a79aba58513bd73fa5be *man/majors.Rd 8fcddc4c1f89c6b2146254925448063e *man/self-adjoin.Rd 16dca107deeccda25644c54f50786329 *man/stat_alluvium.Rd 7576c6200ea232ccc4fa40e60b10d608 *man/stat_flow.Rd d9086abe6147c8439b2792d41273a166 *man/stat_stratum.Rd ae6df5b9750c3beeeb96617bdd42c136 *man/vaccinations.Rd 37455b724fc4126f1b8305cc5c05f444 *tests/figs/deps.txt 80a8836753d1d3974c51fa0bf8e4b643 *tests/figs/geom-alluvium/geom-alluvium-arctangent-curve.svg 7f178f59183893b0c74d4c12d6dda194 *tests/figs/geom-alluvium/geom-alluvium-basic.svg 791d677b21d6f9e87694e085c69a935f *tests/figs/geom-alluvium/geom-alluvium-bump-plot.svg c598e7783c69b2d0e1b52eb88396058a *tests/figs/geom-alluvium/geom-alluvium-cubic-curve.svg ba16e338ba8430415afd85c649f9a148 *tests/figs/geom-alluvium/geom-alluvium-facets.svg 269f15694a3c74a2975d5b536e9d4ea0 *tests/figs/geom-alluvium/geom-alluvium-line-plot.svg 8a5af214a9c3811c5224ebd4e9677ba2 *tests/figs/geom-alluvium/geom-alluvium-linear-curve.svg 59322eeecd3c0fa6acd1019d905db3dc *tests/figs/geom-alluvium/geom-alluvium-quintic-curve.svg 16d4545399ef44c1243c5ad0fd36fc7d *tests/figs/geom-alluvium/geom-alluvium-sigmoid-curve.svg c41a1587657d0be858436146ac806029 *tests/figs/geom-alluvium/geom-alluvium-sine-curve.svg d89637db1cc00533472c3bbf9251f831 *tests/figs/geom-alluvium/geom-alluvium-unscaled-knot-positions.svg 408eb295b4e40fd2523ca26c5050c9e7 *tests/figs/geom-flow/geom-flow-aesthetic.svg 9b05e92d0e89f7a8c8c22e9be21bbbaf *tests/figs/geom-flow/geom-flow-arctangent-curve.svg 9104176abeba96d128d03728c4e24c53 *tests/figs/geom-flow/geom-flow-backward-orientation.svg f339c9a794544a0150319b7f7546b0d1 *tests/figs/geom-flow/geom-flow-basic.svg d159996aacb6566b1c40ac37ca98e06d *tests/figs/geom-flow/geom-flow-cubic-curve.svg 8bb37a5d9ad931ae14b4d39520e2da41 *tests/figs/geom-flow/geom-flow-facets.svg 5e207c9545d6962800f7c29b05111d8b *tests/figs/geom-flow/geom-flow-forward-orientation.svg e58819cc82fb37ee3cafa42fc1aa33c6 *tests/figs/geom-flow/geom-flow-linear-curve.svg 78fbcdabefeea8943ed4076b8dc61514 *tests/figs/geom-flow/geom-flow-quintic-curve.svg c0a7cad8279c584c31415e6a1b949cc1 *tests/figs/geom-flow/geom-flow-sigmoid-curve.svg 4578b53eee1f8ab2303e44a99395b19d *tests/figs/geom-flow/geom-flow-sine-curve.svg 14aeb212895d30e1778b0928bb2d9ca6 *tests/figs/geom-flow/geom-flow-unscaled-knot-positions.svg 2c336196ba2f5b28c34cbed7ebb500e3 *tests/figs/geom-lode/geom-lode-lodes-and-alluvia.svg 00f5f305c794f03d08f13f94e16635dd *tests/figs/geom-lode/geom-lode-lodes-as-strata.svg 48f75b82c0958493aaa8eb50b9f4a215 *tests/figs/geom-lode/geom-lode-one-axis.svg 822a21cb71e7d2cc1e2c93700ee07b86 *tests/figs/geom-stratum/geom-stratum-axis-labels.svg 6424087e3ca003aefd4f536b4217e0f6 *tests/figs/geom-stratum/geom-stratum-basic.svg 5c051c27d36886ad07f5a2da9b65874f *tests/figs/geom-stratum/geom-stratum-extended-width.svg e793a9ec3c67e177c59b0c9d43a27a6e *tests/figs/geom-stratum/geom-stratum-facets-and-axis-labels.svg a15f703b58f52550aabedf54a81a807d *tests/figs/geom-stratum/geom-stratum-facets.svg c1662f77e2600e5343bda99a39bcfcf8 *tests/figs/geom-stratum/geom-stratum-inferred-text-labels.svg b742a5fd073aa7f6e60ec5c35b2aa9c7 *tests/testthat.R 9ce1344f87aec04f2838ce134d494f7d *tests/testthat/_snaps/geom-alluvium/geom-alluvium-arctangent-curve-with-custom-range.svg ceb43f05951d975d5434ea21e6ef5995 *tests/testthat/_snaps/geom-alluvium/geom-alluvium-arctangent-curve.svg 4fd06073b1a120110f9814b52ff79f7d *tests/testthat/_snaps/geom-alluvium/geom-alluvium-basic.svg a0b4457c912e089711621479f47c977f *tests/testthat/_snaps/geom-alluvium/geom-alluvium-bump-plot.svg 7bfc515e3ec94a5853fb6862edee9ff0 *tests/testthat/_snaps/geom-alluvium/geom-alluvium-cubic-curve.svg de6d873d76ac4e39b417aaf0e4f4f5dd *tests/testthat/_snaps/geom-alluvium/geom-alluvium-facets.svg bb0c0663f6783b02998438e10db120ff *tests/testthat/_snaps/geom-alluvium/geom-alluvium-line-plot.svg 4954e9753c9d1158bc89ab501d8cbe6c *tests/testthat/_snaps/geom-alluvium/geom-alluvium-linear-curve.svg 64431c713d32eb5bcf73994d38277033 *tests/testthat/_snaps/geom-alluvium/geom-alluvium-quintic-curve.svg f3816bce4163fcb0e7c94656b5e917da *tests/testthat/_snaps/geom-alluvium/geom-alluvium-sigmoid-curve-with-custom-range.svg 1792ebd46f1c744111bd0017708fa7f2 *tests/testthat/_snaps/geom-alluvium/geom-alluvium-sigmoid-curve.svg 454369c98d40c29c6c4f77ef4458f3f9 *tests/testthat/_snaps/geom-alluvium/geom-alluvium-sine-curve.svg e095c6c917d7c1b74dc37bf8529110aa *tests/testthat/_snaps/geom-alluvium/geom-alluvium-unscaled-knot-positions.svg 96bed621e6f0ab9c2af9ee044f37d4fe *tests/testthat/_snaps/geom-flow/geom-flow-aesthetic.svg ac28ecc255d6e2ea5edd72c1b5d445e1 *tests/testthat/_snaps/geom-flow/geom-flow-arctangent-curve-with-custom-range.svg 0630d50f21e46f3ed53b4a3104dfa04c *tests/testthat/_snaps/geom-flow/geom-flow-arctangent-curve.svg 0e7f36d44d4a952932c8be8d5c83bd06 *tests/testthat/_snaps/geom-flow/geom-flow-backward-orientation.svg 14a003197ca8443d95150fefbc7d0fe1 *tests/testthat/_snaps/geom-flow/geom-flow-basic.svg c6758374b42413d325277a20e1a2289c *tests/testthat/_snaps/geom-flow/geom-flow-cubic-curve.svg d01fd7adbbae08ed41c92c8ba02ff13a *tests/testthat/_snaps/geom-flow/geom-flow-facets.svg 95bd0c802eed95b06972e29c3cd7fb9a *tests/testthat/_snaps/geom-flow/geom-flow-forward-orientation.svg 3f3768dc864487ab0ffb6f83f4c901a1 *tests/testthat/_snaps/geom-flow/geom-flow-linear-curve.svg 76d49f0107117b307bdbb370b224e718 *tests/testthat/_snaps/geom-flow/geom-flow-quintic-curve.svg 113c67b0fec3804b76f86de249a9b669 *tests/testthat/_snaps/geom-flow/geom-flow-sigmoid-curve-with-custom-range.svg 1351c57099b5e4963e078d49dee7ea6f *tests/testthat/_snaps/geom-flow/geom-flow-sigmoid-curve.svg f46bcda1539e00ae21d305c544b1cd4b *tests/testthat/_snaps/geom-flow/geom-flow-sine-curve.svg 12f11ac367833246b31c80d99d4becf4 *tests/testthat/_snaps/geom-flow/geom-flow-unscaled-knot-positions.svg 75e8502f3dc422ef1591761abab71e82 *tests/testthat/_snaps/geom-lode/geom-lode-lodes-and-alluvia.svg 7d91c7fd0bf9a0757d7d7209aade3db4 *tests/testthat/_snaps/geom-lode/geom-lode-lodes-as-strata.svg e89d1661ed0c4f411424442dd6a25c96 *tests/testthat/_snaps/geom-lode/geom-lode-one-axis.svg 53da1b555634c02c5daac4efff6b6d77 *tests/testthat/_snaps/geom-stratum/geom-stratum-axis-labels.svg a836a0fc098705cfa104cd37c0a45b59 *tests/testthat/_snaps/geom-stratum/geom-stratum-basic.svg d68f0c876236427d8ca15d186152f984 *tests/testthat/_snaps/geom-stratum/geom-stratum-extended-width.svg 4f8e09f5cf713d58c712ffea49b18a10 *tests/testthat/_snaps/geom-stratum/geom-stratum-facets-and-axis-labels.svg 8f21c88a01e8032a6e8d0d03948e3f50 *tests/testthat/_snaps/geom-stratum/geom-stratum-facets.svg eb07a40e45b2fd8a2d8444cf87740370 *tests/testthat/_snaps/geom-stratum/geom-stratum-inferred-text-labels.svg 3419b97b630d963412c4c0c7285a82ef *tests/testthat/test-alluvial-data.r 3b3e440cafea7ff2bcd07bd7856ad4ae *tests/testthat/test-geom-alluvium.r 75a06fea0a465f290438dff9ed76687c *tests/testthat/test-geom-flow.r b69ce16ae2c7477662a35168be81936a *tests/testthat/test-geom-lode.r 964039b9059b5a3b5a0c6ee437db19ab *tests/testthat/test-geom-stratum.r e1754dac09c7e993e5a778c315f5d983 *tests/testthat/test-stat-alluvium.r 4d6ff29c0fa74a542cf1cfaca1ca8fe4 *tests/testthat/test-stat-flow.r 3361600be375ceb348809aaa415d0626 *tests/testthat/test-stat-stratum.r 2a043df84b067e89f67c1f4db5352377 *vignettes/ggalluvial.rmd 86dc3a5abc2ccdc272bced12595f3c2d *vignettes/img/hover_alluvium.png cfb69383eaae0fbf596f1734e77c80c9 *vignettes/img/hover_empty_area.png b73588e1a048d76ab751ab89ad9060f7 *vignettes/img/hover_stratum.png 64137b3b858d1d240456dc435f40b6a8 *vignettes/labels.rmd d9376fc182b778ae52fd8423a80ebd54 *vignettes/order-rectangles.rmd c10b9409498bac0e674b1dcaa3d3549c *vignettes/shiny.Rmd ggalluvial/inst/0000755000176200001440000000000014372455323013366 5ustar liggesusersggalluvial/inst/examples/0000755000176200001440000000000014367761414015211 5ustar liggesusersggalluvial/inst/examples/ex-stat-flow.r0000644000176200001440000000465414367761414017737 0ustar liggesusers# illustrate positioning ggplot(as.data.frame(Titanic), aes(y = Freq, axis1 = Class, axis2 = Sex, axis3 = Age, color = Survived)) + stat_stratum(geom = "errorbar") + geom_line(stat = "flow") + stat_flow(geom = "pointrange") + geom_text(stat = "stratum", aes(label = after_stat(stratum))) + scale_x_discrete(limits = c("Class", "Sex", "Age")) # alluvium--flow comparison data(vaccinations) gg <- ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_stratum(alpha = .5) + geom_text(aes(label = response), stat = "stratum") # rightward alluvial aesthetics for vaccine survey data gg + geom_flow(stat = "alluvium", lode.guidance = "forward") # memoryless flows for vaccine survey data gg + geom_flow() # size filter examples gg <- ggplot(vaccinations, aes(y = freq, x = survey, stratum = response, alluvium = subject, fill = response, label = response)) + stat_stratum(alpha = .5) + geom_text(stat = "stratum") # omit small flows gg + geom_flow(min.y = 50) # omit large flows gg + geom_flow(max.y = 100) # negate missing entries ggplot(vaccinations, aes(y = freq, x = survey, stratum = response, alluvium = subject, fill = response, label = response, alpha = response != "Missing")) + stat_stratum(negate.strata = "Missing") + geom_flow(negate.strata = "Missing") + geom_text(stat = "stratum", alpha = 1, negate.strata = "Missing") + scale_alpha_discrete(range = c(.2, .6)) + guides(alpha = "none") \donttest{ # aesthetics that vary betwween and within strata data(vaccinations) vaccinations$subgroup <- LETTERS[1:2][rbinom( n = length(unique(vaccinations$subject)), size = 1, prob = .5 ) + 1][vaccinations$subject] ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response, label = response)) + geom_flow(aes(alpha = subgroup)) + scale_alpha_discrete(range = c(1/3, 2/3)) + geom_stratum(alpha = .5) + geom_text(stat = "stratum") # can even set aesthetics that vary both ways ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, label = response)) + geom_flow(aes(fill = interaction(response, subgroup)), aes.bind = "flows") + scale_alpha_discrete(range = c(1/3, 2/3)) + geom_stratum(alpha = .5) + geom_text(stat = "stratum") } ggalluvial/inst/examples/ex-geom-alluvium.r0000644000176200001440000000373014367761414020574 0ustar liggesusers# basic ggplot(as.data.frame(Titanic), aes(y = Freq, axis1 = Class, axis2 = Sex, axis3 = Age, fill = Survived)) + geom_alluvium() + scale_x_discrete(limits = c("Class", "Sex", "Age")) gg <- ggplot(alluvial::Refugees, aes(y = refugees, x = year, alluvium = country)) # time series bump chart (quintic flows) gg + geom_alluvium(aes(fill = country, colour = country), width = 1/4, alpha = 2/3, decreasing = FALSE, curve_type = "sigmoid") # time series line plot of refugees data, sorted by country gg + geom_alluvium(aes(fill = country, colour = country), decreasing = NA, width = 0, knot.pos = 0) \donttest{ # irregular spacing between axes of a continuous variable refugees_sub <- subset(alluvial::Refugees, year %in% c(2003, 2005, 2010, 2013)) gg <- ggplot(data = refugees_sub, aes(x = year, y = refugees, alluvium = country)) + theme_bw() + scale_fill_brewer(type = "qual", palette = "Set3") # proportional knot positioning (default) gg + geom_alluvium(aes(fill = country), alpha = .75, decreasing = FALSE, width = 1/2) + geom_stratum(aes(stratum = country), decreasing = FALSE, width = 1/2) # constant knot positioning gg + geom_alluvium(aes(fill = country), alpha = .75, decreasing = FALSE, width = 1/2, knot.pos = 1, knot.prop = FALSE) + geom_stratum(aes(stratum = country), decreasing = FALSE, width = 1/2) # coarsely-segmented curves gg + geom_alluvium(aes(fill = country), alpha = .75, decreasing = FALSE, width = 1/2, curve_type = "arctan", segments = 6) + geom_stratum(aes(stratum = country), decreasing = FALSE, width = 1/2) # custom-ranged curves gg + geom_alluvium(aes(fill = country), alpha = .75, decreasing = FALSE, width = 1/2, curve_type = "arctan", curve_range = 1) + geom_stratum(aes(stratum = country), decreasing = FALSE, width = 1/2) } ggalluvial/inst/examples/ex-geom-stratum.r0000644000176200001440000000116114025146066020420 0ustar liggesusers# full axis width ggplot(as.data.frame(Titanic), aes(y = Freq, axis1 = Class, axis2 = Sex, axis3 = Age, axis4 = Survived)) + geom_stratum(width = 1) + geom_text(stat = "stratum", aes(label = after_stat(stratum))) + scale_x_discrete(limits = c("Class", "Sex", "Age", "Survived")) # use of facets ggplot(as.data.frame(Titanic), aes(y = Freq, axis1 = Class, axis2 = Sex)) + geom_flow(aes(fill = Survived)) + geom_stratum() + geom_text(stat = "stratum", aes(label = after_stat(stratum))) + scale_x_discrete(limits = c("Class", "Sex")) + facet_wrap(~ Age, scales = "free_y") ggalluvial/inst/examples/ex-geom-flow.r0000644000176200001440000000443614367761414017711 0ustar liggesusers# use of strata and labels ggplot(as.data.frame(Titanic), aes(y = Freq, axis1 = Class, axis2 = Sex, axis3 = Age)) + geom_flow() + scale_x_discrete(limits = c("Class", "Sex", "Age")) + geom_stratum() + geom_text(stat = "stratum", aes(label = after_stat(stratum))) + ggtitle("Alluvial plot of Titanic passenger demographic data") # use of facets, with sigmoid flows ggplot(as.data.frame(Titanic), aes(y = Freq, axis1 = Class, axis2 = Sex)) + geom_flow(aes(fill = Age), width = .4, curve_type = "quintic") + geom_stratum(width = .4) + geom_text(stat = "stratum", aes(label = after_stat(stratum)), size = 3) + scale_x_discrete(limits = c("Class", "Sex")) + facet_wrap(~ Survived, scales = "fixed") # time series alluvia of WorldPhones data wph <- as.data.frame(as.table(WorldPhones)) names(wph) <- c("Year", "Region", "Telephones") ggplot(wph, aes(x = Year, alluvium = Region, y = Telephones)) + geom_flow(aes(fill = Region, colour = Region), width = 0) # treat 'Year' as a number rather than as a factor wph$Year <- as.integer(as.character(wph$Year)) ggplot(wph, aes(x = Year, alluvium = Region, y = Telephones)) + geom_flow(aes(fill = Region, colour = Region), width = 0) # hold the knot positions fixed ggplot(wph, aes(x = Year, alluvium = Region, y = Telephones)) + geom_flow(aes(fill = Region, colour = Region), width = 0, knot.prop = FALSE) \donttest{ # rightward flow aesthetics for vaccine survey data, with cubic flows data(vaccinations) vaccinations$response <- factor(vaccinations$response, rev(levels(vaccinations$response))) # annotate with proportional counts ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_lode() + geom_flow(curve_type = "cubic") + geom_stratum(alpha = 0) + geom_text(stat = "stratum", aes(label = round(after_stat(prop), 3))) # annotate fixed-width ribbons with counts ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, weight = freq, fill = response)) + geom_lode() + geom_flow(curve_type = "cubic") + geom_stratum(alpha = 0) + geom_text(stat = "flow", aes(label = after_stat(n), hjust = (after_stat(flow) == "to"))) } ggalluvial/inst/examples/ex-alluvial-data.r0000644000176200001440000000563714025146066020530 0ustar liggesusers# Titanic data in alluvia format titanic_alluvia <- as.data.frame(Titanic) head(titanic_alluvia) is_alluvia_form(titanic_alluvia, weight = "Freq") # Titanic data in lodes format titanic_lodes <- to_lodes_form(titanic_alluvia, key = "x", value = "stratum", id = "alluvium", axes = 1:4) head(titanic_lodes) is_lodes_form(titanic_lodes, key = "x", value = "stratum", id = "alluvium", weight = "Freq") # again in lodes format, this time diffusing the `Class` variable titanic_lodes2 <- to_lodes_form(titanic_alluvia, key = variable, value = value, id = cohort, 1:3, diffuse = Class) head(titanic_lodes2) is_lodes_form(titanic_lodes2, key = variable, value = value, id = cohort, weight = Freq) # use `site` to separate data before lode testing is_lodes_form(titanic_lodes2, key = variable, value = value, id = Class, weight = Freq) is_lodes_form(titanic_lodes2, key = variable, value = value, id = Class, weight = Freq, site = cohort) # curriculum data in lodes format data(majors) head(majors) is_lodes_form(majors, key = "semester", value = "curriculum", id = "student") # curriculum data in alluvia format majors_alluvia <- to_alluvia_form(majors, key = "semester", value = "curriculum", id = "student") head(majors_alluvia) is_alluvia_form(majors_alluvia, tidyselect::starts_with("CURR")) # distill variables that vary within `id` values set.seed(1) majors$hypo_grade <- LETTERS[sample(5, size = nrow(majors), replace = TRUE)] majors_alluvia2 <- to_alluvia_form(majors, key = "semester", value = "curriculum", id = "student", distill = "most") head(majors_alluvia2) # options to distinguish strata at different axes gg <- ggplot(majors_alluvia, aes(axis1 = CURR1, axis2 = CURR7, axis3 = CURR13)) gg + geom_alluvium(aes(fill = as.factor(student)), width = 2/5, discern = TRUE) + geom_stratum(width = 2/5, discern = TRUE) + geom_text(stat = "stratum", discern = TRUE, aes(label = after_stat(stratum))) gg + geom_alluvium(aes(fill = as.factor(student)), width = 2/5, discern = FALSE) + geom_stratum(width = 2/5, discern = FALSE) + geom_text(stat = "stratum", discern = FALSE, aes(label = after_stat(stratum))) # warning when inappropriate ggplot(majors[majors$semester %in% paste0("CURR", c(1, 7, 13)), ], aes(x = semester, stratum = curriculum, alluvium = student, label = curriculum)) + geom_alluvium(aes(fill = as.factor(student)), width = 2/5, discern = TRUE) + geom_stratum(width = 2/5, discern = TRUE) + geom_text(stat = "stratum", discern = TRUE) ggalluvial/inst/examples/ex-self-adjoin.r0000644000176200001440000000150714025146066020173 0ustar liggesusers# self-adjoin `majors` data data(majors) major_changes <- self_adjoin(majors, key = semester, by = "student", link = c("semester", "curriculum")) major_changes$change <- major_changes$curriculum.x == major_changes$curriculum.y head(major_changes) # self-adjoin `vaccinations` data data(vaccinations) vaccination_steps <- self_adjoin(vaccinations, key = survey, by = "subject", link = c("survey", "response"), keep.x = c("freq")) head(vaccination_steps) vaccination_steps <- self_adjoin(vaccinations, key = survey, by = "subject", link = c("survey", "response"), keep.x = c("freq"), keep.y = c("start_date", "end_date")) head(vaccination_steps) ggalluvial/inst/examples/ex-shiny-long-data/0000755000176200001440000000000014367761414020621 5ustar liggesusersggalluvial/inst/examples/ex-shiny-long-data/app.R0000644000176200001440000001347014367761414021531 0ustar liggesuserslibrary(ggalluvial) library(shiny) library(htmltools) library(sp) data(vaccinations) vaccinations <- transform(vaccinations, response = factor(response, rev(levels(response)))) # Offset, in pixels, for location of tooltip relative to mouse cursor, # in both x and y direction. offset <- 5 # Width of node boxes node_width <- 1/3 # Width of alluvia alluvium_width <- 1/3 # Draw plot and extract coordinates p <- ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response, label = response)) + scale_x_discrete(expand = c(.1, .1)) + scale_y_continuous(expand = c(0, 0)) + geom_flow(knot.pos = 1/4, width = alluvium_width) + geom_stratum(width = node_width) + geom_text(stat = "stratum", size = rel(2)) + theme_bw() + theme(legend.position = "none") + ggtitle("Vaccination responses on three surveys") + theme(plot.title = element_text(size = rel(1)), legend.position = 'bottom') # Build the plot. pbuilt <- ggplot_build(p) # Use built plot data to recalculate the locations of the flow polygons: # Add width parameter, and then convert built plot data to xsplines data_draw <- transform(pbuilt$data[[1]], width = alluvium_width) groups_to_draw <- split(data_draw, data_draw$group) group_xsplines <- lapply(groups_to_draw, data_to_alluvium) # Convert xspline coordinates to grid object. xspline_coords <- lapply( group_xsplines, function(coords) grid::xsplineGrob(x = coords$x, y = coords$y, shape = coords$shape, open = FALSE) ) # Use grid::xsplinePoints to draw the curve for each polygon xspline_points <- lapply(xspline_coords, grid::xsplinePoints) # Define the x and y axis limits in grid coordinates (old) and plot # coordinates (new) xrange_old <- range(unlist(lapply( xspline_points, function(pts) as.numeric(pts$x) ))) yrange_old <- range(unlist(lapply( xspline_points, function(pts) as.numeric(pts$y) ))) xrange_new <- c(1 - alluvium_width/2, max(pbuilt$data[[1]]$x) + alluvium_width/2) yrange_new <- c(0, sum(pbuilt$data[[2]]$count[pbuilt$data[[2]]$x == 1])) # Define function to convert grid graphics coordinates to data coordinates new_range_transform <- function(x_old, range_old, range_new) { (x_old - range_old[1])/(range_old[2] - range_old[1]) * (range_new[2] - range_new[1]) + range_new[1] } # Using the x and y limits, convert the grid coordinates into plot coordinates. polygon_coords <- lapply(xspline_points, function(pts) { x_trans <- new_range_transform(x_old = as.numeric(pts$x), range_old = xrange_old, range_new = xrange_new) y_trans <- new_range_transform(x_old = as.numeric(pts$y), range_old = yrange_old, range_new = yrange_new) list(x = x_trans, y = y_trans) }) # User interface ui <- fluidPage( fluidRow(tags$div( style = "position: relative;", plotOutput("alluvial_plot", height = "650px", hover = hoverOpts(id = "plot_hover") ), htmlOutput("tooltip"))) ) server <- function(input, output, session) { # Draw plot output$alluvial_plot <- renderPlot(p, res = 200) # Display tooltip output$tooltip <- renderText( if(!is.null(input$plot_hover)) { hover <- input$plot_hover x_coord <- round(hover$x) if(abs(hover$x - x_coord) < (node_width / 2)) { # Display node information if cursor is over a stratum box. # Determine stratum name from x and y coord, and the n. node_row <- pbuilt$data[[2]]$x == x_coord & hover$y > pbuilt$data[[2]]$ymin & hover$y < pbuilt$data[[2]]$ymax node_label <- pbuilt$data[[2]]$stratum[node_row] node_n <- pbuilt$data[[2]]$count[node_row] # Render tooltip renderTags( tags$div( node_label, tags$br(), "n =", node_n, style = paste0( "position: absolute; ", "top: ", hover$coords_css$y + offset, "px; ", "left: ", hover$coords_css$x + offset, "px; ", "background: gray; ", "padding: 3px; ", "color: white; " ) ) )$html } else { # Display flow information if cursor is over a flow polygon: what # alluvia does it pass through? # Calculate whether coordinates of hovering cursor are inside one of the # polygons. hover_within_flow <- sapply( polygon_coords, function(pol) point.in.polygon(point.x = hover$x, point.y = hover$y, pol.x = pol$x, pol.y = pol$y) ) if (any(hover_within_flow)) { # Find the alluvium that is plotted on top. (last) coord_id <- rev(which(hover_within_flow == 1))[1] # Find the strata labels and n corresponding to that alluvium in the data. flow_label <- paste(groups_to_draw[[coord_id]]$stratum, collapse = ' -> ') flow_n <- groups_to_draw[[coord_id]]$count[1] # Render tooltip renderTags( tags$div( flow_label, tags$br(), "n =", flow_n, style = paste0( "position: absolute; ", "top: ", hover$coords_css$y + offset, "px; ", "left: ", hover$coords_css$x + offset, "px; ", "background: gray; ", "padding: 3px; ", "color: white; " ) ) )$html } } } ) } shinyApp(ui = ui, server = server) ggalluvial/inst/examples/ex-shiny-wide-data/0000755000176200001440000000000014367761414020612 5ustar liggesusersggalluvial/inst/examples/ex-shiny-wide-data/app.R0000644000176200001440000001367014367761414021524 0ustar liggesuserslibrary(ggalluvial) library(shiny) library(htmltools) library(sp) data(UCBAdmissions) ucb_admissions <- as.data.frame(UCBAdmissions) # Offset, in pixels, for location of tooltip relative to mouse cursor, # in both x and y direction. offset <- 5 # Width of node boxes node_width <- 1/4 # Width of alluvia alluvium_width <- 1/3 # Draw plot. p <- ggplot(ucb_admissions, aes(y = Freq, axis1 = Gender, axis2 = Dept)) + geom_alluvium(aes(fill = Admit), knot.pos = 1/4, width = alluvium_width) + geom_stratum(width = node_width, reverse = TRUE, fill = 'black', color = 'grey') + geom_label(aes(label = after_stat(stratum)), stat = "stratum", reverse = TRUE, size = rel(2)) + theme_bw() + scale_fill_brewer(type = "qual", palette = "Set1") + scale_x_discrete(limits = c("Gender", "Dept"), expand = c(.05, .05)) + scale_y_continuous(expand = c(0, 0)) + ggtitle("UC Berkeley admissions and rejections", "by sex and department") + theme(plot.title = element_text(size = rel(1)), plot.subtitle = element_text(size = rel(1)), legend.position = 'bottom') # Build the plot. pbuilt <- ggplot_build(p) # Use built plot data to recalculate the locations of the flow polygons: # Add width parameter, and then convert built plot data to xsplines data_draw <- transform(pbuilt$data[[1]], width = alluvium_width) groups_to_draw <- split(data_draw, data_draw$group) group_xsplines <- lapply(groups_to_draw, data_to_alluvium) # Convert xspline coordinates to grid object. xspline_coords <- lapply( group_xsplines, function(coords) grid::xsplineGrob(x = coords$x, y = coords$y, shape = coords$shape, open = FALSE) ) # Use grid::xsplinePoints to draw the curve for each polygon xspline_points <- lapply(xspline_coords, grid::xsplinePoints) # Define the x and y axis limits in grid coordinates (old) and plot # coordinates (new) xrange_old <- range(unlist(lapply( xspline_points, function(pts) as.numeric(pts$x) ))) yrange_old <- range(unlist(lapply( xspline_points, function(pts) as.numeric(pts$y) ))) xrange_new <- c(1 - alluvium_width/2, max(pbuilt$data[[1]]$x) + alluvium_width/2) yrange_new <- c(0, sum(pbuilt$data[[2]]$count[pbuilt$data[[2]]$x == 1])) # Define function to convert grid graphics coordinates to data coordinates new_range_transform <- function(x_old, range_old, range_new) { (x_old - range_old[1])/(range_old[2] - range_old[1]) * (range_new[2] - range_new[1]) + range_new[1] } # Using the x and y limits, convert the grid coordinates into plot coordinates. polygon_coords <- lapply(xspline_points, function(pts) { x_trans <- new_range_transform(x_old = as.numeric(pts$x), range_old = xrange_old, range_new = xrange_new) y_trans <- new_range_transform(x_old = as.numeric(pts$y), range_old = yrange_old, range_new = yrange_new) list(x = x_trans, y = y_trans) }) # User interface ui <- fluidPage( fluidRow(tags$div( style = "position: relative;", plotOutput("alluvial_plot", height = "650px", hover = hoverOpts(id = "plot_hover") ), htmlOutput("tooltip"))) ) server <- function(input, output, session) { # Draw plot and extract coordinates output$alluvial_plot <- renderPlot(p, res = 200) output$tooltip <- renderText( if(!is.null(input$plot_hover)) { hover <- input$plot_hover x_coord <- round(hover$x) if(abs(hover$x - x_coord) < (node_width / 2)) { # Display node information if cursor is over a stratum box. # Determine stratum name from x and y coord, and the n. node_row <- pbuilt$data[[2]]$x == x_coord & hover$y > pbuilt$data[[2]]$ymin & hover$y < pbuilt$data[[2]]$ymax node_label <- pbuilt$data[[2]]$stratum[node_row] node_n <- pbuilt$data[[2]]$count[node_row] # Render tooltip renderTags( tags$div( node_label, tags$br(), "n =", node_n, style = paste0( "position: absolute; ", "top: ", hover$coords_css$y + offset, "px; ", "left: ", hover$coords_css$x + offset, "px; ", "background: gray; ", "padding: 3px; ", "color: white; " ) ) )$html } else { # Display flow information if cursor is over a flow polygon: what # alluvia does it pass through? # Calculate whether coordinates of hovering cursor are inside one of the # polygons. hover_within_flow <- sapply( polygon_coords, function(pol) point.in.polygon(point.x = hover$x, point.y = hover$y, pol.x = pol$x, pol.y = pol$y) ) if (any(hover_within_flow)) { # Find the alluvium that is plotted on top. (last) coord_id <- rev(which(hover_within_flow == 1))[1] # Find the strata labels and n corresponding to that alluvium in the data. flow_label <- paste(groups_to_draw[[coord_id]]$stratum, collapse = ' -> ') flow_n <- groups_to_draw[[coord_id]]$count[1] # Render tooltip renderTags( tags$div( flow_label, tags$br(), "n =", flow_n, style = paste0( "position: absolute; ", "top: ", hover$coords_css$y + offset, "px; ", "left: ", hover$coords_css$x + offset, "px; ", "background: gray; ", "padding: 3px; ", "color: white; " ) ) )$html } } } ) } shinyApp(ui = ui, server = server) ggalluvial/inst/examples/ex-geom-lode.r0000644000176200001440000000100314025146066017637 0ustar liggesusers# one axis ggplot(as.data.frame(Titanic), aes(y = Freq, axis = Class)) + geom_lode(aes(fill = Class, alpha = Survived)) + scale_x_discrete(limits = c("Class")) + scale_alpha_manual(values = c(.25, .75)) gg <- ggplot(as.data.frame(Titanic), aes(y = Freq, axis1 = Class, axis2 = Sex, axis3 = Age, fill = Survived)) # alluvia and lodes gg + geom_alluvium() + geom_lode() # lodes as strata gg + geom_alluvium() + geom_stratum(stat = "alluvium") ggalluvial/inst/examples/ex-stat-alluvium.r0000644000176200001440000001130714367761414020617 0ustar liggesusers# illustrate positioning ggplot(as.data.frame(Titanic), aes(y = Freq, axis1 = Class, axis2 = Sex, axis3 = Age, color = Survived)) + stat_stratum(geom = "errorbar") + geom_line(stat = "alluvium") + stat_alluvium(geom = "pointrange") + geom_text(stat = "stratum", aes(label = after_stat(stratum))) + scale_x_discrete(limits = c("Class", "Sex", "Age")) # lode ordering examples gg <- ggplot(as.data.frame(Titanic), aes(y = Freq, axis1 = Class, axis2 = Sex, axis3 = Age)) + geom_stratum() + geom_text(stat = "stratum", aes(label = after_stat(stratum))) + scale_x_discrete(limits = c("Class", "Sex", "Age")) # use of lode controls gg + geom_flow(aes(fill = Survived, alpha = Sex), stat = "alluvium", lode.guidance = "forward") # prioritize aesthetic binding gg + geom_flow(aes(fill = Survived, alpha = Sex), stat = "alluvium", aes.bind = "alluvia", lode.guidance = "forward") # use of custom lode order gg + geom_flow(aes(fill = Survived, alpha = Sex, order = sample(x = 32)), stat = "alluvium") # use of custom luide guidance function lode_custom <- function(n, i) { stopifnot(n == 3) switch( i, `1` = 1:3, `2` = c(2, 3, 1), `3` = 3:1 ) } gg + geom_flow(aes(fill = Survived, alpha = Sex), stat = "alluvium", aes.bind = "flow", lode.guidance = lode_custom) # omit missing elements & reverse the `y` axis ggplot(ggalluvial::majors, aes(x = semester, stratum = curriculum, alluvium = student, y = 1)) + geom_alluvium(fill = "darkgrey", na.rm = TRUE) + geom_stratum(aes(fill = curriculum), color = NA, na.rm = TRUE) + theme_bw() + scale_y_reverse() \donttest{ # alluvium cementation examples gg <- ggplot(ggalluvial::majors, aes(x = semester, stratum = curriculum, alluvium = student, fill = curriculum)) + geom_stratum() # diagram with outlined alluvia and labels gg + geom_flow(stat = "alluvium", color = "black") + geom_text(aes(label = after_stat(lode)), stat = "alluvium") # cemented diagram with default distillation (first most common alluvium) gg + geom_flow(stat = "alluvium", color = "black", cement.alluvia = TRUE) + geom_text(aes(label = after_stat(lode)), stat = "alluvium", cement.alluvia = TRUE) # cemented diagram with custom label distillation gg + geom_flow(stat = "alluvium", color = "black", cement.alluvia = TRUE) + geom_text(aes(label = after_stat(lode)), stat = "alluvium", cement.alluvia = TRUE, distill = function(x) paste(x, collapse = "; ")) } \donttest{ data(babynames, package = "babynames") # a discontiguous alluvium bn <- subset(babynames, prop >= .01 & sex == "F" & year > 1962 & year < 1968) ggplot(data = bn, aes(x = year, alluvium = name, y = prop)) + geom_alluvium(aes(fill = name, color = name == "Tammy"), decreasing = TRUE, show.legend = FALSE) + scale_color_manual(values = c("#00000000", "#000000")) # expanded to include missing values bn2 <- merge(bn, expand.grid(year = unique(bn$year), name = unique(bn$name)), all = TRUE) ggplot(data = bn2, aes(x = year, alluvium = name, y = prop)) + geom_alluvium(aes(fill = name, color = name == "Tammy"), decreasing = TRUE, show.legend = FALSE) + scale_color_manual(values = c("#00000000", "#000000")) # with missing values filled in with zeros bn2$prop[is.na(bn2$prop)] <- 0 ggplot(data = bn2, aes(x = year, alluvium = name, y = prop)) + geom_alluvium(aes(fill = name, color = name == "Tammy"), decreasing = TRUE, show.legend = FALSE) + scale_color_manual(values = c("#00000000", "#000000")) } # use negative y values to encode deaths versus survivals titanic <- as.data.frame(Titanic) titanic <- transform(titanic, Lives = Freq * (-1) ^ (Survived == "No")) ggplot(subset(titanic, Class != "Crew"), aes(axis1 = Class, axis2 = Sex, axis3 = Age, y = Lives)) + geom_alluvium(aes(alpha = Survived, fill = Class), absolute = FALSE) + geom_stratum(absolute = FALSE) + geom_text(stat = "stratum", aes(label = after_stat(stratum)), absolute = FALSE) + scale_x_discrete(limits = c("Class", "Sex", "Age"), expand = c(.1, .05)) + scale_alpha_discrete(range = c(.25, .75), guide = "none") # faceting with common alluvia ggplot(titanic, aes(y = Freq, axis1 = Class, axis2 = Sex, axis3 = Age)) + facet_wrap(~ Survived) + geom_alluvium() + geom_stratum() + geom_text(stat = "stratum", aes(label = after_stat(stratum))) ggplot(transform(alluvial::Refugees, id = 1), aes(y = refugees, x = year, alluvium = id)) + facet_wrap(~ country) + geom_alluvium(alpha = .75, color = "darkgrey") + scale_x_continuous(breaks = seq(2004, 2012, 4)) ggalluvial/inst/examples/ex-stat-stratum.r0000644000176200001440000000564414025146066020456 0ustar liggesusersdata(vaccinations) # only `stratum` assignment is necessary to generate strata ggplot(vaccinations, aes(y = freq, x = survey, stratum = response, fill = response)) + stat_stratum(width = .5) # lode data, positioning with y labels ggplot(vaccinations, aes(y = freq, x = survey, stratum = response, alluvium = subject, label = after_stat(count))) + stat_stratum(geom = "errorbar") + geom_text(stat = "stratum") # alluvium data, positioning with stratum labels ggplot(as.data.frame(Titanic), aes(y = Freq, axis1 = Class, axis2 = Sex, axis3 = Age, axis4 = Survived)) + geom_text(stat = "stratum", aes(label = after_stat(stratum))) + stat_stratum(geom = "errorbar") + scale_x_discrete(limits = c("Class", "Sex", "Age", "Survived")) # omit labels for strata outside a y range ggplot(vaccinations, aes(y = freq, x = survey, stratum = response, fill = response, label = response)) + stat_stratum(width = .5) + geom_text(stat = "stratum", min.y = 100) # date-valued axis variables ggplot(vaccinations, aes(x = end_date, y = freq, stratum = response, alluvium = subject, fill = response)) + stat_alluvium(geom = "flow", lode.guidance = "forward", width = 30) + stat_stratum(width = 30) + labs(x = "Survey date", y = "Number of respondents") admissions <- as.data.frame(UCBAdmissions) admissions <- transform(admissions, Count = Freq * (-1) ^ (Admit == "Rejected")) # use negative y values to encode rejection versus acceptance ggplot(admissions, aes(y = Count, axis1 = Dept, axis2 = Gender)) + geom_alluvium(aes(fill = Dept), width = 1/12) + geom_stratum(width = 1/12, fill = "black", color = "grey") + geom_label(stat = "stratum", aes(label = after_stat(stratum)), min.y = 200) + scale_x_discrete(limits = c("Department", "Gender"), expand = c(.05, .05)) # computed variable 'deposit' indicates order of each signed stratum ggplot(admissions, aes(y = Count, axis1 = Dept, axis2 = Gender)) + geom_alluvium(aes(fill = Dept), width = 1/12) + geom_stratum(width = 1/12, fill = "black", color = "grey") + geom_text(stat = "stratum", aes(label = after_stat(deposit)), color = "white") + scale_x_discrete(limits = c("Department", "Gender"), expand = c(.05, .05)) # fixed-width strata with acceptance and rejection totals ggplot(admissions, aes(y = sign(Count), weight = Count, axis1 = Dept, axis2 = Gender)) + geom_alluvium(aes(fill = Dept), width = 1/8) + geom_stratum(width = 1/8, fill = "black", color = "grey") + geom_text(stat = "stratum", aes(label = paste0(stratum, ifelse(nchar(as.character(stratum)) == 1L, ": ", "\n"), after_stat(n))), color = "white", size = 3) + scale_x_discrete(limits = c("Department", "Gender"), expand = c(.05, .05)) ggalluvial/inst/doc/0000755000176200001440000000000014372455323014133 5ustar liggesusersggalluvial/inst/doc/ggalluvial.html0000644000176200001440000227013114372455312017154 0ustar liggesusers Alluvial Plots in ggplot2

Alluvial Plots in ggplot2

Jason Cory Brunson

2023-02-13

The {ggalluvial} package is a {ggplot2} extension for producing alluvial plots in a {tidyverse} framework. The design and functionality were originally inspired by the {alluvial} package and have benefitted from the feedback of many users. This vignette

  • defines the essential components of alluvial plots as used in the naming schemes and documentation (axis, alluvium, stratum, lode, flow),
  • describes the alluvial data structures recognized by {ggalluvial},
  • illustrates the new stats and geoms, and
  • showcases some popular variants on the theme and how to produce them.

Unlike most alluvial and related diagrams, the plots produced by {ggalluvial} are uniquely determined by the data set and statistical transformation. The distinction is detailed in this blog post.

Many other resources exist for visualizing categorical data in R, including several more basic plot types that are likely to more accurately convey proportions to viewers when the data are not so structured as to warrant an alluvial plot. In particular, check out Michael Friendly’s {vcd} and {vcdExtra} packages for a variety of statistically-motivated categorical data visualization techniques, Hadley Wickham’s {productplots} package and Haley Jeppson and Heike Hofmann’s descendant {ggmosaic} package for product or mosaic plots, and Nicholas Hamilton’s {ggtern} package for ternary coordinates. Other related packages are mentioned below.

Alluvial plots

Here’s a quintessential alluvial plot:

The next section details how the elements of this image encode information about the underlying dataset. For now, we use the image as a point of reference to define the following elements of a typical alluvial plot:

  • An axis is a dimension (variable) along which the data are vertically arranged at a fixed horizontal position. The plot above uses three categorical axes: Class, Sex, and Age.
  • The groups at each axis are depicted as opaque blocks called strata. For example, the Class axis contains four strata: 1st, 2nd, 3rd, and Crew.
  • Horizontal (x-) splines called alluvia span the width of the plot. In this plot, each alluvium corresponds to a fixed value of each axis variable, indicated by its vertical position at the axis, as well as of the Survived variable, indicated by its fill color.
  • The segments of the alluvia between pairs of adjacent axes are flows.
  • The alluvia intersect the strata at lodes. The lodes are not visualized in the above plot, but they can be inferred as filled rectangles extending the flows through the strata at each end of the plot or connecting the flows on either side of the center stratum.

As the examples in the next section will demonstrate, which of these elements are incorporated into an alluvial plot depends on both how the underlying data is structured and what the creator wants the plot to communicate.

Alluvial data

{ggalluvial} recognizes two formats of “alluvial data”, treated in detail in the following subsections, but which basically correspond to the “wide” and “long” formats of categorical repeated measures data. A third, tabular (or array), form is popular for storing data with multiple categorical dimensions, such as the Titanic and UCBAdmissions datasets.1 For consistency with tidy data principles and {ggplot2} conventions, {ggalluvial} does not accept tabular input; base::as.data.frame() converts such an array to an acceptable data frame.

Alluvia (wide) format

The wide format reflects the visual arrangement of an alluvial plot, but “untwisted”: Each row corresponds to a cohort of observations that take a specific value at each variable, and each variable has its own column. An additional column contains the quantity of each row, e.g. the number of observational units in the cohort, which may be used to control the heights of the strata.2 Basically, the wide format consists of one row per alluvium. This is the format into which the base function as.data.frame() transforms a frequency table, for instance the 3-dimensional UCBAdmissions dataset:

head(as.data.frame(UCBAdmissions), n = 12)
##       Admit Gender Dept Freq
## 1  Admitted   Male    A  512
## 2  Rejected   Male    A  313
## 3  Admitted Female    A   89
## 4  Rejected Female    A   19
## 5  Admitted   Male    B  353
## 6  Rejected   Male    B  207
## 7  Admitted Female    B   17
## 8  Rejected Female    B    8
## 9  Admitted   Male    C  120
## 10 Rejected   Male    C  205
## 11 Admitted Female    C  202
## 12 Rejected Female    C  391
is_alluvia_form(as.data.frame(UCBAdmissions), axes = 1:3, silent = TRUE)
## [1] TRUE

This format is inherited from the first release of {ggalluvial}, which modeled it after usage in {alluvial}: The user declares any number of axis variables, which stat_alluvium() and stat_stratum() recognize and process in a consistent way:

ggplot(as.data.frame(UCBAdmissions),
       aes(y = Freq, axis1 = Gender, axis2 = Dept)) +
  geom_alluvium(aes(fill = Admit), width = 1/12) +
  geom_stratum(width = 1/12, fill = "black", color = "grey") +
  geom_label(stat = "stratum", aes(label = after_stat(stratum))) +
  scale_x_discrete(limits = c("Gender", "Dept"), expand = c(.05, .05)) +
  scale_fill_brewer(type = "qual", palette = "Set1") +
  ggtitle("UC Berkeley admissions and rejections, by sex and department")

An important feature of these plots is the meaningfulness of the vertical axis: No gaps are inserted between the strata, so the total height of the plot reflects the cumulative quantity of the observations. The plots produced by {ggalluvial} conform (somewhat; keep reading) to the “grammar of graphics” principles of {ggplot2}, and this prevents users from producing “free-floating” visualizations like the Sankey diagrams showcased here.3 {ggalluvial} parameters and native {ggplot2} functionality can also produce parallel sets plots, illustrated here using the HairEyeColor dataset:45

ggplot(as.data.frame(HairEyeColor),
       aes(y = Freq,
           axis1 = Hair, axis2 = Eye, axis3 = Sex)) +
  geom_alluvium(aes(fill = Eye),
                width = 1/8, knot.pos = 0, reverse = FALSE) +
  scale_fill_manual(values = c(Brown = "#70493D", Hazel = "#E2AC76",
                               Green = "#3F752B", Blue = "#81B0E4")) +
  guides(fill = "none") +
  geom_stratum(alpha = .25, width = 1/8, reverse = FALSE) +
  geom_text(stat = "stratum", aes(label = after_stat(stratum)),
            reverse = FALSE) +
  scale_x_continuous(breaks = 1:3, labels = c("Hair", "Eye", "Sex")) +
  coord_flip() +
  ggtitle("Eye colors of 592 subjects, by sex and hair color")
## Warning in to_lodes_form(data = data, axes = axis_ind, discern =
## params$discern): Some strata appear at multiple axes.

## Warning in to_lodes_form(data = data, axes = axis_ind, discern =
## params$discern): Some strata appear at multiple axes.

## Warning in to_lodes_form(data = data, axes = axis_ind, discern =
## params$discern): Some strata appear at multiple axes.

(The warning is due to the “Hair” and “Eye” axes having the value “Brown” in common.)

This format and functionality are useful for many applications and will be retained in future versions. They also involve some conspicuous deviations from {ggplot2} norms:

  • The axis[0-9]* position aesthetics are non-standard: they are not an explicit set of parameters but a family based on a regular expression pattern; and at least one, but no specific one, is required.
  • stat_alluvium() ignores any argument to the group aesthetic; instead, StatAlluvium$compute_panel() uses group to link the rows of the internally-transformed dataset that correspond to the same alluvium.
  • The horizontal axis must be manually corrected (using scale_x_discrete() or scale_x_continuous()) to reflect the implicit categorical variable identifying the axis.

Furthermore, format aesthetics like fill are necessarily fixed for each alluvium; they cannot, for example, change from axis to axis according to the value taken at each. This means that, although they can reproduce the branching-tree structure of parallel sets, this format cannot be used to produce alluvial plots with color schemes such as those featured here (“Controlling colors”), which are “reset” at each axis.

Note also that the stratum variable produced by stat_stratum() (called by geom_text()) is computed during the statistical transformation and must be recovered using after_stat() as a calculated aesthetic.

Lodes (long) format

The long format recognized by {ggalluvial} contains one row per lode, and can be understood as the result of “gathering” (in a deprecated {dplyr} sense) or “pivoting” (in the Microsoft Excel or current {dplyr} sense) the axis columns of a dataset in the alluvia format into a key-value pair of columns encoding the axis as the key and the stratum as the value. This format requires an additional indexing column that links the rows corresponding to a common cohort, i.e. the lodes of a single alluvium:

UCB_lodes <- to_lodes_form(as.data.frame(UCBAdmissions),
                           axes = 1:3,
                           id = "Cohort")
head(UCB_lodes, n = 12)
##    Freq Cohort     x  stratum
## 1   512      1 Admit Admitted
## 2   313      2 Admit Rejected
## 3    89      3 Admit Admitted
## 4    19      4 Admit Rejected
## 5   353      5 Admit Admitted
## 6   207      6 Admit Rejected
## 7    17      7 Admit Admitted
## 8     8      8 Admit Rejected
## 9   120      9 Admit Admitted
## 10  205     10 Admit Rejected
## 11  202     11 Admit Admitted
## 12  391     12 Admit Rejected
is_lodes_form(UCB_lodes, key = x, value = stratum, id = Cohort, silent = TRUE)
## [1] TRUE

The functions that convert data between wide (alluvia) and long (lodes) format include several parameters that help preserve ancillary information. See help("alluvial-data") for examples.

The same stat and geom can receive data in this format using a different set of positional aesthetics, also specific to {ggalluvial}:

  • x, the “key” variable indicating the axis to which the row corresponds, which are to be arranged along the horizontal axis;
  • stratum, the “value” taken by the axis variable indicated by x; and
  • alluvium, the indexing scheme that links the rows of a single alluvium.

Heights can vary from axis to axis, allowing users to produce bump charts like those showcased here.6 In these cases, the strata contain no more information than the alluvia and often are not plotted. For convenience, both stat_alluvium() and stat_flow() will accept arguments for x and alluvium even if none is given for stratum.7 As an example, we can group countries in the Refugees dataset by region, in order to compare refugee volumes at different scales:

data(Refugees, package = "alluvial")
country_regions <- c(
  Afghanistan = "Middle East",
  Burundi = "Central Africa",
  `Congo DRC` = "Central Africa",
  Iraq = "Middle East",
  Myanmar = "Southeast Asia",
  Palestine = "Middle East",
  Somalia = "Horn of Africa",
  Sudan = "Central Africa",
  Syria = "Middle East",
  Vietnam = "Southeast Asia"
)
Refugees$region <- country_regions[Refugees$country]
ggplot(data = Refugees,
       aes(x = year, y = refugees, alluvium = country)) +
  geom_alluvium(aes(fill = country, colour = country),
                alpha = .75, decreasing = FALSE) +
  scale_x_continuous(breaks = seq(2003, 2013, 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = -30, hjust = 0)) +
  scale_fill_brewer(type = "qual", palette = "Set3") +
  scale_color_brewer(type = "qual", palette = "Set3") +
  facet_wrap(~ region, scales = "fixed") +
  ggtitle("refugee volume by country and region of origin")

The format allows us to assign aesthetics that change from axis to axis along the same alluvium, which is useful for repeated measures datasets. This requires generating a separate graphical object for each flow, as implemented in geom_flow(). The plot below uses a set of (changes to) students’ academic curricula over the course of several semesters. Since geom_flow() calls stat_flow() by default (see the next example), we override it with stat_alluvium() in order to track each student across all semesters:

data(majors)
majors$curriculum <- as.factor(majors$curriculum)
ggplot(majors,
       aes(x = semester, stratum = curriculum, alluvium = student,
           fill = curriculum, label = curriculum)) +
  scale_fill_brewer(type = "qual", palette = "Set2") +
  geom_flow(stat = "alluvium", lode.guidance = "frontback",
            color = "darkgray") +
  geom_stratum() +
  theme(legend.position = "bottom") +
  ggtitle("student curricula across several semesters")

The stratum heights y are unspecified, so each row is given unit height. This example demonstrates one way {ggalluvial} handles missing data. The alternative is to set the parameter na.rm to TRUE.8 Missing data handling (specifically, the order of the strata) also depends on whether the stratum variable is character or factor/numeric.

Finally, lode format gives us the option to aggregate the flows between adjacent axes, which may be appropriate when the transitions between adjacent axes are of primary importance. We can demonstrate this option on data from the influenza vaccination surveys conducted by the RAND American Life Panel. The data, including one question from each of three surveys, has been aggregated by response profile: Each “subject” (mapped to alluvium) actually represents a cohort of subjects who responded the same way on all three questions, and the size of each cohort (mapped to y) is recorded in “freq”.

data(vaccinations)
vaccinations <- transform(vaccinations,
                          response = factor(response, rev(levels(response))))
ggplot(vaccinations,
       aes(x = survey, stratum = response, alluvium = subject,
           y = freq,
           fill = response, label = response)) +
  scale_x_discrete(expand = c(.1, .1)) +
  geom_flow() +
  geom_stratum(alpha = .5) +
  geom_text(stat = "stratum", size = 3) +
  theme(legend.position = "none") +
  ggtitle("vaccination survey responses at three points in time")

This plot ignores any continuity between the flows between axes. This “memoryless” statistical transformation yields a less cluttered plot, in which at most one flow proceeds from each stratum at one axis to each stratum at the next, but at the cost of being able to track each cohort across the entire plot.

Appendix

sessioninfo::session_info()
## ─ Session info ───────────────────────────────────────────────────────────────
##  setting  value
##  version  R version 4.2.1 (2022-06-23)
##  os       macOS Catalina 10.15.7
##  system   x86_64, darwin17.0
##  ui       X11
##  language (EN)
##  collate  C
##  ctype    en_US.UTF-8
##  tz       America/New_York
##  date     2023-02-13
##  pandoc   2.19.2 @ /Applications/RStudio.app/Contents/Resources/app/quarto/bin/tools/ (via rmarkdown)
## 
## ─ Packages ───────────────────────────────────────────────────────────────────
##  package      * version date (UTC) lib source
##  bslib          0.4.2   2022-12-16 [3] CRAN (R 4.2.0)
##  cachem         1.0.6   2021-08-19 [3] CRAN (R 4.2.0)
##  cli            3.6.0   2023-01-09 [3] CRAN (R 4.2.0)
##  colorspace     2.1-0   2023-01-23 [3] CRAN (R 4.2.0)
##  digest         0.6.31  2022-12-11 [3] CRAN (R 4.2.0)
##  dplyr          1.1.0   2023-01-29 [3] CRAN (R 4.2.0)
##  evaluate       0.20    2023-01-17 [3] CRAN (R 4.2.0)
##  fansi          1.0.4   2023-01-22 [3] CRAN (R 4.2.0)
##  farver         2.1.1   2022-07-06 [3] CRAN (R 4.2.0)
##  fastmap        1.1.0   2021-01-25 [3] CRAN (R 4.2.0)
##  generics       0.1.3   2022-07-05 [3] CRAN (R 4.2.0)
##  ggalluvial   * 0.12.5  2023-02-13 [1] local
##  ggplot2      * 3.4.0   2022-11-04 [3] CRAN (R 4.2.1)
##  glue           1.6.2   2022-02-24 [3] CRAN (R 4.2.0)
##  gtable         0.3.1   2022-09-01 [3] CRAN (R 4.2.0)
##  highr          0.10    2022-12-22 [3] CRAN (R 4.2.0)
##  htmltools      0.5.4   2022-12-07 [3] CRAN (R 4.2.0)
##  jquerylib      0.1.4   2021-04-26 [3] CRAN (R 4.2.0)
##  jsonlite       1.8.4   2022-12-06 [3] CRAN (R 4.2.0)
##  knitr          1.42    2023-01-25 [3] CRAN (R 4.2.0)
##  labeling       0.4.2   2020-10-20 [3] CRAN (R 4.2.0)
##  lifecycle      1.0.3   2022-10-07 [3] CRAN (R 4.2.0)
##  magrittr       2.0.3   2022-03-30 [3] CRAN (R 4.2.0)
##  munsell        0.5.0   2018-06-12 [3] CRAN (R 4.2.0)
##  pillar         1.8.1   2022-08-19 [3] CRAN (R 4.2.0)
##  pkgconfig      2.0.3   2019-09-22 [3] CRAN (R 4.2.0)
##  purrr          1.0.1   2023-01-10 [3] CRAN (R 4.2.0)
##  R6             2.5.1   2021-08-19 [3] CRAN (R 4.2.0)
##  RColorBrewer   1.1-3   2022-04-03 [3] CRAN (R 4.2.0)
##  rlang          1.0.6   2022-09-24 [3] CRAN (R 4.2.0)
##  rmarkdown      2.20    2023-01-19 [3] CRAN (R 4.2.0)
##  rstudioapi     0.14    2022-08-22 [3] CRAN (R 4.2.0)
##  sass           0.4.5   2023-01-24 [3] CRAN (R 4.2.0)
##  scales         1.2.1   2022-08-20 [3] CRAN (R 4.2.0)
##  sessioninfo    1.2.2   2021-12-06 [3] CRAN (R 4.2.0)
##  tibble         3.1.8   2022-07-22 [3] CRAN (R 4.2.0)
##  tidyr          1.3.0   2023-01-24 [3] CRAN (R 4.2.0)
##  tidyselect     1.2.0   2022-10-10 [3] CRAN (R 4.2.0)
##  utf8           1.2.3   2023-01-31 [3] CRAN (R 4.2.1)
##  vctrs          0.5.2   2023-01-23 [3] CRAN (R 4.2.0)
##  withr          2.5.0   2022-03-03 [3] CRAN (R 4.2.0)
##  xfun           0.37    2023-01-31 [3] CRAN (R 4.2.1)
##  yaml           2.3.7   2023-01-23 [3] CRAN (R 4.2.0)
## 
##  [1] /private/var/folders/k6/l4mq9ctj3219429xnvqpdbxm8tckkx/T/Rtmp9fMfyT/Rinst61ce73b51348
##  [2] /private/var/folders/k6/l4mq9ctj3219429xnvqpdbxm8tckkx/T/RtmplDE0GG/temp_libpath60ab25e50e46
##  [3] /Library/Frameworks/R.framework/Versions/4.2/Resources/library
## 
## ──────────────────────────────────────────────────────────────────────────────

  1. See Friendly’s tutorial, linked above, for a discussion.↩︎

  2. Previously, quantities were passed to the weight aesthetic rather than to y. This prevented scale_y_continuous() from correctly transforming scales, and anyway it was inconsistent with the behavior of geom_bar(). As of version 0.12.0, weight is an optional parameter used only by computed variables intended for labeling, not by polygonal graphical elements.↩︎

  3. The {ggforce} package includes parallel set geom and stat layers to produce similar diagrams that can be allowed to free-float.↩︎

  4. A greater variety of parallel sets plots are implemented in the {ggparallel} and {ggpcp} packages.↩︎

  5. Eye color hex codes are taken from Crayola’s Colors of the World crayons.↩︎

  6. If bumping is unnecessary, consider using geom_area() instead.↩︎

  7. stat_stratum() will similarly accept arguments for x and stratum without alluvium. If both strata and either alluvia or flows are to be plotted, though, all three parameters need arguments.↩︎

  8. Be sure to set na.rm consistently in each layer, in this case both the flows and the strata.↩︎

ggalluvial/inst/doc/shiny.html0000644000176200001440000015755114372455323016171 0ustar liggesusers Tooltips for ggalluvial plots in Shiny apps

Tooltips for ggalluvial plots in Shiny apps

Quentin D. Read

2023-02-13

Problem

In an interactive visualization, it is visually cleaner and better for interpretation if labels and other information appear as “tooltips” when the user hovers over or clicks on elements of the plot, rather than displaying all the labels on the plot at one time. However, the {ggalluvial} package does not natively include this functionality. It is possible to enable this using functions from several other packages. This vignette illustrates how to create Shiny apps that display an alluvial plot with tooltips that appear when the user hovers over two different plot elements: strata created with geom_stratum() and alluvia created with geom_alluvium(). An example is provided for wide-format alluvial data (the UCBAdmissions dataset) and long-format alluvial data (the vaccinations dataset).

The tooltips that appear when the user hovers over elements of the plot show a text label and the count in each group. If the user hovers or clicks somewhere inside a ggplot panel, Shiny automatically returns information about the location of the mouse cursor in plot coordinates. That means the main work we have to do is to extract or manually recalculate the coordinates of the different plot elements. With that information, we can determine which plot element the cursor is hovering over and display the appropriate information in the tooltip or other output method.

Note: The app demonstrated here depends on the packages {htmltools} and {sp}, in addition of course to {ggalluvial} and {shiny}. Please be aware that all of these packages will need to be installed on the server where your Shiny app is running.

Hovering over and clicking on strata

Enabling hovering over and clicking on strata is straightforward because of their rectangular shape. We only need the minimum and maximum x and y coordinates for each of the rectangles. The rectangles are evenly spaced along the x-axis, centered on positive integers beginning with 1. The width is set in geom_stratum() so, for example, we know that the x-coordinates of the first stratum are c(1 - width/2, 1 + width/2). The y-coordinates can be determined from the number of rows in the input data multiplied by their weights.

Hovering over and clicking on alluvia

Hovering over and clicking on alluvia are more difficult because the shapes of the alluvia are more complex. The default shape of the polygons includes an xspline curve drawn using the {grid} package. We need to manually reconstruct the coordinates of the polygons, then use sp::pointInPolygon() to detect which, if any, polygons the cursor is over.

App with wide-format alluvial data

The app is embedded below, followed by a walkthrough of the source code.

If you aren’t connected to the internet, or if you loaded this vignette using vignette('shiny', package = 'ggalluvial') rather than browseVignettes(package = 'ggalluvial'), the app will not display in the window above. You can view the app locally by running this line of code in your console:

shiny::shinyAppDir(system.file("examples/ex-shiny-wide-data", package="ggalluvial"))

Structure of the example app

Here, we will go over each section of the code in detail. The full source code is included in the package’s examples directory.

The app first (1) loads the data and (2) builds the plot. Then, (3) information is extracted from the built plot object to (4) manually recalculate the coordinates of the polygons that make up the plot. Internally, {ggalluvial} uses the {grid} package to draw the polygons, so the next steps are (5) to define the minima and maxima of the x and y axes in {grid} units and the units that appear on the plot’s coordinate system, and (6) to convert the polygon coordinates from {grid} units plot units. Next, the user interface is defined, including output of (7) the plot image and (8) the tooltip. The final block of code is the server function, which first (9) renders the plot. Finally, the tooltip is defined. This includes (10) logic to determine whether the mouse cursor is inside the plot panel, then (11) whether it is hovering over a stratum, (12) an alluvium, or neither, based on the mouse coordinates provided by Shiny. If the mouse is hovering over a plot element, the app finds appropriate information and prints it in a small “tooltip” box next to the mouse cursor (11b and 12b).

This is the structure of the app in pseudocode.

'<(1) Load data.>'

'<(2) Create "ggplot" object for alluvial plot and build it.>'

'<(3) Extract data from built plot object used to create alluvium polygons.>'

for (polygon in polygons) {
     '<(4) Use polygon splines to generate coordinates of alluvium boundaries.>'
}

'<(5) Define range of coordinates in grid units and plot units.>'

for (polygon in polygons) {    
     '<(6) Convert coordinates from grid units to plot units.>'
}

ui <- fluidPage(
     '<(7) Output plot with hovering enabled.>'
     
     '<(8) Output tooltip.>'
)


server <- function(input, output, session) {
  
  output$alluvial_plot <- renderPlot({
    '<(9) Render the plot.>'
  })
  
  output$tooltip <- renderText({
    if ('<(10) mouse cursor is within the plot panel>') {
      if ('<(11) mouse cursor is within a stratum box>') {
        '<(11b) Render stratum tooltip.>'
      } else {
        if ('<(12) mouse cursor is within an alluvium polygon>') {
          '<(12b) Render alluvium tooltip.>'
        }
      }
    }
  })
  
}

Loading data

The UC-Berkeley admissions dataset, UCBAdmissions, is used in this example. After loading the necessary packages, the first thing we do in the app is load the data and coerce from array to data frame.

data(UCBAdmissions)
ucb_admissions <- as.data.frame(UCBAdmissions)

Next we set offset, the distance from cursor to tooltip, in pixels, in both x and y directions. We also set node_width and alluvium_width here, which are used as arguments to geom_stratum() and geom_alluvium() below, and again later to determine whether the mouse cursor is hovering over a stratum/alluvium.

# Offset, in pixels, for location of tooltip relative to mouse cursor,
# in both x and y direction.
offset <- 5
# Width of node boxes
node_width <- 1/4
# Width of alluvia
alluvium_width <- 1/3

Drawing the plot and extracting coordinates

Next, we create the ggplot object for the alluvial plot, then we call the ggplot_build() function to build the plot without displaying it.

# Draw plot.
p <- ggplot(ucb_admissions,
            aes(y = Freq, axis1 = Gender, axis2 = Dept)) + 
  geom_alluvium(aes(fill = Admit), knot.pos = 1/4, width = alluvium_width) + 
  geom_stratum(width = node_width, reverse = TRUE, fill = 'black', color = 'grey') + 
  geom_label(aes(label = after_stat(stratum)), 
             stat = "stratum", 
             reverse = TRUE, 
             size = rel(2)) + 
  theme_bw() +
  scale_fill_brewer(type = "qual", palette = "Set1") +
  scale_x_discrete(limits = c("Gender", "Dept"), expand = c(.05, .05)) +
  scale_y_continuous(expand = c(0, 0)) +
  ggtitle("UC Berkeley admissions and rejections", "by sex and department") +
  theme(plot.title = element_text(size = rel(1)),
        plot.subtitle = element_text(size = rel(1)),
        legend.position = 'bottom')

# Build the plot. 
pbuilt <- ggplot_build(p)

Now for the hard part: reverse-engineering the coordinates of the alluvia polygons. This makes use of pbuilt$data[[1]], a data frame with the individual elements of the alluvial plot. We add an additional column for width using the value we set above, then split the data frame by group (groups correspond to the individual alluvium polygons). We apply the function data_to_alluvium() to each element of the list to get the coordinates of the “skeleton” of the x-spline curve. Then, we pass these coordinates to the function grid::xsplineGrob() to fill in the smooth spline curves and convert them into a {grid} object. We pass the resulting object to grid::xsplinePoints(), which converts back into numeric vectors. At this point we now have the coordinates of the alluvium polygons. The object xspline_points is a list with length equal to the number of alluvium polygons in the plot. Each element of the list is a list with elements x and y, which are numeric vectors.

# Add width parameter, and then convert built plot data to xsplines
data_draw <- transform(pbuilt$data[[1]], width = alluvium_width)
groups_to_draw <- split(data_draw, data_draw$group)
group_xsplines <- lapply(groups_to_draw,
                         data_to_alluvium) 

# Convert xspline coordinates to grid object.
xspline_coords <- lapply(
  group_xsplines,
  function(coords) grid::xsplineGrob(x = coords$x, 
                                     y = coords$y, 
                                     shape = coords$shape, 
                                     open = FALSE)
)

# Use grid::xsplinePoints to draw the curve for each polygon
xspline_points <- lapply(xspline_coords, grid::xsplinePoints)

The coordinates we have are in {grid} plotting units but we need to convert them into the same units as the axes on the plot. We do this by determining the range of the x and y-axes in {grid} units (xrange_old and yrange_old). Then we fix the range of the x axis as 1 to the number of strata, adjusted by half the alluvium width on each side. Next we fix the range of the y-axis to the sum of the counts across all alluvia at one node.

# Define the x and y axis limits in grid coordinates (old) and plot
# coordinates (new)
xrange_old <- range(unlist(lapply(
  xspline_points,
  function(pts) as.numeric(pts$x)
)))
yrange_old <- range(unlist(lapply(
  xspline_points,
  function(pts) as.numeric(pts$y)
)))
xrange_new <- c(1 - alluvium_width/2, max(pbuilt$data[[1]]$x) + alluvium_width/2) 
yrange_new <- c(0, sum(pbuilt$data[[2]]$count[pbuilt$data[[2]]$x == 1]))

We define a function new_range_transform() inline and apply it to each set of coordinates. This returns another list, polygon_coords, with the same structure as xspline_points. Now we have the coordinates of the polygons in plot units!

# Define function to convert grid graphics coordinates to data coordinates
new_range_transform <- function(x_old, range_old, range_new) {
  (x_old - range_old[1])/(range_old[2] - range_old[1]) *
    (range_new[2] - range_new[1]) + range_new[1]
}

# Using the x and y limits, convert the grid coordinates into plot coordinates.
polygon_coords <- lapply(xspline_points, function(pts) {
  x_trans <- new_range_transform(x_old = as.numeric(pts$x), 
                                 range_old = xrange_old, 
                                 range_new = xrange_new)
  y_trans <- new_range_transform(x_old = as.numeric(pts$y), 
                                 range_old = yrange_old, 
                                 range_new = yrange_new)
  list(x = x_trans, y = y_trans)
})

User interface

The app includes a minimal user interface with two output elements.

ui <- fluidPage(
  fluidRow(tags$div(
    style = "position: relative;",
    plotOutput("alluvial_plot", height = "650px", 
               hover = hoverOpts(id = "plot_hover")
               ),
    htmlOutput("tooltip")))
)

The elements are:

  • a plotOutput with the argument hover defined, to enable behavior determined by the cursor’s plot coordinates whenever the user hovers over the plot.
  • an htmlOutput for the tooltip that appears next to the cursor on hover.

The elements are wrapped in a fluidRow() and a div() tag.

Note: This vignette only illustrates how to display output when the user hovers over an element. If you want to display output when the user clicks on an element, the corresponding argument to plotOutput() is click = clickOpts(id = "plot_click"). This will return the location of the mouse cursor in plot coordinates when the user clicks somewhere within the plot panel.

Also Note: In the example presented here, all of the plot drawing and coordinate extracting code is outside the server() function, because the plot itself does not change with user input. However if you are building an app where the plot changes in response to user input, for example a menu of options of which variables to display, the plot drawing code has to be inside the renderPlot() expression. This means that the coordinates may need to be recalculated each time the user input changes as well. In that case, you may need to use the global assignment operator <<- so that the coordinates are accessible outside the renderPlot() expression.

Server function

In the server function, we first call renderPlot() to draw the plot in the app window.

output$alluvial_plot <- renderPlot(p, res = 200)

Next, we define the tooltip with a renderText() expression. Within that expression, we first extract the cursor’s plot coordinates from the user input. We determine whether the cursor is hovering over a stratum and if so, display the appropriate tooltip.

screenshot of tooltip on stratum

If the mouse cursor is not hovering over a stratum, we determine whether it is hovering over an alluvium polygon and if so, display different information in the tooltip.

screenshot of tooltip on alluvium

If the mouse cursor is hovering over an empty region of the plot, renderText() returns nothing and no tooltip appears.

screenshot of cursor over empty region

Let’s take a deeper dive into the logic used to determine the text that appears in the tooltip.

First, we check whether the cursor is inside the plot panel. If it is not, the element plot_hover of the input will be NULL. In that case renderText() will return nothing and no tooltip will appear.

output$tooltip <- renderText(
  if(!is.null(input$plot_hover)) { ... }
  ...
)

Hovering over a stratum

Next, we check whether the cursor is over a stratum. We round the x-coordinate of the mouse cursor in data units to the nearest integer, then determine whether the x-coordinate is within node_width/2 of that integer. If so, the mouse cursor is horizontally within the box. Here the if-else statement includes behavior to display the tooltip for a stratum if true, and an alluvium if false.

hover <- input$plot_hover
x_coord <- round(hover$x)
    
if(abs(hover$x - x_coord) < (node_width / 2)) { ... } else { ... }

If the condition is true, we need to find the index of the row of the input data that goes with the stratum the cursor is on. The data frame pbuilt$data[[2]] includes columns x, ymin, and ymax that define the x-coordinate of the center of the stratum, and the minimum and maximum y-coordinates of the stratum. We find the row index of that data frame where x is equal to the rounded x-coordinate of the cursor, and the y-coordinate of the cursor falls between ymin and ymax.

node_row <- 
  pbuilt$data[[2]]$x == x_coord & hover$y > pbuilt$data[[2]]$ymin & hover$y < pbuilt$data[[2]]$ymax

To find the information to display in the tooltip, we get the name of the stratum as well as its width from the data in pbuilt.

node_label <- pbuilt$data[[2]]$stratum[node_row]
node_n <- pbuilt$data[[2]]$count[node_row]

Finally, we render a tooltip using the div tag. We provide the text to display as arguments to htmltools::renderTags(). We also paste CSS style information together and pass it to the style argument. Note that the tooltip positioning is provided in CSS coordinates (pixels), not data coordinates. This does not require any additional effort on our part because plot_hover also includes an element called coords_css, which contains the mouse cursor location in pixel units.

renderTags(
  tags$div(
    node_label, tags$br(),
    "n =", node_n,
    style = paste0(
      "position: absolute; ",
      "top: ", hover$coords_css$y + offset, "px; ",
      "left: ", hover$coords_css$x + offset, "px; ",
      "background: gray; ",
      "padding: 3px; ",
      "color: white; "
    )
  )
)$html

Hovering over an alluvium

If the cursor is not over a stratum, the next nested if-statement checks whether it is over an alluvium. This is done using the function sp::point.in.polygon() applied across each of the polygons for which we defined the coordinates inside the renderPlot() expression.

hover_within_flow <- sapply(
  polygon_coords,
  function(pol) point.in.polygon(point.x = hover$x, 
                                 point.y = hover$y, 
                                 pol.x = pol$x, 
                                 pol.y = pol$y)
)

If at least one polygon is beneath the mouse cursor, we locate the corresponding row in the input data and extract information to display in the tooltip. (If the condition is not met, that means the cursor is hovering over an empty area of the plot, so no tooltip appears.)

if (any(hover_within_flow)) { ... }

In the situation where there are more than one polygon overlapping, we get the information for the polygon that is plotted last by calling rev() on the logical vector returned by point.in.polygon(). This means that the tooltip will display information from the alluvium that appears “on top” in the plot. In this example, we display the names of the nodes that the alluvium connects, with arrows between them, and the width of the alluvium.

coord_id <- rev(which(hover_within_flow == 1))[1]
flow_label <- paste(groups_to_draw[[coord_id]]$stratum, collapse = ' -> ')
flow_n <- groups_to_draw[[coord_id]]$count[1]

We render a tooltip using identical syntax to the one above.

renderTags(
  tags$div(
    flow_label, tags$br(),
    "n =", flow_n,
    style = paste0(
      "position: absolute; ",
      "top: ", hover$coords_css$y + offset, "px; ",
      "left: ", hover$coords_css$x + offset, "px; ",
      "background: gray; ",
      "padding: 3px; ",
      "color: white; "
    )
  )
)$html

App with long-format alluvial data

The vaccinations dataset is used for long-format alluvial data. The app is embedded at the bottom of this document, but we don’t need to walk through the source code because it’s almost identical to the code above. The output of ggplot_build() that is used to find the polygon coordinates and information for the tooltips has a consistent structure regardless of the initial format of the input data. Therefore, the calculation of polygon coordinates, user interface, and server functions of the two apps are identical. The only difference is in the initial creation of the ggplot() object. Refer back to the primary vignette for several example plots made both with long and with wide data.

The app is embedded below.

Again, if the app doesn’t display in the window above for whatever reason, you can view it locally by running this line of code in your console:

shiny::shinyAppDir(system.file("examples/ex-shiny-long-data", package="ggalluvial"))

Conclusion

This vignette demonstrates how to enable tooltips for {ggalluvial} plots in Shiny apps. This is one of many possible ways to do that. It may not be the optimal way — other solutions are certainly possible!

The full source code for both of these Shiny apps is included with the {ggalluvial} package in the ‘examples’ subdirectory where the package is installed: the source files are ggalluvial/examples/ex-shiny-wide-data/app.R and ggalluvial/examples/ex-shiny-long-data/app.R.

ggalluvial/inst/doc/labels.rmd0000644000176200001440000001537114367761414016115 0ustar liggesusers--- title: "Labeling small strata" author: "Jason Cory Brunson" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{labeling small strata} %\VignetteEngine{knitr::rmarkdown} \usepackage[utf8]{inputenc} --- ## Setup This brief vignette uses the `vaccinations` dataset included in {ggalluvial}. As in [the technical introduction](http://corybrunson.github.io/ggalluvial/articles/ggalluvial.html), the order of the levels is reversed to be more intuitive. Objects from other {ggplot2} extensions are accessed via `::` and `:::`. ```{r setup} knitr::opts_chunk$set(fig.width = 6, fig.height = 4, fig.align = "center") library(ggalluvial) data(vaccinations) vaccinations <- transform(vaccinations, response = factor(response, rev(levels(response)))) ``` ## Problem The issue on the table: Strata are most helpful when they're overlaid with text labels. Yet the strata often vary in height, and the labels in length, to such a degree that fitting the text inside the strata at a uniform size renders them illegible. In principle, the user could treat `size` as a variable aesthetic and manually fit text to strata, but this is cumbersome, and doesn't help anyway in cases where large text is needed. To illustrate the problem, check out the plot below. It's by no means an egregious case, but it'll do. (For a more practical example, see [this question on StackOverflow](https://stackoverflow.com/questions/50720718/labelling-and-theme-of-ggalluvial-plot-in-r), which prompted this vignette.) ```{r raw} ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response, label = response)) + scale_x_discrete(expand = c(.1, 0)) + geom_flow(width = 1/4) + geom_stratum(alpha = .5, width = 1/4) + geom_text(stat = "stratum", size = 4) + theme(legend.position = "none") + ggtitle("vaccination survey responses", "labeled using `geom_text()`") ``` ### Fix One option is to simply omit those labels that don't fit within their strata. In response to [an issue](https://github.com/corybrunson/ggalluvial/issues/27), `v0.9.2` includes parameters in `stat_stratum()` to exclude strata outside a specified height range; while few would use this to omit the rectangles themselves, it can be used in tandem with `geom_text()` to shirk this problem, at least when the labels are concise: ```{r omit} ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response, label = response)) + scale_x_discrete(expand = c(.1, 0)) + geom_flow(width = 1/4) + geom_stratum(alpha = .5, width = 1/4) + geom_text(stat = "stratum", size = 4, min.y = 100) + theme(legend.position = "none") + ggtitle( "vaccination survey responses", "labeled using `geom_text()` with `min.y = 100`" ) ``` This is a useful fix for some cases. Still, if the goal is a publication-ready graphic, then it reaffirms the need for more adaptable and elegant solutions. Fortunately, two wonderful packages deliver with, shall we say, flowing colors. ## Solutions Two {ggplot2} extensions are well-suited to this problem: [{ggrepel}](https://github.com/slowkow/ggrepel) and [{ggfittext}](https://github.com/wilkox/ggfittext). They provide new geom layers that use the output of existing stat layers to situate text: `ggrepel::geom_text_repel()` takes the same aesthetics as `ggplot2::geom_text()`, namely `x`, `y`, and `label`. In contrast, `ggfittext::geom_fit_text()` only specifically requires `label` but also needs enough information to determine the rectangle that will contain the text. This can be encoded as `xmin` and `xmax` or as `x` and `width` for the horizontal direction, and as `ymin` and `ymax` or as `y` and `height` for the vertical direction. Conveniently, `ggalluvial::stat_stratum()` produces more than enough information for both geoms, including `x`, `xmin`, `xmax`, and their vertical counterparts. All this can be gleaned from the `ggproto` objects that construct the layers: ```{r aesthetics} print(ggrepel::GeomTextRepel$required_aes) print(ggfittext:::GeomFitText$required_aes) print(ggfittext:::GeomFitText$setup_data) print(StatStratum$compute_panel) ``` I reached the specific solutions through trial and error. They may not be the best tricks for most cases, but they demonstrate what these packages can do. For many more examples, see the respective package vignettes: [for {ggrepel}](https://CRAN.R-project.org/package=ggrepel/vignettes/ggrepel.html), and [for {ggfittext}](https://CRAN.R-project.org/package=ggfittext/vignettes/introduction-to-ggfittext.html). ### Solution 1: {ggrepel} {ggrepel} is most often (in my experience) used to repel text away from symbols in a scatterplot, in whatever directions prevent them from overlapping the symbols and each other. In this case, however, it makes much more sense to align them vertically a fixed horizontal distance (`nudge_x`) away from the strata and repel them vertically from each other (`direction = "y"`) just enough to print them without overlap. It takes an extra bit of effort to render text _only_ for the strata at the first (or at the last) axis, but the result is worth it. ```{r ggrepel} ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + scale_x_discrete(expand = c(.4, 0)) + geom_flow(width = 1/4) + geom_stratum(alpha = .5, width = 1/4) + scale_linetype_manual(values = c("blank", "solid")) + ggrepel::geom_text_repel( aes(label = ifelse(as.numeric(survey) == 1, as.character(response), NA)), stat = "stratum", size = 4, direction = "y", nudge_x = -.5 ) + ggrepel::geom_text_repel( aes(label = ifelse(as.numeric(survey) == 3, as.character(response), NA)), stat = "stratum", size = 4, direction = "y", nudge_x = .5 ) + theme(legend.position = "none") + ggtitle("vaccination survey responses", "labeled using `geom_text_repel()`") ``` ### Solution 2: {ggfittext} {ggfittext} is simplicity itself: The strata are just rectangles, so no more parameter specifications are necessary to fit the text into them. One key parameter is `min.size`, which defaults to `4` and controls how small the text is allowed to get without being omitted. ```{r ggfittext} ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response, label = response)) + scale_x_discrete(expand = c(.1, 0)) + geom_flow(width = 1/4) + geom_stratum(alpha = .5, width = 1/4) + ggfittext::geom_fit_text(stat = "stratum", width = 1/4, min.size = 3) + theme(legend.position = "none") + ggtitle("vaccination survey responses", "labeled using `geom_fit_text()`") ``` Note that this solution requires {ggfittext} v0.6.0. ## Appendix ```{r session info} sessioninfo::session_info() ``` ggalluvial/inst/doc/order-rectangles.R0000644000176200001440000001514114372455322017517 0ustar liggesusers## ----setup-------------------------------------------------------------------- knitr::opts_chunk$set(fig.width = 6, fig.height = 3, fig.align = "center") library(ggalluvial) ## ----data--------------------------------------------------------------------- # toy data set set.seed(0) toy <- data.frame( subject = rep(LETTERS[1:5], times = 4), collection = rep(1:4, each = 5), category = rep( sample(c("X", "Y"), 16, replace = TRUE), rep(c(1, 2, 1, 1), times = 4) ), class = c("one", "one", "one", "two", "two") ) print(toy) ## ----plot--------------------------------------------------------------------- ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + geom_alluvium(aes(fill = class)) + geom_stratum() ## ----strata------------------------------------------------------------------- # collection point and category variables only data <- structure(toy[, 2:3], names = c("x", "stratum")) # required fields for stat transformations data$y <- 1 data$PANEL <- 1 # stratum transformation StatStratum$compute_panel(data) ## ----strata plot-------------------------------------------------------------- ggplot(toy, aes(x = collection, stratum = category)) + stat_stratum() + stat_stratum(geom = "text", aes(label = category)) ## ----strata reverse----------------------------------------------------------- # stratum transformation with strata in original order StatStratum$compute_panel(data, reverse = FALSE) ggplot(toy, aes(x = collection, stratum = category)) + stat_stratum(reverse = FALSE) + stat_stratum(geom = "text", aes(label = category), reverse = FALSE) ## ----strata decreasing-------------------------------------------------------- # stratum transformation with strata in original order StatStratum$compute_panel(data, reverse = FALSE) ggplot(toy, aes(x = collection, stratum = category)) + stat_stratum(decreasing = TRUE) + stat_stratum(geom = "text", aes(label = category), decreasing = TRUE) ## ----alluvia------------------------------------------------------------------ # collection point, category, and subject variables data <- structure(toy[, 1:3], names = c("alluvium", "x", "stratum")) # required fields for stat transformations data$y <- 1 data$PANEL <- 1 # alluvium transformation StatAlluvium$compute_panel(data) ## ----alluvia plot------------------------------------------------------------- ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_alluvium(aes(fill = class)) + stat_stratum(alpha = .25) + stat_alluvium(geom = "text", aes(label = subject)) ## ----flows-------------------------------------------------------------------- # flow transformation StatFlow$compute_panel(data) ## ----flows plot--------------------------------------------------------------- ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_stratum() + stat_flow(aes(fill = class)) + stat_flow(geom = "text", aes(label = subject, hjust = after_stat(flow) == "to")) ## ----lode zigzag-------------------------------------------------------------- for (i in 1:4) print(lode_zigzag(4, i)) ## ----alluvia plot w/ backfront guidance--------------------------------------- for (i in 1:4) print(lode_backfront(4, i)) ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_alluvium(aes(fill = class), lode.guidance = "backfront") + stat_stratum() + stat_alluvium(geom = "text", aes(label = subject), lode.guidance = "backfront") ## ----alluvia plot w/ backward guidance---------------------------------------- for (i in 1:4) print(lode_backward(4, i)) ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_alluvium(aes(fill = class), lode.guidance = "backward") + stat_stratum() + stat_alluvium(geom = "text", aes(label = subject), lode.guidance = "backward") ## ----alluvia plot w/ strong aesthetic binding--------------------------------- ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_alluvium(aes(fill = class, label = subject), aes.bind = "alluvia") + stat_stratum() + stat_alluvium(geom = "text", aes(fill = class, label = subject), aes.bind = "alluvia") ## ----alluvia plot w/ weak aesthetic binding----------------------------------- ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_alluvium(aes(fill = class, label = subject), aes.bind = "flows") + stat_stratum() + stat_alluvium(geom = "text", aes(fill = class, label = subject), aes.bind = "flows") ## ----flows plots w/ aesthetic binding----------------------------------------- ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_flow(aes(fill = class, label = subject), aes.bind = "flows") + stat_stratum() + stat_flow(geom = "text", aes(fill = class, label = subject, hjust = after_stat(flow) == "to"), aes.bind = "flows") ## ----alluvia plot w/ manual lode ordering------------------------------------- lode_ord <- rep(seq(5), times = 4) ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_alluvium(aes(fill = class, order = lode_ord)) + stat_stratum() + stat_alluvium(geom = "text", aes(fill = class, order = lode_ord, label = subject)) ## ----flows plot w/ manual lode ordering--------------------------------------- ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_flow(aes(fill = class, order = lode_ord)) + stat_stratum() + stat_flow(geom = "text", aes(fill = class, order = lode_ord, label = subject, hjust = after_stat(flow) == "to")) ## ----bar plot with negative observations-------------------------------------- set.seed(78) toy$sign <- sample(c(-1, 1), nrow(toy), replace = TRUE) print(toy) ggplot(toy, aes(x = collection, y = sign)) + geom_bar(aes(fill = class), stat = "identity") ## ----flows plot w/ negative strata-------------------------------------------- ggplot(toy, aes(x = collection, stratum = category, alluvium = subject, y = sign)) + geom_flow(aes(fill = class)) + geom_stratum() + geom_text(stat = "stratum", aes(label = category)) ## ----alluvia plot w/ negative strata------------------------------------------ ggplot(toy, aes(x = collection, stratum = category, alluvium = subject, y = sign)) + geom_alluvium(aes(fill = class), absolute = FALSE) + geom_stratum(absolute = FALSE) + geom_text(stat = "alluvium", aes(label = subject), absolute = FALSE) ## ----session info------------------------------------------------------------- sessioninfo::session_info() ggalluvial/inst/doc/labels.html0000644000176200001440000154210414372455314016272 0ustar liggesusers Labeling small strata

Labeling small strata

Jason Cory Brunson

2023-02-13

Setup

This brief vignette uses the vaccinations dataset included in {ggalluvial}. As in the technical introduction, the order of the levels is reversed to be more intuitive. Objects from other {ggplot2} extensions are accessed via :: and :::.

knitr::opts_chunk$set(fig.width = 6, fig.height = 4, fig.align = "center")
library(ggalluvial)
data(vaccinations)
vaccinations <- transform(vaccinations,
                          response = factor(response, rev(levels(response))))

Problem

The issue on the table: Strata are most helpful when they’re overlaid with text labels. Yet the strata often vary in height, and the labels in length, to such a degree that fitting the text inside the strata at a uniform size renders them illegible. In principle, the user could treat size as a variable aesthetic and manually fit text to strata, but this is cumbersome, and doesn’t help anyway in cases where large text is needed.

To illustrate the problem, check out the plot below. It’s by no means an egregious case, but it’ll do. (For a more practical example, see this question on StackOverflow, which prompted this vignette.)

ggplot(vaccinations,
       aes(x = survey, stratum = response, alluvium = subject, y = freq,
           fill = response, label = response)) +
  scale_x_discrete(expand = c(.1, 0)) +
  geom_flow(width = 1/4) +
  geom_stratum(alpha = .5, width = 1/4) +
  geom_text(stat = "stratum", size = 4) +
  theme(legend.position = "none") +
  ggtitle("vaccination survey responses", "labeled using `geom_text()`")

Fix

One option is to simply omit those labels that don’t fit within their strata. In response to an issue, v0.9.2 includes parameters in stat_stratum() to exclude strata outside a specified height range; while few would use this to omit the rectangles themselves, it can be used in tandem with geom_text() to shirk this problem, at least when the labels are concise:

ggplot(vaccinations,
       aes(x = survey, stratum = response, alluvium = subject, y = freq,
           fill = response, label = response)) +
  scale_x_discrete(expand = c(.1, 0)) +
  geom_flow(width = 1/4) +
  geom_stratum(alpha = .5, width = 1/4) +
  geom_text(stat = "stratum", size = 4, min.y = 100) +
  theme(legend.position = "none") +
  ggtitle(
    "vaccination survey responses",
    "labeled using `geom_text()` with `min.y = 100`"
  )

This is a useful fix for some cases. Still, if the goal is a publication-ready graphic, then it reaffirms the need for more adaptable and elegant solutions. Fortunately, two wonderful packages deliver with, shall we say, flowing colors.

Solutions

Two {ggplot2} extensions are well-suited to this problem: {ggrepel} and {ggfittext}. They provide new geom layers that use the output of existing stat layers to situate text: ggrepel::geom_text_repel() takes the same aesthetics as ggplot2::geom_text(), namely x, y, and label. In contrast, ggfittext::geom_fit_text() only specifically requires label but also needs enough information to determine the rectangle that will contain the text. This can be encoded as xmin and xmax or as x and width for the horizontal direction, and as ymin and ymax or as y and height for the vertical direction. Conveniently, ggalluvial::stat_stratum() produces more than enough information for both geoms, including x, xmin, xmax, and their vertical counterparts.

All this can be gleaned from the ggproto objects that construct the layers:

print(ggrepel::GeomTextRepel$required_aes)
## [1] "x"     "y"     "label"
print(ggfittext:::GeomFitText$required_aes)
## [1] "label"
print(ggfittext:::GeomFitText$setup_data)
## <ggproto method>
##   <Wrapper function>
##     function (...) 
## setup_data(...)
## 
##   <Inner function (f)>
##     function (data, params) 
## {
##     if (!(("xmin" %in% names(data) & "xmax" %in% names(data)) | 
##         ("x" %in% names(data)))) {
##         stop("geom_fit_text needs either 'xmin' and 'xmax', or 'x'", 
##             .call = FALSE)
##     }
##     if (!("ymin" %in% names(data) & "ymax" %in% names(data) | 
##         "y" %in% names(data))) {
##         stop("geom_fit_text needs either 'ymin' and 'ymax', or 'y'", 
##             .call = FALSE)
##     }
##     if ((!is.null(params$width)) & (!"unit" %in% class(params$width))) {
##         data$xmin <- data$x - params$width/2
##         data$xmax <- data$x + params$width/2
##     }
##     if ((!is.null(params$height)) & (!"unit" %in% class(params$height))) {
##         data$ymin <- data$y - params$height/2
##         data$ymax <- data$y + params$height/2
##     }
##     if (is.null(params$width) & !"xmin" %in% names(data)) {
##         data$width <- ggplot2::resolution(data$x, FALSE) * 0.9
##         data$xmin <- data$x - data$width/2
##         data$xmax <- data$x + data$width/2
##         data$width <- NULL
##     }
##     if (is.null(params$height) & !"ymin" %in% names(data)) {
##         data$height <- ggplot2::resolution(data$y, FALSE) * 0.9
##         data$ymin <- data$y - data$height/2
##         data$ymax <- data$y + data$height/2
##         data$height <- NULL
##     }
##     if (!is.null(params$formatter)) {
##         if (!is.function(params$formatter)) {
##             stop("`formatter` must be a function")
##         }
##         formatted_labels <- sapply(data$label, params$formatter, 
##             USE.NAMES = FALSE)
##         if ((!length(formatted_labels) == length(data$label)) | 
##             (!is.character(formatted_labels))) {
##             stop("`formatter` must produce a character vector of same length as input")
##         }
##         data$label <- formatted_labels
##     }
##     data
## }
print(StatStratum$compute_panel)
## <ggproto method>
##   <Wrapper function>
##     function (...) 
## compute_panel(..., self = self)
## 
##   <Inner function (f)>
##     function (self, data, scales, decreasing = NULL, reverse = NULL, 
##     absolute = NULL, discern = FALSE, distill = "first", negate.strata = NULL, 
##     infer.label = FALSE, label.strata = NULL, min.y = NULL, max.y = NULL, 
##     min.height = NULL, max.height = NULL) 
## {
##     if (is.null(decreasing)) 
##         decreasing <- ggalluvial_opt("decreasing")
##     if (is.null(reverse)) 
##         reverse <- ggalluvial_opt("reverse")
##     if (is.null(absolute)) 
##         absolute <- ggalluvial_opt("absolute")
##     if (!is.null(label.strata)) {
##         defunct_parameter("label.strata", msg = "use `aes(label = after_stat(stratum))`.")
##         infer.label <- label.strata
##     }
##     if (infer.label) {
##         deprecate_parameter("infer.label", msg = "Use `aes(label = after_stat(stratum))`.")
##         if (is.null(data$label)) {
##             data$label <- data$stratum
##         }
##         else {
##             warning("Aesthetic `label` is specified, ", "so parameter `infer.label` will be ignored.")
##         }
##     }
##     diff_aes <- intersect(c(.color_diff_aesthetics, .text_aesthetics), 
##         names(data))
##     data$yneg <- data$y < 0
##     data$lode <- data$alluvium
##     distill <- distill_fun(distill)
##     weight <- data$weight
##     data$weight <- NULL
##     if (is.null(weight)) 
##         weight <- 1
##     data$n <- weight
##     data$count <- data$y * weight
##     by_vars <- c("x", "yneg", "stratum")
##     only_vars <- c(diff_aes)
##     sum_vars <- c("y", "n", "count")
##     if (!is.null(data$lode)) {
##         agg_lode <- stats::aggregate(data[, "lode", drop = FALSE], 
##             data[, by_vars], distill)
##     }
##     if (length(only_vars) > 0) {
##         agg_only <- stats::aggregate(data[, only_vars, drop = FALSE], 
##             data[, by_vars], only)
##     }
##     data <- stats::aggregate(data[, sum_vars], data[, by_vars], 
##         sum)
##     if (!is.null(data$lode)) {
##         data <- merge(data, agg_lode)
##     }
##     if (length(only_vars) > 0) {
##         data <- merge(data, agg_only)
##     }
##     data <- subset(data, y != 0)
##     data <- deposit_data(data, decreasing, reverse, absolute)
##     x_sums <- tapply(abs(data$count), data$x, sum, na.rm = TRUE)
##     data$prop <- data$count/x_sums[match(as.character(data$x), 
##         names(x_sums))]
##     data <- data[with(data, order(deposit)), , drop = FALSE]
##     data$ycum <- NA
##     for (xx in unique(data$x)) {
##         for (yn in c(FALSE, TRUE)) {
##             ww <- which(data$x == xx & data$yneg == yn)
##             data$ycum[ww] <- cumulate(data$y[ww])
##         }
##     }
##     data$ymin <- data$ycum - abs(data$y)/2
##     data$ymax <- data$ycum + abs(data$y)/2
##     data$y <- data$ycum
##     data$yneg <- NULL
##     data$ycum <- NULL
##     if (!is.null(min.height)) {
##         deprecate_parameter("min.height", "min.y")
##         min.y <- min.height
##     }
##     if (!is.null(max.height)) {
##         deprecate_parameter("max.height", "max.y")
##         max.y <- max.height
##     }
##     if (!is.null(min.y)) 
##         data <- subset(data, ymax - ymin >= min.y)
##     if (!is.null(max.y)) 
##         data <- subset(data, ymax - ymin <= max.y)
##     data
## }

I reached the specific solutions through trial and error. They may not be the best tricks for most cases, but they demonstrate what these packages can do. For many more examples, see the respective package vignettes: for {ggrepel}, and for {ggfittext}.

Solution 1: {ggrepel}

{ggrepel} is most often (in my experience) used to repel text away from symbols in a scatterplot, in whatever directions prevent them from overlapping the symbols and each other. In this case, however, it makes much more sense to align them vertically a fixed horizontal distance (nudge_x) away from the strata and repel them vertically from each other (direction = "y") just enough to print them without overlap. It takes an extra bit of effort to render text only for the strata at the first (or at the last) axis, but the result is worth it.

ggplot(vaccinations,
       aes(x = survey, stratum = response, alluvium = subject, y = freq,
           fill = response)) +
  scale_x_discrete(expand = c(.4, 0)) +
  geom_flow(width = 1/4) +
  geom_stratum(alpha = .5, width = 1/4) +
  scale_linetype_manual(values = c("blank", "solid")) +
  ggrepel::geom_text_repel(
    aes(label = ifelse(as.numeric(survey) == 1, as.character(response), NA)),
    stat = "stratum", size = 4, direction = "y", nudge_x = -.5
  ) +
  ggrepel::geom_text_repel(
    aes(label = ifelse(as.numeric(survey) == 3, as.character(response), NA)),
    stat = "stratum", size = 4, direction = "y", nudge_x = .5
  ) +
  theme(legend.position = "none") +
  ggtitle("vaccination survey responses", "labeled using `geom_text_repel()`")
## Warning: Removed 8 rows containing missing values (`geom_text_repel()`).
## Removed 8 rows containing missing values (`geom_text_repel()`).

Solution 2: {ggfittext}

{ggfittext} is simplicity itself: The strata are just rectangles, so no more parameter specifications are necessary to fit the text into them. One key parameter is min.size, which defaults to 4 and controls how small the text is allowed to get without being omitted.

ggplot(vaccinations,
       aes(x = survey, stratum = response, alluvium = subject, y = freq,
           fill = response, label = response)) +
  scale_x_discrete(expand = c(.1, 0)) +
  geom_flow(width = 1/4) +
  geom_stratum(alpha = .5, width = 1/4) +
  ggfittext::geom_fit_text(stat = "stratum", width = 1/4, min.size = 3) +
  theme(legend.position = "none") +
  ggtitle("vaccination survey responses", "labeled using `geom_fit_text()`")

Note that this solution requires {ggfittext} v0.6.0.

Appendix

sessioninfo::session_info()
## ─ Session info ───────────────────────────────────────────────────────────────
##  setting  value
##  version  R version 4.2.1 (2022-06-23)
##  os       macOS Catalina 10.15.7
##  system   x86_64, darwin17.0
##  ui       X11
##  language (EN)
##  collate  C
##  ctype    en_US.UTF-8
##  tz       America/New_York
##  date     2023-02-13
##  pandoc   2.19.2 @ /Applications/RStudio.app/Contents/Resources/app/quarto/bin/tools/ (via rmarkdown)
## 
## ─ Packages ───────────────────────────────────────────────────────────────────
##  package      * version date (UTC) lib source
##  bslib          0.4.2   2022-12-16 [3] CRAN (R 4.2.0)
##  cachem         1.0.6   2021-08-19 [3] CRAN (R 4.2.0)
##  cli            3.6.0   2023-01-09 [3] CRAN (R 4.2.0)
##  colorspace     2.1-0   2023-01-23 [3] CRAN (R 4.2.0)
##  digest         0.6.31  2022-12-11 [3] CRAN (R 4.2.0)
##  dplyr          1.1.0   2023-01-29 [3] CRAN (R 4.2.0)
##  evaluate       0.20    2023-01-17 [3] CRAN (R 4.2.0)
##  fansi          1.0.4   2023-01-22 [3] CRAN (R 4.2.0)
##  farver         2.1.1   2022-07-06 [3] CRAN (R 4.2.0)
##  fastmap        1.1.0   2021-01-25 [3] CRAN (R 4.2.0)
##  generics       0.1.3   2022-07-05 [3] CRAN (R 4.2.0)
##  ggalluvial   * 0.12.5  2023-02-13 [1] local
##  ggfittext      0.9.1   2021-01-30 [3] CRAN (R 4.2.0)
##  ggplot2      * 3.4.0   2022-11-04 [3] CRAN (R 4.2.1)
##  ggrepel        0.9.3   2023-02-03 [3] CRAN (R 4.2.0)
##  glue           1.6.2   2022-02-24 [3] CRAN (R 4.2.0)
##  gtable         0.3.1   2022-09-01 [3] CRAN (R 4.2.0)
##  highr          0.10    2022-12-22 [3] CRAN (R 4.2.0)
##  htmltools      0.5.4   2022-12-07 [3] CRAN (R 4.2.0)
##  jquerylib      0.1.4   2021-04-26 [3] CRAN (R 4.2.0)
##  jsonlite       1.8.4   2022-12-06 [3] CRAN (R 4.2.0)
##  knitr          1.42    2023-01-25 [3] CRAN (R 4.2.0)
##  labeling       0.4.2   2020-10-20 [3] CRAN (R 4.2.0)
##  lifecycle      1.0.3   2022-10-07 [3] CRAN (R 4.2.0)
##  magrittr       2.0.3   2022-03-30 [3] CRAN (R 4.2.0)
##  munsell        0.5.0   2018-06-12 [3] CRAN (R 4.2.0)
##  pillar         1.8.1   2022-08-19 [3] CRAN (R 4.2.0)
##  pkgconfig      2.0.3   2019-09-22 [3] CRAN (R 4.2.0)
##  purrr          1.0.1   2023-01-10 [3] CRAN (R 4.2.0)
##  R6             2.5.1   2021-08-19 [3] CRAN (R 4.2.0)
##  RColorBrewer   1.1-3   2022-04-03 [3] CRAN (R 4.2.0)
##  Rcpp           1.0.10  2023-01-22 [3] CRAN (R 4.2.1)
##  rlang          1.0.6   2022-09-24 [3] CRAN (R 4.2.0)
##  rmarkdown      2.20    2023-01-19 [3] CRAN (R 4.2.0)
##  rstudioapi     0.14    2022-08-22 [3] CRAN (R 4.2.0)
##  sass           0.4.5   2023-01-24 [3] CRAN (R 4.2.0)
##  scales         1.2.1   2022-08-20 [3] CRAN (R 4.2.0)
##  sessioninfo    1.2.2   2021-12-06 [3] CRAN (R 4.2.0)
##  stringi        1.7.12  2023-01-11 [3] CRAN (R 4.2.0)
##  tibble         3.1.8   2022-07-22 [3] CRAN (R 4.2.0)
##  tidyr          1.3.0   2023-01-24 [3] CRAN (R 4.2.0)
##  tidyselect     1.2.0   2022-10-10 [3] CRAN (R 4.2.0)
##  utf8           1.2.3   2023-01-31 [3] CRAN (R 4.2.1)
##  vctrs          0.5.2   2023-01-23 [3] CRAN (R 4.2.0)
##  withr          2.5.0   2022-03-03 [3] CRAN (R 4.2.0)
##  xfun           0.37    2023-01-31 [3] CRAN (R 4.2.1)
##  yaml           2.3.7   2023-01-23 [3] CRAN (R 4.2.0)
## 
##  [1] /private/var/folders/k6/l4mq9ctj3219429xnvqpdbxm8tckkx/T/Rtmp9fMfyT/Rinst61ce73b51348
##  [2] /private/var/folders/k6/l4mq9ctj3219429xnvqpdbxm8tckkx/T/RtmplDE0GG/temp_libpath60ab25e50e46
##  [3] /Library/Frameworks/R.framework/Versions/4.2/Resources/library
## 
## ──────────────────────────────────────────────────────────────────────────────
ggalluvial/inst/doc/shiny.R0000644000176200001440000002015714372455322015414 0ustar liggesusers## ----setup, echo = FALSE, message = FALSE, warning = FALSE-------------------- knitr::opts_chunk$set(fig.width = 6, fig.height = 3, fig.align = "center") library(ggalluvial) pdf(NULL) ## ----run wide app locally, eval = FALSE--------------------------------------- # shiny::shinyAppDir(system.file("examples/ex-shiny-wide-data", package="ggalluvial")) ## ----pseudocode, eval = FALSE------------------------------------------------- # # '<(1) Load data.>' # # '<(2) Create "ggplot" object for alluvial plot and build it.>' # # '<(3) Extract data from built plot object used to create alluvium polygons.>' # # for (polygon in polygons) { # '<(4) Use polygon splines to generate coordinates of alluvium boundaries.>' # } # # '<(5) Define range of coordinates in grid units and plot units.>' # # for (polygon in polygons) { # '<(6) Convert coordinates from grid units to plot units.>' # } # # ui <- fluidPage( # '<(7) Output plot with hovering enabled.>' # # '<(8) Output tooltip.>' # ) # # # server <- function(input, output, session) { # # output$alluvial_plot <- renderPlot({ # '<(9) Render the plot.>' # }) # # output$tooltip <- renderText({ # if ('<(10) mouse cursor is within the plot panel>') { # if ('<(11) mouse cursor is within a stratum box>') { # '<(11b) Render stratum tooltip.>' # } else { # if ('<(12) mouse cursor is within an alluvium polygon>') { # '<(12b) Render alluvium tooltip.>' # } # } # } # }) # # } ## ----load dataset, eval = FALSE----------------------------------------------- # data(UCBAdmissions) # ucb_admissions <- as.data.frame(UCBAdmissions) ## ----set options, eval = FALSE------------------------------------------------ # # Offset, in pixels, for location of tooltip relative to mouse cursor, # # in both x and y direction. # offset <- 5 # # Width of node boxes # node_width <- 1/4 # # Width of alluvia # alluvium_width <- 1/3 ## ----draw and build plot, eval = FALSE---------------------------------------- # # Draw plot. # p <- ggplot(ucb_admissions, # aes(y = Freq, axis1 = Gender, axis2 = Dept)) + # geom_alluvium(aes(fill = Admit), knot.pos = 1/4, width = alluvium_width) + # geom_stratum(width = node_width, reverse = TRUE, fill = 'black', color = 'grey') + # geom_label(aes(label = after_stat(stratum)), # stat = "stratum", # reverse = TRUE, # size = rel(2)) + # theme_bw() + # scale_fill_brewer(type = "qual", palette = "Set1") + # scale_x_discrete(limits = c("Gender", "Dept"), expand = c(.05, .05)) + # scale_y_continuous(expand = c(0, 0)) + # ggtitle("UC Berkeley admissions and rejections", "by sex and department") + # theme(plot.title = element_text(size = rel(1)), # plot.subtitle = element_text(size = rel(1)), # legend.position = 'bottom') # # # Build the plot. # pbuilt <- ggplot_build(p) ## ----get xsplines and draw curves, eval = FALSE------------------------------- # # Add width parameter, and then convert built plot data to xsplines # data_draw <- transform(pbuilt$data[[1]], width = alluvium_width) # groups_to_draw <- split(data_draw, data_draw$group) # group_xsplines <- lapply(groups_to_draw, # data_to_alluvium) # # # Convert xspline coordinates to grid object. # xspline_coords <- lapply( # group_xsplines, # function(coords) grid::xsplineGrob(x = coords$x, # y = coords$y, # shape = coords$shape, # open = FALSE) # ) # # # Use grid::xsplinePoints to draw the curve for each polygon # xspline_points <- lapply(xspline_coords, grid::xsplinePoints) ## ----get coordinate ranges, eval = FALSE-------------------------------------- # # Define the x and y axis limits in grid coordinates (old) and plot # # coordinates (new) # xrange_old <- range(unlist(lapply( # xspline_points, # function(pts) as.numeric(pts$x) # ))) # yrange_old <- range(unlist(lapply( # xspline_points, # function(pts) as.numeric(pts$y) # ))) # xrange_new <- c(1 - alluvium_width/2, max(pbuilt$data[[1]]$x) + alluvium_width/2) # yrange_new <- c(0, sum(pbuilt$data[[2]]$count[pbuilt$data[[2]]$x == 1])) ## ----transform coordinates, eval = FALSE-------------------------------------- # # Define function to convert grid graphics coordinates to data coordinates # new_range_transform <- function(x_old, range_old, range_new) { # (x_old - range_old[1])/(range_old[2] - range_old[1]) * # (range_new[2] - range_new[1]) + range_new[1] # } # # # Using the x and y limits, convert the grid coordinates into plot coordinates. # polygon_coords <- lapply(xspline_points, function(pts) { # x_trans <- new_range_transform(x_old = as.numeric(pts$x), # range_old = xrange_old, # range_new = xrange_new) # y_trans <- new_range_transform(x_old = as.numeric(pts$y), # range_old = yrange_old, # range_new = yrange_new) # list(x = x_trans, y = y_trans) # }) ## ----ui, eval = FALSE--------------------------------------------------------- # ui <- fluidPage( # fluidRow(tags$div( # style = "position: relative;", # plotOutput("alluvial_plot", height = "650px", # hover = hoverOpts(id = "plot_hover") # ), # htmlOutput("tooltip"))) # ) ## ----renderPlot, eval = FALSE------------------------------------------------- # output$alluvial_plot <- renderPlot(p, res = 200) ## ---- eval = FALSE------------------------------------------------------------ # output$tooltip <- renderText( # if(!is.null(input$plot_hover)) { ... } # ... # ) ## ---- eval = FALSE------------------------------------------------------------ # hover <- input$plot_hover # x_coord <- round(hover$x) # # if(abs(hover$x - x_coord) < (node_width / 2)) { ... } else { ... } ## ---- eval = FALSE------------------------------------------------------------ # node_row <- # pbuilt$data[[2]]$x == x_coord & hover$y > pbuilt$data[[2]]$ymin & hover$y < pbuilt$data[[2]]$ymax ## ---- eval = FALSE------------------------------------------------------------ # node_label <- pbuilt$data[[2]]$stratum[node_row] # node_n <- pbuilt$data[[2]]$count[node_row] ## ----render strata tooltip, eval = FALSE-------------------------------------- # renderTags( # tags$div( # node_label, tags$br(), # "n =", node_n, # style = paste0( # "position: absolute; ", # "top: ", hover$coords_css$y + offset, "px; ", # "left: ", hover$coords_css$x + offset, "px; ", # "background: gray; ", # "padding: 3px; ", # "color: white; " # ) # ) # )$html ## ----test within polygon, eval = FALSE---------------------------------------- # hover_within_flow <- sapply( # polygon_coords, # function(pol) point.in.polygon(point.x = hover$x, # point.y = hover$y, # pol.x = pol$x, # pol.y = pol$y) # ) ## ---- eval = FALSE------------------------------------------------------------ # if (any(hover_within_flow)) { ... } ## ----info for alluvia tooltip, eval = FALSE----------------------------------- # coord_id <- rev(which(hover_within_flow == 1))[1] # flow_label <- paste(groups_to_draw[[coord_id]]$stratum, collapse = ' -> ') # flow_n <- groups_to_draw[[coord_id]]$count[1] ## ----render alluvia tooltip, eval = FALSE------------------------------------- # renderTags( # tags$div( # flow_label, tags$br(), # "n =", flow_n, # style = paste0( # "position: absolute; ", # "top: ", hover$coords_css$y + offset, "px; ", # "left: ", hover$coords_css$x + offset, "px; ", # "background: gray; ", # "padding: 3px; ", # "color: white; " # ) # ) # )$html ## ----run long app locally, eval = FALSE--------------------------------------- # shiny::shinyAppDir(system.file("examples/ex-shiny-long-data", package="ggalluvial")) ggalluvial/inst/doc/ggalluvial.rmd0000644000176200001440000004061114367761414016775 0ustar liggesusers--- title: "Alluvial Plots in ggplot2" author: "Jason Cory Brunson" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{alluvial plots in ggplot2} %\VignetteEngine{knitr::rmarkdown} \usepackage[utf8]{inputenc} --- The {ggalluvial} package is a {ggplot2} extension for producing alluvial plots in a [{tidyverse}](https://github.com/tidyverse) framework. The design and functionality were originally inspired by the [{alluvial}](https://github.com/mbojan/alluvial) package and have benefitted from the feedback of many users. This vignette - defines the essential components of alluvial plots as used in the naming schemes and documentation (_axis_, _alluvium_, _stratum_, _lode_, _flow_), - describes the alluvial data structures recognized by {ggalluvial}, - illustrates the new stats and geoms, and - showcases some popular variants on the theme and how to produce them. Unlike most alluvial and related diagrams, the plots produced by {ggalluvial} are uniquely determined by the data set and statistical transformation. The distinction is detailed in [this blog post](https://corybrunson.github.io/2019/09/13/flow-taxonomy/). Many other resources exist for visualizing categorical data in R, including several more basic plot types that are likely to more accurately convey proportions to viewers when the data are not so structured as to warrant an alluvial plot. In particular, check out Michael Friendly's [{vcd} and {vcdExtra} packages](https://friendly.github.io/vcdExtra/) for a variety of statistically-motivated categorical data visualization techniques, Hadley Wickham's [{productplots} package](https://github.com/hadley/productplots) and Haley Jeppson and Heike Hofmann's descendant [{ggmosaic} package](https://CRAN.R-project.org/package=ggmosaic/vignettes/ggmosaic.html) for product or mosaic plots, and Nicholas Hamilton's [{ggtern} package](http://www.ggtern.com/) for ternary coordinates. Other related packages are mentioned below. ```{r setup, echo=FALSE, message=FALSE, results='hide'} library(ggalluvial) knitr::opts_chunk$set(fig.width = 6, fig.height = 4, fig.align = "center") ``` ## Alluvial plots Here's a quintessential alluvial plot: ```{r example alluvial plot using Titanic dataset, echo=FALSE} ggplot(data = to_lodes_form(as.data.frame(Titanic), key = "Demographic", axes = 1:3), aes(x = Demographic, stratum = stratum, alluvium = alluvium, y = Freq, label = stratum)) + scale_x_discrete(expand = c(.05, .05)) + geom_alluvium(aes(fill = Survived)) + geom_stratum() + geom_text(stat = "stratum") + ggtitle("passengers on the maiden voyage of the Titanic", "stratified by demographics and survival") ``` The next section details how the elements of this image encode information about the underlying dataset. For now, we use the image as a point of reference to define the following elements of a typical alluvial plot: - An _axis_ is a dimension (variable) along which the data are vertically arranged at a fixed horizontal position. The plot above uses three categorical axes: `Class`, `Sex`, and `Age`. - The groups at each axis are depicted as opaque blocks called _strata_. For example, the `Class` axis contains four strata: `1st`, `2nd`, `3rd`, and `Crew`. - Horizontal (x-) splines called _alluvia_ span the width of the plot. In this plot, each alluvium corresponds to a fixed value of each axis variable, indicated by its vertical position at the axis, as well as of the `Survived` variable, indicated by its fill color. - The segments of the alluvia between pairs of adjacent axes are _flows_. - The alluvia intersect the strata at _lodes_. The lodes are not visualized in the above plot, but they can be inferred as filled rectangles extending the flows through the strata at each end of the plot or connecting the flows on either side of the center stratum. As the examples in the next section will demonstrate, which of these elements are incorporated into an alluvial plot depends on both how the underlying data is structured and what the creator wants the plot to communicate. ## Alluvial data {ggalluvial} recognizes two formats of "alluvial data", treated in detail in the following subsections, but which basically correspond to the "wide" and "long" formats of categorical repeated measures data. A third, tabular (or array), form is popular for storing data with multiple categorical dimensions, such as the `Titanic` and `UCBAdmissions` datasets.[^tableform] For consistency with tidy data principles and {ggplot2} conventions, {ggalluvial} does not accept tabular input; `base::as.data.frame()` converts such an array to an acceptable data frame. [^tableform]: See Friendly's tutorial, linked above, for a discussion. ### Alluvia (wide) format The wide format reflects the visual arrangement of an alluvial plot, but "untwisted": Each row corresponds to a cohort of observations that take a specific value at each variable, and each variable has its own column. An additional column contains the quantity of each row, e.g. the number of observational units in the cohort, which may be used to control the heights of the strata.[^weight-y] Basically, the wide format consists of _one row per alluvium_. This is the format into which the base function `as.data.frame()` transforms a frequency table, for instance the 3-dimensional `UCBAdmissions` dataset: ```{r alluvia format of Berkeley admissions dataset} head(as.data.frame(UCBAdmissions), n = 12) is_alluvia_form(as.data.frame(UCBAdmissions), axes = 1:3, silent = TRUE) ``` This format is inherited from the first release of {ggalluvial}, which modeled it after usage in {alluvial}: The user declares any number of axis variables, which `stat_alluvium()` and `stat_stratum()` recognize and process in a consistent way: ```{r alluvial plot of UC Berkeley admissions dataset} ggplot(as.data.frame(UCBAdmissions), aes(y = Freq, axis1 = Gender, axis2 = Dept)) + geom_alluvium(aes(fill = Admit), width = 1/12) + geom_stratum(width = 1/12, fill = "black", color = "grey") + geom_label(stat = "stratum", aes(label = after_stat(stratum))) + scale_x_discrete(limits = c("Gender", "Dept"), expand = c(.05, .05)) + scale_fill_brewer(type = "qual", palette = "Set1") + ggtitle("UC Berkeley admissions and rejections, by sex and department") ``` An important feature of these plots is the meaningfulness of the vertical axis: No gaps are inserted between the strata, so the total height of the plot reflects the cumulative quantity of the observations. The plots produced by {ggalluvial} conform (somewhat; keep reading) to the "grammar of graphics" principles of {ggplot2}, and this prevents users from producing "free-floating" visualizations like the Sankey diagrams showcased [here](https://developers.google.com/chart/interactive/docs/gallery/sankey).[^ggforce] {ggalluvial} parameters and native {ggplot2} functionality can also produce [parallel sets](https://eagereyes.org/parallel-sets) plots, illustrated here using the `HairEyeColor` dataset:[^ggparallel][^crayola] [^ggforce]: [The {ggforce} package](https://github.com/thomasp85/ggforce) includes parallel set geom and stat layers to produce similar diagrams that can be allowed to free-float. [^ggparallel]: A greater variety of parallel sets plots are implemented in the [{ggparallel}](https://github.com/heike/ggparallel) and [{ggpcp}](https://github.com/yaweige/ggpcp) packages. [^crayola]: Eye color hex codes are taken from [Crayola's Colors of the World crayons](https://en.wikipedia.org/wiki/List_of_Crayola_crayon_colors). ```{r parallel sets plot of hair and eye color dataset} ggplot(as.data.frame(HairEyeColor), aes(y = Freq, axis1 = Hair, axis2 = Eye, axis3 = Sex)) + geom_alluvium(aes(fill = Eye), width = 1/8, knot.pos = 0, reverse = FALSE) + scale_fill_manual(values = c(Brown = "#70493D", Hazel = "#E2AC76", Green = "#3F752B", Blue = "#81B0E4")) + guides(fill = "none") + geom_stratum(alpha = .25, width = 1/8, reverse = FALSE) + geom_text(stat = "stratum", aes(label = after_stat(stratum)), reverse = FALSE) + scale_x_continuous(breaks = 1:3, labels = c("Hair", "Eye", "Sex")) + coord_flip() + ggtitle("Eye colors of 592 subjects, by sex and hair color") ``` (The warning is due to the "Hair" and "Eye" axes having the value "Brown" in common.) This format and functionality are useful for many applications and will be retained in future versions. They also involve some conspicuous deviations from {ggplot2} norms: - The `axis[0-9]*` position aesthetics are non-standard: they are not an explicit set of parameters but a family based on a regular expression pattern; and at least one, but no specific one, is required. - `stat_alluvium()` ignores any argument to the `group` aesthetic; instead, `StatAlluvium$compute_panel()` uses `group` to link the rows of the internally-transformed dataset that correspond to the same alluvium. - The horizontal axis must be manually corrected (using `scale_x_discrete()` or `scale_x_continuous()`) to reflect the implicit categorical variable identifying the axis. Furthermore, format aesthetics like `fill` are necessarily fixed for each alluvium; they cannot, for example, change from axis to axis according to the value taken at each. This means that, although they can reproduce the branching-tree structure of parallel sets, this format cannot be used to produce alluvial plots with color schemes such as those featured [here](https://developers.google.com/chart/interactive/docs/gallery/sankey) ("Controlling colors"), which are "reset" at each axis. Note also that the `stratum` variable produced by `stat_stratum()` (called by `geom_text()`) is computed during the statistical transformation and must be recovered using `after_stat()` as a [calculated aesthetic](https://corybrunson.github.io/2020/04/17/calculate-aesthetics/). ### Lodes (long) format The long format recognized by {ggalluvial} contains _one row per lode_, and can be understood as the result of "gathering" (in a deprecated {dplyr} sense) or "pivoting" (in the Microsoft Excel or current {dplyr} sense) the axis columns of a dataset in the alluvia format into a key-value pair of columns encoding the axis as the key and the stratum as the value. This format requires an additional indexing column that links the rows corresponding to a common cohort, i.e. the lodes of a single alluvium: ```{r lodes format of Berkeley admissions dataset} UCB_lodes <- to_lodes_form(as.data.frame(UCBAdmissions), axes = 1:3, id = "Cohort") head(UCB_lodes, n = 12) is_lodes_form(UCB_lodes, key = x, value = stratum, id = Cohort, silent = TRUE) ``` The functions that convert data between wide (alluvia) and long (lodes) format include several parameters that help preserve ancillary information. See `help("alluvial-data")` for examples. The same stat and geom can receive data in this format using a different set of positional aesthetics, also specific to {ggalluvial}: - `x`, the "key" variable indicating the axis to which the row corresponds, which are to be arranged along the horizontal axis; - `stratum`, the "value" taken by the axis variable indicated by `x`; and - `alluvium`, the indexing scheme that links the rows of a single alluvium. Heights can vary from axis to axis, allowing users to produce bump charts like those showcased [here](https://imgur.com/gallery/gI5p7).[^geom-area] In these cases, the strata contain no more information than the alluvia and often are not plotted. For convenience, both `stat_alluvium()` and `stat_flow()` will accept arguments for `x` and `alluvium` even if none is given for `stratum`.[^arguments] As an example, we can group countries in the `Refugees` dataset by region, in order to compare refugee volumes at different scales: [^geom-area]: If bumping is unnecessary, consider using [`geom_area()`](https://r-graph-gallery.com/136-stacked-area-chart) instead. [^arguments]: `stat_stratum()` will similarly accept arguments for `x` and `stratum` without `alluvium`. If both strata and either alluvia or flows are to be plotted, though, all three parameters need arguments. ```{r time series alluvia plot of refugees dataset} data(Refugees, package = "alluvial") country_regions <- c( Afghanistan = "Middle East", Burundi = "Central Africa", `Congo DRC` = "Central Africa", Iraq = "Middle East", Myanmar = "Southeast Asia", Palestine = "Middle East", Somalia = "Horn of Africa", Sudan = "Central Africa", Syria = "Middle East", Vietnam = "Southeast Asia" ) Refugees$region <- country_regions[Refugees$country] ggplot(data = Refugees, aes(x = year, y = refugees, alluvium = country)) + geom_alluvium(aes(fill = country, colour = country), alpha = .75, decreasing = FALSE) + scale_x_continuous(breaks = seq(2003, 2013, 2)) + theme_bw() + theme(axis.text.x = element_text(angle = -30, hjust = 0)) + scale_fill_brewer(type = "qual", palette = "Set3") + scale_color_brewer(type = "qual", palette = "Set3") + facet_wrap(~ region, scales = "fixed") + ggtitle("refugee volume by country and region of origin") ``` The format allows us to assign aesthetics that change from axis to axis along the same alluvium, which is useful for repeated measures datasets. This requires generating a separate graphical object for each flow, as implemented in `geom_flow()`. The plot below uses a set of (changes to) students' academic curricula over the course of several semesters. Since `geom_flow()` calls `stat_flow()` by default (see the next example), we override it with `stat_alluvium()` in order to track each student across all semesters: ```{r alluvial plot of majors dataset} data(majors) majors$curriculum <- as.factor(majors$curriculum) ggplot(majors, aes(x = semester, stratum = curriculum, alluvium = student, fill = curriculum, label = curriculum)) + scale_fill_brewer(type = "qual", palette = "Set2") + geom_flow(stat = "alluvium", lode.guidance = "frontback", color = "darkgray") + geom_stratum() + theme(legend.position = "bottom") + ggtitle("student curricula across several semesters") ``` The stratum heights `y` are unspecified, so each row is given unit height. This example demonstrates one way {ggalluvial} handles missing data. The alternative is to set the parameter `na.rm` to `TRUE`.[^na.rm] Missing data handling (specifically, the order of the strata) also depends on whether the `stratum` variable is character or factor/numeric. [^na.rm]: Be sure to set `na.rm` consistently in each layer, in this case both the flows and the strata. Finally, lode format gives us the option to aggregate the flows between adjacent axes, which may be appropriate when the transitions between adjacent axes are of primary importance. We can demonstrate this option on data from the influenza vaccination surveys conducted by the [RAND American Life Panel](https://alpdata.rand.org/). The data, including one question from each of three surveys, has been aggregated by response profile: Each "subject" (mapped to `alluvium`) actually represents a cohort of subjects who responded the same way on all three questions, and the size of each cohort (mapped to `y`) is recorded in "freq". ```{r alluvial plot of vaccinations dataset} data(vaccinations) vaccinations <- transform(vaccinations, response = factor(response, rev(levels(response)))) ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response, label = response)) + scale_x_discrete(expand = c(.1, .1)) + geom_flow() + geom_stratum(alpha = .5) + geom_text(stat = "stratum", size = 3) + theme(legend.position = "none") + ggtitle("vaccination survey responses at three points in time") ``` This plot ignores any continuity between the flows between axes. This "memoryless" statistical transformation yields a less cluttered plot, in which at most one flow proceeds from each stratum at one axis to each stratum at the next, but at the cost of being able to track each cohort across the entire plot. ## Appendix ```{r session info} sessioninfo::session_info() ``` [^weight-y]: Previously, quantities were passed to the `weight` aesthetic rather than to `y`. This prevented `scale_y_continuous()` from correctly transforming scales, and anyway it was inconsistent with the behavior of `geom_bar()`. As of version 0.12.0, `weight` is an optional parameter used only by computed variables intended for labeling, not by polygonal graphical elements. ggalluvial/inst/doc/labels.R0000644000176200001440000000573714372455314015534 0ustar liggesusers## ----setup-------------------------------------------------------------------- knitr::opts_chunk$set(fig.width = 6, fig.height = 4, fig.align = "center") library(ggalluvial) data(vaccinations) vaccinations <- transform(vaccinations, response = factor(response, rev(levels(response)))) ## ----raw---------------------------------------------------------------------- ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response, label = response)) + scale_x_discrete(expand = c(.1, 0)) + geom_flow(width = 1/4) + geom_stratum(alpha = .5, width = 1/4) + geom_text(stat = "stratum", size = 4) + theme(legend.position = "none") + ggtitle("vaccination survey responses", "labeled using `geom_text()`") ## ----omit--------------------------------------------------------------------- ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response, label = response)) + scale_x_discrete(expand = c(.1, 0)) + geom_flow(width = 1/4) + geom_stratum(alpha = .5, width = 1/4) + geom_text(stat = "stratum", size = 4, min.y = 100) + theme(legend.position = "none") + ggtitle( "vaccination survey responses", "labeled using `geom_text()` with `min.y = 100`" ) ## ----aesthetics--------------------------------------------------------------- print(ggrepel::GeomTextRepel$required_aes) print(ggfittext:::GeomFitText$required_aes) print(ggfittext:::GeomFitText$setup_data) print(StatStratum$compute_panel) ## ----ggrepel------------------------------------------------------------------ ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + scale_x_discrete(expand = c(.4, 0)) + geom_flow(width = 1/4) + geom_stratum(alpha = .5, width = 1/4) + scale_linetype_manual(values = c("blank", "solid")) + ggrepel::geom_text_repel( aes(label = ifelse(as.numeric(survey) == 1, as.character(response), NA)), stat = "stratum", size = 4, direction = "y", nudge_x = -.5 ) + ggrepel::geom_text_repel( aes(label = ifelse(as.numeric(survey) == 3, as.character(response), NA)), stat = "stratum", size = 4, direction = "y", nudge_x = .5 ) + theme(legend.position = "none") + ggtitle("vaccination survey responses", "labeled using `geom_text_repel()`") ## ----ggfittext---------------------------------------------------------------- ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response, label = response)) + scale_x_discrete(expand = c(.1, 0)) + geom_flow(width = 1/4) + geom_stratum(alpha = .5, width = 1/4) + ggfittext::geom_fit_text(stat = "stratum", width = 1/4, min.size = 3) + theme(legend.position = "none") + ggtitle("vaccination survey responses", "labeled using `geom_fit_text()`") ## ----session info------------------------------------------------------------- sessioninfo::session_info() ggalluvial/inst/doc/order-rectangles.html0000644000176200001440000217156414372455322020300 0ustar liggesusers The Order of the Rectangles

The Order of the Rectangles

Jason Cory Brunson

2023-02-13

How the strata and lodes at each axis are ordered, and how to control their order, is a complicated but essential part of {ggalluvial}’s functionality. This vignette explains the motivations behind the implementation and explores the functionality in greater detail than the examples.

Setup

knitr::opts_chunk$set(fig.width = 6, fig.height = 3, fig.align = "center")
library(ggalluvial)

All of the functionality discussed in this vignette is exported by {ggalluvial}. We’ll also need a toy data set to play with. I conjured the data frame toy to be nearly as small as possible while complex enough to illustrate the positional controls:

# toy data set
set.seed(0)
toy <- data.frame(
  subject = rep(LETTERS[1:5], times = 4),
  collection = rep(1:4, each  = 5),
  category = rep(
    sample(c("X", "Y"), 16, replace = TRUE),
    rep(c(1, 2, 1, 1), times = 4)
  ),
  class = c("one", "one", "one", "two", "two")
)
print(toy)
##    subject collection category class
## 1        A          1        Y   one
## 2        B          1        X   one
## 3        C          1        X   one
## 4        D          1        Y   two
## 5        E          1        X   two
## 6        A          2        X   one
## 7        B          2        Y   one
## 8        C          2        Y   one
## 9        D          2        X   two
## 10       E          2        X   two
## 11       A          3        X   one
## 12       B          3        Y   one
## 13       C          3        Y   one
## 14       D          3        Y   two
## 15       E          3        X   two
## 16       A          4        X   one
## 17       B          4        X   one
## 18       C          4        X   one
## 19       D          4        X   two
## 20       E          4        X   two

The subjects are classified into categories at each collection point but are also members of fixed classes. Here’s how {ggalluvial} visualizes these data under default settings:

ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) +
  geom_alluvium(aes(fill = class)) +
  geom_stratum()

Motivations

The amount of control the stat layers stat_alluvial() and stat_flow() exert over the positional aesthetics of graphical objects (grobs) is unusual, by the standards of {ggplot2} and many of its extensions. In the layered grammar of graphics framework, the role of a statistical transformation is usually to summarize the original data, for example by binning (stat_bin()) or by calculating quantiles (stat_qq()). These transformed data are then sent to geom layers for positioning. The positions of grobs may be adjusted after the statistical transformation, for example when points are jittered (geom_jitter()), but the numerical data communicated by the plot are still the product of the stat.

In {ggalluvial}, the stat layers exert slightly more control. For one thing, the transformation is more sophisticated than a single value or a fixed-length vector, such as a mean, standard deviation, or five-number summary. Instead, the values of y (which default to 1) within each collection are, after reordering, transformed using cumsum() and some additional arithmetic to obtain coordinates for the centers y and lower and upper limits ymin and ymax of the strata representing the categories. Additionally, the reordering of lodes within each collection relies on a hierarchy of sorting variables, based on the strata at nearby axes as well as the present one and, optionally, on the values of differentiation aesthetics like fill. How this hierarchy is invoked depends on the choices of several plotting parameters (decreasing, reverse, and absolute). Thus, the results of the statistical transformations are not as intrinsically meaningful as others and are subject to much more intervention by the user. Only once the transformations have produced these coordinates do the geom layers use them to position the rectangles and splines that constitute the plot.

There are two key reasons for this division of labor:

  1. The coordinates returned by some stat layers can be coupled with multiple geom layers. For example, all four geoms can couple with the alluvium stat. Moreover, as showcased in the examples, the stats can also meaningfully couple with exogenous geoms like text, pointrange, and errorbar. (In principle, the geoms could also couple with exogenous stats, but i haven’t done this or seen it done in the wild.)
  2. Different parameters control the calculations of the coordinates (e.g. aes.bind and cement.alluvia) and the rendering of the graphical elements (width, knot.pos, and aes.flow), and it makes intuitive sense to handle these separately. For example, the heights of the strata and lodes convey information about the underlying data, whereas their widths are arbitrary.

(If the data are provided in alluvia format, then Stat*$setup_data() converts them to lodes format in preparation for the main transformation. This can be done manually using the exported conversion functions, and this vignette will assume the data are already in lodes format.)

Positioning strata

Each stat layer demarcates one stack for each data collection point and one rectangle within each stack for each (non-empty) category.1 In {ggalluvial} terms, the collection points are axes and the rectangles are strata or lodes.

To generate a sequence of stacked bar plots with no connecting flows, only the aesthetics x (standard) and stratum (custom) are required:

# collection point and category variables only
data <- structure(toy[, 2:3], names = c("x", "stratum"))
# required fields for stat transformations
data$y <- 1
data$PANEL <- 1
# stratum transformation
StatStratum$compute_panel(data)
##   x stratum   y n count deposit prop ymin ymax
## 2 1       Y 1.0 2     2       1  0.4    0    2
## 1 1       X 3.5 3     3       2  0.6    2    5
## 4 2       Y 1.0 2     2       3  0.4    0    2
## 3 2       X 3.5 3     3       4  0.6    2    5
## 6 3       Y 1.5 3     3       5  0.6    0    3
## 5 3       X 4.0 2     2       6  0.4    3    5
## 7 4       X 2.5 5     5       7  1.0    0    5

Comparing this output to toy, notice first that the data have been aggregated: Each distinct combination of x and stratum occupies only one row. x encodes the axes and is subject to layers specific to this positional aesthetic, e.g. scale_x_*() transformations. ymin and ymax are the lower and upper bounds of the rectangles, and y is their vertical centers. Each stacked rectangle begins where the one below it ends, and their heights are the numbers of subjects (or the totals of their y values, if y is passed a numerical variable) that take the corresponding category value at the corresponding collection point.

Here’s the plot this strata-only transformation yields:

ggplot(toy, aes(x = collection, stratum = category)) +
  stat_stratum() +
  stat_stratum(geom = "text", aes(label = category))

In this vignette, i’ll use the stat_*() functions to add layers, so that the parameters that control their behavior are accessible via tab-completion.

Reversing the strata

Within each axis, stratum defaults to reverse order so that the bars proceed in the original order from top to bottom. This can be overridden by setting reverse = FALSE in stat_stratum():

# stratum transformation with strata in original order
StatStratum$compute_panel(data, reverse = FALSE)
##   x stratum   y n count deposit prop ymin ymax
## 1 1       X 1.5 3     3       1  0.6    0    3
## 2 1       Y 4.0 2     2       2  0.4    3    5
## 3 2       X 1.5 3     3       3  0.6    0    3
## 4 2       Y 4.0 2     2       4  0.4    3    5
## 5 3       X 1.0 2     2       5  0.4    0    2
## 6 3       Y 3.5 3     3       6  0.6    2    5
## 7 4       X 2.5 5     5       7  1.0    0    5
ggplot(toy, aes(x = collection, stratum = category)) +
  stat_stratum(reverse = FALSE) +
  stat_stratum(geom = "text", aes(label = category), reverse = FALSE)

Warning: The caveat to this is that, if reverse is declared in any layer, then it must be declared in every layer, lest the layers be misaligned. This includes any alluvium, flow, and lode layers, since their graphical elements are organized within the bounds of the strata.

Sorting the strata by size

When the strata are defined by a character or factor variable, they default to the order of the variable (lexicographic in the former case). This can be overridden by the decreasing parameter, which defaults to NA but can be set to TRUE or FALSE to arrange the strata in decreasing or increasing order in the y direction:

# stratum transformation with strata in original order
StatStratum$compute_panel(data, reverse = FALSE)
##   x stratum   y n count deposit prop ymin ymax
## 1 1       X 1.5 3     3       1  0.6    0    3
## 2 1       Y 4.0 2     2       2  0.4    3    5
## 3 2       X 1.5 3     3       3  0.6    0    3
## 4 2       Y 4.0 2     2       4  0.4    3    5
## 5 3       X 1.0 2     2       5  0.4    0    2
## 6 3       Y 3.5 3     3       6  0.6    2    5
## 7 4       X 2.5 5     5       7  1.0    0    5
ggplot(toy, aes(x = collection, stratum = category)) +
  stat_stratum(decreasing = TRUE) +
  stat_stratum(geom = "text", aes(label = category), decreasing = TRUE)

Warning: The same caveat applies to decreasing as to reverse: Make sure that all layers using alluvial stats are passed the same values! Henceforth, we’ll use the default (reverse and categorical) ordering of the strata themselves.

Positioning lodes within strata

Alluvia and flows

In the strata-only plot, each subject is represented once at each axis. Alluvia are x-splines that connect these multiple representations of the same subjects across the axes. In order to avoid having these splines overlap at the axes, the alluvium stat must stack the alluvial cohorts—subsets of subjects who have a common profile across all axes—within each stratum. These smaller cohort-specific rectangles are the lodes. This calculation requires the additional custom alluvium aesthetic, which identifies common subjects across the axes:

# collection point, category, and subject variables
data <- structure(toy[, 1:3], names = c("alluvium", "x", "stratum"))
# required fields for stat transformations
data$y <- 1
data$PANEL <- 1
# alluvium transformation
StatAlluvium$compute_panel(data)
##    x alluvium stratum   y PANEL lode n count deposit prop ymin ymax group
## 1  1        A       Y 1.5     1    A 1     1       1  0.2    1    2     1
## 2  1        B       X 3.5     1    B 1     1       2  0.2    3    4     2
## 3  1        C       X 2.5     1    C 1     1       2  0.2    2    3     3
## 4  1        D       Y 0.5     1    D 1     1       1  0.2    0    1     4
## 5  1        E       X 4.5     1    E 1     1       2  0.2    4    5     5
## 6  2        A       X 3.5     1    A 1     1       4  0.2    3    4     1
## 7  2        B       Y 1.5     1    B 1     1       3  0.2    1    2     2
## 8  2        C       Y 0.5     1    C 1     1       3  0.2    0    1     3
## 9  2        D       X 2.5     1    D 1     1       4  0.2    2    3     4
## 10 2        E       X 4.5     1    E 1     1       4  0.2    4    5     5
## 11 3        A       X 3.5     1    A 1     1       6  0.2    3    4     1
## 12 3        B       Y 1.5     1    B 1     1       5  0.2    1    2     2
## 13 3        C       Y 0.5     1    C 1     1       5  0.2    0    1     3
## 14 3        D       Y 2.5     1    D 1     1       5  0.2    2    3     4
## 15 3        E       X 4.5     1    E 1     1       6  0.2    4    5     5
## 16 4        A       X 3.5     1    A 1     1       7  0.2    3    4     1
## 17 4        B       X 1.5     1    B 1     1       7  0.2    1    2     2
## 18 4        C       X 0.5     1    C 1     1       7  0.2    0    1     3
## 19 4        D       X 2.5     1    D 1     1       7  0.2    2    3     4
## 20 4        E       X 4.5     1    E 1     1       7  0.2    4    5     5

The transformed data now contain one row per cohort—instead of per category—per collection point. The vertical positional aesthetics describe the lodes rather than the strata, and the group variable encodes the alluvia (a convenience for the geom layer, and the reason that {ggalluvial} stat layers ignore variables passed to group).

Here’s how this transformation translates into the alluvial plot that began the vignette, labeling the subject of each alluvium at each intersection with a stratum:

ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) +
  stat_alluvium(aes(fill = class)) +
  stat_stratum(alpha = .25) +
  stat_alluvium(geom = "text", aes(label = subject))

The flow stat differs from the alluvium stat by allowing the orders of the lodes within strata to differ from one side of an axis to the other. Put differently, the flow stat allows mixing at the axes, rather than requiring that each case or cohort is follows a continuous trajectory from one end of the plot to the other. As a result, flow plots are often much less cluttered, the trade-off being that cases or cohorts cannot be tracked through them.

# flow transformation
StatFlow$compute_panel(data)
##    alluvium x stratum deposit flow   y n count lode group prop ymin ymax
## 3         2 1       Y       1 from 1.0 2     2    A     2  0.4    0    2
## 1         1 1       X       2 from 3.0 2     2    B     1  0.4    2    4
## 5         3 1       X       2 from 4.5 1     1    E     3  0.2    4    5
## 2         1 2       Y       3   to 1.0 2     2    B     1  0.2    0    2
## 4         2 2       X       4   to 3.0 2     2    A     2  0.2    2    4
## 6         3 2       X       4   to 4.5 1     1    E     3  0.1    4    5
## 7         4 2       Y       3 from 1.0 2     2    B     4  0.2    0    2
## 9         5 2       X       4 from 2.5 1     1    D     5  0.1    2    3
## 11        6 2       X       4 from 4.0 2     2    A     6  0.2    3    5
## 8         4 3       Y       5   to 1.0 2     2    B     4  0.2    0    2
## 10        5 3       Y       5   to 2.5 1     1    D     5  0.1    2    3
## 12        6 3       X       6   to 4.0 2     2    A     6  0.2    3    5
## 13        7 3       Y       5 from 1.5 3     3    B     7  0.3    0    3
## 15        8 3       X       6 from 4.0 2     2    A     8  0.2    3    5
## 14        7 4       X       7   to 1.5 3     3    B     7  0.6    0    3
## 16        8 4       X       7   to 4.0 2     2    A     8  0.4    3    5

The flow stat transformation yields one row per cohort per side per flow. Each intermediate axis appears twice in the data, once for the incoming flow and once for the outgoing flow. (The starting and ending axes only have rows for outgoing and incoming flows, respectively.) Here is the flow version of the preceding alluvial plot, labeling each side of each flow with the corresponding subject:

ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) +
  stat_stratum() +
  stat_flow(aes(fill = class)) +
  stat_flow(geom = "text",
            aes(label = subject, hjust = after_stat(flow) == "to"))

The computed variable flow indicates whether each row of the compute_panel() output corresponds to a flow to or from its axis; the values are used to nudge the labels toward their respective flows (to avoid overlap). Mismatches between adjacent labels indicate where lodes are ordered differently on either side of a stratum.

Lode guidance

As the number of strata at each axis grows, heterogeneous cases or cohorts can produce highly complex alluvia and very messy plots. {ggalluvial} mitigates this by strategically arranging the lodes—the intersections of the alluvia with the strata—so as to reduce their crossings between adjacent axes. This strategy is executed locally: At each axis (call it the index axis), the order of the lodes is guided by several totally or partially ordered variables. In order of priority:

  1. the strata at the index axis
  2. the strata at the other axes to which the index axis is linked by alluvia or flows—namely, all other axes in the case of an alluvium, or a single adjacent axis in the case of a flow
  3. the alluvia themselves, i.e. the variable passed to alluvium

In the alluvium case, the prioritization of the remaining axes is determined by a lode guidance function. A lode guidance function can be passed to the lode.guidance parameter, which defaults to "zigzag". This function puts the nearest (adjacent) axes first, then zigzags outward from there, initially (the “zig”) in the direction of the closer extreme:

for (i in 1:4) print(lode_zigzag(4, i))
## [1] 1 2 3 4
## [1] 2 1 3 4
## [1] 3 4 2 1
## [1] 4 3 2 1

Several alternative lode_*() functions are available:

  • "zagzig" behaves like "zigzag" except initially “zags” toward the farther extreme.
  • "frontback" and "backfront" behave like "zigzag" but extend completely in one outward direction from the index axis before the other.
  • "forward" and "backward" put the remaining axes in increasing and decreasing order, regardless of the relative position of the index axis.

Two alternatives are illustrated below:

for (i in 1:4) print(lode_backfront(4, i))
## [1] 1 2 3 4
## [1] 2 1 3 4
## [1] 3 2 1 4
## [1] 4 3 2 1
ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) +
  stat_alluvium(aes(fill = class), lode.guidance = "backfront") +
  stat_stratum() +
  stat_alluvium(geom = "text", aes(label = subject),
                lode.guidance = "backfront")

The difference between "backfront" guidance and "zigzag" guidance can be seen in the order of the lodes of the "Y" stratum at axis 3: Whereas "zigzag" minimized the crossings between axes 3 and 4, locating the distinctive class-"one" case above the others, "backfront" minimized the crossings between axes 2 and 3 (axis 2 being immediately before axis 3), locating this case below the others.

for (i in 1:4) print(lode_backward(4, i))
## [1] 1 4 3 2
## [1] 2 4 3 1
## [1] 3 4 2 1
## [1] 4 3 2 1
ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) +
  stat_alluvium(aes(fill = class), lode.guidance = "backward") +
  stat_stratum() +
  stat_alluvium(geom = "text", aes(label = subject),
                lode.guidance = "backward")

The effect of "backward" guidance is to keep the right part of the plot as tidy as possible while allowing the left part to become as messy as necessary. ("forward" has the opposite effect.)

Aesthetic binding

It often makes sense to bundle together the cases and cohorts that fall into common groups used to assign differentiation aesthetics: most commonly fill, but also alpha, which controls the opacity of the fill colors, and colour, linetype, and size, which control the borders of the alluvia, flows, and lodes.

The aes.bind parameter defaults to "none", in which case aesthetics play no role in the order of the lodes. Setting the parameter to "flows" prioritizes any such aesthetics after the strata of any other axes but before the alluvia of the index axis (effectively ordering the flows at each axis by aesthetic), while setting it to "alluvia" prioritizes aesthetics before the strata of any other axes (effectively ordering the alluvia). In the toy example, the stronger option results in the lodes within each stratum being sorted first by class:

ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) +
  stat_alluvium(aes(fill = class, label = subject), aes.bind = "alluvia") +
  stat_stratum() +
  stat_alluvium(geom = "text", aes(fill = class, label = subject),
                aes.bind = "alluvia")
## Warning in stat_alluvium(aes(fill = class, label = subject), aes.bind =
## "alluvia"): Ignoring unknown aesthetics: label
## Warning in stat_alluvium(geom = "text", aes(fill = class, label = subject), :
## Ignoring unknown aesthetics: fill

The more flexible option groups the lodes by class only after they’ve been ordered according to the strata at the remaining axes:

ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) +
  stat_alluvium(aes(fill = class, label = subject), aes.bind = "flows") +
  stat_stratum() +
  stat_alluvium(geom = "text", aes(fill = class, label = subject),
                aes.bind = "flows")
## Warning in stat_alluvium(aes(fill = class, label = subject), aes.bind =
## "flows"): Ignoring unknown aesthetics: label
## Warning in stat_alluvium(geom = "text", aes(fill = class, label = subject), :
## Ignoring unknown aesthetics: fill

Warning: In addition to parameters like reverse, when aesthetic variables are prioritized at all, overlaid alluvial layers must include the same aesthetics in the same order. (This can produce warnings when the aesthetics are not recognized by the geom.) Try removing fill = class from the text geom above to see the risk posed by neglecting this check.

Rather than ordering lodes within, the flow stat separately orders the flows into and out from, each stratum. (This precludes a corresponding "alluvia" option for aes.bind.) By default, the flows are ordered with respect first to the orders of the strata at the present axis and second to those at the adjacent axis. Setting aes.bind to the non-default option "flows" tells stat_flow() to prioritize flow aesthetics after the strata of the index axis but before the strata of the adjacent axis:

ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) +
  stat_flow(aes(fill = class, label = subject), aes.bind = "flows") +
  stat_stratum() +
  stat_flow(geom = "text",
            aes(fill = class, label = subject,
                hjust = after_stat(flow) == "to"),
            aes.bind = "flows")
## Warning in stat_flow(aes(fill = class, label = subject), aes.bind = "flows"):
## Ignoring unknown aesthetics: label
## Warning in stat_flow(geom = "text", aes(fill = class, label = subject, hjust =
## after_stat(flow) == : Ignoring unknown aesthetics: fill

Note: The aes.flow parameter tells geom_flow() how flows should inherit differentiation aesthetics from adjacent axes—"forward" or "backward". It does not influence their positions.

Manual lode ordering

Finally, one may wish to put the lodes at each axis in a predefined order, subject to their being located in the correct strata. This can be done by passing a data column to the order aesthetic. For the toy example, we can pass a vector that puts the cases in the order of their IDs in the data at every axis:

lode_ord <- rep(seq(5), times = 4)
ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) +
  stat_alluvium(aes(fill = class, order = lode_ord)) +
  stat_stratum() +
  stat_alluvium(geom = "text",
                aes(fill = class, order = lode_ord, label = subject))
## Warning in stat_alluvium(aes(fill = class, order = lode_ord)): Ignoring unknown
## aesthetics: order
## Warning in stat_alluvium(geom = "text", aes(fill = class, order = lode_ord, :
## Ignoring unknown aesthetics: fill and order

ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) +
  stat_flow(aes(fill = class, order = lode_ord)) +
  stat_stratum() +
  stat_flow(geom = "text",
            aes(fill = class, order = lode_ord, label = subject,
                hjust = after_stat(flow) == "to"))
## Warning in stat_flow(geom = "text", aes(fill = class, order = lode_ord, :
## Ignoring unknown aesthetics: fill

Within each stratum at each axis, the cases are now in order from top to bottom.

Negative strata

In response to an elegant real-world use case, {ggalluvial} can now handle negative observations in the same way as geom_bar(): by grouping these observations into negative strata and stacking these strata in the negative y direction (i.e. in the opposite direction of the positive strata). This new functionality complicates the above discussion in two ways:

  1. Positioning strata: The negative strata could be reverse-ordered with respect to the positive strata, as in geom_bar(), or ordered in the same way (vertically, without regard for sign).
  2. Positioning lodes within strata: Two strata may correspond to the same stratum variable at an axis (one positive and one negative), which under-determines the ordering of lodes within strata.

The first issue is binary: Once decreasing and reverse are chosen, there are only two options for the negative strata. The choice is made by setting the new absolute parameter to either TRUE (the default), which yields a mirror-image ordering, or FALSE, which adopts the same vertical ordering. This setting also influences the ordering of lodes within strata at the same nexus as reverse, namely at the level of the alluvium variable. The second issue is then handled by creating a deposit variable with unique values corresponding to each signed stratum variable value, in the order prescribed by decreasing, reverse, and absolute. The deposit variable is then used in place of stratum for all of the lode-ordering tasks above.

As a point of reference, here is a bar plot of the toy data, with a randomized sign variable used to indicate negative-valued observations:

set.seed(78)
toy$sign <- sample(c(-1, 1), nrow(toy), replace = TRUE)
print(toy)
##    subject collection category class sign
## 1        A          1        Y   one   -1
## 2        B          1        X   one    1
## 3        C          1        X   one    1
## 4        D          1        Y   two   -1
## 5        E          1        X   two    1
## 6        A          2        X   one    1
## 7        B          2        Y   one    1
## 8        C          2        Y   one    1
## 9        D          2        X   two   -1
## 10       E          2        X   two   -1
## 11       A          3        X   one    1
## 12       B          3        Y   one   -1
## 13       C          3        Y   one   -1
## 14       D          3        Y   two    1
## 15       E          3        X   two    1
## 16       A          4        X   one    1
## 17       B          4        X   one    1
## 18       C          4        X   one   -1
## 19       D          4        X   two   -1
## 20       E          4        X   two    1
ggplot(toy, aes(x = collection, y = sign)) +
  geom_bar(aes(fill = class), stat = "identity")

The default behavior, illustrated here with flows, is for the positive strata to proceed downward and the negative strata to proceed upward, in both cases from larger absolute values to zero:

ggplot(toy, aes(x = collection, stratum = category, alluvium = subject,
                y = sign)) +
  geom_flow(aes(fill = class)) +
  geom_stratum() +
  geom_text(stat = "stratum", aes(label = category))

To instead have the strata proceed downward at each axis, and the lodes downward within each stratum, set absolute = FALSE (now plotting alluvia):

ggplot(toy, aes(x = collection, stratum = category, alluvium = subject,
                y = sign)) +
  geom_alluvium(aes(fill = class), absolute = FALSE) +
  geom_stratum(absolute = FALSE) +
  geom_text(stat = "alluvium", aes(label = subject), absolute = FALSE)

Note again that the labels are consistent with the alluvia and flows, despite the omission of the fill aesthetic from the text geom, because the aesthetic variables are not prioritized in the ordering of the lodes.

More examples

More examples of all of the functionality showcased here can be found in the documentation for the stat_*() functions, browsable on the package website.

Appendix

sessioninfo::session_info()
## ─ Session info ───────────────────────────────────────────────────────────────
##  setting  value
##  version  R version 4.2.1 (2022-06-23)
##  os       macOS Catalina 10.15.7
##  system   x86_64, darwin17.0
##  ui       X11
##  language (EN)
##  collate  C
##  ctype    en_US.UTF-8
##  tz       America/New_York
##  date     2023-02-13
##  pandoc   2.19.2 @ /Applications/RStudio.app/Contents/Resources/app/quarto/bin/tools/ (via rmarkdown)
## 
## ─ Packages ───────────────────────────────────────────────────────────────────
##  package      * version date (UTC) lib source
##  bslib          0.4.2   2022-12-16 [3] CRAN (R 4.2.0)
##  cachem         1.0.6   2021-08-19 [3] CRAN (R 4.2.0)
##  cli            3.6.0   2023-01-09 [3] CRAN (R 4.2.0)
##  colorspace     2.1-0   2023-01-23 [3] CRAN (R 4.2.0)
##  digest         0.6.31  2022-12-11 [3] CRAN (R 4.2.0)
##  dplyr          1.1.0   2023-01-29 [3] CRAN (R 4.2.0)
##  evaluate       0.20    2023-01-17 [3] CRAN (R 4.2.0)
##  fansi          1.0.4   2023-01-22 [3] CRAN (R 4.2.0)
##  farver         2.1.1   2022-07-06 [3] CRAN (R 4.2.0)
##  fastmap        1.1.0   2021-01-25 [3] CRAN (R 4.2.0)
##  generics       0.1.3   2022-07-05 [3] CRAN (R 4.2.0)
##  ggalluvial   * 0.12.5  2023-02-13 [1] local
##  ggfittext      0.9.1   2021-01-30 [3] CRAN (R 4.2.0)
##  ggplot2      * 3.4.0   2022-11-04 [3] CRAN (R 4.2.1)
##  ggrepel        0.9.3   2023-02-03 [3] CRAN (R 4.2.0)
##  glue           1.6.2   2022-02-24 [3] CRAN (R 4.2.0)
##  gtable         0.3.1   2022-09-01 [3] CRAN (R 4.2.0)
##  highr          0.10    2022-12-22 [3] CRAN (R 4.2.0)
##  htmltools      0.5.4   2022-12-07 [3] CRAN (R 4.2.0)
##  jquerylib      0.1.4   2021-04-26 [3] CRAN (R 4.2.0)
##  jsonlite       1.8.4   2022-12-06 [3] CRAN (R 4.2.0)
##  knitr          1.42    2023-01-25 [3] CRAN (R 4.2.0)
##  labeling       0.4.2   2020-10-20 [3] CRAN (R 4.2.0)
##  lifecycle      1.0.3   2022-10-07 [3] CRAN (R 4.2.0)
##  magrittr       2.0.3   2022-03-30 [3] CRAN (R 4.2.0)
##  munsell        0.5.0   2018-06-12 [3] CRAN (R 4.2.0)
##  pillar         1.8.1   2022-08-19 [3] CRAN (R 4.2.0)
##  pkgconfig      2.0.3   2019-09-22 [3] CRAN (R 4.2.0)
##  purrr          1.0.1   2023-01-10 [3] CRAN (R 4.2.0)
##  R6             2.5.1   2021-08-19 [3] CRAN (R 4.2.0)
##  RColorBrewer   1.1-3   2022-04-03 [3] CRAN (R 4.2.0)
##  Rcpp           1.0.10  2023-01-22 [3] CRAN (R 4.2.1)
##  rlang          1.0.6   2022-09-24 [3] CRAN (R 4.2.0)
##  rmarkdown      2.20    2023-01-19 [3] CRAN (R 4.2.0)
##  rstudioapi     0.14    2022-08-22 [3] CRAN (R 4.2.0)
##  sass           0.4.5   2023-01-24 [3] CRAN (R 4.2.0)
##  scales         1.2.1   2022-08-20 [3] CRAN (R 4.2.0)
##  sessioninfo    1.2.2   2021-12-06 [3] CRAN (R 4.2.0)
##  stringi        1.7.12  2023-01-11 [3] CRAN (R 4.2.0)
##  tibble         3.1.8   2022-07-22 [3] CRAN (R 4.2.0)
##  tidyr          1.3.0   2023-01-24 [3] CRAN (R 4.2.0)
##  tidyselect     1.2.0   2022-10-10 [3] CRAN (R 4.2.0)
##  utf8           1.2.3   2023-01-31 [3] CRAN (R 4.2.1)
##  vctrs          0.5.2   2023-01-23 [3] CRAN (R 4.2.0)
##  withr          2.5.0   2022-03-03 [3] CRAN (R 4.2.0)
##  xfun           0.37    2023-01-31 [3] CRAN (R 4.2.1)
##  yaml           2.3.7   2023-01-23 [3] CRAN (R 4.2.0)
## 
##  [1] /private/var/folders/k6/l4mq9ctj3219429xnvqpdbxm8tckkx/T/Rtmp9fMfyT/Rinst61ce73b51348
##  [2] /private/var/folders/k6/l4mq9ctj3219429xnvqpdbxm8tckkx/T/RtmplDE0GG/temp_libpath60ab25e50e46
##  [3] /Library/Frameworks/R.framework/Versions/4.2/Resources/library
## 
## ──────────────────────────────────────────────────────────────────────────────

  1. The one exception, discussed below, is for stratum variables that take both positive and negative values.↩︎

ggalluvial/inst/doc/ggalluvial.R0000644000176200001440000001140014372455311016376 0ustar liggesusers## ----setup, echo=FALSE, message=FALSE, results='hide'------------------------- library(ggalluvial) knitr::opts_chunk$set(fig.width = 6, fig.height = 4, fig.align = "center") ## ----example alluvial plot using Titanic dataset, echo=FALSE------------------ ggplot(data = to_lodes_form(as.data.frame(Titanic), key = "Demographic", axes = 1:3), aes(x = Demographic, stratum = stratum, alluvium = alluvium, y = Freq, label = stratum)) + scale_x_discrete(expand = c(.05, .05)) + geom_alluvium(aes(fill = Survived)) + geom_stratum() + geom_text(stat = "stratum") + ggtitle("passengers on the maiden voyage of the Titanic", "stratified by demographics and survival") ## ----alluvia format of Berkeley admissions dataset---------------------------- head(as.data.frame(UCBAdmissions), n = 12) is_alluvia_form(as.data.frame(UCBAdmissions), axes = 1:3, silent = TRUE) ## ----alluvial plot of UC Berkeley admissions dataset-------------------------- ggplot(as.data.frame(UCBAdmissions), aes(y = Freq, axis1 = Gender, axis2 = Dept)) + geom_alluvium(aes(fill = Admit), width = 1/12) + geom_stratum(width = 1/12, fill = "black", color = "grey") + geom_label(stat = "stratum", aes(label = after_stat(stratum))) + scale_x_discrete(limits = c("Gender", "Dept"), expand = c(.05, .05)) + scale_fill_brewer(type = "qual", palette = "Set1") + ggtitle("UC Berkeley admissions and rejections, by sex and department") ## ----parallel sets plot of hair and eye color dataset------------------------- ggplot(as.data.frame(HairEyeColor), aes(y = Freq, axis1 = Hair, axis2 = Eye, axis3 = Sex)) + geom_alluvium(aes(fill = Eye), width = 1/8, knot.pos = 0, reverse = FALSE) + scale_fill_manual(values = c(Brown = "#70493D", Hazel = "#E2AC76", Green = "#3F752B", Blue = "#81B0E4")) + guides(fill = "none") + geom_stratum(alpha = .25, width = 1/8, reverse = FALSE) + geom_text(stat = "stratum", aes(label = after_stat(stratum)), reverse = FALSE) + scale_x_continuous(breaks = 1:3, labels = c("Hair", "Eye", "Sex")) + coord_flip() + ggtitle("Eye colors of 592 subjects, by sex and hair color") ## ----lodes format of Berkeley admissions dataset------------------------------ UCB_lodes <- to_lodes_form(as.data.frame(UCBAdmissions), axes = 1:3, id = "Cohort") head(UCB_lodes, n = 12) is_lodes_form(UCB_lodes, key = x, value = stratum, id = Cohort, silent = TRUE) ## ----time series alluvia plot of refugees dataset----------------------------- data(Refugees, package = "alluvial") country_regions <- c( Afghanistan = "Middle East", Burundi = "Central Africa", `Congo DRC` = "Central Africa", Iraq = "Middle East", Myanmar = "Southeast Asia", Palestine = "Middle East", Somalia = "Horn of Africa", Sudan = "Central Africa", Syria = "Middle East", Vietnam = "Southeast Asia" ) Refugees$region <- country_regions[Refugees$country] ggplot(data = Refugees, aes(x = year, y = refugees, alluvium = country)) + geom_alluvium(aes(fill = country, colour = country), alpha = .75, decreasing = FALSE) + scale_x_continuous(breaks = seq(2003, 2013, 2)) + theme_bw() + theme(axis.text.x = element_text(angle = -30, hjust = 0)) + scale_fill_brewer(type = "qual", palette = "Set3") + scale_color_brewer(type = "qual", palette = "Set3") + facet_wrap(~ region, scales = "fixed") + ggtitle("refugee volume by country and region of origin") ## ----alluvial plot of majors dataset------------------------------------------ data(majors) majors$curriculum <- as.factor(majors$curriculum) ggplot(majors, aes(x = semester, stratum = curriculum, alluvium = student, fill = curriculum, label = curriculum)) + scale_fill_brewer(type = "qual", palette = "Set2") + geom_flow(stat = "alluvium", lode.guidance = "frontback", color = "darkgray") + geom_stratum() + theme(legend.position = "bottom") + ggtitle("student curricula across several semesters") ## ----alluvial plot of vaccinations dataset------------------------------------ data(vaccinations) vaccinations <- transform(vaccinations, response = factor(response, rev(levels(response)))) ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response, label = response)) + scale_x_discrete(expand = c(.1, .1)) + geom_flow() + geom_stratum(alpha = .5) + geom_text(stat = "stratum", size = 3) + theme(legend.position = "none") + ggtitle("vaccination survey responses at three points in time") ## ----session info------------------------------------------------------------- sessioninfo::session_info() ggalluvial/inst/doc/shiny.Rmd0000644000176200001440000005112114367761414015736 0ustar liggesusers--- title: "Tooltips for ggalluvial plots in Shiny apps" author: "Quentin D. Read" date: "`r Sys.Date()`" output: rmarkdown::html_vignette: self_contained: no runtime: shiny vignette: > %\VignetteIndexEntry{ggalluvial in Shiny apps} %\VignetteEngine{knitr::rmarkdown} \usepackage[utf8]{inputenc} --- ```{r setup, echo = FALSE, message = FALSE, warning = FALSE} knitr::opts_chunk$set(fig.width = 6, fig.height = 3, fig.align = "center") library(ggalluvial) pdf(NULL) ``` ## Problem In an interactive visualization, it is visually cleaner and better for interpretation if labels and other information appear as "tooltips" when the user hovers over or clicks on elements of the plot, rather than displaying all the labels on the plot at one time. However, the {ggalluvial} package does not natively include this functionality. It is possible to enable this using functions from several other packages. This vignette illustrates how to create Shiny apps that display an alluvial plot with tooltips that appear when the user hovers over two different plot elements: strata created with `geom_stratum()` and alluvia created with `geom_alluvium()`. An example is provided for wide-format alluvial data (the `UCBAdmissions` dataset) and long-format alluvial data (the `vaccinations` dataset). The tooltips that appear when the user hovers over elements of the plot show a text label and the count in each group. If the user hovers or clicks somewhere inside a ggplot panel, Shiny automatically returns information about the location of the mouse cursor *in plot coordinates*. That means the main work we have to do is to extract or manually recalculate the coordinates of the different plot elements. With that information, we can determine which plot element the cursor is hovering over and display the appropriate information in the tooltip or other output method. _Note:_ The app demonstrated here depends on the packages {htmltools} and {sp}, in addition of course to {ggalluvial} and {shiny}. Please be aware that all of these packages will need to be installed on the server where your Shiny app is running. ### Hovering over and clicking on strata Enabling hovering over and clicking on strata is straightforward because of their rectangular shape. We only need the minimum and maximum `x` and `y` coordinates for each of the rectangles. The rectangles are evenly spaced along the x-axis, centered on positive integers beginning with 1. The width is set in `geom_stratum()` so, for example, we know that the x-coordinates of the first stratum are `c(1 - width/2, 1 + width/2)`. The y-coordinates can be determined from the number of rows in the input data multiplied by their weights. ### Hovering over and clicking on alluvia Hovering over and clicking on alluvia are more difficult because the shapes of the alluvia are more complex. The default shape of the polygons includes an `xspline` curve drawn using the {grid} package. We need to manually reconstruct the coordinates of the polygons, then use `sp::pointInPolygon()` to detect which, if any, polygons the cursor is over. ## App with wide-format alluvial data The app is embedded below, followed by a walkthrough of the source code. If you aren't connected to the internet, or if you loaded this vignette using `vignette('shiny', package = 'ggalluvial')` rather than `browseVignettes(package = 'ggalluvial')`, the app will not display in the window above. You can view the app locally by running this line of code in your console: ```{r run wide app locally, eval = FALSE} shiny::shinyAppDir(system.file("examples/ex-shiny-wide-data", package="ggalluvial")) ``` ## Structure of the example app Here, we will go over each section of the code in detail. The full source code is included in the package's `examples` directory. The app first (1) loads the data and (2) builds the plot. Then, (3) information is extracted from the built plot object to (4) manually recalculate the coordinates of the polygons that make up the plot. Internally, {ggalluvial} uses the {grid} package to draw the polygons, so the next steps are (5) to define the minima and maxima of the x and y axes in {grid} units and the units that appear on the plot's coordinate system, and (6) to convert the polygon coordinates from {grid} units plot units. Next, the user interface is defined, including output of (7) the plot image and (8) the tooltip. The final block of code is the server function, which first (9) renders the plot. Finally, the tooltip is defined. This includes (10) logic to determine whether the mouse cursor is inside the plot panel, then (11) whether it is hovering over a stratum, (12) an alluvium, or neither, based on the mouse coordinates provided by Shiny. If the mouse is hovering over a plot element, the app finds appropriate information and prints it in a small "tooltip" box next to the mouse cursor (11b and 12b). This is the structure of the app in pseudocode. ```{r pseudocode, eval = FALSE} '<(1) Load data.>' '<(2) Create "ggplot" object for alluvial plot and build it.>' '<(3) Extract data from built plot object used to create alluvium polygons.>' for (polygon in polygons) { '<(4) Use polygon splines to generate coordinates of alluvium boundaries.>' } '<(5) Define range of coordinates in grid units and plot units.>' for (polygon in polygons) { '<(6) Convert coordinates from grid units to plot units.>' } ui <- fluidPage( '<(7) Output plot with hovering enabled.>' '<(8) Output tooltip.>' ) server <- function(input, output, session) { output$alluvial_plot <- renderPlot({ '<(9) Render the plot.>' }) output$tooltip <- renderText({ if ('<(10) mouse cursor is within the plot panel>') { if ('<(11) mouse cursor is within a stratum box>') { '<(11b) Render stratum tooltip.>' } else { if ('<(12) mouse cursor is within an alluvium polygon>') { '<(12b) Render alluvium tooltip.>' } } } }) } ``` ### Loading data The UC-Berkeley admissions dataset, `UCBAdmissions`, is used in this example. After loading the necessary packages, the first thing we do in the app is load the data and coerce from array to data frame. ```{r load dataset, eval = FALSE} data(UCBAdmissions) ucb_admissions <- as.data.frame(UCBAdmissions) ``` Next we set `offset`, the distance from cursor to tooltip, in pixels, in both x and y directions. We also set `node_width` and `alluvium_width` here, which are used as arguments to `geom_stratum()` and `geom_alluvium()` below, and again later to determine whether the mouse cursor is hovering over a stratum/alluvium. ```{r set options, eval = FALSE} # Offset, in pixels, for location of tooltip relative to mouse cursor, # in both x and y direction. offset <- 5 # Width of node boxes node_width <- 1/4 # Width of alluvia alluvium_width <- 1/3 ``` ### Drawing the plot and extracting coordinates Next, we create the `ggplot` object for the alluvial plot, then we call the `ggplot_build()` function to build the plot without displaying it. ```{r draw and build plot, eval = FALSE} # Draw plot. p <- ggplot(ucb_admissions, aes(y = Freq, axis1 = Gender, axis2 = Dept)) + geom_alluvium(aes(fill = Admit), knot.pos = 1/4, width = alluvium_width) + geom_stratum(width = node_width, reverse = TRUE, fill = 'black', color = 'grey') + geom_label(aes(label = after_stat(stratum)), stat = "stratum", reverse = TRUE, size = rel(2)) + theme_bw() + scale_fill_brewer(type = "qual", palette = "Set1") + scale_x_discrete(limits = c("Gender", "Dept"), expand = c(.05, .05)) + scale_y_continuous(expand = c(0, 0)) + ggtitle("UC Berkeley admissions and rejections", "by sex and department") + theme(plot.title = element_text(size = rel(1)), plot.subtitle = element_text(size = rel(1)), legend.position = 'bottom') # Build the plot. pbuilt <- ggplot_build(p) ``` Now for the hard part: reverse-engineering the coordinates of the alluvia polygons. This makes use of `pbuilt$data[[1]]`, a data frame with the individual elements of the alluvial plot. We add an additional column for `width` using the value we set above, then split the data frame by group (groups correspond to the individual alluvium polygons). We apply the function `data_to_alluvium()` to each element of the list to get the coordinates of the "skeleton" of the x-spline curve. Then, we pass these coordinates to the function `grid::xsplineGrob()` to fill in the smooth spline curves and convert them into a {grid} object. We pass the resulting object to `grid::xsplinePoints()`, which converts back into numeric vectors. At this point we now have the coordinates of the alluvium polygons. The object `xspline_points` is a list with length equal to the number of alluvium polygons in the plot. Each element of the list is a list with elements `x` and `y`, which are numeric vectors. ```{r get xsplines and draw curves, eval = FALSE} # Add width parameter, and then convert built plot data to xsplines data_draw <- transform(pbuilt$data[[1]], width = alluvium_width) groups_to_draw <- split(data_draw, data_draw$group) group_xsplines <- lapply(groups_to_draw, data_to_alluvium) # Convert xspline coordinates to grid object. xspline_coords <- lapply( group_xsplines, function(coords) grid::xsplineGrob(x = coords$x, y = coords$y, shape = coords$shape, open = FALSE) ) # Use grid::xsplinePoints to draw the curve for each polygon xspline_points <- lapply(xspline_coords, grid::xsplinePoints) ``` The coordinates we have are in {grid} plotting units but we need to convert them into the same units as the axes on the plot. We do this by determining the range of the x and y-axes in {grid} units (`xrange_old` and `yrange_old`). Then we fix the range of the x axis as 1 to the number of strata, adjusted by half the alluvium width on each side. Next we fix the range of the y-axis to the sum of the counts across all alluvia at one node. ```{r get coordinate ranges, eval = FALSE} # Define the x and y axis limits in grid coordinates (old) and plot # coordinates (new) xrange_old <- range(unlist(lapply( xspline_points, function(pts) as.numeric(pts$x) ))) yrange_old <- range(unlist(lapply( xspline_points, function(pts) as.numeric(pts$y) ))) xrange_new <- c(1 - alluvium_width/2, max(pbuilt$data[[1]]$x) + alluvium_width/2) yrange_new <- c(0, sum(pbuilt$data[[2]]$count[pbuilt$data[[2]]$x == 1])) ``` We define a function `new_range_transform()` inline and apply it to each set of coordinates. This returns another list, `polygon_coords`, with the same structure as `xspline_points`. Now we have the coordinates of the polygons in plot units! ```{r transform coordinates, eval = FALSE} # Define function to convert grid graphics coordinates to data coordinates new_range_transform <- function(x_old, range_old, range_new) { (x_old - range_old[1])/(range_old[2] - range_old[1]) * (range_new[2] - range_new[1]) + range_new[1] } # Using the x and y limits, convert the grid coordinates into plot coordinates. polygon_coords <- lapply(xspline_points, function(pts) { x_trans <- new_range_transform(x_old = as.numeric(pts$x), range_old = xrange_old, range_new = xrange_new) y_trans <- new_range_transform(x_old = as.numeric(pts$y), range_old = yrange_old, range_new = yrange_new) list(x = x_trans, y = y_trans) }) ``` ### User interface The app includes a minimal user interface with two output elements. ```{r ui, eval = FALSE} ui <- fluidPage( fluidRow(tags$div( style = "position: relative;", plotOutput("alluvial_plot", height = "650px", hover = hoverOpts(id = "plot_hover") ), htmlOutput("tooltip"))) ) ``` The elements are: - a `plotOutput` with the argument `hover` defined, to enable behavior determined by the cursor's plot coordinates whenever the user hovers over the plot. - an `htmlOutput` for the tooltip that appears next to the cursor on hover. The elements are wrapped in a `fluidRow()` and a `div()` tag. _Note:_ This vignette only illustrates how to display output when the user hovers over an element. If you want to display output when the user clicks on an element, the corresponding argument to `plotOutput()` is `click = clickOpts(id = "plot_click")`. This will return the location of the mouse cursor in plot coordinates when the user clicks somewhere within the plot panel. _Also Note:_ In the example presented here, all of the plot drawing and coordinate extracting code is outside the `server()` function, because the plot itself does not change with user input. However if you are building an app where the plot changes in response to user input, for example a menu of options of which variables to display, the plot drawing code has to be inside the `renderPlot()` expression. This means that the coordinates may need to be recalculated each time the user input changes as well. In that case, you may need to use the global assignment operator `<<-` so that the coordinates are accessible outside the `renderPlot()` expression. ### Server function In the server function, we first call `renderPlot()` to draw the plot in the app window. ```{r renderPlot, eval = FALSE} output$alluvial_plot <- renderPlot(p, res = 200) ``` Next, we define the tooltip with a `renderText()` expression. Within that expression, we first extract the cursor's plot coordinates from the user input. We determine whether the cursor is hovering over a stratum and if so, display the appropriate tooltip. ![screenshot of tooltip on stratum](https://raw.githubusercontent.com/corybrunson/ggalluvial/main/vignettes/img/hover_stratum.png) If the mouse cursor is not hovering over a stratum, we determine whether it is hovering over an alluvium polygon and if so, display different information in the tooltip. ![screenshot of tooltip on alluvium](https://raw.githubusercontent.com/corybrunson/ggalluvial/main/vignettes/img/hover_alluvium.png) If the mouse cursor is hovering over an empty region of the plot, `renderText()` returns nothing and no tooltip appears. ![screenshot of cursor over empty region](https://raw.githubusercontent.com/corybrunson/ggalluvial/main/vignettes/img/hover_empty_area.png) Let's take a deeper dive into the logic used to determine the text that appears in the tooltip. First, we check whether the cursor is inside the plot panel. If it is not, the element `plot_hover` of the input will be `NULL`. In that case `renderText()` will return nothing and no tooltip will appear. ```{r, eval = FALSE} output$tooltip <- renderText( if(!is.null(input$plot_hover)) { ... } ... ) ``` #### Hovering over a stratum Next, we check whether the cursor is over a stratum. We round the x-coordinate of the mouse cursor in data units to the nearest integer, then determine whether the x-coordinate is within `node_width/2` of that integer. If so, the mouse cursor is horizontally within the box. Here the `if`-`else` statement includes behavior to display the tooltip for a stratum if true, and an alluvium if false. ```{r, eval = FALSE} hover <- input$plot_hover x_coord <- round(hover$x) if(abs(hover$x - x_coord) < (node_width / 2)) { ... } else { ... } ``` If the condition is true, we need to find the index of the row of the input data that goes with the stratum the cursor is on. The data frame `pbuilt$data[[2]]` includes columns `x`, `ymin`, and `ymax` that define the x-coordinate of the center of the stratum, and the minimum and maximum y-coordinates of the stratum. We find the row index of that data frame where `x` is equal to the rounded x-coordinate of the cursor, and the y-coordinate of the cursor falls between `ymin` and `ymax`. ```{r, eval = FALSE} node_row <- pbuilt$data[[2]]$x == x_coord & hover$y > pbuilt$data[[2]]$ymin & hover$y < pbuilt$data[[2]]$ymax ``` To find the information to display in the tooltip, we get the name of the stratum as well as its width from the data in `pbuilt`. ```{r, eval = FALSE} node_label <- pbuilt$data[[2]]$stratum[node_row] node_n <- pbuilt$data[[2]]$count[node_row] ``` Finally, we render a tooltip using the `div` tag. We provide the text to display as arguments to `htmltools::renderTags()`. We also paste CSS style information together and pass it to the `style` argument. Note that the tooltip positioning is provided in CSS coordinates (pixels), not data coordinates. This does not require any additional effort on our part because `plot_hover` also includes an element called `coords_css`, which contains the mouse cursor location in pixel units. ```{r render strata tooltip, eval = FALSE} renderTags( tags$div( node_label, tags$br(), "n =", node_n, style = paste0( "position: absolute; ", "top: ", hover$coords_css$y + offset, "px; ", "left: ", hover$coords_css$x + offset, "px; ", "background: gray; ", "padding: 3px; ", "color: white; " ) ) )$html ``` #### Hovering over an alluvium If the cursor is not over a stratum, the next nested `if`-statement checks whether it is over an alluvium. This is done using the function `sp::point.in.polygon()` applied across each of the polygons for which we defined the coordinates inside the `renderPlot()` expression. ```{r test within polygon, eval = FALSE} hover_within_flow <- sapply( polygon_coords, function(pol) point.in.polygon(point.x = hover$x, point.y = hover$y, pol.x = pol$x, pol.y = pol$y) ) ``` If at least one polygon is beneath the mouse cursor, we locate the corresponding row in the input data and extract information to display in the tooltip. (If the condition is not met, that means the cursor is hovering over an empty area of the plot, so no tooltip appears.) ```{r, eval = FALSE} if (any(hover_within_flow)) { ... } ``` In the situation where there are more than one polygon overlapping, we get the information for the polygon that is plotted last by calling `rev()` on the logical vector returned by `point.in.polygon()`. This means that the tooltip will display information from the alluvium that appears "on top" in the plot. In this example, we display the names of the nodes that the alluvium connects, with arrows between them, and the width of the alluvium. ```{r info for alluvia tooltip, eval = FALSE} coord_id <- rev(which(hover_within_flow == 1))[1] flow_label <- paste(groups_to_draw[[coord_id]]$stratum, collapse = ' -> ') flow_n <- groups_to_draw[[coord_id]]$count[1] ``` We render a tooltip using identical syntax to the one above. ```{r render alluvia tooltip, eval = FALSE} renderTags( tags$div( flow_label, tags$br(), "n =", flow_n, style = paste0( "position: absolute; ", "top: ", hover$coords_css$y + offset, "px; ", "left: ", hover$coords_css$x + offset, "px; ", "background: gray; ", "padding: 3px; ", "color: white; " ) ) )$html ``` ## App with long-format alluvial data The `vaccinations` dataset is used for long-format alluvial data. The app is embedded at the bottom of this document, but we don't need to walk through the source code because it's almost identical to the code above. The output of `ggplot_build()` that is used to find the polygon coordinates and information for the tooltips has a consistent structure regardless of the initial format of the input data. Therefore, the calculation of polygon coordinates, user interface, and server functions of the two apps are identical. The only difference is in the initial creation of the `ggplot()` object. Refer back to the [primary vignette](ggalluvial.html) for several example plots made both with long and with wide data. The app is embedded below. Again, if the app doesn't display in the window above for whatever reason, you can view it locally by running this line of code in your console: ```{r run long app locally, eval = FALSE} shiny::shinyAppDir(system.file("examples/ex-shiny-long-data", package="ggalluvial")) ``` ## Conclusion This vignette demonstrates how to enable tooltips for {ggalluvial} plots in Shiny apps. This is one of many possible ways to do that. It may not be the optimal way — other solutions are certainly possible! The full source code for both of these Shiny apps is included with the {ggalluvial} package in the 'examples' subdirectory where the package is installed: the source files are `ggalluvial/examples/ex-shiny-wide-data/app.R` and `ggalluvial/examples/ex-shiny-long-data/app.R`. ggalluvial/inst/doc/order-rectangles.rmd0000644000176200001440000005314014367761414020107 0ustar liggesusers--- title: "The Order of the Rectangles" author: "Jason Cory Brunson" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{order of rectangles} %\VignetteEngine{knitr::rmarkdown} \usepackage[utf8]{inputenc} --- How the strata and lodes at each axis are ordered, and how to control their order, is a complicated but essential part of {ggalluvial}'s functionality. This vignette explains the motivations behind the implementation and explores the functionality in greater detail than the examples. ## Setup ```{r setup} knitr::opts_chunk$set(fig.width = 6, fig.height = 3, fig.align = "center") library(ggalluvial) ``` All of the functionality discussed in this vignette is exported by {ggalluvial}. We'll also need a toy data set to play with. I conjured the data frame `toy` to be nearly as small as possible while complex enough to illustrate the positional controls: ```{r data} # toy data set set.seed(0) toy <- data.frame( subject = rep(LETTERS[1:5], times = 4), collection = rep(1:4, each = 5), category = rep( sample(c("X", "Y"), 16, replace = TRUE), rep(c(1, 2, 1, 1), times = 4) ), class = c("one", "one", "one", "two", "two") ) print(toy) ``` The subjects are classified into categories at each collection point but are also members of fixed classes. Here's how {ggalluvial} visualizes these data under default settings: ```{r plot} ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + geom_alluvium(aes(fill = class)) + geom_stratum() ``` ## Motivations The amount of control the stat layers `stat_alluvial()` and `stat_flow()` exert over the [positional aesthetics](https://ggplot2.tidyverse.org/reference/aes_position.html) of graphical objects (grobs) is unusual, by the standards of {ggplot2} and many of its extensions. In [the layered grammar of graphics framework](https://www.tandfonline.com/doi/abs/10.1198/jcgs.2009.07098), the role of a statistical transformation is usually to summarize the original data, for example by binning (`stat_bin()`) or by calculating quantiles (`stat_qq()`). These transformed data are then sent to geom layers for positioning. The positions of grobs may be adjusted after the statistical transformation, for example when points are jittered (`geom_jitter()`), but the numerical data communicated by the plot are still the product of the stat. In {ggalluvial}, the stat layers exert slightly more control. For one thing, the transformation is more sophisticated than a single value or a fixed-length vector, such as a mean, standard deviation, or five-number summary. Instead, the values of `y` (which default to `1`) within each collection are, after reordering, transformed using `cumsum()` and some additional arithmetic to obtain coordinates for the centers `y` and lower and upper limits `ymin` and `ymax` of the strata representing the categories. Additionally, the reordering of lodes within each collection relies on a hierarchy of sorting variables, based on the strata at nearby axes as well as the present one and, optionally, on the values of differentiation aesthetics like `fill`. How this hierarchy is invoked depends on the choices of several plotting parameters (`decreasing`, `reverse`, and `absolute`). Thus, the results of the statistical transformations are not as intrinsically meaningful as others and are subject to much more intervention by the user. Only once the transformations have produced these coordinates do the geom layers use them to position the rectangles and splines that constitute the plot. There are two key reasons for this division of labor: 1. The coordinates returned by some stat layers can be coupled with multiple geom layers. For example, all four geoms can couple with the `alluvium` stat. Moreover, as showcased in [the examples](http://corybrunson.github.io/ggalluvial/reference/index.html), the stats can also meaningfully couple with exogenous geoms like `text`, `pointrange`, and `errorbar`. (In principle, the geoms could also couple with exogenous stats, but i haven't done this or seen it done in the wild.) 2. Different parameters control the calculations of the coordinates (e.g. `aes.bind` and `cement.alluvia`) and the rendering of the graphical elements (`width`, `knot.pos`, and `aes.flow`), and it makes intuitive sense to handle these separately. For example, the heights of the strata and lodes convey information about the underlying data, whereas their widths are arbitrary. (If the data are provided in alluvia format, then `Stat*$setup_data()` converts them to lodes format in preparation for the main transformation. This can be done manually using [the exported conversion functions](http://corybrunson.github.io/ggalluvial/reference/alluvial-data.html), and this vignette will assume the data are already in lodes format.) ## Positioning strata Each stat layer demarcates one stack for each data collection point and one rectangle within each stack for each (non-empty) category.[^yneg] In [{ggalluvial} terms](http://corybrunson.github.io/ggalluvial/articles/ggalluvial.html), the collection points are axes and the rectangles are strata or lodes. [^yneg]: The one exception, discussed below, is for stratum variables that take both positive and negative values. To generate a sequence of stacked bar plots with no connecting flows, only the aesthetics `x` (standard) and `stratum` (custom) are required: ```{r strata} # collection point and category variables only data <- structure(toy[, 2:3], names = c("x", "stratum")) # required fields for stat transformations data$y <- 1 data$PANEL <- 1 # stratum transformation StatStratum$compute_panel(data) ``` Comparing this output to `toy`, notice first that the data have been aggregated: Each distinct combination of `x` and `stratum` occupies only one row. `x` encodes the axes and is subject to layers specific to this positional aesthetic, e.g. `scale_x_*()` transformations. `ymin` and `ymax` are the lower and upper bounds of the rectangles, and `y` is their vertical centers. Each stacked rectangle begins where the one below it ends, and their heights are the numbers of subjects (or the totals of their `y` values, if `y` is passed a numerical variable) that take the corresponding category value at the corresponding collection point. Here's the plot this strata-only transformation yields: ```{r strata plot} ggplot(toy, aes(x = collection, stratum = category)) + stat_stratum() + stat_stratum(geom = "text", aes(label = category)) ``` In this vignette, i'll use the `stat_*()` functions to add layers, so that the parameters that control their behavior are accessible via tab-completion. ### Reversing the strata Within each axis, `stratum` defaults to reverse order so that the bars proceed in the original order from top to bottom. This can be overridden by setting `reverse = FALSE` in `stat_stratum()`: ```{r strata reverse} # stratum transformation with strata in original order StatStratum$compute_panel(data, reverse = FALSE) ggplot(toy, aes(x = collection, stratum = category)) + stat_stratum(reverse = FALSE) + stat_stratum(geom = "text", aes(label = category), reverse = FALSE) ``` **Warning:** The caveat to this is that, _if `reverse` is declared in any layer, then it must be declared in every layer_, lest the layers be misaligned. This includes any `alluvium`, `flow`, and `lode` layers, since their graphical elements are organized within the bounds of the strata. ### Sorting the strata by size When the strata are defined by a character or factor variable, they default to the order of the variable (lexicographic in the former case). This can be overridden by the `decreasing` parameter, which defaults to `NA` but can be set to `TRUE` or `FALSE` to arrange the strata in decreasing or increasing order in the `y` direction: ```{r strata decreasing} # stratum transformation with strata in original order StatStratum$compute_panel(data, reverse = FALSE) ggplot(toy, aes(x = collection, stratum = category)) + stat_stratum(decreasing = TRUE) + stat_stratum(geom = "text", aes(label = category), decreasing = TRUE) ``` **Warning:** The same caveat applies to `decreasing` as to `reverse`: Make sure that all layers using alluvial stats are passed the same values! Henceforth, we'll use the default (reverse and categorical) ordering of the strata themselves. ## Positioning lodes within strata ### Alluvia and flows In the strata-only plot, each subject is represented once at each axis. _Alluvia_ are x-splines that connect these multiple representations of the same subjects across the axes. In order to avoid having these splines overlap at the axes, the `alluvium` stat must stack the alluvial cohorts---subsets of subjects who have a common profile across all axes---within each stratum. These smaller cohort-specific rectangles are the _lodes_. This calculation requires the additional custom `alluvium` aesthetic, which identifies common subjects across the axes: ```{r alluvia} # collection point, category, and subject variables data <- structure(toy[, 1:3], names = c("alluvium", "x", "stratum")) # required fields for stat transformations data$y <- 1 data$PANEL <- 1 # alluvium transformation StatAlluvium$compute_panel(data) ``` The transformed data now contain _one row per cohort_---instead of per category---_per collection point_. The vertical positional aesthetics describe the lodes rather than the strata, and the `group` variable encodes the `alluvia` (a convenience for the geom layer, and the reason that {ggalluvial} stat layers ignore variables passed to `group`). Here's how this transformation translates into the alluvial plot that began the vignette, labeling the subject of each alluvium at each intersection with a stratum: ```{r alluvia plot} ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_alluvium(aes(fill = class)) + stat_stratum(alpha = .25) + stat_alluvium(geom = "text", aes(label = subject)) ``` The `flow` stat differs from the `alluvium` stat by allowing the orders of the lodes within strata to differ from one side of an axis to the other. Put differently, the `flow` stat allows _mixing_ at the axes, rather than requiring that each case or cohort is follows a continuous trajectory from one end of the plot to the other. As a result, flow plots are often much less cluttered, the trade-off being that cases or cohorts cannot be tracked through them. ```{r flows} # flow transformation StatFlow$compute_panel(data) ``` The `flow` stat transformation yields _one row per cohort per side per flow_. Each intermediate axis appears twice in the data, once for the incoming flow and once for the outgoing flow. (The starting and ending axes only have rows for outgoing and incoming flows, respectively.) Here is the flow version of the preceding alluvial plot, labeling each side of each flow with the corresponding subject: ```{r flows plot} ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_stratum() + stat_flow(aes(fill = class)) + stat_flow(geom = "text", aes(label = subject, hjust = after_stat(flow) == "to")) ``` The [computed variable](https://ggplot2.tidyverse.org/reference/aes_eval.html) `flow` indicates whether each row of the `compute_panel()` output corresponds to a flow _to_ or _from_ its axis; the values are used to nudge the labels toward their respective flows (to avoid overlap). Mismatches between adjacent labels indicate where lodes are ordered differently on either side of a stratum. ### Lode guidance As the number of strata at each axis grows, heterogeneous cases or cohorts can produce highly complex alluvia and very messy plots. {ggalluvial} mitigates this by strategically arranging the lodes---the intersections of the alluvia with the strata---so as to reduce their crossings between adjacent axes. This strategy is executed locally: At each axis (call it the _index_ axis), the order of the lodes is guided by several totally or partially ordered variables. In order of priority: 1. the strata at the index axis 2. the strata at the other axes to which the index axis is linked by alluvia or flows---namely, all other axes in the case of an alluvium, or a single adjacent axis in the case of a flow 3. the alluvia themselves, i.e. the variable passed to `alluvium` In the alluvium case, the prioritization of the remaining axes is determined by a _lode guidance function_. A lode guidance function can be passed to the `lode.guidance` parameter, which defaults to `"zigzag"`. This function puts the nearest (adjacent) axes first, then zigzags outward from there, initially (the "zig") in the direction of the closer extreme: ```{r lode zigzag} for (i in 1:4) print(lode_zigzag(4, i)) ``` Several alternative `lode_*()` functions are available: - `"zagzig"` behaves like `"zigzag"` except initially "zags" toward the farther extreme. - `"frontback"` and `"backfront"` behave like `"zigzag"` but extend completely in one outward direction from the index axis before the other. - `"forward"` and `"backward"` put the remaining axes in increasing and decreasing order, regardless of the relative position of the index axis. Two alternatives are illustrated below: ```{r alluvia plot w/ backfront guidance} for (i in 1:4) print(lode_backfront(4, i)) ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_alluvium(aes(fill = class), lode.guidance = "backfront") + stat_stratum() + stat_alluvium(geom = "text", aes(label = subject), lode.guidance = "backfront") ``` The difference between `"backfront"` guidance and `"zigzag"` guidance can be seen in the order of the lodes of the `"Y"` stratum at axis `3`: Whereas `"zigzag"` minimized the crossings between axes `3` and `4`, locating the distinctive class-`"one"` case above the others, `"backfront"` minimized the crossings between axes `2` and `3` (axis `2` being immediately before axis `3`), locating this case below the others. ```{r alluvia plot w/ backward guidance} for (i in 1:4) print(lode_backward(4, i)) ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_alluvium(aes(fill = class), lode.guidance = "backward") + stat_stratum() + stat_alluvium(geom = "text", aes(label = subject), lode.guidance = "backward") ``` The effect of `"backward"` guidance is to keep the right part of the plot as tidy as possible while allowing the left part to become as messy as necessary. (`"forward"` has the opposite effect.) ### Aesthetic binding It often makes sense to bundle together the cases and cohorts that fall into common groups used to assign differentiation aesthetics: most commonly `fill`, but also `alpha`, which controls the opacity of the `fill` colors, and `colour`, `linetype`, and `size`, which control the borders of the alluvia, flows, and lodes. The `aes.bind` parameter defaults to `"none"`, in which case aesthetics play no role in the order of the lodes. Setting the parameter to `"flows"` prioritizes any such aesthetics _after_ the strata of any other axes but _before_ the alluvia of the index axis (effectively ordering the flows at each axis by aesthetic), while setting it to `"alluvia"` prioritizes aesthetics _before_ the strata of any other axes (effectively ordering the alluvia). In the toy example, the stronger option results in the lodes within each stratum being sorted first by class: ```{r alluvia plot w/ strong aesthetic binding} ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_alluvium(aes(fill = class, label = subject), aes.bind = "alluvia") + stat_stratum() + stat_alluvium(geom = "text", aes(fill = class, label = subject), aes.bind = "alluvia") ``` The more flexible option groups the lodes by class only after they've been ordered according to the strata at the remaining axes: ```{r alluvia plot w/ weak aesthetic binding} ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_alluvium(aes(fill = class, label = subject), aes.bind = "flows") + stat_stratum() + stat_alluvium(geom = "text", aes(fill = class, label = subject), aes.bind = "flows") ``` **Warning:** In addition to parameters like `reverse`, _when aesthetic variables are prioritized at all, overlaid alluvial layers must include the same aesthetics in the same order_. (This can produce warnings when the aesthetics are not recognized by the geom.) Try removing `fill = class` from the text geom above to see the risk posed by neglecting this check. Rather than ordering lodes _within_, the `flow` stat separately orders the flows _into_ and _out from_, each stratum. (This precludes a corresponding `"alluvia"` option for `aes.bind`.) By default, the flows are ordered with respect first to the orders of the strata at the present axis and second to those at the adjacent axis. Setting `aes.bind` to the non-default option `"flows"` tells `stat_flow()` to prioritize flow aesthetics after the strata of the index axis but before the strata of the adjacent axis: ```{r flows plots w/ aesthetic binding} ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_flow(aes(fill = class, label = subject), aes.bind = "flows") + stat_stratum() + stat_flow(geom = "text", aes(fill = class, label = subject, hjust = after_stat(flow) == "to"), aes.bind = "flows") ``` Note: The `aes.flow` parameter tells `geom_flow()` how flows should inherit differentiation aesthetics from adjacent axes---`"forward"` or `"backward"`. It does _not_ influence their positions. ### Manual lode ordering Finally, one may wish to put the lodes at each axis in a predefined order, subject to their being located in the correct strata. This can be done by passing a data column to the `order` aesthetic. For the toy example, we can pass a vector that puts the cases in the order of their IDs in the data at every axis: ```{r alluvia plot w/ manual lode ordering} lode_ord <- rep(seq(5), times = 4) ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_alluvium(aes(fill = class, order = lode_ord)) + stat_stratum() + stat_alluvium(geom = "text", aes(fill = class, order = lode_ord, label = subject)) ``` ```{r flows plot w/ manual lode ordering} ggplot(toy, aes(x = collection, stratum = category, alluvium = subject)) + stat_flow(aes(fill = class, order = lode_ord)) + stat_stratum() + stat_flow(geom = "text", aes(fill = class, order = lode_ord, label = subject, hjust = after_stat(flow) == "to")) ``` Within each stratum at each axis, the cases are now in order from top to bottom. ## Negative strata In response to an elegant real-world use case, {ggalluvial} can now handle negative observations in the same way as `geom_bar()`: by grouping these observations into negative strata and stacking these strata in the negative `y` direction (i.e. in the opposite direction of the positive strata). This new functionality complicates the above discussion in two ways: 1. _Positioning strata:_ The negative strata could be reverse-ordered with respect to the positive strata, as in `geom_bar()`, or ordered in the same way (vertically, without regard for sign). 2. _Positioning lodes within strata:_ Two strata may correspond to the same stratum variable at an axis (one positive and one negative), which under-determines the ordering of lodes within strata. The first issue is binary: Once `decreasing` and `reverse` are chosen, there are only two options for the negative strata. The choice is made by setting the new `absolute` parameter to either `TRUE` (the default), which yields a mirror-image ordering, or `FALSE`, which adopts the same vertical ordering. This setting also influences the ordering of lodes within strata at the same nexus as `reverse`, namely at the level of the alluvium variable. The second issue is then handled by creating a `deposit` variable with unique values corresponding to each _signed_ stratum variable value, in the order prescribed by `decreasing`, `reverse`, and `absolute`. The `deposit` variable is then used in place of `stratum` for all of the lode-ordering tasks above. As a point of reference, here is a bar plot of the toy data, with a randomized sign variable used to indicate negative-valued observations: ```{r bar plot with negative observations} set.seed(78) toy$sign <- sample(c(-1, 1), nrow(toy), replace = TRUE) print(toy) ggplot(toy, aes(x = collection, y = sign)) + geom_bar(aes(fill = class), stat = "identity") ``` The default behavior, illustrated here with flows, is for the positive strata to proceed downward and the negative strata to proceed upward, in both cases from larger absolute values to zero: ```{r flows plot w/ negative strata} ggplot(toy, aes(x = collection, stratum = category, alluvium = subject, y = sign)) + geom_flow(aes(fill = class)) + geom_stratum() + geom_text(stat = "stratum", aes(label = category)) ``` To instead have the strata proceed downward at each axis, and the lodes downward within each stratum, set `absolute = FALSE` (now plotting alluvia): ```{r alluvia plot w/ negative strata} ggplot(toy, aes(x = collection, stratum = category, alluvium = subject, y = sign)) + geom_alluvium(aes(fill = class), absolute = FALSE) + geom_stratum(absolute = FALSE) + geom_text(stat = "alluvium", aes(label = subject), absolute = FALSE) ``` Note again that the labels are consistent with the alluvia and flows, despite the omission of the `fill` aesthetic from the text geom, because the aesthetic variables are not prioritized in the ordering of the lodes. ## More examples More examples of all of the functionality showcased here can be found in the documentation for the `stat_*()` functions, [browsable on the package website](http://corybrunson.github.io/ggalluvial/reference/index.html). ## Appendix ```{r session info} sessioninfo::session_info() ``` ggalluvial/inst/CITATION0000644000176200001440000000251014025146066014515 0ustar liggesusers# format authors (based on `citation()`) author <- .read_authors_at_R_field(meta$`Authors@R`) author <- format(author, include = c("given", "family")) # formatted description fields descr <- list( author = paste(paste(head(author, -1L), collapse = ", "), tail(author, 1L), sep = " and "), year = sub("-.*", "", meta$Date), title = paste0(meta$Package, ": ", meta$Title), note = sprintf("R package version %s", meta$Version), url = meta$URL ) # Package citation bibentry( bibtype = "Misc", textVersion = paste0( descr$author, " (", descr$year, "). ", descr$title, ". ", descr$note, ". ", descr$url ), header = gettextf("To cite package %s in publications, use:", sQuote("ggalluvial")), key = "ggalluvial-package", title = descr$title, author = descr$author, year = descr$year, note = descr$note, url = descr$url ) # JOSS article citation bibentry( bibtype = "Article", header = gettextf("To cite layered alluvial plots as implemented in %s:", sQuote("ggalluvial")), key = "ggalluvial-article", title = "{ggalluvial}: Layered Grammar for Alluvial Plots", author = "Jason Cory Brunson", year = "2020", journal = "Journal of Open Source Software", volume = "5", number = "49", pages = "2017", doi = "10.21105/joss.02017" )