ggalluvial/0000755000176200001440000000000013762731463012415 5ustar liggesusersggalluvial/NAMESPACE0000644000176200001440000000146413762506060013632 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(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(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) import(tidyselect) importFrom(rlang,.data) ggalluvial/README.md0000644000176200001440000001445613761533613013702 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) [![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") ``` The documentation contains several examples; use `help()` to call forth examples of any layer (`stat_*` or `geom_*`) or of the conversion functions (`to_*_form`). ## Acknowledgments ### Resources Development of this package benefitted from the use of equipment and the support of colleagues at [UConn Health](https://health.uconn.edu/). ### 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/0000755000176200001440000000000013762566201013322 5ustar liggesusersggalluvial/data/majors.rda0000644000176200001440000000056513700405077015306 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.rda0000644000176200001440000000106013710336102016454 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/0000755000176200001440000000000013762566201013164 5ustar liggesusersggalluvial/man/lode-guidance-functions.Rd0000644000176200001440000000347213566771437020202 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}) } } ggalluvial/man/majors.Rd0000644000176200001440000000114513703353253014743 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.Rd0000644000176200001440000000521013716513142015637 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.Rd0000644000176200001440000002403113710336102016304 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-alluvium.r \name{geom_alluvium} \alias{geom_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, ... ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}} or \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, or the result of a call to a position adjustment function.} \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()}}. } \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) # 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.Rd0000644000176200001440000003656213761533613016360 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()}} or \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, or the result of a call to a position adjustment function.} \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}{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{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() # 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 = "; ")) \dontrun{ 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")) # filling in missing zeros bn2 <- merge(bn, expand.grid(year = unique(bn$year), name = unique(bn$name)), all = TRUE) 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 = FALSE) # 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() } \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.Rd0000644000176200001440000003017013710336102015442 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()}} or \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, or the result of a call to a position adjustment function.} \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}{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{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 = FALSE) # 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.Rd0000644000176200001440000002007613761533613016200 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:nse-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:nse-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.Rd0000644000176200001440000003006213710336102016172 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()}} or \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, or the result of a call to a position adjustment function.} \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()}}). In addition to existing functions, accepts the character values \code{"first"} (the default), \code{"last"}, 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/0000755000176200001440000000000013761476563014642 5ustar liggesusersggalluvial/man/figures/README-unnamed-chunk-7-1.png0000644000176200001440000020625213761476563021351 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\ @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.png0000644000176200001440000021334013761476562021343 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\ @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 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. } \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 \href{https://health.uconn.edu/}{UConn Health}. } \seealso{ Useful links: \itemize{ \item \url{http://corybrunson.github.io/ggalluvial/} \item Report bugs at \url{https://github.com/corybrunson/ggalluvial/issues} } } \author{ \strong{Maintainer}: Jason Cory Brunson \email{cornelioid@gmail.com} Authors: \itemize{ \item Quentin D. Read } } \keyword{internal} ggalluvial/man/ggalluvial-ggproto.Rd0000644000176200001440000000255513703353253017264 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-alluvium.r, R/geom-flow.r, R/geom-lode.r, % R/geom-stratum.r, R/ggproto.r, R/stat-alluvium.r, R/stat-flow.r, % R/stat-stratum.r \docType{data} \name{GeomAlluvium} \alias{GeomAlluvium} \alias{GeomFlow} \alias{GeomLode} \alias{GeomStratum} \alias{ggalluvial-ggproto} \alias{StatAlluvium} \alias{StatFlow} \alias{StatStratum} \title{Base ggproto classes for ggalluvial} \format{ An object of class \code{GeomAlluvium} (inherits from \code{Geom}, \code{ggproto}, \code{gg}) of length 6. An object of class \code{GeomFlow} (inherits from \code{Geom}, \code{ggproto}, \code{gg}) of length 6. An object of class \code{GeomLode} (inherits from \code{Geom}, \code{ggproto}, \code{gg}) of length 6. An object of class \code{GeomStratum} (inherits from \code{GeomRect}, \code{Geom}, \code{ggproto}, \code{gg}) of length 6. An object of class \code{StatAlluvium} (inherits from \code{Stat}, \code{ggproto}, \code{gg}) of length 6. An object of class \code{StatFlow} (inherits from \code{Stat}, \code{ggproto}, \code{gg}) of length 5. An object of class \code{StatStratum} (inherits from \code{Stat}, \code{ggproto}, \code{gg}) of length 5. } \description{ Base ggproto classes for ggalluvial } \seealso{ \code{\link[ggplot2:ggplot2-ggproto]{ggplot2::ggplot2-ggproto}} } \keyword{datasets} \keyword{internal} ggalluvial/DESCRIPTION0000644000176200001440000000342713762731463014131 0ustar liggesusersPackage: ggalluvial Type: Package Title: Alluvial Plots in 'ggplot2' Version: 0.12.3 Date: 2020-12-04 Authors@R: c( person(given = "Jason Cory", family = "Brunson", role = c("aut", "cre"), email = "cornelioid@gmail.com"), person(given = "Quentin D.", family = "Read", role = 'aut')) Maintainer: Jason Cory Brunson 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.5), 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.1.1 NeedsCompilation: no Packaged: 2020-12-05 02:12:17 UTC; corybrunson Author: Jason Cory Brunson [aut, cre], Quentin D. Read [aut] Repository: CRAN Date/Publication: 2020-12-05 16:20:02 UTC ggalluvial/build/0000755000176200001440000000000013762566200013507 5ustar liggesusersggalluvial/build/vignette.rds0000644000176200001440000000046713762566200016055 0ustar liggesusersRN0L6UQ*?@|C T8p5Zr6TሰN׭JE^{g73;N޲(Qb !@JIaJ)uY IΤ JL?hTqZjBmԲE8wGl:BqbJ%jj)'$V䠊ԎZצ3unmK9 鉿 ȱE @l>9!^3ےȣ?%}=9Sdj&s!oxvϳ9{Agf?zb 2TW܋] B4݉?}>d?7 ggalluvial/tests/0000755000176200001440000000000013762566201013553 5ustar liggesusersggalluvial/tests/testthat/0000755000176200001440000000000013762731462015416 5ustar liggesusersggalluvial/tests/testthat/test-stat-stratum.r0000644000176200001440000000441413703353253021222 0ustar liggesuserscontext("stat-stratum") # weights are used but not returned test_that("`stat_stratum` weights computed variables but drops weight", { data <- data.frame(x = rep(1:2, c(2, 3)), stratum = LETTERS[c(1, 2, 1, 2, 2)]) data$y <- c(1, 1, 1, 1, 2) data$weight <- c(.5, 1, .5, 1, 1.5) comp <- StatStratum$compute_panel(data) comp <- comp[with(comp, order(x, stratum)), ] expect_equivalent(comp$n, c(0.5, 1, 0.5, 2.5)) expect_equivalent(comp$count, c(0.5, 1, 0.5, 4)) expect_equivalent(comp$prop, c(c(1, 2) / 3, c(1, 8) / 9)) expect_null(comp$lode) expect_null(comp$weight) }) # reverse and absolute parameters, negative values test_that("`stat_stratum` orders strata correctly with negative values", { data <- expand.grid(stratum = LETTERS[1:2], x = 1:2) data$y <- c(1, 1, -1, -1) # order by stratum, `reverse = TRUE` #ggplot(data, aes(x = x, stratum = stratum, y = y)) + # geom_stratum() + # geom_text(stat = "stratum", aes(label = stratum)) comp <- StatStratum$compute_panel(data) expect_identical(comp[with(comp, order(x, stratum)), ]$y, c(1.5, 0.5, -1.5, -0.5)) # order by stratum, `reverse = FALSE` #ggplot(data, aes(x = x, stratum = stratum, y = y)) + # geom_stratum(reverse = FALSE) + # geom_text(stat = "stratum", aes(label = stratum), reverse = FALSE) comp <- StatStratum$compute_panel(data, reverse = FALSE) expect_identical(comp[with(comp, order(x, stratum)), ]$y, c(0.5, 1.5, -0.5, -1.5)) # order by stratum, `absolute = FALSE` #ggplot(data, aes(x = x, stratum = stratum, y = y)) + # geom_stratum(absolute = FALSE) + # geom_text(stat = "stratum", aes(label = stratum), absolute = FALSE) comp <- StatStratum$compute_panel(data, absolute = FALSE) expect_identical(comp[with(comp, order(x, stratum)), ]$y, c(1.5, 0.5, -0.5, -1.5)) # order by stratum, `reverse = FALSE, absolute = FALSE` #ggplot(data, aes(x = x, stratum = stratum, y = y)) + # geom_stratum(reverse = FALSE, absolute = FALSE) + # geom_text(stat = "stratum", aes(label = stratum), # reverse = FALSE, absolute = FALSE) comp <- StatStratum$compute_panel(data, reverse = FALSE, absolute = FALSE) expect_identical(comp[with(comp, order(x, stratum)), ]$y, c(0.5, 1.5, -1.5, -0.5)) }) ggalluvial/tests/testthat/test-stat-flow.r0000644000176200001440000000753213715034242020473 0ustar liggesuserscontext("stat-flow") # weights are used but not returned test_that("`stat_flow` weights computed variables but drops weight", { data <- expand.grid(alluvium = letters[1:3], x = 1:2) data$stratum <- LETTERS[c(1, 1, 2, 1, 2, 2)] data$y <- c(1, 1, 1, 1, 1, 2) data$weight <- c(.5, 1, 1, .5, 1, 1) comp <- as.data.frame(StatFlow$compute_panel(data)) comp <- comp[with(comp, order(x, alluvium)), ] expect_equivalent(comp$n, c(1, 1, 0.5, 1, 1, 0.5)) expect_equivalent(comp$count, c(1, 1, 0.5, 2, 1, 0.5)) expect_equivalent(comp$prop, c(c(2, 2, 1) / 5, c(4, 2, 1) / 7)) expect_equal(comp$lode, rep(factor(letters[3:1]), times = 2)) expect_null(comp$weight) }) # reverse and absolute, negative values test_that("`stat_flow` orders flows correctly with negative values", { data <- expand.grid(alluvium = letters[1:3], x = 1:2) data$stratum <- LETTERS[c(1, 1, 2)] data$y <- c(1, 1, 1, -1, 1, -1) # order by stratum, `reverse = TRUE` #ggplot(data, aes(x = x, stratum = stratum, alluvium = alluvium, y = y)) + # geom_flow() comp <- StatFlow$compute_panel(data) expect_identical(comp[with(comp, order(x, alluvium)), ]$y, c(1.5, 0.5, 2.5, -1.5, -0.5, 0.5)) # order by stratum, `reverse = FALSE` #ggplot(data, aes(x = x, stratum = stratum, alluvium = alluvium, y = y)) + # geom_flow(reverse = FALSE) comp <- StatFlow$compute_panel(data, reverse = FALSE) expect_identical(comp[with(comp, order(x, alluvium)), ]$y, c(2.5, 0.5, 1.5, -1.5, -0.5, 0.5)) # order by stratum, `reverse = FALSE, absolute = FALSE` #ggplot(data, aes(x = x, stratum = stratum, alluvium = alluvium, y = y)) + # geom_flow(reverse = FALSE, absolute = FALSE) comp <- StatFlow$compute_panel(data, reverse = FALSE, absolute = FALSE) expect_identical(comp[with(comp, order(x, alluvium)), ]$y, c(0.5, 2.5, 1.5, -1.5, -0.5, 0.5)) }) # aesthetic binding test_that("`stat_flow` orders alluvia correctly according to `aes.bind`", { data <- expand.grid(alluvium = letters[1:4], x = 1:2) data$stratum <- LETTERS[c(1, 1, 1, 2, 2, 1, 3, 1)] data$y <- 1 data$fill <- c("red", "blue", "blue", "blue", "red", "blue", "blue", "blue") # order by index strata and linked strata (flows) #ggplot(data, aes(x = x, stratum = stratum, alluvium = alluvium, y = y)) + # geom_flow(aes(fill = fill)) comp <- StatFlow$compute_panel(data) expect_identical(comp[with(comp, order(x, alluvium)), ]$y, c(2.5, 1.5, 0.5, 3.5, 1.5, 0.5, 2.5, 3.5)) # order by index strata, linked strata (flows), and aesthetics #ggplot(data, aes(x = x, stratum = stratum, alluvium = alluvium, y = y)) + # geom_flow(aes(fill = fill), aes.bind = "flows") comp <- StatFlow$compute_panel(data, aes.bind = "flows") expect_identical(comp[with(comp, order(x, alluvium)), ]$y, c(1.5, 2.5, 0.5, 3.5, 1.5, 0.5, 2.5, 3.5)) # cannot order by aesthetics before by linked strata (flows) expect_warning(StatFlow$compute_panel(data, aes.bind = "alluvia"), "flows") }) # missing values test_that("`stat_flow` preserves missingness to position flows", { data <- data.frame(x = c(1, 2, 2, 3), stratum = factor(LETTERS[c(1L, 2L, 1L, 2L)]), alluvium = c(1L, 2L, 1L, 2L), PANEL = factor(1L), group = seq(4L), y = 1) comp <- StatFlow$compute_panel(data) expect_identical(sort(complete.cases(comp)), rep(c(FALSE, TRUE), c(2L, 4L))) }) # exceptional data test_that("`stat_flow` handles exceptional data with out errors", { wph <- as.data.frame(as.table(WorldPhones)) names(wph) <- c("Year", "Region", "Telephones") wph$Year <- as.integer(as.character(wph$Year)) gg <- ggplot(wph, aes(x = Year, alluvium = Region, y = Telephones)) + geom_flow(aes(fill = Region, colour = Region)) expect_silent(ggplot_build(gg)) }) ggalluvial/tests/testthat/test-geom-lode.r0000644000176200001440000000132513710336102020410 0ustar liggesuserscontext("geom-lode") # visual tests test_that("`geom_lode` draws correctly", { d <- as.data.frame(Titanic) a1 <- aes(y = Freq, axis = Class) a2 <- aes(y = Freq, axis1 = Class, axis2 = Sex, axis3 = Age, fill = Survived) skip_on_cran() skip_if_not_installed("vdiffr") vdiffr::expect_doppelganger( "`geom_lode`: one axis", ggplot(d, a1) + geom_lode(aes(fill = Class, alpha = Survived)) + scale_x_discrete(limits = c("Class")) ) vdiffr::expect_doppelganger( "`geom_lode`: lodes and alluvia", ggplot(d, a2) + geom_alluvium() + geom_lode() ) vdiffr::expect_doppelganger( "`geom_lode`: lodes as strata", ggplot(d, a2) + geom_alluvium() + geom_stratum(stat = "alluvium") ) }) ggalluvial/tests/testthat/test-geom-alluvium.r0000644000176200001440000000666513710336102021337 0ustar liggesuserscontext("geom-alluvium") # visual tests test_that("`geom_alluvium` draws correctly", { d1 <- as.data.frame(Titanic) a1 <- aes(y = Freq, axis1 = Class, axis2 = Sex, axis3 = Age, fill = Survived) a2 <- aes(y = Freq, axis1 = Class, axis2 = Sex) d2 <- alluvial::Refugees a3 <- aes(y = refugees, x = year, alluvium = country) skip_on_cran() skip_if_not_installed("vdiffr") vdiffr::expect_doppelganger( "`geom_alluvium`: basic", ggplot(d1, a1) + geom_alluvium() ) vdiffr::expect_doppelganger( "`geom_alluvium`: facets", ggplot(d1, a2) + geom_alluvium(aes(fill = Age), width = .4) + facet_wrap(~ Survived, scales = "fixed") ) vdiffr::expect_doppelganger( "`geom_alluvium`: bump plot", ggplot(d2, a3) + geom_alluvium(aes(fill = country), width = 1/4, decreasing = FALSE) ) vdiffr::expect_doppelganger( "`geom_alluvium`: line plot", ggplot(d2, a3) + geom_alluvium(aes(fill = country), width = 0, knot.pos = 0) ) }) test_that("`geom_alluvium()` recognizes alternative curves", { data(vaccinations) skip_on_cran() skip_if_not_installed("vdiffr") vdiffr::expect_doppelganger( "`geom_alluvium`: unscaled knot positions", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_alluvium(knot.prop = FALSE) ) vdiffr::expect_doppelganger( "`geom_alluvium`: 'linear' curve", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_alluvium(curve_type = "linear") ) vdiffr::expect_doppelganger( "`geom_alluvium`: 'cubic' curve", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_alluvium(curve_type = "cubic") ) vdiffr::expect_doppelganger( "`geom_alluvium`: 'quintic' curve", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_alluvium(curve_type = "quintic") ) vdiffr::expect_doppelganger( "`geom_alluvium`: 'sine' curve", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_alluvium(curve_type = "sine") ) vdiffr::expect_doppelganger( "`geom_alluvium`: 'arctangent' curve", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_alluvium(curve_type = "arctan") ) vdiffr::expect_doppelganger( "`geom_alluvium`: 'arctangent' curve with custom range", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_alluvium(curve_type = "arctan", curve_range = 1) ) vdiffr::expect_doppelganger( "`geom_alluvium`: 'sigmoid' curve", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_alluvium(curve_type = "sigmoid") ) vdiffr::expect_doppelganger( "`geom_alluvium`: 'sigmoid' curve with custom range", ggplot(vaccinations, aes(x = survey, stratum = response, alluvium = subject, y = freq, fill = response)) + geom_alluvium(curve_type = "sigmoid", curve_range = 3) ) }) ggalluvial/tests/testthat/test-geom-stratum.r0000644000176200001440000000230613710336102021164 0ustar liggesuserscontext("geom-stratum") # visual tests test_that("`geom_stratum` draws correctly", { d <- as.data.frame(Titanic) a1 <- aes(y = Freq, axis1 = Class, axis2 = Sex, axis3 = Age, axis4 = Survived) a2 <- aes(y = Freq, axis1 = Class, axis2 = Sex) skip_on_cran() skip_if_not_installed("vdiffr") vdiffr::expect_doppelganger( "`geom_stratum`: basic", ggplot(d, a1) + geom_stratum() ) vdiffr::expect_doppelganger( "`geom_stratum`: extended width", ggplot(d, a1) + geom_stratum(width = 1) ) vdiffr::expect_doppelganger( "`geom_stratum`: inferred text labels", ggplot(d, a1) + geom_text(stat = "stratum", aes(label = after_stat(stratum))) ) vdiffr::expect_doppelganger( "`geom_stratum`: axis labels", ggplot(d, a1) + geom_stratum() + scale_x_discrete(limits = c("Class", "Sex", "Age", "Survived")) ) vdiffr::expect_doppelganger( "`geom_stratum`: facets", ggplot(d, a2) + geom_stratum() + facet_wrap(~ Age, scales = "free_y") ) vdiffr::expect_doppelganger( "`geom_stratum`: facets and axis labels", ggplot(d, a2) + geom_stratum() + scale_x_discrete(limits = c("Class", "Sex")) + facet_wrap(~ Age, scales = "free_y") ) }) ggalluvial/tests/testthat/test-stat-alluvium.r0000644000176200001440000001006513703353253021360 0ustar liggesuserscontext("stat-alluvium") # weights are used but not returned test_that("`stat_alluvium` weights computed variables but drops weight", { # not cementing alluvia data <- expand.grid(alluvium = letters[1:3], x = 1:2) data$stratum <- LETTERS[c(1, 1, 2, 1, 2, 2)] data$y <- c(1, 1, 1, 1, 1, 2) data$weight <- c(.5, 1, 1, .5, 1, 1) comp <- StatAlluvium$compute_panel(data) comp <- comp[with(comp, order(x, alluvium)), ] expect_equivalent(comp$n, c(0.5, 1, 1, 0.5, 1, 1)) expect_equivalent(comp$count, c(0.5, 1, 1, 0.5, 1, 2)) expect_equivalent(comp$prop, c(c(1, 2, 2) / 5, c(1, 2, 4) / 7)) expect_equal(comp$lode, factor(rep(letters[1:3], times = 2))) expect_null(comp$weight) # cementing alluvia data$stratum <- LETTERS[c(1, 1, 2)] comp <- StatAlluvium$compute_panel(data, cement.alluvia = TRUE) comp <- comp[with(comp, order(x, alluvium)), ] expect_equivalent(comp$n, c(1.5, 1, 1.5, 1)) expect_equivalent(comp$count, c(1.5, 1, 1.5, 2)) expect_equivalent(comp$prop, c(c(3, 2) / 5, c(3, 4) / 7)) expect_equal(comp$lode, rep(factor(letters[1:3])[c(1, 3)], times = 2)) expect_null(comp$weight) }) # negative values test_that("`stat_alluvium` orders alluvia without regard to negative values", { data <- expand.grid(alluvium = letters[1:2], x = 1:2) data$stratum <- LETTERS[1] data$y <- c(-1, -1) # order by alluvium, `reverse = TRUE` #ggplot(data, aes(x = x, stratum = stratum, alluvium = alluvium, y = y)) + # geom_alluvium() + # geom_text(stat = "alluvium", aes(label = alluvium)) comp <- StatAlluvium$compute_panel(data) expect_identical(comp[with(comp, order(x, alluvium)), ]$y, c(-0.5, -1.5, -0.5, -1.5)) # order by alluvium, `reverse = FALSE` #ggplot(data, aes(x = x, stratum = stratum, alluvium = alluvium, y = y)) + # geom_alluvium(absolute = FALSE) + # geom_text(stat = "alluvium", aes(label = alluvium), absolute = FALSE) comp <- StatAlluvium$compute_panel(data, absolute = FALSE) expect_identical(comp[with(comp, order(x, alluvium)), ]$y, c(-0.5, -1.5, -0.5, -1.5)) }) # aesthetic binding test_that("`stat_alluvium` orders alluvia correctly according to `aes.bind`", { data <- expand.grid(alluvium = letters[1:4], x = 1:2) data$stratum <- LETTERS[1:2][c(1, 1, 2, 2, 2, 2, 2, 1)] data$y <- 1 data$fill <- c("red", "blue", "blue", "blue") # order by index strata, linked strata (flows), and alluvia #ggplot(data, aes(x = x, stratum = stratum, alluvium = alluvium, y = y)) + # geom_alluvium(aes(fill = fill)) + # geom_text(stat = "alluvium", aes(fill = fill, label = alluvium)) comp <- StatAlluvium$compute_panel(data) expect_identical(comp[with(comp, order(x, alluvium)), ]$y, c(3.5, 2.5, 0.5, 1.5, 2.5, 1.5, 0.5, 3.5)) # order by index strata, linked strata (flows), aesthetics, and alluvia #ggplot(data, aes(x = x, stratum = stratum, alluvium = alluvium, y = y)) + # geom_alluvium(aes(fill = fill), aes.bind = "flows") + # geom_text(stat = "alluvium", aes(fill = fill, label = alluvium), # aes.bind = "flows") comp <- StatAlluvium$compute_panel(data, aes.bind = "flows") expect_identical(comp[with(comp, order(x, alluvium)), ]$y, c(2.5, 3.5, 0.5, 1.5, 1.5, 2.5, 0.5, 3.5)) # order by index strata, aesthetics, linked strata (flows), and alluvia #ggplot(data, aes(x = x, stratum = stratum, alluvium = alluvium, y = y)) + # geom_alluvium(aes(fill = fill), aes.bind = "alluvia") + # geom_text(stat = "alluvium", aes(fill = fill, label = alluvium), # aes.bind = "alluvia") comp <- StatAlluvium$compute_panel(data, aes.bind = "alluvia") expect_identical(comp[with(comp, order(x, alluvium)), ]$y, c(2.5, 3.5, 0.5, 1.5, 0.5, 2.5, 1.5, 3.5)) }) # exceptional data test_that("`stat_flow` handles exceptional data with out errors", { data(Refugees, package = "alluvial") refugees_sub <- subset(Refugees, year %in% c(2003, 2005, 2010, 2013)) gg <- ggplot(refugees_sub, aes(x = year, y = refugees, alluvium = country)) + geom_alluvium(aes(fill = country)) expect_silent(ggplot_build(gg)) }) ggalluvial/tests/testthat/test-alluvial-data.r0000644000176200001440000000736113761533613021302 0ustar liggesuserscontext("alluvial-data") titanic_alluvia <- as.data.frame(Titanic) null_wt <- NULL # `is_alluvia_form()` tests test_that("`is_alluvia_form` recognizes alluvia-format Titanic data", { expect_message(is_alluvia_form(titanic_alluvia), "[Mm]issing") expect_true(is_alluvia_form(titanic_alluvia, axes = c("Class", "Sex"))) expect_true(is_alluvia_form(titanic_alluvia, axes = 1:4)) expect_true(is_alluvia_form(titanic_alluvia, Class, Sex, Age)) expect_true(is_alluvia_form(titanic_alluvia, axes = c("Class", "Sex"), weight = "Freq")) expect_true(is_alluvia_form(titanic_alluvia, axes = 1:4, weight = 5)) expect_true(is_alluvia_form(titanic_alluvia, Class, Sex, Age, weight = Freq)) expect_true(is_alluvia_form(titanic_alluvia, Class, Sex, weight = !!null_wt)) }) # `to_lodes_form()` tests test_that("`to_lodes_form` consistently formats Titanic data", { expect_equivalent(to_lodes_form(titanic_alluvia, axes = c("Class", "Sex")), to_lodes_form(titanic_alluvia, axes = 1:2)) expect_equivalent(to_lodes_form(titanic_alluvia, axes = c("Class", "Sex")), to_lodes_form(titanic_alluvia, Class, Sex)) expect_equivalent(to_lodes_form(titanic_alluvia, axes = c("Class", "Sex"), diffuse = "Class"), to_lodes_form(titanic_alluvia, axes = 1:2, diffuse = 1)) expect_equivalent(to_lodes_form(titanic_alluvia, axes = c("Class", "Sex"), diffuse = "Class"), to_lodes_form(titanic_alluvia, Class, Sex, diffuse = Class)) }) # preparation for next tests titanic_lodes <- suppressWarnings(to_lodes_form( transform(titanic_alluvia, Index = 1:nrow(titanic_alluvia)), key = "Variable", value = "Value", id = "Index", axes = 1:4, factor_key = TRUE )) titanic_lodes$Value <- factor(titanic_lodes$Value, levels = do.call(c, lapply(titanic_alluvia[, 1:4], levels))) # `is_lodes_form()` tests test_that("`is_lodes_form` recognizes lodes-format Titanic data", { expect_error(is_lodes_form(titanic_lodes)) expect_true(is_lodes_form(titanic_lodes, key = "Variable", value = "Value", id = "Index")) expect_true(is_lodes_form(titanic_lodes, key = Variable, value = Value, id = Index)) expect_true(is_lodes_form(titanic_lodes, key = 3, value = 4, id = 2)) expect_true(is_lodes_form(titanic_lodes, key = "Variable", value = "Value", id = "Index", weight = "Freq")) expect_true(is_lodes_form(titanic_lodes, key = 3, value = 4, id = 2, weight = 1)) expect_true(is_lodes_form(titanic_lodes, key = Variable, value = Value, id = Index, weight = Freq)) expect_true(is_lodes_form(titanic_lodes, key = Variable, value = Value, id = Index, weight = !!null_wt)) }) # `to_alluvia_form()` tests test_that("`to_alluvia_form` consistently formats Titanic data", { expect_equivalent(to_alluvia_form(titanic_lodes, key = "Variable", value = "Value", id = "Index"), to_alluvia_form(titanic_lodes, key = 3, value = 4, id = 2)) expect_equivalent(to_alluvia_form(titanic_lodes, key = "Variable", value = "Value", id = "Index"), to_alluvia_form(titanic_lodes, key = Variable, value = Value, id = Index)) }) ggalluvial/tests/testthat/test-geom-flow.r0000644000176200001440000000743313710336102020442 0ustar liggesuserscontext("geom-flow") # 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/0000755000176200001440000000000013566771437014516 5ustar liggesusersggalluvial/tests/figs/geom-alluvium/0000755000176200001440000000000013703353253017262 5ustar liggesusersggalluvial/tests/figs/geom-alluvium/geom-alluvium-facets.svg0000644000176200001440000017724113703353253024045 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.svg0000644000176200001440000026107613703353253024517 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.svg0000644000176200001440000035610113703353253024652 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.svg0000644000176200001440000034320113703353253023650 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.svg0000644000176200001440000035603513703353253025376 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.svg0000644000176200001440000036145513703353253027376 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.svg0000644000176200001440000035611313703353253025004 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.svg0000644000176200001440000035624613703353253025200 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.svg0000644000176200001440000027306313566771437024521 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.svg0000644000176200001440000035573313703353253025361 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.svg0000644000176200001440000035602413703353253026046 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.txt0000644000176200001440000000010313644215031016160 0ustar liggesusers- vdiffr-svg-engine: 1.0 - vdiffr: 0.3.1 - freetypeharfbuzz: 0.2.5 ggalluvial/tests/figs/geom-lode/0000755000176200001440000000000013703353253016347 5ustar liggesusersggalluvial/tests/figs/geom-lode/geom-lode-lodes-and-alluvia.svg0000644000176200001440000040006013703353253024237 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.svg0000644000176200001440000037145213703353253023755 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.svg0000644000176200001440000003601413646065110022463 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/0000755000176200001440000000000013646065110017121 5ustar liggesusersggalluvial/tests/figs/geom-stratum/geom-stratum-basic.svg0000644000176200001440000001570713566771437023400 0ustar liggesusers 0 500 1000 1500 2000 1 2 3 4 Freq `geom_stratum`: basic ggalluvial/tests/figs/geom-stratum/geom-stratum-facets.svg0000644000176200001440000003031113566771437023550 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.svg0000644000176200001440000001575413646065110024504 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.svg0000644000176200001440000001631613566771437026334 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.svg0000644000176200001440000002526413646065110026504 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.svg0000644000176200001440000001572013566771437025227 0ustar liggesusers 0 500 1000 1500 2000 1 2 3 4 Freq `geom_stratum`: extended width ggalluvial/tests/figs/geom-flow/0000755000176200001440000000000013703353253016373 5ustar liggesusersggalluvial/tests/figs/geom-flow/geom-flow-basic.svg0000644000176200001440000006244113566771437022115 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.svg0000644000176200001440000015324013703353253023407 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.svg0000644000176200001440000023442013566771437025027 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.svg0000644000176200001440000015642013703353253025612 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.svg0000644000176200001440000023442113566771437025142 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.svg0000644000176200001440000015313413703353253024265 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.svg0000644000176200001440000015316413703353253023227 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.svg0000644000176200001440000016054013703353253022261 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.svg0000644000176200001440000015315713703353253023102 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.svg0000644000176200001440000013332213566771437023002 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.svg0000644000176200001440000015310113703353253023564 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.svg0000644000176200001440000015314213703353253023612 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.R0000644000176200001440000000010013074701100015506 0ustar liggesuserslibrary(testthat) library(ggalluvial) test_check("ggalluvial") ggalluvial/vignettes/0000755000176200001440000000000013762566201014421 5ustar liggesusersggalluvial/vignettes/img/0000755000176200001440000000000013762504353015175 5ustar liggesusersggalluvial/vignettes/img/hover_empty_area.jpg0000644000176200001440000011406613761533613021240 0ustar liggesusersJFIF``ExifII*bj(1 r2i``GIMP 2.10.222020:11:24 09:18:13 JFIFC    $.' ",#(7),01444'9=82<.342C  2!!22222222222222222222222222222222222222222222222222" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?P_`۞qVo%] E(v:~ub)'08QҬT6տ܏?Ys3As,?g8{r|"mtog;H/'?G KY{IUޗ?ϲg++H>K/'?M2 T;Ty+0o ,54fG}3r?J(0F).>ʟ+=Կϲz_'iJ 575?dQ/'?Ytiv5dQ/'?Ytw{Iiv5 39\M\!++?T$j8'POtR,*\oz9?xt7܏?yȣ>coΏG?PsʘYQ\,1Tk[eozҊF/vC4j%N]zv0y6,G9ۛoOĵ[sxtnoΏG?4-뭮/Nbu?$oj:66O#ޓңXBx6U2MCE1hߏւh((( (2 [{rVH9'=8jaɥJ089:Uچ@4kea $V.K MFE]R>aOn8 ܾc}#c?,y? kwI޾DQQJ5{IWqhis'Ch6J - իM) N&WTk1DHռsGF7qDW_,ܶf]m6? Est9HҖ72[D&P9iu<H\'ҜI' ՘v'@=QU?gfrW>jrNJn|R(,dy-ojb;.\~gS= =L=OvQIfi>u^pԎ¹+U{ETI"K(kZ{(#Xѣ}rvR)t?跮{/a[ȭv}Pہ Gҡʦ_>-S#v>%SQr#EyMp#ڀE1dGfU`J6;gVuR)f 4r2(\GɏqS\ A"ooY˜HU g,|7y Mo[q,j>I @5 PJ@45qn¸WB?V~#0̦8=M[b))D\_DpVM?N~{u"e.$zZU"MɉڣY?ʥzURΟĎ?QJ(EpPpGly?3E)]?wC4W|vGUߨS`8>˖nM vHCT|f*֜6rh(^*k|cnXE%l<z뿴lW)oO޻Z]yY1c`q}~T7q\TGұ;kMP(!xHiֲ4}Z'S1D1TC~# 2xn8ךԮ u Iޟx#= 'ŧD&-WV꡻"Y(++sEkG8sX悡R2 s]gb bSP+طǸT3͐vu8Jq&Ljr)a68ҭBcT .(9?ʼשcn=ߑ֋z\#hcϥ?ƭ *M k17,j̒GȽɭU봟85PRO#*n=n9=N@y5nC74;})%"arjܨRd{ &E-'ӇN-뵮+Nޟ][Enk 6K6vH<0N3~"+|Gi^ǍsoS/J7wy[}n;?Jt}+#= O9|5v-ZvʹO|K5vSLq?oȤݽz?]OB;.k6$0K5u,{s\,꫊T?0_QIQRy =dDQ{9d/JdEPEPEPEP(Q@Ei 3<;=NAjK^7ܠq UB#"3ыQKdn8q5zSDh0E8@ zQzR@\ _"?696 $t$ ʮ[H.-b}tQOhс APzQzR@h"V6Y8e=q[H6 Du8歴QtV##8TE$ORZ]ҍҖc6~5GSQs ;Z) 4A@ 6pqKzR@ Telx#tT,107MŶ.arQ3: N GQEQEQEQE]http://ns.adobe.com/xap/1.0/ ICC_PROFILElcms0mntrRGB XYZ  acspMSFT-lcms desc @cprt`6wtptchad,rXYZbXYZgXYZrTRC gTRC bTRC chrm4$dmndX$dmdd|$mluc enUS$GIMP built-in sRGBmluc enUSPublic DomainXYZ -sf32 B%nXYZ o8XYZ $XYZ bparaff Y [chrmT|L&g\mluc enUSGIMPmluc enUSsRGBC     C   ' QCR)M- HY!@@B A BJD8W9"OjpPΆ+~Tc[۝-X"&>G[ L1$.+X!nӢ bd<ߥԀDhT'w $eCzk0tA  LWc0:-"O&@ I&˾a[@12ߥqԀDMAnȴ{H !/:+nӈ$ mqԀDhT'}5n@H:-@{h k6IrRMP[A{`#}RZ12IrnqԀDhRzRYc7$bdyԽ֠|@ LyvV2u $5[,}Yu8\~ݎ_!tcs {q^qksoov[e& yGүw>"AWRMDs# =RSJGS{sx2K.}K8Y8쵨:-v{c_>K^HI6An|é}L\i_$q]Dtǡ)|F&HRzh}=M/ޮބgo:*D $@G=t3lr~ǣ|G .y鏥=}|ס|A12Y!1^SocO|9Z_/__L厤w瞸w]^fig^)I6'ЪIX- GmgK.e ,G#:vZ[bCu;,rS]/rT <s/~krM_7wӁ}bwqS+| t~Fߚ$[C:Xʈ2}RZ8`hmW~O6ٰoSK{M/x Uŝ*I1*ˋFώYըǿ6 //^lsRLt܏^qkPu $rl,WK@^_{(Ds,|fۀA{sqq2>]ҙZA>mqyY_Syɖ &=O#:nZ[1c,9xt|~wKI&ϫi}(:kc f=4^=.>@"Oag * p>1~l^T2}nXBi?#:vZoH*w^~]mc S]/rR 'ݘWM,PӱBzLy^،:]lznG/@8쵨:֛ǣ^\X\$}WK@ԃS/t%H9ce*L{Y@- Gn=HJ/~NzN>^LNK;-je.B|=5Gr,wJ&- Gn=J&Z=F_KG|=j-|W|cÿlOB<;UP,u cOǣ=$ǿ6 s=l(6x0{<=%.?-!fMJLBI_-N~L+^ޤ$@ԌDjEGn=H%?;KJ_eeC{0t;/羙^kvyݮ$WS=)-@"I OKz9|cVҐe3Ň/=}_5{=K08Gǿ9^kty-Sm/rRMyI6Rc7$.Rǯ|yߝH}RZ]j;M|;7KIҀ9c&- Gn}IiIոO 'O}(gZ{=sfB onmߟWK@ԀDhT|c7>BZAHrK{sxb%Kr>J :j^, ,\|;UP,u $ǿ6etFJŪs;|>_wfb^K$W?bd S]/rRMP[ACߞ޿Vnmg"J]:6zu 㯍̥ L^:/@ԀDhT#oDI@ ȄOqַA H3g厤$@YR'w $eCzk0tA  LWg0:mŅn^X>H,@ ~+*BeВ 7O,/]]3d̒$@ь_NJ DTX׸ yԵ5"ٲd,[%ue=4瓝>fL$"m_%*X/Y*g)$cQ I6  $A D. 514A!3@%0#$`LEeރO751Fu>t裧E>(X]˴9vGk]˴9v.BaGN:tQӢG ]˴9v.˴9v.XaӢt裧EB$.n)8^wٽQj=>w?xނyfKFݨ tQ뢑z 7_j6GN7]{EڍQE)x3_((w888lڟoqGqGqA888x-YWv;Vi2jWCIF^wڭLYc{Gx5>9 m2FvɕQ뢗xm|\K#E[fȀ.nc{Gf1cAM7qVRa-{yR#l4 \!ĸSI1܋&Jf sRGEWqMh=?iE_"&?R=Sg21 MD3q8S6e2kf*(t”kQ@G)U xЈ誹]R>qڙ/¨A"1Lg @Ŧ1e}Kuռk9JOE^)[|2Hg/8UtWQ^NC_H쟸>|G)C {jsr'` )J,{d2݂+^zjbuZH:9CAms*W"z*fn YLC3Gv+ۀMUBR,*"}'1 Am6:F@x│"9M[fM ":%9*l$&#ߒl$Kea7KꢹQZ)>k&dHjmijBE5>4 +\Y ]VJ}Whu{Txf2tx;("39iF& ]BRlE# 91K RIB*)ȥ U EAI4લEuYkx\Hwg mmL6쫘J>zK+WᴓZs!_B"#`~MꈄDF'~lp+x;C@lVbfeNwW"z*nqhK%[gi]JGReKI,}eEDBU#DtR!sCG`y$=`FXSkNd1W: H?vd>f1#r^3+کzGbыF-bҵZ3W)u;{`δrȞWQ^߄}mdCE R6h6h6h6h6h6h6hI Ni )ǒklҜ"q~A \_}./>Kq~A \_}./ aQ!:\S+\9R$'HW5ƹˋ#KQFl z Z Z z z z Z Z z z Z zV9J+A+A+A/A/A/A+A+A/A/A+A+A+@A?0WՉ# )g-1 !02QA@Paq"BR`?8 y+W9^ry+CU+W9^ry+W9B$"nkBDݬ)օS7k `u5W"nkBAko+o+o+o+o+o+o+o+o+o+o+o+o+W^y^y^y^y^y^y^y^y^y^y^y^y^ >c\ ݭPX^f'lƸ[de$>ORB{L^KǴ]r}ܫ_w*WoUp3ug:SFWʾUr}ܫw=8{F. % :_n$"z TX45clB#4K: XOUp$Y 8R AH) RH;-&J,_M $+in(>V5(0ꇤתU௅|+_ WMj|\ 23^D>W~+Cy^D>W~+ȇ!|"+CE>&3Yk5fYBMhU?IvSZO'C h.]Av h.D h.]Av h.Meߩ!=4[)gJ  1!t"23AQas#04@qrBDRb$5C`S?\]h?T}e-n_hC8և˴Ժ҆^:࠰u&֞K&Xe+e )E;<ٟX6gy? ʐ50c<#G>X$9$|#I,rHcG>X$9$|.mk JH'f~Alf,CjmW4*U>X$9$|#I,rHcG>X$9$|#匜lZ|Z͙y?#͙l-J]n3_q/{]{`5Rݘ&wҾn5/vol*_wd~ZW{ƶwEw-pץK.vcl߯J}ƶwEw-pץK.vcl߮0#0#0#0_QFaF QaFa3^Wr7 zTb{wfvɝ/{fBҭ;}6[rMu ]Ool!BZe 5ˆJ+BI~LJ2"H+P뮪HCRӊB;d~ZSF_ghڳޜKi|>[h U½Py4M^{`5 ゛r[SDRaCJ,@ÛgDaqJGI:2lx"h(m/Ud<iqI)⒭j3Lj2g~W1EEQEEQ R{i[BۢkmE%@Ѓ ԸB!)Wu\}jkҥ{ۻ3Lכ>0gGY7=4ܪЄZJ)*O@#E%C*5BRiX-м6R+NhF_ ?AVs&vݪ[̾MrOa`6,Jxfښir,|LL:0*!B}pSye i* jm%*fif誦_k&vuek6U beVUJ|`NKfP^4,9JZ1N6 +"u?#<4:AjKʹPl6PM rp#>F_w;dw+sŬIV-()#hgx/V#]LUܷ Y{5wGƛd'Y.'(F;,*%ѕZyh,D牅d֒W6(W?f&!6,WD P<􈤃2(RZ> V?fP.E41ՕcR 7h84=s(ٖ~ P8A*.R۬5ozoGw$䮕 8E&(OVl ^mӅLXq&%{љMXp'j*ig~bҫq5Ҕʫs GT-!Sik,yO8Tq~}Qǔ+FTJOQhQǔ)GW<y_Ua Cvem4*X?-)R9QkW<y_8Tq>}PL8+GS<y_8Tq~~ܭYQU8Z>'>S( Us j?qԂ/JɴqѲ)̧PBPۭKBQ)ۥPBcAvmmTF %,0㄄+D%JmMJyԳzoUN˺V:ŅㆈmU*)RV5hSMʼҲ~jBEx"mM8è8DR4Na6-&4j}3XJtd[?!yN MX%ve+^JzJip):e+&Ѳ$&-O]:(YZ,9f?H\[u uu5,6fRږllimU8ʒTNxMRHjAw/)"bjeLx1n/6V_;(IkFUM)gYm?*!1AQa q0@P?!%p鬕jsj8cIh qD|ao,K%dY,K%BX%dY,K%dY)ߏ-nm{R]+.ѣ59ό'? 4}b`{ OOOG!>>,򁌷gƿccJ4ɉ '''&3}b}b}b}bf{ 'iaf|k>1O b8Uy+੧c_wOӂs?]c_wL$eGQB>2|b1h|a_GQ|a<҉GQ|e5}2Qm-L%%%%nInInH$$V+rArKrKrKrDZ---50Tj].:qvwv [A1hżâ TZ-  J.ڔL:tKDB˾hJ{n]x翷t{ݝ݊d:-;@sQRry `6دwvi hRsvVa͸ej5 CϫX,2U i~7ruhnh{7;!HP|ali'_pw QMpNΓByLeLW quYYU+s!V8xƎF߼tۺsCNcr{.): 5/ EEk+C;4EmwxhO\[p]գ^p)1t38Q)B6i i0`ljKB/'O l1Ez˖n͋^yJlNފZR٫ubPϘ pkО&t8n+]Ң uDP9p:`Im_OJbͥYwBB5M@^[Lb7*dy{Ok 5N c[k!o3u;15M`[Ѝ+|+,ߥ(7[<^i {! ,k&KP K\ܙHd^WX=TS0=ZTVқ7#o,p fT/6)C->K.Յd7Vƭm  b)`! SI^!\psKoFL Q+E̊Ѝ쨛CZ r7{d459:J3i@+Q[t%̵kP8 |ތ7EӜTm:4't QG_Vu%v [\7cexZ;ƴEM2fLdlٳin o,e+ZjM7۟ %ee#\̋B荀]xUY<ksHE |O:sWv^4rFozFo{wN |8C<*T#mwR2'߳UKl? v*8RdX+1ʐҙ퀫" ˧Rb 2A{e-qtӋmTi,Qq_[rzX]+Кpgow oj(Dhzo %b-NMaHn y~l|S>)=+2!zܮūcP6w_K*>0=k LZ;'WBVXz`\rsqk۱b-]yMz)yɑֳŕg1jpېΈJi+iJ5[ߗ,tuq0wf;qw~".HyC忳E' huf;zlQ)0x\1)T298*UjYIG о x=ji=f gb}IQݙ\3RhͰG!g0dt+ӫXJUqms=j|p\j%IA2jjpw~"+cfmwJ5^4w)1i,6S͖b8Snyq9O4z翳va0Ϙe tx94pTZ5fs}^2mwJUS |˵g=`6Lq}Ym `1*-rrb3f4wzVn4㻉nBUӲ膢7fѾo{֖jB^, P7;] .1-.MY{iFw?ۊ}lG]ۛIeޒQDx㻍aB† ~zRd*?hw׮OM.xHV@jKs:qҟ{>UW)R44#9"ߚBRPvQiڸ1A9L5/_#ͬwO'UE5-0b>REOY-77%wb7wht],FO9)r]k ӆ&ǀm8= 8{(m9n;-(\0p2uK0;61Fyj9eD9}(]u(aE\ܘqߍ)@C@.{.yJ?-+`Q n-gf9%44q|zc_/S5N4j`@+WxJbjŬisudγukwtyJzyFj3jQ&+6|cR#SSz翅M8]&=%=%=%=<6SB1,~i[GXu{1ZF&ுc"'e$Wg ]??%ۊv=ݤWt8*i;;n_s.6W:KHiW:p:|MScc##cHqI}L}D}D+ Bѳ(CW( "OIc###M+ևt$>>2YU \ڈפ5 .{y/EϏdFznHuU9a@C ,6^Xd*TQ5 lb%v`y,RJ$ 4ph k - ~pRCpBn5PVгYPI {RJ+X56.NN,HLCs+EI+QP]dot͒M.ӣ@Fރ Tx$^zu]Ht eB9JVmy(S3Uu{sA|7yj\w@Ua5nEEcۮ'YS*U$%P#t!0\RJ*Wm%Jԩ_ J (@ $@$I$I$A$I$H$Y$I$I$K$I>Y$K`dI%A$I$I$I$K$H$[$I$I$I$I !$IA$I$I$I$o6rHI$I$K$I(I$OA$I4q$I$I$OPX$I$HI$I$I$K$O?nmWOma$I$I$CE_\]*'])$I$I$K$I> 2UC*]$A!I$$I$RVI@_$;ڷ޹JI ṢO@$0I$Of;$%YoH@ޠD+ I(~W$tBI#9$@<` u$HTWI$_$F;dJ "|A"ܒI$<$4HԒ4$ʰ$CI(ᣐEQ|A"!I$ $#xz~Hْ ēI$aI$JI-#5A'YєI$I$AC]dHeI$K$I([wd6tq$I$I$LHdޞ:HLL}I$I$K$m)I3䆥ަKuA$I$I$F xA HCI$I$I$K$I(4LxK&4A$I$I$I$gЊi_`HI$I$I$K$I- ?A$I$I$I$DKH[my$I$I$K$I)$$Y$A$I$I$DdI$H$Y$I$I$K$\H*4a&IBI$I$I$H` O|I$I$I$-GpII"$i$I$I$I$I$$$ @0I$I$O*!1AQa 0q@P?ګaVP*ѹÂWbt:4ӚsNi94ӚqP4ӚsNi94Ӎ8Hqw.nu λ߿~-\`ߋx.#뿟.%q j?RZO W>}?y~>}?y~O/v(U_TS ?y~ϡϣG>}7D.QXѮU3:г5NPd ҭ@MiFΝv⣡[Hr$ BJ0k1\!=7Ve>HU+9 ~q~qY$/)V"eЭ΅*Y^rPQD/~qèO [~ mlTs2߿rBJ`8wX0u+yYТzRXfO=DVEDVYp뿞pC $D+hcw^| جdJ\*.C+=K d$I_LF.h;'qp: %ؐde^Z^CG2IʫYK Ne,W'-,jb=*`5)jRHf2\(:5g2EA2v(Z GB:`cUOe[`x(aEX*:Kx=4g"QjB dP-QaLD5vl}#dZv3Cpk Ռ2K|&5_ɪF5_-,y5f՚VjY5Jnc~#Q>pA{b4#C=c؍bcAfVۖZI$WWWWWWWWWWWPp:|[;~-\`zkrY-֤4ҚSJh94Ґfb>4ҚSJh94ӏ$'I"=rQj IT|QX_*>T|Q\}2)(CGʏ*>U*>T|Q+3m;Z̻XIlNTUSWf]`{kLuK>4l$@Bcv w;xj9z*Ɏ,)#[ݦ7w;xu(NL-MSr[d0@/]"w%(."f4#ˋm%qb,M鑍.V˄nk4а=sKa#VCN>rphv[i5(w=Ui%NrA%ٗKJʖgPiHEeՊ ;Tj 1 "jE,pCi l: UJr^XpNbeFS fveܖvPǣOM0. ROZ 55kPqLmBIu:ҿx.AB;D_qP4'!L{4mdi[hByw%`!@5n:'l]o|Y&f3"Mȥ4mdcJ@̻)CŔ* RKD4GQ%tAUj $7&mK=MwP9b˹,ltC a %j #c(7 4=Y lcRl'+NV̻BQ$P;ǂ-:C!m{k ݃Iu`E.=D1P% Ψi5ΈMl\R- Yw'(;2K$ PATB(HTGPt*M(Pmd\ȁR)$Ġveܖ  ^œltVv#IY<w%\m"qBS\Y6Hp[Imk+pF[ ;ʒBZ{-f=DXHθNSL[iʪ;Y;jYK%ň `:HR2dWJJ m$:6-ecwa5 uiE*Yka E 8(]5 %6(,$}TtCPؔp"JY$J'NF $ێ2(&Y$)g"bTSveܖ+RYvr<F£մ Ϩ\RK,C yZ kNJ(S)D]pI16}e ugYugYAYyamh("U ͇f]0= m.Q+4,%}QPI$m"lI$HR#;az ^隍ȑ=v*}te⭴Ј%)!1AQaq 0@?)T%49Q@ m] 6[ZPN @BF :Ag8s'8)'8s'8/ "9Nq9Nq9Nq9Ľ/c &DRJ*TRGr*Th8HVNh0X[)a2p!ȘL:ׯCye@>(j}7}7}7}7,*zOOOB<Ӕ/'3"`sHLC4"]}\ׄooo;Q}I_iii_hR4Q: wzn\nگsܮoۻ4x"WI ;{7?wtBqJ7w5apyv~/Z}7\rW.\ȕq4=e˗5argЪ^b(ϩSu#H&yԎu 5=Ds^,t}Ū ޷@Cwu#HR3yQ:Ԏ u~ӭmok*_yӔ?O%F'/Tѩ2J)F3t4Qjal /'/\­s_? pE X77^oz<wO~v47ц=#߸7H V(q xPZBk;'x)A&A#,*L &eP .AdoѤe*>*TPcʕ*i?djwxTS*J=T5؆< (W[V-!¶X4׹Kndn Vm}j[$aY)NJklJ͎ Q`D[+#ULobʝqd>)`g0j3??JWFea g `,5Ix4|4n (qyB΍eV0E`+3WhXXݡSq&aGiGM{g$ڱn`N»33#}J1<1(5 p&N׸77/,准Ҍ]ASvQ'8l@>?CL+7!yK9XD?XU 1DLR⽟+zb7*_u:$"Z$+\|A PG mrxL~O?ugg`J ^M[rX €. /=L5^a`i t8o.Ba%AfRuxi:Z# QDٖy@c }g ޲o2UMiHQ!(U /RfshN;Zd[_P;%!fA뽑A1ٔaKiQsz/>)0hPQRuspZ":Kk& bFz!Bխ^|kh] B%W hBb6i ,aU­[d5]7MJ,ڌMPGE #l+Y `,6aRbڸbsS[Μuu[~&8,5qNJw/ەBYCU# v^PʫW2mk~[B]sS~dy̦]xy[ yu:9F^lr92(r5Ϥ:9pyqYnXfˡY8S*w%#f% mZց>cto2GHYj !Z=k tZ\OŢeKr@ K4Ż]o++mjB!=KiEe 9 *arRp_b|)Ś*8.Eiζ!gtioNjˌel<\ YWF֮ǔTn 4h˺|t^?`x߱ͬZ"ºma-5DmbPUnRns[L%aRtʗUQ.+{Ⴅƀ;}\0R X ^p)UwO ٷ4܃ϳ~v;4.m,Y2kdtp%UX<߷f?I ; IbhC aK,W84&e4@`Zh];JU-A@wV‰ cGjr\`hu(noG&vj EIOoCQNW&$GXT:gF.YR8WײPd}{Ǭ!4wwӅ0v\'IpFRa_]>)_eC \b⛀*_!VI݊AY@M5b1 Y\UYCNR}lv@Z(V% ulZfY& t-0)A}+a eyD t3QԢ,~kkӰ߬2^2D"7[a+BrOaH@~& rc)0Ĉ^p[gXɵCilڬޑAZ jZ)hժ4*χ-8.58YEUҠ3>`pŠD{Ltyx]? ̡AYQ -Ųk(}j8u'>#An t־"p']*%mcgT*8@:Prr/C N_ަoC}?XTB-ciVƚA| FĶ= LYJ||bKq56:|Exß(#q_PtgHc,r-MP()no}Hr q{y>)`:t%W@1J4^ў/Zf8em.ɧTsJ}ߺSIMO/m 'nM]٤x n:/xgEȢxUmeE:Wa:F. T=5M n&"TX(|?Sx'<&"5qd<(Ž}58t TAUÀ)N*E|YUǕ(*}ģ"hwxܫe)W3sWYrG x޵+*,ɯRT;}*~Os@vi2 %z9Ȇ\ߩ*W(Q+?M](43fpE&{@`&Oۗ=ıVrEԹ4j>"|ˠZ M5d˓Zͥ[[jveH91}b`ѢxKTj*4&ݞͥۤ7f*>W̩4)[PEг>b]c6x3:ju~e0+ή/?3~g3˙hm[?3~g3s<̹jr_ҨS)vH1W7j0?U<\~'~"@߈P3LO}V? dÈyC% =Ģ8L5.d uNjsSdh{b8M^gZ.!Ҝ G GQ GQp!+MQQwe7cyRB_FRJ{ƈ+#׸O( 2qoۻ4xȕnkNA~,zorQc/Py8844QK)&|%mtz[$rm#, Bn+Cu@W)nr%V7"@ABE,}Hn$Y4a4R/hYdkRB.qMkߙt.7_~EHS ;!qeߨb.[5C^]#q.Vd7uSX93ӧF=O){IZ]o? ?d+*G}VcYuY~̟3X{kfG}V//ְmN,M8IDtd|~ 69,-/9(((((CLJ)ǡ>\5-+3Qb5C_{?i\^ҫnn~cѹ:S}X!,QzUb͑΍7?#4?շҠ?#l?1]Czӑqo?IQǴ_RR,%FW Ej=͓Οې8=4ܳzQj76:>ykmY:>yn//Wn ?Wu:0p@$ ?ge,bZQ'R[Ǽ_T5(u; Ppr=p*IEPEPEPEPEPe輅coO'9'`UM1ǀÃUbR̳[ǰq5moP-<%u^kP*vn_2kk[ kh?m=$bt5<Σ'5{I[.I3lOΔ~ 'ֹ[U31"10*rvLF<҉^-:V7FbA0(=3MokG5d[Ǵ_RV}̶lO_?1A)~ח6'G),z6K})ǚI -@=Tw??u@k*G՗-YzHMN>m'OZy-a]Gr%K{jq3<5OvQIz~uJ##>o?~slIMsN։ %8 h.*b]$1TȊzdg"@feŤ-`f^ˀu=idDU݉?%w.=9NDY.WJЂ#ߠQ՗[^Sb^e01aH޻O=qv>c^1]OW=r?R)`$t-m?L?vtmV'R,_PM ,m hwe0z8vyTWdnO<gQ^%f5H2̤Mю0xPh/#>B\Jڰko1$`UenTۊ3\]εxc|Q}ZrE+;pw+`~F(jV󁹸rq't#S#犽E00LBX2Ps$U (MG%M go!}8 rnjΖGBoN( M:h..LI 8SEfJ\t*iOEA7˟¹k_i]qz5)+Z?Ød[Lty:}m-P]їC+QәrQEu﹒8>k~|g G]ΥzZrt(^iYg Ul$Ue=A&NVFckx}yJ!}{Ⱟ['G7??ʋfQ'R[Ǽ_X%Q@Q@Q@Q@Q@iOEG3I$hd"R}q5C^II]kơ]WE aa~{ &o\* ܵOdn1ܑɬM,-cѝJ#/sG;7LdIHzy+a51[}+Hf9*y}nuT{EU&j&2SWЍG߱O?x;W:} c(βH? EcIco-k!]%U-,g%[8aycҧkX\>S 8RDQP/:} bQ@0۴k;ƼfO[d1BE  ЖI$\}Ӓ1BZdLHF d__V 'pvֳ[ :b*#S+me*zUl ϖ:.4abZA3/uA~U[:} b\XKά(IjT/k ]2`:hX4,"]32@?ᶆsm.rh((((]http://ns.adobe.com/xap/1.0/ ICC_PROFILElcms0mntrRGB XYZ  acspMSFT-lcms desc @cprt`6wtptchad,rXYZbXYZgXYZrTRC gTRC bTRC chrm4$dmndX$dmdd|$mluc enUS$GIMP built-in sRGBmluc enUSPublic DomainXYZ -sf32 B%nXYZ o8XYZ $XYZ bparaff Y [chrmT|L&g\mluc enUSGIMPmluc enUSsRGBC     C   ' _[,j@$J% @A L$Dy8;0<{s$A Pà7}}䠐Q9~X S(";GH)^ Jϓ(`ucWNPC:+y,pͣ9gF~ʒvv|wФ>CȂI轇8[Z5_Z=VtX5o(zA2[Rtbc xCgYi[KNv>z"?bU1rbbR9u$>C_D 8QʾdRTQGz^:k&;_aD"CȂLM{:X3ւʉ¢I{P5)"J180 1L;W^q -Q~W> z?'0vq@$@b@xڐIu49(W_rmVKX9>H}SǑmEkݸFiA%>j@ՃW.^|db@xڔ9\lLMVmcevd!|\lnq\ndH G^:cέF`k 2"+[ Wx{jhaVw{J>vän pZZe].sj)0ڣFwu_]KT}9CeD"fAQ! s>j@Հ2")[!DQSMZ;\R-㳴{΅4O?G_A HKt}9CeAI8fkT6˂"OΞß:DIPK5;~)^}DH t(Hhd7CC!h hd42  #Q=>(Gld4 hd42 hd42 6PMGz|QfwOAGK=_j{Kgn :(;(isg O~Pעߡ?'EetM.v}]/Y'l΂/m.qtEۿB~NQFoh4%lњ3Fh;,}<4fњ3FhqZgn :({0=4۳qtΪg31Y_ϖ,L3)O1CPaBzisgv gvTϵuurfvY.ht0$̭,+*𠠽+I䣘`" A zSObO}M`aq0 |`r Ŋ8fvͅ#uebL6 mD ZUv}]Zm*_kfvП5L)O]^3~=%xQ(Gr̙ cnlu IR5i)j%"g2)^RfUe܏&]:({0+~M%2@OK;vw`wns>鐴JRL4Hps53\Pt# Ӈ q1X9e|4z)R7hiU:({0 S鶾@݂Yݸ^ bDWS>עHw%U1=TjGW[i9))RAj5!>n2\YZL^3];fYCqK63Ü"*%NL%cG:(i[KN:* [KI8݂[`0 Fk5x S>עNٴ>kK\=!CS$ qVg>"S]"ˑuƳѢgnZ 9"_  eJ&I?'Ef}xoMYԛ2ɳPu8TLuP\1e$MZYݸ pq[]1gYꁚbg83?URF?'EfAo)`a!\vw`wF#•֣bl4ϵ;u|~YTt7_~:({8t`\v}jKF=Tϵ;u|~ZFLd:?'Efn>[t ʡU墉30WgH,dBFaA$j4WS>ע>>ף2=̄#?'Efn3$1 $nsg O~R_A$ZkRIv^TH;w-MĸЌn]´4IV9۳q33qR#몛I\dT$8Bߚj͡*O%iDóD101 `C1F8Z}<P@X(L-`c)kfvmn%:4=y1;v{`wn.9+ 碙gn :({0E:oHdiI4+9۳ꓑ7j`!dm"R JJ:}EۿB~N͎}Tƛ킵1**Matg 1tg3 ŪgY'lȧ=1;݂Yݸ_U3z,tPgG(0Xhs-e-p-er0X" " Ä ' &8Lp1M,-^3~y]4,}Kgn :(;(isg G~PעߚfKSNf$Kf +0rUVG%YdrUVE;j09*#J9*TѦUyfXyf*q+u'9*#J9*!U{J9*#JV5*X3\pPa$F0yeƧθٖ)f7f0=eAKaf5K6fՈHoQDu,RcM'PrYޝKD*Mc*~QS3IeZJL6h!&8H`~?\?/;  1!023AQRa"4PSB@q#`bC?ZAS #2            eI"1`!`!`!`!`!`!`!`!`!`!`!`!`!EWE^݇ޖ;>赮l}kOZ-tv)8}kWwa1}yuPdH/$_g2/~k{Ev;/]WAgKG q6S C- 5g 3V:FjHX5cfthr&mzAev;.iH"%ͰB>^R!3V:j@X#5c*92;'dA9.?jVIrsJq]K>TZ::QWc2AhCYM7mNI 2E1ؗHRa*%ʌ[lY6Uޙw}Ldx<]j=r!"O6񕚧qqL.]yy4[qhу*T>ݚD\Q0 α΂C{EOLepGX.PeWDvSf ˉ[+eA£2C=0/~a"܃r4B"[@j5LSo7Wc2 *!*F̙ ZUu[+j'dN2: dG2 `􄟙 1{T􁉈)I3 rxadɦי AkXĎ:ɼRN!l"T%F# 嘦9.SIHjHx${(m,t{x0){̜C)h%l\ 5LUUxohze܁5(|'>rV^]WG 'Pi0Q!  6îlG"Wd^ o 2V^]/\-7T`ˢBΣusųF-1lQg:[9bΣ5:2V^]=z6ua LvJ_-)("Ξg'8$Y/_!dB| %K¨w%$^JN L JTSEش)3(OA'cc11bz f1=3OA'cc11qХph,݇FN#/c{'vzZSq!aaagg}g̤eu٬3D3>3?3>3?3>3>Ae==AjO Y{.1 !2AQ0@P"aBR`q?kНBG3f9^ry+W9^ry9y+W9^ry+Pƿ~h_~h_~h_~郞WALj!kHv!kHv!kHv 5PzCפ;^zCפ;^zCפ;^zC`?Ghao"̲q;aWS,=TZ fWowkݬGvwkݬGvyMc*S,=v|CwNo+GvwkݬGv9GpGȈyL{V?q3!jPpuO8D\'8_t'0i JKgd=3{ msCh6F`E5 'mQG[d6_9Ke U!D:TsgtnPC44NH/I 53`ABqd`6aCcUYLh@ 꺥%T}i,= l7;ᜪLV"LXT'Zc¢c3:aT6̠rym)aUЁK$Y@8@L)0D38Y Bq9<yߌ=ֺF\TWWWyaT6̪'*>Ia\r w.>0uKtRZeeqcd̕rnW[Һ:Ee:aAM9JmRNX{9Mqo"vCU4ѕحcᐔknEG솨~4=3L$lu{, چt{Pr7" ;;;"љVE)~A!xsΨ'Qd'/C3dE't:+m9bA9iT#DG .KP3W?͐J.rw `PE}d8jټ3NUQb^2 %p'#\ZS"W/Q8{FZ843@u-X^Пz EPҴ"pڋ \ZW.=˭*zWҸޕ7q+\oJzRy[5/48]LzѲ#u((C׹S Wx&Ǘ(y 5F3V:ecCc33;Xc33;Xc33;XFpqonUjZV ~߮?~h_*aa,%XK a,%W ,%XK a,%Lio&)hS?2S?L  !1t"3AQaq245@rs#0BRSbC%`cd?\PRR3,]\-ҴJp*% )R +e iKE n(d4ᮺdeMH1  &-E N7tF:#{GDoh7tF 4⌞֩vR &ȏgf`gݹYM- :#{GDoh7tF:#{GDoh%(Ild} ~hɛ3}Qs";|_؟uovGSQ5FaTjQd͙Q5FaTjQ5D]mP甯{^? &E̍~[bfe^m-*SY<0I-)jGf{l< sm"+MDd} ~4Jg[G~}U7fo!ISBVȷN!f%TlK'JzᩖkpTTPFvJT?>؟uovKЧᛏ5DÙ oEN挛7%RÒu7 V(TܸJRP䨘p68$bQ‚ozHa#~谓^s[b׶ɿs< $*U-0Uɭi >ԩ++)MٙeQ3N˶Ã}.!k@ze^D+J&{G9K8/mn\-*ԠS› O4>C%ZHLt[臲NmoQ最{RN0{*dN1k6V $kÒXy*-+~B%SX{k5B-(ԛ挛726~CnNM/+2nT\aߧlkvnMCqйlT!8\_^76V鼌r'ʂᳺ i[aVPܓ64J橦4LI{%OaQuFRP*O_9/Ǎ'xwG'xwD'yO0t꧖Ҝ`%,(BUB*5 d͙ͮ0mqZmpq1%'{l39(TRRM s~\vmkQlTcG( g%CMJ&U=`z/{^? q)x`ǂD(,:6kpE8t<T8+\axnlOٺ7gRR*cyP78{eЊcJD']uç(hJ Wbq~`ݒ)g- \9 6%Xև ͞8IՓT:픭5U-# U,Y+&MN5T% LJBk@aݧ ^p؟uoβ w]1߫Gf%奩R/+H}l)j[Z%>./{^? :m]97fo.dmsoKlOٺ7gr~hwFT" %ߔvKЧveG:&E̍zUm7^&\o.&PBVUcT$> |~`ݒ)^<\h1W4d<I[;"R_O/Ljԗc#̛3&;o)ໆf5V7#u8\$]9'{l3G|'"_>d ~h5G(̈́Z_D`̮hɛ3}Qs";XLPų~[bJBښw m!uJiP7' l[T>mP&C'd@RT_>Zl!QP0fd<_P@ǃ Ia$ wu7+'{l<~`ݒ)]:9sfҠn挛5Vژ 5raʿ9ybYkʕDż{CM<-Z?傢B}@ꌍm]1/7c|_Lo]0jyim7^&)_>d ~zg:&E̍~[b׶ɿsWDkG}BULo=1''7-(<0Z8„,S2nT\aƨTjP0Q5F[b׶ɿsWBy\ѓ6fEv)?fd9+쏡Ohɛ3}Qs";|_؟uoy9eBP{0L/]5q E)c޾WkKbOG=}xCۗ"-wRۏQ>־<GGZ(Yk_e #kZi90ۛUhE #kd}}x,Q>־YkZXH9m-ՊSQo_c%i+H{zQobͭ“M>־<GGZ(Yk_e #kd}}0ڥ$+>+>++Wv{ =C-FVt|V|V|V5,3YXdh;a'_okj掃>ו ~[̾\(j#z򽿣×syܗK _{^Wp5xrno2r<a'(­Q{eGeGQ{e,-G(=%=l(-e>aאW8NP9xY^*P5pJ_^K~BMG7`>R$([hE וuRhQb;¡e+ުُuTej\:ir<NI~uƱ0Am8[fj[OlJ0CFYp]g΃8,B^ǍUtƗ([31{3W޷w p7NONiSEua[NQǁ!~VOeD ax50Ÿ 7|4iџZrI _t r5}І(ׂ{G [,lHhtݏ2zjhAMgO =Gca _{^Q'y U%3w *BQex<<Ӆ늏"ʠ>m<l/1ZB6D8Kл~K&J MӁ@,_vpT@JLt.QQ%h-ҡB^/PORucFC&u5p┽0۾*T@ׅPؑRv?\s]t1]Y(1I24=Vp ؕQPeD l%x3cF+>@$ЭnT^YCSzaO0]#|A m@rfwr=(ݒ6*]z@XwTcY+IPק1* %J1wYWipjlxA%jJWD#Ottr)DB%2]]vIhneK@Kz&#sSқf" N7upT4-sA]AOF_qC*l?/ĢR v=DZiip]w"ӧh7D7 m'}kJ8W^7?O%*ӎ9T\ӯBOe:}N"Eҝ.Eht97GiZYV@bz]bbi$]lDӴ)M3 칿T4bhf+Rb(ƐRnPXᚱgJKۻ`W~לPe.菉xJ=n)3W484hˬ[pLڀ;}$RvK0-PѮ,ޘ Eujv-Jf,!t Fgo2Pi{tMh.<j^z4p7 !ד%at7բT7JA>)QA2*0x:)K;V4j: ;C ۮ"t\gKuVkAX 4VOj"xytYn%՗cW-r¥ S=O_!ד"en<f ~AeޑC vOa+v[g8T܃O^񎂜ۯ7ǁEmD ZeO0TmFKűeeF] whpr(Һĸk+M^x!Xt'{?|aWWՅW+ߣ-r{^qW6?Yr\OE"]`C :s*hEf<v?6Q9:\@F.SC *Jº5:+b{>!cOy8)mr~>MȀvӪ$gz5xpe*Y9MVLR ?u[^Ǫ]K羫 DeR V`K{r$B=7"@@ =6\ו)];Jgb4GNI@4f]z%wHX)t GxS) \Q't½ ޡF6MX8YY(!"f칆bu7nerX`<џh^]{6pU1 Dcմ̵oB5]S|O?EhAe=y8Y8^Z2vè2:%[e10f+YBf"{T\E5P]íSDeK;i=_3| }ȅI~>=:FRƶ q ^=Ák)K)D8yקнB&$jFu鸊E8D#zn{|^ۼ)CF4ԑ.qFzph޷z;Ji4v+Z,N5ih4q/Zxk딥AB=0HkXȢY?N^ν8zy/r=^÷rXmq66qh.YYg555;@G_ L"l:WQn~s-/ӉS={KSI={Foi={BoD#z#_M6C') |~|~|~g+,^1fgnS'qPew~?SN;?P;KE}oAÅ܋͹RJ +L"=+89|7} tPfPbLi*\o4`_EmżD@ {FS0HIz4hӣJRA^5u*MxG ڙ[;7Ɓ%4i $hѦ  *WQVpvp@ihH nB'f :Uo!2@waUuNx,T2J*ThW h m !2 :2J*8&Bu%Q}ᘇ+ eh yY*TVjг,Gge#E5dj*T\  @UvKePS3^chZ%kGBk;&k49*C].-҆\kw78RݧYHUڟЯ<3&0u톯BIC)KktJNwNv YZp !m78Ӳ}J*W:\\r> <  ((I=HHd3$^I"HĒI$I$I$A$d$I$*II$I$I ~IdBY$IU$I$I$E$I?Y$I!dI-A$I$I"H$I 2J$I I$I$I$NO$&I?N%I$I$I$ &rI$ $I&$I$I$HƋ($I$NIH$DI$I$I%SJM7$cT $I$I *}2} jII$I$I {P`PE$GHO$Ic6[QjA#{PH$CH"`OjI *fj$L_a0'H @H2n;h &` 5I 4 }Dy4@I$\I$ H(l~;$$ dI>$!e}6%In=I$i fc2/I>#$$`I$@I33%䞛(A4A$;ĒI& H$",H^2N[ I m22I$I$L4Ui$$m IZI$Hd &v٪h.$I$I$D"w1dǏ&HL7_I$I$I%pRq /$cb1 $I$I$P!8vE2RII$I$H fd7i$I$I$I$I3\tS`4tA$I$I$H$akk}$ $ I$I$I$HR#mI$I$I$ %m`,-mH$I$I$O6H$J$I$I$I${amI$I$I49C"dI$I$I$k$ $hĒELHI$I$M$!EH(I&I$ $I$I'*!1AQa 0qP@?C$U&s42LMsNi94ӚsNi8HLDF9"&ӚsNi94Ӛqly?=,y?=ly?=lzcK_1(F#_ob[Ch{ w4=| 'h{ w4=JuIU?T|Ch{ w|Ch{ wB^\';y1/(}L 绅Ÿ*T@pq}ݯ&h}CZ䔱K1"[!_ EhV6d䙱^Ly6r9LUJv ynƓM1aZR e&~Q9&}ST0'ItFE$ӖJËF) B G7nn}T `Y݋TƤQaj XVҦ,7diIB/#rHEaMGP!N+$t7[S?jI1"vl'rM@b擹E˴^FG!&`C. D*L7v9c/)jͽ⺪Kr*i.4ZA24Nّζ+ɏ&y2 ;w35NB5o= &UaԿG}TH*-}DaCn=Mcɴ^PX%k`:k"G~Gc|>ۏ6p 8&NI\RS^L ۣQAUk-i~u2&џhϰg3~}4%.5 M"T1Z Uac0 v7bEU6ǡj 8ƯܤNIG */捣ꏪ>ꏪ>ꏪ>p{BѲj'Iy$,dFB2!dBȅ "EBe .K%dY,Hm҄), [c}l=ؗ+q(,K?ܒ222322V8OAS[əF\ER2Ȯes+\7ER_̮es#>M/5̮es+R^prW2ϕ9Z4a[!e^s 3vHU;f/bOJ:O)!1 0AQaq@P?6"WgA'5=F9n(3;;;G2wqwqwp76E[ F/j+ ^6WE-(܄SSSSSSSSSSSSB6pNJrrrrrrrrrrr*S?XC(IG{G{G{e;2:z=ޏz=ޏz=U?vMb+%\N~Br ʜ\b6b?do?GI6ӥTl!^1AlIa;Gh?4usQ3j¹#v;CV[g#+# jl]& Y8NxY |ܦM!s1ZD:LLNlGDK#84lpҏ#UȬCM,hl'9۬ θjQZ0  <RI$[UAo. pwjBBWV/5#f&)IAZW; 2!)dcJQLXI sg|GR&h䇘F&77T78L{Ypӏb?U 34Q uɗvBn$I eMkTksΦᒡבHFm!(rJ)`XT7"v˘%Z_$Eo;hCb%,KDV> p*9Si54G㣁),j&ƻBƓ4t.y苐'н&.Y)iJ(Ln6QrCۤ;F,r^@&RI9%IWJ"Bi6v3;crQQ9{Mc%fNT,$;sF_AH:#Mnh;e7lIpI98 e(X e}Mu\TH1±7q@E3|0Lٓ9ƅFch_mlɁ o;+a!H1ug%+Q|GlaЁ\hU.ccETU "4Hf!Ўt!sd,Re# jXFL$I/H="?#TlBpq݇JٴBڂbyCSxUń@$*VQ9Zy%DGBvƛQ0.jcT Ȕbׄ>ʤ6X[DP R2$c礡Uh,eBX3j+7˝BGBE~d%6';m6Aʾڎp0R\^ ^pv˚qC\ZCbmOx&;q#tt$Ya?4W7 K4qI&KDpנ5U;NӴF2$*D:GH##td~ 7%cCx/_$I|%K/_$EUm_2v;񶢺-1>0& gygGfygyǒM YygGvygyXH#I$(8$IPZBmI$j7RdI#iO?|2F{?AbĸIQyіm$u[Fx~󂦌G*!1AQa q0@P?GrӝUb)UB \LAILyMjc& OhmN:ÕpN:Njc&8gu'Xbu N:N:CsLq129*TRJ*TƱ(T]j9PC7TXl2j;v]p uY}~_W}iW},jEC!6Rx¢W۷bD!Z hr|O~'ڿ_QV? ?W}#kmOl(~mwa`AU;v$H?Fv/S.;ÏF{>~;7?Fv/S.;F{>~;On#uMsپYr˞.\xrq ˗=.\ OAH3Lej^4 yѻxGsꄷZ7g4x03.ƆkQYzMQޑG4;SWwTƊ9Dj˂fc=ԌԆV}to---/Cyn>n>n>c>=%i/r]`s~U[[[5מIgo/ jwFO/w;<ϭݾ){N~!s_v谫Zʨxm() eê6" FftVD,.^!thN2@]搻 i Y@TF֜i邠sGs13j&9cxs}.r9ocg~&s1gO8*P,-,5#+Lx>u "J/;R gc=i”..Wkz6/4d`pV[)xD`,u`ϨWc/ZQ fSFJ7 ҷMV~dm|`=)I۱IEYXQ TW77~I9:Gi=56nw Bmw+/v(#t=J2{#*!('GtnFӂQ.naTi ,È`8Ld>X Ν>NϢ 0QzӦ$>awth6#H50) M[jލh9ю_+Zэx_Л?čs[7+ZűxϢ'[UUm^͞?A!Ac\uLl°s8VTBxJTC#$T M((j֒%Y bVQ%2]o0|Be /mE .T U}Hܵ2D#ĻL 5=ǀI9KEQG !jJ x ~g?M (a݌Q#B&gd+q3474X9)eteHH u8أA TH(JαJhUsj21 ֆ5L1Q먜Zvɀ-W,-$ v&a3d̴*]z*ਲ਼.jeZ-MQEfaZ/|:B֒[uԉhMc-G@ *(k)̣#u%lnX P]]y>P84/]ܽ"ꚇOb ^u!]G.'ݏ9ω2Jt&Pjd,dwMׂ.O[mC?d%}Lj%BKUwؙ Ae7Ud0iФsfjfm-"Qie$(# ,h@`RcL˝}2(]sTN YTi::;|z#WduK JFm)j[W:Tea(Ȋ\4|IDk5xZ,5^~DPR/@J Me@@ au+H Z/8˚ui]+ 0.*]nI5G :9\Gʇ#H-`U}qV" YtܥLOӴ4V X\|zN9i^m똚KƴSnzn_!p 4;v\ZLڻC_80e8íNpۑie~#4H qRYۦ`J)vM[PQB6 !H@օ,>Mojle07yddNrdɈR3m; 7!3d [܄ u05LMceT9dԖ)\O 3*)hZbCoL` ӮQy6ntzx XU5z_HEeUeXڀ<`8i \ѭ465{O::>~0-h:COUaa>aQRSآl :wQ8vbh?—(xSo,8 ]jѱYr[Ef\We 0k;U[؀@ }'LT(2~Ů/ljޮr_L`^NeLg{p0b.]sYe3 6@@^ؗB‶8K%%m'zJ2 IA@-NHd X\%kRU:3i;nazp0Zb K W1 gU0)j`B9Gtj!HaW}(9وBUXQNZj[Jw/#u'pRju+l<&=e#y7[@ OME{x Pmu"XbKv bCIV[A˿n5xσj=e ,INhdR7RiB} t>X0a 5T.5wxB;q[EDNhp-߬Hϵ[ѷIOHH~ffO/K6k,,l +%al|| 70] tZt%AYm3op3 K0Xji%A v4nݍon{K .z˂B>i(+NQXtJ f \܏ےm2!X`X L3LT/¹Y^ /K+7֠D@k :orS+xoN4ф@?Fu5,xݗOѩHI;=5),O8 juxF0 `/_r F fi(C\_x:IX,_Ǭu` E4>%좭Y LEC u**0?41աh[XCx AD4ehBvv{ ( `fNůgeH>+%ue \EܙTc8"4l3u7C#nHi~ԬL}g=&E9Ң`\>ܲpQ-IC\l*B ]A7kɱvs+3Uu]V6rPUU6'Y,QPЂ=0o{ ",Wߘ݇[@Ɲ ۗˎƱ6Bµ3M.]`ug%V\T^o]1D}z n-Z1qֱz͜Sj^{:'SeʻlOW4JR6f{ Ê q)wYPaSa"a4І-q5ZH>cG4[[T=XWOUT)ψ{ej a9}]Cm_54{mam7pWFrWݣUw8K\c2ԃ{^t]e|'p6Yk#P!uFsB}1xT E*o}_.ԭ,T-Z*r:xwe0WIۓTa)D\qc P ~2} ;$-k%m/}HM,)ѩ>ҺcP|s.C :ǗfUjuEC.b(A;- 0*nX]ͯ\ނ\Pt(}>}|T}?9?}cU}b,/&HHU[/On.<8z~`G:Ə:U_MOމ/y>@|XdK_K)v>_K)omЗR5#ZH4Tf֖#PUz[UQ@Ә =g?0IvJ zG.L=atDBNOt]<}?KvnZbj>Yo2yeo,[Lٞ*0:2cLӉNININHZFtpzB.&t"8<'SFnuM_/w;\w^#=s?{5\Qfi,uEÒwq9Ca@Zm`6rklg>|8 P L.ϟ>+\>mU|$y%][g0JQL ٠,N.@pLO>";., 4'ϟwoJ/;0g6PU7/]"C>y"EèkO6K#;*eWj0sRK &6\AMBeeeeamL% CGfIXut 2.!yVVVVי@-tr;Ti*%\A`5HeeeeeY-yd YK@QrAX4*`@y@ vh R0Adaokb;Aߴ7@=2TƔ/jüBp)Vq@0pi4LeTCHYO@al*׆kBG!29p8*! XR4y KDEkBpI+$jxwR 3]߆5"n@ZiȚS r*"/neMbA\ĭ@;V% JbVF=%/IC`Bggalluvial/vignettes/img/hover_stratum.jpg0000644000176200001440000011536713761533613020616 0ustar liggesusersJFIF``>ExifII*bj(1 r2i``GIMP 2.10.222020:11:24 09:17:58 $JFIFC    $.' ",#(7),01444'9=82<.342C  2!!22222222222222222222222222222222222222222222222222" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?N% vgMEfKtRT ȻWw,Ǹ!$z{UKI?3@ ³nuym^nVs:&/i]Pґkz\DzoK>VOzZH.Ưϲ{}ihjoK>Q/'?YT{Iiv:k;FD 6g yLƸel9™/'?T WXJrNǣKNPMWz_O? ʤ=E/i#OkoK>Q/'?YTvH>K #f*hXRO.1CcyW%?{UǜiNMrbiFE܏?I(r(x9Z}RQ@Q@Q@Q@Q@Ck뤟 _-]C4=s:/򮚹Mh˂G P%azAގj?9w'`,G5Xq΍7? 4sU7F?S}~?toYUz+"}NWQUzvk7$pʪooΟ\Qۃv,AEV?#?S}SGyV?xt}M?us_\(HDzMjʩf |&V/SrJ\rz ޿X18xثⷬ5W+nƢjkTΜ<=&;?UZI\;rknmS{敦vCkuL(e*j^(XNc9sWEJ^:nyXLsUjOٝ5 v$rk>saCִ*ǖ&8έK;QZYƒ6i"+r2m-፷$HP* [/ʯW}Lv8_CWEURj/x >wiz!)j q{YWvĠ]=E/|>V.{Zэq~˓'#]ͣ/\,o Um=>ZZ8 Z1YWw{K\޿W ?B+O?"(U0T Ң, CeYK!*s"Nx;u>5uBU.Ini RfԼ"YFV q3 LIv #yZ~׮c gdfWD妵e%yVT#A_ʝ/췾jE:@B̜&sn8NFMr V4Efvó'9q֣?%X]B9Gc6|(9÷ ?J鷺ƊH[<($;Ԛ̺L+:!X  oir%{ݭ4)$+3CyX5=[bCG''b'Z(Q@Q@Ck뤟b#J׈[I=oBWV[?C\!Y~Z?Ǐ3FA8<# {v{=ļtQ<Q4l=hN%{Ư!^hVp+Ϟ%6QLN}=jePD**ۭ:?*YȲ/ܿ(VtK85^w(#U,KNf9&/nfM4Lajslֻat*W4Ϛ J۰=4v4ddt*m?ʸiIU]O5&읽+C>Ӫ֟z*uu,Ь;  xz+'ԃ\/KܞW sF-Ŭ* VVkܷlqfS)s;JT(r )Q@Q@Eef ~BAp9 -\-Yn@'*rO$usV:كHc+ (US.a("F(=\@ȬH}H|D}VN5 Xw̽ӦCJGNZؕ=A5q%1$g2GZ+ޔ3]էy\W ?1iUǜg_ٖ}5V?!Vj޹ =RQ@Q@Q@Q@Q@Ck뤟,4ȅ|d}E2KGO\Fx_]]s:/Ahw'dqXI# Έ=Yv+%$L!zZbe-i;u wm/uʞZZڳQj6vletI;I-=T榤Z(rVh|i& [/ʯb+Q[YʪymkGQTԡ_~Ucl Z=E\`巡j\`4mIWqip5UOOO<kΦ|.&֟z*V?!@4QEQEQEQEQEQO+u$&Q`.Uc>ROmiin\*/'5~4KfYFcԙRr\,ϹNqYhűM_hűM_kBVEsK.!ċcLH1u楶tۨhr2?FiX8llSKh$II94Y ]ʟض?ɿض?ɿhQE͞ ; `HX`吅g=0)SKt7 LrI9?][@m)}7Q,ǩL˴nX&W$ض?ɿhQJ|Ϲc<'w)29qGnEE{)[$Crfq KNUFe?l o2@z s<ab5h-mfhT6tHX9=i)EO6Qy98zZ!X9$$$F.{p~UQEQEQEQE]http://ns.adobe.com/xap/1.0/ ICC_PROFILElcms0mntrRGB XYZ  acspMSFT-lcms desc @cprt`6wtptchad,rXYZbXYZgXYZrTRC gTRC bTRC chrm4$dmndX$dmdd|$mluc enUS$GIMP built-in sRGBmluc enUSPublic DomainXYZ -sf32 B%nXYZ o8XYZ $XYZ bparaff Y [chrmT|L&g\mluc enUSGIMPmluc enUSsRGBC     C   ' RF)MD @d !qvEdO@.廹î B HEof]R$A$ æ4pLAn"q2@&br8n GM8:0 T|_l12Hc{ai9 vpzqbd xoOU@:0D|sg5Z1S A vaMA2y&C:07;`"zyӳ˖ĀA$q}Gpq\s=#י)"-e쟌XH =EGeAm@bd 8xTP9ٞF]Iax2>s)<:j磩C08yo]&Xyi٩nH9t`J@S3nc(ۊ,vqy>:xeb yӲeAmH% {~kGM8:0DD̀An!綾gS䊽MA"'&.jo($lwM'侮eǢ;рJ@"dA$""f@y+^^O]笶T)=8줘eQ'һZlѽR {Νv\$"Ofea7d$;ϨP8t`g _ĝye3H渲ُq6'k}{oAu&$y.?Jpz&cSva D| 7j.9-0͏Y8iVe[3e{Νv\$%N++}q@HsF |r/KR&f ,-}+7;q=#*յ{^tW"zyӳ˖Ā5MǷl{sQ;ߨ@8t`˟;_Xs8f{* p>/cnw$"}N|ПzU˝9Fq8t堶9D17=|=goI #<~4_ c5~OWVRH7;q2 ˚gӋlɐ*=P;.Z o0eS_^)wc,g 8@уO-;&>W5u[ed  ϖaa1m6r^ ^}tZspq뢿؍&b8>уɅ/EP"El >F}l f|w]>ڿab.|M0#ھL#-ub|glɔ B%1y/IəLupfz02yo Cc4bo"[E'٤Z-&btr8mMw綡ꦔIJc>Hy鞌S t{Lv_WQ"c,XeZ0rasu =~}5T:O{qO9(dC\~Z1sR?7;`,g秛H*=P;.Z o5mrOр>F}nru^4[)ɔC8geI5fL"R02$ 9-qw?JAn|FQ=-YOB9N?vP.u(qss$&@ wQpT|gt9m綴$ktkgN;.z+* mk8t`* pGȸ5v  $r&@!3IsFIn"q@ tr8nA %5HsF1c13i#aLnBenuU"*c-~kID&PH Q峛ǤnmH Lp+5KI!^xD311%:Ɗ(O)M2 hd42xd42 CC!g0O=>(1Yf&Cc!hd42c!hd42 lz|QGtr(7Y Mn=CWA܏8}jZh&O1Ӫeqv"l<'u~9]̌t)2++Q@Y-Tr,;Sǃ,Faqu5$I$xOuuBkTv~MTb@Hsա;]yGXNT]$>-$V+XZOj'0)P^Q^vTS0fxO e-*L"'9]XI.Cm;J*TLVUU6ZUKkZn-m)"ׯD$.Cu3@+qҫqزʉq5z2kpm xTn26%XIL gg~$zd-!ԣBj55 MpYe; &Xd 7ڞ?0 ϡ'o1dt"s)=~ŞmLпҲ(j oRD~~WqfxOJYD6R{I Bо#$ZR,VMwC"[78טgsF#IxFpg83Vb$N5er)U!V ɗr^̇gϤs1F 0R/"s)=k&_|YߑO9]yKY fxOq빗fȉlWK֩oU O[d P*3ڌ, M OusG2=̆&.r)PqAIu!)Wn"Q=N#xy<+ u&Ī4)=~KQZimTRZE/JD`dX eU7_i+Xutf ‚ W"*fngDla΂;+:RxnO>-Ll" UƆRXn)6mdMVk 6CKCC2զ% Q++:;("ȃ,6@8t{zPxfrҍBÙ"ܮmuU"hZFYΪzIgti;vN5jR =f&h9gK5c'HmŸlyPğ `ζah{$W0B& /empQzCc0ehFgAJW_(E:.6K0+h'-_ptJ¡4yiAD$'Ue2Ѥ_SDR+!ݨ}Eʍ_pw``rt=&G9\NRCDUA:Bwsų-1lqg;[;bEgW>o:W`uSDUY8Gxք̂tdZ`Fxtq3v%K,Y/_Ad}1.sD')LjEp+ҒCQ1b{ j1=5OaF'ƣcQ1b{ j1=5>Tq2'[&Yʍnhb;'Vk zxC梬VC_5^5_5^5_5^5^@TQ(kkkkkkkDD[J_|3}Xy0X/.1 !2Q0A@P"aBqR`?G9 y+W9^ry+C#y+W9^ry+P58™O4*)B8™O4*)B1d9]vCWd9]vCWd9]vCWd9v =r!+r!G+r!+A5n,Q;`f7QA`4kմ i+x8Xb;V#Xb;Ps yW?k5]nFXb;V#Xb;=DC1vq7Zȩ+!&6 r3vW!2 .OѾf-"w;iS['_ٜ |2^Ch6|(;kMB5THNu_c,c/c[=zfQ _ SzV65]Nh2(莋ݓQM7Ty`#HܘdS^SZ3fXb*&6SP3|wtDI©jiRk$Sv(`#Z8Ȩ"e5[ R]EoZ+ iux r3w7݅PxkbT Aa4N&;`A8'QA4)/1НT12Eo3fƊjn;DuPx 27jxSώ/ .) *hӘ#7fqP͏9zr)//fFb7 c)FnT6MF%Goוx+^ Wly{Mjr7C5V39Xc3V39Xc3V39Xc3Tg8jZVUkhyTMaLOKg2fk a,%XK a,%0XK a,%XK a,$D|1!=s!ݍbH_M  !1t"234AQas#0@q5BbrRS`Cc?\]h8IwږZCucZo$k(ZkZ ]ַ69teTYzU|dIa+eeARТٯpFgof$(:#sGDnh74tF授:#sGDnh݉EkYFu)5&7^ϸ#{3dr튥4j74tF授:#sGDnh=:#sGDnh"lSLcٯpFgof}M)Jfh[!ܓcrLnI1&*!1F1@'7qa-O鍜HW1&NܓcrLgmmSD#+}6_w⋯s?=xh\Qif7qaOJqTgŏ+}6_w⋯s?=w2jt\vK%AQٺmQ^fc,R%S'l*sIAIB 55ڼuюh4\w _M9]Ʒ3׋}Ӌg@\4܎JW:i0TBq-<0sqR -O-QkXk|z`!9ՌWZmvelTG '7Y2Om -4jW*~mwdUKCz"YiId,I1HerզT,YiYyײ U8L!sK{P594e v6iڄxC^ Qbɮ&'eyZqВaZKWZQ4HO c¿# RVO&V-ZiN<0۠&fY̛:8A˿c`nn4(&~zWZOJ9sw_XˈܐWZm C$pIɓ%m3@4N HKRKuJAns O.i/)|1/0mx:]%U-`Y+ē2\BTآP[#xɠ7,2E1XJY/Fl }vF-0f,@t$hr̭d d:+kF-a)yw]r AFx,$ā icjQ0{Laɑ Mmg5ԤH ZVF# Oꢫjng2l mSkH4O<^ XbBj3zK.Q8SjI$e߮pۅ䛝UW/2{J4AJwqJXJ+r6\=BKְkF=Lm+Uvغlmx?:C::C:Fa4lxp|.R4ERJ qBSo$k6+Cj3Fp gW xseu՗]r@c)~3T6Zs~Q3^EuTlM~eߊ1۲-@B!y`-CJHdI ң㩌Isw_=f־xԭ4-M=%$ܪyM%kDsa95-'CqN%FsCkJpYYH$rŷUe5xጣJkL(1/̻F3ܚg4h-)$.,#8ߒ55ڿg3\WZms!O(y0yWɷX%H2T-) rUBE݂hZ<H8(tx}͉ϟDLyB3Uisע̦'38cIjNRwFBȥV6vjxi*D\zc11$k viLXPFcLH{N+}6Mj&q% LaIPr8ArMJ6˭-QV}TSʯ,%~(&5v\ƵWc7d=f־x#iM<7K-9*KD\Ox- $ܗ]ι3rݭ.nZ]iٻu7)]1+67 =/,7h}BChZ0zK.Qvc\ELZ:qsw\ iٻu7)ע FKHX˾1aHZ-lU˿]&~zN\ƵXLrc/{N+}6Mƽ[KMVڶ83E&C7`tT2f5ɟ7stFvȎ(Bp4 q fr/SK0TܪL~12@~+1ċºotH.6ˍ(K.Qvc\A)1_Dl@%5Xsmki3Y* +iYvIn Yu8mԃŋ _M7.afy5($dk?L:Tσ%ז}pְke7EѺ/7E辘1}1/ލ}1/7EtuH{N+}6_w⋳]̣7]oG%kXk|_WZm̿2f5i5J1'7D螘zctOLnJ1qEGD7qah4F4h4Fw _M9]_Z_ºoe~(3%uW7py& 9'^4 &O e~m!H#}}eVm%;p?gu1t^_s OȪӮ;UMϖ7[_uG#FkzQdz7)'fliHޒ=m}oY7[_uG#Fa%"LR׆W:Cʴ$*QP_t__slȷeĹ_ Yk޲=m}oY7[_uG#FkI?JoI7[_uG#FkzPǂȜv>}!.`"(.*@+:C:ri 6e,26)H\^nCi*AI䂆%FEDzK̫AcC,AV ;.:`pVMlɲSsJRkC}hpajJ J=']!iEP OAvYR(%l*%%y3fuYBEI[s NɸUMx% J͑pg a _ y[M6TA NA.%_}CVWeR=Vj9MFyiKH)GZ u lM„g6BL2mJ-U&EV26[RxXC \yg9( ]m*Thܰ,@Ʉf%S>(‰vS(M͑(V(*!1AQa q0@P?! .aU4SK6x- *1F#b1F##F#b1F# /Bpf@Ryи$H-6 NNN@[\ YMg+v` bf!وv`C_!وvgw1C;1CլNC;1;0W;gf.4+mw.08+np ǮN\Wfw7n"*jIqedJuQX) uP.Ԭ9ٴEb 08:cpvmm%5VO#ޅLQ %X,>:hEK2!%P+x ɥ^si cx`|)2 5scЍ0C}&$zC:{ǬUB1A*.rG V P3Bp,yf¥`Az,Sdʾ h=,%$!{U\kb$', DYhD'f d:bv~BITbJ vpk$dg^K-B"yLQE&5) K^5$*D7HRVTh&ٜo4yNnw :H E.DR4ڐwKVa@}jn,lHa3vM ! 0ie@9 [ s!].#vĵ0[*mP7TIպ0]=zIP^vJv2N`ЈcL 9QCCHx'pvm0Fws|AFK.ZT%2^.YV$H@&sE#`/lQ }yR#̞L1pF`]%(1b3Dd̈\"ГU\g8U;86)Ƞ8V s= v:E(@?a;StYF03d^i!ؖa?ٴzZ&EMfǿ)m{+@ע6jS:(;%69%e"!`*[ $"4A;PHlS$MQ@, ?B<@Q,{n- Xc\O -ǀثh59ҠݣNӄ@%I5} &{b:ڷ Dɘe#PDΰ0@d@Iq<<?{_ڐPL%==nbŹјj@)#9lLJeycz|wv9g@F3KG&0rVf :tg8U_ 4Da g FI ¢DAa! : PVpGsđgQeWfM,u(8 ޏb3`@`:)(Fn -%+u0 >ϼ@ŹxmF aY9|8- %@@0X (BJMpwz0! vm =  #{ϊp&ya#BBT^ޑpNRZ(1 @)TP~>**+!*Y xP 5x;6x!-a$a\W~gOx[O ۴ܿq5Y!~#Rت-Ai !wErb,;'08.XdӒI,^>P!`iIC9gQTXOH Jy1L'TI z87sBYtM ;ƜRGD?i2V{!{LTH[(( Z߮/s`6#fHCz( McdC8&M`;E uMKq\P8elx(xPlWt +*0_1M]3i2HTbD 9\B :*LHӚ @%f=2}x'`M-i:K0VaK Z7IW'hf F/p)K`t+tP5:f- /($jr$?8 C@ ]2KPD#Qx:렰6;6"gK$7,.9ņo3V(D8s =g`R*I`Gr+q #%.W'FR J'"iDw3€!m;C yT!A:!gL?")YX|4F0F@: PTEaXU2 PY Jvm8Ayg>,kNK)X$hС']p=vE=4hnR7@@ѣJPvX,@V#T5 [7!~AK\pb 2ٛ0:a,(K QE & @KC>cR#0mAm5EQCA)@N(*+\E M)CpQE.VJ ta $ F"qJ(r̈́tB$r= $b7cʏh8'R=؃D0 M<R *2*x)M-k[JuT y KcN^'nǑYA )Q!3󂖟(KE(d8_  K (@IILM$: H $I$I$I$d%"I$vI$I$I$I$|IdIY$I;$I$I$G$I>Y$I`I$I$I$I"I$IRJ$H$I$I$I$G _$ 'pI+KI$I$I$I%I$I$I&ҿ$I$I$GH$IIA$yI$I$ %rsme$P܋I$I$I$0xtDeG vI$I$I$I$u|d b0Y|$CIK$I,YB8I'FoBI @"&MB$Үb`$Nʂa)&4IFH2{(I 7ͶK$H$~&kdH=X$I\[$oI$߲Ez|ܭ$^Q0AI .dII i~2a3$I$mlI$e$Y#I4qΘ$OI$EI,m$FI6I I"I$+ZD" $ I$I$K5@J$5mI` $I$I%$đQo$I$I$MD?*HѣHtْI$I$I `@\u $53I$I$I$X5p ~6`dZI$I$I$IYL-sA6 $I$I$M$I,y8 S5I$I$I I$J>ݤI$$I$I$I$Hn F$iܤI$I$I$I%]m%L-uI$I$I$O$*H$I$I$I$I"pAkp߭I$I$IX''~$I$I$I$J$$=DMՒHrI$I$E$%AH,I&I$ $I$I'*!1AQa q0@P?[ ,_s+1]!jSNi94ӚsNi9g\!Ri94ӚsNi9p?Eyo97 vfXwVst`K'\7.o9!L^Ԅk4=Ƈ{a{4=Ƈ{^cC`E:k' J{/w4=Ƈ{+,w4=Ƈ{>k\?C^=[fl&͙t06+ z [ *Shqnz|.M0]=L M&c"P1,V|Z~Q&I-:1jO]Ajr^Ɨi;^ƗОHzBA lm&͘.-]AD/cAv4/cKg OȻu?rc"\y!+!P$*gX0d\Dٲ`BV/q8D#QQlVYp~HTpMQ(S7dXK5]UJ 8*bxdՠbQbvӛ(1 0 ] &L%}ELlki,$]c1B\j+_wQ 9]3`6lI89Ijc# (Q5֚@(Ђ*.VZy,7iڵ2m%\NӔ3nXܻfrlقRDtK-WQ$46 D,CH?9Qf,ƐK&XQArux9Ud5Mħѓ8d]3`6lt R*G'&y7R@$/Q)i!kKeP4 E2pʽ 亦BinGU^ .\6'I̲WI@!DS!bT?adVN]hY=L hflDLQEɳf]t2sR*j!pEL6+Ϡ[qg?s%U8Rȷ0%\*)L# ):T3h6lTȖ<'J3bv^r3.]U1rDnE]3h6lt`ٰT\:Cɱ^} ÅluIݐek3:%a3D5.QyS w)j껉"xH#U1{1{ <…uE8'Z)Uti/!>!7-2%VJ'Kэ^cZTsDFU+qy%T8%>urL9DE"xc+s8ڑJ*gk`=@8L + HoȔ(]X)w:G)w;uϊH(z\"}Vg5V7މu2 ђ&J6W!m`P246kO+u^FR)yBګgӖɻqD%à Nbn IHBI̸JL,X R\mqz 0mX Ty`)*p [Hփlbد?ۯ Cbp)b8%\'_DL%!x6t×3}>э2Oq1F6+ VF2 R+")&9'"6`X۳ٯ?r6% tQS#UUy(㡫j 8ƯJ' 1!UGqFKAiaad}QGT}QGT}QGb$ůPYȅ "D,Y!dBȵ) 3؊GdYRY,OEռ\/R?1ߝ<%aiY3ddS2֭5v+33##"߇rDԣtBs¹̮es*7 'T6es+\F|+A9!\W2.̮|'?3̈f Sb\DuP%6lV.|*TWT2NY{ҝK5]}()!1 0AQaq@P?Ÿ&\5'B% Hir"wqwqwpdhfJwqwqwqϢn_WYKa7/ꫢKM+U]e/4ZuJrrrrrrrrrrrr|҅9E9E9E9E9E9E9E9E9E9E9GymPPޏz=ޏz=ޏz=:N2){z=ޏz=ޏz=%up˙,j,EFŀ Z̹ 5W:(DI+ m+7hv^z*Ɏ,)#cp#v;ClX>nԘ4P:8/]$-uE ̹!5 Y7 !Dɓ94 b-ٗ طR(i#`{eG׬$|JȌ4tS44{SICґN!]: !,̸D&*x AgiHEuփ:71 "iIm1r &[$$ČF=U^?8Ε:!5GR!K3.d=VEk"aiK$OGW cT%EG8E6+=ګ4(.Vzc&7_~uM }P(CrrbqVzve̖}\!DՍyԞVF"`jr*' Rj܈TФF5  xbrٗ2X8!Y0)%:UGw_Imʂ&PNP""H($",̹!(,jǂ\Z2Smo8SK EF#8!d2-j` ٗ2X^H!$P]H Γ!7TqvG6ET ݂& Sf\`,CU P6tFNP- Y'.d=4P!T c7IXL(Z6.Hd@;<wٗ2X( [6=U+|KYf$ԁ,s%\8 A\[Į-en7x&r'bB%6 'rD\4GB3RvsM.D M*ȾBN:E$F (Bz)6ҺR%)2~Ci\5Z7p) m S*t/)vSI+@:'P(TȺ!!%9A%Z1pp'"B,}Rҡd=зIDD ʼnaK YXY'bTq Wf\`{b+.$R>-eJ4S(ٔ0q-O9W8j6[PJAiVXAuV.̸)hc\~uJ#nPt%Y}(jj{J̸A`{} YR[;NӴ;N&2A2cs#$3t:GL#tK!I>?$'q݉PFHNI|%K/_$I|%WKwsMc6UtXqig3<3k<3w)!1AQa q@0?SQtE7aFē`ŵ CYdaLq( *c:N:N:N/bc&8Rgu 'Xbu'Xbu'Xbu:^Lq1@̩RJ*TRD;J*T 8J`Ϟq0jPdY ZvjC@jF?zjO~'ڿ_ާڿ_)C:O%g^5A*{v6.XX$:'iį>jO~!ZzB>jO!=/X(*evڨk6~Gw|4$!hsapf]==]Gw|4$!߰hsap3ٿq%˗.|r>g= W.\ף %˗`{7jo1 M jƏu74x@MܓGpU6/'fƏ--- <}Tcvht7-EXw}zwݧk旉v3{M;NX{%c( &sٿ/]PPR*@eE.R#.%LXpr+P-XaQk .ুs13s1xˤj@MACrk ÑP u{7-H giPT LY+ cESq^&j#6!u-`vMBYRh_}^ pw%X=)I oEwvTyE-VrKܞ73m(zL~^ᲊud0bzāEF {kB^)j\ = ΦEOweofo0tSK'Jev5G_ =((X}ngClL<@'rxϳ87TӶ]/RXH|0Ӳ8puf傝c3ٿ,I4kbR*[y<gb@t. *^W~UCHϣ,)Tˀ]-| ,[XHGQD\Z-xFl(?prјCEb%-o{7mZ8 \_F+:4е #dyB6zf[E@.1n͗#JM[DR)d -C.?rs!ja]MP %j@S,#/Ddm2 ~5vƆ v|MzW4mݽ?5Y֖hl#D(KcN5+ cLj1p#Mis)vFgA݀*FK9c Ъݶ,?rWl`?W2D)6mQIӪ:AsKUT,$C!)r撎'~mBb7a{Gr1 B!\+;]=eD |WAziQdm{@Z%SI/22}/ev>C&db99/524 K#+`],µlCDX7y=T &շC2Tyq- *RS1DO@`xz{=?lX%j y|qce$p7R=XT:-wJ]LJڛ*?V[ YgP5[)"%hxBl\%sj -%U\F?( ME7^PZIsK'2xϫ;.\E]&V~;l??j(#/5/wٻoS/M(\m1*@wPJ^2/Ib+B v4CVtIMB%JQ֔P@qT4SEI1bRqh*m䌰@ ̸.^K3]M Lb} 5TjN)#GX/6jF">3+|c ;%G53#0,s5_K D0]la]5 Px d( XeNKagm 1Qfu<}f46'U F DD!r%SEnwdY3 PӹM/kh( @c{Hip2)d;r|OD QZ4F۱=F#(p+^f'"5Lpd;{B ;/?jǮ ~j}j{:U PLR \s4&Vzs}mH$ng1zJP2cɀfƦ3~ 齆%+F"'Co9XKj"@Xz{(-ٳ Ut9` )<`b}_/vZTZӨ=`p"70(c*':Af|zE$4a0~g?/wٻls^F{$|!J'YXMPSA4XZGM u+K-)[C58 p]z)>IB\܌7zT8[sN%.h' ‰CD[(~^q[n(Yj.XK̷M|/W4lM}66jowٻoF{dJe^*z +RU9`(=]<.н+z:f MuŹ7#CsE9ecE1/x[6(ɊQ}nVW/c>k܇p2iH@ꢙnP̮o !u:%dfm.'XvephMn^~Y~v ϡхn5ikl4>X,;)|!B)G@l 8+h>:뛒!Ѓx*. l,DL[ab ~m j̪[jϗaEn\ m)?1ji_S[4ưblij@|"/<]йY͕z tehL@oS+j=5bxeb݂Ҁ)jS g21]fHK*2` -t)=&M iaSCMoӲb"u*?*Ŗ+hm6O~h8B7eFiC5^'㰙_⸤rˏr鼩G@)_u:((s>9߱*^B咝|cǠ!]8ٿ Ğ=\Q;)! 7ƚVmJYޥ!P8=YW(*9ϋ BD}(sx_ԃJvM@M|9t faPڽW#5ap% ?2{ڞ^7妆ĠԟG7dB5+V%AN ySˬ=] c"o hP_V+rTSRw]χkBuك܆wo=ov0(*s I~spr8~?$$xMw*>H֥8xCSm>?y<MFXbK 5R-9rnAE?G3޲ߣ>k5AC~^s}3RQ.):s\j``T__h(NO۩/ܽO5P+c[)_K(oG/_K) 6Rk7jj 5b69ɂ- ۨ{ʐkgO(Юu}Y̴>}>x55AVK+a>!DgP \1]?C{:oCft{Ag%wofmL[3hΠі-[-卮]eye(eO8^˻NH yz0`46p=oZGw|4$%_v]MϷц?1ۼ3ٿ"b 5 !Y EJ<bNÙdxqظ Rw9qAd( iɊKlEZ4/5wN|oύ~v⩘])峸)3ظ]ޘ׳V8b Y5Ė]cT, 5=Ji"˖~k_`;EZ ب#{\=`+0z@y(lm+)++I[M5]/YtiG59exBtIYYYYYjX%v B ˢ,rţQ2eecEjˤ50IY`-tkU2VVVP"4UTP +!7Hӳ-]|&D5[ PE#H>!6DKF&+EM /k],RMJ1epV 0q+y;G&9j$,/d\VM9WR@w&hZ(@4^(eJ4r2YӋ6hb Qvqh]ݔ60# ( +%.Qs+^ GNsS%{^%mk0?ggalluvial/vignettes/labels.rmd0000644000176200001440000001542113761533613016372 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.rmd0000644000176200001440000003777213762213101017260 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 (PDF)](https://CRAN.R-project.org/package=vcdExtra/vignettes/vcd-tutorial.pdf) 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 grouped 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::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 version 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 existing **ggplot2** functionality can also produce [parallel sets](https://eagereyes.org/parallel-sets) plots, illustrated here using the `Titanic` dataset:[^ggparallel] [^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. ```{r parallel sets plot of Titanic dataset} ggplot(as.data.frame(Titanic), aes(y = Freq, axis1 = Survived, axis2 = Sex, axis3 = Class)) + geom_alluvium(aes(fill = Class), width = 0, knot.pos = 0, reverse = FALSE) + guides(fill = FALSE) + geom_stratum(width = 1/8, reverse = FALSE) + geom_text(stat = "stratum", aes(label = after_stat(stratum)), reverse = FALSE) + scale_x_continuous(breaks = 1:3, labels = c("Survived", "Sex", "Class")) + coord_flip() + ggtitle("Titanic survival by class and sex") ``` 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 `stratum` variable produced by `stat_stratum()` (called by `geom_text()`) is not available before the statistical transformation is performed and must be recovered using `after_stat()`. - 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 and functionality cannot produce alluvial plots with the color schemes featured [here](https://epijim.uk/code-snippets/eq5d/) ("Alluvial diagram") and [here](https://developers.google.com/chart/interactive/docs/gallery/sankey) ("Controlling colors"), which are "reset" at each axis. ### Lodes (long) format The long format recognized by **ggalluvial** contains _one row per lode_, and can be understood as the result of "gathering" (in the **dplyr** sense) or "pivoting" (in the Microsoft Excel 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 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://www.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" plot produces 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.Rmd0000644000176200001440000005553613762507372016241 0ustar liggesusers--- title: "Tooltips for ggalluvial plots in Shiny apps" author: "Quentin D. Read" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{ggalluvial in Shiny apps} %\VignetteEngine{knitr::rmarkdown} \usepackage[utf8]{inputenc} --- ```{r setup} knitr::opts_chunk$set(fig.width = 6, fig.height = 3, fig.align = "center") library(ggalluvial) ``` ## 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 a Shiny app that displays 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()`. The tooltips that appear when the user hovers over elements of the plot show a text label and the number of flows included in each group. This is made relatively straightforward because 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 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. ## Data for reproducible example This toy dataset is used for the example app. ```{r toy dataset, message = FALSE, warning = FALSE} example_data <- data.frame( weight = rep(1, 12), ID = 1:12, cluster = rep(c(1, 2), c(4, 8)), grp1 = rep(c('1a', '1b', '1a', '1b'), c(3, 2, 3, 4)), grp2 = rep(c('2a', '2b', '2a', '2b', '2a'), c(2, 2, 2, 2, 4)), grp3 = rep(c('3a','3b', '3a', '3b'), c(3, 2, 2, 5)) ) ``` Here is a static plot generated using the toy dataset. ```{r static plot, fig.width = 6} ggplot(example_data, aes(y = weight, axis1 = grp1, axis2 = grp2, axis3 = grp3)) + geom_alluvium(aes(fill = factor(cluster)), knot.pos = 0.25) + geom_stratum(width = 1/8, reverse = TRUE) + geom_text(aes(label = after_stat(stratum)), stat = "stratum", reverse = TRUE, size = rel(3)) + theme_bw() + scale_x_continuous(expand = c(0, 0)) + scale_y_continuous(expand = c(0, 0)) ``` ## Structure of the example app Here, we will go over each section of the code in detail. The full code is reproduced at the bottom of this document. ### 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 = "500px", 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. Both of 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. ### Server function The server function is more complex. Its general structure looks like this, in pseudocode: ```{r server function skeleton, eval = FALSE} server <- function(input, output, session) { output$alluvial_plot <- renderPlot({ '' '' '' '' '' '' }) output$tooltip <- renderText({ if ('') { if ('') { '' } else { if ('') { '' } } } }) } ``` First, we create the `ggplot` object for the alluvial plot, then we call the `ggplot_build()` function to build the plot without displaying it. The next lines of code are to "reverse engineer" the polygon coordinates. Finally, we call `renderPlot()` to pass the plot to `output`. 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.jpg) 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.jpg) If the mouse cursor is hovering over an empty region of the plot, nothing is returned by `renderText()` and so no tooltip text box is displayed. ![screenshot of cursor over empty region](https://raw.githubusercontent.com/corybrunson/ggalluvial/main/vignettes/img/hover_empty_area.jpg) Let's take a deeper dive into each part of the server function. #### 1. Drawing plot and extracting coordinates The first part of the server function includes code to draw the plot and build it with `ggplot_build()`. Note that the global assignment operator `<<-` is used to assign `node_width` and `pbuilt` so they are both accessible outside the `renderPlot()` expression. _Note:_ In the example presented here, strictly speaking all of the plot drawing and coordinate extracting code could be 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. So we've left it there in the example code. ```{r server part 1a, eval = FALSE} output$alluvial_plot <- renderPlot({ # Width of node boxes node_width <<- 1/4 p <- ggplot(example_data, aes(y = weight, axis1 = grp1, axis2 = grp2, axis3 = grp3)) + geom_alluvium(aes(fill = factor(cluster)), knot.pos = 0.25) + geom_stratum(width = node_width, reverse = TRUE) + geom_text(aes(label = after_stat(stratum)), stat = "stratum", reverse = TRUE, size = rel(3)) + theme_bw() + scale_x_continuous(expand = c(0, 0)) + scale_y_continuous(expand = c(0, 0)) # Build the plot. Use global assignment so that this object is accessible # later. 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`, which has a value of 1/3 hard-coded into `ggalluvial::geom_alluvium()`, then split the data frame by group (groups correspond to the individual alluvium polygons). We apply the unexported function `ggalluvial:::data_to_xspline()` to each element of the list to get the x-spline coordinates. Then, we pass the x-spline coordinates to the function `grid::xsplineGrob()` to convert them into a `grid` object. We pass the resulting object to `grid::xsplinePoints()`. At this point we now have the coordinates of the alluvium polygons. ```{r server part 1b, eval = FALSE} # 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 = 1/3) groups_to_draw <- split(data_draw, data_draw$group) group_xsplines <- lapply(groups_to_draw, ggalluvial:::data_to_xspline, knot.prop = TRUE) # 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 fixing the range of the x axis as 1 to the number of strata, adjusted by the width of the nodes, and the y axis to the number of rows in the data (again, this is possible here because each flow polygon is exactly 1 unit high). We define a function `new_range_transform()` inline and apply it to each set of coordinates, assigning the resulting object globally so it can be accessed later. Now we have the coordinates of the polygons in plot units! So we can close the expression after returning the plot. ```{r server part 1c, 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 - 1/6, 3 + 1/6) yrange_new <- c(0, nrow(example_data)) # 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. Use global assignment. 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) }) # Return plot p }, res = 200) ``` #### 2. Logic for determining cursor location and displaying tooltips 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`. ```{r, eval = FALSE} output$tooltip <- renderText( if(!is.null(input$plot_hover)) { ... } ... ) ``` 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. ```{r, eval = FALSE} hover <- input$plot_hover x_coord <- round(hover$x) if(abs(hover$x - x_coord) < (node_width / 2)) { ... } ``` The nearest integer to the y-coordinate corresponds to the row of the data frame because we set `reverse = TRUE` and all `weight = 1` in the input data. So, for example, the first row of the data frame corresponds to y range `c(0, 1)`, the second `c(1, 2)`, and so forth. This gives us all the information we need to find the index of the rows of the input data that goes with the stratum the cursor is on. _Note:_ It is necessary for the input data to be sorted in ascending order of the `group` column, named `cluster` in this example. If it is not sorted in this way, the relative order of the flows along the y-axis will not correspond to their order in the data. ```{r, eval = FALSE} node_row <- pbuilt$data[[2]]$x == x_coord & hover$y > pbuilt$data[[2]]$ymin & hover$y < pbuilt$data[[2]]$ymax ``` We get the name of the stratum as well as the total number of flows passing through it. ```{r, eval = FALSE} node_label <- pbuilt$data[[2]]$stratum[node_row] node_n <- pbuilt$data[[2]]$n[node_row] ``` Finally, we render a tooltip using the `div` tag and passing it to `htmltools::renderTags()`. 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 the mouse cursor location in those units. ```{r, 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 ``` If the cursor is not over a stratum, the next logic 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, 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. 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 will display the names of all the nodes that the alluvium passes through. ```{r info for alluvia tooltip, eval = FALSE} coord_id <- rev(which(hover_within_flow == 1))[1] flow_id <- example_data$ID[coord_id] axis_values <- example_data[flow_id, c('grp1', 'grp2', 'grp3')] ``` We render a tooltip that shows the names of all the nodes that the hovered path passes through, using very similar syntax to the above tooltip. ```{r, eval = FALSE} renderTags( tags$div( paste(axis_values, collapse = ' -> '), 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 ``` ## Conclusion This vignette demonstrates how to enable tooltips for **ggalluvial** plots in Shiny apps. However it's important to note that some of the workarounds are slightly inelegant. This may not be the optimal way to do it — other solutions are certainly possible! ## Appendix ### Complete app code ```{r full app, eval = FALSE} library(ggalluvial) library(shiny) library(htmltools) library(sp) example_data <- data.frame( weight = rep(1, 12), ID = 1:12, cluster = rep(c(1, 2), c(4, 8)), grp1 = rep(c('1a', '1b', '1a', '1b'), c(3, 2, 3, 4)), grp2 = rep(c('2a', '2b', '2a', '2b', '2a'), c(2, 2, 2, 2, 4)), grp3 = rep(c('3a','3b', '3a', '3b'), c(3, 2, 2, 5)) ) # User interface ui <- fluidPage( fluidRow(tags$div( style = "position: relative;", plotOutput("alluvial_plot", height = "500px", hover = hoverOpts(id = "plot_hover") ), htmlOutput("tooltip"))) ) server <- function(input, output, session) { # Draw plot and extract coordinates output$alluvial_plot <- renderPlot({ # Width of node boxes node_width <<- 1/4 p <- ggplot(example_data, aes(y = weight, axis1 = grp1, axis2 = grp2, axis3 = grp3)) + geom_alluvium(aes(fill = factor(cluster)), knot.pos = 0.25) + geom_stratum(width = node_width, reverse = TRUE) + geom_text(aes(label = after_stat(stratum)), stat = "stratum", reverse = TRUE, size = rel(3)) + theme_bw() + scale_x_continuous(expand = c(0, 0)) + scale_y_continuous(expand = c(0, 0)) # Build the plot. Use global assignment so that this object is accessible # later. 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 = 1/3) groups_to_draw <- split(data_draw, data_draw$group) group_xsplines <- lapply(groups_to_draw, ggalluvial:::data_to_xspline, knot.prop = TRUE) # 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 - 1/6, 3 + 1/6) yrange_new <- c(0, nrow(example_data)) # 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. Use global assignment. 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) }) # Return plot 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]]$n[node_row] # Offset, in pixels, for location of tooltip relative to mouse cursor, # in both x and y direction. offset <- 5 # 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] # Get the corresponding row ID from the data. flow_id <- example_data$ID[coord_id] # Get the axis 1-3 values for all axes for that row ID. axis_values <- example_data[flow_id, c('grp1', 'grp2', 'grp3')] offset <- 5 # Render tooltip renderTags( tags$div( paste(axis_values, collapse = ' -> '), 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/vignettes/order-rectangles.rmd0000644000176200001440000005315613710336102020363 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/stat.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/0000755000176200001440000000000013762566201012612 5ustar liggesusersggalluvial/R/stat-utils.r0000644000176200001440000001007613761533613015112 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 == "none") { stop("Data is not in a recognized alluvial form ", "(see `help('alluvial-data')` for details).") } else if (type == "lodes") { if (is.factor(data$stratum)) { data$stratum <- addNA(data$stratum, ifany = TRUE) } else { data$stratum[is.na(data$stratum)] <- "" } } else { 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")]) 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_fun <- function(distill) { if (is.function(distill)) { return(distill) } else { return(get(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")]), 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.r0000644000176200001440000002771613722770406014732 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"), # ` = NULL` prevents "unknown aesthetics" warnings default_aes = aes(weight = 1, stratum = NULL, alluvium = NULL), 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 if (any(is.na(data$y))) { stop("Data contains missing `y` values.") } 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, .dots = 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.r0000644000176200001440000003026313761533613015521 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 #' @import tidyselect #' @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), !! rlang::enquo(key)) value_var <- vars_pull(names(data), !! rlang::enquo(value)) id_var <- vars_pull(names(data), !! rlang::enquo(id)) # test id-axis pairings within each site (see issue #65) if (! is.null(rlang::enexprs(site))) { site_vars <- vars_select(names(data), !!! rlang::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(rlang::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(rlang::enexpr(weight))) { weight_var <- vars_select(names(data), !! rlang::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(rlang::enexpr(weight))) { weight_var <- NULL } else { weight_var <- vars_select(names(data), !! rlang::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(rlang::enexpr(axes))) { axes <- data_at_vars(data, axes) } else { quos <- rlang::quos(...) if (rlang::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 <- rlang::quo_name(rlang::enexpr(key)) value_var <- rlang::quo_name(rlang::enexpr(value)) id_var <- rlang::quo_name(rlang::enexpr(id)) if (! is.null(rlang::enexpr(axes))) { axes <- data_at_vars(data, axes) } else { quos <- rlang::quos(...) if (rlang::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(rlang::enexpr(diffuse))) { diffuse <- if (diffuse) axes else NULL } else { diffuse <- unname(vars_select(names(data), !! rlang::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), !! rlang::enquo(key)) value_var <- vars_pull(names(data), !! rlang::enquo(value)) id_var <- vars_pull(names(data), !! rlang::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 (distill) { distill <- most } 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) } 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 (rlang::is_character(vars)) { vars } else if (rlang::is_integerish(vars)) { data_vars[vars] } else if (rlang::is_quosures(vars)) { out <- dplyr::select_vars(data_vars, !!! vars) if (! any(rlang::have_name(vars))) { names(out) <- NULL } out } else { stop("Either a character or numeric vector ", "or a `vars()` object ", "is required.") } } ggalluvial/R/utils.r0000644000176200001440000000072313710336102014123 0ustar liggesusers# color and differentiation aesthetics .color_diff_aesthetics <- c( "fill", "bg", "alpha", "fg", "col", "colour", "color", "lty", "linetype", "cex", "lwd", "size", "pch", "shape" ) # text aesthetics .text_aesthetics <- c( "label", "vjust", "hjust", "angle", "family", "fontface", "lineheight" ) # distilling functions first <- dplyr::first last <- dplyr::last most <- function(x) { x[which(factor(x) == names(which.max(table(factor(x)))))[1]] } ggalluvial/R/lode-guidance-functions.r0000644000176200001440000000525713566771437017527 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`) #' #' @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.r0000644000176200001440000000457213646065107015431 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, 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.r0000644000176200001440000000313213710336101013670 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.r0000644000176200001440000000175013710336102016504 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/). #' "_PACKAGE" # 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.r0000644000176200001440000000456213716513142014076 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.r0000755000176200001440000004167213722770402015615 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) } } 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 if (any(is.na(data$y))) { stop("Data contains missing `y` values.") } 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)], key = key, value = value, id = id ) } ggalluvial/R/self-adjoin.r0000644000176200001440000000432713716513142015171 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 #' @import tidyselect #' @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 <- tidyselect::vars_pull(names(data), !! rlang::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.r0000644000176200001440000000021213364111337014443 0ustar liggesusers#' Base ggproto classes for ggalluvial #' #' @name ggalluvial-ggproto #' @seealso [`ggplot2::ggplot2-ggproto`] #' @keywords internal NULL ggalluvial/R/geom-lode.r0000644000176200001440000000525113646065107014650 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, linetype = 1, colour = 0, 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.r0000644000176200001440000001565513710336102014671 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`. #' @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". #' @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(size = .5, linetype = 1, colour = 0, 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("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 <- row_to_curve(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, curve_type = curve_type, curve_range = curve_range, segments = segments, knot.prop = knot.prop) # 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$size * .pt ) ) }) # combine spline grobs grob <- do.call(grid::grobTree, grobs) grob$name <- grid::grobName(grob, "xspline") grob }, draw_key = draw_key_polygon ) # send to spline or unit curve depending on parameters row_to_curve <- function( x0, x1, ymin0, ymax0, ymin1, ymax1, kp0, kp1, curve_type, curve_range, segments, knot.prop ) { if (curve_type %in% c("spline", "xspline")) { # x-spline path row_to_xspline(x0, x1, ymin0, ymax0, ymin1, ymax1, kp0, kp1, knot.prop) } 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 row_to_unit_curve(x0, x1, ymin0, ymax0, ymin1, ymax1, curve_type, curve_range, segments) } } row_to_xspline <- function( x0, x1, ymin0, ymax0, ymin1, ymax1, kp0, kp1, knot.prop ) { 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) ) } row_to_unit_curve <- function( x0, x1, ymin0, ymax0, ymin1, ymax1, curve_type, curve_range, segments ) { 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.r0000644000176200001440000002044413710336102015550 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()]. #' @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(size = .5, linetype = 1, colour = 0, 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 if (nrow(data) == 1) { # spline coordinates (one axis) curve_data <- 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, 4) )) } else if (curve_type %in% c("spline", "xspline")) { # spline coordinates (more than one axis) curve_data <- data_to_xspline(data, knot.prop) } 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 coordinates (more than one axis) curve_data <- data_to_unit_curve(data, curve_type, curve_range, 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$size * .pt ) ) }, draw_key = draw_key_polygon ) # calculate control point coordinates for x-splines data_to_xspline <- function(data, knot.prop) { # left side, right side, forebound knot, backbound knot, left side, right side w_fore <- rep(data$width, c(3, rep(4, nrow(data) - 2), 3)) k_fore <- rep(data$knot.pos, c(3, rep(4, nrow(data) - 2), 3)) if (knot.prop) { # distances between strata b_fore <- rep(data$x, c(1, rep(2, nrow(data) - 2), 1)) + c(1, -1) * rep(data$width / 2, c(1, rep(2, nrow(data) - 2), 1)) d_fore <- diff(b_fore)[c(TRUE, FALSE)] # scale `k_fore` to these distances k_fore <- k_fore * c(0, rep(d_fore, rep(4, nrow(data) - 1)), 0) } # axis position +/- corresponding width +/- relative knot position x_fore <- rep(data$x, c(3, rep(4, nrow(data) - 2), 3)) + w_fore / 2 * c(-1, rep(c(1, 1, -1, -1), nrow(data) - 1), 1) + k_fore * c(0, rep(c(0, 1, -1, 0), nrow(data) - 1), 0) # vertical positions are those of lodes ymin_fore <- rep(data$ymin, c(3, rep(4, nrow(data) - 2), 3)) ymax_fore <- rep(data$ymax, c(3, rep(4, nrow(data) - 2), 3)) shape_fore <- c(0, rep(c(0, 1, 1, 0), nrow(data) - 1), 0) data.frame( x = c(x_fore, rev(x_fore)), y = c(ymin_fore, rev(ymax_fore)), shape = rep(shape_fore, 2) ) } data_to_unit_curve <- function(data, curve_type, curve_range, segments) { # specs for a single flow curve curve_fun <- make_curve_fun(curve_type, curve_range) i_once <- seq(0, 1, length.out = segments + 1) 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) - 1) * 2] + outer(diff(b_fore)[seq(nrow(data) - 1) * 2], i_once, "*")), b_fore[nrow(data) * 2] ) ymin_fore <- c( data$ymin[1], t(data$ymin[-nrow(data)] + outer(diff(data$ymin), f_once, "*")), data$ymin[nrow(data)] ) ymax_fore <- c( data$ymax[1], 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.r0000644000176200001440000002476313722770414015460 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()]). In addition to existing functions, accepts the #' character values `"first"` (the default), `"last"`, 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 if (any(is.na(data$y))) { stop("Data contains missing `y` values.") } 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.r0000644000176200001440000000326313710336102015052 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.md0000644000176200001440000004046513762211453013514 0ustar liggesusers # 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. # earlier versions I only started maintaining `NEWS.md` with version 0.5.0. ggalluvial/MD50000644000176200001440000001624213762731463012732 0ustar liggesusersabfdf1ef204c8d31d96c95713da4ef35 *DESCRIPTION b3e4f7441095dc9a9f7b1de2998d6a64 *NAMESPACE ab051b50edf52d9734ab4e5ef7cb3821 *NEWS.md 16d69f255dca8a982af7c2f8b9580f44 *R/alluvial-data.r 09aa353f212a485fffb576bf09e1ecb0 *R/data.r 24daa41e0bdd5707c1db36376153527a *R/devel.r 75e80b276cba477a511ef15be2c7462d *R/geom-alluvium.r abc9e5e531194739c7220583cf3a9d62 *R/geom-flow.r e3faf37104271173fac70d3e95352fd0 *R/geom-lode.r f2b73463ce561737a9c8cdb2cc33c603 *R/geom-stratum.r 381ec3f04c84b1356150879f98e27945 *R/geom-utils.r 38d0caf01bfc7cd777f4bf265ba196d7 *R/ggalluvial-package.r 7d53688cdfb70ea93e4e951348f65837 *R/ggproto.r fc629fb95041c9aa164f9da277e54e2c *R/lode-guidance-functions.r 5361ee346efbf135934443e684e0858a *R/self-adjoin.r 55dd0bd7f6fc79ff171931355704ac67 *R/stat-alluvium.r 5e1709655cab6a5a2a77699e5a0dc123 *R/stat-flow.r 65cd75dd58a95fa9d203ec5fde7b7527 *R/stat-stratum.r 4ef003dae197e63182c09d909433a656 *R/stat-utils.r d289991b017764beb7afaba8fc1c62b6 *R/utils.r 812319a2d0944a031363fd4e173ee462 *README.md 94406ca9282690a1960abc4bedc824a7 *build/vignette.rds 96bce82e0f24d1ff28ed6c6b5205ad52 *data/majors.rda 5223231efa77767c267893a6105952c8 *data/vaccinations.rda b397890005f835604a3d9bc10f0bab73 *inst/CITATION aba7a77b04056b1cdb59e78e61a52e94 *inst/doc/ggalluvial.R 7bbdf729df2e2c573d8f9be155d65f04 *inst/doc/ggalluvial.html b025898fa78110db3a023bf0eadb1d21 *inst/doc/ggalluvial.rmd ca77b0132eeacfb09a95e62de751c7fb *inst/doc/labels.R 31db40e5f5c6d4e8cb47e844809335ad *inst/doc/labels.html 2afe8b519bc273a73b1e39a697949763 *inst/doc/labels.rmd 86bc5c624c58cb785e4cd24f4f86fdcb *inst/doc/order-rectangles.R f961471c9b765070c484f9fa8c1f3fe1 *inst/doc/order-rectangles.html 977077fdc7a7fbacb96dade4c82da608 *inst/doc/order-rectangles.rmd 01525d21f62f0c398fa487fed950e131 *inst/doc/shiny.R c4d7ba1f91e13c4f099b71c0703b3b0c *inst/doc/shiny.Rmd 883058da8f0f3f75adb47a1cefdafcff *inst/doc/shiny.html f0396a001c5dbff3e569c43e69996dac *inst/examples/ex-alluvial-data.r edf1dac2f910dffed0dc49d44ba5a8f0 *inst/examples/ex-geom-alluvium.r fdd4518a3f6e69f3bc60a34864fdb111 *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 7bfb559b71a864865c17046cc541fde7 *inst/examples/ex-stat-alluvium.r 0adde021063be1756efa8a4bb8146dea *inst/examples/ex-stat-flow.r 4d355ce9ca7dfeede6d9c11ec1b58384 *inst/examples/ex-stat-stratum.r 5d533f1871e4d5fd1dd099f299e39216 *man/alluvial-data.Rd 7b9a8848b69ebe0c9e35ef9f4f40cc2b *man/figures/README-unnamed-chunk-6-1.png 716082b715d98a34fe3da6e6acb7f7c2 *man/figures/README-unnamed-chunk-7-1.png a42b293bdd9753b90f3a559d94718751 *man/geom_alluvium.Rd 9240b019fade46d8c57c90c4173ac131 *man/geom_flow.Rd 4acf9fe7d46c600a6f6ca48372462c1c *man/geom_lode.Rd 4bb5eb431957e69b68d53abf2cee7671 *man/geom_stratum.Rd 77310f20634ab54c42172859d5b23065 *man/ggalluvial-deprecated.Rd 6cde51dd719466e8b8525ab013d76c92 *man/ggalluvial-ggproto.Rd 5c4d436c199795b7b44b249f4b766cb9 *man/ggalluvial-package.Rd 1e803e259ac88eb4721cb01e5105d8ac *man/lode-guidance-functions.Rd 642665787614a79aba58513bd73fa5be *man/majors.Rd 8fcddc4c1f89c6b2146254925448063e *man/self-adjoin.Rd 3498b72cce74b562f0bde11fcb2389d2 *man/stat_alluvium.Rd c88e0430cab178830f7c248ccf802409 *man/stat_flow.Rd 99c4490b01fbe706b36b982f9a2fb555 *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 3419b97b630d963412c4c0c7285a82ef *tests/testthat/test-alluvial-data.r 2cbc30a40c3d3b85851258bc970224e7 *tests/testthat/test-geom-alluvium.r 70a5c1f7f36ffa4a556d729dfed757af *tests/testthat/test-geom-flow.r 3f7e0ab7fd0cb9a35111f0bf6ed4c994 *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 b025898fa78110db3a023bf0eadb1d21 *vignettes/ggalluvial.rmd 74e33b2c2881cfc7e2c7430ae5400216 *vignettes/img/hover_alluvium.jpg 9e32ab07f4c52144ee81e4be1f37e014 *vignettes/img/hover_empty_area.jpg 5ef16142246758b1cc29d910c9f747aa *vignettes/img/hover_stratum.jpg 2afe8b519bc273a73b1e39a697949763 *vignettes/labels.rmd 977077fdc7a7fbacb96dade4c82da608 *vignettes/order-rectangles.rmd c4d7ba1f91e13c4f099b71c0703b3b0c *vignettes/shiny.Rmd ggalluvial/inst/0000755000176200001440000000000013762566201013366 5ustar liggesusersggalluvial/inst/examples/0000755000176200001440000000000013762566201015204 5ustar liggesusersggalluvial/inst/examples/ex-stat-flow.r0000644000176200001440000000463613703353253017726 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 = FALSE) # 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.r0000644000176200001440000000371313710336102020554 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) # 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.r0000644000176200001440000000116113703353253020420 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.r0000644000176200001440000000442113761533613017676 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) # 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.r0000644000176200001440000000563713761533613020534 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.r0000644000176200001440000000150713710336102020163 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-geom-lode.r0000644000176200001440000000100313317731073017640 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.r0000644000176200001440000001047413761533613020616 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() # 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 = "; ")) \dontrun{ 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")) # filling in missing zeros bn2 <- merge(bn, expand.grid(year = unique(bn$year), name = unique(bn$name)), all = TRUE) 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 = FALSE) # 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() ggalluvial/inst/examples/ex-stat-stratum.r0000644000176200001440000000564413710336102020446 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/0000755000176200001440000000000013762566200014132 5ustar liggesusersggalluvial/inst/doc/ggalluvial.html0000644000176200001440000210756613762566157017203 0ustar liggesusers Alluvial Plots in ggplot2

Alluvial Plots in ggplot2

Jason Cory Brunson

2020-12-04

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 (PDF) 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 grouped 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::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 version 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 existing ggplot2 functionality can also produce parallel sets plots, illustrated here using the Titanic dataset:4

ggplot(as.data.frame(Titanic),
       aes(y = Freq,
           axis1 = Survived, axis2 = Sex, axis3 = Class)) +
  geom_alluvium(aes(fill = Class),
                width = 0, knot.pos = 0, reverse = FALSE) +
  guides(fill = FALSE) +
  geom_stratum(width = 1/8, reverse = FALSE) +
  geom_text(stat = "stratum", aes(label = after_stat(stratum)),
            reverse = FALSE) +
  scale_x_continuous(breaks = 1:3, labels = c("Survived", "Sex", "Class")) +
  coord_flip() +
  ggtitle("Titanic survival by class and sex")

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 stratum variable produced by stat_stratum() (called by geom_text()) is not available before the statistical transformation is performed and must be recovered using after_stat().
  • 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 and functionality cannot produce alluvial plots with the color schemes featured here (“Alluvial diagram”) and here (“Controlling colors”), which are “reset” at each axis.

Lodes (long) format

The long format recognized by ggalluvial contains one row per lode, and can be understood as the result of “gathering” (in the dplyr sense) or “pivoting” (in the Microsoft Excel 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.5 In these cases, the strata contain no more information than the alluvia and often not plotted. For convenience, both stat_alluvium() and stat_flow() will accept arguments for x and alluvium even if none is given for stratum.6 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.7 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” plot produces 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.0.0 (2020-04-24)
##  os       macOS High Sierra 10.13.6   
##  system   x86_64, darwin17.0          
##  ui       X11                         
##  language (EN)                        
##  collate  C                           
##  ctype    en_US.UTF-8                 
##  tz       America/New_York            
##  date     2020-12-04                  
## 
## ─ Packages ───────────────────────────────────────────────────────────────────
##  package      * version date       lib source        
##  assertthat     0.2.1   2019-03-21 [3] CRAN (R 4.0.0)
##  cli            2.2.0   2020-11-20 [3] CRAN (R 4.0.2)
##  colorspace     2.0-0   2020-11-11 [3] CRAN (R 4.0.0)
##  crayon         1.3.4   2017-09-16 [3] CRAN (R 4.0.0)
##  digest         0.6.27  2020-10-24 [3] CRAN (R 4.0.2)
##  dplyr          1.0.2   2020-08-18 [3] CRAN (R 4.0.2)
##  ellipsis       0.3.1   2020-05-15 [3] CRAN (R 4.0.0)
##  evaluate       0.14    2019-05-28 [3] CRAN (R 4.0.0)
##  fansi          0.4.1   2020-01-08 [3] CRAN (R 4.0.0)
##  farver         2.0.3   2020-01-16 [3] CRAN (R 4.0.0)
##  generics       0.1.0   2020-10-31 [3] CRAN (R 4.0.2)
##  ggalluvial   * 0.12.3  2020-12-05 [1] local         
##  ggplot2      * 3.3.2   2020-06-19 [3] CRAN (R 4.0.0)
##  glue           1.4.2   2020-08-27 [3] CRAN (R 4.0.0)
##  gtable         0.3.0   2019-03-25 [3] CRAN (R 4.0.0)
##  htmltools      0.5.0   2020-06-16 [3] CRAN (R 4.0.0)
##  knitr          1.30    2020-09-22 [3] CRAN (R 4.0.2)
##  labeling       0.4.2   2020-10-20 [3] CRAN (R 4.0.2)
##  lifecycle      0.2.0   2020-03-06 [3] CRAN (R 4.0.0)
##  magrittr       2.0.1   2020-11-17 [3] CRAN (R 4.0.2)
##  munsell        0.5.0   2018-06-12 [3] CRAN (R 4.0.0)
##  pillar         1.4.7   2020-11-20 [3] CRAN (R 4.0.2)
##  pkgconfig      2.0.3   2019-09-22 [3] CRAN (R 4.0.0)
##  purrr          0.3.4   2020-04-17 [3] CRAN (R 4.0.0)
##  R6             2.5.0   2020-10-28 [3] CRAN (R 4.0.2)
##  RColorBrewer   1.1-2   2014-12-07 [3] CRAN (R 4.0.0)
##  rlang          0.4.9   2020-11-26 [3] CRAN (R 4.0.2)
##  rmarkdown      2.5     2020-10-21 [3] CRAN (R 4.0.0)
##  scales         1.1.1   2020-05-11 [3] CRAN (R 4.0.0)
##  sessioninfo    1.1.1   2018-11-05 [3] CRAN (R 4.0.0)
##  stringi        1.5.3   2020-09-09 [3] CRAN (R 4.0.2)
##  stringr        1.4.0   2019-02-10 [3] CRAN (R 4.0.0)
##  tibble         3.0.4   2020-10-12 [3] CRAN (R 4.0.2)
##  tidyr          1.1.2   2020-08-27 [3] CRAN (R 4.0.0)
##  tidyselect     1.1.0   2020-05-11 [3] CRAN (R 4.0.0)
##  vctrs          0.3.5   2020-11-17 [3] CRAN (R 4.0.2)
##  withr          2.3.0   2020-09-22 [3] CRAN (R 4.0.2)
##  xfun           0.19    2020-10-30 [3] CRAN (R 4.0.2)
##  yaml           2.2.1   2020-02-01 [3] CRAN (R 4.0.0)
## 
## [1] /private/var/folders/pg/fjg8r4fj5v33zqmwptf9mfg80000gn/T/RtmpoGapBj/Rinst12614536d51cf
## [2] /private/var/folders/pg/fjg8r4fj5v33zqmwptf9mfg80000gn/T/Rtmp9uVgtw/temp_libpath122121ce65082
## [3] /Library/Frameworks/R.framework/Versions/4.0/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. If bumping is unnecessary, consider using geom_area() instead.↩︎

  6. 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.↩︎

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

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

Tooltips for ggalluvial plots in Shiny apps

Quentin D. Read

2020-12-04

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

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 a Shiny app that displays 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().

The tooltips that appear when the user hovers over elements of the plot show a text label and the number of flows included in each group. This is made relatively straightforward because 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 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.

Data for reproducible example

This toy dataset is used for the example app.

example_data <- data.frame(
  weight = rep(1, 12),
  ID = 1:12,
  cluster = rep(c(1, 2), c(4, 8)),
  grp1 = rep(c('1a', '1b', '1a', '1b'), c(3, 2, 3, 4)),
  grp2 = rep(c('2a', '2b', '2a', '2b', '2a'), c(2, 2, 2, 2, 4)),
  grp3 = rep(c('3a','3b', '3a', '3b'), c(3, 2, 2, 5))
)

Here is a static plot generated using the toy dataset.

ggplot(example_data,
       aes(y = weight, axis1 = grp1, axis2 = grp2, axis3 = grp3)) + 
  geom_alluvium(aes(fill = factor(cluster)), knot.pos = 0.25) + 
  geom_stratum(width = 1/8, reverse = TRUE) + 
  geom_text(aes(label = after_stat(stratum)), 
            stat = "stratum", 
            reverse = TRUE, 
            size = rel(3)) + 
  theme_bw() +
  scale_x_continuous(expand = c(0, 0)) +
  scale_y_continuous(expand = c(0, 0))

Structure of the example app

Here, we will go over each section of the code in detail. The full code is reproduced at the bottom of this document.

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 = "500px", 
               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.

Both of 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.

Server function

The server function is more complex. Its general structure looks like this, in pseudocode:

server <- function(input, output, session) {
  
  output$alluvial_plot <- renderPlot({
    
    '<Create "ggplot" object for alluvial plot.>'
    
    '<Build alluvial plot and assign globally.>'
    
    '<Extract data from built plot object used to create alluvium polygons.>'
    
    '<Use polygon splines to generate coordinates of alluvium boundaries.>'
    
    '<Convert coordinates from grid units to plot units and assign globally.>'
    
    '<Render the plot.>'
  })
  
  output$tooltip <- renderText({
    if ('<mouse cursor is within the plot panel>') {
      if ('<mouse cursor is within a stratum box>') {
        '<Render stratum tooltip.>'
      } else {
        if ('<mouse cursor is within an alluvium polygon>') {
          '<Render alluvium tooltip.>'
        }
      }
    }
  })
  
}

First, we create the ggplot object for the alluvial plot, then we call the ggplot_build() function to build the plot without displaying it. The next lines of code are to “reverse engineer” the polygon coordinates. Finally, we call renderPlot() to pass the plot to output.

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, nothing is returned by renderText() and so no tooltip text box is displayed.

screenshot of cursor over empty region

Let’s take a deeper dive into each part of the server function.

1. Drawing plot and extracting coordinates

The first part of the server function includes code to draw the plot and build it with ggplot_build(). Note that the global assignment operator <<- is used to assign node_width and pbuilt so they are both accessible outside the renderPlot() expression.

Note: In the example presented here, strictly speaking all of the plot drawing and coordinate extracting code could be 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. So we’ve left it there in the example code.

output$alluvial_plot <- renderPlot({
 
  # Width of node boxes
  node_width <<- 1/4
  
  p <- ggplot(example_data,
              aes(y = weight, axis1 = grp1, axis2 = grp2, axis3 = grp3)) + 
    geom_alluvium(aes(fill = factor(cluster)), knot.pos = 0.25) + 
    geom_stratum(width = node_width, reverse = TRUE) + 
    geom_text(aes(label = after_stat(stratum)), 
              stat = "stratum", 
              reverse = TRUE, 
              size = rel(3)) + 
    theme_bw() +
    scale_x_continuous(expand = c(0, 0)) +
    scale_y_continuous(expand = c(0, 0))
  
  # Build the plot. Use global assignment so that this object is accessible
  # later.
  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, which has a value of 1/3 hard-coded into ggalluvial::geom_alluvium(), then split the data frame by group (groups correspond to the individual alluvium polygons). We apply the unexported function ggalluvial:::data_to_xspline() to each element of the list to get the x-spline coordinates. Then, we pass the x-spline coordinates to the function grid::xsplineGrob() to convert them into a grid object. We pass the resulting object to grid::xsplinePoints(). At this point we now have the coordinates of the alluvium polygons.

  # 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 = 1/3)
  groups_to_draw <- split(data_draw, data_draw$group)
  group_xsplines <- lapply(groups_to_draw,
                           ggalluvial:::data_to_xspline,
                           knot.prop = TRUE) 
  
  # 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 fixing the range of the x axis as 1 to the number of strata, adjusted by the width of the nodes, and the y axis to the number of rows in the data (again, this is possible here because each flow polygon is exactly 1 unit high).

We define a function new_range_transform() inline and apply it to each set of coordinates, assigning the resulting object globally so it can be accessed later. Now we have the coordinates of the polygons in plot units! So we can close the expression after returning the plot.

  # 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 - 1/6, 3 + 1/6) 
  yrange_new <- c(0, nrow(example_data)) 
  
  # 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. Use global assignment.
  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)
  })

  # Return plot
  p
}, 
res = 200)

2. Logic for determining cursor location and displaying tooltips

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.

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

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.

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

The nearest integer to the y-coordinate corresponds to the row of the data frame because we set reverse = TRUE and all weight = 1 in the input data. So, for example, the first row of the data frame corresponds to y range c(0, 1), the second c(1, 2), and so forth. This gives us all the information we need to find the index of the rows of the input data that goes with the stratum the cursor is on. Note: It is necessary for the input data to be sorted in ascending order of the group column, named cluster in this example. If it is not sorted in this way, the relative order of the flows along the y-axis will not correspond to their order in the data.

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

We get the name of the stratum as well as the total number of flows passing through it.

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

Finally, we render a tooltip using the div tag and passing it to htmltools::renderTags(). 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 the mouse cursor location in those 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

If the cursor is not over a stratum, the next logic 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. 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 will display the names of all the nodes that the alluvium passes through.

coord_id <- rev(which(hover_within_flow == 1))[1]
flow_id <- example_data$ID[coord_id]
axis_values <- example_data[flow_id, c('grp1', 'grp2', 'grp3')]

We render a tooltip that shows the names of all the nodes that the hovered path passes through, using very similar syntax to the above tooltip.

renderTags(
  tags$div(
    paste(axis_values, collapse = ' -> '),
    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

Conclusion

This vignette demonstrates how to enable tooltips for ggalluvial plots in Shiny apps. However it’s important to note that some of the workarounds are slightly inelegant. This may not be the optimal way to do it — other solutions are certainly possible!

Appendix

Complete app code

library(ggalluvial)
library(shiny)
library(htmltools)
library(sp)

example_data <- data.frame(
  weight = rep(1, 12),
  ID = 1:12,
  cluster = rep(c(1, 2), c(4, 8)),
  grp1 = rep(c('1a', '1b', '1a', '1b'), c(3, 2, 3, 4)),
  grp2 = rep(c('2a', '2b', '2a', '2b', '2a'), c(2, 2, 2, 2, 4)),
  grp3 = rep(c('3a','3b', '3a', '3b'), c(3, 2, 2, 5))
)

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

server <- function(input, output, session) {
  
  # Draw plot and extract coordinates
  output$alluvial_plot <- renderPlot({
   
    # Width of node boxes
    node_width <<- 1/4
    
    p <- ggplot(example_data,
                aes(y = weight, axis1 = grp1, axis2 = grp2, axis3 = grp3)) + 
      geom_alluvium(aes(fill = factor(cluster)), knot.pos = 0.25) + 
      geom_stratum(width = node_width, reverse = TRUE) + 
      geom_text(aes(label = after_stat(stratum)), 
                stat = "stratum", 
                reverse = TRUE, 
                size = rel(3)) + 
      theme_bw() +
      scale_x_continuous(expand = c(0, 0)) +
      scale_y_continuous(expand = c(0, 0))
    
    # Build the plot. Use global assignment so that this object is accessible
    # later.
    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 = 1/3)
    groups_to_draw <- split(data_draw, data_draw$group)
    group_xsplines <- lapply(groups_to_draw,
                             ggalluvial:::data_to_xspline,
                             knot.prop = TRUE) 
    
    # 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 - 1/6, 3 + 1/6) 
    yrange_new <- c(0, nrow(example_data)) 
    
    # 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. Use global assignment.
    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)
    })

    # Return plot
    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]]$n[node_row]
        
        # Offset, in pixels, for location of tooltip relative to mouse cursor,
        # in both x and y direction.
        offset <- 5
        
        # 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]
          # Get the corresponding row ID from the data.
          flow_id <- example_data$ID[coord_id]
          # Get the axis 1-3 values for all axes for that row ID.
          axis_values <- example_data[flow_id, c('grp1', 'grp2', 'grp3')]
          
          offset <- 5
          
          # Render tooltip
          renderTags(
            tags$div(
              paste(axis_values, collapse = ' -> '),
              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/doc/labels.rmd0000644000176200001440000001542113761533613016104 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.R0000644000176200001440000001514113762566175017532 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.html0000644000176200001440000155247013762566163016310 0ustar liggesusers Labeling small strata

Labeling small strata

Jason Cory Brunson

2020-12-04

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 (...) 
## f(...)
## 
##   <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 (...) 
## f(..., 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).

## Warning: 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.0.0 (2020-04-24)
##  os       macOS High Sierra 10.13.6   
##  system   x86_64, darwin17.0          
##  ui       X11                         
##  language (EN)                        
##  collate  C                           
##  ctype    en_US.UTF-8                 
##  tz       America/New_York            
##  date     2020-12-04                  
## 
## ─ Packages ───────────────────────────────────────────────────────────────────
##  package      * version date       lib source                        
##  assertthat     0.2.1   2019-03-21 [3] CRAN (R 4.0.0)                
##  cli            2.2.0   2020-11-20 [3] CRAN (R 4.0.2)                
##  colorspace     2.0-0   2020-11-11 [3] CRAN (R 4.0.0)                
##  crayon         1.3.4   2017-09-16 [3] CRAN (R 4.0.0)                
##  digest         0.6.27  2020-10-24 [3] CRAN (R 4.0.2)                
##  dplyr          1.0.2   2020-08-18 [3] CRAN (R 4.0.2)                
##  ellipsis       0.3.1   2020-05-15 [3] CRAN (R 4.0.0)                
##  evaluate       0.14    2019-05-28 [3] CRAN (R 4.0.0)                
##  fansi          0.4.1   2020-01-08 [3] CRAN (R 4.0.0)                
##  farver         2.0.3   2020-01-16 [3] CRAN (R 4.0.0)                
##  generics       0.1.0   2020-10-31 [3] CRAN (R 4.0.2)                
##  ggalluvial   * 0.12.3  2020-12-05 [1] local                         
##  ggfittext      0.9.0   2020-06-14 [3] CRAN (R 4.0.0)                
##  ggplot2      * 3.3.2   2020-06-19 [3] CRAN (R 4.0.0)                
##  ggrepel        0.8.2   2020-03-08 [3] CRAN (R 4.0.0)                
##  glue           1.4.2   2020-08-27 [3] CRAN (R 4.0.0)                
##  gtable         0.3.0   2019-03-25 [3] CRAN (R 4.0.0)                
##  htmltools      0.5.0   2020-06-16 [3] CRAN (R 4.0.0)                
##  knitr          1.30    2020-09-22 [3] CRAN (R 4.0.2)                
##  labeling       0.4.2   2020-10-20 [3] CRAN (R 4.0.2)                
##  lifecycle      0.2.0   2020-03-06 [3] CRAN (R 4.0.0)                
##  magrittr       2.0.1   2020-11-17 [3] CRAN (R 4.0.2)                
##  munsell        0.5.0   2018-06-12 [3] CRAN (R 4.0.0)                
##  pillar         1.4.7   2020-11-20 [3] CRAN (R 4.0.2)                
##  pkgconfig      2.0.3   2019-09-22 [3] CRAN (R 4.0.0)                
##  purrr          0.3.4   2020-04-17 [3] CRAN (R 4.0.0)                
##  R6             2.5.0   2020-10-28 [3] CRAN (R 4.0.2)                
##  RColorBrewer   1.1-2   2014-12-07 [3] CRAN (R 4.0.0)                
##  Rcpp           1.0.5   2020-10-02 [3] Github (RcppCore/Rcpp@a9ca85d)
##  rlang          0.4.9   2020-11-26 [3] CRAN (R 4.0.2)                
##  rmarkdown      2.5     2020-10-21 [3] CRAN (R 4.0.0)                
##  scales         1.1.1   2020-05-11 [3] CRAN (R 4.0.0)                
##  sessioninfo    1.1.1   2018-11-05 [3] CRAN (R 4.0.0)                
##  stringi        1.5.3   2020-09-09 [3] CRAN (R 4.0.2)                
##  stringr        1.4.0   2019-02-10 [3] CRAN (R 4.0.0)                
##  tibble         3.0.4   2020-10-12 [3] CRAN (R 4.0.2)                
##  tidyr          1.1.2   2020-08-27 [3] CRAN (R 4.0.0)                
##  tidyselect     1.1.0   2020-05-11 [3] CRAN (R 4.0.0)                
##  vctrs          0.3.5   2020-11-17 [3] CRAN (R 4.0.2)                
##  withr          2.3.0   2020-09-22 [3] CRAN (R 4.0.2)                
##  xfun           0.19    2020-10-30 [3] CRAN (R 4.0.2)                
##  yaml           2.2.1   2020-02-01 [3] CRAN (R 4.0.0)                
## 
## [1] /private/var/folders/pg/fjg8r4fj5v33zqmwptf9mfg80000gn/T/RtmpoGapBj/Rinst12614536d51cf
## [2] /private/var/folders/pg/fjg8r4fj5v33zqmwptf9mfg80000gn/T/Rtmp9uVgtw/temp_libpath122121ce65082
## [3] /Library/Frameworks/R.framework/Versions/4.0/Resources/library
ggalluvial/inst/doc/shiny.R0000644000176200001440000003440413762566176015430 0ustar liggesusers## ----setup-------------------------------------------------------------------- knitr::opts_chunk$set(fig.width = 6, fig.height = 3, fig.align = "center") library(ggalluvial) ## ----toy dataset, message = FALSE, warning = FALSE---------------------------- example_data <- data.frame( weight = rep(1, 12), ID = 1:12, cluster = rep(c(1, 2), c(4, 8)), grp1 = rep(c('1a', '1b', '1a', '1b'), c(3, 2, 3, 4)), grp2 = rep(c('2a', '2b', '2a', '2b', '2a'), c(2, 2, 2, 2, 4)), grp3 = rep(c('3a','3b', '3a', '3b'), c(3, 2, 2, 5)) ) ## ----static plot, fig.width = 6----------------------------------------------- ggplot(example_data, aes(y = weight, axis1 = grp1, axis2 = grp2, axis3 = grp3)) + geom_alluvium(aes(fill = factor(cluster)), knot.pos = 0.25) + geom_stratum(width = 1/8, reverse = TRUE) + geom_text(aes(label = after_stat(stratum)), stat = "stratum", reverse = TRUE, size = rel(3)) + theme_bw() + scale_x_continuous(expand = c(0, 0)) + scale_y_continuous(expand = c(0, 0)) ## ----ui, eval = FALSE--------------------------------------------------------- # ui <- fluidPage( # fluidRow(tags$div( # style = "position: relative;", # plotOutput("alluvial_plot", height = "500px", # hover = hoverOpts(id = "plot_hover") # ), # htmlOutput("tooltip"))) # ) ## ----server function skeleton, eval = FALSE----------------------------------- # server <- function(input, output, session) { # # output$alluvial_plot <- renderPlot({ # # '' # # '' # # '' # # '' # # '' # # '' # }) # # output$tooltip <- renderText({ # if ('') { # if ('') { # '' # } else { # if ('') { # '' # } # } # } # }) # # } ## ----server part 1a, eval = FALSE--------------------------------------------- # output$alluvial_plot <- renderPlot({ # # # Width of node boxes # node_width <<- 1/4 # # p <- ggplot(example_data, # aes(y = weight, axis1 = grp1, axis2 = grp2, axis3 = grp3)) + # geom_alluvium(aes(fill = factor(cluster)), knot.pos = 0.25) + # geom_stratum(width = node_width, reverse = TRUE) + # geom_text(aes(label = after_stat(stratum)), # stat = "stratum", # reverse = TRUE, # size = rel(3)) + # theme_bw() + # scale_x_continuous(expand = c(0, 0)) + # scale_y_continuous(expand = c(0, 0)) # # # Build the plot. Use global assignment so that this object is accessible # # later. # pbuilt <<- ggplot_build(p) ## ----server part 1b, eval = FALSE--------------------------------------------- # # 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 = 1/3) # groups_to_draw <- split(data_draw, data_draw$group) # group_xsplines <- lapply(groups_to_draw, # ggalluvial:::data_to_xspline, # knot.prop = TRUE) # # # 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) ## ----server part 1c, 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 - 1/6, 3 + 1/6) # yrange_new <- c(0, nrow(example_data)) # # # 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. Use global assignment. # 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) # }) # # # Return plot # 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)) { ... } ## ---- 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]]$n[node_row] ## ---- 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 ## ---- 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) # ) ## ----info for alluvia tooltip, eval = FALSE----------------------------------- # coord_id <- rev(which(hover_within_flow == 1))[1] # flow_id <- example_data$ID[coord_id] # axis_values <- example_data[flow_id, c('grp1', 'grp2', 'grp3')] ## ---- eval = FALSE------------------------------------------------------------ # renderTags( # tags$div( # paste(axis_values, collapse = ' -> '), # 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 ## ----full app, eval = FALSE--------------------------------------------------- # library(ggalluvial) # library(shiny) # library(htmltools) # library(sp) # # example_data <- data.frame( # weight = rep(1, 12), # ID = 1:12, # cluster = rep(c(1, 2), c(4, 8)), # grp1 = rep(c('1a', '1b', '1a', '1b'), c(3, 2, 3, 4)), # grp2 = rep(c('2a', '2b', '2a', '2b', '2a'), c(2, 2, 2, 2, 4)), # grp3 = rep(c('3a','3b', '3a', '3b'), c(3, 2, 2, 5)) # ) # # # User interface # ui <- fluidPage( # fluidRow(tags$div( # style = "position: relative;", # plotOutput("alluvial_plot", height = "500px", # hover = hoverOpts(id = "plot_hover") # ), # htmlOutput("tooltip"))) # ) # # server <- function(input, output, session) { # # # Draw plot and extract coordinates # output$alluvial_plot <- renderPlot({ # # # Width of node boxes # node_width <<- 1/4 # # p <- ggplot(example_data, # aes(y = weight, axis1 = grp1, axis2 = grp2, axis3 = grp3)) + # geom_alluvium(aes(fill = factor(cluster)), knot.pos = 0.25) + # geom_stratum(width = node_width, reverse = TRUE) + # geom_text(aes(label = after_stat(stratum)), # stat = "stratum", # reverse = TRUE, # size = rel(3)) + # theme_bw() + # scale_x_continuous(expand = c(0, 0)) + # scale_y_continuous(expand = c(0, 0)) # # # Build the plot. Use global assignment so that this object is accessible # # later. # 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 = 1/3) # groups_to_draw <- split(data_draw, data_draw$group) # group_xsplines <- lapply(groups_to_draw, # ggalluvial:::data_to_xspline, # knot.prop = TRUE) # # # 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 - 1/6, 3 + 1/6) # yrange_new <- c(0, nrow(example_data)) # # # 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. Use global assignment. # 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) # }) # # # Return plot # 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]]$n[node_row] # # # Offset, in pixels, for location of tooltip relative to mouse cursor, # # in both x and y direction. # offset <- 5 # # # 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] # # Get the corresponding row ID from the data. # flow_id <- example_data$ID[coord_id] # # Get the axis 1-3 values for all axes for that row ID. # axis_values <- example_data[flow_id, c('grp1', 'grp2', 'grp3')] # # offset <- 5 # # # Render tooltip # renderTags( # tags$div( # paste(axis_values, collapse = ' -> '), # 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/doc/ggalluvial.rmd0000644000176200001440000003777213762213101016772 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 (PDF)](https://CRAN.R-project.org/package=vcdExtra/vignettes/vcd-tutorial.pdf) 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 grouped 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::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 version 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 existing **ggplot2** functionality can also produce [parallel sets](https://eagereyes.org/parallel-sets) plots, illustrated here using the `Titanic` dataset:[^ggparallel] [^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. ```{r parallel sets plot of Titanic dataset} ggplot(as.data.frame(Titanic), aes(y = Freq, axis1 = Survived, axis2 = Sex, axis3 = Class)) + geom_alluvium(aes(fill = Class), width = 0, knot.pos = 0, reverse = FALSE) + guides(fill = FALSE) + geom_stratum(width = 1/8, reverse = FALSE) + geom_text(stat = "stratum", aes(label = after_stat(stratum)), reverse = FALSE) + scale_x_continuous(breaks = 1:3, labels = c("Survived", "Sex", "Class")) + coord_flip() + ggtitle("Titanic survival by class and sex") ``` 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 `stratum` variable produced by `stat_stratum()` (called by `geom_text()`) is not available before the statistical transformation is performed and must be recovered using `after_stat()`. - 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 and functionality cannot produce alluvial plots with the color schemes featured [here](https://epijim.uk/code-snippets/eq5d/) ("Alluvial diagram") and [here](https://developers.google.com/chart/interactive/docs/gallery/sankey) ("Controlling colors"), which are "reset" at each axis. ### Lodes (long) format The long format recognized by **ggalluvial** contains _one row per lode_, and can be understood as the result of "gathering" (in the **dplyr** sense) or "pivoting" (in the Microsoft Excel 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 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://www.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" plot produces 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.R0000644000176200001440000000573713762566162015542 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.html0000644000176200001440000217645113762566175020313 0ustar liggesusers The Order of the Rectangles

The Order of the Rectangles

Jason Cory Brunson

2020-12-04

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: Ignoring unknown aesthetics: label
## Warning: 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: Ignoring unknown aesthetics: label
## Warning: 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: Ignoring unknown aesthetics: label
## Warning: 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: Ignoring unknown aesthetics: order
## Warning: Ignoring unknown aesthetics: fill, 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: Ignoring unknown aesthetics: order
## Warning: Ignoring unknown aesthetics: fill, order

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.0.0 (2020-04-24)
##  os       macOS High Sierra 10.13.6   
##  system   x86_64, darwin17.0          
##  ui       X11                         
##  language (EN)                        
##  collate  C                           
##  ctype    en_US.UTF-8                 
##  tz       America/New_York            
##  date     2020-12-04                  
## 
## ─ Packages ───────────────────────────────────────────────────────────────────
##  package      * version date       lib source                        
##  assertthat     0.2.1   2019-03-21 [3] CRAN (R 4.0.0)                
##  cli            2.2.0   2020-11-20 [3] CRAN (R 4.0.2)                
##  colorspace     2.0-0   2020-11-11 [3] CRAN (R 4.0.0)                
##  crayon         1.3.4   2017-09-16 [3] CRAN (R 4.0.0)                
##  digest         0.6.27  2020-10-24 [3] CRAN (R 4.0.2)                
##  dplyr          1.0.2   2020-08-18 [3] CRAN (R 4.0.2)                
##  ellipsis       0.3.1   2020-05-15 [3] CRAN (R 4.0.0)                
##  evaluate       0.14    2019-05-28 [3] CRAN (R 4.0.0)                
##  fansi          0.4.1   2020-01-08 [3] CRAN (R 4.0.0)                
##  farver         2.0.3   2020-01-16 [3] CRAN (R 4.0.0)                
##  generics       0.1.0   2020-10-31 [3] CRAN (R 4.0.2)                
##  ggalluvial   * 0.12.3  2020-12-05 [1] local                         
##  ggfittext      0.9.0   2020-06-14 [3] CRAN (R 4.0.0)                
##  ggplot2      * 3.3.2   2020-06-19 [3] CRAN (R 4.0.0)                
##  ggrepel        0.8.2   2020-03-08 [3] CRAN (R 4.0.0)                
##  glue           1.4.2   2020-08-27 [3] CRAN (R 4.0.0)                
##  gtable         0.3.0   2019-03-25 [3] CRAN (R 4.0.0)                
##  htmltools      0.5.0   2020-06-16 [3] CRAN (R 4.0.0)                
##  knitr          1.30    2020-09-22 [3] CRAN (R 4.0.2)                
##  labeling       0.4.2   2020-10-20 [3] CRAN (R 4.0.2)                
##  lifecycle      0.2.0   2020-03-06 [3] CRAN (R 4.0.0)                
##  magrittr       2.0.1   2020-11-17 [3] CRAN (R 4.0.2)                
##  munsell        0.5.0   2018-06-12 [3] CRAN (R 4.0.0)                
##  pillar         1.4.7   2020-11-20 [3] CRAN (R 4.0.2)                
##  pkgconfig      2.0.3   2019-09-22 [3] CRAN (R 4.0.0)                
##  purrr          0.3.4   2020-04-17 [3] CRAN (R 4.0.0)                
##  R6             2.5.0   2020-10-28 [3] CRAN (R 4.0.2)                
##  RColorBrewer   1.1-2   2014-12-07 [3] CRAN (R 4.0.0)                
##  Rcpp           1.0.5   2020-10-02 [3] Github (RcppCore/Rcpp@a9ca85d)
##  rlang          0.4.9   2020-11-26 [3] CRAN (R 4.0.2)                
##  rmarkdown      2.5     2020-10-21 [3] CRAN (R 4.0.0)                
##  scales         1.1.1   2020-05-11 [3] CRAN (R 4.0.0)                
##  sessioninfo    1.1.1   2018-11-05 [3] CRAN (R 4.0.0)                
##  stringi        1.5.3   2020-09-09 [3] CRAN (R 4.0.2)                
##  stringr        1.4.0   2019-02-10 [3] CRAN (R 4.0.0)                
##  tibble         3.0.4   2020-10-12 [3] CRAN (R 4.0.2)                
##  tidyr          1.1.2   2020-08-27 [3] CRAN (R 4.0.0)                
##  tidyselect     1.1.0   2020-05-11 [3] CRAN (R 4.0.0)                
##  vctrs          0.3.5   2020-11-17 [3] CRAN (R 4.0.2)                
##  withr          2.3.0   2020-09-22 [3] CRAN (R 4.0.2)                
##  xfun           0.19    2020-10-30 [3] CRAN (R 4.0.2)                
##  yaml           2.2.1   2020-02-01 [3] CRAN (R 4.0.0)                
## 
## [1] /private/var/folders/pg/fjg8r4fj5v33zqmwptf9mfg80000gn/T/RtmpoGapBj/Rinst12614536d51cf
## [2] /private/var/folders/pg/fjg8r4fj5v33zqmwptf9mfg80000gn/T/Rtmp9uVgtw/temp_libpath122121ce65082
## [3] /Library/Frameworks/R.framework/Versions/4.0/Resources/library

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

ggalluvial/inst/doc/ggalluvial.R0000644000176200001440000001113513762566155016416 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 Titanic dataset------------------------------------ ggplot(as.data.frame(Titanic), aes(y = Freq, axis1 = Survived, axis2 = Sex, axis3 = Class)) + geom_alluvium(aes(fill = Class), width = 0, knot.pos = 0, reverse = FALSE) + guides(fill = FALSE) + geom_stratum(width = 1/8, reverse = FALSE) + geom_text(stat = "stratum", aes(label = after_stat(stratum)), reverse = FALSE) + scale_x_continuous(breaks = 1:3, labels = c("Survived", "Sex", "Class")) + coord_flip() + ggtitle("Titanic survival by class and sex") ## ----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.Rmd0000644000176200001440000005553613762507372015753 0ustar liggesusers--- title: "Tooltips for ggalluvial plots in Shiny apps" author: "Quentin D. Read" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{ggalluvial in Shiny apps} %\VignetteEngine{knitr::rmarkdown} \usepackage[utf8]{inputenc} --- ```{r setup} knitr::opts_chunk$set(fig.width = 6, fig.height = 3, fig.align = "center") library(ggalluvial) ``` ## 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 a Shiny app that displays 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()`. The tooltips that appear when the user hovers over elements of the plot show a text label and the number of flows included in each group. This is made relatively straightforward because 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 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. ## Data for reproducible example This toy dataset is used for the example app. ```{r toy dataset, message = FALSE, warning = FALSE} example_data <- data.frame( weight = rep(1, 12), ID = 1:12, cluster = rep(c(1, 2), c(4, 8)), grp1 = rep(c('1a', '1b', '1a', '1b'), c(3, 2, 3, 4)), grp2 = rep(c('2a', '2b', '2a', '2b', '2a'), c(2, 2, 2, 2, 4)), grp3 = rep(c('3a','3b', '3a', '3b'), c(3, 2, 2, 5)) ) ``` Here is a static plot generated using the toy dataset. ```{r static plot, fig.width = 6} ggplot(example_data, aes(y = weight, axis1 = grp1, axis2 = grp2, axis3 = grp3)) + geom_alluvium(aes(fill = factor(cluster)), knot.pos = 0.25) + geom_stratum(width = 1/8, reverse = TRUE) + geom_text(aes(label = after_stat(stratum)), stat = "stratum", reverse = TRUE, size = rel(3)) + theme_bw() + scale_x_continuous(expand = c(0, 0)) + scale_y_continuous(expand = c(0, 0)) ``` ## Structure of the example app Here, we will go over each section of the code in detail. The full code is reproduced at the bottom of this document. ### 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 = "500px", 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. Both of 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. ### Server function The server function is more complex. Its general structure looks like this, in pseudocode: ```{r server function skeleton, eval = FALSE} server <- function(input, output, session) { output$alluvial_plot <- renderPlot({ '' '' '' '' '' '' }) output$tooltip <- renderText({ if ('') { if ('') { '' } else { if ('') { '' } } } }) } ``` First, we create the `ggplot` object for the alluvial plot, then we call the `ggplot_build()` function to build the plot without displaying it. The next lines of code are to "reverse engineer" the polygon coordinates. Finally, we call `renderPlot()` to pass the plot to `output`. 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.jpg) 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.jpg) If the mouse cursor is hovering over an empty region of the plot, nothing is returned by `renderText()` and so no tooltip text box is displayed. ![screenshot of cursor over empty region](https://raw.githubusercontent.com/corybrunson/ggalluvial/main/vignettes/img/hover_empty_area.jpg) Let's take a deeper dive into each part of the server function. #### 1. Drawing plot and extracting coordinates The first part of the server function includes code to draw the plot and build it with `ggplot_build()`. Note that the global assignment operator `<<-` is used to assign `node_width` and `pbuilt` so they are both accessible outside the `renderPlot()` expression. _Note:_ In the example presented here, strictly speaking all of the plot drawing and coordinate extracting code could be 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. So we've left it there in the example code. ```{r server part 1a, eval = FALSE} output$alluvial_plot <- renderPlot({ # Width of node boxes node_width <<- 1/4 p <- ggplot(example_data, aes(y = weight, axis1 = grp1, axis2 = grp2, axis3 = grp3)) + geom_alluvium(aes(fill = factor(cluster)), knot.pos = 0.25) + geom_stratum(width = node_width, reverse = TRUE) + geom_text(aes(label = after_stat(stratum)), stat = "stratum", reverse = TRUE, size = rel(3)) + theme_bw() + scale_x_continuous(expand = c(0, 0)) + scale_y_continuous(expand = c(0, 0)) # Build the plot. Use global assignment so that this object is accessible # later. 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`, which has a value of 1/3 hard-coded into `ggalluvial::geom_alluvium()`, then split the data frame by group (groups correspond to the individual alluvium polygons). We apply the unexported function `ggalluvial:::data_to_xspline()` to each element of the list to get the x-spline coordinates. Then, we pass the x-spline coordinates to the function `grid::xsplineGrob()` to convert them into a `grid` object. We pass the resulting object to `grid::xsplinePoints()`. At this point we now have the coordinates of the alluvium polygons. ```{r server part 1b, eval = FALSE} # 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 = 1/3) groups_to_draw <- split(data_draw, data_draw$group) group_xsplines <- lapply(groups_to_draw, ggalluvial:::data_to_xspline, knot.prop = TRUE) # 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 fixing the range of the x axis as 1 to the number of strata, adjusted by the width of the nodes, and the y axis to the number of rows in the data (again, this is possible here because each flow polygon is exactly 1 unit high). We define a function `new_range_transform()` inline and apply it to each set of coordinates, assigning the resulting object globally so it can be accessed later. Now we have the coordinates of the polygons in plot units! So we can close the expression after returning the plot. ```{r server part 1c, 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 - 1/6, 3 + 1/6) yrange_new <- c(0, nrow(example_data)) # 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. Use global assignment. 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) }) # Return plot p }, res = 200) ``` #### 2. Logic for determining cursor location and displaying tooltips 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`. ```{r, eval = FALSE} output$tooltip <- renderText( if(!is.null(input$plot_hover)) { ... } ... ) ``` 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. ```{r, eval = FALSE} hover <- input$plot_hover x_coord <- round(hover$x) if(abs(hover$x - x_coord) < (node_width / 2)) { ... } ``` The nearest integer to the y-coordinate corresponds to the row of the data frame because we set `reverse = TRUE` and all `weight = 1` in the input data. So, for example, the first row of the data frame corresponds to y range `c(0, 1)`, the second `c(1, 2)`, and so forth. This gives us all the information we need to find the index of the rows of the input data that goes with the stratum the cursor is on. _Note:_ It is necessary for the input data to be sorted in ascending order of the `group` column, named `cluster` in this example. If it is not sorted in this way, the relative order of the flows along the y-axis will not correspond to their order in the data. ```{r, eval = FALSE} node_row <- pbuilt$data[[2]]$x == x_coord & hover$y > pbuilt$data[[2]]$ymin & hover$y < pbuilt$data[[2]]$ymax ``` We get the name of the stratum as well as the total number of flows passing through it. ```{r, eval = FALSE} node_label <- pbuilt$data[[2]]$stratum[node_row] node_n <- pbuilt$data[[2]]$n[node_row] ``` Finally, we render a tooltip using the `div` tag and passing it to `htmltools::renderTags()`. 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 the mouse cursor location in those units. ```{r, 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 ``` If the cursor is not over a stratum, the next logic 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, 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. 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 will display the names of all the nodes that the alluvium passes through. ```{r info for alluvia tooltip, eval = FALSE} coord_id <- rev(which(hover_within_flow == 1))[1] flow_id <- example_data$ID[coord_id] axis_values <- example_data[flow_id, c('grp1', 'grp2', 'grp3')] ``` We render a tooltip that shows the names of all the nodes that the hovered path passes through, using very similar syntax to the above tooltip. ```{r, eval = FALSE} renderTags( tags$div( paste(axis_values, collapse = ' -> '), 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 ``` ## Conclusion This vignette demonstrates how to enable tooltips for **ggalluvial** plots in Shiny apps. However it's important to note that some of the workarounds are slightly inelegant. This may not be the optimal way to do it — other solutions are certainly possible! ## Appendix ### Complete app code ```{r full app, eval = FALSE} library(ggalluvial) library(shiny) library(htmltools) library(sp) example_data <- data.frame( weight = rep(1, 12), ID = 1:12, cluster = rep(c(1, 2), c(4, 8)), grp1 = rep(c('1a', '1b', '1a', '1b'), c(3, 2, 3, 4)), grp2 = rep(c('2a', '2b', '2a', '2b', '2a'), c(2, 2, 2, 2, 4)), grp3 = rep(c('3a','3b', '3a', '3b'), c(3, 2, 2, 5)) ) # User interface ui <- fluidPage( fluidRow(tags$div( style = "position: relative;", plotOutput("alluvial_plot", height = "500px", hover = hoverOpts(id = "plot_hover") ), htmlOutput("tooltip"))) ) server <- function(input, output, session) { # Draw plot and extract coordinates output$alluvial_plot <- renderPlot({ # Width of node boxes node_width <<- 1/4 p <- ggplot(example_data, aes(y = weight, axis1 = grp1, axis2 = grp2, axis3 = grp3)) + geom_alluvium(aes(fill = factor(cluster)), knot.pos = 0.25) + geom_stratum(width = node_width, reverse = TRUE) + geom_text(aes(label = after_stat(stratum)), stat = "stratum", reverse = TRUE, size = rel(3)) + theme_bw() + scale_x_continuous(expand = c(0, 0)) + scale_y_continuous(expand = c(0, 0)) # Build the plot. Use global assignment so that this object is accessible # later. 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 = 1/3) groups_to_draw <- split(data_draw, data_draw$group) group_xsplines <- lapply(groups_to_draw, ggalluvial:::data_to_xspline, knot.prop = TRUE) # 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 - 1/6, 3 + 1/6) yrange_new <- c(0, nrow(example_data)) # 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. Use global assignment. 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) }) # Return plot 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]]$n[node_row] # Offset, in pixels, for location of tooltip relative to mouse cursor, # in both x and y direction. offset <- 5 # 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] # Get the corresponding row ID from the data. flow_id <- example_data$ID[coord_id] # Get the axis 1-3 values for all axes for that row ID. axis_values <- example_data[flow_id, c('grp1', 'grp2', 'grp3')] offset <- 5 # Render tooltip renderTags( tags$div( paste(axis_values, collapse = ' -> '), 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/doc/order-rectangles.rmd0000644000176200001440000005315613710336102020075 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/stat.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/CITATION0000644000176200001440000000251013761533613014521 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" )