ggforce/0000755000176200001440000000000015024531642011670 5ustar liggesusersggforce/MD50000644000176200001440000001607315024531642012207 0ustar liggesusers0f324a65c14bf9b32413a5085bc805a8 *DESCRIPTION c31ee18d335f7158ed985f5939319c1f *LICENSE 080ab81d44918970c5d5698f05f83350 *LICENSE.note 074ab9753bfc295e06671afc06b28a42 *NAMESPACE 7b0338621efeb25dbfb155e8b0608546 *NEWS.md 12cc4083f50e0ef0f19badedc241d114 *R/aaa.R 1f01d04150c3b044dacaea7435f7e45f *R/arc.R 0f0179e54a253252be3bcb4c22d5ff92 *R/arc_bar.R ca37977420f37be66a6031b9a40b9022 *R/autodensity.R c194934911d49c255c58f7316ba921e9 *R/autohistogram.R 13039b04f6ae7e452d16b479d2d4b2bf *R/autopoint.R d0a98f01b845dcfb261c5c1eccdf4253 *R/bezier.R ef1e35a4fc5515a3e0d548aa04eca750 *R/bspline.R f3c66e7ee357f21bc6bbf6a5ad30cf9d *R/bspline_closed.R 853e89d229853ab7e58b97d69ca6cef3 *R/circle.R 00d562332a5fc99f75f71f6b538b78fa *R/concaveman.R c687ba220bc21ef0a7dd62303c61e0c5 *R/cpp11.R 1171d5d516722bdff581414641f1fc6c *R/diagonal.R 16f46895a5ff9b24ed5007dcfd359fe2 *R/diagonal_wide.R 623e0fee3967a653bdb9a426113d45b9 *R/ellipse.R 6be6f08eff892a77c5f8d4dd1fa18247 *R/errorbar.R 421f4ca6923977a98b8f1834f6b1c97c *R/facet_grid_paginate.R cac927db87335eea506373c371d32b40 *R/facet_matrix.R c1e1b35b18de21912df5dbb4d3810ca9 *R/facet_row.R 0fc347de7cb9993e4ac4a2cde077d921 *R/facet_stereo.R 052f774ea52dedd966a524daf60ad90a *R/facet_wrap_paginate.R d05f6058ff91fd944bea2c1ea467bfb4 *R/facet_zoom.R af8fd5a428595ecc4975599456c6593e *R/ggforce-package.R fee6ed1299effd00b4befb852ea654d5 *R/ggproto-classes.R 9c2a181144180cd8c8dfc4e9c8a954d1 *R/interpolate.R c12c9a5d11dedb91ab0a8382a2fec52c *R/labeller.R 85a0cf0f9790392267b4465dafe91b31 *R/link.R d181392cd2d141dbd04afdac40beb088 *R/mark_circle.R f693347195fb26f7f9d4808163654191 *R/mark_ellipse.R 9e3d8d4deb8331ea73e98e501bc848fc *R/mark_hull.R 4da8d0fe511dea85d541d11c38049ae8 *R/mark_label.R ef7f45acab57912d1cd0f047ea556a38 *R/mark_rect.R 8c2ac81d2578f2c9ad4ddf19368be99d *R/parallel_sets.R 35c1d6bb63b6059b67282bb2e21a533a *R/position-jitternormal.R b02c6b794b7a5f0cc98b46986ad168c9 *R/position_auto.R e2c245568f1812ad738db99e84dd66e3 *R/position_floatstack.R 2462411f657908c80009e3e33ffce669 *R/regon.R 09d1e9f5963b8b14726dca48d3010fac *R/scale-depth.R 66aaf0b2f89a197e67dab0258e5f1fea *R/scale-unit.R fcdd7b21be9a3e641e8929de7949419a *R/shape.R 248c43f056155b4c91f0392071105f08 *R/sina.R d9775dba79f7ddf16dbad9bf4e92499b *R/spiro.R d1434c1bd4a80b925fe3d61951e9eaca *R/themes.R 16dd7665e67da1bbb9bc7723907941c5 *R/trans.R 5e8a4bebb3759a54f64ff4e86061166f *R/trans_linear.R b468e65f7d135ed9b5a6325180b53366 *R/utilities.R 8e376dec4d9ea46de0ecc35774a549d3 *R/voronoi.R 3937d69e2f342a1bfd06b54cc2034ab1 *R/zzz.R 0fec52c688730f2cddbed11b7f268a31 *README.md 34f8441533f62b6c21362a5ebf2de211 *man/facet_grid_paginate.Rd bdd64205f085c5b1063a417abb7e4ae9 *man/facet_matrix.Rd cb1f767b59e1cb4a70ccc8429a36e75e *man/facet_row.Rd 6f063e27bf980fed22223bda91c1e481 *man/facet_stereo.Rd bd12faf79d8cc83c090e43dfa7b46853 *man/facet_wrap_paginate.Rd cb3f6f3cc4b80d5247e8dde831a56843 *man/facet_zoom.Rd f3860f9dd9e3f1f7aaf2b1d08ca490a9 *man/figures/README-example-1.png cb1e46f469cfbbbde29c8b5113e1d789 *man/figures/lifecycle-archived.svg c0d2e5a54f1fa4ff02bf9533079dd1f7 *man/figures/lifecycle-defunct.svg a1b8c987c676c16af790f563f96cbb1f *man/figures/lifecycle-deprecated.svg c3978703d8f40f2679795335715e98f4 *man/figures/lifecycle-experimental.svg 952b59dc07b171b97d5d982924244f61 *man/figures/lifecycle-maturing.svg 27b879bf3677ea76e3991d56ab324081 *man/figures/lifecycle-questioning.svg 53b3f893324260b737b3c46ed2a0e643 *man/figures/lifecycle-stable.svg 1c1fe7a759b86dc6dbcbe7797ab8246c *man/figures/lifecycle-superseded.svg 700122af4c3aa3fc71a7562348bcf127 *man/figures/logo.png 20fa804950661156114c48629db7ccec *man/figures/logo.svg d68befdb639b3c9e843bf8f00b70a407 *man/gather_set_data.Rd 38fe90883e68a98382de54d7fa3ad85c *man/geom_arc.Rd 3c378ceebf8153d1bd7f65fe079f2be8 *man/geom_arc_bar.Rd ada8e4f403417bde511befd072c8092e *man/geom_autohistogram.Rd bc23e484f08879f91412e5d92544f812 *man/geom_autopoint.Rd 26e7b0651f4c9aa33da05177ac27c4f2 *man/geom_bezier.Rd 7d0a275f7f8a49af1a88d4b3e02a4a44 *man/geom_bspline.Rd dadf8f0df890b16f4b82d3cdc3c67d2e *man/geom_bspline_closed.Rd 041f54088241c881c9ba705bf11fbed7 *man/geom_circle.Rd 775162e8cd51c1b710a8dc69511b3ed7 *man/geom_delvor.Rd 99caf2937555642998969219fddfcef8 *man/geom_diagonal.Rd db065dbc5a1bea7c4a014f8085ce5d2f *man/geom_diagonal_wide.Rd 5766b3b711dc058f5d766a7cb6532521 *man/geom_ellipse.Rd 0a1c24a0313f80aad8d43c675e17e00f *man/geom_link.Rd 5a376e241226e54eb6ea4313ce9878e7 *man/geom_mark_circle.Rd 90c0f296d197ae6db5c52f17ec915a58 *man/geom_mark_ellipse.Rd 3ffc8d345a617d7bccd9df1732dfebc9 *man/geom_mark_hull.Rd e3c3ead4fc60266a203dccdc5a5b81ab *man/geom_mark_rect.Rd 303c46061a85eb851bb2c72e206f3aea *man/geom_parallel_sets.Rd 8208c875eaa8babbbc6f37ffe96f4124 *man/geom_regon.Rd 445339639088f126ae0993e8e6ed9e3f *man/geom_shape.Rd f29793c651072a851b0cd7ab10fbe073 *man/geom_sina.Rd 8611991555bf78922f190d64efa38f59 *man/geom_spiro.Rd b745311004a906a5a207974dd646f35c *man/ggforce-extensions.Rd d5f74b11aa5d1708b69865f2a3f35cf4 *man/ggforce-package.Rd 7c04ebc12cbdf837804cc8c209b5025d *man/interpolateDataFrame.Rd bf23fe37e93fbcd24a4db8329b5e2556 *man/label_tex.Rd 4b75fdf88125c4f945353f24882dbbfa *man/linear_trans.Rd 12d8ae329fdd7b044564efe314941910 *man/n_pages.Rd c8d17319bff3a6a004b3f9d767019c62 *man/position_auto.Rd f4e33dd3b73f846e28ba59b4ca9aa549 *man/position_jitternormal.Rd 90ee86eb2026d21d1a8afd45d73619e8 *man/power_trans.Rd 5e4f94cfb65e7a14c1e41ca0a2ffe522 *man/radial_trans.Rd e7ebcf6bf39671dc8c5e8ed9cb067a20 *man/scale_depth.Rd 81f0cace928f1172ca90e3a6aade2a31 *man/scale_unit.Rd 2aac875e37de638d63febb91f4490f67 *man/shapeGrob.Rd 710ac854092f1b36ae7bd9ddfe07c357 *man/stat_err.Rd e4501f76729f26339ebb93cd3f853dc5 *man/theme_no_axes.Rd e0c9cb605b5af22900c9f8ecbc5e8f84 *man/trans_reverser.Rd 8b4d9b9ac04ec5409e1667eb5d4b9589 *src/bSpline.cpp cd53945f1775af2ede09b6ce727f71b0 *src/bezier.cpp 9fc22691ccf2b79f27e0e11f39d36843 *src/concaveman.cpp acc36ca6c5604b6cbce4be77fd6e5f29 *src/concaveman.h f4e932bcee9431b48a22db524736bcb5 *src/cpp11.cpp 952452371235096bd5455de7fcf23f09 *src/deBoor.cpp 1e1eb94fe5ba5f4ecf4b4155c07f2f53 *src/deBoor.h 06cbe4d0bae805dca91f92d5b73d56fe *src/ellipseEnclose.cpp c6a103fbf17e1ebd51e0b28776cd4ef4 *src/enclose.cpp 4292ccc3b33dc008dd74e703704548c7 *src/pointPath.cpp e8b532d2bc26c567813dcd5a3af8d4e1 *src/robust_predicate/basebase.hpp 5b63cd9ba0d4922fced992ce960c199f *src/robust_predicate/expansion/dd_float.hpp afeb6ca4d21281202b0809645cd05bc8 *src/robust_predicate/expansion/ia_float.hpp 3e6128ab60bd53d369b2f274b5b1d23f *src/robust_predicate/expansion/mp_basic.hpp 02cb16f743b91b20a15929b68981ee3d *src/robust_predicate/expansion/mp_float.hpp 5cd12fac76f95d21edbcde6eb1529ef2 *src/robust_predicate/expansion/mp_utils.hpp 070a96d8b18e519704b9d3138a19f40d *src/robust_predicate/geompred.hpp c08f6a3175ee1a434e7b2a6f754ca8a9 *src/robust_predicate/mpfloats.hpp 888dcf3a8848a3b341a6ebd9b55c1d22 *src/robust_predicate/predicate/bisect_k.hpp 5c68ad1145c502b92fb7fa54269f8e0b *src/robust_predicate/predicate/inball_k.hpp ed46fef36cee58314ccb9870e89d2e06 *src/robust_predicate/predicate/orient_k.hpp 1421c01526322adf92d16eb6862e671a *src/robust_predicate/predicate/predicate_k.hpp ggforce/R/0000755000176200001440000000000015024472120012064 5ustar liggesusersggforce/R/autohistogram.R0000644000176200001440000001116414672274110015107 0ustar liggesusers#' A distribution geoms that fills the panel and works with discrete and continuous data #' #' These versions of the histogram and density geoms have been designed #' specifically for diagonal plotting with [facet_matrix()]. They differ from #' [ggplot2::geom_histogram()] and [ggplot2::geom_density()] in that they #' defaults to mapping `x` and `y` to `.panel_x` and `.panel_y` respectively, #' they ignore the y scale of the panel and fills it out, and they work for both #' continuous and discrete x scales. #' #' @inheritParams ggplot2::geom_histogram #' #' @seealso [facet_matrix] for creating matrix grids #' #' @export #' #' @examples #' # A matrix plot with a mix of discrete and continuous variables #' p <- ggplot(mpg) + #' geom_autopoint() + #' facet_matrix(vars(drv:fl), layer.diag = 2, grid.y.diag = FALSE) #' p #' #' # Diagonal histograms #' p + geom_autohistogram() #' #' # Diagonal density distributions #' p + geom_autodensity() #' #' # You can use them like regular layers with groupings etc #' p + geom_autodensity(aes(colour = drv, fill = drv), #' alpha = 0.4) geom_autohistogram <- function(mapping = NULL, data = NULL, stat = "autobin", position = "floatstack", ..., bins = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) { extra_mapping <- aes(x = .panel_x, y = .panel_y) if (is.null(mapping$x)) mapping$x <- extra_mapping$x if (is.null(mapping$y)) mapping$y <- extra_mapping$y class(mapping) <- 'uneval' layer( data = data, mapping = mapping, stat = stat, geom = GeomAutorect, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( bins = bins, na.rm = na.rm, ... ) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatAutobin <- ggproto('StatAutobin', StatBin, setup_params = function(data, params) { if (is.null(params$bins)) params$bins <- 30 params$panel_range <- lapply(split(data$y, data$PANEL), function(y) { if (length(y) == 0) return() range(y, na.rm=TRUE) }) params$panel_count <- lapply(split(data$y, data$PANEL), function(y)length(y[is.finite(y)])) params }, compute_group = function(self, data, scales, binwidth = NULL, bins = NULL, center = NULL, boundary = NULL, closed = c("right", "left"), pad = FALSE, breaks = NULL, panel_range = list(), panel_count = list(), # The following arguments are not used, but must # be listed so parameters are computed correctly origin = NULL, right = NULL, drop = NULL, width = NULL) { if (scales$x$is_discrete()) { binned <- lapply(split(data, data$x), function(d) { data_frame0( count = nrow(d), x = d$x[1], xmin = d$x[1] - 0.5, xmax = d$x[1] + 0.5, width = 1 ) }) binned <- vec_rbind(!!!binned) binned$density <- binned$count / sum(binned$count) binned$ncount <- binned$count / max(binned$count) binned$ndensity <- binned$density / max(binned$density) } else { binned <- ggproto_parent(StatBin, self)$compute_group( data, scales, binwidth = binwidth, bins = bins, center = center, boundary = boundary, closed = closed, pad = pad, breaks = breaks, origin = origin, right = right, drop = drop ) } panel_range <- panel_range[[data$PANEL[1]]] panel_count <- panel_count[[data$PANEL[1]]] binned$ymin <- panel_range[1] binned$ymax <- binned$ymin + binned$ncount * (panel_range[2] - panel_range[1]) * nrow(data) / panel_count binned$y <- (binned$ymin + binned$ymax) / 2 binned }, default_aes = aes(weight = 1), required_aes = c("x", "y") ) #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export GeomAutorect <- ggproto('PositionAutorect', GeomRect, draw_panel = function(self, data, panel_params, coord, ...) { y_range <- coord$range(panel_params)$y y_span <- y_range[2] - y_range[1] panel_min <- min(data$ymin) panel_span <- max(data$ymax) - panel_min data$ymin <- ((data$ymin - panel_min) / panel_span) * y_span * 0.9 + y_range[1] data$ymax <- ((data$ymax - panel_min) / panel_span) * y_span * 0.9 + y_range[1] ggproto_parent(GeomRect, self)$draw_panel(data, panel_params, coord, ...) }, extra_params = c('na.rm', 'lineend', 'linejoin') ) ggforce/R/ggforce-package.R0000644000176200001440000000354414672274110015231 0ustar liggesusers#' @useDynLib ggforce #' @import ggplot2 #' #' @examples #' rocketData <- data.frame( #' x = c(1, 1, 2, 2), #' y = c(1, 2, 2, 3) #' ) #' rocketData <- do.call(rbind, lapply(seq_len(500) - 1, function(i) { #' rocketData$y <- rocketData$y - c(0, i / 500) #' rocketData$group <- i + 1 #' rocketData #' })) #' rocketData2 <- data.frame( #' x = c(2, 2.25, 2), #' y = c(2, 2.5, 3) #' ) #' rocketData2 <- do.call(rbind, lapply(seq_len(500) - 1, function(i) { #' rocketData2$x[2] <- rocketData2$x[2] - i * 0.25 / 500 #' rocketData2$group <- i + 1 + 500 #' rocketData2 #' })) #' #' ggplot() + geom_link(aes( #' x = 2, y = 2, xend = 3, yend = 3, alpha = after_stat(index), #' size = after_stat(index) #' ), colour = 'goldenrod', n = 500) + #' geom_bezier(aes(x = x, y = y, group = group, colour = after_stat(index)), #' data = rocketData #' ) + #' geom_bezier(aes(x = y, y = x, group = group, colour = after_stat(index)), #' data = rocketData #' ) + #' geom_bezier(aes(x = x, y = y, group = group, colour = 1), #' data = rocketData2 #' ) + #' geom_bezier(aes(x = y, y = x, group = group, colour = 1), #' data = rocketData2 #' ) + #' geom_text(aes(x = 1.65, y = 1.65, label = 'ggplot2', angle = 45), #' colour = 'white', size = 15 #' ) + #' coord_fixed() + #' scale_x_reverse() + #' scale_y_reverse() + #' scale_alpha(range = c(1, 0), guide = 'none') + #' scale_size_continuous( #' range = c(20, 0.1), trans = 'exp', #' guide = 'none' #' ) + #' scale_color_continuous(guide = 'none') + #' xlab('') + ylab('') + #' ggtitle('ggforce: Accelerating ggplot2') + #' theme(plot.title = element_text(size = 20)) #' @keywords internal "_PACKAGE" ## usethis namespace: start #' @import rlang #' @import vctrs #' @importFrom lifecycle deprecated #' @useDynLib ggforce, .registration = TRUE ## usethis namespace: end NULL ggforce/R/bspline_closed.R0000644000176200001440000001035515024471216015205 0ustar liggesusers#' Create closed b-spline shapes #' #' This geom creates closed b-spline curves and draws them as shapes. The #' closed b-spline is achieved by wrapping the control points rather than the #' knots. The *0 version uses the [grid::xsplineGrob()] function with #' `open = FALSE` and can thus not be manipulated as a shape geom in the same #' way as the base version (expand, contract, etc). #' #' @section Aesthetics: #' geom_bspline_closed understand the following aesthetics (required aesthetics #' are in bold): #' #' - **x** #' - **y** #' - color #' - fill #' - linewidth #' - linetype #' - alpha #' #' @section Computed variables: #' #' \describe{ #' \item{x, y}{The coordinates for the path describing the spline} #' \item{index}{The progression along the interpolation mapped between 0 and 1} #' } #' #' @inheritParams ggplot2::geom_polygon #' @inheritParams ggplot2::stat_identity #' #' @param n The number of points generated for each spline #' #' @author Thomas Lin Pedersen. The C++ code for De Boor's algorithm has been #' adapted from #' \href{https://chi3x10.wordpress.com/2009/10/18/de-boor-algorithm-in-c/}{Jason Yu-Tseh Chi implementation} #' #' @name geom_bspline_closed #' @rdname geom_bspline_closed #' #' @examples #' # Create 6 random control points #' controls <- data.frame( #' x = runif(6), #' y = runif(6) #' ) #' #' ggplot(controls, aes(x, y)) + #' geom_polygon(fill = NA, colour = 'grey') + #' geom_point(colour = 'red') + #' geom_bspline_closed(alpha = 0.5) #' #' # The 0 version approximates the correct shape #' ggplot(controls, aes(x, y)) + #' geom_polygon(fill = NA, colour = 'grey') + #' geom_point(colour = 'red') + #' geom_bspline_closed0(alpha = 0.5) #' #' # But only the standard version supports geom_shape operations #' # Be aware of self-intersections though #' ggplot(controls, aes(x, y)) + #' geom_polygon(fill = NA, colour = 'grey') + #' geom_point(colour = 'red') + #' geom_bspline_closed(alpha = 0.5, expand = unit(2, 'cm')) NULL #' @rdname geom_bspline_closed #' @export stat_bspline_closed <- function(mapping = NULL, data = NULL, geom = 'shape', position = 'identity', na.rm = FALSE, n = 100, show.legend = NA, inherit.aes = TRUE, ...) { layer( stat = StatBspline, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, n = n, ...) ) } #' @rdname geom_bspline_closed #' @export geom_bspline_closed <- function(mapping = NULL, data = NULL, stat = 'bspline', position = 'identity', n = 100, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomShape, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, n = n, type = 'closed', ...) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom grid xsplineGrob gpar #' @export GeomBsplineClosed0 <- ggproto('GeomBspline0', GeomPolygon, draw_panel = function(data, panel_scales, coord, na.rm = FALSE) { coords <- coord$transform(data, panel_scales) if (!is.integer(coords$group)) { coords$group <- match(coords$group, unique0(coords$group)) } startPoint <- match(unique0(coords$group), coords$group) xsplineGrob(coords$x, coords$y, id = coords$group, default.units = 'native', shape = 1, open = FALSE, gp = gpar( col = coords$colour[startPoint], fill = ggplot2::fill_alpha(coords$fill[startPoint], coords$alpha[startPoint]), lwd = (coords$linewidth[startPoint] %||% coords$size[startPoint]) * .pt, lty = coords$linetype[startPoint] ) ) } ) #' @rdname geom_bspline_closed #' @export geom_bspline_closed0 <- function(mapping = NULL, data = NULL, stat = 'identity', position = 'identity', na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomBsplineClosed0, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, ...) ) } ggforce/R/autopoint.R0000644000176200001440000000321014672274110014234 0ustar liggesusers#' A point geom specialised for scatterplot matrices #' #' This geom is a specialisation of [ggplot2::geom_point()] with two changes. It #' defaults to mapping `x` and `y` to `.panel_x` and `.panel_y` respectively, #' and it defaults to using [position_auto()] to jitter the points based on the #' combination of position scale types. #' #' @inheritParams ggplot2::geom_point #' #' @seealso [facet_matrix] for how to lay out scatterplot matrices and #' [position_auto] for information about the position adjustments #' #' @export #' #' @examples #' # Continuous vs continuous: No jitter #' ggplot(mpg) + geom_autopoint(aes(cty, hwy)) #' #' # Continuous vs discrete: sina jitter #' ggplot(mpg) + geom_autopoint(aes(cty, drv)) #' #' # Discrete vs discrete: disc-jitter #' ggplot(mpg) + geom_autopoint(aes(fl, drv)) #' #' # Used with facet_matrix (x and y are automatically mapped) #' ggplot(mpg) + #' geom_autopoint() + #' facet_matrix(vars(drv:fl)) #' geom_autopoint <- function(mapping = NULL, data = NULL, stat = "identity", position = "auto", ..., na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) { extra_mapping <- aes(x = .panel_x, y = .panel_y) if (is.null(mapping$x)) mapping$x <- extra_mapping$x if (is.null(mapping$y)) mapping$y <- extra_mapping$y class(mapping) <- 'uneval' layer( data = data, mapping = mapping, stat = stat, geom = GeomPoint, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( na.rm = na.rm, ... ) ) } ggforce/R/arc.R0000644000176200001440000001774414672274110013000 0ustar liggesusers#' @include arc_bar.R NULL #' Arcs based on radius and radians #' #' This set of stats and geoms makes it possible to draw circle segments based #' on a center point, a radius and a start and end angle (in radians). These #' functions are intended for cartesian coordinate systems and makes it possible #' to create circular plot types without using the #' [ggplot2::coord_polar()] coordinate system. #' #' @details An arc is a segment of a line describing a circle. It is the #' fundamental visual element in donut charts where the length of the segment #' (and conversely the angular span of the segment) describes the proportion of #' an entety. #' #' @section Aesthetics: #' geom_arc understand the following aesthetics (required aesthetics are in #' bold): #' #' - **x0** #' - **y0** #' - **r** #' - **start** #' - **end** #' - color #' - linewidth #' - linetype #' - alpha #' - lineend #' #' @section Computed variables: #' #' \describe{ #' \item{x, y}{The start coordinates for the segment} #' \item{xend, yend}{The end coordinates for the segment} #' \item{curvature}{The curvature of the curveGrob to match a circle} #' } #' #' @inheritParams ggplot2::geom_path #' @inheritParams ggplot2::stat_identity #' #' @param n the smoothness of the arc. Sets the number of points to use if the #' arc would cover a full circle #' #' @param ncp the number of control points used to draw the arc with curveGrob. #' Determines how well the arc approximates a circle section #' #' @name geom_arc #' @rdname geom_arc #' @seealso [geom_arc_bar()] for drawing arcs with fill #' #' @examples #' # Lets make some data #' arcs <- data.frame( #' start = seq(0, 2 * pi, length.out = 11)[-11], #' end = seq(0, 2 * pi, length.out = 11)[-1], #' r = rep(1:2, 5) #' ) #' #' # Behold the arcs #' ggplot(arcs) + #' geom_arc(aes(x0 = 0, y0 = 0, r = r, start = start, end = end, #' linetype = factor(r))) #' #' # Use the calculated index to map values to position on the arc #' ggplot(arcs) + #' geom_arc(aes(x0 = 0, y0 = 0, r = r, start = start, end = end, #' size = after_stat(index)), lineend = 'round') #' #' # The 0 version maps directly to curveGrob instead of calculating the points #' # itself #' ggplot(arcs) + #' geom_arc0(aes(x0 = 0, y0 = 0, r = r, start = start, end = end, #' linetype = factor(r))) #' #' # The 2 version allows interpolation of aesthetics between the start and end #' # points #' arcs2 <- data.frame( #' angle = c(arcs$start, arcs$end), #' r = rep(arcs$r, 2), #' group = rep(1:10, 2), #' colour = sample(letters[1:5], 20, TRUE) #' ) #' #' ggplot(arcs2) + #' geom_arc2(aes(x0 = 0, y0 = 0, r = r, end = angle, group = group, #' colour = colour), size = 2) #' NULL #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatArc <- ggproto('StatArc', Stat, compute_panel = function(data, scales, n = 360) { arcPaths(data, n) }, required_aes = c('x0', 'y0', 'r', 'start', 'end') ) #' @rdname geom_arc #' @export stat_arc <- function(mapping = NULL, data = NULL, geom = 'arc', position = 'identity', na.rm = FALSE, show.legend = NA, n = 360, inherit.aes = TRUE, ...) { layer( stat = StatArc, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, n = n, ...) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom grid curveGrob gList gpar #' @export GeomArc <- ggproto('GeomArc', GeomPath) #' @rdname geom_arc #' @export geom_arc <- function(mapping = NULL, data = NULL, stat = 'arc', position = 'identity', n = 360, arrow = NULL, lineend = 'butt', na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomArc, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(arrow = arrow, n = n, lineend = lineend, na.rm = na.rm, ...) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatArc2 <- ggproto('StatArc2', Stat, compute_panel = function(data, scales, n = 360) { arcPaths2(data, n) }, required_aes = c('x0', 'y0', 'r', 'group', 'end') ) #' @rdname geom_arc #' @export stat_arc2 <- function(mapping = NULL, data = NULL, geom = 'path_interpolate', position = 'identity', na.rm = FALSE, show.legend = NA, n = 360, inherit.aes = TRUE, ...) { layer( stat = StatArc2, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, n = n, ...) ) } #' @rdname geom_arc #' @export geom_arc2 <- function(mapping = NULL, data = NULL, stat = 'arc2', position = 'identity', n = 360, arrow = NULL, lineend = 'butt', na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomPathInterpolate, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(arrow = arrow, n = n, lineend = lineend, na.rm = na.rm, ...) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom grid arcCurvature #' @export StatArc0 <- ggproto('StatArc0', Stat, compute_panel = function(data, scales) { data$x <- data$x0 + data$r * sin(data$start) data$y <- data$y0 + data$r * cos(data$start) data$xend <- data$x0 + data$r * sin(data$end) data$yend <- data$y0 + data$r * cos(data$end) deltaA <- (data$start - data$end) * 180 / pi data$curvature <- sign(deltaA) * sapply(abs(deltaA), arcCurvature) data }, required_aes = c('x0', 'y0', 'r', 'start', 'end') ) #' @rdname geom_arc #' @export stat_arc0 <- function(mapping = NULL, data = NULL, geom = 'arc0', position = 'identity', na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( stat = StatArc0, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, ...) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom grid curveGrob gList gpar #' @export GeomArc0 <- ggproto('GeomArc0', Geom, required_aes = c('x0', 'y0', 'r', 'start', 'end'), default_aes = aes(colour = 'black', linewidth = 0.5, linetype = 1, alpha = 1), draw_key = draw_key_path, draw_panel = function(self, data, panel_scales, coord, ncp = 5, arrow = NULL, lineend = 'butt', na.rm = FALSE) { if (!coord$is_linear()) { cli::cli_abort('{.fn {snake_class(self)}} is not implemented for non-linear coordinates') } trans <- coord$transform(data, panel_scales) grobs <- lapply(seq_len(nrow(trans)), function(i) { curveGrob(trans$x[i], trans$y[i], trans$xend[i], trans$yend[i], default.units = 'native', curvature = data$curvature[i], angle = 90, ncp = ncp, square = FALSE, squareShape = 1, inflect = FALSE, open = TRUE, gp = gpar( col = alpha( trans$colour[i], trans$alpha[i] ), lwd = (trans$linewidth[i] %||% trans$size[i]) * .pt, lty = trans$linetype[i], lineend = trans$lineend[i] ), arrow = arrow[i] ) }) inject(gList(!!!grobs)) }, rename_size = TRUE, non_missing_aes = "size" ) #' @rdname geom_arc #' @export geom_arc0 <- function(mapping = NULL, data = NULL, stat = 'arc0', position = 'identity', ncp = 5, arrow = NULL, lineend = 'butt', na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomArc0, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( arrow = arrow, ncp = ncp, lineend = lineend, na.rm = na.rm, ... ) ) } ggforce/R/position_floatstack.R0000644000176200001440000000210714672274110016275 0ustar liggesusers# Only for use with autohistogram and autodensity #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export PositionFloatstack <- ggproto('PositionFloatstack', PositionStack, setup_params = function(self, data) { flipped_aes <- has_flipped_aes(data) data <- flip_data(data, flipped_aes) list( var = self$var %||% if (flipped_aes) 'xmax' else 'ymax', fill = self$fill, vjust = self$vjust, reverse = self$reverse, flipped_aes = flipped_aes ) }, compute_panel = function(self, data, params, scales) { data <- flip_data(data, params$flipped_aes) panel_min <- data$ymin[1] data$y <- data$y - panel_min data$ymin <- data$ymin - panel_min data$ymax <- data$ymax - panel_min data <- flip_data(data, params$flipped_aes) data <- ggproto_parent(PositionStack, self)$compute_panel(data, params, scales) data <- flip_data(data, params$flipped_aes) data$y <- data$y + panel_min data$ymin <- data$ymin + panel_min data$ymax <- data$ymax + panel_min flip_data(data, params$flipped_aes) } ) ggforce/R/facet_wrap_paginate.R0000644000176200001440000001576214672274110016214 0ustar liggesusers#' Split facet_wrap over multiple plots #' #' This extension to [ggplot2::facet_wrap()] will allow you to split #' a facetted plot over multiple pages. You define a number of rows and columns #' per page as well as the page number to plot, and the function will #' automatically only plot the correct panels. Usually this will be put in a #' loop to render all pages one by one. #' #' @inheritParams ggplot2::facet_wrap #' @param nrow,ncol Number of rows and columns #' @param page The page to draw #' #' @note If either `ncol` or `nrow` is `NULL` this function will #' fall back to the standard `facet_wrap` functionality. #' #' @family ggforce facets #' @seealso [n_pages()] to compute the total number of pages in a paginated #' faceted plot #' #' @export #' @importFrom utils packageVersion #' #' @examples #' ggplot(diamonds) + #' geom_point(aes(carat, price), alpha = 0.1) + #' facet_wrap_paginate(~ cut:clarity, ncol = 3, nrow = 3, page = 4) #' facet_wrap_paginate <- function(facets, nrow = NULL, ncol = NULL, scales = 'fixed', shrink = TRUE, labeller = 'label_value', as.table = TRUE, switch = deprecated(), drop = TRUE, dir = 'h', strip.position = 'top', page = 1) { # Work around non-lifecycle deprecation if (!lifecycle::is_present(switch) && packageVersion('ggplot2') <= '3.3.6') { switch <- NULL } real_dir <- 'h' if (identical(dir, 'v')) { tmp <- ncol ncol <- nrow nrow <- tmp real_dir <- 'v' dir <- 'h' } facet <- facet_wrap(facets, nrow = nrow, ncol = ncol, scales = scales, shrink = shrink, labeller = labeller, as.table = as.table, switch = switch, drop = drop, dir = dir, strip.position = strip.position ) if (is.null(nrow) || is.null(ncol)) { facet } else { ggproto(NULL, FacetWrapPaginate, shrink = shrink, params = c(facet$params, list(page = page, real_dir = real_dir)) ) } } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom gtable gtable_add_rows gtable_add_cols #' @export FacetWrapPaginate <- ggproto('FacetWrapPaginate', FacetWrap, setup_params = function(data, params) { modify_list( params, list( max_rows = params$nrow, max_cols = params$ncol, nrow = NULL ) ) }, compute_layout = function(data, params) { layout <- FacetWrap$compute_layout(data, params) layout$page <- ceiling(layout$ROW / params$max_rows) layout }, draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { include <- which(layout$page == params$page) panels <- panels[include] ranges <- ranges[include] layout <- layout[include, , drop = FALSE] layout$ROW <- layout$ROW - min(layout$ROW) + 1 x_scale_ind <- unique0(layout$SCALE_X) x_scales <- x_scales[x_scale_ind] layout$SCALE_X <- match(layout$SCALE_X, x_scale_ind) y_scale_ind <- unique0(layout$SCALE_Y) y_scales <- y_scales[y_scale_ind] layout$SCALE_Y <- match(layout$SCALE_Y, y_scale_ind) if (identical(params$real_dir, "v")) { layout[c("ROW", "COL")] <- layout[c("COL", "ROW")] params[c('max_cols', 'max_rows')] <- params[c('max_rows', 'max_cols')] } table <- FacetWrap$draw_panels(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) if (max(layout$ROW) != params$max_rows) { spacing <- theme$panel.spacing.y %||% theme$panel.spacing missing_rows <- params$max_rows - max(layout$ROW) strip_rows <- unique0(table$layout$t[grepl('strip', table$layout$name) & table$layout$l %in% panel_cols(table)$l]) if (length(strip_rows) != 0) strip_rows <- strip_rows[as.numeric(table$heights[strip_rows]) != 0] axis_b_rows <- unique0(table$layout$t[grepl('axis-b', table$layout$name)]) axis_b_rows <- axis_b_rows[as.numeric(table$heights[axis_b_rows]) != 0] axis_t_rows <- unique0(table$layout$t[grepl('axis-t', table$layout$name)]) axis_t_rows <- axis_t_rows[as.numeric(table$heights[axis_t_rows]) != 0] table <- gtable_add_rows(table, unit(missing_rows, 'null')) table <- gtable_add_rows(table, spacing * missing_rows) if (length(strip_rows) != 0) { table <- gtable_add_rows(table, min(table$heights[strip_rows]) * missing_rows) } if (params$free$x) { if (length(axis_b_rows) != 0) { table <- gtable_add_rows(table, min(table$heights[axis_b_rows]) * missing_rows) } if (length(axis_t_rows) != 0) { table <- gtable_add_rows(table, min(table$heights[axis_t_rows]) * missing_rows) } } } if (max(layout$COL) != params$max_cols) { spacing <- theme$panel.spacing.x %||% theme$panel.spacing missing_cols <- params$max_cols - max(layout$COL) strip_cols <- unique0(table$layout$t[grepl('strip', table$layout$name) & table$layout$t %in% panel_rows(table)$t]) if (length(strip_cols) != 0) strip_cols <- strip_cols[as.numeric(table$widths[strip_cols]) != 0] axis_l_cols <- unique0(table$layout$l[grepl('axis-l', table$layout$name)]) axis_l_cols <- axis_l_cols[as.numeric(table$widths[axis_l_cols]) != 0] axis_r_cols <- unique0(table$layout$l[grepl('axis-r', table$layout$name)]) axis_r_cols <- axis_r_cols[as.numeric(table$widths[axis_r_cols]) != 0] table <- gtable_add_cols(table, unit(missing_cols, 'null')) table <- gtable_add_cols(table, spacing * missing_cols) if (length(strip_cols) != 0) { table <- gtable_add_cols(table, min(table$widths[strip_cols]) * missing_cols) } if (params$free$y) { if (length(axis_l_cols) != 0) { table <- gtable_add_cols(table, min(table$widths[axis_l_cols]) * missing_cols) } if (length(axis_r_cols) != 0) { table <- gtable_add_cols(table, min(table$widths[axis_r_cols]) * missing_cols) } } } table } ) #' Determine the number of pages in a paginated facet plot #' #' This is a simple helper that returns the number of pages it takes to plot all #' panels when using [facet_wrap_paginate()] and #' [facet_grid_paginate()]. It partially builds the plot so depending #' on the complexity of your plot it might take some time to calculate... #' #' @param plot A ggplot object using either facet_wrap_paginate or #' facet_grid_paginate #' #' @return If the plot uses using either facet_wrap_paginate or #' facet_grid_paginate it returns the total number of pages. Otherwise it #' returns NULL #' #' @export #' #' @examples #' p <- ggplot(diamonds) + #' geom_point(aes(carat, price), alpha = 0.1) + #' facet_wrap_paginate(~ cut:clarity, ncol = 3, nrow = 3, page = 1) #' n_pages(p) n_pages <- function(plot) { if (utils::packageVersion('ggplot2') <= '2.2.1') { page <- ggplot_build(plot)$layout$panel_layout$page } else { page <- ggplot_build(plot)$layout$layout$page } if (!is.null(page)) { max(page) } else { NULL } } ggforce/R/ellipse.R0000644000176200001440000000666514672274110013670 0ustar liggesusers#' Draw (super)ellipses based on the coordinate system scale #' #' This is a generalisation of [geom_circle()] that allows you to draw #' ellipses at a specified angle and center relative to the coordinate system. #' Apart from letting you draw regular ellipsis, the stat is using the #' generalised formula for superellipses which can be utilised by setting the #' `m1` and `m2` aesthetics. If you only set the m1 the m2 value will follow #' that to ensure a symmetric appearance. #' #' @section Aesthetics: #' geom_arc understand the following aesthetics (required aesthetics are in #' bold): #' #' - **x0** #' - **y0** #' - **a** #' - **b** #' - **angle** #' - m1 #' - m2 #' - color #' - fill #' - linewidth #' - linetype #' - alpha #' - lineend #' #' @section Computed variables: #' #' \describe{ #' \item{x, y}{The coordinates for the points along the ellipse} #' } #' #' @inheritParams ggplot2::geom_path #' @inheritParams ggplot2::stat_identity #' #' @param n The number of points to sample along the ellipse. #' #' @name geom_ellipse #' @rdname geom_ellipse #' #' @examples #' # Basic usage #' ggplot() + #' geom_ellipse(aes(x0 = 0, y0 = 0, a = 10, b = 3, angle = 0)) + #' coord_fixed() #' #' # Rotation #' # Note that it expects radians and rotates the ellipse counter-clockwise #' ggplot() + #' geom_ellipse(aes(x0 = 0, y0 = 0, a = 10, b = 3, angle = pi / 4)) + #' coord_fixed() #' #' # Draw a super ellipse #' ggplot() + #' geom_ellipse(aes(x0 = 0, y0 = 0, a = 6, b = 3, angle = -pi / 3, m1 = 3)) + #' coord_fixed() NULL #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatEllip <- ggproto('StatEllip', Stat, setup_data = function(data, params) { data$m1 <- if (is.null(data$m1)) 2 else data$m1 data$m2 <- if (is.null(data$m2)) data$m1 else data$m2 data }, compute_panel = function(self, data, scales, n = 360) { if (empty_data(data)) return(data) data$group <- make_unique(data$group) n_ellipses <- nrow(data) data <- data[rep(seq_len(n_ellipses), each = n), ] points <- rep(seq(0, 2 * pi, length.out = n + 1)[seq_len(n)], n_ellipses) cos_p <- cos(points) sin_p <- sin(points) x_tmp <- abs(cos_p)^(2 / data$m1) * data$a * sign(cos_p) y_tmp <- abs(sin_p)^(2 / data$m2) * data$b * sign(sin_p) data$x <- data$x0 + x_tmp * cos(data$angle) - y_tmp * sin(data$angle) data$y <- data$y0 + x_tmp * sin(data$angle) + y_tmp * cos(data$angle) data }, required_aes = c('x0', 'y0', 'a', 'b', 'angle'), default_aes = aes(m1 = NA, m2 = NA), extra_params = c('n', 'na.rm') ) #' @rdname geom_ellipse #' @export stat_ellip <- function(mapping = NULL, data = NULL, geom = 'circle', position = 'identity', n = 360, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( stat = StatEllip, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, n = n, ...) ) } #' @rdname geom_ellipse #' @export geom_ellipse <- function(mapping = NULL, data = NULL, stat = 'ellip', position = 'identity', n = 360, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomCircle, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(n = n, na.rm = na.rm, ...) ) } ggforce/R/aaa.R0000644000176200001440000000200314672274110012733 0ustar liggesusersutils::globalVariables(c( 'x', 'y' )) `%||%` <- function(x, y) { if (is.null(x)) y else x } is.waive <- function(x) inherits(x, 'waiver') `%|W|%` <- function(x, y) { if (is.waive(x)) y else x } expand_default <- function(scale, discrete = c(0, 0.6), continuous = c(0.05, 0)) { scale$expand %|W|% if (scale$is_discrete()) discrete else continuous } combine_aes <- function(aes1, aes2) { aes_all <- c(aes1[setdiff(names(aes1), names(aes2))], aes2) class(aes_all) <- class(aes1) aes_all } empty_data <- function(x) { length(x) == 0 || nrow(x) == 0 } # This function is like base::make.unique, but it # maintains the ordering of the original names if the values # are sorted. make_unique <- function(x, sep = '.') { if (!anyDuplicated(x)) return(x) groups <- match(x, unique(x)) suffix <- unsplit(lapply(split(x, groups), seq_along), groups) max_chars <- nchar(max(suffix)) suffix_format <- paste0('%0', max_chars, 'd') paste0(x, sep, sprintf(suffix_format, suffix)) } ggforce/R/mark_label.R0000644000176200001440000003065314672274110014316 0ustar liggesusers#' @importFrom grid gpar inherit_gp <- function(..., gp, call = caller_env()) { new_gp <- list2(...) for (par in names(new_gp)) { old_par <- par inherited_par <- new_gp[[par]] if (isTRUE(new_gp[[par]] == 'inherit')) { inherited_par <- gp[[old_par]] } else if (isTRUE(new_gp[[par]] == 'inherit_fill')) { old_par <- 'fill' inherited_par <- gp[[old_par]] } else if (isTRUE(grepl('inherit_col', new_gp[[par]]))) { old_par <- 'col' inherited_par <- gp[[old_par]] } if (is.null(inherited_par)) { cli::cli_abort("Can't inherit {.field {old_par}} as it is not given in the root {.cls gpar}") } new_gp[[par]] <- inherited_par } inject(gpar(!!!new_gp)) } subset_gp <- function(gp, index, ignore = c('font')) { gp_names <- names(gp) gp_names <- gp_names[-unique0(unlist(lapply(ignore, grep, gp_names)))] for (par in gp_names) { gp[[par]] <- rep_len(gp[[par]], index)[index] } gp } #' @importFrom polyclip polyoffset polyminkowski polyclip #' @importFrom grid convertX convertY place_labels <- function(rects, polygons, bounds, anchors, ghosts) { res <- vector('list', length(rects)) bbox <- list( x = c(0, bounds[1], bounds[1], 0), y = c(0, 0, bounds[2], bounds[2]) ) if (!is.null(ghosts) && length(ghosts$x) > 0) { ghosts$x <- convertX(ghosts$x, 'mm', TRUE) ghosts$y <- convertY(ghosts$y, 'mm', TRUE) ghosts <- Map( function(xmin, xmax, ymin, ymax) { list(x = c(xmin, xmax, xmax, xmin), y = c(ymin, ymin, ymax, ymax)) }, xmin = ghosts$x - 2, xmax = ghosts$x + 2, ymin = ghosts$y - 2, ymax = ghosts$y + 2 ) ghosts <- polyoffset(ghosts, 0) polygons <- c(polygons, ghosts) } for (i in seq_along(rects)) { if (all(rects[[i]] == 0)) next() r <- rects[[i]] / 2 + 2 rect <- list(x = c(-r[1], r[1], r[1], -r[1]), y = c(-r[2], -r[2], r[2], r[2])) b <- polyminkowski(bbox, rect) for (p in polygons) { b <- polyclip(b, polyminkowski(p, rect)[1], 'union') } if (length(b) == 1) next() b <- lapply(b[-1], function(p) cbind(p$x, p$y)) closest <- points_to_path(matrix(anchors[[i]], ncol = 2), b, TRUE) res[[i]] <- closest$proj rect$x <- rect$x + closest$proj[1] rect$y <- rect$y + closest$proj[2] polygons[[length(polygons) + 1]] <- polyoffset(rect, 10) } res } #' @importFrom polyclip polyoffset #' @importFrom grid convertWidth convertHeight nullGrob polylineGrob #' @importFrom stats runif make_label <- function(labels, dims, polygons, ghosts, buffer, con_type, con_border, con_cap, con_gp, anchor_mod, anchor_x, anchor_y, arrow) { polygons <- lapply(polygons, function(p) { if (length(p$x) == 1 & length(p$y) == 1) { list( x = runif(200, p$x-0.00005, p$x+0.00005), y = runif(200, p$y-0.00005, p$y+0.00005) ) } else { list( x = p$x, y = p$y ) } }) anchors <- lapply(seq_along(polygons), function(i) { x <- mean(range(polygons[[i]]$x)) if (length(anchor_x) == length(polygons) && !is.na(anchor_x[i])) x <- anchor_x[i] y <- mean(range(polygons[[i]]$y)) if (length(anchor_y) == length(polygons) && !is.na(anchor_y[i])) y <- anchor_y[i] c(x, y) }) p_big <- polyoffset(polygons, convertWidth(buffer, 'mm', TRUE)) area <- c( convertWidth(unit(1, 'npc'), 'mm', TRUE), convertHeight(unit(1, 'npc'), 'mm', TRUE) ) labelpos <- place_labels(dims, p_big, area, anchors, ghosts) if (all(lengths(labelpos) == 0)) { return(list(nullGrob())) } labels_drawn <- which(!vapply(labelpos, is.null, logical(1))) labels <- Map(function(lab, pos) { if (is.null(pos) || inherits(lab, 'null')) return(nullGrob()) lab$vp$x <- unit(pos[1], 'mm') lab$vp$y <- unit(pos[2], 'mm') lab }, lab = labels, pos = labelpos) connect <- inject(rbind(!!!Map(function(pol, pos, dim) { if (is.null(pos)) return(NULL) dim <- dim / anchor_mod pos <- cbind( c(pos[1] - dim[1], pos[1] + dim[1], pos[1] + dim[1], pos[1] - dim[1]), c(pos[2] - dim[2], pos[2] - dim[2], pos[2] + dim[2], pos[2] + dim[2]) ) pos <- points_to_path(pos, list(cbind(pol$x, pol$y)), TRUE) pos$projection[which.min(pos$distance), ] }, pol = polygons, pos = labelpos, dim = dims))) labeldims <- inject(rbind(!!!dims[lengths(labelpos) != 0])) / 2 labelpos <- inject(rbind(!!!labelpos)) if (con_type == 'none' || !con_type %in% c('elbow', 'straight')) { connect <- nullGrob() } else { con_fun <- switch(con_type, elbow = elbow, straight = straight) connect <- con_fun( labelpos[, 1] - labeldims[, 1], labelpos[, 1] + labeldims[, 1], labelpos[, 2] - labeldims[, 2], labelpos[, 2] + labeldims[, 2], connect[, 1], connect[, 2] ) if (con_border == 'one') { connect <- with_borderline( labelpos[, 1] - labeldims[, 1], labelpos[, 1] + labeldims[, 1], connect ) } connect <- end_cap(connect, con_cap) connect <- zip_points(connect) if (!is.null(arrow)) arrow$ends <- 2L con_gp <- subset_gp(con_gp, labels_drawn) connect <- polylineGrob(connect$x, connect$y, id = connect$id, default.units = 'mm', gp = con_gp, arrow = arrow ) } c(labels, list(connect)) } #' @importFrom grid valid.just textGrob nullGrob viewport grobWidth grobHeight #' rectGrob gpar grid.layout unit gTree gList grobDescent labelboxGrob <- function(label, x = unit(0.5, 'npc'), y = unit(0.5, 'npc'), description = NULL, width = NULL, min.width = 50, default.units = 'mm', hjust = 0, pad = margin(2, 2, 2, 2, 'mm'), gp = gpar(), desc.gp = gpar(), vp = NULL) { width <- as_mm(width, default.units) min.width <- as_mm(min.width, default.units) pad <- as_mm(pad, default.units) pad[c(1, 3)] <- as_mm(pad[c(1, 3)], default.units, FALSE) if (!is.null(label) && !is.na(label)) { if (!is.null(width)) { label <- wrap_text(label, gp, width - pad[2] - pad[4]) } just <- c(hjust[1], 0.5) lab_grob <- textGrob(label, x = just[1], y = just[2], just = just, gp = gp) } else { lab_grob <- nullGrob() } if (!is.null(width)) { final_width <- max(width, min.width) - pad[2] - pad[4] } else { if (as_mm(grobWidth(lab_grob)) > (min.width - pad[2] - pad[4])) { final_width <- as_mm(grobWidth(lab_grob)) + pad[2] + pad[4] } else { final_width <- max(as_mm(grobWidth(lab_grob)), min.width) - pad[2] - pad[4] } } if (!is.null(description) && !is.na(description)) { description <- wrap_text(description, desc.gp, final_width) just <- c(rep_len(hjust, 2)[2], 0.5) desc_grob <- textGrob(description, x = just[1], y = just[2], just = just, gp = desc.gp) if (is.null(width)) { final_width_desc <- min(final_width, as_mm(grobWidth(desc_grob))) final_width <- as_mm(grobWidth(lab_grob)) if (final_width < final_width_desc) { final_width <- final_width_desc } } } else { desc_grob <- nullGrob() if (is.null(width)) final_width <- as_mm(grobWidth(lab_grob)) } bg_grob <- rectGrob(gp = gpar(col = NA, fill = gp$fill)) lab_height <- as_mm(grobHeight(lab_grob), width = FALSE) desc_height <- as_mm(grobHeight(desc_grob), width = FALSE) sep_height <- if (lab_height > 0 && desc_height > 0) { pad[1] } else if (lab_height > 0) { font_descent(gp$fontfamily, gp$fontface, gp$fontsize, gp$cex) } else { 0 } vp <- viewport( x = x, y = y, width = unit(final_width + pad[2] + pad[4], 'mm'), height = unit(pad[1] + pad[3] + lab_height + desc_height + sep_height, 'mm'), layout = grid.layout( 5, 3, widths = unit(c(pad[2], final_width, pad[4]), 'mm'), heights = unit(c(pad[1], lab_height, sep_height, desc_height, pad[3]), 'mm') ) ) lab_grob$vp <- viewport(layout.pos.col = 2, layout.pos.row = 2) desc_grob$vp <- viewport(layout.pos.col = 2, layout.pos.row = 4) gTree(children = gList(bg_grob, lab_grob, desc_grob), vp = vp, cl = 'mark_label') } #' @export #' @importFrom grid widthDetails widthDetails.mark_label <- function(x) { x$vp$width } #' @export #' @importFrom grid heightDetails heightDetails.mark_label <- function(x) { x$vp$height } #' @importFrom grid textGrob grobWidth wrap_text <- function(text, gp, width) { text <- gsub('-', '- ', text) text <- strsplit(text, split = ' ', fixed = TRUE)[[1]] text <- paste0(text, ' ') text <- sub('- ', '-', text) txt <- '' for (i in text) { oldlab <- txt txt <- paste0(txt, i) tmpGrob <- textGrob(txt, gp = gp) if (as_mm(grobWidth(tmpGrob)) > width) { txt <- paste(trimws(oldlab), i, sep = '\n') } } trimws(txt) } #' @importFrom grid unit is.unit convertWidth convertHeight as_mm <- function(x, def, width = TRUE) { if (is.null(x)) return(x) if (!is.unit(x)) x <- unit(x, def) if (width) { convertWidth(x, 'mm', TRUE) } else { convertHeight(x, 'mm', TRUE) } } straight <- function(xmin, xmax, ymin, ymax, x, y) { conn_point <- get_end_points(xmin, xmax, ymin, ymax, x, y) list( as.matrix(conn_point), cbind(x = x, y = y) ) } elbow <- function(xmin, xmax, ymin, ymax, x, y) { lines <- straight(xmin, xmax, ymin, ymax, x, y) end_pos <- lines[[1]] - lines[[2]] end_angle <- atan2(end_pos[, 2], end_pos[, 1]) %% (2 * pi) angle_bin <- end_angle %/% (pi / 4) angle_lower <- end_angle %% (pi / 4) < 0.5 elbow <- lapply(seq_along(angle_bin), function(i) { a_bin <- angle_bin[i] a_lower <- angle_lower[i] if (a_bin == 0 || a_bin == 4) { if (a_lower) { c(end_pos[i, 1] - end_pos[i, 2], 0) } else { c(end_pos[i, 2], end_pos[i, 2]) } } else if (a_bin == 1 || a_bin == 5) { if (a_lower) { c(end_pos[i, 1], end_pos[i, 1]) } else { c(0, end_pos[i, 2] - end_pos[i, 1]) } } else if (a_bin == 2 || a_bin == 6) { if (a_lower) { c(0, end_pos[i, 2] + end_pos[i, 1]) } else { c(end_pos[i, 1], -end_pos[i, 1]) } } else if (a_bin == 3 || a_bin == 7) { if (a_lower) { c(-end_pos[i, 2], end_pos[i, 2]) } else { c(end_pos[i, 1] + end_pos[i, 2], 0) } } }) elbow <- inject(rbind(!!!elbow)) elbow <- elbow + lines[[2]] colnames(elbow) <- c('x', 'y') list(lines[[1]], elbow, lines[[2]]) } with_borderline <- function(xmin, xmax, lines) { new_start <- lines[[1]] new_start[, 1] <- ifelse(new_start[, 1] == xmin, xmax, xmin) c(list(new_start), lines) } end_cap <- function(lines, cap) { from <- lines[[length(lines) - 1]] to <- lines[[length(lines)]] d <- to - from l <- sqrt(rowSums((d)^2)) to <- from + d * (l - cap) / l lines[[length(lines)]] <- to lines } zip_points <- function(points) { n_lines <- nrow(points[[1]]) n_joints <- length(points) points <- as.data.frame(inject(rbind(!!!points))) points$id <- rep(seq_len(n_lines), n_joints) points[order(points$id), ] } get_end_points <- function(xmin, xmax, ymin, ymax, x, y) { xmin_tmp <- xmin - x xmax_tmp <- xmax - x ymin_tmp <- ymin - y ymax_tmp <- ymax - y pos <- ifelse( xmin_tmp < 0, ifelse(ymin_tmp < 0, 'bottomleft', 'topleft'), ifelse(ymin_tmp < 0, 'bottomright', 'topright') ) pos <- ifelse( ymin_tmp < 0 & ymax_tmp > 0, ifelse(xmin_tmp < 0, 'left', 'right'), ifelse( xmin_tmp < 0 & xmax_tmp > 0, ifelse(ymin_tmp < 0, 'bottom', 'top'), pos ) ) x_new <- vswitch( pos, left = xmax, bottomleft = xmax, topleft = xmax, right = xmin, bottomright = xmin, topright = xmin, top = ifelse(abs(xmin_tmp) < abs(xmax_tmp), xmin, xmax), bottom = ifelse(abs(xmin_tmp) < abs(xmax_tmp), xmin, xmax) ) y_new <- vswitch( pos, bottom = ymax, bottomleft = ymax, bottomright = ymax, top = ymin, topleft = ymin, topright = ymin, left = ifelse(abs(ymin_tmp) < abs(ymax_tmp), ymin, ymax), right = ifelse(abs(ymin_tmp) < abs(ymax_tmp), ymin, ymax) ) data_frame0(x = x_new, y = y_new) } vswitch <- function(x, ...) { cases <- cbind(...) cases[cbind(seq_along(x), match(x, colnames(cases)))] } font_descent <- function(fontfamily, fontface, fontsize, cex) { italic <- fontface >= 3 bold <- fontface == 2 | fontface == 4 info <- systemfonts::font_info(fontfamily, italic, bold, fontsize * (cex %||% 1), res = 300) as_mm(abs(info$max_descend)*72/300, 'pt', FALSE) } ggforce/R/facet_zoom.R0000644000176200001440000004406015024471216014346 0ustar liggesusers#' Facet data for zoom with context #' #' This facetting provides the means to zoom in on a subset of the data, while #' keeping the view of the full dataset as a separate panel. The zoomed-in area #' will be indicated on the full dataset panel for reference. It is possible to #' zoom in on both the x and y axis at the same time. If this is done it is #' possible to both get each zoom separately and combined or just combined. #' #' @param x,y,xy An expression evaluating to a logical vector that determines #' the subset of data to zoom in on #' #' @param zoom.data An expression evaluating to a logical vector. If `TRUE` #' the data only shows in the zoom panels. If `FALSE` the data only show in #' the context panel. If `NA` the data will show in all panels. #' #' @param xlim,ylim Specific zoom ranges for each axis. If present they will #' override `x`, `y`, and/or `xy`. #' #' @param split If both `x` and `y` is given, should each axis zoom #' be shown separately as well? Defaults to `FALSE` #' #' @param horizontal If both `x` and `y` is given and #' `split = FALSE` How should the zoom panel be positioned relative to the #' full data panel? Defaults to `TRUE` #' #' @param zoom.size Sets the relative size of the zoom panel to the full data #' panel. The default (`2`) makes the zoom panel twice the size of the full #' data panel. #' #' @param show.area Should the zoom area be drawn below the data points on the #' full data panel? Defaults to `TRUE`. #' #' @inheritParams ggplot2::facet_wrap #' #' @family ggforce facets #' #' @export #' #' @examples #' # Zoom in on the versicolor species on the x-axis #' ggplot(iris, aes(Petal.Length, Petal.Width, colour = Species)) + #' geom_point() + #' facet_zoom(x = Species == 'versicolor') #' #' # Zoom in on versicolor on both axes #' ggplot(iris, aes(Petal.Length, Petal.Width, colour = Species)) + #' geom_point() + #' facet_zoom(xy = Species == 'versicolor') #' #' # Use different zoom criteria on each axis #' ggplot(iris, aes(Petal.Length, Petal.Width, colour = Species)) + #' geom_point() + #' facet_zoom(x = Species != 'setosa', y = Species == 'versicolor') #' #' # Get each axis zoom separately as well #' ggplot(iris, aes(Petal.Length, Petal.Width, colour = Species)) + #' geom_point() + #' facet_zoom(xy = Species == 'versicolor', split = TRUE) #' #' # Define the zoom area directly #' ggplot(iris, aes(Petal.Length, Petal.Width, colour = Species)) + #' geom_point() + #' facet_zoom(xlim = c(2, 4)) #' #' # Selectively show data in the zoom panel #' ggplot(iris, aes(Petal.Length, Petal.Width, colour = Species)) + #' geom_point() + #' facet_zoom(x = Species == 'versicolor', zoom.data = Species == 'versicolor') facet_zoom <- function(x, y, xy, zoom.data, xlim = NULL, ylim = NULL, split = FALSE, horizontal = TRUE, zoom.size = 2, show.area = TRUE, shrink = TRUE) { x <- if (missing(x)) if (missing(xy)) NULL else enquo(xy) else enquo(x) y <- if (missing(y)) if (missing(xy)) NULL else enquo(xy) else enquo(y) zoom.data <- if (missing(zoom.data)) NULL else enquo(zoom.data) if (is.null(x) && is.null(y) && is.null(xlim) && is.null(ylim)) { cli::cli_abort('Either x- or y-zoom must be given') } if (!is.null(xlim)) x <- NULL if (!is.null(ylim)) y <- NULL ggproto(NULL, FacetZoom, shrink = shrink, params = list( x = x, y = y, xlim = xlim, ylim = ylim, split = split, zoom.data = zoom.data, zoom.size = zoom.size, show.area = show.area, horizontal = horizontal ) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom grid convertUnit unit unit.c polygonGrob segmentsGrob gpar #' grobTree rectGrob #' @importFrom gtable gtable_add_cols gtable_add_rows gtable_add_grob #' @importFrom scales rescale #' @export FacetZoom <- ggproto('FacetZoom', Facet, compute_layout = function(data, params) { layout <- data_frame0( name = c('orig', 'x', 'y', 'full', 'orig_true', 'zoom_true'), SCALE_X = c(1L, 2L, 1L, 2L, 1L, 1L), SCALE_Y = c(1L, 1L, 2L, 2L, 1L, 1L) ) if (is.null(params$y) && is.null(params$ylim)) { layout <- layout[c(1, 2, 5:6), ] } else if (is.null(params$x) && is.null(params$xlim)) { layout <- layout[c(1, 3, 5:6), ] } layout$PANEL <- seq_len(nrow(layout)) layout }, map_data = function(data, layout, params) { if (empty(data)) { return(cbind(data, PANEL = integer(0))) } vec_rbind( cbind(data, PANEL = 1L), if (!is.null(params$x)) { index_x <- try_fetch(eval_tidy(params$x, data), error = function(e) FALSE) if (sum(index_x, na.rm = TRUE) != 0) { cbind(data[index_x, ], PANEL = layout$PANEL[layout$name == 'x']) } }, if (!is.null(params$y)) { index_y <- try_fetch(eval_tidy(params$y, data), error = function(e) FALSE) if (sum(index_y, na.rm = TRUE) != 0) { cbind(data[index_y, ], PANEL = layout$PANEL[layout$name == 'y']) } }, if (!is.null(params$zoom.data)) { zoom_data <- try_fetch(eval_tidy(params$zoom.data, data), error = function(e) NA) zoom_data <- rep(zoom_data, length.out = nrow(data)) zoom_ind <- zoom_data | is.na(zoom_data) orig_ind <- !zoom_data | is.na(zoom_data) vec_rbind( cbind(data[zoom_ind, ], PANEL = if (any(zoom_ind)) layout$PANEL[layout$name == 'zoom_true'] else integer(0)), cbind(data[orig_ind, ], PANEL = if (any(orig_ind)) layout$PANEL[layout$name == 'orig_true'] else integer(0)) ) } ) }, train_scales = function(self, x_scales, y_scales, layout, data, params) { # Remove any limits settings on the zoom panels if (length(x_scales) > 1) x_scales[[2]]$limits <- NULL if (length(y_scales) > 1) y_scales[[2]]$limits <- NULL # loop over each layer, training x and y scales in turn for (layer_data in data) { match_id <- match(layer_data$PANEL, layout$PANEL) if (!is.null(x_scales)) { if ('x' %in% layout$name && x_scales[[1]]$is_discrete()) { cli::cli_abort('facet_zoom doesn\'t support zooming in discrete scales') } x_vars <- intersect(x_scales[[1]]$aesthetics, names(layer_data)) SCALE_X <- layout$SCALE_X[match_id] if (!is.null(params$xlim) && length(x_scales) > 1) { x_scales[[2]]$train(x_scales[[2]]$transform(params$xlim)) scale_apply(layer_data, x_vars, 'train', SCALE_X, x_scales[-2]) } else { scale_apply(layer_data, x_vars, 'train', SCALE_X, x_scales) } } if (!is.null(y_scales)) { if ('y' %in% layout$name && y_scales[[1]]$is_discrete()) { cli::cli_abort('facet_zoom doesn\'t support zooming in discrete scales') } y_vars <- intersect(y_scales[[1]]$aesthetics, names(layer_data)) SCALE_Y <- layout$SCALE_Y[match_id] if (!is.null(params$ylim) && length(y_scales) > 1) { y_scales[[2]]$train(y_scales[[2]]$transform(params$ylim)) scale_apply(layer_data, y_vars, 'train', SCALE_Y, y_scales[-2]) } else { scale_apply(layer_data, y_vars, 'train', SCALE_Y, y_scales) } } } }, finish_data = function(data, layout, x_scales, y_scales, params) { plot_panels <- which(!grepl('_true', layout$name)) data <- if (is.null(params$zoom.data)) { vec_rbind(!!!lapply(layout$PANEL[plot_panels], function(panel) { d <- data[data$PANEL == 1, ] d$PANEL <- panel d })) } else { orig_pan <- layout$PANEL[layout$name == 'orig_true'] zoom_pan <- layout$PANEL[layout$name == 'zoom_true'] orig_data <- data[data$PANEL == orig_pan, ] orig_data$PANEL <- if (nrow(orig_data) != 0) 1L else integer(0) zoom_data <- data[data$PANEL == zoom_pan, ] vec_rbind(orig_data, vec_rbind(!!!lapply(plot_panels[-1], function(panel) { zoom_data$PANEL <- if (nrow(zoom_data) != 0) panel else integer(0) zoom_data }))) } data$PANEL <- factor(data$PANEL, layout$PANEL) data }, draw_panels = function(self, panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { if (inherits(coord, 'CoordFlip')) { cli::cli_abort('facet_zoom doesn\'t work with flipped scales') } if (is.null(params$x) && is.null(params$xlim)) { params$horizontal <- TRUE } else if (is.null(params$y) && is.null(params$ylim)) { params$horizontal <- FALSE } zoom_x <- calc_element('zoom.x', theme) zoom_y <- calc_element('zoom.y', theme) # Construct the panels axes <- render_axes(ranges, ranges, coord, theme, FALSE) panelGrobs <- create_panels(panels, axes$x, axes$y) panelGrobs <- panelGrobs[seq_len(length(panelGrobs) - 2)] if ('full' %in% layout$name && !params$split) { panelGrobs <- panelGrobs[c(1, 4)] } if ('y' %in% layout$name) { if (!inherits(zoom_y, 'element_blank')) { zoom_prop <- rescale(y_scales[[2]]$dimension(expansion(y_scales[[2]])), from = y_scales[[1]]$dimension(expansion(y_scales[[1]])) ) indicator <- polygonGrob( c(1, 1, 0, 0), c(zoom_prop, 1, 0), gp = gpar(col = NA, fill = ggplot2::fill_alpha(zoom_y$fill, 0.5)) ) lines <- segmentsGrob( y0 = c(0, 1), x0 = c(0, 0), y1 = zoom_prop, x1 = c(1, 1), gp = gpar( col = zoom_y$colour, lty = zoom_y$linetype, lwd = (zoom_y$linewidth %||% zoom_y$size) * .pt, lineend = 'round' ) ) indicator_h <- grobTree(indicator, lines) } else { indicator_h <- zeroGrob() } } if ('x' %in% layout$name) { if (!inherits(zoom_x, 'element_blank')) { zoom_prop <- rescale(x_scales[[2]]$dimension(expansion(x_scales[[2]])), from = x_scales[[1]]$dimension(expansion(x_scales[[1]])) ) indicator <- polygonGrob( c(zoom_prop, 1, 0), c(1, 1, 0, 0), gp = gpar(col = NA, fill = ggplot2::fill_alpha(zoom_x$fill, 0.5)) ) lines <- segmentsGrob( x0 = c(0, 1), y0 = c(0, 0), x1 = zoom_prop, y1 = c(1, 1), gp = gpar( col = zoom_x$colour, lty = zoom_x$linetype, lwd = (zoom_x$linewidth %||% zoom_x$size) * .pt, lineend = 'round' ) ) indicator_v <- grobTree(indicator, lines) } else { indicator_v <- zeroGrob() } } if ('full' %in% layout$name && params$split) { space.x <- calc_element("panel.spacing.x", theme) space.x <- unit(5 * as.numeric(convertUnit(space.x, 'cm')), 'cm') space.y <- calc_element("panel.spacing.y", theme) space.y <- unit(5 * as.numeric(convertUnit(space.y, 'cm')), 'cm') final <- gtable_add_cols(panelGrobs[[3]], space.x) final <- cbind(final, panelGrobs[[1]], size = 'first') final_tmp <- gtable_add_cols(panelGrobs[[4]], space.x) final_tmp <- cbind(final_tmp, panelGrobs[[2]], size = 'first') final <- gtable_add_rows(final, space.y) final <- rbind(final, final_tmp, size = 'first') final <- gtable_add_grob(final, list(indicator_h, indicator_h), c(2, 6), 3, c(2, 6), 5, z = -Inf, name = 'zoom-indicator') final <- gtable_add_grob(final, list(indicator_v, indicator_v), 3, c(2, 6), 5, z = -Inf, name = 'zoom-indicator') heights <- unit.c( unit(max_height(list(axes$x[[1]]$top, axes$x[[3]]$top)), 'cm'), unit(1, 'null'), unit(max_height(list(axes$x[[1]]$bottom, axes$x[[3]]$bottom)), 'cm'), space.y, unit(max_height(list(axes$x[[2]]$top, axes$x[[4]]$top)), 'cm'), unit(params$zoom.size, 'null'), unit(max_height(list(axes$x[[2]]$bottom, axes$x[[4]]$bottom)), 'cm') ) widths <- unit.c( unit(max_width(list(axes$y[[3]]$left, axes$y[[4]]$left)), 'cm'), unit(params$zoom.size, 'null'), unit(max_width(list(axes$y[[3]]$right, axes$y[[4]]$right)), 'cm'), space.x, unit(max_width(list(axes$y[[1]]$left, axes$y[[2]]$left)), 'cm'), unit(1, 'null'), unit(max_width(list(axes$y[[1]]$right, axes$y[[2]]$right)), 'cm') ) final$heights <- heights final$widths <- widths } else { if (params$horizontal) { space <- calc_element("panel.spacing.x", theme) space <- unit(5 * as.numeric(convertUnit(space, 'cm')), 'cm') heights <- unit.c( unit(max_height(list(axes$x[[1]]$top, axes$x[[2]]$top)), 'cm'), unit(1, 'null'), unit(max_height(list(axes$x[[1]]$bottom, axes$x[[2]]$bottom)), 'cm') ) final <- gtable_add_cols(panelGrobs[[2]], space) final <- cbind(final, panelGrobs[[1]], size = 'first') final$heights <- heights final$widths[panel_cols(final)$l] <- unit(c(params$zoom.size, 1), 'null') final <- gtable_add_grob(final, indicator_h, 2, 3, 2, 5, z = -Inf, name = 'zoom-indicator') } else { space <- calc_element("panel.spacing.y", theme) space <- unit(5 * as.numeric(convertUnit(space, 'cm')), 'cm') widths <- unit.c( unit(max_width(list(axes$y[[1]]$left, axes$y[[2]]$left)), 'cm'), unit(1, 'null'), unit(max_width(list(axes$y[[1]]$right, axes$y[[2]]$right)), 'cm') ) final <- gtable_add_rows(panelGrobs[[1]], space) final <- rbind(final, panelGrobs[[2]], size = 'first') final$widths <- widths final$heights[panel_rows(final)$t] <- unit(c(1, params$zoom.size), 'null') final <- gtable_add_grob(final, indicator_v, 3, 2, 5, z = -Inf, name = 'zoom-indicator') } } final }, draw_back = function(data, layout, x_scales, y_scales, theme, params) { zoom_x <- calc_element('zoom.x', theme) zoom_y <- calc_element('zoom.y', theme) if (!(is.null(params$x) && is.null(params$xlim)) && params$show.area && !inherits(zoom_x, 'element_blank') && length(x_scales) > 1) { zoom_prop <- rescale(x_scales[[2]]$dimension(expansion(x_scales[[2]])), from = x_scales[[1]]$dimension(expansion(x_scales[[1]])) ) x_back <- grobTree( rectGrob(x = mean(zoom_prop), y = 0.5, width = diff(zoom_prop), height = 1, gp = gpar(col = NA, fill = ggplot2::fill_alpha(zoom_x$fill, 0.5))), segmentsGrob(zoom_prop, c(0, 0), zoom_prop, c(1, 1), gp = gpar( col = zoom_x$colour, lty = zoom_x$linetype, lwd = (zoom_x$linewidth %||% zoom_x$size) * .pt, lineend = 'round' )) ) } else { x_back <- zeroGrob() } if (!(is.null(params$y) && is.null(params$ylim)) && params$show.area && !inherits(zoom_y, 'element_blank') && length(y_scales) > 1) { zoom_prop <- rescale(y_scales[[2]]$dimension(expansion(y_scales[[2]])), from = y_scales[[1]]$dimension(expansion(y_scales[[1]])) ) y_back <- grobTree( rectGrob(y = mean(zoom_prop), x = 0.5, height = diff(zoom_prop), width = 1, gp = gpar(col = NA, fill = ggplot2::fill_alpha(zoom_y$fill, 0.5))), segmentsGrob(y0 = zoom_prop, x0 = c(0, 0), y1 = zoom_prop, x1 = c(1, 1), gp = gpar(col = zoom_y$colour, lty = zoom_y$linetype, lwd = (zoom_y$linewidth %||% zoom_y$size) * .pt, lineend = 'round' ) ) ) } else { y_back <- zeroGrob() } if ('full' %in% layout$name && params$split) { list(grobTree(x_back, y_back), y_back, x_back, zeroGrob(), zeroGrob(), zeroGrob()) } else { list(grobTree(x_back, y_back), zeroGrob(), zeroGrob(), zeroGrob()) } } ) #' @importFrom grid grobHeight grobWidth unit unit.c #' @importFrom gtable gtable gtable_add_grob create_panels <- function(panels, x.axis, y.axis) { Map(function(panel, x, y, i) { heights <- unit.c(grobHeight(x$top), unit(1, 'null'), grobHeight(x$bottom)) widths <- unit.c(grobWidth(y$left), unit(1, 'null'), grobWidth(y$right)) table <- gtable(widths, heights) table <- gtable_add_grob(table, panel, t = 2, l = 2, z = 2, clip = 'on', name = paste0('panel-', i)) table <- gtable_add_grob(table, x, t = c(1, 3), l = 2, z = 4, clip = 'off', name = paste0(c('axis-t-', 'axis-b-'), i)) table <- gtable_add_grob(table, y, t = 2, l = c(1, 3), z = 4, clip = 'off', name = paste0(c('axis-l-', 'axis-r-'), i)) }, panel = panels, x = x.axis, y = y.axis, i = seq_along(panels)) } expansion <- function(scale, discrete = c(0, 0.6), continuous = c(0.05, 0)) { if (inherits(scale$expand, 'waiver')) { if (scale$is_discrete()) { discrete } else { continuous } } else { scale$expand } } # Helpers ----------------------------------------------------------------- split_with_index <- function(x, f, n = max(f)) { if (n == 1) return(list(x)) f <- as.integer(f) attributes(f) <- list(levels = as.character(seq_len(n)), class = "factor") unname(split(x, f)) } # Function for applying scale method to multiple variables in a given # data set. Implement in such a way to minimize copying and hence maximise # speed scale_apply <- function(data, vars, method, scale_id, scales) { if (length(vars) == 0) return() if (nrow(data) == 0) return() if (any(is.na(scale_id))) { cli::cli_abort("{.arg scale_id} must not contain any {.val NA}") } scale_index <- split_with_index(seq_along(scale_id), scale_id, length(scales)) lapply(vars, function(var) { pieces <- lapply(seq_along(scales), function(i) { scales[[i]][[method]](data[[var]][scale_index[[i]]]) }) # Remove empty vectors to avoid coercion issues with vctrs pieces[lengths(pieces) == 0] <- NULL o <- order(unlist(scale_index))[seq_len(sum(lengths(pieces)))] vec_c(!!!pieces)[o] }) } ggforce/R/facet_row.R0000644000176200001440000000764215024471216014176 0ustar liggesusers#' One-dimensional facets #' #' These facets are one-dimensional versions of [ggplot2::facet_wrap()], #' arranging the panels in either a single row or a single column. This #' restriction makes it possible to support a `space` argument as seen in #' [ggplot2::facet_grid()] which, if set to `"free"` will allow the panels to be #' sized based on the relative range of their scales. Another way of thinking #' about them are one-dimensional versions of [ggplot2::facet_grid()] (ie. #' `. ~ {var}` or `{var} ~ .`), but with the ability to position the strip at #' either side of the panel. However you look at it it is the best of both world #' if you just need one dimension. #' #' @inheritParams ggplot2::facet_wrap #' @param space Should the size of the panels be fixed or relative to the range #' of the respective position scales #' #' @export #' #' @examples #' # Standard use #' ggplot(mtcars) + #' geom_point(aes(disp, mpg)) + #' facet_col(~gear) #' # It retains the ability to have unique scales for each panel #' ggplot(mtcars) + #' geom_point(aes(disp, mpg)) + #' facet_col(~gear, scales = 'free') #' #' # But can have free sizing along the stacking dimension #' ggplot(mtcars) + #' geom_point(aes(disp, mpg)) + #' facet_col(~gear, scales = 'free', space = 'free') #' #' # And you can position the strip where-ever you like #' ggplot(mtcars) + #' geom_point(aes(disp, mpg)) + #' facet_col(~gear, scales = 'free', space = 'free', strip.position = 'bottom') #' facet_row <- function(facets, scales = "fixed", space = "fixed", shrink = TRUE, labeller = "label_value", drop = TRUE, strip.position = 'top') { space <- match.arg(space, c('free', 'fixed')) facet <- facet_wrap(facets, nrow = 1, scales = scales, shrink = shrink, labeller = labeller, drop = drop, strip.position = strip.position) params <- facet$params if ("space" %in% fn_fmls_names(facet_wrap)) { params$space_free <- list(x = space == 'free', y = FALSE) } else { params$space_free <- space == 'free' } ggproto(NULL, FacetRow, shrink = shrink, params = params) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export FacetRow <- ggproto('FacetRow', FacetWrap, draw_panels = function(self, panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { combined <- ggproto_parent(FacetWrap, self)$draw_panels(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) if (isTRUE(params$space_free)) { widths <- vapply(layout$PANEL, function(i) diff(ranges[[i]]$x.range), numeric(1)) panel_widths <- unit(widths, "null") combined$widths[panel_cols(combined)$l] <- panel_widths } combined } ) #' @rdname facet_row #' @export facet_col <- function(facets, scales = "fixed", space = "fixed", shrink = TRUE, labeller = "label_value", drop = TRUE, strip.position = 'top') { space <- match.arg(space, c('free', 'fixed')) facet <- facet_wrap(facets, ncol = 1, scales = scales, shrink = shrink, labeller = labeller, drop = drop, strip.position = strip.position) params <- facet$params if ("space" %in% fn_fmls_names(facet_wrap)) { params$space_free <- list(x = FALSE, y = space == 'free') } else { params$space_free <- space == 'free' } ggproto(NULL, FacetCol, shrink = shrink, params = params) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export FacetCol <- ggproto('FacetCol', FacetWrap, draw_panels = function(self, panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { combined <- ggproto_parent(FacetWrap, self)$draw_panels(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) if (isTRUE(params$space_free)) { heights <- vapply(layout$PANEL, function(i) diff(ranges[[i]]$y.range), numeric(1)) panel_heights <- unit(heights, "null") combined$heights[panel_rows(combined)$t] <- panel_heights } combined } ) ggforce/R/mark_hull.R0000644000176200001440000003176515024471216014206 0ustar liggesusers#' Annotate areas with hulls #' #' This geom lets you annotate sets of points via hulls. While convex hulls are #' most common due to their clear definition, they can lead to large areas #' covered that does not contain points. Due to this `geom_mark_hull` uses #' concaveman which lets you adjust concavity of the resulting hull. The hull is #' calculated at draw time, and can thus change as you resize the plot. In order #' to clearly contain all points, and for aesthetic purpose the resulting hull #' is expanded 5mm and rounded on the corners. This can be adjusted with the #' `expand` and `radius` parameters. #' #' @inheritSection geom_mark_circle Annotation #' @inheritSection geom_mark_circle Filtering #' @section Aesthetics: #' `geom_mark_hull` understand the following aesthetics (required aesthetics are #' in bold): #' #' - **x** #' - **y** #' - x0 *(used to anchor the label)* #' - y0 *(used to anchor the label)* #' - filter #' - label #' - description #' - color #' - fill #' - group #' - size #' - linetype #' - alpha #' #' @inheritParams geom_mark_circle #' #' @param concavity A measure of the concavity of the hull. `1` is very concave #' while it approaches convex as it grows. Defaults to `2`. #' #' @family mark geoms #' @name geom_mark_hull #' @rdname geom_mark_hull #' #' @examples #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_hull(aes(fill = Species, filter = Species != 'versicolor')) + #' geom_point() #' #' # Adjusting the concavity lets you change the shape of the hull #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_hull(aes(fill = Species, filter = Species != 'versicolor'), #' concavity = 1 #' ) + #' geom_point() #' #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_hull(aes(fill = Species, filter = Species != 'versicolor'), #' concavity = 10 #' ) + #' geom_point() #' #' # Add annotation #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_hull(aes(fill = Species, label = Species)) + #' geom_point() #' #' # Long descriptions are automatically wrapped to fit into the width #' iris$desc <- c( #' 'A super Iris - and it knows it', #' 'Pretty mediocre Iris, but give it a couple of years and it might surprise you', #' "You'll never guess what this Iris does every Sunday" #' )[iris$Species] #' #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_hull(aes(fill = Species, label = Species, description = desc, #' filter = Species == 'setosa')) + #' geom_point() #' #' # Change the buffer size to move labels farther away (or closer) from the #' # marks #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_hull(aes(fill = Species, label = Species), #' label.buffer = unit(40, 'mm')) + #' geom_point() #' #' # The connector is capped a bit before it reaches the mark, but this can be #' # controlled #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_hull(aes(fill = Species, label = Species), #' con.cap = 0) + #' geom_point() #' #' # If you want to use the scaled colours for the labels or connectors you can #' # use the "inherit" keyword instead #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_hull(aes(fill = Species, label = Species), #' label.fill = "inherit") + #' geom_point() #' NULL #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export GeomMarkHull <- ggproto('GeomMarkHull', GeomMarkCircle, draw_panel = function(self, data, panel_params, coord, expand = unit(5, 'mm'), radius = unit(2.5, 'mm'), concavity = 2, label.margin = margin(2, 2, 2, 2, 'mm'), label.width = NULL, label.minwidth = unit(50, 'mm'), label.hjust = 0, label.buffer = unit(10, 'mm'), label.fontsize = 12, label.family = '', label.fontface = c('bold', 'plain'), label.lineheight = 1, label.fill = 'white', label.colour = 'black', con.colour = 'black', con.size = 0.5, con.type = 'elbow', con.linetype = 1, con.border = 'one', con.cap = unit(3, 'mm'), con.arrow = NULL) { if (nrow(data) == 0) return(zeroGrob()) # As long as coord$transform() doesn't recognise x0/y0 data$xmin <- data$x0 data$ymin <- data$y0 coords <- coord$transform(data, panel_params) if (!is.integer(coords$group)) { coords$group <- match(coords$group, unique0(coords$group)) } coords <- coords[order(coords$group), ] # For gpar(), there is one entry per polygon (not one entry per point). # We'll pull the first value from each group, and assume all these values # are the same within each group. first_idx <- !duplicated(coords$group) first_rows <- coords[first_idx, ] label <- NULL ghosts <- NULL if (!is.null(coords$label) || !is.null(coords$description)) { label <- first_rows is_ghost <- which(self$removed$PANEL == coords$PANEL[1]) if (length(is_ghost) > 0) { ghosts <- self$removed[is_ghost, ] ghosts <- coord$transform(ghosts, panel_params) ghosts <- list(x = ghosts$x, y = ghosts$y) } } gp <- gpar( col = first_rows$colour, fill = ggplot2::fill_alpha(first_rows$fill, first_rows$alpha), lwd = (first_rows$linewidth %||% first_rows$size) * .pt, lty = first_rows$linetype, fontsize = (first_rows$size %||% 4.217518) * .pt ) hullEncGrob(coords$x, coords$y, default.units = 'native', id = coords$group, expand = expand, radius = radius, concavity = concavity, label = label, ghosts = ghosts, mark.gp = gp, label.gp = inherit_gp( col = label.colour[1], fill = label.fill, fontface = label.fontface[1], fontfamily = label.family[1], fontsize = label.fontsize[1], lineheight = label.lineheight[1], gp = gp ), desc.gp = inherit_gp( col = rep_len(label.colour, 2)[2], fontface = rep_len(label.fontface, 2)[2], fontfamily = rep_len(label.family, 2)[2], fontsize = rep_len(label.fontsize, 2)[2], lineheight = rep_len(label.lineheight, 2)[2], gp = gp ), con.gp = inherit_gp( col = con.colour, fill = con.colour, lwd = if (is.numeric(con.size)) con.size * .pt else con.size, lty = con.linetype, gp = gp ), label.margin = label.margin, label.width = label.width, label.minwidth = label.minwidth, label.hjust = label.hjust, label.buffer = label.buffer, con.type = con.type, con.border = con.border, con.cap = con.cap, con.arrow = con.arrow, anchor.x = first_rows$xmin, anchor.y = first_rows$ymin ) } ) #' @rdname geom_mark_hull #' @export geom_mark_hull <- function(mapping = NULL, data = NULL, stat = 'identity', position = 'identity', expand = unit(5, 'mm'), radius = unit(2.5, 'mm'), concavity = 2, label.margin = margin(2, 2, 2, 2, 'mm'), label.width = NULL, label.minwidth = unit(50, 'mm'), label.hjust = 0, label.fontsize = 12, label.family = '', label.lineheight = 1, label.fontface = c('bold', 'plain'), label.fill = 'white', label.colour = 'black', label.buffer = unit(10, 'mm'), con.colour = 'black', con.size = 0.5, con.type = 'elbow', con.linetype = 1, con.border = 'one', con.cap = unit(3, 'mm'), con.arrow = NULL, ..., na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) { layer( data = data, mapping = mapping, stat = stat, geom = GeomMarkHull, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( na.rm = na.rm, expand = expand, radius = radius, concavity = concavity, label.margin = label.margin, label.width = label.width, label.minwidth = label.minwidth, label.fontsize = label.fontsize, label.family = label.family, label.lineheight = label.lineheight, label.fontface = label.fontface, label.hjust = label.hjust, label.fill = label.fill, label.colour = label.colour, label.buffer = label.buffer, con.colour = con.colour, con.size = con.size, con.type = con.type, con.linetype = con.linetype, con.border = con.border, con.cap = con.cap, con.arrow = con.arrow, ... ) ) } # Helpers ----------------------------------------------------------------- hullEncGrob <- function(x = c(0, 0.5, 1, 0.5), y = c(0.5, 1, 0.5, 0), id = NULL, id.lengths = NULL, expand = 0, radius = 0, concavity = 2, label = NULL, ghosts = NULL, default.units = 'npc', name = NULL, mark.gp = gpar(), label.gp = gpar(), desc.gp = gpar(), con.gp = gpar(), label.margin = margin(), label.width = NULL, label.minwidth = unit(50, 'mm'), label.hjust = 0, label.buffer = unit(10, 'mm'), con.type = 'elbow', con.border = 'one', con.cap = unit(3, 'mm'), con.arrow = NULL, anchor.x = NULL, anchor.y = NULL, vp = NULL) { mark <- shapeGrob( x = x, y = y, id = id, id.lengths = id.lengths, expand = expand, radius = radius, default.units = default.units, name = name, gp = mark.gp, vp = vp ) if (!is.null(label)) { label <- lapply(seq_len(nrow(label)), function(i) { if (is.na(label$label[i] %||% NA) && is.na(label$description[i] %||% NA)) return(zeroGrob()) grob <- labelboxGrob(label$label[i], 0, 0, label$description[i], gp = subset_gp(label.gp, i), desc.gp = subset_gp(desc.gp, i), pad = label.margin, width = label.width, min.width = label.minwidth, hjust = label.hjust ) if (con.border == 'all') { con.gp <- subset_gp(con.gp, i) grob$children[[1]]$gp$col <- con.gp$col grob$children[[1]]$gp$lwd <- con.gp$lwd grob$children[[1]]$gp$lty <- con.gp$lty } grob }) labeldim <- lapply(label, function(l) { c( convertWidth(grobWidth(l), 'mm', TRUE), convertHeight(grobHeight(l), 'mm', TRUE) ) }) ghosts <- lapply(ghosts, unit, default.units) } else { labeldim <- NULL } if (!is.null(anchor.x) && !is.unit(anchor.x)) { anchor.x <- unit(anchor.x, default.units) } if (!is.null(anchor.y) && !is.unit(anchor.y)) { anchor.y <- unit(anchor.y, default.units) } gTree( mark = mark, concavity = concavity, label = label, labeldim = labeldim, buffer = label.buffer, ghosts = ghosts, con.gp = con.gp, con.type = con.type, con.cap = as_mm(con.cap, default.units), con.border = con.border, con.arrow = con.arrow, anchor.x = anchor.x, anchor.y = anchor.y, name = name, vp = vp, cl = 'hull_enc' ) } #' @importFrom grid convertX convertY unit makeContent setChildren gList #' @export makeContent.hull_enc <- function(x) { mark <- x$mark x_new <- convertX(mark$x, 'mm', TRUE) x_new <- split(x_new, mark$id) y_new <- convertY(mark$y, 'mm', TRUE) y_new <- split(y_new, mark$id) polygons <- Map(function(xx, yy, type) { mat <- unique0(cbind(xx, yy)) if (nrow(mat) <= 2) { return(mat) } if (length(unique0(xx)) == 1) { return(mat[c(which.min(mat[, 2]), which.max(mat[, 2])), ]) } if (length(unique0((yy[-1] - yy[1]) / (xx[-1] - xx[1]))) == 1) { return(mat[c(which.min(mat[, 1]), which.max(mat[, 1])), ]) } concaveman(mat, x$concavity, 0) }, xx = x_new, yy = y_new) # ensure that all polygons have the same set of column names polygons <- lapply(polygons, function(x) { colnames(x) <- c("x", "y") return(x) }) mark$id <- rep(seq_along(polygons), vapply(polygons, nrow, numeric(1))) polygons <- vec_rbind(!!!polygons) mark$x <- unit(polygons[, 1], 'mm') mark$y <- unit(polygons[, 2], 'mm') if (inherits(mark, 'shape')) mark <- makeContent(mark) if (!is.null(x$label)) { polygons <- Map(function(x, y) list(x = x, y = y), x = split(as.numeric(mark$x), mark$id), y = split(as.numeric(mark$y), mark$id) ) anchor_x <- if (is.null(x$anchor.x)) NULL else convertX(x$anchor.x, 'mm', TRUE) anchor_y <- if (is.null(x$anchor.y)) NULL else convertY(x$anchor.y, 'mm', TRUE) labels <- make_label( labels = x$label, dims = x$labeldim, polygons = polygons, ghosts = x$ghosts, buffer = x$buffer, con_type = x$con.type, con_border = x$con.border, con_cap = x$con.cap, con_gp = x$con.gp, anchor_mod = 2, anchor_x = anchor_x, anchor_y = anchor_y, arrow = x$con.arrow ) setChildren(x, inject(gList(!!!c(list(mark), labels)))) } else { setChildren(x, gList(mark)) } } ggforce/R/facet_stereo.R0000644000176200001440000001254314672274110014666 0ustar liggesusers#' Create a stereogram plot #' #' This, arguably pretty useless function, lets you create plots with a sense of #' depth by creating two slightly different versions of the plot that #' corresponds to how the eyes would see it if the plot was 3 dimensional. To #' experience the effect look at the plots through 3D hardware such as Google #' Cardboard or by relaxing the eyes and focusing into the distance. The #' depth of a point is calculated for layers having a depth aesthetic supplied. #' The scaling of the depth can be controlled with [scale_depth()] as #' you would control any aesthetic. Negative values will result in features #' placed behind the paper plane, while positive values will result in #' features hovering in front of the paper. While features within each layer is #' sorted so those closest to you are plotted on top of those more distant, this #' cannot be done between layers. Thus, layers are always plotted on top of #' each others, even if the features in one layer lies behind features in a #' layer behind it. The depth experience is inaccurate and should not be used #' for conveying important data. Regard this more as a party-trick... #' #' @param IPD The interpupillary distance (in mm) used for calculating point #' displacement. The default value is an average of both genders #' #' @param panel.size The final plot size in mm. As IPD this is used to calculate #' point displacement. Don't take this value too literal but experiment until #' you get a nice effect. Lower values gives higher displacement and thus #' require the plots to be observed from a closer distance #' #' @inheritParams ggplot2::facet_wrap #' #' @family ggforce facets #' #' @export #' #' @examples #' # You'll have to accept a warning about depth being an unknown aesthetic #' ggplot(mtcars) + #' geom_point(aes(mpg, disp, depth = cyl)) + #' facet_stereo() facet_stereo <- function(IPD = 63.5, panel.size = 200, shrink = TRUE) { ggproto(NULL, FacetStereo, shrink = shrink, params = list( IPD = IPD, panel.size = panel.size ) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom scales rescale #' @importFrom gtable gtable_add_cols #' @export FacetStereo <- ggproto('FacetStereo', Facet, compute_layout = function(data, params) { data_frame0(PANEL = c(1L, 2L), SCALE_X = 1L, SCALE_Y = 1L) }, map_data = function(data, layout, params) { if (empty(data)) { return(cbind(data, PANEL = integer(0))) } vec_rbind( cbind(data, PANEL = 1L), cbind(data, PANEL = 2L) ) }, finish_data = function(data, layout, x_scales, y_scales, params) { if ('depth' %in% names(data)) { if ('.interp' %in% names(data)) { data$depth2 <- vec_rbind(!!!lapply(split(data, data$PANEL), interpolateDataFrame))$depth } else { data$depth2 <- data$depth } group_order <- order( sapply(split(data$depth2, data$group), quantile, probs = 0.9, na.rm = TRUE) ) data <- vec_rbind(!!!split(data, data$group)[group_order]) data[data$group == -1, ] <- data[data$group == -1, ][order(data$depth2[data$group == -1]), ] data$group[data$group != -1] <- match(data$group[data$group != -1], unique0(data$group[data$group != -1])) x_range <- x_scales[[1]]$dimension(expand_default(x_scales[[1]])) k <- ifelse(data$PANEL == 1, -1, 1) * params$IPD / 2 x_transform <- function(d) { h <- rescale(d, to = c(-1, 1) * params$panel.size / 2, from = x_range) new_pos <- h + (h - k) * data$depth2 rescale(new_pos, to = x_range, from = c(-1, 1) * params$panel.size / 2) } data <- transform_position(data, x_transform) data$depth2 <- NULL } data }, draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { axes <- render_axes(ranges, ranges, coord, theme, FALSE) panelGrobs <- create_panels(panels, axes$x, axes$y) spacing <- theme$panel.spacing.x %||% theme$panel.spacing panel <- gtable_add_cols(panelGrobs[[1]], spacing) cbind(panel, panelGrobs[[2]], size = 'first') }, draw_labels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, labels, params) { panel_dim <- find_panel(panels) xlab_height_top <- grobHeight(labels$x[[1]]) panels <- gtable_add_rows(panels, xlab_height_top, pos = 0) panels <- gtable_add_grob(panels, labels$x[[1]], name = 'xlab-t', l = panel_dim$l, r = panel_dim$r, t = 1, clip = 'off' ) xlab_height_bottom <- grobHeight(labels$x[[2]]) panels <- gtable_add_rows(panels, xlab_height_bottom, pos = -1) panels <- gtable_add_grob(panels, labels$x[[2]], name = 'xlab-b', l = panel_dim$l, r = panel_dim$r, t = -1, clip = 'off' ) panel_dim <- find_panel(panels) ylab_width_left <- grobWidth(labels$y[[1]]) panels <- gtable_add_cols(panels, ylab_width_left, pos = 0) panels <- gtable_add_grob(panels, labels$y[[1]], name = 'ylab-l', l = 1, b = panel_dim$b, t = panel_dim$t, clip = 'off' ) ylab_width_right <- grobWidth(labels$y[[2]]) panels <- gtable_add_cols(panels, ylab_width_right, pos = -1) panels <- gtable_add_grob(panels, labels$y[[2]], name = 'ylab-r', l = -1, b = panel_dim$b, t = panel_dim$t, clip = 'off' ) panels } ) ggforce/R/diagonal.R0000644000176200001440000002203114672274110013772 0ustar liggesusers#' Draw horizontal diagonals #' #' A diagonal is a bezier curve where the control points are moved #' perpendicularly towards the center in either the x or y direction a fixed #' amount. The versions provided here calculates horizontal diagonals meaning #' that the x coordinate is moved to achieve the control point. The #' `geom_diagonal()` and `stat_diagonal()` functions are simply helpers that #' takes care of calculating the position of the control points and then #' forwards the actual bezier calculations to [geom_bezier()]. #' #' @section Aesthetics: #' geom_diagonal and geom_diagonal0 understand the following aesthetics #' (required aesthetics are in bold): #' #' - **x** #' - **y** #' - **xend** #' - **yend** #' - color #' - linewidth #' - linetype #' - alpha #' - lineend #' #' geom_diagonal2 understand the following aesthetics #' (required aesthetics are in bold): #' #' - **x** #' - **y** #' - **group** #' - color #' - linewidth #' - linetype #' - alpha #' - lineend #' #' @section Computed variables: #' #' \describe{ #' \item{x, y}{The interpolated point coordinates} #' \item{index}{The progression along the interpolation mapped between 0 and 1} #' } #' #' @inheritParams ggplot2::geom_line #' @inheritParams ggplot2::stat_identity #' #' @param n The number of points to create for each segment #' #' @param strength The proportion to move the control point along the x-axis #' towards the other end of the bezier curve #' #' @inheritSection ggplot2::geom_line Orientation #' #' @name geom_diagonal #' @rdname geom_diagonal #' #' @examples #' data <- data.frame( #' x = rep(0, 10), #' y = 1:10, #' xend = 1:10, #' yend = 2:11 #' ) #' #' ggplot(data) + #' geom_diagonal(aes(x, y, xend = xend, yend = yend)) #' #' # The standard version provides an index to create gradients #' ggplot(data) + #' geom_diagonal(aes(x, y, xend = xend, yend = yend, alpha = after_stat(index))) #' #' # The 0 version uses bezierGrob under the hood for an approximation #' ggplot(data) + #' geom_diagonal0(aes(x, y, xend = xend, yend = yend)) #' #' # The 2 version allows you to interpolate between endpoint aesthetics #' data2 <- data.frame( #' x = c(data$x, data$xend), #' y = c(data$y, data$yend), #' group = rep(1:10, 2), #' colour = sample(letters[1:5], 20, TRUE) #' ) #' ggplot(data2) + #' geom_diagonal2(aes(x, y, group = group, colour = colour)) #' #' # Use strength to control the steepness of the central region #' ggplot(data, aes(x, y, xend = xend, yend = yend)) + #' geom_diagonal(strength = 0.75, colour = 'red') + #' geom_diagonal(strength = 0.25, colour = 'blue') #' NULL #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatDiagonal <- ggproto('StatDiagonal', Stat, setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) params }, setup_data = function(data, params) { data$flipped_aes <- params$flipped_aes data }, compute_panel = function(data, scales, n = 100, strength = 0.5, flipped_aes = FALSE) { if (empty_data(data)) return(data) data <- flip_data(data, flipped_aes) data$group <- make_unique(data$group) end <- data end$x <- end$xend end$y <- end$yend data <- vec_rbind(data, end) data$xend <- NULL data$yend <- NULL data <- data[order(data$group), ] data <- add_controls(data, strength) data <- StatBezier$compute_panel(data, scales, n) flip_data(data, flipped_aes) }, required_aes = c('x', 'y', 'xend', 'yend'), extra_params = c('na.rm', 'n', 'strength', 'orientation') ) #' @rdname geom_diagonal #' @export stat_diagonal <- function(mapping = NULL, data = NULL, geom = 'path', position = 'identity', n = 100, strength = 0.5, na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, ...) { layer( stat = StatDiagonal, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, orientation = orientation, n = n, strength = strength, ...) ) } #' @rdname geom_diagonal #' @export geom_diagonal <- function(mapping = NULL, data = NULL, stat = 'diagonal', position = 'identity', n = 100, na.rm = FALSE, orientation = NA, strength = 0.5, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomPath, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, orientation = orientation, n = n, strength = strength, ...) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatDiagonal2 <- ggproto('StatDiagonal2', Stat, setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) params }, setup_data = function(data, params) { data$flipped_aes <- params$flipped_aes data }, compute_layer = function(self, data, params, panels) { if (empty_data(data)) return(data) data <- flip_data(data, params$flipped_aes) data <- data[order(data$group), ] data <- add_controls(data, params$strength) data <- flip_data(data, params$flipped_aes) StatBezier2$compute_layer(data, params, panels) }, required_aes = c('x', 'y'), extra_params = c('na.rm', 'n', 'strength', 'orientation') ) #' @rdname geom_diagonal #' @export stat_diagonal2 <- function(mapping = NULL, data = NULL, geom = 'path_interpolate', position = 'identity', na.rm = FALSE, orientation = NA, show.legend = NA, n = 100, strength = 0.5, inherit.aes = TRUE, ...) { layer( stat = StatDiagonal2, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, orientation = orientation, n = n, strength = strength, ...) ) } #' @rdname geom_diagonal #' @export geom_diagonal2 <- function(mapping = NULL, data = NULL, stat = 'diagonal2', position = 'identity', arrow = NULL, lineend = 'butt', na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, n = 100, strength = 0.5, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomPathInterpolate, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( arrow = arrow, lineend = lineend, na.rm = na.rm, orientation = orientation, n = n, strength = strength, ... ) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatDiagonal0 <- ggproto('StatDiagonal0', Stat, setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) params }, setup_data = function(data, params) { data$flipped_aes <- params$flipped_aes data }, compute_panel = function(data, scales, strength = 0.5, flipped_aes = FALSE) { if (empty_data(data)) return(data) data <- flip_data(data, flipped_aes) data$group <- make_unique(data$group) end <- data end$x <- end$xend end$y <- end$yend data <- vec_rbind(data, end) data$xend <- NULL data$yend <- NULL data <- data[order(data$group), ] data <- add_controls(data, strength) data <- flip_data(data, flipped_aes) StatBezier0$compute_panel(data, scales) }, required_aes = c('x', 'y', 'xend', 'yend'), extra_params = c('na.rm', 'strength', 'orientation') ) #' @rdname geom_diagonal #' @export stat_diagonal0 <- function(mapping = NULL, data = NULL, geom = 'bezier0', position = 'identity', na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, strength = 0.5, ...) { layer( stat = StatDiagonal0, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, orientation = orientation, strength = strength, ...) ) } #' @rdname geom_diagonal #' @export geom_diagonal0 <- function(mapping = NULL, data = NULL, stat = 'diagonal0', position = 'identity', arrow = NULL, lineend = 'butt', na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, strength = 0.5, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomBezier0, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( arrow = arrow, lineend = lineend, na.rm = na.rm, orientation = orientation, strength = strength, ... ) ) } add_controls <- function(data, strength) { start <- data[rep_len(c(TRUE, FALSE), nrow(data)), ] end <- data[rep_len(c(FALSE, TRUE), nrow(data)), ] x_diff <- (end$x - start$x) * strength mid1 <- start mid1$x <- mid1$x + x_diff mid2 <- end mid2$x <- mid2$x - x_diff vec_rbind(start, mid1, mid2, end) } ggforce/R/mark_circle.R0000644000176200001440000004230015024471216014466 0ustar liggesusers#' Annotate areas with circles #' #' This geom lets you annotate sets of points via circles. The enclosing circles #' are calculated at draw time and the most optimal enclosure at the given #' aspect ratio is thus guaranteed. As with the other `geom_mark_*` geoms the #' enclosure inherits from [geom_shape()] and defaults to be expanded slightly #' to better enclose the points. #' #' @section Annotation: #' All `geom_mark_*` allow you to put descriptive textboxes connected to the #' mark on the plot, using the `label` and `description` aesthetics. The #' textboxes are automatically placed close to the mark, but without obscuring #' any of the datapoints in the layer. The placement is dynamic so if you resize #' the plot you'll see that the annotation might move around as areas become big #' enough or too small to fit the annotation. If there's not enough space for #' the annotation without overlapping data it will not get drawn. In these cases #' try resizing the plot, change the size of the annotation, or decrease the #' buffer region around the marks. #' #' @section Filtering: #' Often marks are used to draw attention to, or annotate specific features of #' the plot and it is thus not desirable to have marks around everything. While #' it is possible to simply pre-filter the data used for the mark layer, the #' `geom_mark_*` geoms also comes with a dedicated `filter` aesthetic that, if #' set, will remove all rows where it evalutates to `FALSE`. There are #' multiple benefits of using this instead of prefiltering. First, you don't #' have to change your data source, making your code more adaptable for #' exploration. Second, the data removed by the filter aesthetic is remembered #' by the geom, and any annotation will take care not to overlap with the #' removed data. #' #' @section Aesthetics: #' geom_mark_circle understand the following aesthetics (required aesthetics are #' in bold): #' #' - **x** #' - **y** #' - x0 *(used to anchor the label)* #' - y0 *(used to anchor the label)* #' - filter #' - label #' - description #' - color #' - fill #' - group #' - size #' - linetype #' - alpha #' #' @inheritParams geom_shape #' #' @param n The number of points used to draw each circle. Defaults to `100`. #' @param label.margin The margin around the annotation boxes, given by a call #' to [ggplot2::margin()]. #' @param label.width A fixed width for the label. Set to `NULL` to let the text #' or `label.minwidth` decide. #' @param label.minwidth The minimum width to provide for the description. If #' the size of the label exceeds this, the description is allowed to fill as #' much as the label. #' @param label.fontsize The size of the text for the annotation. If it contains #' two elements the first will be used for the label and the second for the #' description. #' @param label.family The font family used for the annotation. If it contains #' two elements the first will be used for the label and the second for the #' description. #' @param label.fontface The font face used for the annotation. If it contains #' two elements the first will be used for the label and the second for the #' description. #' @param label.lineheight The height of a line as a multipler of the fontsize. #' If it contains two elements the first will be used for the label and the #' second for the description. #' @param label.hjust The horizontal justification for the annotation. If it #' contains two elements the first will be used for the label and the second for #' the description. #' @param label.fill The fill colour for the annotation box. Use `"inherit"` to #' use the fill from the enclosure or `"inherit_col"` to use the border colour #' of the enclosure. #' @param label.colour The text colour for the annotation. If it contains #' two elements the first will be used for the label and the second for the #' description. Use `"inherit"` to use the border colour of the enclosure or #' `"inherit_fill"` to use the fill colour from the enclosure. #' @param label.buffer The size of the region around the mark where labels #' cannot be placed. #' @param con.colour The colour for the line connecting the annotation to the #' mark. Use `"inherit"` to use the border colour of the enclosure or #' `"inherit_fill"` to use the fill colour from the enclosure. #' @param con.size The width of the connector. Use `"inherit"` to use the border #' width of the enclosure. #' @param con.type The type of the connector. Either `"elbow"`, `"straight"`, or #' `"none"`. #' @param con.linetype The linetype of the connector. Use `"inherit"` to use the #' border linetype of the enclosure. #' @param con.border The bordertype of the connector. Either `"one"` (to draw a #' line on the horizontal side closest to the mark), `"all"` (to draw a border #' on all sides), or `"none"` (not going to explain that one). #' @param con.cap The distance before the mark that the line should stop at. #' @param con.arrow An arrow specification for the connection using #' [grid::arrow()] for the end pointing towards the mark. #' #' @family mark geoms #' #' @name geom_mark_circle #' @rdname geom_mark_circle #' #' @examples #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_circle(aes(fill = Species, filter = Species != 'versicolor')) + #' geom_point() #' #' # Add annotation #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_circle(aes(fill = Species, label = Species)) + #' geom_point() #' #' # Long descriptions are automatically wrapped to fit into the width #' iris$desc <- c( #' 'A super Iris - and it knows it', #' 'Pretty mediocre Iris, but give it a couple of years and it might surprise you', #' "You'll never guess what this Iris does every Sunday" #' )[iris$Species] #' #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_circle(aes(fill = Species, label = Species, description = desc, #' filter = Species == 'setosa')) + #' geom_point() #' #' # Change the buffer size to move labels farther away (or closer) from the #' # marks #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_circle(aes(fill = Species, label = Species), #' label.buffer = unit(30, 'mm')) + #' geom_point() #' #' # The connector is capped a bit before it reaches the mark, but this can be #' # controlled #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_circle(aes(fill = Species, label = Species), #' con.cap = 0) + #' geom_point() #' #' # If you want to use the scaled colours for the labels or connectors you can #' # use the "inherit" keyword instead #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_circle(aes(fill = Species, label = Species), #' label.fill = "inherit") + #' geom_point() #' NULL #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export GeomMarkCircle <- ggproto('GeomMarkCircle', GeomShape, setup_data = function(self, data, params) { if (!is.null(data$filter)) { data$filter <- ifelse(is.na(data$filter), FALSE, data$filter) self$removed <- data[!data$filter, c('x', 'y', 'PANEL')] data <- data[data$filter, ] } data }, draw_panel = function(self, data, panel_params, coord, expand = unit(5, 'mm'), radius = expand, n = 100, label.margin = margin(2, 2, 2, 2, 'mm'), label.width = NULL, label.minwidth = unit(50, 'mm'), label.hjust = 0, label.buffer = unit(10, 'mm'), label.fontsize = 12, label.family = '', label.fontface = c('bold', 'plain'), label.fill = 'white', label.colour = 'black', label.lineheight = 1, con.colour = 'black', con.size = 0.5, con.type = 'elbow', con.linetype = 1, con.border = 'one', con.cap = unit(3, 'mm'), con.arrow = NULL) { if (nrow(data) == 0) return(zeroGrob()) # As long as coord$transform() doesn't recognise x0/y0 data$xmin <- data$x0 data$ymin <- data$y0 coords <- coord$transform(data, panel_params) if (!is.integer(coords$group)) { coords$group <- match(coords$group, unique0(coords$group)) } coords <- coords[order(coords$group), ] # For gpar(), there is one entry per polygon (not one entry per point). # We'll pull the first value from each group, and assume all these values # are the same within each group. first_idx <- !duplicated(coords$group) first_rows <- coords[first_idx, ] label <- NULL ghosts <- NULL if (!is.null(coords$label) || !is.null(coords$description)) { label <- first_rows is_ghost <- which(self$removed$PANEL == coords$PANEL[1]) if (length(is_ghost) > 0) { ghosts <- self$removed[is_ghost, ] ghosts <- coord$transform(ghosts, panel_params) ghosts <- list(x = ghosts$x, y = ghosts$y) } } gp <- gpar( col = first_rows$colour, fill = ggplot2::fill_alpha(first_rows$fill, first_rows$alpha), lwd = (first_rows$linewidth %||% first_rows$size) * .pt, lty = first_rows$linetype, fontsize = (first_rows$size %||% 4.217518) * .pt ) circEncGrob(coords$x, coords$y, default.units = 'native', id = coords$group, expand = expand, radius = radius, n = n, label = label, ghosts = ghosts, mark.gp = gp, label.gp = inherit_gp( col = label.colour[1], fill = label.fill, fontface = label.fontface[1], fontfamily = label.family[1], fontsize = label.fontsize[1], lineheight = label.lineheight[1], gp = gp ), desc.gp = inherit_gp( col = rep_len(label.colour, 2)[2], fontface = rep_len(label.fontface, 2)[2], fontfamily = rep_len(label.family, 2)[2], fontsize = rep_len(label.fontsize, 2)[2], lineheight = rep_len(label.lineheight, 2)[2], gp = gp ), con.gp = inherit_gp( col = con.colour, fill = con.colour, lwd = if (is.numeric(con.size)) con.size * .pt else con.size, lty = con.linetype, gp = gp ), label.margin = label.margin, label.width = label.width, label.minwidth = label.minwidth, label.hjust = label.hjust, label.buffer = label.buffer, con.type = con.type, con.border = con.border, con.cap = con.cap, con.arrow = con.arrow, anchor.x = first_rows$xmin, anchor.y = first_rows$ymin ) }, default_aes = combine_aes( GeomShape$default_aes, aes(fill = NA, colour = 'black', alpha = 0.3, filter = NULL, label = NULL, description = NULL, x0 = NULL, y0 = NULL) ), handle_na = function(self, data, params) { remove_missing(data, params$na.rm, c(self$required_aes, self$non_missing_aes), snake_class(self) ) }, extra_params = 'na.rm' ) #' @rdname geom_mark_circle #' @export geom_mark_circle <- function(mapping = NULL, data = NULL, stat = 'identity', position = 'identity', expand = unit(5, 'mm'), radius = expand, n = 100, label.margin = margin(2, 2, 2, 2, 'mm'), label.width = NULL, label.minwidth = unit(50, 'mm'), label.hjust = 0, label.fontsize = 12, label.family = '', label.lineheight = 1, label.fontface = c('bold', 'plain'), label.fill = 'white', label.colour = 'black', label.buffer = unit(10, 'mm'), con.colour = 'black', con.size = 0.5, con.type = 'elbow', con.linetype = 1, con.border = 'one', con.cap = unit(3, 'mm'), con.arrow = NULL, ..., na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) { layer( data = data, mapping = mapping, stat = stat, geom = GeomMarkCircle, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( na.rm = na.rm, expand = expand, radius = radius, n = n, label.margin = label.margin, label.width = label.width, label.minwidth = label.minwidth, label.fontsize = label.fontsize, label.family = label.family, label.lineheight = label.lineheight, label.fontface = label.fontface, label.hjust = label.hjust, label.fill = label.fill, label.colour = label.colour, label.buffer = label.buffer, con.colour = con.colour, con.size = con.size, con.type = con.type, con.linetype = con.linetype, con.border = con.border, con.cap = con.cap, con.arrow = con.arrow, ... ) ) } # Helpers ----------------------------------------------------------------- #' @importFrom grDevices chull circEncGrob <- function(x = c(0, 0.5, 1, 0.5), y = c(0.5, 1, 0.5, 0), id = NULL, id.lengths = NULL, expand = 0, radius = 0, n = 100, label = NULL, ghosts = NULL, default.units = 'npc', name = NULL, mark.gp = gpar(), label.gp = gpar(), desc.gp = gpar(), con.gp = gpar(), label.margin = margin(), label.width = NULL, label.minwidth = unit(50, 'mm'), label.hjust = 0, label.buffer = unit(10, 'mm'), con.type = 'elbow', con.border = 'one', con.cap = unit(3, 'mm'), con.arrow = NULL, anchor.x = NULL, anchor.y = NULL, vp = NULL) { if (is.null(id)) { if (is.null(id.lengths)) { id <- rep(1, length(x)) } else { id <- rep(seq_along(id.lengths), id.lengths) if (length(id) != length(x)) { cli::cli_abort('{.arg id.lengths} must sum up to the number of points') } } } include <- unlist(lapply(split(seq_along(x), id), function(i) { xi <- x[i] yi <- y[i] if (length(unique0(xi)) == 1) { return(i[c(which.min(yi), which.max(yi))]) } if (length(unique0(yi)) == 1) { return(i[c(which.min(xi), which.max(xi))]) } i[chull(xi, yi)] })) mark <- shapeGrob( x = x[include], y = y[include], id = id[include], id.lengths = NULL, expand = expand, radius = radius, default.units = default.units, name = name, gp = mark.gp, vp = vp ) if (!is.null(label)) { label <- lapply(seq_len(nrow(label)), function(i) { if (is.na(label$label[i] %||% NA) && is.na(label$description[i] %||% NA)) return(zeroGrob()) grob <- labelboxGrob(label$label[i], 0, 0, label$description[i], gp = subset_gp(label.gp, i), desc.gp = subset_gp(desc.gp, i), pad = label.margin, width = label.width, min.width = label.minwidth, hjust = label.hjust ) if (con.border == 'all') { con.gp <- subset_gp(con.gp, i) grob$children[[1]]$gp$col <- con.gp$col grob$children[[1]]$gp$lwd <- con.gp$lwd grob$children[[1]]$gp$lty <- con.gp$lty } grob }) labeldim <- lapply(label, function(l) { c( convertWidth(grobWidth(l), 'mm', TRUE), convertHeight(grobHeight(l), 'mm', TRUE) ) }) ghosts <- lapply(ghosts, unit, default.units) } else { labeldim <- NULL } if (!is.null(anchor.x) && !is.unit(anchor.x)) { anchor.x <- unit(anchor.x, default.units) } if (!is.null(anchor.y) && !is.unit(anchor.y)) { anchor.y <- unit(anchor.y, default.units) } gTree( mark = mark, n = n, label = label, labeldim = labeldim, buffer = label.buffer, ghosts = ghosts, con.gp = con.gp, con.type = con.type, con.cap = as_mm(con.cap, default.units), con.border = con.border, con.arrow = con.arrow, anchor.x = anchor.x, anchor.y = anchor.y, name = name, vp = vp, cl = 'circ_enc' ) } #' @importFrom grid convertX convertY unit makeContent setChildren gList #' @export makeContent.circ_enc <- function(x) { mark <- x$mark x_new <- convertX(mark$x, 'mm', TRUE) y_new <- convertY(mark$y, 'mm', TRUE) circles <- enclose_points(round(x_new, 2), round(y_new, 2), mark$id) circles$id <- seq_len(nrow(circles)) circles <- circles[rep(circles$id, each = x$n), ] points <- 2 * pi * (seq_len(x$n) - 1) / x$n circles$x <- circles$x0 + cos(points) * circles$r circles$y <- circles$y0 + sin(points) * circles$r circles <- unique0(circles) mark$x <- unit(circles$x, 'mm') mark$y <- unit(circles$y, 'mm') mark$id <- circles$id if (inherits(mark, 'shape')) mark <- makeContent(mark) if (!is.null(x$label)) { polygons <- Map(function(x, y) list(x = x, y = y), x = split(as.numeric(mark$x), mark$id), y = split(as.numeric(mark$y), mark$id) ) anchor_x <- if (is.null(x$anchor.x)) NULL else convertX(x$anchor.x, 'mm', TRUE) anchor_y <- if (is.null(x$anchor.y)) NULL else convertY(x$anchor.y, 'mm', TRUE) labels <- make_label( labels = x$label, dims = x$labeldim, polygons = polygons, ghosts = x$ghosts, buffer = x$buffer, con_type = x$con.type, con_border = x$con.border, con_cap = x$con.cap, con_gp = x$con.gp, anchor_mod = 2, anchor_x = anchor_x, anchor_y = anchor_y, arrow = x$con.arrow ) setChildren(x, inject(gList(!!!c(list(mark), labels)))) } else { setChildren(x, gList(mark)) } } ggforce/R/trans.R0000644000176200001440000001414414672274110013351 0ustar liggesusers#' Create a power transformation object #' #' This function can be used to create a proper trans object that encapsulates #' a power transformation (x^n). #' #' @param n The degree of the power transformation #' #' @return A trans object #' #' @importFrom scales trans_new extended_breaks format_format #' @importFrom MASS fractions #' #' @export #' #' @examples #' # Power of 2 transformations #' trans <- power_trans(2) #' trans$transform(1:10) #' #' # Cubic root transformation #' trans <- power_trans(1 / 3) #' trans$transform(1:10) #' #' # Use it in a plot #' ggplot() + #' geom_line(aes(x = 1:10, y = 1:10)) + #' scale_x_continuous(trans = power_trans(2), #' expand = c(0, 1)) power_trans <- function(n) { trans_new( name = paste0('power of ', fractions(n)), transform = function(x) { x^n }, inverse = function(x) { x^(1 / n) }, breaks = extended_breaks(), format = format_format(), domain = c(0, Inf) ) } #' Create radial data in a cartesian coordinate system #' #' This function creates a trans object that converts radial data to their #' corresponding coordinates in cartesian space. The trans object is created for #' a specific radius and angle range that will be mapped to the unit circle so #' data doesn't have to be normalized to 0-1 and 0-2*pi in advance. While there #' exists a clear mapping from radial to cartesian, the inverse is not true as #' radial representation is periodic. It is impossible to know how many #' revolutions around the unit circle a point has taken from reading its #' coordinates. The inverse function will always assume that coordinates are in #' their first revolution i.e. map them back within the range of a.range. #' #' @param r.range The range in radius that correspond to 0 - 1 in the unit #' circle. #' #' @param a.range The range in angles that correspond to 2*pi - 0. As radians #' are normally measured counterclockwise while radial displays are read #' clockwise it's an inverse mapping #' #' @param offset The offset in angles to apply. Determines that start position #' on the circle. pi/2 (the default) corresponds to 12 o'clock. #' #' @param pad Adds to the end points of the angle range in order to separate the #' start and end point. Defaults to 0.5 #' #' @param clip Should input data be clipped to r.range and a.range or be allowed #' to extend beyond. Defaults to FALSE (no clipping) #' #' @return A trans object. The transform method for the object takes an r #' (radius) and a (angle) argument and returns a data.frame with x and y columns #' with rows for each element in r/a. The inverse method takes an x and y #' argument and returns a data.frame with r and a columns and rows for each #' element in x/y. #' #' @note While trans objects are often used to modify scales in ggplot2, radial #' transformation is different as it is a coordinate transformation and takes #' two arguments. Consider it a trans version of coord_polar and use it to #' transform your data prior to plotting. #' #' @importFrom scales trans_new extended_breaks format_format #' #' @export #' #' @examples #' # Some data in radial form #' rad <- data.frame(r = seq(1, 10, by = 0.1), a = seq(1, 10, by = 0.1)) #' #' # Create a transformation #' radial <- radial_trans(c(0, 1), c(0, 5)) #' #' # Get data in x, y #' cart <- radial$transform(rad$r, rad$a) #' #' # Have a look #' ggplot() + #' geom_path(aes(x = x, y = y), data = cart, color = 'forestgreen') + #' geom_path(aes(x = r, y = a), data = rad, color = 'firebrick') radial_trans <- function(r.range, a.range, offset = pi / 2, pad = 0.5, clip = FALSE) { a.range[which.min(a.range)] <- min(a.range) - pad a.range[which.max(a.range)] <- max(a.range) + pad trans_new( name = paste0( 'radial-to-cartesian: ', r.range[1], '-', r.range[2], ' -> 0-1; ', a.range[1], '-', a.range[2], ' -> 2pi-0' ), transform = function(r, a) { if (clip) { r[r < min(r.range)] <- min(r.range) r[r > max(r.range)] <- max(r.range) a[a < min(a.range)] <- min(a.range) a[a > max(a.range)] <- max(a.range) } if (diff(r.range) == 0) { r <- 1 } else { r <- (r - r.range[1]) / diff(r.range) } if (diff(a.range) == 0) { a <- offset } else { a <- offset + (a - a.range[1]) / diff(a.range) * -2 * pi } data_frame0(x = r * cos(a), y = r * sin(a)) }, inverse = function(x, y) { r <- sqrt(x^2 + y^2) * diff(r.range) + r.range[1] angle <- -(atan2(y, x) - offset) angle[angle < 0] <- 2 * pi + angle[angle < 0] a <- angle / (2 * pi) * diff(a.range) + a.range[1] data_frame0(r = r, a = a) }, breaks = extended_breaks(), format = format_format() ) } #' Reverse a transformation #' #' While the scales package export a reverse_trans object it does not allow for #' reversing of already transformed ranged - e.g. a reverse exp transformation #' is not possible. trans_reverser takes a trans object or something coercible #' to one and creates a reverse version of it. #' #' @param trans A trans object or an object that can be converted to one using #' [scales::as.trans()] #' #' @return A trans object #' #' @importFrom scales as.trans trans_new asn_trans atanh_trans boxcox_trans #' date_trans exp_trans identity_trans log10_trans log1p_trans log2_trans #' logit_trans log_trans probability_trans probit_trans reciprocal_trans #' reverse_trans sqrt_trans time_trans #' #' @export #' #' @examples #' # Lets make a plot #' p <- ggplot() + #' geom_line(aes(x = 1:10, y = 1:10)) #' #' # scales already have a reverse trans #' p + scale_x_continuous(trans = 'reverse') #' #' # But what if you wanted to reverse an already log transformed scale? #' p + scale_x_continuous(trans = trans_reverser('log')) trans_reverser <- function(trans) { transformOrig <- as.trans(trans) trans_new( name = paste0('reverse-', transformOrig$name), transform = function(x) { -transformOrig$transform(x) }, inverse = function(x) { transformOrig$inverse(-x) }, breaks = transformOrig$breaks, format = transformOrig$format, domain = transformOrig$domain ) } ggforce/R/bezier.R0000644000176200001440000002510514672274110013501 0ustar liggesusers#' Create quadratic or cubic bezier curves #' #' This set of geoms makes it possible to connect points creating either #' quadratic or cubic beziers. bezier and bezier2 both work by calculating #' points along the bezier and connecting these to draw the curve. bezier0 #' directly draws the bezier using bezierGrob. In line with the [geom_link()] and #' [geom_link2()] differences geom_bezier creates the points, assign #' an index to each interpolated point and repeat the aesthetics for the start #' point, while geom_bezier2 interpolates the aesthetics between the start and #' end points. #' #' @details #' Input data is understood as a sequence of data points the first being the #' start point, then followed by one or two control points and then the end #' point. More than 4 and less than 3 points per group will throw an error. #' [grid::bezierGrob()] only takes cubic beziers so if three points are #' supplied the middle one as duplicated. This, along with the fact that #' [grid::bezierGrob()] estimates the curve using an x-spline means #' that the curves produced by geom_bezier and geom_bezier2 deviates from those #' produced by geom_bezier0. If you want true bezier paths use geom_bezier or #' geom_bezier2. #' #' @section Aesthetics: #' geom_bezier, geom_bezier2 and geom_bezier0 understand the following aesthetics #' (required aesthetics are in bold): #' #' - **x** #' - **y** #' - color #' - linewidth #' - linetype #' - alpha #' - lineend #' #' #' @section Computed variables: #' #' \describe{ #' \item{x, y}{The interpolated point coordinates} #' \item{index}{The progression along the interpolation mapped between 0 and 1} #' } #' #' @inheritParams ggplot2::geom_path #' @inheritParams ggplot2::stat_identity #' #' @param n The number of points to create for each segment #' #' @name geom_bezier #' @rdname geom_bezier #' #' @examples #' beziers <- data.frame( #' x = c(1, 2, 3, 4, 4, 6, 6), #' y = c(0, 2, 0, 0, 2, 2, 0), #' type = rep(c('cubic', 'quadratic'), c(3, 4)), #' point = c('end', 'control', 'end', 'end', 'control', 'control', 'end'), #' colour = letters[1:7] #' ) #' help_lines <- data.frame( #' x = c(1, 3, 4, 6), #' xend = c(2, 2, 4, 6), #' y = 0, #' yend = 2 #' ) #' #' # See how control points affect the bezier #' ggplot() + #' geom_segment(aes(x = x, xend = xend, y = y, yend = yend), #' data = help_lines, #' arrow = arrow(length = unit(c(0, 0, 0.5, 0.5), 'cm')), #' colour = 'grey') + #' geom_bezier(aes(x = x, y = y, group = type, linetype = type), #' data = beziers) + #' geom_point(aes(x = x, y = y, colour = point), #' data = beziers) #' #' # geom_bezier0 is less exact #' ggplot() + #' geom_segment(aes(x = x, xend = xend, y = y, yend = yend), #' data = help_lines, #' arrow = arrow(length = unit(c(0, 0, 0.5, 0.5), 'cm')), #' colour = 'grey') + #' geom_bezier0(aes(x = x, y = y, group = type, linetype = type), #' data = beziers) + #' geom_point(aes(x = x, y = y, colour = point), #' data = beziers) #' #' # Use geom_bezier2 to interpolate between endpoint aesthetics #' ggplot(beziers) + #' geom_bezier2(aes(x = x, y = y, group = type, colour = colour)) #' NULL #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatBezier <- ggproto('StatBezier', Stat, compute_panel = function(data, scales, n = 100) { if (empty_data(data)) return(data) nControls <- table(data$group) controlRange <- range(nControls) if (min(controlRange) < 3 || max(controlRange) > 4) { cli::cli_abort(c( 'Only support for quadratic and cubic beziers', i = 'Make sure each group consists of 3 or 4 rows' )) } data <- data[order(data$group), ] groups <- unique0(data$group) paths <- getBeziers(data$x, data$y, match(data$group, groups), n) paths <- data_frame0( x = paths$paths[, 1], y = paths$paths[, 2], group = groups[paths$pathID] ) paths$index <- rep(seq(0, 1, length.out = n), length(nControls)) dataIndex <- rep(match(unique0(data$group), data$group), each = n) cbind( paths, data[dataIndex, !names(data) %in% c('x', 'y', 'group'), drop = FALSE] ) }, required_aes = c('x', 'y'), extra_params = c('na.rm', 'n') ) #' @rdname geom_bezier #' @export stat_bezier <- function(mapping = NULL, data = NULL, geom = 'path', position = 'identity', na.rm = FALSE, show.legend = NA, n = 100, inherit.aes = TRUE, ...) { layer( stat = StatBezier, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, n = n, ...) ) } #' @rdname geom_bezier #' @export geom_bezier <- function(mapping = NULL, data = NULL, stat = 'bezier', position = 'identity', arrow = NULL, lineend = 'butt', na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, n = 100, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomPath, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( arrow = arrow, lineend = lineend, na.rm = na.rm, n = n, ... ) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatBezier2 <- ggproto('StatBezier2', Stat, compute_layer = function(self, data, params, panels) { if (empty_data(data)) return(data) data <- data[order(data$group), ] nControls <- table(data$group) controlRange <- range(nControls) if (min(controlRange) < 3 || max(controlRange) > 4) { cli::cli_abort(c( 'Only support for quadratic and cubic beziers', i = 'Make sure each group consists of 3 or 4 rows' )) } groups <- unique0(data$group) paths <- getBeziers(data$x, data$y, match(data$group, groups), params$n) paths <- data_frame0( x = paths$paths[, 1], y = paths$paths[, 2], group = groups[paths$pathID] ) paths$index <- rep(seq(0, 1, length.out = params$n), length(nControls)) dataIndex <- rep(match(unique0(data$group), data$group), each = params$n) paths <- cbind(paths, data[dataIndex, 'PANEL', drop = FALSE]) extraCols <- !names(data) %in% c('x', 'y', 'group', 'PANEL') startIndex <- c(1, cumsum(nControls) + 1)[-(length(nControls) + 1)] endIndex <- c(startIndex[-1] - 1, nrow(data)) dataIndex <- c(startIndex, endIndex) pathIndex <- match(unique0(data$group), paths$group) pathIndex <- c(pathIndex, pathIndex + 1) paths$.interp <- TRUE paths$.interp[pathIndex] <- FALSE if (any(extraCols)) { for (i in names(data)[extraCols]) { paths[[i]] <- data[[i]][1] paths[[i]][pathIndex] <- data[dataIndex, i] } } paths }, required_aes = c('x', 'y'), extra_params = c('na.rm', 'n') ) #' @rdname geom_bezier #' @export stat_bezier2 <- function(mapping = NULL, data = NULL, geom = 'path_interpolate', position = 'identity', na.rm = FALSE, show.legend = NA, n = 100, inherit.aes = TRUE, ...) { layer( stat = StatBezier2, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, n = n, ...) ) } #' @rdname geom_bezier #' @export geom_bezier2 <- function(mapping = NULL, data = NULL, stat = 'bezier2', position = 'identity', arrow = NULL, lineend = 'butt', na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, n = 100, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomPathInterpolate, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( arrow = arrow, lineend = lineend, na.rm = na.rm, n = n, ... ) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatBezier0 <- ggproto('StatBezier0', Stat, compute_panel = function(data, scales) { if (empty_data(data)) return(data) data <- data[order(data$group), ] nControls <- table(data$group) controlRange <- range(nControls) if (min(controlRange) < 3 || max(controlRange) > 4) { cli::cli_abort(c( 'Only support for quadratic and cubic beziers', i = 'Make sure each group consists of 3 or 4 rows' )) } quadratic <- nControls == 3 if (any(quadratic)) { controlIndex <- c(1, cumsum(nControls) + 1)[-(length(nControls) + 1)] extraRows <- controlIndex[quadratic] + 1 extraRows <- sort(c(seq_len(nrow(data)), extraRows)) data <- data[extraRows, ] } data }, required_aes = c('x', 'y') ) #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom grid bezierGrob gpar #' @export GeomBezier0 <- ggproto('GeomBezier0', GeomPath, draw_panel = function(data, panel_scales, coord, arrow = NULL, lineend = 'butt', linejoin = 'round', linemitre = 1, na.rm = FALSE) { coords <- coord$transform(data, panel_scales) if (!is.integer(coords$group)) { coords$group <- match(coords$group, unique0(coords$group)) } startPoint <- match(unique0(coords$group), coords$group) bezierGrob(coords$x, coords$y, id = coords$group, default.units = 'native', arrow = arrow, gp = gpar( col = alpha(coords$colour[startPoint], coords$alpha[startPoint]), lwd = (coords$linewidth[startPoint] %||% coords$size[startPoint]) * .pt, lty = coords$linetype[startPoint], lineend = lineend, linejoin = linejoin, linemitre = linemitre ) ) } ) #' @rdname geom_bezier #' @export stat_bezier0 <- function(mapping = NULL, data = NULL, geom = 'bezier0', position = 'identity', na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( stat = StatBezier0, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, ...) ) } #' @rdname geom_bezier #' @export geom_bezier0 <- function(mapping = NULL, data = NULL, stat = 'bezier0', position = 'identity', arrow = NULL, lineend = 'butt', na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomBezier0, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(arrow = arrow, lineend = lineend, na.rm = na.rm, ...) ) } ggforce/R/mark_ellipse.R0000644000176200001440000003237515024471216014675 0ustar liggesusers#' Annotate areas with ellipses #' #' This geom lets you annotate sets of points via ellipses. The enclosing #' ellipses are estimated using the Khachiyan algorithm which guarantees an #' optimal solution within the given tolerance level. As this geom is often #' expanded it is of lesser concern that some points are slightly outside the #' ellipsis. The Khachiyan algorithm has polynomial complexity and can thus #' suffer from scaling issues. Still, it is only calculated on the convex hull #' of the groups, so performance issues should be rare (it can easily handle a #' hull consisting of 1000 points). #' #' @inheritSection geom_mark_circle Annotation #' @inheritSection geom_mark_circle Filtering #' @section Aesthetics: #' `geom_mark_ellipse` understands the following aesthetics (required aesthetics are #' in bold): #' #' - **x** #' - **y** #' - x0 *(used to anchor the label)* #' - y0 *(used to anchor the label)* #' - filter #' - label #' - description #' - color #' - fill #' - group #' - size #' - linetype #' - alpha #' #' @inheritParams geom_mark_circle #' #' @param n The number of points used to draw each ellipse. Defaults to `100`. #' @param tol The tolerance cutoff. Lower values will result in ellipses closer #' to the optimal solution. Defaults to `0.01`. #' #' @family mark geoms #' #' @name geom_mark_ellipse #' @rdname geom_mark_ellipse #' #' @examples #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_ellipse(aes(fill = Species, filter = Species != 'versicolor')) + #' geom_point() #' #' # Add annotation #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_ellipse(aes(fill = Species, label = Species)) + #' geom_point() #' #' # Long descriptions are automatically wrapped to fit into the width #' iris$desc <- c( #' 'A super Iris - and it knows it', #' 'Pretty mediocre Iris, but give it a couple of years and it might surprise you', #' "You'll never guess what this Iris does every Sunday" #' )[iris$Species] #' #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_ellipse(aes(fill = Species, label = Species, description = desc, #' filter = Species == 'setosa')) + #' geom_point() #' #' # Change the buffer size to move labels farther away (or closer) from the #' # marks #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_ellipse(aes(fill = Species, label = Species), #' label.buffer = unit(40, 'mm')) + #' geom_point() #' #' # The connector is capped a bit before it reaches the mark, but this can be #' # controlled #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_ellipse(aes(fill = Species, label = Species), #' con.cap = 0) + #' geom_point() #' #' # If you want to use the scaled colours for the labels or connectors you can #' # use the "inherit" keyword instead #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_ellipse(aes(fill = Species, label = Species), #' label.fill = "inherit") + #' geom_point() NULL #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export GeomMarkEllipse <- ggproto('GeomMarkEllipse', GeomMarkCircle, draw_panel = function(self, data, panel_params, coord, expand = unit(5, 'mm'), radius = expand, n = 100, tol = 0.01, label.margin = margin(2, 2, 2, 2, 'mm'), label.width = NULL, label.minwidth = unit(50, 'mm'), label.hjust = 0, label.buffer = unit(10, 'mm'), label.fontsize = 12, label.family = '', label.fontface = c('bold', 'plain'), label.lineheight = 1, label.fill = 'white', label.colour = 'black', con.colour = 'black', con.size = 0.5, con.type = 'elbow', con.linetype = 1, con.border = 'one', con.cap = unit(3, 'mm'), con.arrow = NULL) { if (nrow(data) == 0) return(zeroGrob()) # As long as coord$transform() doesn't recognise x0/y0 data$xmin <- data$x0 data$ymin <- data$y0 coords <- coord$transform(data, panel_params) if (!is.integer(coords$group)) { coords$group <- match(coords$group, unique0(coords$group)) } coords <- coords[order(coords$group), ] # For gpar(), there is one entry per polygon (not one entry per point). # We'll pull the first value from each group, and assume all these values # are the same within each group. first_idx <- !duplicated(coords$group) first_rows <- coords[first_idx, ] label <- NULL ghosts <- NULL if (!is.null(coords$label) || !is.null(coords$description)) { label <- first_rows is_ghost <- which(self$removed$PANEL == coords$PANEL[1]) if (length(is_ghost) > 0) { ghosts <- self$removed[is_ghost, ] ghosts <- coord$transform(ghosts, panel_params) ghosts <- list(x = ghosts$x, y = ghosts$y) } } gp <- gpar( col = first_rows$colour, fill = ggplot2::fill_alpha(first_rows$fill, first_rows$alpha), lwd = (first_rows$linewidth %||% first_rows$size) * .pt, lty = first_rows$linetype, fontsize = (first_rows$size %||% 4.217518) * .pt ) ellipEncGrob(coords$x, coords$y, default.units = 'native', id = coords$group, expand = expand, radius = radius, n = n, tol = tol, label = label, ghosts = ghosts, mark.gp = gp, label.gp = inherit_gp( col = label.colour[1], fill = label.fill, fontface = label.fontface[1], fontfamily = label.family[1], fontsize = label.fontsize[1], lineheight = label.lineheight[1], gp = gp ), desc.gp = inherit_gp( col = rep_len(label.colour, 2)[2], fontface = rep_len(label.fontface, 2)[2], fontfamily = rep_len(label.family, 2)[2], fontsize = rep_len(label.fontsize, 2)[2], lineheight = rep_len(label.lineheight, 2)[2], gp = gp ), con.gp = inherit_gp( col = con.colour, fill = con.colour, lwd = if (is.numeric(con.size)) con.size * .pt else con.size, lty = con.linetype, gp = gp ), label.margin = label.margin, label.width = label.width, label.minwidth = label.minwidth, label.hjust = label.hjust, label.buffer = label.buffer, con.type = con.type, con.border = con.border, con.cap = con.cap, con.arrow = con.arrow, anchor.x = first_rows$xmin, anchor.y = first_rows$ymin ) } ) #' @rdname geom_mark_ellipse #' @export geom_mark_ellipse <- function(mapping = NULL, data = NULL, stat = 'identity', position = 'identity', expand = unit(5, 'mm'), radius = expand, n = 100, tol = 0.01, label.margin = margin(2, 2, 2, 2, 'mm'), label.width = NULL, label.minwidth = unit(50, 'mm'), label.hjust = 0, label.fontsize = 12, label.family = '', label.lineheight = 1, label.fontface = c('bold', 'plain'), label.fill = 'white', label.colour = 'black', label.buffer = unit(10, 'mm'), con.colour = 'black', con.size = 0.5, con.type = 'elbow', con.linetype = 1, con.border = 'one', con.cap = unit(3, 'mm'), con.arrow = NULL, ..., na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) { layer( data = data, mapping = mapping, stat = stat, geom = GeomMarkEllipse, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( na.rm = na.rm, expand = expand, radius = radius, n = n, tol = tol, label.margin = label.margin, label.width = label.width, label.minwidth = label.minwidth, label.fontsize = label.fontsize, label.family = label.family, label.lineheight = label.lineheight, label.fontface = label.fontface, label.hjust = label.hjust, label.fill = label.fill, label.colour = label.colour, label.buffer = label.buffer, con.colour = con.colour, con.size = con.size, con.type = con.type, con.linetype = con.linetype, con.border = con.border, con.cap = con.cap, con.arrow = con.arrow, ... ) ) } # Helpers ----------------------------------------------------------------- #' @importFrom grDevices chull ellipEncGrob <- function(x = c(0, 0.5, 1, 0.5), y = c(0.5, 1, 0.5, 0), id = NULL, id.lengths = NULL, expand = 0, radius = 0, n = 100, tol = 0.01, label = NULL, ghosts = NULL, default.units = 'npc', name = NULL, mark.gp = gpar(), label.gp = gpar(), desc.gp = gpar(), con.gp = gpar(), label.margin = margin(), label.width = NULL, label.minwidth = unit(50, 'mm'), label.hjust = 0, label.buffer = unit(10, 'mm'), con.type = 'elbow', con.border = 'one', con.cap = unit(3, 'mm'), con.arrow = NULL, anchor.x = NULL, anchor.y = NULL, vp = NULL) { if (is.null(id)) { if (is.null(id.lengths)) { id <- rep(1, length(x)) } else { id <- rep(seq_along(id.lengths), id.lengths) if (length(id) != length(x)) { cli::cli_abort('{.arg id.lengths} must sum up to the number of points') } } } include <- unlist(lapply(split(seq_along(x), id), function(i) { xi <- x[i] yi <- y[i] if (length(unique0(xi)) == 1) { return(i[c(which.min(yi), which.max(yi))]) } if (length(unique0(yi)) == 1) { return(i[c(which.min(xi), which.max(xi))]) } i[chull(xi, yi)] })) mark <- shapeGrob( x = x[include], y = y[include], id = id[include], id.lengths = NULL, expand = expand, radius = radius, default.units = default.units, name = name, gp = mark.gp, vp = vp ) if (!is.null(label)) { label <- lapply(seq_len(nrow(label)), function(i) { if (is.na(label$label[i] %||% NA) && is.na(label$description[i] %||% NA)) return(zeroGrob()) grob <- labelboxGrob(label$label[i], 0, 0, label$description[i], gp = subset_gp(label.gp, i), desc.gp = subset_gp(desc.gp, i), pad = label.margin, width = label.width, min.width = label.minwidth, hjust = label.hjust ) if (con.border == 'all') { con.gp <- subset_gp(con.gp, i) grob$children[[1]]$gp$col <- con.gp$col grob$children[[1]]$gp$lwd <- con.gp$lwd grob$children[[1]]$gp$lty <- con.gp$lty } grob }) labeldim <- lapply(label, function(l) { c( convertWidth(grobWidth(l), 'mm', TRUE), convertHeight(grobHeight(l), 'mm', TRUE) ) }) ghosts <- lapply(ghosts, unit, default.units) } else { labeldim <- NULL } if (!is.null(anchor.x) && !is.unit(anchor.x)) { anchor.x <- unit(anchor.x, default.units) } if (!is.null(anchor.y) && !is.unit(anchor.y)) { anchor.y <- unit(anchor.y, default.units) } gTree( mark = mark, n = n, tol = tol, label = label, labeldim = labeldim, buffer = label.buffer, ghosts = ghosts, con.gp = con.gp, con.type = con.type, con.cap = as_mm(con.cap, default.units), con.border = con.border, con.arrow = con.arrow, anchor.x = anchor.x, anchor.y = anchor.y, name = name, vp = vp, cl = 'ellip_enc' ) } #' @importFrom grid convertX convertY unit makeContent childNames addGrob #' setChildren gList #' @export makeContent.ellip_enc <- function(x) { mark <- x$mark x_new <- convertX(mark$x, 'mm', TRUE) y_new <- convertY(mark$y, 'mm', TRUE) ellipses <- enclose_ellip_points(round(x_new, 2), round(y_new, 2), mark$id, x$tol) ellipses$id <- seq_len(nrow(ellipses)) ellipses <- ellipses[rep(ellipses$id, each = x$n), ] points <- 2 * pi * (seq_len(x$n) - 1) / x$n x_tmp <- cos(points) * ellipses$a y_tmp <- sin(points) * ellipses$b ellipses$x <- ellipses$x0 + x_tmp * cos(ellipses$angle) - y_tmp * sin(ellipses$angle) ellipses$y <- ellipses$y0 + x_tmp * sin(ellipses$angle) + y_tmp * cos(ellipses$angle) ellipses <- unique0(ellipses) mark$x <- unit(ellipses$x, 'mm') mark$y <- unit(ellipses$y, 'mm') mark$id <- ellipses$id if (inherits(mark, 'shape')) mark <- makeContent(mark) if (!is.null(x$label)) { polygons <- Map(function(x, y) list(x = x, y = y), x = split(as.numeric(mark$x), mark$id), y = split(as.numeric(mark$y), mark$id) ) anchor_x <- if (is.null(x$anchor.x)) NULL else convertX(x$anchor.x, 'mm', TRUE) anchor_y <- if (is.null(x$anchor.y)) NULL else convertY(x$anchor.y, 'mm', TRUE) labels <- make_label( labels = x$label, dims = x$labeldim, polygons = polygons, ghosts = x$ghosts, buffer = x$buffer, con_type = x$con.type, con_border = x$con.border, con_cap = x$con.cap, con_gp = x$con.gp, anchor_mod = 2, anchor_x = anchor_x, anchor_y = anchor_y, arrow = x$con.arrow ) setChildren(x, inject(gList(!!!c(list(mark), labels)))) } else { setChildren(x, gList(mark)) } } ggforce/R/cpp11.R0000644000176200001440000000155614672274110013151 0ustar liggesusers# Generated by cpp11: do not edit by hand splinePath <- function(x, y, degree, knots, detail, type) { .Call(`_ggforce_splinePath`, x, y, degree, knots, detail, type) } getSplines <- function(x, y, id, detail, type) { .Call(`_ggforce_getSplines`, x, y, id, detail, type) } bezierPath <- function(x, y, detail) { .Call(`_ggforce_bezierPath`, x, y, detail) } getBeziers <- function(x, y, id, detail) { .Call(`_ggforce_getBeziers`, x, y, id, detail) } concaveman_c <- function(p, h, concavity, threshold) { .Call(`_ggforce_concaveman_c`, p, h, concavity, threshold) } enclose_ellip_points <- function(x, y, id, tol) { .Call(`_ggforce_enclose_ellip_points`, x, y, id, tol) } enclose_points <- function(x, y, id) { .Call(`_ggforce_enclose_points`, x, y, id) } points_to_path <- function(pos, path, close) { .Call(`_ggforce_points_to_path`, pos, path, close) } ggforce/R/facet_matrix.R0000644000176200001440000003122115024472120014654 0ustar liggesusers#' Facet by different data columns #' #' The `facet_matrix()` facet allows you to put different data columns into #' different rows and columns in a grid of panels. If the same data columns are #' present in both the rows and the columns of the grid, and used together with #' [ggplot2::geom_point()] it is also known as a scatterplot matrix, and if #' other geoms are used it is sometimes referred to as a pairs plot. #' `facet_matrix` is so flexible that these types are simply a subset of its #' capabilities, as any combination of data columns can be plotted against each #' other using any type of geom. Layers should use the `.panel_x` and `.panel_y` #' placeholders to map aesthetics to, in order to access the row and column #' data. #' #' @param rows,cols A specification of the data columns to put in the rows and #' columns of the facet grid. They are specified using the [ggplot2::vars()] #' function wherein you can use standard tidyselect syntax as known from e.g. #' `dplyr::select()`. These data values will be made available to the different #' layers through the `.panel_x` and `.panel_y` variables. #' @inheritParams ggplot2::facet_grid #' @param flip.rows Should the order of the rows be reversed so that, if the #' rows and columns are equal, the diagonal goes from bottom-left to top-right #' instead of top-left to bottom-right. #' @param alternate.axes Should axes be drawn at alternating positions. #' @param layer.lower,layer.diag,layer.upper Specification for where each layer #' should appear. The default (`NULL`) will allow any layer that has not been #' specified directly to appear at that position. Putting e.g. `layer.diag = 2` #' will make the second layer appear on the diagonal as well as remove that #' layer from any position that has `NULL`. Using `TRUE` will put all layers at #' that position, and using `FALSE` will conversely remove all layers. These #' settings will only have an effect if the grid is symmetric. #' @param layer.continuous,layer.discrete,layer.mixed As above, but instead of #' referencing panel positions it references the combination of position scales #' in the panel. Continuous panels have both a continuous x and y axis, discrete #' panels have both a discrete x and y axis, and mixed panels have one of each. #' Unlike the position based specifications above these also have an effect in #' non-symmetric grids. #' @param grid.y.diag Should the y grid be removed from the diagonal? In certain #' situations the diagonal are used to plot the distribution of the column data #' and will thus not use the y-scale. Removing the y gridlines can indicate #' this. #' #' @note Due to the special nature of this faceting it slightly breaks the #' ggplot2 API, in that any positional scale settings are ignored. This is #' because each row and column in the grid will potentially have very different #' scale types and it is not currently possible to have multiple different scale #' specifications in the same plot object. #' #' @seealso [geom_autopoint], [geom_autohistogram], [geom_autodensity], and #' [position_auto] for geoms and positions that adapts to different positional #' scale types #' #' @export #' #' @examples #' # Standard use: #' ggplot(mpg) + #' geom_point(aes(x = .panel_x, y = .panel_y)) + #' facet_matrix(vars(displ, cty, hwy)) #' #' # Switch the diagonal, alternate the axes and style strips as axis labels #' ggplot(mpg) + #' geom_point(aes(x = .panel_x, y = .panel_y)) + #' facet_matrix(vars(displ, cty, hwy), flip.rows = TRUE, #' alternate.axes = TRUE, switch = 'both') + #' theme(strip.background = element_blank(), #' strip.placement = 'outside', #' strip.text = element_text(size = 12)) #' #' # Mix discrete and continuous columns. Use geom_autopoint for scale-based jitter #' ggplot(mpg) + #' geom_autopoint() + #' facet_matrix(vars(drv:fl)) #' #' # Have a special diagonal layer #' ggplot(mpg) + #' geom_autopoint() + #' geom_autodensity() + #' facet_matrix(vars(drv:fl), layer.diag = 2) #' #' \donttest{ #' # Show continuous panels in upper triangle as contours and rest as binned #' ggplot(mpg) + #' geom_autopoint() + #' geom_autodensity() + #' geom_density2d(aes(x = .panel_x, y = .panel_y)) + #' geom_bin2d(aes(x = .panel_x, y = .panel_y)) + #' facet_matrix(vars(drv:fl), layer.lower = 1, layer.diag = 2, #' layer.continuous = -4, layer.discrete = -3, layer.mixed = -3) #' } #' #' # Make asymmetric grid #' ggplot(mpg) + #' geom_boxplot(aes(x = .panel_x, y = .panel_y, group = .panel_x)) + #' facet_matrix(rows = vars(cty, hwy), cols = vars(drv, fl)) #' facet_matrix <- function(rows, cols = rows, shrink = TRUE, switch = NULL, labeller = "label_value", flip.rows = FALSE, alternate.axes = FALSE, layer.lower = NULL, layer.diag = NULL, layer.upper = NULL, layer.continuous = NULL, layer.discrete = NULL, layer.mixed = NULL, grid.y.diag = TRUE) { if (!is_quosures(rows)) rows <- quos(rows) if (!is_quosures(cols)) cols <- quos(cols) labeller <- match.fun(labeller) ggproto(NULL, FacetMatrix, shrink = shrink, params = list(rows = quos(row_data = row_data), cols = quos(col_data = col_data), row_vars = rows, col_vars = cols, switch = switch, labeller = labeller, free = list(x = TRUE, y = TRUE), space_free = list(x = FALSE, y = FALSE), margins = FALSE, as.table = !flip.rows, drop = TRUE, labeller = label_value, alternate.axes = alternate.axes, layer.lower = layer.lower, layer.diag = layer.diag, layer.upper = layer.upper, layer.continuous = layer.continuous, layer.discrete = layer.discrete, layer.mixed = layer.mixed, grid.y.diag = grid.y.diag) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom tidyselect eval_select #' @export FacetMatrix <- ggproto('FacetMatrix', FacetGrid, setup_data = function(data, params) { lapply(seq_along(data), function(i) { d <- data[[i]] d$.layer_index <- i - 1 d }) }, setup_params = function(data, params) { rows <- lapply(data, function(d) { names(eval_select(quo(c(!!!params$row_vars)), d)) }) rows <- unique0(unlist(rows)) cols <- lapply(data, function(d) { names(eval_select(quo(c(!!!params$col_vars)), d)) }) cols <- unique0(unlist(cols)) if (length(rows) == 0 || length(cols) == 0) { cli::cli_abort('{.arg rows} and {.arg cols} must select valid data columns') } params$pairs <- all(rows == cols) if (!params$as.table) rows <- rev(rows) params$row_vars <- rows params$col_vars <- cols plot_env <- get('plot_env', caller_env(2)) # Horrible hack - don't judge params$row_scales <- create_pos_scales(rows, data, plot_env, 'y', params$alternate.axes) params$col_scales <- create_pos_scales(cols, data, plot_env, 'x', params$alternate.axes) check_layer_pos_params(params$pairs, params$lower, params$upper, params$diag) n_layers <- length(data) - 1 params$layer_pos <- assign_layers( n_layers, lower = params$layer.lower, diagonal = params$layer.diag, upper = params$layer.upper ) params$layer_type <- assign_layers( n_layers, continuous = params$layer.continuous, discrete = params$layer.discrete, mixed = params$layer.mixed ) params }, compute_layout = function(data, params) { layout <- expand.grid(col_data = params$col_vars, row_data = params$row_vars, stringsAsFactors = FALSE) layout$ROW <- match(layout$row_data, params$row_vars) layout$COL <- match(layout$col_data, params$col_vars) layout$PANEL <- factor(seq_len(nrow(layout))) layout$SCALE_X <- layout$COL layout$SCALE_Y <- layout$ROW if (params$pairs) { mat_ind <- matrix(seq_len(nrow(layout)), length(params$row_vars), length(params$col_vars), byrow = TRUE) if (!params$as.table) mat_ind <- mat_ind[rev(seq_along(params$row_vars)), ] layout$panel_pos <- 'lower' layout$panel_pos[diag(mat_ind)] <- 'diagonal' layout$panel_pos[mat_ind[upper.tri(mat_ind)]] <- 'upper' } layout }, map_data = function(data, layout, params) { layer_pos <- params$layer_pos[[data$.layer_index[1]]] layer_type <- params$layer_type[[data$.layer_index[1]]] data <- lapply(seq_len(nrow(layout)), function(i) { row <- layout$row_data[i] col <- layout$col_data[i] col_discrete <- params$col_scales[[layout$SCALE_X[i]]]$is_discrete() row_discrete <- params$row_scales[[layout$SCALE_Y[i]]]$is_discrete() panel_type <- c('continuous', 'mixed', 'discrete')[col_discrete + row_discrete + 1] placeholder <- cbind(data[0, ], PANEL = layout$PANEL[0], .panel_x = numeric(), .panel_y = numeric()) if (!all(c(row, col) %in% names(data))) return(placeholder) if (params$pairs && !layout$panel_pos[i] %in% layer_pos) return(placeholder) if (!panel_type %in% layer_type) return(placeholder) data$PANEL <- layout$PANEL[i] data$.panel_x <- params$col_scales[[col]]$map(data[[col]]) data$.panel_y <- params$row_scales[[row]]$map(data[[row]]) if (packageVersion('ggplot2') <= '3.3.6') { if (inherits(data$.panel_x, 'mapped_discrete')) { data$.panel_x <- unclass(data$.panel_x) } if (inherits(data$.panel_y, 'mapped_discrete')) { data$.panel_y <- unclass(data$.panel_y) } } data }) vec_rbind(!!!data) }, init_scales = function(layout, x_scale = NULL, y_scale = NULL, params) { scales <- list() if (!is.null(x_scale)) { scales$x <- params$col_scales } if (!is.null(y_scale)) { scales$y <- params$row_scales } scales }, draw_panels = function(self, panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { if (params$pairs && !params$grid.y.diag) { panels[layout$panel_pos == 'diagonal'] <- lapply( panels[layout$panel_pos == 'diagonal'], function(panel) { grill <- grep('^grill', names(panel$children)) y_grid <- grep('^panel\\.grid\\.(major\\.y)|(minor\\.y)', names(panel$children[[grill]]$children)) panel$children[[grill]]$children[y_grid] <- rep(list(zeroGrob()), length(y_grid)) panel } ) } ggproto_parent(FacetGrid, self)$draw_panels(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) } ) create_pos_scales <- function(vars, data, env, dim = 'x', alternate = FALSE) { positions <- if (dim == 'x') c('bottom', 'top') else c('left', 'right') scales <- lapply(seq_along(vars), function(i) { var <- vars[i] pos <- if (alternate) positions[((i - 1) %% 2) + 1] else positions[1] d <- lapply(data, .subset2, var) d <- d[lengths(d) != 0] type <- paste0('scale_', dim, '_', scale_type(d[[1]])) scales <- lapply(type, function(t) { if (exists(t, env, mode = 'function')) { scale <- get(t, env, mode = 'function') } else if (exists(t, asNamespace('ggplot2'), mode = 'function')) { scale <- get(t, asNamespace('ggplot2'), mode = 'function') } else if (exists(t, env, mode = 'function')) { scale <- get(t, env, mode = 'function') } else if (exists(t, asNamespace('ggforce'), mode = 'function')) { scale <- get(t, asNamespace('ggforce'), mode = 'function') } else { NULL } }) scales <- scales[lengths(scales) != 0] if (length(scales) == 0) { cli::cli_abort('Unable to pick a scale for {.col {var}}') } scale <- scales[[1]](name = NULL, position = pos) lapply(d, scale$train) scale }) names(scales) <- vars scales } assign_layers <- function(n_layers, ...) { specs <- list(...) layers <- seq_len(n_layers) specs <- lapply(specs, function(spec) { if (is.null(spec)) return(spec) if (is.logical(spec)) { if (spec) layers else integer() } else { layers[spec] } }) specified_layers <- sort(unique0(unlist(specs))) specified_layers <- layers %in% specified_layers specs <- lapply(specs, function(spec) { if (is.null(spec)) { layers[!specified_layers] } else { spec } }) split( unlist(lapply(names(specs), function(name) rep_along(specs[[name]], name))), factor(unlist(specs), levels = layers) ) } check_layer_pos_params <- function(pairs = TRUE, lower = NULL, upper = NULL, diag = NULL) { if (pairs) return() if (!all(is.null(lower), is.null(upper), is.null(diag))) { cli::cli_warn('layer positions are ignored when the matrix is not symmetrical') } } utils::globalVariables(c('.panel_x', '.panel_y', 'col_data', 'row_data')) ggforce/R/scale-depth.R0000644000176200001440000000252514672274110014413 0ustar liggesusers#' Scales for depth perception #' #' These scales serve to scale the depth aesthetic when creating stereographic #' plots. The range specifies the relative distance between the points and the #' paper plane in relation to the distance between the eyes and the paper plane #' i.e. a range of c(-0.5, 0.5) would put the highest values midways between #' the eyes and the image plane and the lowest values the same distance behind #' the image plane. To ensure a nice viewing experience these values should not #' exceed ~0.3 as it would get hard for the eyes to consolidate the two #' pictures. #' #' @param ... arguments passed on to continuous_scale or discrete_scale #' #' @param range The relative range as related to the distance between the eyes #' and the paper plane. #' #' @export #' @importFrom scales rescale_pal #' #' @examples #' ggplot(mtcars) + #' geom_point(aes(mpg, disp, depth = cyl)) + #' scale_depth(range = c(-0.1, 0.25)) + #' facet_stereo() scale_depth <- function(..., range = c(0, 0.3)) { continuous_scale('depth', 'depth_c', rescale_pal(range), ...) } #' @rdname scale_depth #' #' @export scale_depth_continuous <- scale_depth #' @rdname scale_depth #' #' @export scale_depth_discrete <- function(..., range = c(0, 0.3)) { discrete_scale( 'depth', 'depth_d', function(n) seq(range[1], range[2], length.out = n), ... ) } ggforce/R/utilities.R0000644000176200001440000002040014672274110014225 0ustar liggesusers# Wrapping vctrs data_frame constructor with no name repair data_frame0 <- function(...) data_frame(..., .name_repair = "minimal") # Wrapping unique0() to accept NULL unique0 <- function(x, ...) if (is.null(x)) x else vec_unique(x, ...) df_rows <- function(x, i) { cols <- lapply(x, `[`, i = i) data_frame0(!!!cols, .size = length(i)) } split_matrix <- function(x, col_names = colnames(x)) { force(col_names) x <- lapply(seq_len(ncol(x)), function(i) x[, i]) if (!is.null(col_names)) names(x) <- col_names x } # More performant modifyList without recursion modify_list <- function(old, new) { for (i in names(new)) old[[i]] <- new[[i]] old } empty <- function(df) { is.null(df) || nrow(df) == 0 || ncol(df) == 0 } # Adapted from plyr:::id_vars # Create a unique id for elements in a single vector id_var <- function(x, drop = FALSE) { if (length(x) == 0) { id <- integer() n = 0L } else if (!is.null(attr(x, "n")) && !drop) { return(x) } else if (is.factor(x) && !drop) { x <- addNA(x, ifany = TRUE) id <- as.integer(x) n <- length(levels(x)) } else { levels <- sort(unique0(x), na.last = TRUE) id <- match(x, levels) n <- max(id) } attr(id, "n") <- n id } #' Create an unique integer id for each unique row in a data.frame #' #' Properties: #' - `order(id)` is equivalent to `do.call(order, df)` #' - rows containing the same data have the same value #' - if `drop = FALSE` then room for all possibilites #' #' @param .variables list of variables #' @param drop Should unused factor levels be dropped? #' #' @return An integer vector with attribute `n` giving the total number of #' possible unique rows #' #' @keywords internal #' @noRd #' id <- function(.variables, drop = FALSE) { nrows <- NULL if (is.data.frame(.variables)) { nrows <- nrow(.variables) .variables <- unclass(.variables) } lengths <- lengths(.variables) .variables <- .variables[lengths != 0] if (length(.variables) == 0) { n <- nrows %||% 0L id <- seq_len(n) attr(id, "n") <- n return(id) } if (length(.variables) == 1) { return(id_var(.variables[[1]], drop = drop)) } ids <- rev(lapply(.variables, id_var, drop = drop)) p <- length(ids) ndistinct <- vapply(ids, attr, "n", FUN.VALUE = numeric(1), USE.NAMES = FALSE) n <- prod(ndistinct) if (n > 2^31) { char_id <- inject(paste(!!!ids, sep = "\r")) res <- match(char_id, unique0(char_id)) } else { combs <- c(1, cumprod(ndistinct[-p])) mat <- inject(cbind(!!!ids)) res <- c((mat - 1L) %*% combs + 1L) } if (drop) { id_var(res, drop = TRUE) } else { res <- as.integer(res) attr(res, "n") <- n res } } #' Apply function to unique subsets of a data.frame #' #' This function is akin to `plyr::ddply`. It takes a single data.frame, #' splits it by the unique combinations of the columns given in `by`, apply a #' function to each split, and then reassembles the results into a sigle #' data.frame again. #' #' @param df A data.frame #' @param by A character vector of column names to split by #' @param fun A function to apply to each split #' @param ... Further arguments to `fun` #' @param drop Should unused factor levels in the columns given in `by` be #' dropped. #' #' @return A data.frame if the result of `fun` does not include the columns #' given in `by` these will be prepended to the result. #' #' @keywords internal #' @importFrom stats setNames #' @noRd dapply <- function(df, by, fun, ..., drop = TRUE) { grouping_cols <- .subset(df, by) fallback_order <- unique0(c(by, names(df))) apply_fun <- function(x) { res <- fun(x, ...) if (is.null(res)) return(res) if (length(res) == 0) return(data_frame0()) vars <- lapply(setNames(by, by), function(col) .subset2(x, col)[1]) if (is.matrix(res)) res <- split_matrix(res) if (is.null(names(res))) names(res) <- paste0("V", seq_along(res)) if (all(by %in% names(res))) return(data_frame0(!!!unclass(res))) res <- modify_list(unclass(vars), unclass(res)) res <- res[intersect(c(fallback_order, names(res)), names(res))] data_frame0(!!!res) } # Shortcut when only one group if (all(vapply(grouping_cols, single_value, logical(1)))) { return(apply_fun(df)) } ids <- id(grouping_cols, drop = drop) group_rows <- split_with_index(seq_len(nrow(df)), ids) result <- lapply(seq_along(group_rows), function(i) { cur_data <- df_rows(df, group_rows[[i]]) apply_fun(cur_data) }) vec_rbind0(!!!result) } # Use chartr() for safety since toupper() fails to convert i to I in Turkish locale lower_ascii <- "abcdefghijklmnopqrstuvwxyz" upper_ascii <- "ABCDEFGHIJKLMNOPQRSTUVWXYZ" to_lower_ascii <- function(x) chartr(upper_ascii, lower_ascii, x) to_upper_ascii <- function(x) chartr(lower_ascii, upper_ascii, x) tolower <- function(x) { cli::cli_abort("Please use {.fn to_lower_ascii}, which works fine in all locales.") } toupper <- function(x) { cli::cli_abort("Please use {.fn to_upper_ascii}, which works fine in all locales.") } snakeize <- function(x) { x <- gsub("([A-Za-z])([A-Z])([a-z])", "\\1_\\2\\3", x) x <- gsub(".", "_", x, fixed = TRUE) x <- gsub("([a-z])([A-Z])", "\\1_\\2", x) to_lower_ascii(x) } snake_class <- function(x) { snakeize(class(x)[1]) } single_value <- function(x, ...) { UseMethod("single_value") } #' @export single_value.default <- function(x, ...) { # This is set by id() used in creating the grouping var identical(attr(x, "n"), 1L) } #' @export single_value.factor <- function(x, ...) { # Panels are encoded as factor numbers and can never be missing (NA) identical(levels(x), "1") } with_seed_null <- function(seed, code) { if (is.null(seed)) { code } else { withr::with_seed(seed, code) } } vec_rbind0 <- function(..., .error_call = current_env(), .call = caller_env()) { with_ordered_restart( vec_rbind(..., .error_call = .error_call), .call ) } with_ordered_restart <- function(expr, .call) { withCallingHandlers( expr, vctrs_error_incompatible_type = function(cnd) { x <- cnd[["x"]] y <- cnd[["y"]] class_x <- class(x)[1] class_y <- class(y)[1] restart <- FALSE if (is.ordered(x) || is.ordered(y)) { restart <- TRUE if (is.ordered(x)) { x <- factor(as.character(x), levels = levels(x)) } if (is.ordered(y)) { y <- factor(as.character(y), levels = levels(y)) } } else if (is.character(x) || is.character(y)) { restart <- TRUE if (is.character(x)) { y <- as.character(y) } else { x <- as.character(x) } } else if (is.factor(x) || is.factor(y)) { restart <- TRUE lev <- c() if (is.factor(x)) { lev <- c(lev, levels(x)) } if (is.factor(y)) { lev <- c(lev, levels(y)) } x <- factor(as.character(x), levels = unique(lev)) y <- factor(as.character(y), levels = unique(lev)) } # Don't recurse and let ptype2 error keep its course if (!restart) { return(zap()) } msg <- paste0("Combining variables of class <", class_x, "> and <", class_y, ">") desc <- paste0( "Please ensure your variables are compatible before plotting (location: ", format_error_call(.call), ")" ) deprecate_soft0( "3.4.0", I(msg), details = desc ) x_arg <- cnd[["x_arg"]] y_arg <- cnd[["y_arg"]] call <- cnd[["call"]] # Recurse with factor methods and restart with the result if (inherits(cnd, "vctrs_error_ptype2")) { out <- vec_ptype2(x, y, x_arg = x_arg, y_arg = y_arg, call = call) restart <- "vctrs_restart_ptype2" } else if (inherits(cnd, "vctrs_error_cast")) { out <- vec_cast(x, y, x_arg = x_arg, to_arg = y_arg, call = call) restart <- "vctrs_restart_cast" } else { return(zap()) } # Old-R compat for `tryInvokeRestart()` try_restart <- function(restart, ...) { if (!is_null(findRestart(restart))) { invokeRestart(restart, ...) } } try_restart(restart, out) } ) } deprecate_soft0 <- function(..., user_env = NULL) { user_env <- user_env %||% getOption("ggplot2_plot_env") %||% caller_env(2) lifecycle::deprecate_soft(..., user_env = user_env) } ggforce/R/regon.R0000644000176200001440000000617214672274110013336 0ustar liggesusers#' Draw regular polygons by specifying number of sides #' #' This geom makes it easy to construct regular polygons (polygons where all #' sides and angles are equal) by specifying the number of sides, position, and #' size. The polygons are always rotated so that they "rest" on a flat side, but #' this can be changed with the angle aesthetic. The size is based on the radius #' of their circumcircle and is thus not proportional to their area. #' #' @section Aesthetics: #' geom_regon understand the following aesthetics (required aesthetics are in #' bold): #' #' - **x0** x coordinate #' - **y0** y coordinate #' - **sides** the number of sides for regon #' - **r** the ratio of regon with respect to plot #' - **angle** regon rotation angle (unit is radian) #' - color #' - fill #' - size #' - linetype #' - alpha #' - lineend #' #' @section Computed variables: #' #' \describe{ #' \item{x, y}{The coordinates for the corners of the polygon} #' } #' #' @inheritParams ggplot2::geom_polygon #' @inheritParams ggplot2::stat_identity #' #' @name geom_regon #' @rdname geom_regon #' #' @examples #' ggplot() + #' geom_regon(aes(x0 = runif(8), y0 = runif(8), sides = sample(3:10, 8), #' angle = 0, r = runif(8) / 10)) + #' coord_fixed() #' #' # The polygons are drawn with geom_shape, so can be manipulated as such #' ggplot() + #' geom_regon(aes(x0 = runif(8), y0 = runif(8), sides = sample(3:10, 8), #' angle = 0, r = runif(8) / 10), #' expand = unit(1, 'cm'), radius = unit(1, 'cm')) + #' coord_fixed() NULL #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatRegon <- ggproto('StatRegon', Stat, compute_layer = function(self, data, params, panels) { if (empty_data(data)) return(data) pos <- unlist(lapply(data$sides, function(n) { p <- (seq_len(n) - 1) / n if (n %% 2 == 0) p <- p + p[2] / 2 p * 2 * pi })) data$group <- make_unique(data$group) data <- data[rep(seq_len(nrow(data)), data$sides), ] x_tmp <- sin(pos) * data$r y_tmp <- cos(pos) * data$r data$x <- data$x0 + x_tmp * cos(data$angle) - y_tmp * sin(data$angle) data$y <- data$y0 + x_tmp * sin(data$angle) + y_tmp * cos(data$angle) data }, required_aes = c('x0', 'y0', 'sides', 'angle', 'r'), extra_params = c('na.rm') ) #' @rdname geom_regon #' @export stat_regon <- function(mapping = NULL, data = NULL, geom = 'shape', position = 'identity', na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( stat = StatRegon, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, ...) ) } #' @rdname geom_regon #' @export geom_regon <- function(mapping = NULL, data = NULL, stat = 'regon', position = 'identity', na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomShape, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, ...) ) } ggforce/R/zzz.R0000644000176200001440000000265615024477421013066 0ustar liggesusersglobalVariables(c( "from_theme", "colour", "ink", "linewidth", "linetype" )) default_axis_guide <- NULL .onLoad <- function(...) { if (utils::packageVersion("ggplot2") > "3.2.1") { default_axis_guide <<- ggplot2::waiver() } else { default_axis_guide <<- "none" } if ("element_geom" %in% getNamespaceExports("ggplot2")) { ggplot2::update_geom_defaults(GeomArc0, ggplot2::aes(colour = from_theme(colour %||% ink), linewidth = from_theme(linewidth), linetype = from_theme(linetype))) ggplot2::update_geom_defaults(GeomArcBar, ggplot2::aes(colour = from_theme(colour %||% ink))) ggplot2::update_geom_defaults(GeomCircle, ggplot2::aes(colour = from_theme(colour %||% ink))) ggplot2::update_geom_defaults(GeomMarkCircle, ggplot2::aes(colour = from_theme(colour %||% ink))) ggplot2::update_geom_defaults(GeomMarkEllipse, ggplot2::aes(colour = from_theme(colour %||% ink))) ggplot2::update_geom_defaults(GeomMarkHull, ggplot2::aes(colour = from_theme(colour %||% ink))) ggplot2::update_geom_defaults(GeomMarkRect, ggplot2::aes(colour = from_theme(colour %||% ink))) } ggplot2::register_theme_elements( zoom = element_rect(), zoom.x = element_rect(), zoom.y = element_rect(), element_tree = list( zoom = ggplot2::el_def('element_rect', 'strip.background'), zoom.x = ggplot2::el_def('element_rect', 'zoom'), zoom.y = ggplot2::el_def('element_rect', 'zoom') ) ) } ggforce/R/diagonal_wide.R0000644000176200001440000001004614672274110015005 0ustar liggesusers#' Draw an area defined by an upper and lower diagonal #' #' The `geom_diagonal_wide()` function draws a *thick* diagonal, that is, a #' polygon confined between a lower and upper [diagonal][geom_diagonal]. This #' geom is bidirectional and the direction can be controlled with the #' `orientation` argument. #' #' @section Aesthetics: #' geom_diagonal_wide understand the following aesthetics #' (required aesthetics are in bold): #' #' - **x** #' - **y** #' - **group** #' - color #' - linewidth #' - linetype #' - alpha #' - lineend #' #' @inheritParams geom_shape #' @inheritParams ggplot2::stat_identity #' @inheritParams ggplot2::geom_line #' #' @param n The number of points to create for each of the bounding diagonals #' #' @param strength The proportion to move the control point along the x-axis #' towards the other end of the bezier curve #' #' @inheritSection ggplot2::geom_line Orientation #' #' @name geom_diagonal_wide #' @rdname geom_diagonal_wide #' #' @examples #' data <- data.frame( #' x = c(1, 2, 2, 1, 2, 3, 3, 2), #' y = c(1, 2, 3, 2, 3, 1, 2, 5), #' group = c(1, 1, 1, 1, 2, 2, 2, 2) #' ) #' #' ggplot(data) + #' geom_diagonal_wide(aes(x, y, group = group)) #' #' # The strength control the steepness #' ggplot(data, aes(x, y, group = group)) + #' geom_diagonal_wide(strength = 0.75, alpha = 0.5, fill = 'red') + #' geom_diagonal_wide(strength = 0.25, alpha = 0.5, fill = 'blue') #' #' # The diagonal_wide geom uses geom_shape under the hood, so corner rounding #' # etc are all there #' ggplot(data) + #' geom_diagonal_wide(aes(x, y, group = group), radius = unit(5, 'mm')) #' NULL #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatDiagonalWide <- ggproto('StatDiagonalWide', Stat, setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) params }, setup_data = function(data, params) { data$flipped_aes <- params$flipped_aes if (any(table(data$group) != 4)) { cli::cli_abort('Each group must consist of 4 points') } data }, compute_panel = function(data, scales, strength = 0.5, n = 100, flipped_aes = FALSE) { data <- flip_data(data, flipped_aes) data <- data[order(data$group, data$x, data$y), ] lower <- data[rep_len(c(TRUE, FALSE, TRUE, FALSE), nrow(data)), ] upper <- data[rep_len(c(FALSE, TRUE, FALSE, TRUE), nrow(data)), ] lower <- add_controls(lower, strength) upper <- add_controls(upper[rev(seq_len(nrow(upper))), ], strength) lower <- StatBezier$compute_panel(lower, scales, n) upper <- StatBezier$compute_panel(upper, scales, n) diagonals <- vec_rbind(lower, upper) diagonals$index <- NULL diagonals <- diagonals[order(diagonals$group), ] flip_data(diagonals, flipped_aes) }, required_aes = c('x', 'y', 'group'), extra_params = c('na.rm', 'n', 'strength', 'orientation') ) #' @rdname geom_diagonal_wide #' @export stat_diagonal_wide <- function(mapping = NULL, data = NULL, geom = 'shape', position = 'identity', n = 100, strength = 0.5, na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, ...) { layer( stat = StatDiagonalWide, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, orientation = orientation, n = n, strength = strength, ...) ) } #' @rdname geom_diagonal_wide #' @export geom_diagonal_wide <- function(mapping = NULL, data = NULL, stat = 'diagonal_wide', position = 'identity', n = 100, na.rm = FALSE, orientation = NA, strength = 0.5, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomShape, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, orientation = orientation, n = n, strength = strength, ...) ) } ggforce/R/shape.R0000644000176200001440000002243115024471216013316 0ustar liggesusers#' Draw polygons with expansion/contraction and/or rounded corners #' #' This geom is a cousin of [ggplot2::geom_polygon()] with the added #' possibility of expanding or contracting the polygon by an absolute amount #' (e.g. 1 cm). Furthermore, it is possible to round the corners of the polygon, #' again by an absolute amount. The resulting geom reacts to resizing of the #' plot, so the expansion/contraction and corner radius will not get distorted. #' If no expansion/contraction or corner radius is specified, the geom falls #' back to `geom_polygon` so there is no performance penality in using this #' instead of `geom_polygon`. #' #' @note Some settings can result in the dissappearance of polygons, #' specifically when contracting or rounding corners with a relatively large #' amount. Also note that x and y scale limits does not take expansion into #' account and the resulting polygon might thus not fit into the plot. #' #' @section Aesthetics: #' geom_shape understand the following aesthetics (required aesthetics are in #' bold): #' #' - **x** #' - **y** #' - color #' - fill #' - group #' - size #' - linetype #' - alpha #' #' @inheritParams ggplot2::geom_polygon #' #' @param expand A numeric or unit vector of length one, specifying the #' expansion amount. Negative values will result in contraction instead. If the #' value is given as a numeric it will be understood as a proportion of the #' plot area width. #' #' @param radius As `expand` but specifying the corner radius. #' #' @author Thomas Lin Pedersen #' #' @name geom_shape #' @rdname geom_shape #' #' @examples #' shape <- data.frame( #' x = c(0.5, 1, 0.75, 0.25, 0), #' y = c(0, 0.5, 1, 0.75, 0.25) #' ) #' # Expand and round #' ggplot(shape, aes(x = x, y = y)) + #' geom_shape(expand = unit(1, 'cm'), radius = unit(0.5, 'cm')) + #' geom_polygon(fill = 'red') #' #' # Contract #' ggplot(shape, aes(x = x, y = y)) + #' geom_polygon(fill = 'red') + #' geom_shape(expand = unit(-1, 'cm')) #' #' # Only round corners #' ggplot(shape, aes(x = x, y = y)) + #' geom_polygon(fill = 'red') + #' geom_shape(radius = unit(1, 'cm')) NULL #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export GeomShape <- ggproto('GeomShape', GeomPolygon, draw_panel = function(data, panel_params, coord, expand = 0, radius = 0) { n <- nrow(data) if (n == 1 && expand == 0) { return(zeroGrob()) } munched <- coord_munch(coord, data, panel_params) munched <- munched[order(munched$group), ] if (!is.integer(munched$group)) { munched$group <- match(munched$group, unique0(munched$group)) } # For gpar(), there is one entry per polygon (not one entry per point). # We'll pull the first value from each group, and assume all these values # are the same within each group. first_idx <- !duplicated(munched$group) first_rows <- munched[first_idx, ] shapeGrob(munched$x, munched$y, default.units = 'native', id = munched$group, expand = expand, radius = radius, gp = gpar( col = first_rows$colour, fill = ggplot2::fill_alpha(first_rows$fill, first_rows$alpha), lwd = (first_rows$linewidth %||% first_rows$size) * .pt, lty = first_rows$linetype ) ) }, extra_params = c('expand', 'radius') ) #' @rdname geom_shape #' @export geom_shape <- function(mapping = NULL, data = NULL, stat = 'identity', position = 'identity', expand = 0, radius = 0, ..., na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) { layer( data = data, mapping = mapping, stat = stat, geom = GeomShape, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( na.rm = na.rm, expand = expand, radius = radius, ... ) ) } #' The grob powering geom_shape #' #' This is the underlying grob constructor for [geom_shape()]. It is exported #' for others to use but with limited support #' #' @inheritParams grid::polygonGrob #' @param expand An expansion size to expand each shape with, given in units #' or a numeric refering to `default.units` #' @param radius The corner radius to apply to each shape, given in units #' or a numeric refering to `default.units` #' #' @return A grob of class `shape` or, of `expand` and `radius` are `0` a #' regular polygon grob #' #' @keywords internal #' #' @export #' @importFrom grid is.unit grob shapeGrob <- function(x = c(0, 0.5, 1, 0.5), y = c(0.5, 1, 0.5, 0), id = NULL, id.lengths = NULL, expand = 0, radius = 0, default.units = 'npc', name = NULL, gp = gpar(), vp = NULL) { if (as.numeric(expand) == 0 && as.numeric(radius) == 0) { grob <- polygonGrob( x = x, y = y, id = id, id.lengths = id.lengths, default.units = default.units, name = name, gp = gp, vp = vp ) return(grob) } if (!is.unit(x)) { x <- unit(x, default.units) } if (!is.unit(y)) { y <- unit(y, default.units) } if (!is.unit(expand)) { expand <- unit(expand, default.units) } if (!is.unit(radius)) { radius <- unit(radius, default.units) } if (as.numeric(radius) < 0) { cli::cli_abort('{.arg radius} must be positive') } if (is.null(id)) { if (is.null(id.lengths)) { id <- rep(1, length(x)) } else { id <- rep(seq_along(id.lengths), id.lengths) if (length(id) != length(x)) { cli::cli_abort('{.arg id.lengths} must sum up to the number of points', call. = FALSE) } } } x <- x[order(id)] y <- y[order(id)] grob( x = x, y = y, id = id, expand = expand, radius = radius, name = name, gp = gp, vp = vp, cl = 'shape' ) } #' @importFrom grid convertX convertY convertWidth #' @importFrom polyclip polyoffset polylineoffset #' @export makeContent.shape <- function(x) { id.length <- lengths(split(seq_along(x$id), x$id)) type <- ifelse(id.length == 1, 'point', ifelse(id.length == 2, 'line', 'polygon')) x_new <- convertX(x$x, 'mm', TRUE) x_new <- split(x_new, x$id) y_new <- convertY(x$y, 'mm', TRUE) y_new <- split(y_new, x$id) polygons <- Map(list, x = x_new, y = y_new) poly <- split(polygons, type) expand <- convertWidth(x$expand, 'mm', TRUE) radius <- convertWidth(x$radius, 'mm', TRUE) expand <- expand - radius if (expand != 0) { if (!is.null(poly$polygon)) { poly$polygon <- lapply(poly$polygon, polyoffset, delta = expand, jointype = 'miter', miterlim = 1000) } if (expand > 0) { if (!is.null(poly$line)) { poly$line <- lapply(poly$line, polylineoffset, delta = expand, jointype = 'square', endtype = 'opensquare') } poly$point <- pointoffset(poly$point, expand, type = 'square') } } if (radius != 0) { if (!is.null(poly$polygon)) { not_empty <- lengths(poly$polygon) != 0 poly$polygon[not_empty] <- lapply(poly$polygon[not_empty], polyoffset, delta = radius, jointype = 'round') } if (expand > 0) { if (!is.null(poly$line)) { not_empty <- lengths(poly$line) != 0 poly$line[not_empty] <- lapply(poly$line[not_empty], polyoffset, delta = radius, jointype = 'round') } if (!is.null(poly$point)) { not_empty <- lengths(poly$point) != 0 poly$point[not_empty] <- lapply(poly$point[not_empty], polyoffset, delta = radius, jointype = 'round') } } else { if (!is.null(poly$line)) { poly$line <- lapply(poly$line, polylineoffset, delta = radius, jointype = 'round', endtype = 'openround') } poly$point <- pointoffset(poly$point, radius, type = 'circle') } } polygons[type == 'polygon'] <- lapply(poly$polygon, function(d) if (length(d) == 0) list() else d[[1]]) polygons[type == 'line'] <- lapply(poly$line, function(d) if (length(d) == 0) list() else d[[1]]) polygons[type == 'point'] <- lapply(poly$point, function(d) if (length(d) == 0) list() else d[[1]]) x$id <- rep(seq_along(polygons), sapply(polygons, function(p) length(p$x))) x_new <- unlist(lapply(polygons, `[[`, 'x')) y_new <- unlist(lapply(polygons, `[[`, 'y')) if (length(x_new) == 0) return(nullGrob()) x$x <- unit(x_new, 'mm') x$y <- unit(y_new, 'mm') x$cl <- 'polygon' class(x)[1] <- 'polygon' x } pointoffset <- function(A, delta, type) { if (length(A) == 0) return(A) switch( type, square = { square <- list(x = c(-delta, -delta, delta, delta), y = c(-delta, delta, delta, -delta)) x <- split(rep(sapply(A, `[[`, 'x'), each = 4) + square$x, rep(seq_along(A), each = 4)) y <- split(rep(sapply(A, `[[`, 'y'), each = 4) + square$y, rep(seq_along(A), each = 4)) lapply(Map(list, x = x, y = y), list) }, circle = { detail <- 100 radi <- seq(0, 2 * pi, length.out = detail + 1)[-(detail + 1)] circle <- list(x = cos(radi) * delta, y = sin(radi) * delta) x <- split(rep(sapply(A, `[[`, 'x'), each = detail) + circle$x, rep(seq_along(A), each = detail)) y <- split(rep(sapply(A, `[[`, 'y'), each = detail) + circle$y, rep(seq_along(A), each = detail)) lapply(Map(list, x = x, y = y), list) } ) } ggforce/R/bspline.R0000644000176200001440000002251514672274110013657 0ustar liggesusers#' B-splines based on control points #' #' This set of stats and geoms makes it possible to draw b-splines based on a #' set of control points. As with [geom_bezier()] there exists several #' versions each having there own strengths. The base version calculates the #' b-spline as a number of points along the spline and connects these with a #' path. The *2 version does the same but in addition interpolates aesthetics #' between each control point. This makes the *2 version considerably slower #' so it shouldn't be used unless needed. The *0 version uses #' [grid::xsplineGrob()] with `shape = 1` to approximate a b-spline. #' #' @section Aesthetics: #' geom_bspline understand the following aesthetics (required aesthetics are in #' bold): #' #' - **x** #' - **y** #' - color #' - linewidth #' - linetype #' - alpha #' - lineend #' #' #' @section Computed variables: #' #' \describe{ #' \item{x, y}{The coordinates for the path describing the spline} #' \item{index}{The progression along the interpolation mapped between 0 and 1} #' } #' #' @inheritParams ggplot2::geom_path #' @inheritParams ggplot2::stat_identity #' #' @param n The number of points generated for each spline #' @param type Either `'clamped'` (default) or `'open'`. The former creates a #' knot sequence that ensures the splines starts and ends at the terminal #' control points. #' #' @author Thomas Lin Pedersen. The C++ code for De Boor's algorithm has been #' adapted from #' \href{https://chi3x10.wordpress.com/2009/10/18/de-boor-algorithm-in-c/}{Jason Yu-Tseh Chi implementation} #' #' @name geom_bspline #' @rdname geom_bspline #' #' @examples #' # Define some control points #' cp <- data.frame( #' x = c( #' 0, -5, -5, 5, 5, 2.5, 5, 7.5, 5, 2.5, 5, 7.5, 5, -2.5, -5, -7.5, -5, #' -2.5, -5, -7.5, -5 #' ), #' y = c( #' 0, -5, 5, -5, 5, 5, 7.5, 5, 2.5, -5, -7.5, -5, -2.5, 5, 7.5, 5, 2.5, #' -5, -7.5, -5, -2.5 #' ), #' class = sample(letters[1:3], 21, replace = TRUE) #' ) #' #' # Now create some paths between them #' paths <- data.frame( #' ind = c( #' 7, 5, 8, 8, 5, 9, 9, 5, 6, 6, 5, 7, 7, 5, 1, 3, 15, 8, 5, 1, 3, 17, 9, 5, #' 1, 2, 19, 6, 5, 1, 4, 12, 7, 5, 1, 4, 10, 6, 5, 1, 2, 20 #' ), #' group = c( #' 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 7, 7, #' 7, 7, 7, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10 #' ) #' ) #' paths$x <- cp$x[paths$ind] #' paths$y <- cp$y[paths$ind] #' paths$class <- cp$class[paths$ind] #' #' ggplot(paths) + #' geom_bspline(aes(x = x, y = y, group = group, colour = after_stat(index))) + #' geom_point(aes(x = x, y = y), data = cp, color = 'steelblue') #' #' ggplot(paths) + #' geom_bspline2(aes(x = x, y = y, group = group, colour = class)) + #' geom_point(aes(x = x, y = y), data = cp, color = 'steelblue') #' #' ggplot(paths) + #' geom_bspline0(aes(x = x, y = y, group = group)) + #' geom_point(aes(x = x, y = y), data = cp, color = 'steelblue') #' NULL #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatBspline <- ggproto('StatBspline', Stat, compute_layer = function(self, data, params, panels) { if (empty_data(data)) return(data) data <- data[order(data$group), ] groups <- unique0(data$group) paths <- getSplines(data$x, data$y, match(data$group, groups), params$n, params$type %||% 'clamped') paths <- data_frame0( x = paths$paths[, 1], y = paths$paths[, 2], group = groups[paths$pathID] ) paths$index <- rep( seq(0, 1, length.out = params$n), length(unique0(data$group)) ) dataIndex <- rep(match(unique0(data$group), data$group), each = params$n) cbind( paths, data[dataIndex, !names(data) %in% c('x', 'y', 'group'), drop = FALSE] ) }, required_aes = c('x', 'y'), extra_params = c('na.rm', 'n', 'type') ) #' @rdname geom_bspline #' @export stat_bspline <- function(mapping = NULL, data = NULL, geom = 'path', position = 'identity', na.rm = FALSE, n = 100, type = 'clamped', show.legend = NA, inherit.aes = TRUE, ...) { layer( stat = StatBspline, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, n = n, type = type, ...) ) } #' @rdname geom_bspline #' @export geom_bspline <- function(mapping = NULL, data = NULL, stat = 'bspline', position = 'identity', arrow = NULL, n = 100, type = 'clamped', lineend = 'butt', na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomPath, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( arrow = arrow, lineend = lineend, na.rm = na.rm, n = n, type = type, ... ) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatBspline2 <- ggproto('StatBspline2', Stat, compute_layer = function(self, data, params, panels) { if (empty_data(data)) return(data) data <- data[order(data$group), ] nControls <- table(data$group) groups <- unique0(data$group) paths <- getSplines(data$x, data$y, match(data$group, groups), params$n, params$type %||% 'clamped') paths <- data_frame0( x = paths$paths[, 1], y = paths$paths[, 2], group = groups[paths$pathID] ) paths$index <- rep( seq(0, 1, length.out = params$n), length(unique0(data$group)) ) dataIndex <- rep(match(unique0(data$group), data$group), each = params$n) paths <- cbind(paths, data[dataIndex, 'PANEL', drop = FALSE]) extraCols <- !names(data) %in% c('x', 'y', 'group', 'PANEL') pathIndex <- match(unique0(data$group), paths$group) pathIndex <- unlist(Map(seq, from = pathIndex, length.out = nControls)) paths$.interp <- TRUE paths$.interp[pathIndex] <- FALSE if (any(extraCols)) { for (i in names(data)[extraCols]) { paths[[i]] <- data[[i]][1] paths[[i]][pathIndex] <- data[, i] } } paths }, required_aes = c('x', 'y'), extra_params = c('na.rm', 'n', 'type') ) #' @rdname geom_bspline #' @export stat_bspline2 <- function(mapping = NULL, data = NULL, geom = 'path_interpolate', position = 'identity', na.rm = FALSE, n = 100, type = 'clamped', show.legend = NA, inherit.aes = TRUE, ...) { layer( stat = StatBspline2, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, n = n, type = type, ...) ) } #' @rdname geom_bspline #' @export geom_bspline2 <- function(mapping = NULL, data = NULL, stat = 'bspline2', position = 'identity', arrow = NULL, n = 100, type = 'clamped', lineend = 'butt', na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomPathInterpolate, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( arrow = arrow, lineend = lineend, na.rm = na.rm, n = n, type = type, ... ) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom grid xsplineGrob gpar #' @export GeomBspline0 <- ggproto('GeomBspline0', GeomPath, draw_panel = function(data, panel_scales, coord, arrow = NULL, type = 'clamped', lineend = 'butt', linejoin = 'round', linemitre = 1, na.rm = FALSE) { coords <- coord$transform(data, panel_scales) if (!is.integer(coords$group)) { coords$group <- match(coords$group, unique0(coords$group)) } startPoint <- match(unique0(coords$group), coords$group) xsplineGrob(coords$x, coords$y, id = coords$group, default.units = 'native', shape = 1, arrow = arrow, repEnds = type == 'clamped', gp = gpar( col = alpha(coords$colour[startPoint], coords$alpha[startPoint]), lwd = (coords$linewidth[startPoint] %||% coords$size[startPoint]) * .pt, lty = coords$linetype[startPoint], lineend = lineend, linejoin = linejoin, linemitre = linemitre ) ) } ) #' @rdname geom_bspline #' @export stat_bspline0 <- function(mapping = NULL, data = NULL, geom = 'bspline0', position = 'identity', na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, type = 'clamped', ...) { layer( stat = StatIdentity, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, type = type, ...) ) } #' @rdname geom_bspline #' @export geom_bspline0 <- function(mapping = NULL, data = NULL, stat = 'identity', position = 'identity', arrow = NULL, lineend = 'butt', na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, type = 'clamped', ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomBspline0, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( arrow = arrow, lineend = lineend, na.rm = na.rm, type = type, ... ) ) } ggforce/R/facet_grid_paginate.R0000644000176200001440000000745014672274110016163 0ustar liggesusers#' Split facet_grid over multiple plots #' #' This extension to [ggplot2::facet_grid()] will allow you to split #' a facetted plot over multiple pages. You define a number of rows and columns #' per page as well as the page number to plot, and the function will #' automatically only plot the correct panels. Usually this will be put in a #' loop to render all pages one by one. #' #' @inheritParams ggplot2::facet_grid #' @param ncol Number of columns per page #' @param nrow Number of rows per page #' @param page The page to draw #' @param byrow Should the pages be created row-wise or column wise #' #' @note If either `ncol` or `nrow` is `NULL` this function will #' fall back to the standard `facet_grid` functionality. #' #' @family ggforce facets #' @seealso [n_pages()] to compute the total number of pages in a paginated #' faceted plot #' #' @export #' #' @examples #' # Draw a small section of the grid #' ggplot(diamonds) + #' geom_point(aes(carat, price), alpha = 0.1) + #' facet_grid_paginate(color ~ cut:clarity, ncol = 3, nrow = 3, page = 4) facet_grid_paginate <- function(facets, margins = FALSE, scales = 'fixed', space = 'fixed', shrink = TRUE, labeller = 'label_value', as.table = TRUE, switch = NULL, drop = TRUE, ncol = NULL, nrow = NULL, page = 1, byrow = TRUE) { facet <- facet_grid(facets, margins = margins, scales = scales, space = space, shrink = shrink, labeller = labeller, as.table = as.table, switch = switch, drop = drop ) if (is.null(nrow) || is.null(ncol)) { facet } else { ggproto(NULL, FacetGridPaginate, shrink = shrink, params = c( facet$params, list(ncol = ncol, nrow = nrow, page = page, byrow = byrow) ) ) } } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom gtable gtable_add_rows gtable_add_cols #' @export FacetGridPaginate <- ggproto('FacetGridPaginate', FacetGrid, compute_layout = function(data, params) { layout <- FacetGrid$compute_layout(data, params) row_bin <- ceiling(layout$ROW / params$nrow) col_bin <- ceiling(layout$COL / params$ncol) bin_layout <- matrix(seq_len(max(row_bin) * max(col_bin)), nrow = max(row_bin), byrow = params$byrow ) layout$page <- bin_layout[(col_bin - 1) * nrow(bin_layout) + row_bin] layout }, draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { include <- which(layout$page == params$page) panels <- panels[include] ranges <- ranges[include] layout <- layout[include, , drop = FALSE] layout$ROW <- layout$ROW - min(layout$ROW) + 1 layout$COL <- layout$COL - min(layout$COL) + 1 layout$PANEL <- 1:dim(layout)[1] x_scale_ind <- unique0(layout$SCALE_X) x_scales <- x_scales[x_scale_ind] layout$SCALE_X <- match(layout$SCALE_X, x_scale_ind) y_scale_ind <- unique0(layout$SCALE_Y) y_scales <- y_scales[y_scale_ind] layout$SCALE_Y <- match(layout$SCALE_Y, y_scale_ind) table <- FacetGrid$draw_panels(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) if (max(layout$ROW) != params$nrow) { spacing <- theme$panel.spacing.y %||% theme$panel.spacing missing_rows <- params$nrow - max(layout$ROW) table <- gtable_add_rows(table, unit(missing_rows, 'null')) table <- gtable_add_rows(table, spacing * missing_rows) } if (max(layout$COL) != params$ncol) { spacing <- theme$panel.spacing.x %||% theme$panel.spacing missing_cols <- params$ncol - max(layout$COL) table <- gtable_add_cols(table, unit(missing_cols, 'null')) table <- gtable_add_cols(table, spacing * missing_cols) } table } ) ggforce/R/voronoi.R0000644000176200001440000006074514672274110013725 0ustar liggesusers#' @include shape.R NULL #' Voronoi tesselation and delaunay triangulation #' #' This set of geoms and stats allows you to display voronoi tesselation and #' delaunay triangulation, both as polygons and as line segments. Furthermore #' it lets you augment your point data with related summary statistics. The #' computations are based on the [deldir::deldir()] package. #' #' @section Aesthetics: #' geom_voronoi_tile and geom_delaunay_tile understand the following aesthetics #' (required aesthetics are in bold): #' #' - **x** #' - **y** #' - alpha #' - color #' - fill #' - linetype #' - size #' #' geom_voronoi_segment, geom_delaunay_segment, and geom_delaunay_segment2 #' understand the following aesthetics (required aesthetics are in bold): #' #' - **x** #' - **y** #' - alpha #' - color #' - linetype #' - size #' #' @section Computed variables: #' stat_delvor_summary computes the following variables: #' \describe{ #' \item{x, y}{If `switch.centroid = TRUE` this will be the coordinates for #' the voronoi tile centroid, otherwise it is the original point} #' \item{xcent, ycent}{If `switch.centroid = FALSE` this will be the #' coordinates for the voronoi tile centroid, otherwise it will be `NULL`} #' \item{xorig, yorig}{If `switch.centroid = TRUE` this will be the #' coordinates for the original point, otherwise it will be `NULL`} #' \item{ntri}{Number of triangles emanating from the point} #' \item{triarea}{The total area of triangles emanating from the point divided #' by 3} #' \item{triprop}{`triarea` divided by the sum of the area of all #' triangles} #' \item{nsides}{Number of sides on the voronoi tile associated with the point} #' \item{nedges}{Number of sides of the associated voronoi tile that is part of #' the bounding box} #' \item{vorarea}{The area of the voronoi tile associated with the point} #' \item{vorprop}{`vorarea` divided by the sum of all voronoi tiles} #' } #' #' @inheritParams ggplot2::geom_polygon #' @inheritParams ggplot2::geom_segment #' @inheritParams ggplot2::stat_identity #' @inheritParams geom_link #' #' @param bound The bounding rectangle for the tesselation or a custom polygon #' to clip the tesselation to. Defaults to `NULL` which creates a rectangle #' expanded 10\% in all directions. If supplied as a bounding box it should be a #' vector giving the bounds in the following order: xmin, xmax, ymin, ymax. If #' supplied as a polygon it should either be a 2-column matrix or a data.frame #' containing an `x` and `y` column. #' #' @param eps A value of epsilon used in testing whether a quantity is zero, #' mainly in the context of whether points are collinear. If anomalous errors #' arise, it is possible that these may averted by adjusting the value of eps #' upward or downward. #' #' @param max.radius The maximum distance a tile can extend from the point of #' origin. Will in effect clip each tile to a circle centered at the point with #' the given radius. If `normalize = TRUE` the radius will be given relative to #' the normalized values #' #' @param normalize Should coordinates be normalized prior to calculations. If #' `x` and `y` are in wildly different ranges it can lead to #' tesselation and triangulation that seems off when plotted without #' [ggplot2::coord_fixed()]. Normalization of coordinates solves this. #' The coordinates are transformed back after calculations. #' #' @param asp.ratio If `normalize = TRUE` the x values will be multiplied by this #' amount after normalization. #' #' @name geom_voronoi #' @aliases geom_delaunay #' @rdname geom_delvor #' #' @examplesIf requireNamespace("deldir", quietly = TRUE) #' # Voronoi #' # You usually wants all points to take part in the same tesselation so set #' # the group aesthetic to a constant (-1L is just a convention) #' ggplot(iris, aes(Sepal.Length, Sepal.Width, group = -1L)) + #' geom_voronoi_tile(aes(fill = Species)) + #' geom_voronoi_segment() + #' geom_text(aes(label = after_stat(nsides), size = after_stat(vorarea)), #' stat = 'delvor_summary', switch.centroid = TRUE #' ) #' #' # Difference of normalize = TRUE (segment layer is calculated without #' # normalisation) #' ggplot(iris, aes(Sepal.Length, Sepal.Width, group = -1L)) + #' geom_voronoi_tile(aes(fill = Species), normalize = TRUE) + #' geom_voronoi_segment() #' #' # Set a max radius #' ggplot(iris, aes(Sepal.Length, Sepal.Width, group = -1L)) + #' geom_voronoi_tile(aes(fill = Species), colour = 'black', max.radius = 0.25) #' #' # Set custom bounding polygon #' triangle <- cbind(c(3, 9, 6), c(1, 1, 6)) #' ggplot(iris, aes(Sepal.Length, Sepal.Width, group = -1L)) + #' geom_voronoi_tile(aes(fill = Species), colour = 'black', bound = triangle) #' #' # Use geom_shape functionality to round corners etc #' ggplot(iris, aes(Sepal.Length, Sepal.Width, group = -1L)) + #' geom_voronoi_tile(aes(fill = Species), colour = 'black', #' expand = unit(-.5, 'mm'), radius = unit(2, 'mm')) #' #' # Delaunay triangles #' ggplot(iris, aes(Sepal.Length, Sepal.Width)) + #' geom_delaunay_tile(alpha = 0.3, colour = 'black') #' #' # Use geom_delauney_segment2 to interpolate aestetics between end points #' ggplot(iris, aes(Sepal.Length, Sepal.Width)) + #' geom_delaunay_segment2(aes(colour = Species, group = -1), size = 2, #' lineend = 'round') NULL #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom scales rescale #' @export StatVoronoiTile <- ggproto('StatVoronoiTile', Stat, setup_params = function(self, data, params) { check_installed('deldir', 'to calculate voronoi tesselation') params }, compute_group = function(self, data, scales, bound = NULL, eps = 1e-9, max.radius = NULL, normalize = FALSE, asp.ratio = 1) { data$group <- paste0(seq_len(nrow(data)), ':', data$group) if (any(duplicated(data[, c('x', 'y')]))) { cli::cli_warn('{.fn {snake_class(self)}} is dropping duplicated points') } polybound <- NULL if (is.null(bound)) { if (!is.null(max.radius)) { bound <- c(range(data$x), range(data$y)) bound[c(1, 3)] <- bound[c(1, 3)] - max.radius * 1.5 bound[c(2, 4)] <- bound[c(2, 4)] + max.radius * 1.5 } } else if (is.matrix(bound) || is.data.frame(bound)) { if (is.matrix(bound) && is.null(colnames(bound))) { colnames(bound) <- c('x', 'y') } polybound <- as.data.frame(bound) bound <- c(range(polybound$x), range(polybound$y)) } if (normalize) { x_range <- range(data$x, na.rm = TRUE, finite = TRUE) y_range <- range(data$y, na.rm = TRUE, finite = TRUE) data$x <- rescale(data$x, from = x_range) * asp.ratio data$y <- rescale(data$y, from = y_range) if (!is.null(bound)) { bound[1:2] <- rescale(bound[1:2], from = x_range) * asp.ratio bound[3:4] <- rescale(bound[3:4], from = y_range) } if (!is.null(polybound)) { polybound$x <- rescale(polybound$x, from = x_range) * asp.ratio polybound$y <- rescale(polybound$y, from = y_range) } } vor <- deldir::deldir(data$x, data$y, rw = bound, eps = eps, suppressMsge = TRUE) tiles <- to_tile(vor) tiles$orig_x <- data$x[vor$ind.orig[tiles$group]] tiles$orig_y <- data$y[vor$ind.orig[tiles$group]] tiles$group <- data$group[vor$ind.orig[tiles$group]] tiles <- clip_tiles(tiles, max.radius, polybound) data$x <- NULL data$y <- NULL data <- merge(tiles, data, sort = FALSE, all.x = TRUE) if (normalize) { data$x <- rescale(data$x / asp.ratio, to = x_range, from = c(0, 1)) data$y <- rescale(data$y, to = y_range, from = c(0, 1)) } data }, required_aes = c('x', 'y') ) #' @rdname geom_delvor #' @inheritParams geom_shape #' @export geom_voronoi_tile <- function(mapping = NULL, data = NULL, stat = 'voronoi_tile', position = 'identity', na.rm = FALSE, bound = NULL, eps = 1e-9, max.radius = NULL, normalize = FALSE, asp.ratio = 1, expand = 0, radius = 0, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomShape, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(bound = bound, eps = eps, max.radius = max.radius, normalize = normalize, asp.ratio = asp.ratio, na.rm = na.rm, expand = expand, radius = radius, ...) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom scales rescale #' @export StatVoronoiSegment <- ggproto('StatVoronoiSegment', Stat, setup_params = function(self, data, params) { check_installed('deldir', 'to calculate voronoi tesselation') params }, compute_group = function(self, data, scales, bound = NULL, eps = 1e-9, normalize = FALSE, asp.ratio = 1) { if (any(duplicated(data[, c('x', 'y')]))) { cli::cli_warn('{.fn {snake_class(self)}} is dropping duplicated points') } if (normalize) { x_range <- range(data$x, na.rm = TRUE, finite = TRUE) y_range <- range(data$y, na.rm = TRUE, finite = TRUE) data$x <- rescale(data$x, from = x_range) * asp.ratio data$y <- rescale(data$y, from = y_range) if (!is.null(bound)) { bound[1:2] <- rescale(bound[1:2], from = x_range) * asp.ratio bound[3:4] <- rescale(bound[3:4], from = x_range) } } vor <- deldir::deldir(data$x, data$y, rw = bound, eps = eps, suppressMsge = TRUE) segments <- vor$dirsgs[, 1:5] names(segments) <- c('x', 'y', 'xend', 'yend', 'group') segments$group <- vor$ind.orig[segments$group] data <- cbind( segments[, 1:4], data[segments$group, !names(data) %in% c('x', 'y'), drop = FALSE] ) if (normalize) { data$x <- rescale(data$x / asp.ratio, to = x_range, from = c(0, 1)) data$xend <- rescale(data$xend / asp.ratio, to = x_range, from = c(0, 1)) data$y <- rescale(data$y, to = y_range, from = c(0, 1)) data$yend <- rescale(data$yend, to = y_range, from = c(0, 1)) } data }, required_aes = c('x', 'y') ) #' @rdname geom_delvor #' @export geom_voronoi_segment <- function(mapping = NULL, data = NULL, stat = 'voronoi_segment', position = 'identity', na.rm = FALSE, bound = NULL, eps = 1e-9, normalize = FALSE, asp.ratio = 1, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomSegment, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(bound = bound, eps = eps, normalize = normalize, asp.ratio = asp.ratio, na.rm = na.rm, ...) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom scales rescale #' @export StatDelaunayTile <- ggproto('StatDelaunayTile', Stat, setup_params = function(self, data, params) { check_installed('deldir', 'to calculate delaunay triangulation') params }, compute_group = function(self, data, scales, bound = NULL, eps = 1e-9, normalize = FALSE, asp.ratio = 1) { if (normalize) { x_range <- range(data$x, na.rm = TRUE, finite = TRUE) y_range <- range(data$y, na.rm = TRUE, finite = TRUE) data$x <- rescale(data$x, from = x_range) * asp.ratio data$y <- rescale(data$y, from = y_range) if (!is.null(bound)) { bound[1:2] <- rescale(bound[1:2], from = x_range) * asp.ratio bound[3:4] <- rescale(bound[3:4], from = x_range) } } data <- lapply(split(data, data$group), function(d) { if (any(duplicated(d[, c('x', 'y')]))) { cli::cli_warn('{.fn {snake_class(self)}} is dropping duplicated points') } vor <- deldir::deldir(d$x, d$y, rw = bound, eps = eps, suppressMsge = TRUE) d <- to_triangle(vor) d$group <- paste(data$group[1], '_', match(d$group, unique0(d$group))) d }) for (i in seq_len(length(data) - 1) + 1) { max_group <- max(data[[i - 1]]$group) data[[i]]$group <- data[[i]]$group + max_group } data <- vec_rbind(!!!data) if (normalize) { data$x <- rescale(data$x / asp.ratio, to = x_range, from = c(0, 1)) data$y <- rescale(data$y, to = y_range, from = c(0, 1)) } data }, required_aes = c('x', 'y') ) #' @rdname geom_delvor #' @inheritParams geom_shape #' @export geom_delaunay_tile <- function(mapping = NULL, data = NULL, stat = 'delaunay_tile', position = 'identity', na.rm = FALSE, bound = NULL, eps = 1e-9, normalize = FALSE, asp.ratio = 1, expand = 0, radius = 0, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomShape, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(bound = bound, eps = eps, normalize = normalize, asp.ratio = asp.ratio, expand = expand, radius = radius, na.rm = na.rm, ...) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom scales rescale #' @export StatDelaunaySegment <- ggproto('StatDelaunaySegment', Stat, setup_params = function(self, data, params) { check_installed('deldir', 'to calculate delaunay triangulation') params }, compute_group = function(self, data, scales, bound = NULL, eps = 1e-9, normalize = FALSE, asp.ratio = 1) { if (any(duplicated(data[, c('x', 'y')]))) { cli::cli_warn('{.fn {snake_class(self)}} is dropping duplicated points') } if (normalize) { x_range <- range(data$x, na.rm = TRUE, finite = TRUE) y_range <- range(data$y, na.rm = TRUE, finite = TRUE) data$x <- rescale(data$x, from = x_range) * asp.ratio data$y <- rescale(data$y, from = y_range) if (!is.null(bound)) { bound[1:2] <- rescale(bound[1:2], from = x_range) * asp.ratio bound[3:4] <- rescale(bound[3:4], from = x_range) } } vor <- deldir::deldir(data$x, data$y, rw = bound, eps = eps, suppressMsge = TRUE) segments <- vor$delsgs[, 1:5] names(segments) <- c('x', 'y', 'xend', 'yend', 'group') segments$group <- vor$ind.orig[segments$group] data <- cbind( segments[, 1:4], data[segments$group, !names(data) %in% c('x', 'y'), drop = FALSE] ) if (normalize) { data$x <- rescale(data$x / asp.ratio, to = x_range, from = c(0, 1)) data$xend <- rescale(data$xend / asp.ratio, to = x_range, from = c(0, 1)) data$y <- rescale(data$y, to = y_range, from = c(0, 1)) data$yend <- rescale(data$yend, to = y_range, from = c(0, 1)) } data }, required_aes = c('x', 'y') ) #' @rdname geom_delvor #' @export geom_delaunay_segment <- function(mapping = NULL, data = NULL, stat = 'delaunay_segment', position = 'identity', na.rm = FALSE, bound = NULL, eps = 1e-9, normalize = FALSE, asp.ratio = 1, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomSegment, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(bound = bound, eps = eps, normalize = normalize, na.rm = na.rm, asp.ratio = asp.ratio, ...) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom scales rescale #' @export StatDelaunaySegment2 <- ggproto('StatDelaunaySegment2', Stat, setup_params = function(self, data, params) { check_installed('deldir', 'to calculate delaunay triangulation') params }, compute_group = function(self, data, scales, bound = NULL, eps = 1e-9, n = 100, normalize = FALSE, asp.ratio = 1) { if (any(duplicated(data[, c('x', 'y')]))) { cli::cli_warn('{.fn {snake_class(self)}} is dropping duplicated points') } if (normalize) { x_range <- range(data$x, na.rm = TRUE, finite = TRUE) y_range <- range(data$y, na.rm = TRUE, finite = TRUE) data$x <- rescale(data$x, from = x_range) * asp.ratio data$y <- rescale(data$y, from = y_range) if (!is.null(bound)) { bound[1:2] <- rescale(bound[1:2], from = x_range) * asp.ratio bound[3:4] <- rescale(bound[3:4], from = x_range) } } vor <- deldir::deldir(data$x, data$y, rw = bound, eps = eps, suppressMsge = TRUE) segments <- vec_rbind( structure(vor$delsgs[, c(1:2, 5)], names = c('x', 'y', 'group')), structure(vor$delsgs[, c(3:4, 6)], names = c('x', 'y', 'group')) ) segments$group <- vor$ind.orig[segments$group] segments <- cbind( segments[, 1:2], data[segments$group, !names(data) %in% c('x', 'y'), drop = FALSE] ) segments$group <- rep(seq_len(nrow(vor$delsgs)), 2) segments <- segments[order(segments$group), ] if (normalize) { segments$x <- rescale(segments$x / asp.ratio, to = x_range, from = c(0, 1)) segments$y <- rescale(segments$y, to = y_range, from = c(0, 1)) } StatLink2$compute_panel(segments, scales, n) }, required_aes = c('x', 'y') ) #' @rdname geom_delvor #' @export geom_delaunay_segment2 <- function(mapping = NULL, data = NULL, stat = 'delaunay_segment2', position = 'identity', na.rm = FALSE, bound = NULL, eps = 1e-9, normalize = FALSE, asp.ratio = 1, n = 100, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomPathInterpolate, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(bound = bound, eps = eps, normalize = normalize, asp.ratio = asp.ratio, n = n, na.rm = na.rm, ...) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom scales rescale #' @export StatDelvorSummary <- ggproto('StatDelvorSummary', Stat, setup_params = function(self, data, params) { check_installed('deldir', 'to calculate delaunay triangulation') params }, compute_group = function(self, data, scales, bound = NULL, eps = 1e-9, switch.centroid = FALSE, normalize = FALSE, asp.ratio = 1) { if (any(duplicated(data[, c('x', 'y')]))) { cli::cli_warn('{.fn {snake_class(self)}} is dropping duplicated points') } if (normalize) { x_range <- range(data$x, na.rm = TRUE, finite = TRUE) y_range <- range(data$y, na.rm = TRUE, finite = TRUE) data$x <- rescale(data$x, from = x_range) * asp.ratio data$y <- rescale(data$y, from = y_range) if (!is.null(bound)) { bound[1:2] <- rescale(bound[1:2], from = x_range) * asp.ratio bound[3:4] <- rescale(bound[3:4], from = x_range) } } vor <- deldir::deldir(data$x, data$y, rw = bound, eps = eps, suppressMsge = TRUE) names(vor$summary) <- c('x', 'y', 'ntri', 'triarea', 'triprop', 'nsides', 'nedges', 'vorarea', 'vorprop') tiles <- to_tile(vor) vor$summary$xcent <- sapply(split(tiles$x, tiles$group), mean) vor$summary$ycent <- sapply(split(tiles$y, tiles$group), mean) data <- cbind( data[vor$ind.orig, , drop = FALSE], vor$summary[, !names(vor$summary) %in% c('x', 'y'), drop = FALSE] ) if (normalize) { data$x <- rescale(data$x / asp.ratio, to = x_range, from = c(0, 1)) data$xcent <- rescale(data$xcent / asp.ratio, to = x_range, from = c(0, 1)) data$y <- rescale(data$y, to = y_range, from = c(0, 1)) data$ycent <- rescale(data$ycent, to = y_range, from = c(0, 1)) } if (switch.centroid) { name_ind <- match(c('xcent', 'ycent', 'x', 'y'), names(data)) names(data)[name_ind] <- c('x', 'y', 'xorig', 'yorig') } data }, required_aes = c('x', 'y') ) #' @rdname geom_delvor #' @export stat_delvor_summary <- function(mapping = NULL, data = NULL, geom = 'point', position = 'identity', na.rm = FALSE, bound = NULL, eps = 1e-9, normalize = FALSE, asp.ratio = 1, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = StatDelvorSummary, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(bound = bound, eps = eps, normalize = normalize, na.rm = na.rm, asp.ratio = asp.ratio, ...) ) } # HELPERS ----------------------------------------------------------------- to_tile <- function(object) { check_installed('deldir', 'to calculate voronoi tesselation') tiles <- vec_rbind( structure(object$dirsgs[, c(1:2, 5)], names = c('x', 'y', 'group')), structure(object$dirsgs[, c(1:2, 6)], names = c('x', 'y', 'group')), structure(object$dirsgs[, c(3:5)], names = c('x', 'y', 'group')), structure(object$dirsgs[, c(3:4, 6)], names = c('x', 'y', 'group')) ) tiles <- unique0(tiles) tiles <- vec_rbind( tiles, data_frame0( x = object$rw[c(1, 2, 2, 1)], y = object$rw[c(3, 3, 4, 4)], group = deldir::get.cnrind( object$summary$x, object$summary$y, object$rw ) ) ) tiles$theta <- atan2( tiles$y - object$summary$y[tiles$group], tiles$x - object$summary$x[tiles$group] ) tiles$theta <- ifelse(tiles$theta > 0, tiles$theta, tiles$theta + 2 * pi) tiles[order(tiles$group, tiles$theta), ] } to_triangle <- function(object) { tiles <- vec_rbind( structure(object$dirsgs[, c(1:2, 5)], names = c('x', 'y', 'point')), structure(object$dirsgs[, c(3:4, 6)], names = c('x', 'y', 'point')) ) tiles$group <- as.integer( factor(paste0(signif(tiles$x, 5), '_', signif(tiles$y, 5))) ) # tiles <- tiles[tiles$tri %in% unique(tiles$tri[duplicated(tiles$tri)]),] unconform <- table(tiles$group) unconform <- as.integer(names(unconform[unconform != 3])) unconform_point <- tiles$point[tiles$group %in% unconform] tiles <- tiles[!tiles$group %in% unconform, , drop = FALSE] unconform_seg <- object$delsgs$ind1 %in% unconform_point & object$delsgs$ind2 %in% unconform_point object$delsgs <- object$delsgs[unconform_seg, , drop = FALSE] last_points <- tri_mat(object) last_points <- data_frame0( point = as.vector(last_points), group = rep(seq(max(tiles$group) + 1, length.out = ncol(last_points)), each = 3) ) triangles <- vec_rbind(tiles[, c('point', 'group'), drop = FALSE], last_points) triangles$x <- object$summary$x[triangles$point] triangles$y <- object$summary$y[triangles$point] triangles <- triangles[order(triangles$group, triangles$point), ] triangles$group <- match(triangles$group, unique0(triangles$group)) dup_tri <- which(duplicated(matrix(triangles$point, ncol = 3, byrow = TRUE))) triangles <- triangles[!triangles$group %in% dup_tri, , drop = FALSE] triangles } tri_mat <- function(object) { a <- object$delsgs[, 5] b <- object$delsgs[, 6] tlist <- matrix(integer(0), 3, 0) for (i in union(a, b)) { jj <- c(b[a == i], a[b == i]) jj <- sort(unique0(jj)) jj <- jj[jj > i] if (length(jj) > 0) { for (j in jj) { kk <- c(b[a == j], a[b == j]) kk <- kk[(kk %in% jj) & (kk > j)] if (length(kk) > 0) { for (k in kk) tlist <- cbind(tlist, c( i, j, k )) } } } } tlist } #' @importFrom polyclip polyclip clip_tiles <- function(tiles, radius, bound) { if (is.null(radius) && is.null(bound)) return(tiles) p <- seq(0, 2 * pi, length.out = 361)[-361] circ <- list( x = cos(p) * radius, y = sin(p) * radius ) dapply(tiles, 'group', function(tile) { final_tile <- list(x = tile$x, y = tile$y) if (!is.null(radius)) { circ_temp <- list(x = circ$x + tile$orig_x[1], y = circ$y + tile$orig_y[1]) final_tile <- polyclip(final_tile, circ_temp, 'intersection') } if (!is.null(bound)) { final_tile <- polyclip(final_tile, bound, 'intersection') } if (length(final_tile) == 0) return(NULL) data_frame0( x = final_tile[[1]]$x, y = final_tile[[1]]$y, group = tile$group[1] ) }) } ggforce/R/arc_bar.R0000644000176200001440000002252714672274110013617 0ustar liggesusers#' @include shape.R NULL #' Arcs and wedges as polygons #' #' This set of stats and geoms makes it possible to draw arcs and wedges as #' known from pie and donut charts as well as more specialized plottypes such as #' sunburst plots. #' #' @details An arc bar is the thick version of an arc; that is, a circle segment #' drawn as a polygon in the same way as a rectangle is a thick version of a #' line. A wedge is a special case of an arc where the inner radius is 0. As #' opposed to applying coord_polar to a stacked bar chart, these layers are #' drawn in cartesian space, which allows for transformations not possible with #' the native ggplot2 approach. Most notable of these are the option to explode #' arcs and wedgets away from their center point, thus detaching it from the #' main pie/donut. #' #' @section Aesthetics: #' geom_arc_bar understand the following aesthetics (required aesthetics are in #' bold): #' #' - **x0** #' - **y0** #' - **r0** #' - **r** #' - **start** - when using stat_arc_bar #' - **end** - when using stat_arc_bar #' - **amount** - when using stat_pie #' - explode #' - color #' - fill #' - linewidth #' - linetype #' - alpha #' #' #' @section Computed variables: #' \describe{ #' \item{x, y}{x and y coordinates for the polygon} #' } #' #' \describe{ #' \item{x, y}{The start coordinates for the segment} #' } #' #' @inheritParams ggplot2::geom_polygon #' @inheritParams ggplot2::stat_identity #' #' @param n The number of points used to draw a full circle. The number of #' points on each arc will then be calculated as n / span-of-arc #' #' @param sep The separation between arcs in pie/donut charts #' #' @name geom_arc_bar #' @rdname geom_arc_bar #' @seealso [geom_arc()] for drawing arcs as lines #' #' @examples #' # If you know the angle spans to plot it is easy #' arcs <- data.frame( #' start = seq(0, 2 * pi, length.out = 11)[-11], #' end = seq(0, 2 * pi, length.out = 11)[-1], #' r = rep(1:2, 5) #' ) #' #' # Behold the arcs #' ggplot(arcs) + #' geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = r - 1, r = r, start = start, #' end = end, fill = r)) #' #' # geom_arc_bar uses geom_shape to draw the arcs, so you have all the #' # possibilities of that as well, e.g. rounding of corners #' ggplot(arcs) + #' geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = r - 1, r = r, start = start, #' end = end, fill = r), radius = unit(4, 'mm')) #' #' # If you got values for a pie chart, use stat_pie #' states <- c( #' 'eaten', "eaten but said you didn\'t", 'cat took it', 'for tonight', #' 'will decompose slowly' #' ) #' pie <- data.frame( #' state = factor(rep(states, 2), levels = states), #' type = rep(c('Pie', 'Donut'), each = 5), #' r0 = rep(c(0, 0.8), each = 5), #' focus = rep(c(0.2, 0, 0, 0, 0), 2), #' amount = c(4, 3, 1, 1.5, 6, 6, 1, 2, 3, 2) #' ) #' #' # Look at the cakes #' ggplot() + geom_arc_bar(aes( #' x0 = 0, y0 = 0, r0 = r0, r = 1, amount = amount, #' fill = state, explode = focus #' ), #' data = pie, stat = 'pie' #' ) + #' facet_wrap(~type, ncol = 1) + #' coord_fixed() + #' theme_no_axes() + #' scale_fill_brewer('', type = 'qual') #' NULL #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatArcBar <- ggproto('StatArcBar', Stat, compute_panel = function(data, scales, n = 360) { arcPaths(data, n) }, required_aes = c('x0', 'y0', 'r0', 'r', 'start', 'end') ) #' @rdname geom_arc_bar #' @export stat_arc_bar <- function(mapping = NULL, data = NULL, geom = 'arc_bar', position = 'identity', n = 360, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( stat = StatArcBar, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, n = n, ...) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatPie <- ggproto('StatPie', Stat, compute_panel = function(data, scales, n = 360, sep = 0) { data <- dapply(data, c('x0', 'y0'), function(df) { angles <- cumsum(df$amount) seps <- cumsum(sep * seq_along(angles)) if (max(seps) >= 2 * pi) { cli::cli_abort(c( 'Total separation exceeds circle circumference', i = 'Try lowering {.arg sep}.' )) } angles <- angles / max(angles) * (2 * pi - max(seps)) data_frame0( df, start = c(0, angles[-length(angles)]) + c(0, seps[-length(seps)]) + sep / 2, end = angles + seps - sep / 2 ) }) arcPaths(as.data.frame(data), n) }, required_aes = c('x0', 'y0', 'r0', 'r', 'amount'), default_aes = aes(explode = NULL) ) #' @rdname geom_arc_bar #' @export stat_pie <- function(mapping = NULL, data = NULL, geom = 'arc_bar', position = 'identity', n = 360, sep = 0, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( stat = StatPie, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, n = n, sep = sep, ...) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export GeomArcBar <- ggproto('GeomArcBar', GeomShape, default_aes = combine_aes(GeomShape$default_aes, aes(colour = 'black', fill = NA)) ) #' @rdname geom_arc_bar #' @inheritParams geom_shape #' @export geom_arc_bar <- function(mapping = NULL, data = NULL, stat = 'arc_bar', position = 'identity', n = 360, expand = 0, radius = 0, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomArcBar, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, n = n, expand = expand, radius = radius, ...) ) } arcPaths <- function(data, n) { trans <- radial_trans(c(0, 1), c(0, 2 * pi), pad = 0) data <- data[data$start != data$end, ] data$nControl <- ceiling(n / (2 * pi) * abs(data$end - data$start)) data$nControl[data$nControl < 3] <- 3 extraData <- !names(data) %in% c('r0', 'r', 'start', 'end', 'group') data$group <- make_unique(data$group) paths <- lapply(seq_len(nrow(data)), function(i) { path <- data_frame0( a = seq(data$start[i], data$end[i], length.out = data$nControl[i]), r = data$r[i] ) if ('r0' %in% names(data)) { if (data$r0[i] != 0) { path <- vec_rbind( path, data_frame0(a = rev(path$a), r = data$r0[i]) ) } else { path <- vec_rbind( path, data_frame0(a = data$start[i], r = 0) ) } } path$group <- data$group[i] path$index <- seq(0, 1, length.out = nrow(path)) path <- cbind(path, data[rep(i, nrow(path)), extraData, drop = FALSE]) }) paths <- vec_rbind(!!!paths) paths <- cbind( paths[, !names(paths) %in% c('r', 'a')], trans$transform(paths$r, paths$a) ) paths$x <- paths$x + paths$x0 paths$y <- paths$y + paths$y0 if ('explode' %in% names(data)) { exploded <- data$explode != 0 if (any(exploded)) { exploder <- trans$transform( data$explode[exploded], data$start[exploded] + (data$end[exploded] - data$start[exploded]) / 2 ) explodedPaths <- paths$group %in% which(exploded) exploderInd <- as.integer(factor(paths$group[explodedPaths])) paths$x[explodedPaths] <- paths$x[explodedPaths] + exploder$x[exploderInd] paths$y[explodedPaths] <- paths$y[explodedPaths] + exploder$y[exploderInd] } } paths[, !names(paths) %in% c('x0', 'y0', 'exploded')] } arcPaths2 <- function(data, n) { trans <- radial_trans(c(0, 1), c(0, 2 * pi), pad = 0) fullCirc <- n / (2 * pi) extraData <- setdiff(names(data), c('r', 'x0', 'y0', 'end', 'group', 'PANEL')) hasExtra <- length(extraData) != 0 extraTemplate <- data[1, extraData, drop = FALSE] paths <- lapply(split(seq_len(nrow(data)), data$group), function(i) { if (length(i) != 2) { cli::cli_abort(c( 'Arcs must be defined by two end points', i = 'Make sure each group consists of two rows' )) } if (data$r[i[1]] != data$r[i[2]] || data$x0[i[1]] != data$x0[i[2]] || data$y0[i[1]] != data$y0[i[2]]) { cli::cli_abort( 'Both end points in each arc must be at same radius ({.arg r}) and with same center ({.arg {c("x0", "y0")}})' ) } if (data$end[i[1]] == data$end[i[2]]) return() nControl <- ceiling(fullCirc * abs(diff(data$end[i]))) if (nControl < 3) nControl <- 3 path <- data_frame0( a = seq(data$end[i[1]], data$end[i[2]], length.out = nControl), r = data$r[i[1]], x0 = data$x0[i[1]], y0 = data$y0[i[1]], group = data$group[i[1]], index = seq(0, 1, length.out = nControl), .interp = c(FALSE, rep(TRUE, nControl - 2), FALSE), PANEL = data$PANEL[i[1]] ) if (hasExtra) { path <- cbind(path, extraTemplate[rep(1, nControl), , drop = FALSE]) path[1, extraData] <- data[i[1], extraData, drop = FALSE] path[nControl, extraData] <- data[i[2], extraData, drop = FALSE] } path }) paths <- vec_rbind(!!!paths) paths <- cbind( paths[, !names(paths) %in% c('r', 'a')], trans$transform(paths$r, paths$a) ) paths$x <- paths$x + paths$x0 paths$y <- paths$y + paths$y0 paths[, !names(paths) %in% c('x0', 'y0')] } ggforce/R/sina.R0000644000176200001440000004022414672274110013152 0ustar liggesusers#' Sina plot #' #' The sina plot is a data visualization chart suitable for plotting any single #' variable in a multiclass dataset. It is an enhanced jitter strip chart, #' where the width of the jitter is controlled by the density distribution of #' the data within each class. #' #' @details There are two available ways to define the x-axis borders for the #' samples to spread within: #' \itemize{ #' \item{`method == "density"` #' #' A density kernel is estimated along the y-axis for every sample group, and #' the samples are spread within that curve. In effect this means that points #' will be positioned randomly within a violin plot with the same parameters. #' } #' \item{`method == "counts"`: #' #' The borders are defined by the number of samples that occupy the same bin. #' #' } #' } #' #' @section Aesthetics: #' geom_sina understand the following aesthetics (required aesthetics are in #' bold): #' #' - **x** #' - **y** #' - color #' - group #' - size #' - alpha #' #' @inheritParams ggplot2::geom_line #' @inheritParams ggplot2::stat_identity #' @inheritParams ggplot2::stat_density #' #' @param scale How should each sina be scaled. Corresponds to the `scale` #' parameter in [ggplot2::geom_violin()]? Available are: #' #' - `'area'` for scaling by the largest density/bin among the different sinas #' - `'count'` as above, but in addition scales by the maximum number of points #' in the different sinas. #' - `'width'` Only scale according to the `maxwidth` parameter #' #' For backwards compatibility it can also be a logical with `TRUE` meaning #' `area` and `FALSE` meaning `width` #' #' @param method Choose the method to spread the samples within the same #' bin along the x-axis. Available methods: "density", "counts" (can be #' abbreviated, e.g. "d"). See `Details`. #' #' @param maxwidth Control the maximum width the points can spread into. Values #' between 0 and 1. #' #' @param bin_limit If the samples within the same y-axis bin are more #' than `bin_limit`, the samples's X coordinates will be adjusted. #' #' @param binwidth The width of the bins. The default is to use `bins` #' bins that cover the range of the data. You should always override #' this value, exploring multiple widths to find the best to illustrate the #' stories in your data. #' #' @param bins Number of bins. Overridden by binwidth. Defaults to 50. #' #' @param seed A seed to set for the jitter to ensure a reproducible plot #' #' @param jitter_y If y is integerish banding can occur and the default is to #' jitter the values slightly to make them better distributed. Setting #' `jitter_y = FALSE` turns off this behaviour #' #' @inheritSection ggplot2::geom_line Orientation #' #' @author Nikos Sidiropoulos, Claus Wilke, and Thomas Lin Pedersen #' #' @name geom_sina #' @rdname geom_sina #' #' @section Computed variables: #' #' \describe{ #' \item{density}{The density or sample counts per bin for each point} #' \item{scaled}{`density` scaled by the maximum density in each group} #' \item{n}{The number of points in the group the point belong to} #' } #' #' #' @examples #' ggplot(midwest, aes(state, area)) + geom_point() #' #' # Boxplot and Violin plots convey information on the distribution but not the #' # number of samples, while Jitter does the opposite. #' ggplot(midwest, aes(state, area)) + #' geom_violin() #' #' ggplot(midwest, aes(state, area)) + #' geom_jitter() #' #' # Sina does both! #' ggplot(midwest, aes(state, area)) + #' geom_violin() + #' geom_sina() #' #' p <- ggplot(midwest, aes(state, popdensity)) + #' scale_y_log10() #' #' p + geom_sina() #' #' # Colour the points based on the data set's columns #' p + geom_sina(aes(colour = inmetro)) #' #' # Or any other way #' cols <- midwest$popdensity > 10000 #' p + geom_sina(colour = cols + 1L) #' #' # Sina plots with continuous x: #' ggplot(midwest, aes(cut_width(area, 0.02), popdensity)) + #' geom_sina() + #' scale_y_log10() #' #' #' ### Sample gaussian distributions #' # Unimodal #' a <- rnorm(500, 6, 1) #' b <- rnorm(400, 5, 1.5) #' #' # Bimodal #' c <- c(rnorm(200, 3, .7), rnorm(50, 7, 0.4)) #' #' # Trimodal #' d <- c(rnorm(200, 2, 0.7), rnorm(300, 5.5, 0.4), rnorm(100, 8, 0.4)) #' #' df <- data.frame( #' 'Distribution' = c( #' rep('Unimodal 1', length(a)), #' rep('Unimodal 2', length(b)), #' rep('Bimodal', length(c)), #' rep('Trimodal', length(d)) #' ), #' 'Value' = c(a, b, c, d) #' ) #' #' # Reorder levels #' df$Distribution <- factor( #' df$Distribution, #' levels(df$Distribution)[c(3, 4, 1, 2)] #' ) #' #' p <- ggplot(df, aes(Distribution, Value)) #' p + geom_boxplot() #' p + geom_violin() + #' geom_sina() #' #' # By default, Sina plot scales the width of the class according to the width #' # of the class with the highest density. Turn group-wise scaling off with: #' p + #' geom_violin() + #' geom_sina(scale = FALSE) NULL #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatSina <- ggproto('StatSina', Stat, required_aes = c('x', 'y'), setup_data = function(data, params) { data <- flip_data(data, params$flipped_aes) data$flipped_aes <- params$flipped_aes if (is.double(data$x) && !.has_groups(data) && any(data$x != data$x[1L])) { cli::cli_abort(c( "Continuous {.field {flipped_names(params$flipped_aes)$x}} aesthetic", "i" = "did you forget {.code aes(group = ...)}?" )) } flip_data(data, params$flipped_aes) }, setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = TRUE, group_has_equal = TRUE) data <- flip_data(data, params$flipped_aes) params$maxwidth <- params$maxwidth %||% (resolution(data$x %||% 0) * 0.9) if (is.null(params$binwidth) && is.null(params$bins)) { params$bins <- 50 } params }, compute_panel = function(self, data, scales, scale = TRUE, method = 'density', bw = 'nrd0', kernel = 'gaussian', binwidth = NULL, bins = NULL, maxwidth = 1, adjust = 1, bin_limit = 1, seed = NA, flipped_aes = FALSE, jitter_y = TRUE) { if (!is.null(binwidth)) { bins <- bin_breaks_width(scales[[flipped_names(flipped_aes)$y]]$dimension() + 1e-8, binwidth) } else { bins <- bin_breaks_bins(scales[[flipped_names(flipped_aes)$y]]$dimension() + 1e-8, bins) } data <- ggproto_parent(Stat, self)$compute_panel(data, scales, scale = scale, method = method, bw = bw, kernel = kernel, bins = bins$breaks, maxwidth = maxwidth, adjust = adjust, bin_limit = bin_limit, flipped_aes = flipped_aes) data <- flip_data(data, flipped_aes) if (is.logical(scale)) { scale <- if (scale) 'area' else 'width' } # choose how sinas are scaled relative to each other data$sinawidth <- switch( scale, # area : keep the original densities but scale them to a max width of 1 # for plotting purposes only area = data$density / max(data$density), # count: use the original densities scaled to a maximum of 1 (as above) # and then scale them according to the number of observations count = data$density / max(data$density) * data$n / max(data$n), # width: constant width (each density scaled to a maximum of 1) width = data$scaled ) data$sinawidth[!is.finite(data$sinawidth)] <- 0 if (!is.na(seed)) { new_seed <- sample(.Machine$integer.max, 1L) set.seed(seed) on.exit(set.seed(new_seed)) } data$xmin <- data$x - maxwidth / 2 data$xmax <- data$x + maxwidth / 2 data$x_diff <- runif(nrow(data), min = -1, max = 1) * maxwidth * data$sinawidth/2 data$width <- maxwidth # jitter y values if the input is input is integer if (jitter_y && is_integerish(data$y)) { data$y <- jitter(data$y) } flip_data(data, flipped_aes) }, compute_group = function(data, scales, scale = TRUE, method = 'density', bw = 'nrd0', kernel = 'gaussian', maxwidth = 1, adjust = 1, bin_limit = 1, bins = NULL, flipped_aes = FALSE) { if (nrow(data) == 0) return(NULL) data <- flip_data(data, flipped_aes) if (nrow(data) < 3) { data$density <- 0 data$scaled <- 1 } else if (length(unique0(data$y)) < 2) { data$density <- 1 data$scaled <- 1 } else if (method == 'density') { # density kernel estimation range <- range(data$y, na.rm = TRUE) bw <- calc_bw(data$y, bw) dens <- compute_density(data$y, data$w, from = range[1], to = range[2], bw = bw, adjust = adjust, kernel = kernel) densf <- stats::approxfun(dens$x, dens$density, rule = 2) data$density <- densf(data$y) data$scaled <- data$density / max(dens$density) } else { # bin based estimation bin_index <- cut(data$y, bins, include.lowest = TRUE, labels = FALSE) data$density <- tapply(bin_index, bin_index, length)[as.character(bin_index)] data$density[data$density <= bin_limit] <- 0 data$scaled <- data$density / max(data$density) } # Compute width if x has multiple values if (length(unique0(data$x)) > 1) { width <- diff(range(data$x)) * maxwidth } else { width <- maxwidth } data$width <- width data$n <- nrow(data) data$x <- mean(range(data$x)) flip_data(data, flipped_aes) }, finish_layer = function(data, params) { # rescale x in case positions have been adjusted data <- flip_data(data, params$flipped_aes) x_mod <- (data$xmax - data$xmin) / data$width data$x <- data$x + data$x_diff * x_mod flip_data(data, params$flipped_aes) }, extra_params = c('na.rm', 'orientation') ) #' @rdname geom_sina #' @export stat_sina <- function(mapping = NULL, data = NULL, geom = 'point', position = 'dodge', scale = 'area', method = 'density', bw = 'nrd0', kernel = 'gaussian', maxwidth = NULL, adjust = 1, bin_limit = 1, binwidth = NULL, bins = NULL, seed = NA, jitter_y = TRUE, ..., na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE) { method <- match.arg(method, c('density', 'counts')) layer( data = data, mapping = mapping, stat = StatSina, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(scale = scale, method = method, bw = bw, kernel = kernel, maxwidth = maxwidth, adjust = adjust, bin_limit = bin_limit, binwidth = binwidth, bins = bins, seed = seed, jitter_y = jitter_y, na.rm = na.rm, orientation = orientation, ...) ) } #' @rdname geom_sina #' @export geom_sina <- function(mapping = NULL, data = NULL, stat = 'sina', position = 'dodge', ..., na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE) { layer( data = data, mapping = mapping, stat = stat, geom = GeomPoint, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( na.rm = na.rm, orientation = orientation, ... ) ) } # Binning functions ------------------------------------------------------- bins <- function(breaks, closed = "right", fuzz = 1e-08 * stats::median(diff(breaks))) { if (!is.numeric(breaks)) { cli::cli_abort("{.arg breaks} must be a numeric vector") } closed <- arg_match0(closed, c("right", "left")) breaks <- sort(breaks) # Adapted base::hist - this protects from floating point rounding errors if (closed == "right") { fuzzes <- c(-fuzz, rep.int(fuzz, length(breaks) - 1)) } else { fuzzes <- c(rep.int(-fuzz, length(breaks) - 1), fuzz) } structure( list( breaks = breaks, fuzzy = breaks + fuzzes, right_closed = closed == "right" ), class = "ggplot2_bins" ) } # Compute parameters ----------------------------------------------------------- # from ggplot2 compute_density <- function(x, w, from, to, bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512) { nx <- length(x) if (is.null(w)) { w <- rep(1 / nx, nx) } else { w <- w / sum(w) } dens <- stats::density(x, weights = w, bw = bw, adjust = adjust, kernel = kernel, n = n, from = from, to = to) data_frame0( x = dens$x, density = dens$y, scaled = dens$y / max(dens$y, na.rm = TRUE), ndensity = dens$y / max(dens$y, na.rm = TRUE), count = dens$y * nx, n = nx ) } calc_bw <- function(x, bw) { if (is.character(bw)) { if (length(x) < 2) { cli::cli_abort("{.arg x} must contain at least 2 elements to select a bandwidth automatically") } bw <- switch( to_lower_ascii(bw), nrd0 = stats::bw.nrd0(x), nrd = stats::bw.nrd(x), ucv = stats::bw.ucv(x), bcv = stats::bw.bcv(x), sj = , `sj-ste` = stats::bw.SJ(x, method = "ste"), `sj-dpi` = stats::bw.SJ(x, method = "dpi"), cli::cli_abort("{.var {bw}} is not a valid bandwidth rule") ) } bw } bin_breaks <- function(breaks, closed = c('right', 'left')) { bins(breaks, closed) } bin_breaks_width <- function(x_range, width = NULL, center = NULL, boundary = NULL, closed = c("right", "left")) { if (length(x_range) != 2) { cli::cli_abort("{.arg x_range} must have two elements") } # if (length(x_range) == 0) { # return(bin_params(numeric())) # } if (!(is.numeric(width) && length(width) == 1)) { cli::cli_abort("{.arg width} must be a number") } if (width <= 0) { cli::cli_abort("{.arg binwidth} must be positive") } if (!is.null(boundary) && !is.null(center)) { cli::cli_abort("Only one of {.arg boundary} and {.arg center} may be specified.") } else if (is.null(boundary)) { if (is.null(center)) { # If neither edge nor center given, compute both using tile layer's # algorithm. This puts min and max of data in outer half of their bins. boundary <- width / 2 } else { # If center given but not boundary, compute boundary. boundary <- center - width / 2 } } # Find the left side of left-most bin: inputs could be Dates or POSIXct, so # coerce to numeric first. x_range <- as.numeric(x_range) width <- as.numeric(width) boundary <- as.numeric(boundary) shift <- floor((x_range[1] - boundary) / width) origin <- boundary + shift * width # Small correction factor so that we don't get an extra bin when, for # example, origin = 0, max(x) = 20, width = 10. max_x <- x_range[2] + (1 - 1e-08) * width if (isTRUE((max_x - origin) / width > 1e6)) { cli::cli_abort(c( "The number of histogram bins must be less than 1,000,000.", "i" = "Did you make {.arg binwidth} too small?" )) } breaks <- seq(origin, max_x, width) if (length(breaks) == 1) { # In exceptionally rare cases, the above can fail and produce only a # single break (see issue #3606). We fix this by adding a second break. breaks <- c(breaks, breaks + width) } bin_breaks(breaks, closed = closed) } bin_breaks_bins <- function(x_range, bins = 30, center = NULL, boundary = NULL, closed = c("right", "left")) { if (length(x_range) != 2) { cli::cli_abort("{.arg x_range} must have two elements") } bins <- as.integer(bins) if (bins < 1) { cli::cli_abort("{.arg bins} must be 1 or greater") } else if (scales::zero_range(x_range)) { # 0.1 is the same width as the expansion `default_expansion()` gives for 0-width data width <- 0.1 } else if (bins == 1) { width <- diff(x_range) boundary <- x_range[1] } else { width <- (x_range[2] - x_range[1]) / (bins - 1) } bin_breaks_width(x_range, width, boundary = boundary, center = center, closed = closed) } .has_groups <- function(data) { # If no group aesthetic is specified, all values of the group column equal to # -1L. On the other hand, if a group aesthetic is specified, all values # are different from -1L (since they are a result of plyr::id()). NA is # returned for 0-row data frames. data$group[1L] != -1L } ggforce/R/themes.R0000644000176200001440000000140514672274110013503 0ustar liggesusers#' Theme without axes and gridlines #' #' This theme is a simple wrapper around any complete theme that removes the #' axis text, title and ticks as well as the grid lines for plots where these #' have little meaning. #' #' @param base.theme The theme to use as a base for the new theme. Defaults to #' [ggplot2::theme_bw()]. #' #' @return A modified version of base.theme #' #' @export #' #' @examples #' p <- ggplot() + geom_point(aes(x = wt, y = qsec), data = mtcars) #' #' p + theme_no_axes() #' p + theme_no_axes(theme_grey()) #' theme_no_axes <- function(base.theme = theme_bw()) { base.theme %+replace% theme( axis.text = element_blank(), axis.title = element_blank(), axis.ticks = element_blank(), panel.grid = element_blank() ) } ggforce/R/labeller.R0000644000176200001440000000156014672274110014002 0ustar liggesusers#' A labeller function to parse TeX syntax #' #' This function formats the strip labels of facet grids and wraps that contains #' TeX expressions. The latex2exp package must be installed. #' #' @seealso [ggplot2::labeller], [latex2exp::TeX()] #' #' @inheritParams ggplot2::label_parsed #' @inheritDotParams ggplot2::label_parsed -labels #' #' @examples #' # requires latex2exp package be installed #' if (requireNamespace("latex2exp", quietly = TRUE)) { #' library(ggplot2) #' d <- data.frame(x = 1, y = 1, facet = "$\\beta$") #' ggplot(d, aes(x, y)) + #' geom_point() + #' facet_wrap(~ facet, labeller = label_tex) #' } #' @importFrom ggplot2 label_parsed #' @export label_tex <- function(labels, ...) { check_installed('latex2exp', 'to parse tex equations') label_parsed( data_frame0(!!!lapply(labels, latex2exp::TeX, output = "character")), ... ) } ggforce/R/position_auto.R0000644000176200001440000001057214672274110015117 0ustar liggesusers#' Jitter based on scale types #' #' This position adjustment is able to select a meaningful jitter of the data #' based on the combination of positional scale types. IT behaves differently #' depending on if none, one, or both the x and y scales are discrete. If both #' are discrete it will jitter the datapoints evenly inside a disc, if one of #' them is discrete it will jitter the discrete dimension to follow the density #' along the other dimension (like a sina plot). If neither are discrete it will #' not do any jittering. #' #' @param jitter.width The maximal width of the jitter #' @param bw The smoothing bandwidth to use in the case of sina jittering. See #' the `bw` argument in [stats::density] #' @param scale Should the width of jittering be scaled based on the number of #' points in the group #' @param seed A seed to supply to make the jittering reproducible across layers #' #' @seealso [geom_autopoint] for a point geom that uses auto-position by default #' #' @export #' #' @examples #' # Continuous vs continuous: No jitter #' ggplot(mpg) + geom_point(aes(cty, hwy), position = 'auto') #' #' # Continuous vs discrete: sina jitter #' ggplot(mpg) + geom_point(aes(cty, drv), position = 'auto') #' #' # Discrete vs discrete: disc-jitter #' ggplot(mpg) + geom_point(aes(fl, drv), position = 'auto') #' #' # Don't scale the jitter based on group size #' ggplot(mpg) + geom_point(aes(cty, drv), position = position_auto(scale = FALSE)) #' ggplot(mpg) + geom_point(aes(fl, drv), position = position_auto(scale = FALSE)) #' position_auto <- function(jitter.width = 0.75, bw = 'nrd0', scale = TRUE, seed = NA) { if (!is.null(seed) && is.na(seed)) { seed <- sample.int(.Machine$integer.max, 1L) } ggproto(NULL, PositionAuto, jitter.width = jitter.width, seed = seed, bw = bw, scale = scale ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export #' @importFrom withr with_seed PositionAuto <- ggproto('PositionAuto', Position, jitter.width = 0.75, seed = NULL, bw = 'nrd0', scale = TRUE, setup_params = function(self, data) { list(jitter.width = self$jitter.width, bw = self$bw, seed = self$seed, scale = self$scale) }, compute_panel = function(data, params, scales) { discrete_x <- scales$x$is_discrete() discrete_y <- scales$y$is_discrete() if (!discrete_x && !discrete_y) { return(data) } if (discrete_x && discrete_y) { comb <- table(data$x, data$y) max_n <- max(comb) if (params$scale) { weight <- sqrt(comb[cbind(as.character(data$x), as.character(data$y))] / max_n) * (params$jitter.width / 2) } else { weight <- params$jitter.width / 2 } if (is.null(params$seed)) { adj <- sample_disc(length(data$x), weight) } else { adj <- with_seed(params$seed, sample_disc(length(data$x), weight)) } data$x <- data$x + adj$x data$y <- data$y + adj$y data } else { trans_x <- trans_y <- identity if (discrete_x) { trans_x <- function(x) x + sina_trans(x, data$y, params$jitter.width / 2, params$bw, params$scale) } else { trans_y <- function(x) x + sina_trans(x, data$x, params$jitter.width / 2, params$bw, params$scale) } if (is.null(params$seed)) { transform_position(data, trans_x, trans_y) } else { with_seed(params$seed, transform_position(data, trans_x, trans_y)) } } } ) sina_trans <- function(x, val, max_width, bw = 'nrd0', scale = TRUE) { max_size <- max(table(x)) by_ind <- split(seq_along(x), x) x_new <- unlist(lapply(by_ind, function(i) { val_x <- val[i] if (length(unique0(val_x)) < 2) { return(stats::runif(length(val_x), min = -max_width, max = max_width)) } if (length(val_x) < 3) { return(0) } range <- range(val_x, na.rm = TRUE) bw <- calc_bw(val_x, bw) dens <- stats::density(val_x, bw = bw, from = range[1], to = range[2]) densf <- stats::approxfun(dens$x, dens$y, rule = 2) x_mod <- densf(val_x) x_mod <- x_mod / max(x_mod) if (scale) x_mod <- x_mod * length(val_x) / max_size stats::runif(length(val_x), min = -1, max = 1) * max_width * x_mod })) x_new[match(seq_along(x), unlist(by_ind))] } sample_disc <- function(n, r_disc = 1) { r = sqrt(stats::runif(n, 0, 1)) theta = stats::runif(n, 0, 2*pi) x <- r * cos(theta) * r_disc y <- r * sin(theta) * r_disc list(x = x, y = y) } ggforce/R/mark_rect.R0000644000176200001440000002731115024471216014167 0ustar liggesusers#' Annotate areas with rectangles #' #' This geom lets you annotate sets of points via rectangles. The rectangles are #' simply scaled to the range of the data and as with the other #' `geom_mark_*()` geoms expanded and have rounded corners. #' #' @inheritSection geom_mark_circle Annotation #' @inheritSection geom_mark_circle Filtering #' @section Aesthetics: #' `geom_mark_rect` understands the following aesthetics (required aesthetics are #' in bold): #' #' - **x** #' - **y** #' - x0 *(used to anchor the label)* #' - y0 *(used to anchor the label)* #' - filter #' - label #' - description #' - color #' - fill #' - group #' - size #' - linetype #' - alpha #' #' @inheritParams geom_mark_circle #' #' @family mark geoms #' #' @name geom_mark_rect #' @rdname geom_mark_rect #' #' @examples #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_rect(aes(fill = Species, filter = Species != 'versicolor')) + #' geom_point() #' #' # Add annotation #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_rect(aes(fill = Species, label = Species)) + #' geom_point() #' #' # Long descriptions are automatically wrapped to fit into the width #' iris$desc <- c( #' 'A super Iris - and it knows it', #' 'Pretty mediocre Iris, but give it a couple of years and it might surprise you', #' "You'll never guess what this Iris does every Sunday" #' )[iris$Species] #' #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_rect(aes(fill = Species, label = Species, description = desc, #' filter = Species == 'setosa')) + #' geom_point() #' #' # Change the buffer size to move labels farther away (or closer) from the #' # marks #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_rect(aes(fill = Species, label = Species), #' label.buffer = unit(30, 'mm')) + #' geom_point() #' #' # The connector is capped a bit before it reaches the mark, but this can be #' # controlled #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_rect(aes(fill = Species, label = Species), #' con.cap = 0) + #' geom_point() #' #' # If you want to use the scaled colours for the labels or connectors you can #' # use the "inherit" keyword instead #' ggplot(iris, aes(Petal.Length, Petal.Width)) + #' geom_mark_rect(aes(fill = Species, label = Species), #' label.fill = "inherit") + #' geom_point() NULL #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export GeomMarkRect <- ggproto('GeomMarkRect', GeomMarkCircle, setup_data = function(self, data, params) { if (!is.null(data$filter)) { data$filter <- ifelse(is.na(data$filter), FALSE, data$filter) self$removed <- data[!data$filter, c('x', 'y', 'PANEL')] data <- data[data$filter, ] } if (nrow(data) == 0) return(data) vec_rbind(!!!lapply(split(data, list(data$PANEL, data$group)), function(d) { if (nrow(d) == 1) return(d) x_range <- range(d$x, na.rm = TRUE) y_range <- range(d$y, na.rm = TRUE) d_new <- data_frame0( x = x_range[c(1, 1, 2, 2)], y = y_range[c(1, 2, 2, 1)] ) d$x <- NULL d$y <- NULL unique0(cbind(d_new, d[rep(1, 4), ])) })) }, draw_panel = function(self, data, panel_params, coord, expand = unit(5, 'mm'), radius = unit(2.5, 'mm'), label.margin = margin(2, 2, 2, 2, 'mm'), label.width = NULL, label.minwidth = unit(50, 'mm'), label.hjust = 0, label.buffer = unit(10, 'mm'), label.fontsize = 12, label.family = '', label.fontface = c('bold', 'plain'), label.lineheight = 1, label.fill = 'white', label.colour = 'black', con.colour = 'black', con.size = 0.5, con.type = 'elbow', con.linetype = 1, con.border = 'one', con.cap = unit(3, 'mm'), con.arrow = NULL) { if (nrow(data) == 0) return(zeroGrob()) # As long as coord$transform() doesn't recognise x0/y0 data$xmin <- data$x0 data$ymin <- data$y0 coords <- coord$transform(data, panel_params) if (!is.integer(coords$group)) { coords$group <- match(coords$group, unique0(coords$group)) } coords <- coords[order(coords$group), ] # For gpar(), there is one entry per polygon (not one entry per point). # We'll pull the first value from each group, and assume all these values # are the same within each group. first_idx <- !duplicated(coords$group) first_rows <- coords[first_idx, ] label <- NULL ghosts <- NULL if (!is.null(coords$label) || !is.null(coords$description)) { label <- first_rows is_ghost <- which(self$removed$PANEL == coords$PANEL[1]) if (length(is_ghost) > 0) { ghosts <- self$removed[is_ghost, ] ghosts <- coord$transform(ghosts, panel_params) ghosts <- list(x = ghosts$x, y = ghosts$y) } } gp <- gpar( col = first_rows$colour, fill = ggplot2::fill_alpha(first_rows$fill, first_rows$alpha), lwd = (first_rows$linewidth %||% first_rows$size) * .pt, lty = first_rows$linetype, fontsize = (first_rows$size %||% 4.217518) * .pt ) rectEncGrob(coords$x, coords$y, default.units = 'native', id = coords$group, expand = expand, radius = radius, label = label, ghosts = ghosts, mark.gp = gp, label.gp = inherit_gp( col = label.colour[1], fill = label.fill, fontface = label.fontface[1], fontfamily = label.family[1], fontsize = label.fontsize[1], lineheight = label.lineheight[1], gp = gp ), desc.gp = inherit_gp( col = rep_len(label.colour, 2)[2], fontface = rep_len(label.fontface, 2)[2], fontfamily = rep_len(label.family, 2)[2], fontsize = rep_len(label.fontsize, 2)[2], lineheight = rep_len(label.lineheight, 2)[2], gp = gp ), con.gp = inherit_gp( col = con.colour, fill = con.colour, lwd = if (is.numeric(con.size)) con.size * .pt else con.size, lty = con.linetype, gp = gp ), label.margin = label.margin, label.width = label.width, label.minwidth = label.minwidth, label.hjust = label.hjust, label.buffer = label.buffer, con.type = con.type, con.border = con.border, con.cap = con.cap, con.arrow = con.arrow, anchor.x = first_rows$xmin, anchor.y = first_rows$ymin ) } ) #' @rdname geom_mark_rect #' @export geom_mark_rect <- function(mapping = NULL, data = NULL, stat = 'identity', position = 'identity', expand = unit(5, 'mm'), radius = unit(2.5, 'mm'), label.margin = margin(2, 2, 2, 2, 'mm'), label.width = NULL, label.minwidth = unit(50, 'mm'), label.hjust = 0, label.fontsize = 12, label.family = '', label.lineheight = 1, label.fontface = c('bold', 'plain'), label.fill = 'white', label.colour = 'black', label.buffer = unit(10, 'mm'), con.colour = 'black', con.size = 0.5, con.type = 'elbow', con.linetype = 1, con.border = 'one', con.cap = unit(3, 'mm'), con.arrow = NULL, ..., na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) { layer( data = data, mapping = mapping, stat = stat, geom = GeomMarkRect, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( na.rm = na.rm, expand = expand, radius = radius, label.margin = label.margin, label.width = label.width, label.minwidth = label.minwidth, label.fontsize = label.fontsize, label.family = label.family, label.lineheight = label.lineheight, label.fontface = label.fontface, label.hjust = label.hjust, label.fill = label.fill, label.colour = label.colour, label.buffer = label.buffer, con.colour = con.colour, con.size = con.size, con.type = con.type, con.linetype = con.linetype, con.border = con.border, con.cap = con.cap, con.arrow = con.arrow, ... ) ) } # Helpers ----------------------------------------------------------------- rectEncGrob <- function(x = c(0, 0.5, 1, 0.5), y = c(0.5, 1, 0.5, 0), id = NULL, id.lengths = NULL, expand = 0, radius = 0, label = NULL, ghosts = NULL, default.units = 'npc', name = NULL, mark.gp = gpar(), label.gp = gpar(), desc.gp = gpar(), con.gp = gpar(), label.margin = margin(), label.width = NULL, label.minwidth = unit(50, 'mm'), label.hjust = 0, label.buffer = unit(10, 'mm'), con.type = 'elbow', con.border = 'one', con.cap = unit(3, 'mm'), con.arrow = NULL, anchor.x = NULL, anchor.y = NULL, vp = NULL) { mark <- shapeGrob( x = x, y = y, id = id, id.lengths = id.lengths, expand = expand, radius = radius, default.units = default.units, name = name, gp = mark.gp, vp = vp ) if (!is.null(label)) { label <- lapply(seq_len(nrow(label)), function(i) { if (is.na(label$label[i] %||% NA) && is.na(label$description[i] %||% NA)) return(zeroGrob()) grob <- labelboxGrob(label$label[i], 0, 0, label$description[i], gp = subset_gp(label.gp, i), desc.gp = subset_gp(desc.gp, i), pad = label.margin, width = label.width, min.width = label.minwidth, hjust = label.hjust ) if (con.border == 'all') { con.gp <- subset_gp(con.gp, i) grob$children[[1]]$gp$col <- con.gp$col grob$children[[1]]$gp$lwd <- con.gp$lwd grob$children[[1]]$gp$lty <- con.gp$lty } grob }) labeldim <- lapply(label, function(l) { c( convertWidth(grobWidth(l), 'mm', TRUE), convertHeight(grobHeight(l), 'mm', TRUE) ) }) ghosts <- lapply(ghosts, unit, default.units) } else { labeldim <- NULL } if (!is.null(anchor.x) && !is.unit(anchor.x)) { anchor.x <- unit(anchor.x, default.units) } if (!is.null(anchor.y) && !is.unit(anchor.y)) { anchor.y <- unit(anchor.y, default.units) } gTree( mark = mark, label = label, labeldim = labeldim, buffer = label.buffer, ghosts = ghosts, con.gp = con.gp, con.type = con.type, con.cap = as_mm(con.cap, default.units), con.border = con.border, con.arrow = con.arrow, anchor.x = anchor.x, anchor.y = anchor.y, name = name, vp = vp, cl = 'rect_enc' ) } #' @importFrom grid makeContent setChildren gList #' @export makeContent.rect_enc <- function(x) { mark <- x$mark if (inherits(mark, 'shape')) mark <- makeContent(mark) if (!is.null(x$label)) { polygons <- Map(function(x, y) list(x = x, y = y), x = split(as.numeric(mark$x), mark$id), y = split(as.numeric(mark$y), mark$id) ) anchor_x <- if (is.null(x$anchor.x)) NULL else convertX(x$anchor.x, 'mm', TRUE) anchor_y <- if (is.null(x$anchor.y)) NULL else convertY(x$anchor.y, 'mm', TRUE) labels <- make_label( labels = x$label, dims = x$labeldim, polygons = polygons, ghosts = x$ghosts, buffer = x$buffer, con_type = x$con.type, con_border = x$con.border, con_cap = x$con.cap, con_gp = x$con.gp, anchor_mod = 3, anchor_x = anchor_x, anchor_y = anchor_y, arrow = x$con.arrow ) setChildren(x, inject(gList(!!!c(list(mark), labels)))) } else { setChildren(x, gList(mark)) } } ggforce/R/interpolate.R0000644000176200001440000000677215024471216014556 0ustar liggesusers#' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom grid segmentsGrob polylineGrob gpar GeomPathInterpolate <- ggproto('GeomPathInterpolate', GeomPath, draw_panel = function(self, data, panel_scales, coord, arrow = NULL, lineend = 'butt', linejoin = 'round', linemitre = 1, na.rm = FALSE) { if (!anyDuplicated(data$group)) { cli::cli_inform(c( "{.fn {snake_class(self)}}: Each group consists of only one observation.", i = "Do you need to adjust the {.field group} aesthetic?" )) } data <- data[order(data$group), , drop = FALSE] data <- interpolateDataFrame(data) munched <- coord_munch(coord, data, panel_scales) rows <- stats::ave(seq_len(nrow(munched)), munched$group, FUN = length ) munched <- munched[rows >= 2, ] if (nrow(munched) < 2) { return(zeroGrob()) } attr <- dapply(data, 'group', function(df) { data_frame0( solid = identical(unique0(df$linetype), 1), constant = nrow(unique0(df[, names(df) %in% c( 'alpha', 'colour', 'linewidth', 'size', 'linetype' )])) == 1 ) }) solid_lines <- all(attr$solid) constant <- all(attr$constant) if (!solid_lines && !constant) { cli::cli_abort("{.fn {snake_class(self)}} can't have varying {.field colour}, {.field linewidth}, and/or {.field alpha} along the line when {.field linetype} isn't solid") } n <- nrow(munched) group_diff <- munched$group[-1] != munched$group[-n] start <- c(TRUE, group_diff) end <- c(group_diff, TRUE) if (!constant) { segmentsGrob(munched$x[!end], munched$y[!end], munched$x[!start], munched$y[!start], default.units = 'native', arrow = arrow, gp = gpar( col = alpha(munched$colour, munched$alpha)[!end], fill = ggplot2::fill_alpha(munched$colour[!end], munched$alpha[!end]), lwd = (munched$linewidth[!end] %||% munched$size[!end]) * .pt, lty = munched$linetype[!end], lineend = lineend, linejoin = linejoin, linemitre = linemitre ) ) } else { id <- match(munched$group, unique0(munched$group)) polylineGrob(munched$x, munched$y, id = id, default.units = 'native', arrow = arrow, gp = gpar( col = alpha(munched$colour, munched$alpha)[start], fill = ggplot2::fill_alpha(munched$colour[start], munched$alpha[start]), lwd = (munched$linewidth[start] %||% munched$size[start]) * .pt, lty = munched$linetype[start], lineend = lineend, linejoin = linejoin, linemitre = linemitre ) ) } }, handle_na = function(data, params) { data } ) #' Interpolate layer data #' #' @param data A data.frame with data for a layer #' #' @return A similar data.frame with NA values interpolated #' #' @importFrom tweenr tween_t #' @keywords internal #' @export interpolateDataFrame <- function(data) { if (is.null(data$group)) { cli::cli_abort('data must have a group column') } interpLengths <- lengths(split(data$group, data$group)) for (i in seq_len(ncol(data))) { if (names(data)[i] %in% c('x', 'y', 'index', 'group', '.interp') || all(is.na(data[[i]]))) { next } if (length(unique0(data[[i]][data$.interp])) > 1) { next } interpValues <- split(data[[i]][!data$.interp], data$group[!data$.interp]) data[[i]] <- unlist(tween_t(interpValues, interpLengths)) } data[, names(data) != '.interp'] } ggforce/R/trans_linear.R0000644000176200001440000000641314672274110014703 0ustar liggesusers#' Create a custom linear transformation #' #' This function lets you compose transformations based on a sequence of linear #' transformations. If the transformations are parameterised the parameters will #' become arguments in the transformation function. The transformations are #' one of `rotate`, `shear`, `stretch`, `translate`, and #' `reflect`. #' #' @param ... A number of transformation functions. #' #' @return `linear_trans` creates a trans object. The other functions #' return a 3x3 transformation matrix. #' #' @export #' @importFrom scales trans_new #' #' @examples #' trans <- linear_trans(rotate(a), shear(1, 0), translate(x1, y1)) #' square <- data.frame(x = c(0, 0, 1, 1), y = c(0, 1, 1, 0)) #' square2 <- trans$transform(square$x, square$y, a = pi / 3, x1 = 4, y1 = 8) #' square3 <- trans$transform(square$x, square$y, a = pi / 1.5, x1 = 2, y1 = -6) #' square <- rbind(square, square2, square3) #' square$group <- rep(1:3, each = 4) #' ggplot(square, aes(x, y, group = group)) + #' geom_polygon(aes(fill = factor(group)), colour = 'black') linear_trans <- function(...) { calls <- as.list(substitute(list2(...)))[-1] transformations <- sapply(calls, deparse) args <- unlist(lapply(calls, function(call) { args <- as.list(call)[-1] as.character(args[sapply(args, 'class') == 'name']) })) args <- unique0(args) if (any(c('x', 'y') %in% args)) { cli::cli_abort('{.arg x} and {.arg y} are preserved argument names') } args <- c('x', 'y', args) trans_fun <- function() { env <- environment() trans_mat <- Reduce(function(l, r) r %*% l, lapply(calls, eval, envir = env)) trans <- trans_mat %*% rbind(x, y, z = 1) data_frame0(x = trans[1, ], y = trans[2, ]) } formals(trans_fun) <- structure(rep(list(quote(expr = )), length(args)), names = args) inv_fun <- function() { env <- environment() trans_mat <- Reduce(function(l, r) r %*% l, lapply(calls, eval, envir = env)) trans_mat <- solve(trans_mat) trans <- trans_mat %*% rbind(x, y, z = 1) data_frame0(x = trans[1, ], y = trans[2, ]) } formals(inv_fun) <- structure(rep(list(quote(expr = )), length(args)), names = args) trans_new( name = paste0('linear: ', paste(transformations, collapse = ', ')), transform = trans_fun, inverse = inv_fun, breaks = extended_breaks(), format = format_format() ) } #' @rdname linear_trans #' @param angle An angle in radians rotate <- function(angle) { matrix(c(cos(angle), -sin(angle), 0, sin(angle), cos(angle), 0, 0, 0, 1), ncol = 3) } #' @rdname linear_trans #' @param x the transformation magnitude in the x-direction #' @param y the transformation magnitude in the x-direction stretch <- function(x, y) { matrix(c(x, 0, 0, 0, y, 0, 0, 0, 1), ncol = 3) } #' @rdname linear_trans shear <- function(x, y) { matrix(c(1, y, 0, x, 1, 0, 0, 0, 1), ncol = 3) } #' @rdname linear_trans translate <- function(x, y) { matrix(c(1, 0, 0, 0, 1, 0, x, y, 1), ncol = 3) } #' @rdname linear_trans reflect <- function(x, y) { l <- x^2 + y^2 matrix( c( (x^2 - y^2) / l, 2 * x * y / l, 0, 2 * x * y / l, (y^2 - x^2) / l, 0, 0, 0, 1 ), ncol = 3 ) } ggforce/R/ggproto-classes.R0000644000176200001440000000057614672274110015342 0ustar liggesusers#' ggforce extensions to ggplot2 #' #' ggforce makes heavy use of the ggproto class system to extend the #' functionality of ggplot2. In general the actual classes should be of little #' interest to users as the standard ggplot2 api of using geom_* and stat_* #' functions for building up the plot is encouraged. #' #' @name ggforce-extensions #' @rdname ggforce-extensions #' NULL ggforce/R/position-jitternormal.R0000644000176200001440000000710714672274110016577 0ustar liggesusers#' Jitter points with normally distributed random noise #' #' [ggplot2::geom_jitter()] adds random noise to points using a uniform #' distribution. When many points are plotted, they appear in a rectangle. This #' position jitters points using a normal distribution instead, resulting in #' more circular clusters. #' #' @family position adjustments #' @param sd_x,sd_y Standard deviation to add along the x and y axes. The #' function uses [stats::rnorm()] with `mean = 0` behind the scenes. #' #' If omitted, defaults to 0.15. As with [ggplot2::geom_jitter()], categorical #' data is aligned on the integers, so a standard deviation of more than 0.2 #' will spread the data so it's not possible to see the distinction between #' the categories. #' @inheritParams ggplot2::position_jitter #' @export #' @examples #' # Example data #' df <- data.frame( #' x = sample(1:3, 1500, TRUE), #' y = sample(1:3, 1500, TRUE) #' ) #' #' # position_jitter results in rectangular clusters #' ggplot(df, aes(x = x, y = y)) + #' geom_point(position = position_jitter()) #' #' # geom_jitternormal results in more circular clusters #' ggplot(df, aes(x = x, y = y)) + #' geom_point(position = position_jitternormal()) #' #' # You can adjust the standard deviations along both axes #' # Tighter circles #' ggplot(df, aes(x = x, y = y)) + #' geom_point(position = position_jitternormal(sd_x = 0.08, sd_y = 0.08)) #' #' # Oblong shapes #' ggplot(df, aes(x = x, y = y)) + #' geom_point(position = position_jitternormal(sd_x = 0.2, sd_y = 0.08)) #' #' # Only add random noise to one dimension #' ggplot(df, aes(x = x, y = y)) + #' geom_point( #' position = position_jitternormal(sd_x = 0.15, sd_y = 0), #' alpha = 0.1 #' ) position_jitternormal <- function(sd_x = NULL, sd_y = NULL, seed = NA) { ggproto(NULL, PositionJitterNormal, sd_x = sd_x, sd_y = sd_y, seed = seed ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export PositionJitterNormal <- ggproto('PositionJitterNormal', Position, seed = NA, required_aes = c('x', 'y'), setup_params = function(self, data) { if (!is.null(self$seed) && is.na(self$seed)) { seed <- sample.int(.Machine$integer.max, 1L) } else { seed <- self$seed } list( sd_x = self$sd_x %||% 0.15, sd_y = self$sd_y %||% 0.15, seed = seed ) }, compute_layer = function(data, params, panel) { trans_x <- if (params$sd_x > 0) { function(x) x + rnorm(length(x), sd = params$sd_x) } trans_y <- if (params$sd_y > 0) { function(x) x + rnorm(length(x), sd = params$sd_y) } # Make sure x and y jitter is only calculated once for all position aesthetics # Takes aesthetic names from ggplot_global x_aes <- intersect(c("x", "xmin", "xmax", "xend", "xintercept", "xmin_final", "xmax_final", "xlower", "xmiddle", "xupper", "x0"), names(data)) x <- if (length(x_aes) == 0) 0 else data[[x_aes[1]]] y_aes <- intersect(c("y", "ymin", "ymax", "yend", "yintercept", "ymin_final", "ymax_final", "lower", "middle", "upper", "y0"), names(data)) y <- if (length(y_aes) == 0) 0 else data[[y_aes[1]]] dummy_data <- data_frame0(x = x, y = y, .size = nrow(data)) fixed_jitter <- with_seed_null(params$seed, transform_position(dummy_data, trans_x, trans_y)) x_jit <- fixed_jitter$x - x y_jit <- fixed_jitter$y - y # Avoid nan values, if x or y has Inf values x_jit[is.infinite(x)] <- 0 y_jit[is.infinite(y)] <- 0 # Apply jitter transform_position(data, function(x) x + x_jit, function(x) x + y_jit) } ) ggforce/R/link.R0000644000176200001440000001412314672274110013154 0ustar liggesusers#' Link points with paths #' #' This set of geoms makes it possible to connect points using straight lines. #' Before you think [ggplot2::geom_segment()] and #' [ggplot2::geom_path()], these functions have some additional tricks #' up their sleeves. geom_link connects two points in the same way as #' [ggplot2::geom_segment()] but does so by interpolating multiple #' points between the two. An additional column called index is added to the #' data with a sequential progression of the interpolated points. This can be #' used to map color or size to the direction of the link. geom_link2 uses the #' same syntax as [ggplot2::geom_path()] but interpolates between the #' aesthetics given by each row in the data. #' #' @section Aesthetics: #' geom_link understand the following aesthetics (required aesthetics are in #' bold): #' #' - **x** #' - **y** #' - **xend** #' - **yend** #' - color #' - size #' - linetype #' - alpha #' - lineend #' #' geom_link2 understand the following aesthetics (required aesthetics are in #' bold): #' #' - **x** #' - **y** #' - color #' - size #' - linetype #' - alpha #' - lineend #' #' @section Computed variables: #' #' \describe{ #' \item{x, y}{The interpolated point coordinates} #' \item{index}{The progression along the interpolation mapped between 0 and 1} #' } #' #' @inheritParams ggplot2::geom_path #' @inheritParams ggplot2::geom_segment #' @inheritParams ggplot2::stat_identity #' #' @param n The number of points to create for each segment #' #' @name geom_link #' @rdname geom_link #' #' @examples #' # Lets make some data #' lines <- data.frame( #' x = c(5, 12, 15, 9, 6), #' y = c(17, 20, 4, 15, 5), #' xend = c(19, 17, 2, 9, 5), #' yend = c(10, 18, 7, 12, 1), #' width = c(1, 10, 6, 2, 3), #' colour = letters[1:5] #' ) #' #' ggplot(lines) + #' geom_link(aes(x = x, y = y, xend = xend, yend = yend, colour = colour, #' alpha = stat(index), size = after_stat(index))) #' #' ggplot(lines) + #' geom_link2(aes(x = x, y = y, colour = colour, size = width, group = 1), #' lineend = 'round', n = 500) #' #' # geom_link0 is simply an alias for geom_segment to put the link geoms in #' # line with the other line geoms with multiple versions. `index` is not #' # available here #' ggplot(lines) + #' geom_link0(aes(x = x, y = y, xend = xend, yend = yend, colour = colour)) NULL #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatLink <- ggproto('StatLink', Stat, compute_panel = function(data, scales, n = 100) { extraCols <- !names(data) %in% c('x', 'y', 'xend', 'yend', 'group', 'PANEL') data$group <- make_unique(data$group) data <- lapply(seq_len(nrow(data)), function(i) { path <- data_frame0( x = seq(data$x[i], data$xend[i], length.out = n), y = seq(data$y[i], data$yend[i], length.out = n), index = seq(0, 1, length.out = n), group = data$group[i] ) cbind(path, data[rep(i, n), extraCols, drop = FALSE]) }) vec_rbind(!!!data) }, required_aes = c('x', 'y', 'xend', 'yend') ) #' @rdname geom_link #' @export stat_link <- function(mapping = NULL, data = NULL, geom = 'path', position = 'identity', na.rm = FALSE, show.legend = NA, n = 100, inherit.aes = TRUE, ...) { layer( stat = StatLink, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, n = n, ...) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom tweenr tween_t #' @export StatLink2 <- ggproto('StatLink2', Stat, compute_panel = function(data, scales, n = 100) { extraCols <- !names(data) %in% c('x', 'y', 'group', 'PANEL', 'frame') extraCols <- names(data)[extraCols] data <- dapply(data, 'group', function(df) { n_group <- n * (nrow(df) - 1) + 1 interp <- tween_t(list(df$x, df$y), n_group) interp <- data_frame0(x = interp[[1]], y = interp[[2]]) interp <- cbind(interp, index = seq(0, 1, length.out = n_group), group = df$group[1], PANEL = df$PANEL[1] ) if ('frame' %in% names(df)) interp$frame <- df$frame[1] nIndex <- seq_len(nrow(interp)) if (length(extraCols) > 0) { cbind(interp, df[nIndex, extraCols, drop = FALSE], .interp = nIndex > nrow(df)) } else { cbind(interp, .interp = nIndex > nrow(df)) } }) data[data$.interp, extraCols] <- data[1, extraCols, drop = FALSE] data }, required_aes = c('x', 'y') ) #' @rdname geom_link #' @export stat_link2 <- function(mapping = NULL, data = NULL, geom = 'path_interpolate', position = 'identity', na.rm = FALSE, show.legend = NA, n = 100, inherit.aes = TRUE, ...) { layer( stat = StatLink2, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, n = n, ...) ) } #' @rdname geom_link #' @export geom_link <- function(mapping = NULL, data = NULL, stat = 'link', position = 'identity', arrow = NULL, lineend = 'butt', na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, n = 100, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomPath, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( arrow = arrow, lineend = lineend, na.rm = na.rm, n = n, ... ) ) } #' @rdname geom_link #' @export geom_link2 <- function(mapping = NULL, data = NULL, stat = 'link2', position = 'identity', arrow = NULL, lineend = 'butt', na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, n = 100, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomPathInterpolate, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( arrow = arrow, lineend = lineend, na.rm = na.rm, n = n, ... ) ) } #' @rdname geom_link #' @export geom_link0 <- geom_segment ggforce/R/scale-unit.R0000644000176200001440000000155514672274110014270 0ustar liggesusers#' Position scales for units data #' #' `r lifecycle::badge('deprecated')` These are the default scales for the units #' class. These will usually be added automatically. To override manually, use #' `scale_*_unit`. #' #' @param ... Passed on to `units::scale_x_units()` or `units::scale_y_units()` #' #' @name scale_unit #' @aliases NULL #' @keywords internal NULL #' @rdname scale_unit #' @export #' @importFrom scales censor scale_x_unit <- function(...) { lifecycle::deprecate_soft('0.3.4', "scale_x_unit()", "units::scale_x_units()") check_installed('units', 'to use scale_x_unit') units::scale_x_units(...) } #' @rdname scale_unit #' @export #' @importFrom scales censor scale_y_unit <- function(...) { lifecycle::deprecate_soft('0.3.4', "scale_y_unit()", "units::scale_y_units()") check_installed('units', 'to use scale_y_unit') units::scale_y_units(...) } ggforce/R/errorbar.R0000644000176200001440000000334714672274110014043 0ustar liggesusers#' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatErr <- ggproto( "StatErr", Stat, required_aes = c('xmin', 'x', 'xmax', 'ymin', 'y', 'ymax'), compute_group = function(data, scales) { data_frame0( x = c(data$xmin, data$x), xend = c(data$xmax, data$x), y = c(data$y, data$ymin), yend = c(data$y, data$ymax) )[c(matrix(seq_len(2 * nrow(data)), nrow = 2, byrow = TRUE)), ] } ) #' Intervals in vertical and horizontal directions #' #' `stat_err` draws intervals of points (`x`, `y`) in vertical (`ymin`, `ymax`) #' and horizontal (`xmin`, `xmax`) directions. #' #' @section Aesthetics: #' `stat_err()` understands the following aesthetics (required aesthetics are in #' bold): #' #' - **x** #' - **xmin** #' - **xmax** #' - **y** #' - **ymin** #' - **ymax** #' - alpha #' - color #' - group #' - linetype #' - linewidth #' #' @examples #' library(ggplot2) #' #' x <- 1:3 #' xmin <- x - 2.5 #' xmax <- x + 2.5 #' d <- data.frame( #' x = x, y = x, xmin = xmin, ymin = xmin, xmax = xmax, ymax = xmax, #' color = as.factor(x) #' ) #' ggplot( #' d, #' aes(x = x, y = y, xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, color = color) #' ) + #' stat_err(size = 2) #' #' @inheritParams ggplot2::layer #' @inheritParams ggplot2::geom_errorbar #' @inheritParams ggplot2::stat_identity #' #' @importFrom ggplot2 layer #' #' @export stat_err <- function( mapping = NULL, data = NULL, geom = "segment", position = "identity", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) { layer( stat = StatErr, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, ...) ) } ggforce/R/parallel_sets.R0000644000176200001440000003601214672274110015052 0ustar liggesusers#' Create Parallel Sets diagrams #' #' A parallel sets diagram is a type of visualisation showing the interaction #' between multiple categorical variables. If the variables has an intrinsic #' order the representation can be thought of as a Sankey Diagram. If each #' variable is a point in time it will resemble an alluvial diagram. #' #' In a parallel sets visualization each categorical variable will be assigned #' a position on the x-axis. The size of the intersection of categories from #' neighboring variables are then shown as thick diagonals, scaled by the sum of #' elements shared between the two categories. The natural data representation #' for such as plot is to have each categorical variable in a separate column #' and then have a column giving the amount/magnitude of the combination of #' levels in the row. This representation is unfortunately not fitting for the #' `ggplot2` API which needs every position encoding in the same column. To make #' it easier to work with `ggforce` provides a helper [gather_set_data()], which #' takes care of the transformation. #' #' @section Aesthetics: #' geom_parallel_sets understand the following aesthetics #' (required aesthetics are in bold): #' #' - **x|y** #' - **id** #' - **split** #' - **value** #' - color #' - fill #' - size #' - linetype #' - alpha #' - lineend #' #' @inheritParams geom_diagonal_wide #' @param sep The proportional separation between categories within a variable #' @param axis.width The width of the area around each variable axis #' @param angle The angle of the axis label text #' @param nudge_x,nudge_y Horizontal and vertical adjustment to nudge labels by. #' Useful for offsetting text from the category segments. #' #' @inheritSection ggplot2::geom_line Orientation #' #' @name geom_parallel_sets #' @rdname geom_parallel_sets #' #' @author Thomas Lin Pedersen #' #' @examples #' data <- reshape2::melt(Titanic) #' data <- gather_set_data(data, 1:4) #' #' ggplot(data, aes(x, id = id, split = y, value = value)) + #' geom_parallel_sets(aes(fill = Sex), alpha = 0.3, axis.width = 0.1) + #' geom_parallel_sets_axes(axis.width = 0.1) + #' geom_parallel_sets_labels(colour = 'white') #' #' # Use nudge_x to offset and hjust = 0 to left-justify label #' ggplot(data, aes(x, id = id, split = y, value = value)) + #' geom_parallel_sets(aes(fill = Sex), alpha = 0.3, axis.width = 0.1) + #' geom_parallel_sets_axes(axis.width = 0.1) + #' geom_parallel_sets_labels(colour = 'red', angle = 0, nudge_x = 0.1, hjust = 0) NULL #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatParallelSets <- ggproto('StatParallelSets', Stat, setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE) params }, setup_data = function(data, params) { value_check <- lapply(split(data$value, data$id), unique0) if (any(lengths(value_check) != 1)) { cli::cli_abort('{.field value} must be kept constant across {.field id}') } data$split <- as.factor(data$split) data$flipped_aes <- params$flipped_aes data }, compute_panel = function(data, scales, sep = 0.05, strength = 0.5, n = 100, axis.width = 0, flipped_aes = FALSE) { data <- flip_data(data, flipped_aes) data <- remove_group(data) data <- complete_data(data) cols <- c('group', 'colour', 'color', 'fill', 'size', 'linewidth', 'alpha', 'linetype') data_groups <- vec_rbind( !!!lapply(split(data[, names(data) %in% cols, drop = FALSE], data$group), function(d) { data_frame0(!!!lapply(d, function(x) na.omit(x)[1])) } ) ) # Calculate axis sizes data_axes <- sankey_axis_data(data, sep) # Calculate diagonals diagonals <- sankey_diag_data(data, data_axes, data_groups, axis.width) diagonals <- flip_data(diagonals, flipped_aes) StatDiagonalWide$compute_panel(diagonals, scales, strength, n, flipped_aes) }, required_aes = c('x|y', 'id', 'split', 'value'), extra_params = c('na.rm', 'n', 'sep', 'strength', 'axis.width', 'orientation') ) #' @rdname geom_parallel_sets #' @export stat_parallel_sets <- function(mapping = NULL, data = NULL, geom = 'shape', position = 'identity', n = 100, strength = 0.5, sep = 0.05, axis.width = 0, na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, ...) { layer( stat = StatParallelSets, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( na.rm = na.rm, orientation = orientation, n = n, strength = strength, sep = sep, axis.width = axis.width, ... ) ) } #' @rdname geom_parallel_sets #' @export geom_parallel_sets <- function(mapping = NULL, data = NULL, stat = 'parallel_sets', position = 'identity', n = 100, na.rm = FALSE, orientation = NA, sep = 0.05, strength = 0.5, axis.width = 0, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomShape, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( na.rm = na.rm, orientation = orientation, n = n, strength = strength, sep = sep, axis.width = axis.width, ... ) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatParallelSetsAxes <- ggproto('StatParallelSetsAxes', Stat, setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE) params }, setup_data = function(data, params) { value_check <- lapply(split(data$value, data$id), unique0) if (any(lengths(value_check) != 1)) { cli::cli_abort('{.field value} must be kept constant across {.field id}') } data$split <- as.factor(data$split) data$flipped_aes <- params$flipped_aes data }, compute_panel = function(data, scales, sep = 0.05, axis.width = 0, flipped_aes = FALSE) { data <- flip_data(data, flipped_aes) split_levels <- levels(data$split) data <- remove_group(data) data <- complete_data(data, FALSE) # Calculate axis sizes data_axes <- sankey_axis_data(data, sep) data_axes <- data_axes[data_axes$split != '.ggforce_missing', ] cols <- c('x', 'split', 'colour', 'color', 'fill', 'size', 'linewidth', 'alpha', 'linetype') aes <- data[, names(data) %in% cols] aes <- unique0(aes) if (nrow(aes) != nrow(data_axes)) { cli::cli_abort('Axis aesthetics must be constant in each split') } data_axes$split <- factor(as.character(data_axes$split), levels = split_levels) aes$split <- factor(as.character(aes$split), levels = split_levels) data <- merge(data_axes, aes, by = c('x', 'split'), all.x = TRUE, sort = FALSE) names(data)[names(data) == 'split'] <- 'label' data$y <- data$ymin + data$value / 2 data$xmin <- data$x - axis.width / 2 data$xmax <- data$x + axis.width / 2 flip_data(data, flipped_aes) }, required_aes = c('x|y', 'id', 'split', 'value'), extra_params = c('na.rm', 'sep', 'orientation') ) #' @rdname geom_parallel_sets #' @export stat_parallel_sets_axes <- function(mapping = NULL, data = NULL, geom = 'parallel_sets_axes', position = 'identity', sep = 0.05, axis.width = 0, na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, ...) { layer( stat = StatParallelSetsAxes, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, orientation = orientation, sep = sep, axis.width = axis.width, ...) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export GeomParallelSetsAxes <- ggproto('GeomParallelSetsAxes', GeomShape, setup_data = function(data, params) { flipped_aes <- has_flipped_aes(data, params) data <- flip_data(data, flipped_aes) data$group <- seq_len(nrow(data)) lb <- data lb$x <- lb$xmin lb$y <- lb$ymin rb <- data rb$x <- rb$xmax rb$y <- rb$ymin lt <- data lt$x <- lt$xmin lt$y <- lt$ymax rt <- data rt$x <- rt$xmax rt$y <- rt$ymax data <- vec_rbind(lb, rb, rt, lt) flip_data(data[order(data$group), ], flipped_aes) }, required_aes = c('xmin', 'ymin', 'xmax', 'ymax') ) #' @rdname geom_parallel_sets #' @export geom_parallel_sets_axes <- function(mapping = NULL, data = NULL, stat = 'parallel_sets_axes', position = 'identity', na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomParallelSetsAxes, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, orientation = orientation, ...) ) } #' @rdname geom_parallel_sets #' @export geom_parallel_sets_labels <- function(mapping = NULL, data = NULL, stat = 'parallel_sets_axes', angle = -90, nudge_x = 0, nudge_y = 0, position = 'identity', na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, ...) { if (!missing(nudge_x) || !missing(nudge_y)) { if (!missing(position)) { cli::cli_abort(c( "both {.arg position} and {.arg nudge_x}/{.arg nudge_y} are supplied", "i" = "Only use one approach to alter the position" )) } position <- position_nudge(nudge_x, nudge_y) } layer( data = data, mapping = mapping, stat = stat, geom = GeomText, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, orientation = orientation, angle = angle, ...) ) } #' Tidy data for use with geom_parallel_sets #' #' This helper function makes it easy to change tidy data into a tidy(er) format #' that can be used by geom_parallel_sets. #' #' @param data A tidy dataframe with some categorical columns #' @param x The columns to use for axes in the parallel sets diagram #' @param id_name The name of the column that will contain the original index of #' the row. #' #' @return A data.frame #' #' @export #' #' @examples #' data <- reshape2::melt(Titanic) #' head(gather_set_data(data, 1:4)) #' head(gather_set_data(data, c("Class","Sex","Age","Survived"))) gather_set_data <- function(data, x, id_name = 'id') { columns <- tidyselect::eval_select(enquo(x), data) data[[id_name]] <- seq_len(nrow(data)) vec_rbind(!!!lapply(names(columns), function(n) { data$x <- n data$y <- data[[n]] data })) } #' @importFrom stats na.omit complete_data <- function(data, check_id = TRUE) { levels(data$split) <- c(levels(data$split), '.ggforce_missing') all_obs <- unique0(data[, c('id', 'value')]) data <- vec_rbind(!!!lapply(split(data, data$x), function(d) { if (anyDuplicated(d$id) != 0) { cli::cli_abort('{.field id} must be unique within axes') } x <- d$x[1] if (length(d$id) != nrow(all_obs)) { n_miss <- nrow(all_obs) - length(d$id) fill <- d[seq_len(n_miss), ][NA, ] fill$x <- x fill[, c('id', 'value')] <- all_obs[!d$id %in% all_obs$id, ] fill$split <- '.ggforce_missing' d <- vec_rbind(d, fill) } d })) if (check_id) { # Ensure id grouping id_groups <- lapply(split(data$group, data$id), function(x) unique0(na.omit(x))) if (any(lengths(id_groups) != 1)) { cli::cli_abort('{.field id} must keep grouping across data') } id_match <- match(as.character(data$id), names(id_groups)) data$group <- unlist(id_groups)[id_match] } data[order(data$x, data$id), ] } sankey_axis_data <- function(data, sep) { vec_rbind(!!!lapply(split(data, data$x), function(d) { splits <- split(d$value, as.character(d$split)) splits <- splits[rev(order(match(names(splits), levels(d$split))))] d <- data_frame0( split = factor(names(splits)), value = sapply(splits, sum), x = d$x[1] ) sep <- sum(d$value) * sep d$ymax <- (seq_len(nrow(d)) - 1) * sep + cumsum(d$value) d$ymin <- d$ymax - d$value d })) } sankey_diag_data <- function(data, axes_data, groups, axis.width) { axes <- sort(unique0(data$x)) diagonals <- lapply(seq_len(length(axes) - 1), function(i) { from <- data[data$x == axes[i], , drop = FALSE] to <- data[data$x == axes[i + 1], , drop = FALSE] diagonals <- split( seq_len(nrow(from)), list(from$group, from$split, to$split) ) diagonals <- diagonals[lengths(diagonals) != 0] diag_rep <- sapply(diagonals, `[`, 1) diag_from <- data_frame0( group = from$group[diag_rep], split = from$split[diag_rep], value = sapply(diagonals, function(ii) sum(from$value[ii])), x = from$x[1] + axis.width / 2 ) diag_to <- diag_from diag_to$split <- to$split[diag_rep] diag_to$x <- to$x[1] - axis.width / 2 diag_from <- add_y_pos(diag_from, axes_data[axes_data$x == axes[i], ]) diag_to <- add_y_pos(diag_to, axes_data[axes_data$x == axes[i + 1], ]) diagonals <- vec_rbind(diag_from, diag_to) main_groups <- diagonals$group diagonals$group <- rep(seq_len(nrow(diag_from) / 2), 4) if (length(setdiff(names(groups), 'group')) > 0) { diagonals <- cbind( diagonals, groups[match(main_groups, groups$group), names(groups) != 'group', drop = FALSE] ) } diagonals }) n_groups <- sapply(diagonals, nrow) / 4 group_offset <- c(0, cumsum(n_groups)[-length(n_groups)]) vec_rbind(!!!Map(function(d, i) { d$group <- d$group + i d }, d = diagonals, i = group_offset)) } add_y_pos <- function(data, axes_data) { splits <- split(seq_len(nrow(data)), as.character(data$split)) ymin <- lapply(splits, function(i) { split <- as.character(data$split[i[1]]) sizes <- data$value[i] ymin <- axes_data$ymax[axes_data$split == split] - cumsum(sizes[order(data$group[i])]) ymin[order(data$group[i])] <- ymin ymin }) data$y[unlist(splits)] <- unlist(ymin) data_tmp <- data data_tmp$y <- data$y + data$value vec_rbind(data_tmp, data) } remove_group <- function(data) { split_groups <- lapply(split(data$group, data$split), unique0) if (length(Reduce(intersect, split_groups)) == 0) { disc <- vapply(data, is.discrete, logical(1)) disc[names(disc) %in% c('split', 'label', 'PANEL')] <- FALSE if (any(disc)) { data$group <- id(data[disc], drop = TRUE) } else { data$group <- -1 } } data } is.discrete <- function(x) { is.factor(x) || is.character(x) || is.logical(x) } ggforce/R/concaveman.R0000644000176200001440000000031714672274110014331 0ustar liggesusersconcaveman <- function(points, concavity, threshold) { if (nrow(points) < 4) return(unname(points)) hull <- as.integer(grDevices::chull(points)) - 1L concaveman_c(points, hull, concavity, threshold) } ggforce/R/autodensity.R0000644000176200001440000000736714672274110014603 0ustar liggesusers#' @rdname geom_autohistogram #' @inheritParams ggplot2::geom_point #' @inheritParams ggplot2::geom_density #' @export geom_autodensity <- function(mapping = NULL, data = NULL, stat = "autodensity", position = "floatstack", ..., bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, trim = FALSE, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, outline.type = "upper") { extra_mapping <- aes(x = .panel_x, y = .panel_y) if (is.null(mapping$x)) mapping$x <- extra_mapping$x if (is.null(mapping$y)) mapping$y <- extra_mapping$y class(mapping) <- 'uneval' layer( data = data, mapping = mapping, stat = stat, geom = GeomAutoarea, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( bw = bw, adjust = adjust, kernel = kernel, n = n, trim = trim, na.rm = na.rm, ..., outline.type = outline.type ) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export StatAutodensity <- ggproto('StatAutodensity', StatDensity, setup_params = function(data, params) { params$panel_range <- lapply(split(data$y, data$PANEL), function(y) { if (length(y) == 0) return() range(y, na.rm=TRUE) }) params$panel_count <- lapply(split(data$y, data$PANEL), function(y)length(y[is.finite(y)])) params }, compute_group = function(self, data, scales, bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, trim = FALSE, na.rm = FALSE, panel_range = list(), panel_count = list()) { if (scales$x$is_discrete()) { bins <- split(data, factor(data$x, levels = seq_len(scales$x$range_c$range[2]))) binned <- lapply(as.integer(names(bins)), function(x) { count <- nrow(bins[[x]]) pad <- if (count == 0) 0.5 else 0.3 pad <- pad * c(-1, 1) data_frame0( x = x + pad, density = count / nrow(data) ) }) binned <- vec_rbind(!!!binned) binned$scaled <- binned$density / max(binned$density) binned$ndensity <- binned$density / max(binned$density) binned$count <- binned$density * nrow(data) binned$n <- nrow(data) } else { binned <- ggproto_parent(StatDensity, self)$compute_group( data, scales, bw = bw, adjust = adjust, kernel = kernel, n = n, trim = trim, na.rm = na.rm ) } panel_range <- panel_range[[data$PANEL[1]]] panel_count <- panel_count[[data$PANEL[1]]] ymin <- panel_range[1] binned$y <- ymin + binned$ndensity * (panel_range[2] - panel_range[1]) * nrow(data) / panel_count binned$ymin <- ymin binned$ymax <- binned$y binned }, default_aes = aes(weight = 1), required_aes = c("x", "y") ) #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export GeomAutoarea <- ggproto('GeomAutoarea', GeomArea, setup_data = function(data, params) { data[order(data$PANEL, data$group, data$x), ] }, draw_panel = function(self, data, panel_params, coord, na.rm = FALSE, ...) { y_range <- coord$range(panel_params)$y y_span <- y_range[2] - y_range[1] panel_min <- min(data$ymin) panel_span <- max(data$ymax) - panel_min data$ymin <- ((data$ymin - panel_min) / panel_span) * y_span * 0.9 + y_range[1] data$ymax <- ((data$ymax - panel_min) / panel_span) * y_span * 0.9 + y_range[1] ggproto_parent(GeomArea, self)$draw_panel( data = data, panel_params = panel_params, coord = coord, na.rm = na.rm, ... ) } ) ggforce/R/spiro.R0000644000176200001440000001023014672274110013346 0ustar liggesusers#' Draw spirograms based on the radii of the different "wheels" involved #' #' This, rather pointless, geom allows you to draw spirograms, as known from the #' popular drawing toy where lines were traced by inserting a pencil into a hole #' in a small gear that would then trace around inside another gear. The #' potential practicality of this geom is slim and it excists mainly for fun and #' art. #' #' @section Aesthetics: #' stat_spiro and geom_spiro understand the following aesthetics (required #' aesthetics are in bold): #' #' - **R** #' - **r** #' - **d** #' - x0 #' - y0 #' - outer #' - color #' - size #' - linetype #' - alpha #' #' @section Computed variables: #' #' \describe{ #' \item{x, y}{The coordinates for the path describing the spirogram} #' \item{index}{The progression along the spirogram mapped between 0 and 1} #' } #' #' @inheritParams ggplot2::geom_path #' @inheritParams ggplot2::stat_identity #' #' @param n The number of points that should be used to draw a fully closed #' spirogram. If `revolutions < 1` the actual number of points will be less #' than this. #' #' @param revolutions The number of times the inner gear should revolve around #' inside the outer gear. If `NULL` the number of revolutions to reach the #' starting position is calculated and used. #' #' @name geom_spiro #' @rdname geom_spiro #' #' @examples #' # Basic usage #' ggplot() + #' geom_spiro(aes(R = 10, r = 3, d = 5)) #' #' # Only draw a portion #' ggplot() + #' geom_spiro(aes(R = 10, r = 3, d = 5), revolutions = 1.2) #' #' # Let the inner gear circle the outside of the outer gear #' ggplot() + #' geom_spiro(aes(R = 10, r = 3, d = 5, outer = TRUE)) NULL #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom MASS fractions #' @export StatSpiro <- ggproto('StatSpiro', Stat, compute_panel = function(data, scales, n = 500, revolutions = NULL) { if (empty_data(data)) return(data) if (is.null(data$outer)) data$outer <- FALSE if (is.null(data$x0)) data$x0 <- 0 if (is.null(data$y0)) data$y0 <- 0 n_spiro <- nrow(data) data$group <- make_unique(data$group) if (is.null(revolutions)) { revo <- attr(fractions(data$r / data$R), 'fracs') revo <- as.numeric(sub('/.*$', '', revo)) } else { revo <- revolutions } data <- data[rep(seq_len(n_spiro), n * revo), ] data$rho <- unlist(lapply(revo, function(r) { seq(0, 2 * pi * r, length.out = n * r) })) data$index <- unlist(lapply(revo, function(r) { seq(0, 1, length.out = n * r) })) data$x <- data$x0 + ifelse( data$outer, (data$R + data$r) * cos(data$rho) - data$d * cos(data$rho * (data$R + data$r) / data$r), (data$R - data$r) * cos(data$rho) + data$d * cos(data$rho * (data$R - data$r) / data$r) ) data$y <- data$y0 + ifelse( data$outer, (data$R + data$r) * sin(data$rho) - data$d * sin(data$rho * (data$R + data$r) / data$r), (data$R - data$r) * sin(data$rho) - data$d * sin(data$rho * (data$R - data$r) / data$r) ) data }, required_aes = c('R', 'r', 'd'), default_aes = aes(outer = FALSE, x0 = 0, y0 = 0), extra_params = c('na.rm', 'n', 'revolutions') ) #' @rdname geom_spiro #' @export stat_spiro <- function(mapping = NULL, data = NULL, geom = 'path', position = 'identity', na.rm = FALSE, n = 500, revolutions = NULL, show.legend = NA, inherit.aes = TRUE, ...) { layer( stat = StatSpiro, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, n = n, revolutions = revolutions, ...) ) } #' @rdname geom_spiro #' @export geom_spiro <- function(mapping = NULL, data = NULL, stat = 'spiro', position = 'identity', arrow = NULL, n = 500, lineend = 'butt', na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomPath, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(arrow = arrow, lineend = lineend, na.rm = na.rm, n = n, ...) ) } ggforce/R/circle.R0000644000176200001440000000627514672274110013471 0ustar liggesusers#' @include arc_bar.R #' @include shape.R NULL #' Circles based on center and radius #' #' This set of stats and geoms makes it possible to draw circles based on a #' center point and a radius. In contrast to using #' [ggplot2::geom_point()], the size of the circles are related to the #' coordinate system and not to a separate scale. These functions are intended #' for cartesian coordinate systems and will only produce a true circle if #' [ggplot2::coord_fixed()] is used. #' #' @note If the intend is to draw a bubble chart then use #' [ggplot2::geom_point()] and map a variable to the size scale #' #' @section Aesthetics: #' geom_circle understand the following aesthetics (required aesthetics are in #' bold): #' #' - **x0** #' - **y0** #' - **r** #' - color #' - fill #' - linewidth #' - linetype #' - alpha #' - lineend #' #' @section Computed variables: #' #' \describe{ #' \item{x, y}{The start coordinates for the segment} #' } #' #' @inheritParams ggplot2::geom_path #' @inheritParams ggplot2::stat_identity #' #' @param n The number of points on the generated path per full circle. #' #' @name geom_circle #' @rdname geom_circle #' @seealso [geom_arc_bar()] for drawing arcs with fill #' #' @examples #' # Lets make some data #' circles <- data.frame( #' x0 = rep(1:3, 3), #' y0 = rep(1:3, each = 3), #' r = seq(0.1, 1, length.out = 9) #' ) #' #' # Behold some circles #' ggplot() + #' geom_circle(aes(x0 = x0, y0 = y0, r = r, fill = r), data = circles) #' #' # Use coord_fixed to ensure true circularity #' ggplot() + #' geom_circle(aes(x0 = x0, y0 = y0, r = r, fill = r), data = circles) + #' coord_fixed() #' NULL #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @importFrom grid arcCurvature #' @export StatCircle <- ggproto('StatCircle', Stat, compute_panel = function(data, scales, n = 360) { # Avoid some weird interaction if x and y are mapped at the global level data$x <- NULL data$y <- NULL data$start <- 0 data$end <- 2 * pi arcPaths(data, n + 1) }, required_aes = c('x0', 'y0', 'r') ) #' @rdname geom_circle #' @export stat_circle <- function(mapping = NULL, data = NULL, geom = 'circle', position = 'identity', n = 360, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( stat = StatCircle, data = data, mapping = mapping, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(na.rm = na.rm, n = n, ...) ) } #' @rdname ggforce-extensions #' @format NULL #' @usage NULL #' @export GeomCircle <- ggproto('GeomCircle', GeomShape, default_aes = combine_aes(GeomShape$default_aes, aes(colour = 'black', fill = NA)) ) #' @rdname geom_circle #' @inheritParams geom_shape #' @export geom_circle <- function(mapping = NULL, data = NULL, stat = 'circle', position = 'identity', n = 360, expand = 0, radius = 0, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( data = data, mapping = mapping, stat = stat, geom = GeomCircle, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list2(n = n, na.rm = na.rm, ...) ) } ggforce/LICENSE.note0000644000176200001440000000553614672274110013654 0ustar liggesusers-------------------------------------------------------------------------------- The concaveman.h file is redistributed with the following license BSD 2-Clause License Copyright (c) 2019, sadaszewski All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- The robust-predicates code used in concaveman is redistributed with the following license `Robust-Predicate` is licensed under the following terms: This program may be freely redistributed under the condition that the copyright notices (including this entire header) are not removed, and no compensation is received through use of the software. Private, research, and institutional use is free. You may distribute modified versions of this code `UNDER THE CONDITION THAT THIS CODE AND ANY MODIFICATIONS MADE TO IT IN THE SAME FILE REMAIN UNDER COPYRIGHT OF THE ORIGINAL AUTHOR, BOTH SOURCE AND OBJECT CODE ARE MADE FREELY AVAILABLE WITHOUT CHARGE, AND CLEAR NOTICE IS GIVEN OF THE MODIFICATIONS`. Distribution of this code as part of a commercial system is permissible `ONLY BY DIRECT ARRANGEMENT WITH THE AUTHOR`. (If you are not directly supplying this code to a customer, and you are instead telling them how they can obtain it for free, then you are not required to make any arrangement with me.) `DISCLAIMER`: Neither I nor: Columbia University, the Massachusetts Institute of Technology, the University of Sydney, nor the National Aeronautics and Space Administration warrant this code in any way whatsoever. This code is provided "as-is" to be used at your own risk. -------------------------------------------------------------------------------- ggforce/src/0000755000176200001440000000000015024525117012457 5ustar liggesusersggforce/src/concaveman.h0000644000176200001440000005265215024476200014752 0ustar liggesusers// // Author: Stanislaw Adaszewski, 2019 // C++ port from https://github.com/mapbox/concaveman (js) // // Comments from js repo added by wheeled // #pragma once #include #include #include #include #include #include #include #include #include #include #include #include #include #include "robust_predicate/geompred.hpp" //#define DEBUG // uncomment to dump debug info to screen //#define DEBUG_2 // uncomment to dump second-level debug info to screen template class compare_first { public: bool operator()(const T &a, const T &b) { return (std::get<0>(a) < std::get<0>(b)); } }; template double orient_2d(const std::array &a, const std::array &b, const std::array &c) { static double coords[6] = {0,0,0,0,0,0}; coords[0] = a[0]; coords[1] = a[1]; coords[2] = b[0]; coords[3] = b[1]; coords[4] = c[0]; coords[5] = c[1]; return geompred::orient2d(coords, coords+2, coords+4); } // check if the edges (p1,q1) and (p2,q2) intersect template bool intersects( const std::array &p1, const std::array &q1, const std::array &p2, const std::array &q2) { auto res = (p1[0] != q2[0] || p1[1] != q2[1]) && (q1[0] != p2[0] || q1[1] != p2[1]) && (orient_2d(p1, q1, p2) > 0) != (orient_2d(p1, q1, q2) > 0) && (orient_2d(p2, q2, p1) > 0) != (orient_2d(p2, q2, q1) > 0); return res; } // square distance between 2 points template T getSqDist( const std::array &p1, const std::array &p2) { auto dx = p1[0] - p2[0]; auto dy = p1[1] - p2[1]; return dx * dx + dy * dy; } // square distance from a point to a segment template T sqSegDist( const std::array &p, const std::array &p1, const std::array &p2) { auto x = p1[0]; auto y = p1[1]; auto dx = p2[0] - x; auto dy = p2[1] - y; if (std::abs(dx) < 1e-10) dx = 0; if (std::abs(dy) < 1e-10) dy = 0; if (dx != 0 || dy != 0) { auto t = ((p[0] - x) * dx + (p[1] - y) * dy) / (dx * dx + dy * dy); if (t > 1) { x = p2[0]; y = p2[1]; } else if (t > 0) { x += dx * t; y += dy * t; } } else if (dx == 0) { auto ymin = std::min(p1[1], p2[1]); auto ymax = std::max(p1[1], p2[1]); y = std::min(ymax, std::max(ymin, p[1])); } else { auto xmin = std::min(p1[0], p2[0]); auto xmax = std::max(p1[0], p2[0]); y = std::min(xmax, std::max(xmin, p[0])); } dx = p[0] - x; dy = p[1] - y; return dx * dx + dy * dy; } // segment to segment distance, ported from http://geomalgorithms.com/a07-_distance.html by Dan Sunday template T sqSegSegDist(T x0, T y0, T x1, T y1, T x2, T y2, T x3, T y3) { auto ux = x1 - x0; auto uy = y1 - y0; auto vx = x3 - x2; auto vy = y3 - y2; auto wx = x0 - x2; auto wy = y0 - y2; auto a = ux * ux + uy * uy; auto b = ux * vx + uy * vy; auto c = vx * vx + vy * vy; auto d = ux * wx + uy * wy; auto e = vx * wx + vy * wy; auto D = a * c - b * b; T sc, sN, tc, tN; auto sD = D; auto tD = D; if (D < 1e-10) { sN = 0; sD = 1; tN = e; tD = c; } else { sN = b * e - c * d; tN = a * e - b * d; if (sN < 0) { sN = 0; tN = e; tD = c; } else if (sN > sD) { sN = sD; tN = e + b; tD = c; } } if (tN < 0) { tN = 0; if (-d < 0) sN = 0; else if (-d > a) sN = sD; else { sN = -d; sD = a; } } else if (tN > tD) { tN = tD; if (-d + b < 0) sN = 0; else if (-d + b > a) sN = sD; else { sN = -d + b; sD = a; } } sc = ((std::abs(sN) < 1e-10) ? 0 : sN / sD); tc = ((std::abs(tN) < 1e-10) ? 0 : tN / tD); auto cx = (1 - sc) * x0 + sc * x1; auto cy = (1 - sc) * y0 + sc * y1; auto cx2 = (1 - tc) * x2 + tc * x3; auto cy2 = (1 - tc) * y2 + tc * y3; auto dx = cx2 - cx; auto dy = cy2 - cy; return dx * dx + dy * dy; } template class rtree { public: typedef rtree type; typedef const type const_type; typedef type *type_ptr; typedef const type *type_const_ptr; typedef std::array bounds_type; typedef DATA data_type; rtree(): m_is_leaf(false), m_data() { for (auto i = 0; i < DIM; i++) { m_bounds[i] = std::numeric_limits::max(); m_bounds[i + DIM] = std::numeric_limits::min(); } } rtree(data_type data, const bounds_type &bounds): m_is_leaf(true), m_data(data), m_bounds(bounds) { for (auto i = 0; i < DIM; i++) if (bounds[i] > bounds[i + DIM]) throw std::runtime_error("Bounds minima have to be less than maxima"); } void insert(data_type data, const bounds_type &bounds) { if (m_is_leaf) throw std::runtime_error("Cannot insert into leaves"); m_bounds = updated_bounds(bounds); if (m_children.size() < MAX_CHILDREN) { auto r = std::make_unique(data, bounds); m_children.push_back(std::move(r)); return; } std::reference_wrapper best_child = *m_children.begin()->get(); auto best_volume = volume(best_child.get().updated_bounds(bounds)); for (auto it = ++m_children.begin(); it != m_children.end(); it++) { auto v = volume((*it)->updated_bounds(bounds)); if (v < best_volume) { best_volume = v; best_child = *it->get(); } } if (!best_child.get().is_leaf()) { best_child.get().insert(data, bounds); #ifdef DEBUG std::cout << "best_child: " << bounds[0] << " " << bounds[1] << std::endl; #endif return; } auto leaf = std::make_unique(best_child.get().data(), best_child.get().bounds()); best_child.get().m_is_leaf = false; best_child.get().m_data = data_type(); best_child.get().m_children.push_back(std::move(leaf)); best_child.get().insert(data, bounds); } void intersection(const bounds_type &bounds, std::vector> &res) const { if (!intersects(bounds)) return; if (m_is_leaf) { res.push_back(*this); return; } for (auto &ch : m_children) ch->intersection(bounds, res); } std::vector> intersection(const bounds_type& bounds) const { std::vector> res; intersection(bounds, res); return res; } bool intersects(const bounds_type &bounds) const { for (auto i = 0; i < DIM; i++) { if (m_bounds[i] > bounds[i + DIM]) return false; if (m_bounds[i + DIM] < bounds[i]) return false; } return true; } void erase(data_type data, const bounds_type &bounds) { if (m_is_leaf) throw std::runtime_error("Cannot erase from leaves"); if (!intersects(bounds)) return; for (auto it = m_children.begin(); it != m_children.end(); ) { if (!(*it)->m_is_leaf) { (*it)->erase(data, bounds); it++; } else if ((*it)->m_data == data && (*it)->m_bounds == bounds) { m_children.erase(it++); } else it++; } } void print(int level = 0) { // print the entire tree for (auto it = m_children.begin(); it != m_children.end(); ) { auto bounds = (*it)->m_bounds; std::string pad(level, '\t'); if ((*it)->m_is_leaf) { printf ("%s leaf %0.6f %0.6f \n", pad.c_str(), bounds[0], bounds[1]); } else { printf ("%s branch %0.6f %0.6f %0.6f %0.6f \n", pad.c_str(), bounds[0], bounds[1], bounds[2], bounds[3]); (*it)->print(level + 1); } it++; } } bounds_type updated_bounds(const bounds_type &child_bounds) const { bounds_type res; for (auto i = 0; i < DIM; i++) { res[i] = std::min(child_bounds[i], m_bounds[i]); res[i + DIM] = std::max(child_bounds[i + DIM], m_bounds[i + DIM]); } return res; } static T volume(const bounds_type &bounds) { T res = 1; for (auto i = 0; i < DIM; i++) { auto delta = bounds[i + DIM] - bounds[i]; res *= delta; } return res; } const bounds_type& bounds() const { return m_bounds; } bool is_leaf() const { return m_is_leaf; } data_type data() const { return m_data; } const std::list>& children() const { return m_children; } static std::string bounds_to_string(const bounds_type &bounds) { std::string res = "( "; for (auto i = 0; i < DIM * 2; i++) { if (i > 0) res += ", "; res += std::to_string(bounds[i]); } res += " )"; return res; } void to_string(std::string &res, int tab) const { std::string pad(tab, '\t'); if (m_is_leaf) { res += pad + "{ data: " + std::to_string(m_data) + ", bounds: " + bounds_to_string(m_bounds) + " }"; return; } res += pad + "{ bounds: " + bounds_to_string(m_bounds) + ", children: [\n"; auto i = 0; for (auto &ch : m_children) { if (i++ > 0) res += "\n"; ch->to_string(res, tab + 1); } res += "\n" + pad + "]}"; } std::string to_string() const { std::string res; to_string(res, 0); return res; } private: bool m_is_leaf; data_type m_data; std::list> m_children; bounds_type m_bounds; }; template struct Node { typedef Node type; typedef type *type_ptr; typedef std::array point_type; Node(): p(), minX(), minY(), maxX(), maxY() { } Node(const point_type &p): Node() { this->p = p; } point_type p; T minX; T minY; T maxX; T maxY; }; template class CircularList; template class CircularElement { public: typedef CircularElement type; typedef type *ptr_type; template CircularElement(Args&&... args): m_data(std::forward(args)...) { } T& data() { return m_data; } template CircularElement* insert(Args&&... args) { auto elem = new CircularElement(std::forward(args)...); elem->m_prev = this; elem->m_next = m_next; m_next->m_prev = elem; m_next = elem; return elem; } CircularElement* prev() { return m_prev; } CircularElement* next() { return m_next; } private: T m_data; CircularElement *m_prev; CircularElement *m_next; friend class CircularList; }; template class CircularList { public: typedef CircularElement element_type; CircularList(): m_last(nullptr) { } ~CircularList() { #ifdef DEBUG std::cout << "~CircularList()" << std::endl; #endif auto node = m_last; while (true) { #ifdef DEBUG // std::cout << (i++) << std::endl; #endif auto tmp = node; node = node->m_next; delete tmp; if (node == m_last) break; } } template CircularElement* insert(element_type *prev, Args&&... args) { auto elem = new CircularElement(std::forward(args)...); if (prev == nullptr && m_last != nullptr) throw std::runtime_error("Once the list is non-empty you must specify where to insert"); if (prev == nullptr) { elem->m_prev = elem->m_next = elem; } else { elem->m_prev = prev; elem->m_next = prev->m_next; prev->m_next->m_prev = elem; prev->m_next = elem; } m_last = elem; return elem; } private: element_type *m_last; }; // update the bounding box of a node's edge template void updateBBox(typename CircularElement::ptr_type elem) { auto &node(elem->data()); auto p1 = node.p; auto p2 = elem->next()->data().p; node.minX = std::min(p1[0], p2[0]); node.minY = std::min(p1[1], p2[1]); node.maxX = std::max(p1[0], p2[0]); node.maxY = std::max(p1[1], p2[1]); } #ifdef DEBUG_2 template void snapshot( const std::array &a, const std::array &b, const std::array &c, const std::array &d, const double sqLen, const double maxSqLen, const std::array &trigger, const bool use_trigger) { if ( !use_trigger || trigger == b ) { if ( !use_trigger ) printf ("Snapshot untriggered\n"); else printf ("Snapshot trigger: %0.6f %0.6f \n", trigger[0], trigger[1]); printf ("... segment a, b: %0.6f %0.6f, %0.6f %0.6f \n", a[0], a[1], b[0], b[1]); printf ("... segment c, d: %0.6f %0.6f, %0.6f %0.6f \n", c[0], c[1], d[0], d[1]); printf ("... sqDist a-b, b-c, c-d: %e, %e, %e", getSqDist(a, b), getSqDist(b, c), getSqDist(c, d)); printf ("... sqLen, maxSqLen: %e, %e", sqLen, maxSqLen); } } #endif template std::vector> concaveman( const std::vector> &points, // start with a convex hull of the points const std::vector &hull, // a relative measure of concavity; higher value means simpler hull T concavity=2, // when a segment goes below this length threshold, it won't be drilled down further T lengthThreshold=0 ) { typedef Node node_type; typedef std::array point_type; typedef CircularElement circ_elem_type; typedef CircularList circ_list_type; typedef circ_elem_type *circ_elem_ptr_type; #ifdef DEBUG std::cout << "concaveman()" << std::endl; #endif // exit if hull includes all points already if (hull.size() == points.size()) { std::vector res; for (auto &i : hull) res.push_back(points[i]); return res; } // index the points with an R-tree rtree tree; for (auto &p : points) tree.insert(p, { p[0], p[1], p[0], p[1] }); circ_list_type circList; circ_elem_ptr_type last = nullptr; std::list queue; // turn the convex hull into a linked list and populate the initial edge queue with the nodes for (auto &idx : hull) { auto &p = points[idx]; tree.erase(p, { p[0], p[1], p[0], p[1] }); last = circList.insert(last, p); queue.push_back(last); } #ifdef DEBUG_2 tree.print(0); #endif // loops through the hull? why? #ifdef DEBUG std::cout << "Starting hull: "; #endif for (auto elem = last->next(); ; elem=elem->next()) { #ifdef DEBUG std::cout << elem->data().p[0] << " " << elem->data().p[1] << std::endl; #endif if (elem == last) break; } // index the segments with an R-tree (for intersection checks) rtree segTree; for (auto &elem : queue) { auto &node(elem->data()); updateBBox(elem); segTree.insert(elem, { node.minX, node.minY, node.maxX, node.maxY }); } auto sqConcavity = concavity * concavity; auto sqLenThreshold = lengthThreshold * lengthThreshold; // process edges one by one while (!queue.empty()) { auto elem = *queue.begin(); queue.pop_front(); auto a = elem->prev()->data().p; auto b = elem->data().p; auto c = elem->next()->data().p; auto d = elem->next()->next()->data().p; // skip the edge if it's already short enough auto sqLen = getSqDist(b, c); if (sqLen < sqLenThreshold) continue; auto maxSqLen = sqLen / sqConcavity; #ifdef DEBUG_2 // dump key parameters either on every pass or when a certain point is 'b' point_type trigger = { 106.69593021225502127436, 63.77710542402261495454 }; snapshot(a, b, c, d, sqLen, maxSqLen, trigger, true); #endif // find the best connection point for the current edge to flex inward to bool ok; auto p = findCandidate(tree, a, b, c, d, maxSqLen, segTree, ok); // if we found a connection and it satisfies our concavity measure if (ok && std::min(getSqDist(p, b), getSqDist(p, c)) <= maxSqLen) { #ifdef DEBUG printf ("Modifying hull, p: %0.6f %0.6f \n" ,p[0], p[1]); #endif // connect the edge endpoints through this point and add 2 new edges to the queue queue.push_back(elem); queue.push_back(elem->insert(p)); // update point and segment indexes auto &node = elem->data(); auto &next = elem->next()->data(); tree.erase(p, { p[0], p[1], p[0], p[1] }); segTree.erase(elem, { node.minX, node.minY, node.maxX, node.maxY }); updateBBox(elem); updateBBox(elem->next()); segTree.insert(elem, { node.minX, node.minY, node.maxX, node.maxY }); segTree.insert(elem->next(), { next.minX, next.minY, next.maxX, next.maxY }); } #ifdef DEBUG else printf ("No point found along segment: %0.6f %0.6f, %0.6f %0.6f \n", b[0], b[1], c[0], c[1]); #endif } // convert the resulting hull linked list to an array of points std::vector concave; for (auto elem = last->next(); ; elem = elem->next()) { concave.push_back(elem->data().p); if (elem == last) break; } return concave; } template std::array findCandidate( const rtree> &tree, const std::array &a, const std::array &b, const std::array &c, const std::array &d, T maxDist, const rtree>::ptr_type> &segTree, bool &ok) { typedef std::array point_type; typedef rtree> tree_type; typedef const tree_type const_tree_type; typedef std::reference_wrapper tree_ref_type; typedef std::tuple tuple_type; #ifdef DEBUG std::cout << "findCandidate(), maxDist: " << maxDist << std::endl; #endif ok = false; std::priority_queue, compare_first> queue; std::reference_wrapper node = tree; // search through the point R-tree with a depth-first search using a priority queue // in the order of distance to the edge (b, c) while (true) { for (auto &child : node.get().children()) { auto bounds = child->bounds(); point_type pt = { bounds[0], bounds[1] }; auto dist = child->is_leaf() ? sqSegDist(pt, b, c) : sqSegBoxDist(b, c, *child); if (dist > maxDist) continue; // skip the node if it's farther than we ever need queue.push(tuple_type(-dist, *child)); } while (!queue.empty() && std::get<1>(queue.top()).get().is_leaf()) { auto item = queue.top(); queue.pop(); auto bounds = std::get<1>(item).get().bounds(); point_type p = { bounds[0], bounds[1] }; // skip all points that are as close to adjacent edges (a,b) and (c,d), // and points that would introduce self-intersections when connected auto d0 = sqSegDist(p, a, b); auto d1 = sqSegDist(p, c, d); #ifdef DEBUG_2 printf (" p: %0.6f %0.6f sqSegDist: %e, %e, %e \n", bounds[0], bounds[1], d0, std::get<0>(item), d1); #endif if (-std::get<0>(item) < d0 && -std::get<0>(item) < d1 && noIntersections(b, p, segTree) && noIntersections(c, p, segTree)) { ok = true; return std::get<1>(item).get().data(); } #ifdef DEBUG_2 else { bool cond1 = -std::get<0>(item) < d0; bool cond2 = -std::get<0>(item) < d1; bool cond3 = noIntersections(b, p, segTree); bool cond4 = noIntersections(c, p, segTree); std::cout << "Not OK: " << cond1 << " " << cond2 << " " << cond3 << " " << cond4 << std::endl; } #endif } if (queue.empty()) break; node = std::get<1>(queue.top()); queue.pop(); } return point_type(); } // square distance from a segment bounding box to the given one template T sqSegBoxDist( const std::array &a, const std::array &b, const rtree &bbox) { if (inside(a, bbox) || inside(b, bbox)) return 0; auto &bounds = bbox.bounds(); auto minX = bounds[0]; auto minY = bounds[1]; auto maxX = bounds[2]; auto maxY = bounds[3]; auto d1 = sqSegSegDist(a[0], a[1], b[0], b[1], minX, minY, maxX, minY); if (d1 == 0) return 0; auto d2 = sqSegSegDist(a[0], a[1], b[0], b[1], minX, minY, minX, maxY); if (d2 == 0) return 0; auto d3 = sqSegSegDist(a[0], a[1], b[0], b[1], maxX, minY, maxX, maxY); if (d3 == 0) return 0; auto d4 = sqSegSegDist(a[0], a[1], b[0], b[1], minX, maxY, maxX, maxY); if (d4 == 0) return 0; return std::min(std::min(d1, d2), std::min(d3, d4)); } template bool inside( const std::array &a, const rtree &bbox) { auto &bounds = bbox.bounds(); auto minX = bounds[0]; auto minY = bounds[1]; auto maxX = bounds[2]; auto maxY = bounds[3]; auto res = (a[0] >= minX) && (a[0] <= maxX) && (a[1] >= minY) && (a[1] <= maxY); return res; } // check if the edge (a,b) doesn't intersect any other edges template bool noIntersections( const std::array &a, const std::array &b, const rtree>::ptr_type> &segTree) { auto minX = std::min(a[0], b[0]); auto minY = std::min(a[1], b[1]); auto maxX = std::max(a[0], b[0]); auto maxY = std::max(a[1], b[1]); auto isect = segTree.intersection({ minX, minY, maxX, maxY }); for (decltype(segTree) &ch : isect) { auto elem = ch.data(); if (intersects(elem->data().p, elem->next()->data().p, a, b)) return false; } return true; } ggforce/src/deBoor.cpp0000644000176200001440000000260214672274110014377 0ustar liggesusers// Taken from https://chi3x10.wordpress.com/2009/10/18/de-boor-algorithm-in-c/ #include "deBoor.h" Point::Point() { x = 0.0; y = 0.0; } Point::Point(double xInit, double yInit) { x = xInit; y = yInit; } Point Point::operator=(const Point pt) { x = pt.x; y = pt.y; return *this; } Point Point::operator+(const Point pt) const { Point temp; temp.x = x + pt.x; temp.y = y + pt.y; return temp; } Point Point::operator*(double m) const { Point temp; temp.x = x*m; temp.y = y*m; return temp; } Point Point::operator/(double m) const { Point temp; temp.x = x/m; temp.y = y/m; return temp; } Point deBoor(int k, int degree, int i, double x, std::vector knots, std::vector ctrlPoints) { // Please see wikipedia page for detail // note that the algorithm here kind of traverses in reverse order // comapred to that in the wikipedia page if(k == 0) { return ctrlPoints[i]; } else { double alpha = (x - knots[i])/(knots[i+degree + 1 - k] - knots[i]); return (deBoor(k - 1, degree, i - 1, x, knots, ctrlPoints)*(1 - alpha) + deBoor(k - 1, degree, i, x, knots, ctrlPoints)*alpha); } } int whichInterval(double x, std::vector knots) { int ti = knots.size(); for(int i = 1; i < ti - 1; i++) { if(x < knots[i]) return(i - 1); else if(x == knots[ti - 1]) return(ti - 1); } return -1; } ggforce/src/robust_predicate/0000755000176200001440000000000015024525117016015 5ustar liggesusersggforce/src/robust_predicate/geompred.hpp0000644000176200001440000000347714672274110020345 0ustar liggesusers /* ------------------------------------------------------------ * robust geometric predicates, a'la shewchuk ------------------------------------------------------------ * * This program may be freely redistributed under the * condition that the copyright notices (including this * entire header) are not removed, and no compensation * is received through use of the software. Private, * research, and institutional use is free. You may * distribute modified versions of this code UNDER THE * CONDITION THAT THIS CODE AND ANY MODIFICATIONS MADE * TO IT IN THE SAME FILE REMAIN UNDER COPYRIGHT OF THE * ORIGINAL AUTHOR, BOTH SOURCE AND OBJECT CODE ARE * MADE FREELY AVAILABLE WITHOUT CHARGE, AND CLEAR * NOTICE IS GIVEN OF THE MODIFICATIONS. Distribution * of this code as part of a commercial system is * permissible ONLY BY DIRECT ARRANGEMENT WITH THE * AUTHOR. (If you are not directly supplying this * code to a customer, and you are instead telling them * how they can obtain it for free, then you are not * required to make any arrangement with me.) * * Disclaimer: Neither I nor: Columbia University, The * Massachusetts Institute of Technology, The * University of Sydney, nor The National Aeronautics * and Space Administration warrant this code in any * way whatsoever. This code is provided "as-is" to be * used at your own risk. * ------------------------------------------------------------ * * Last updated: 01 March, 2020 * * Copyright 2020-- * Darren Engwirda * de2363@columbia.edu * https://github.com/dengwirda/ * ------------------------------------------------------------ */ # pragma once # ifndef __PREDICATES__ # define __PREDICATES__ # include "basebase.hpp" # include "mpfloats.hpp" # include # include "predicate/predicate_k.hpp" # endif//__PREDICATES__ ggforce/src/robust_predicate/predicate/0000755000176200001440000000000014672274066017771 5ustar liggesusersggforce/src/robust_predicate/predicate/inball_k.hpp0000644000176200001440000013355714672274110022261 0ustar liggesusers /* -------------------------------------------------------- * PREDICATE-k: robust geometric predicates in E^k. -------------------------------------------------------- * * This program may be freely redistributed under the * condition that the copyright notices (including this * entire header) are not removed, and no compensation * is received through use of the software. Private, * research, and institutional use is free. You may * distribute modified versions of this code UNDER THE * CONDITION THAT THIS CODE AND ANY MODIFICATIONS MADE * TO IT IN THE SAME FILE REMAIN UNDER COPYRIGHT OF THE * ORIGINAL AUTHOR, BOTH SOURCE AND OBJECT CODE ARE * MADE FREELY AVAILABLE WITHOUT CHARGE, AND CLEAR * NOTICE IS GIVEN OF THE MODIFICATIONS. Distribution * of this code as part of a commercial system is * permissible ONLY BY DIRECT ARRANGEMENT WITH THE * AUTHOR. (If you are not directly supplying this * code to a customer, and you are instead telling them * how they can obtain it for free, then you are not * required to make any arrangement with me.) * * Disclaimer: Neither I nor: Columbia University, The * Massachusetts Institute of Technology, The * University of Sydney, nor The National Aeronautics * and Space Administration warrant this code in any * way whatsoever. This code is provided "as-is" to be * used at your own risk. * -------------------------------------------------------- * * Last updated: 14 April, 2020 * * Copyright 2020-- * Darren Engwirda * de2363@columbia.edu * https://github.com/dengwirda/ * -------------------------------------------------------- */ // from predicate_k.hpp... /* -------------------------------------------------------- * * Compute an exact determinant using multi-precision * expansions, a'la shewchuk * * | ax ay dot(a, a) +1. | * | bx by dot(b, b) +1. | * | cx cy dot(c, c) +1. | * | dx dy dot(d, d) +1. | * * This is the unweighted "in-ball" predicate in E^2. * -------------------------------------------------------- */ __normal_call REAL_TYPE inball2d_e ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd , bool_type &_OK ) { /*--------------- inball2d predicate, "exact" version */ mp::expansion< 4 > _a_lift, _b_lift, _c_lift, _d_lift; mp::expansion< 4 > _d2_ab_, _d2_ac_, _d2_ad_, _d2_bc_, _d2_bd_, _d2_cd_; mp::expansion< 12> _d3_abc, _d3_abd, _d3_acd, _d3_bcd; mp::expansion<384> _d4full; _OK = true; /*-------------------------------------- lifted terms */ mp::expansion_add( mp::expansion_from_sqr(_pa[ 0]), mp::expansion_from_sqr(_pa[ 1]), _a_lift ) ; mp::expansion_add( mp::expansion_from_sqr(_pb[ 0]), mp::expansion_from_sqr(_pb[ 1]), _b_lift ) ; mp::expansion_add( mp::expansion_from_sqr(_pc[ 0]), mp::expansion_from_sqr(_pc[ 1]), _c_lift ) ; mp::expansion_add( mp::expansion_from_sqr(_pd[ 0]), mp::expansion_from_sqr(_pd[ 1]), _d_lift ) ; /*-------------------------------------- 2 x 2 minors */ compute_det_2x2(_pa[ 0], _pa[ 1], _pb[ 0], _pb[ 1], _d2_ab_ ) ; compute_det_2x2(_pa[ 0], _pa[ 1], _pc[ 0], _pc[ 1], _d2_ac_ ) ; compute_det_2x2(_pa[ 0], _pa[ 1], _pd[ 0], _pd[ 1], _d2_ad_ ) ; compute_det_2x2(_pb[ 0], _pb[ 1], _pc[ 0], _pc[ 1], _d2_bc_ ) ; compute_det_2x2(_pb[ 0], _pb[ 1], _pd[ 0], _pd[ 1], _d2_bd_ ) ; compute_det_2x2(_pc[ 0], _pc[ 1], _pd[ 0], _pd[ 1], _d2_cd_ ) ; /*-------------------------------------- 3 x 3 minors */ unitary_det_3x3(_d2_cd_, _d2_bd_, _d2_bc_, _d3_bcd, +3) ; unitary_det_3x3(_d2_cd_, _d2_ad_, _d2_ac_, _d3_acd, +3) ; unitary_det_3x3(_d2_bd_, _d2_ad_, _d2_ab_, _d3_abd, +3) ; unitary_det_3x3(_d2_bc_, _d2_ac_, _d2_ab_, _d3_abc, +3) ; /*-------------------------------------- 4 x 4 result */ compute_det_4x4(_d3_bcd, _a_lift, _d3_acd, _b_lift, _d3_abd, _c_lift, _d3_abc, _d_lift, _d4full, +3) ; /*-------------------------------------- leading det. */ return mp::expansion_est(_d4full) ; } __normal_call REAL_TYPE inball2d_i ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd , bool_type &_OK ) { /*--------------- inball2d predicate, "bound" version */ ia_flt _adx, _ady, _adw , _bdx, _bdy, _bdw , _cdx, _cdy, _cdw ; ia_flt _ali, _bli, _cli ; ia_flt _bdxcdy, _cdxbdy , _cdxady, _adxcdy , _adxbdy, _bdxady ; ia_flt _d33; ia_rnd _rnd; // up rounding! _adx.from_sub(_pa[0], _pd[0]) ; // coord. diff. _ady.from_sub(_pa[1], _pd[1]) ; _adw.from_sub(_pa[2], _pd[2]) ; _bdx.from_sub(_pb[0], _pd[0]) ; _bdy.from_sub(_pb[1], _pd[1]) ; _bdw.from_sub(_pb[2], _pd[2]) ; _cdx.from_sub(_pc[0], _pd[0]) ; _cdy.from_sub(_pc[1], _pd[1]) ; _cdw.from_sub(_pc[2], _pd[2]) ; _ali = sqr (_adx) + sqr (_ady) ; // lifted terms _bli = sqr (_bdx) + sqr (_bdy) ; _cli = sqr (_cdx) + sqr (_cdy) ; _bdxcdy = _bdx * _cdy ; // 2 x 2 minors _cdxbdy = _cdx * _bdy ; _cdxady = _cdx * _ady ; _adxcdy = _adx * _cdy ; _adxbdy = _adx * _bdy ; _bdxady = _bdx * _ady ; _d33 = // 3 x 3 result _ali * (_bdxcdy - _cdxbdy) + _bli * (_cdxady - _adxcdy) + _cli * (_adxbdy - _bdxady) ; _OK = _d33.lo() >= (REAL_TYPE)0. ||_d33.up() <= (REAL_TYPE)0. ; return ( _d33.mid() ) ; } __normal_call REAL_TYPE inball2d_f ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd , bool_type &_OK ) { /*--------------- inball2d predicate, "float" version */ REAL_TYPE static const _ER = + 11. * std::pow(mp::_epsilon, 1) ; REAL_TYPE _adx, _ady, _ali , _bdx, _bdy, _bli , _cdx, _cdy, _cli ; REAL_TYPE _bdxcdy, _cdxbdy , _cdxady, _adxcdy , _adxbdy, _bdxady ; REAL_TYPE _BDXCDY, _CDXBDY , _CDXADY, _ADXCDY , _ADXBDY, _BDXADY ; REAL_TYPE _d33, _FT ; _adx = _pa [0] - _pd [0] ; // coord. diff. _ady = _pa [1] - _pd [1] ; _bdx = _pb [0] - _pd [0] ; _bdy = _pb [1] - _pd [1] ; _cdx = _pc [0] - _pd [0] ; _cdy = _pc [1] - _pd [1] ; _ali = _adx * _adx + _ady * _ady; // lifted terms _bli = _bdx * _bdx + _bdy * _bdy; _cli = _cdx * _cdx + _cdy * _cdy; _bdxcdy = _bdx * _cdy ; // 2 x 2 minors _cdxbdy = _cdx * _bdy ; _cdxady = _cdx * _ady ; _adxcdy = _adx * _cdy ; _adxbdy = _adx * _bdy ; _bdxady = _bdx * _ady ; _BDXCDY = std::abs (_bdxcdy) ; _CDXBDY = std::abs (_cdxbdy) ; _CDXADY = std::abs (_cdxady) ; _ADXCDY = std::abs (_adxcdy) ; _ADXBDY = std::abs (_adxbdy) ; _BDXADY = std::abs (_bdxady) ; _FT = // roundoff tol _ali * (_BDXCDY + _CDXBDY) + _bli * (_CDXADY + _ADXCDY) + _cli * (_ADXBDY + _BDXADY) ; _FT *= _ER ; _d33 = // 3 x 3 result _ali * (_bdxcdy - _cdxbdy) + _bli * (_cdxady - _adxcdy) + _cli * (_adxbdy - _bdxady) ; _OK = _d33 > +_FT || _d33 < -_FT ; return ( _d33 ) ; } /* -------------------------------------------------------- * * Compute an exact determinant using multi-precision * expansions, a'la shewchuk * * | ax ay dot(a, a) - aw +1. | * | bx by dot(b, b) - bw +1. | * | cx cy dot(c, c) - cw +1. | * | dx dy dot(d, d) - dw +1. | * * This is the weighted "in-ball" predicate in E^2. * -------------------------------------------------------- */ __normal_call REAL_TYPE inball2w_e ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd , bool_type &_OK ) { /*--------------- inball2w predicate, "exact" version */ mp::expansion< 5 > _a_lift, _b_lift, _c_lift, _d_lift; mp::expansion< 4 > _t_lift; mp::expansion< 4 > _d2_ab_, _d2_ac_, _d2_ad_, _d2_bc_, _d2_bd_, _d2_cd_; mp::expansion< 12> _d3_abc, _d3_abd, _d3_acd, _d3_bcd; mp::expansion<480> _d4full; _OK = true; /*-------------------------------------- lifted terms */ mp::expansion_add( mp::expansion_from_sqr(_pa[ 0]), mp::expansion_from_sqr(_pa[ 1]), _t_lift ) ; mp::expansion_sub( _t_lift , _pa[ 2] , _a_lift); mp::expansion_add( mp::expansion_from_sqr(_pb[ 0]), mp::expansion_from_sqr(_pb[ 1]), _t_lift ) ; mp::expansion_sub( _t_lift , _pb[ 2] , _b_lift); mp::expansion_add( mp::expansion_from_sqr(_pc[ 0]), mp::expansion_from_sqr(_pc[ 1]), _t_lift ) ; mp::expansion_sub( _t_lift , _pc[ 2] , _c_lift); mp::expansion_add( mp::expansion_from_sqr(_pd[ 0]), mp::expansion_from_sqr(_pd[ 1]), _t_lift ) ; mp::expansion_sub( _t_lift , _pd[ 2] , _d_lift); /*-------------------------------------- 2 x 2 minors */ compute_det_2x2(_pa[ 0], _pa[ 1], _pb[ 0], _pb[ 1], _d2_ab_ ) ; compute_det_2x2(_pa[ 0], _pa[ 1], _pc[ 0], _pc[ 1], _d2_ac_ ) ; compute_det_2x2(_pa[ 0], _pa[ 1], _pd[ 0], _pd[ 1], _d2_ad_ ) ; compute_det_2x2(_pb[ 0], _pb[ 1], _pc[ 0], _pc[ 1], _d2_bc_ ) ; compute_det_2x2(_pb[ 0], _pb[ 1], _pd[ 0], _pd[ 1], _d2_bd_ ) ; compute_det_2x2(_pc[ 0], _pc[ 1], _pd[ 0], _pd[ 1], _d2_cd_ ) ; /*-------------------------------------- 3 x 3 minors */ unitary_det_3x3(_d2_cd_, _d2_bd_, _d2_bc_, _d3_bcd, +3) ; unitary_det_3x3(_d2_cd_, _d2_ad_, _d2_ac_, _d3_acd, +3) ; unitary_det_3x3(_d2_bd_, _d2_ad_, _d2_ab_, _d3_abd, +3) ; unitary_det_3x3(_d2_bc_, _d2_ac_, _d2_ab_, _d3_abc, +3) ; /*-------------------------------------- 4 x 4 result */ compute_det_4x4(_d3_bcd, _a_lift, _d3_acd, _b_lift, _d3_abd, _c_lift, _d3_abc, _d_lift, _d4full, +3) ; /*-------------------------------------- leading det. */ return mp::expansion_est(_d4full) ; } __normal_call REAL_TYPE inball2w_i ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd , bool_type &_OK ) { /*--------------- inball2w predicate, "bound" version */ ia_flt _adx, _ady, _adw , _bdx, _bdy, _bdw , _cdx, _cdy, _cdw ; ia_flt _ali, _bli, _cli ; ia_flt _bdxcdy, _cdxbdy , _cdxady, _adxcdy , _adxbdy, _bdxady ; ia_flt _d33; ia_rnd _rnd; // up rounding! _adx.from_sub(_pa[0], _pd[0]) ; // coord. diff. _ady.from_sub(_pa[1], _pd[1]) ; _adw.from_sub(_pa[2], _pd[2]) ; _bdx.from_sub(_pb[0], _pd[0]) ; _bdy.from_sub(_pb[1], _pd[1]) ; _bdw.from_sub(_pb[2], _pd[2]) ; _cdx.from_sub(_pc[0], _pd[0]) ; _cdy.from_sub(_pc[1], _pd[1]) ; _cdw.from_sub(_pc[2], _pd[2]) ; _ali = sqr (_adx) + sqr (_ady) // lifted terms - _adw ; _bli = sqr (_bdx) + sqr (_bdy) - _bdw ; _cli = sqr (_cdx) + sqr (_cdy) - _cdw ; _bdxcdy = _bdx * _cdy ; // 2 x 2 minors _cdxbdy = _cdx * _bdy ; _cdxady = _cdx * _ady ; _adxcdy = _adx * _cdy ; _adxbdy = _adx * _bdy ; _bdxady = _bdx * _ady ; _d33 = // 3 x 3 result _ali * (_bdxcdy - _cdxbdy) + _bli * (_cdxady - _adxcdy) + _cli * (_adxbdy - _bdxady) ; _OK = _d33.lo() >= (REAL_TYPE)0. ||_d33.up() <= (REAL_TYPE)0. ; return ( _d33.mid() ) ; } __normal_call REAL_TYPE inball2w_f ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd , bool_type &_OK ) { /*--------------- inball2w predicate, "float" version */ REAL_TYPE static const _ER = + 12. * std::pow(mp::_epsilon, 1) ; REAL_TYPE _adx, _ady, _adw , _bdx, _bdy, _bdw , _cdx, _cdy, _cdw ; REAL_TYPE _ali, _bli, _cli ; REAL_TYPE _bdxcdy, _cdxbdy , _cdxady, _adxcdy , _adxbdy, _bdxady ; REAL_TYPE _ALI, _BLI, _CLI ; REAL_TYPE _BDXCDY, _CDXBDY , _CDXADY, _ADXCDY , _ADXBDY, _BDXADY ; REAL_TYPE _d33, _FT ; _adx = _pa [0] - _pd [0] ; // coord. diff. _ady = _pa [1] - _pd [1] ; _adw = _pa [2] - _pd [2] ; _bdx = _pb [0] - _pd [0] ; _bdy = _pb [1] - _pd [1] ; _bdw = _pb [2] - _pd [2] ; _cdx = _pc [0] - _pd [0] ; _cdy = _pc [1] - _pd [1] ; _cdw = _pc [2] - _pd [2] ; _ali = _adx * _adx + _ady * _ady // lifted terms - _adw ; _ALI = std::abs (_ali) ; _bli = _bdx * _bdx + _bdy * _bdy - _bdw ; _BLI = std::abs (_bli) ; _cli = _cdx * _cdx + _cdy * _cdy - _cdw ; _CLI = std::abs (_cli) ; _bdxcdy = _bdx * _cdy ; // 2 x 2 minors _cdxbdy = _cdx * _bdy ; _cdxady = _cdx * _ady ; _adxcdy = _adx * _cdy ; _adxbdy = _adx * _bdy ; _bdxady = _bdx * _ady ; _BDXCDY = std::abs (_bdxcdy) ; _CDXBDY = std::abs (_cdxbdy) ; _CDXADY = std::abs (_cdxady) ; _ADXCDY = std::abs (_adxcdy) ; _ADXBDY = std::abs (_adxbdy) ; _BDXADY = std::abs (_bdxady) ; _FT = // roundoff tol _ALI * (_BDXCDY + _CDXBDY) + _BLI * (_CDXADY + _ADXCDY) + _CLI * (_ADXBDY + _BDXADY) ; _FT *= _ER ; _d33 = // 3 x 3 result _ali * (_bdxcdy - _cdxbdy) + _bli * (_cdxady - _adxcdy) + _cli * (_adxbdy - _bdxady) ; _OK = _d33 > +_FT || _d33 < -_FT ; return ( _d33 ) ; } /* -------------------------------------------------------- * * Compute an exact determinant using multi-precision * expansions, a'la shewchuk * * | ax ay az dot(a, a) +1. | * | bx by bz dot(b, b) +1. | * | cx cy cz dot(c, c) +1. | * | dx dy dz dot(d, d) +1. | * | ex ey ez dot(e, e) +1. | * * This is the unweighted "in-ball" predicate in E^3. * -------------------------------------------------------- */ __normal_call REAL_TYPE inball3d_e ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd , __const_ptr(REAL_TYPE) _pe , bool_type &_OK ) { /*--------------- inball3d predicate, "exact" version */ mp::expansion< 6 > _a_lift, _b_lift, _c_lift, _d_lift, _e_lift; mp::expansion< 4 > _d2_ab_, _d2_ac_, _d2_ad_, _d2_ae_, _d2_bc_, _d2_bd_, _d2_be_, _d2_cd_, _d2_ce_, _d2_de_; mp::expansion< 24> _d3_abc, _d3_abd, _d3_abe, _d3_acd, _d3_ace, _d3_ade, _d3_bcd, _d3_bce, _d3_bde, _d3_cde; mp::expansion< 96> _d4abcd, _d4abce, _d4abde, _d4acde, _d4bcde; mp::expansion<5760>_d5full; _OK = true; mp::expansion< 1 > _pa_zz_(_pa[ 2]); mp::expansion< 1 > _pb_zz_(_pb[ 2]); mp::expansion< 1 > _pc_zz_(_pc[ 2]); mp::expansion< 1 > _pd_zz_(_pd[ 2]); mp::expansion< 1 > _pe_zz_(_pe[ 2]); /*-------------------------------------- lifted terms */ mp::expansion_add( mp::expansion_from_sqr(_pa[ 0]), mp::expansion_from_sqr(_pa[ 1]), mp::expansion_from_sqr(_pa[ 2]), _a_lift ) ; mp::expansion_add( mp::expansion_from_sqr(_pb[ 0]), mp::expansion_from_sqr(_pb[ 1]), mp::expansion_from_sqr(_pb[ 2]), _b_lift ) ; mp::expansion_add( mp::expansion_from_sqr(_pc[ 0]), mp::expansion_from_sqr(_pc[ 1]), mp::expansion_from_sqr(_pc[ 2]), _c_lift ) ; mp::expansion_add( mp::expansion_from_sqr(_pd[ 0]), mp::expansion_from_sqr(_pd[ 1]), mp::expansion_from_sqr(_pd[ 2]), _d_lift ) ; mp::expansion_add( mp::expansion_from_sqr(_pe[ 0]), mp::expansion_from_sqr(_pe[ 1]), mp::expansion_from_sqr(_pe[ 2]), _e_lift ) ; /*-------------------------------------- 2 x 2 minors */ compute_det_2x2(_pa[ 0], _pa[ 1], _pb[ 0], _pb[ 1], _d2_ab_ ) ; compute_det_2x2(_pa[ 0], _pa[ 1], _pc[ 0], _pc[ 1], _d2_ac_ ) ; compute_det_2x2(_pa[ 0], _pa[ 1], _pd[ 0], _pd[ 1], _d2_ad_ ) ; compute_det_2x2(_pa[ 0], _pa[ 1], _pe[ 0], _pe[ 1], _d2_ae_ ) ; compute_det_2x2(_pb[ 0], _pb[ 1], _pc[ 0], _pc[ 1], _d2_bc_ ) ; compute_det_2x2(_pb[ 0], _pb[ 1], _pd[ 0], _pd[ 1], _d2_bd_ ) ; compute_det_2x2(_pb[ 0], _pb[ 1], _pe[ 0], _pe[ 1], _d2_be_ ) ; compute_det_2x2(_pc[ 0], _pc[ 1], _pd[ 0], _pd[ 1], _d2_cd_ ) ; compute_det_2x2(_pc[ 0], _pc[ 1], _pe[ 0], _pe[ 1], _d2_ce_ ) ; compute_det_2x2(_pd[ 0], _pd[ 1], _pe[ 0], _pe[ 1], _d2_de_ ) ; /*-------------------------------------- 3 x 3 minors */ compute_det_3x3(_d2_bc_, _pa_zz_, _d2_ac_, _pb_zz_, _d2_ab_, _pc_zz_, _d3_abc, +3) ; compute_det_3x3(_d2_bd_, _pa_zz_, _d2_ad_, _pb_zz_, _d2_ab_, _pd_zz_, _d3_abd, +3) ; compute_det_3x3(_d2_be_, _pa_zz_, _d2_ae_, _pb_zz_, _d2_ab_, _pe_zz_, _d3_abe, +3) ; compute_det_3x3(_d2_cd_, _pa_zz_, _d2_ad_, _pc_zz_, _d2_ac_, _pd_zz_, _d3_acd, +3) ; compute_det_3x3(_d2_ce_, _pa_zz_, _d2_ae_, _pc_zz_, _d2_ac_, _pe_zz_, _d3_ace, +3) ; compute_det_3x3(_d2_de_, _pa_zz_, _d2_ae_, _pd_zz_, _d2_ad_, _pe_zz_, _d3_ade, +3) ; compute_det_3x3(_d2_cd_, _pb_zz_, _d2_bd_, _pc_zz_, _d2_bc_, _pd_zz_, _d3_bcd, +3) ; compute_det_3x3(_d2_ce_, _pb_zz_, _d2_be_, _pc_zz_, _d2_bc_, _pe_zz_, _d3_bce, +3) ; compute_det_3x3(_d2_de_, _pb_zz_, _d2_be_, _pd_zz_, _d2_bd_, _pe_zz_, _d3_bde, +3) ; compute_det_3x3(_d2_de_, _pc_zz_, _d2_ce_, _pd_zz_, _d2_cd_, _pe_zz_, _d3_cde, +3) ; /*-------------------------------------- 4 x 4 minors */ unitary_det_4x4(_d3_cde, _d3_bde, _d3_bce, _d3_bcd, _d4bcde, +4) ; unitary_det_4x4(_d3_cde, _d3_ade, _d3_ace, _d3_acd, _d4acde, +4) ; unitary_det_4x4(_d3_bde, _d3_ade, _d3_abe, _d3_abd, _d4abde, +4) ; unitary_det_4x4(_d3_bce, _d3_ace, _d3_abe, _d3_abc, _d4abce, +4) ; unitary_det_4x4(_d3_bcd, _d3_acd, _d3_abd, _d3_abc, _d4abcd, +4) ; /*-------------------------------------- 5 x 5 result */ compute_det_5x5(_d4bcde, _a_lift, _d4acde, _b_lift, _d4abde, _c_lift, _d4abce, _d_lift, _d4abcd, _e_lift, _d5full, +4) ; /*-------------------------------------- leading det. */ return mp::expansion_est(_d5full) ; } __normal_call REAL_TYPE inball3d_i ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd , __const_ptr(REAL_TYPE) _pe , bool_type &_OK ) { /*--------------- inball3d predicate, "bound" version */ ia_flt _aex, _aey, _aez , _ali, _bex, _bey, _bez , _bli, _cex, _cey, _cez , _cli, _dex, _dey, _dez , _dli; ia_flt _aexbey, _bexaey , _aexcey, _cexaey , _bexcey, _cexbey , _cexdey, _dexcey , _dexaey, _aexdey , _bexdey, _dexbey ; ia_flt _ab_, _bc_, _cd_, _da_, _ac_, _bd_; ia_flt _abc, _bcd, _cda, _dab; ia_flt _d44; ia_rnd _rnd; // up rounding! _aex.from_sub(_pa[0], _pe[0]) ; // coord. diff. _aey.from_sub(_pa[1], _pe[1]) ; _aez.from_sub(_pa[2], _pe[2]) ; _bex.from_sub(_pb[0], _pe[0]) ; _bey.from_sub(_pb[1], _pe[1]) ; _bez.from_sub(_pb[2], _pe[2]) ; _cex.from_sub(_pc[0], _pe[0]) ; _cey.from_sub(_pc[1], _pe[1]) ; _cez.from_sub(_pc[2], _pe[2]) ; _dex.from_sub(_pd[0], _pe[0]) ; _dey.from_sub(_pd[1], _pe[1]) ; _dez.from_sub(_pd[2], _pe[2]) ; _ali = sqr (_aex) + sqr (_aey) // lifted terms + sqr (_aez) ; _bli = sqr (_bex) + sqr (_bey) + sqr (_bez) ; _cli = sqr (_cex) + sqr (_cey) + sqr (_cez) ; _dli = sqr (_dex) + sqr (_dey) + sqr (_dez) ; _aexbey = _aex * _bey ; // 2 x 2 minors _bexaey = _bex * _aey ; _ab_ = _aexbey - _bexaey ; _bexcey = _bex * _cey; _cexbey = _cex * _bey; _bc_ = _bexcey - _cexbey ; _cexdey = _cex * _dey; _dexcey = _dex * _cey; _cd_ = _cexdey - _dexcey ; _dexaey = _dex * _aey; _aexdey = _aex * _dey; _da_ = _dexaey - _aexdey ; _aexcey = _aex * _cey; _cexaey = _cex * _aey; _ac_ = _aexcey - _cexaey ; _bexdey = _bex * _dey; _dexbey = _dex * _bey; _bd_ = _bexdey - _dexbey ; _abc = // 3 x 3 minors _aez * _bc_ - _bez * _ac_ + _cez * _ab_ ; _bcd = _bez * _cd_ - _cez * _bd_ + _dez * _bc_ ; _cda = _cez * _da_ + _dez * _ac_ + _aez * _cd_ ; _dab = _dez * _ab_ + _aez * _bd_ + _bez * _da_ ; _d44 = // 4 x 4 result _dli * _abc - _cli * _dab + _bli * _cda - _ali * _bcd ; _OK = _d44.lo() >= (REAL_TYPE)0. ||_d44.up() <= (REAL_TYPE)0.; return ( _d44.mid() ) ; } __normal_call REAL_TYPE inball3d_f ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd , __const_ptr(REAL_TYPE) _pe , bool_type &_OK ) { /*--------------- inball3d predicate, "float" version */ REAL_TYPE static const _ER = + 17. * std::pow(mp::_epsilon, 1) ; REAL_TYPE _aex, _aey, _aez , _ali, _bex, _bey, _bez , _bli, _cex, _cey, _cez , _cli, _dex, _dey, _dez , _dli; REAL_TYPE _aexbey, _bexaey , _aexcey, _cexaey , _bexcey, _cexbey , _cexdey, _dexcey , _dexaey, _aexdey , _bexdey, _dexbey ; REAL_TYPE _ab_, _bc_, _cd_, _da_, _ac_, _bd_; REAL_TYPE _abc, _bcd, _cda, _dab; REAL_TYPE _AEZ, _BEZ, _CEZ, _DEZ; REAL_TYPE _AEXBEY, _BEXAEY , _AEXCEY, _CEXAEY , _BEXCEY, _CEXBEY , _CEXDEY, _DEXCEY , _DEXAEY, _AEXDEY , _BEXDEY, _DEXBEY ; REAL_TYPE _AB_, _BC_, _CD_, _DA_, _AC_, _BD_; REAL_TYPE _ABC, _BCD, _CDA, _DAB; REAL_TYPE _d44, _FT ; _aex = _pa [0] - _pe [0] ; // coord. diff. _aey = _pa [1] - _pe [1] ; _aez = _pa [2] - _pe [2] ; _AEZ = std::abs (_aez) ; _bex = _pb [0] - _pe [0] ; _bey = _pb [1] - _pe [1] ; _bez = _pb [2] - _pe [2] ; _BEZ = std::abs (_bez) ; _cex = _pc [0] - _pe [0] ; _cey = _pc [1] - _pe [1] ; _cez = _pc [2] - _pe [2] ; _CEZ = std::abs (_cez) ; _dex = _pd [0] - _pe [0] ; _dey = _pd [1] - _pe [1] ; _dez = _pd [2] - _pe [2] ; _DEZ = std::abs (_dez) ; _ali = _aex * _aex + _aey * _aey // lifted terms + _aez * _aez ; _bli = _bex * _bex + _bey * _bey + _bez * _bez ; _cli = _cex * _cex + _cey * _cey + _cez * _cez ; _dli = _dex * _dex + _dey * _dey + _dez * _dez ; _aexbey = _aex * _bey ; // 2 x 2 minors _bexaey = _bex * _aey ; _ab_ = _aexbey - _bexaey ; _AEXBEY = std::abs (_aexbey) ; _BEXAEY = std::abs (_bexaey) ; _AB_ = _AEXBEY + _BEXAEY ; _bexcey = _bex * _cey; _cexbey = _cex * _bey; _bc_ = _bexcey - _cexbey ; _BEXCEY = std::abs (_bexcey) ; _CEXBEY = std::abs (_cexbey) ; _BC_ = _BEXCEY + _CEXBEY ; _cexdey = _cex * _dey; _dexcey = _dex * _cey; _cd_ = _cexdey - _dexcey ; _CEXDEY = std::abs (_cexdey) ; _DEXCEY = std::abs (_dexcey) ; _CD_ = _CEXDEY + _DEXCEY ; _dexaey = _dex * _aey; _aexdey = _aex * _dey; _da_ = _dexaey - _aexdey ; _DEXAEY = std::abs (_dexaey) ; _AEXDEY = std::abs (_aexdey) ; _DA_ = _DEXAEY + _AEXDEY ; _aexcey = _aex * _cey; _cexaey = _cex * _aey; _ac_ = _aexcey - _cexaey ; _AEXCEY = std::abs (_aexcey) ; _CEXAEY = std::abs (_cexaey) ; _AC_ = _AEXCEY + _CEXAEY ; _bexdey = _bex * _dey; _dexbey = _dex * _bey; _bd_ = _bexdey - _dexbey ; _BEXDEY = std::abs (_bexdey) ; _DEXBEY = std::abs (_dexbey) ; _BD_ = _BEXDEY + _DEXBEY ; _abc = // 3 x 3 minors _aez * _bc_ - _bez * _ac_ + _cez * _ab_ ; _ABC = _AEZ * _BC_ + _BEZ * _AC_ + _CEZ * _AB_ ; _bcd = _bez * _cd_ - _cez * _bd_ + _dez * _bc_ ; _BCD = _BEZ * _CD_ + _CEZ * _BD_ + _DEZ * _BC_ ; _cda = _cez * _da_ + _dez * _ac_ + _aez * _cd_ ; _CDA = _CEZ * _DA_ + _DEZ * _AC_ + _AEZ * _CD_ ; _dab = _dez * _ab_ + _aez * _bd_ + _bez * _da_ ; _DAB = _DEZ * _AB_ + _AEZ * _BD_ + _BEZ * _DA_ ; _FT = // roundoff tol _dli * _ABC + _cli * _DAB + _bli * _CDA + _ali * _BCD ; _FT *= _ER ; _d44 = // 4 x 4 result _dli * _abc - _cli * _dab + _bli * _cda - _ali * _bcd ; _OK = _d44 > _FT || _d44 < -_FT ; return ( _d44 ) ; } /* -------------------------------------------------------- * * Compute an exact determinant using multi-precision * expansions, a'la shewchuk * * | ax ay az dot(a, a) - aw +1. | * | bx by bz dot(b, b) - bw +1. | * | cx cy cz dot(c, c) - cw +1. | * | dx dy dz dot(d, d) - dw +1. | * | ex ey ez dot(e, e) - ew +1. | * * This is the weighted "in-ball" predicate in E^3. * -------------------------------------------------------- */ __normal_call REAL_TYPE inball3w_e ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd , __const_ptr(REAL_TYPE) _pe , bool_type &_OK ) { /*--------------- inball3w predicate, "exact" version */ mp::expansion< 7 > _a_lift, _b_lift, _c_lift, _d_lift, _e_lift; mp::expansion< 6 > _t_lift; mp::expansion< 4 > _d2_ab_, _d2_ac_, _d2_ad_, _d2_ae_, _d2_bc_, _d2_bd_, _d2_be_, _d2_cd_, _d2_ce_, _d2_de_; mp::expansion< 24> _d3_abc, _d3_abd, _d3_abe, _d3_acd, _d3_ace, _d3_ade, _d3_bcd, _d3_bce, _d3_bde, _d3_cde; mp::expansion< 96> _d4abcd, _d4abce, _d4abde, _d4acde, _d4bcde; mp::expansion<6720>_d5full; _OK = true; mp::expansion< 1 > _pa_zz_(_pa[ 2]); mp::expansion< 1 > _pb_zz_(_pb[ 2]); mp::expansion< 1 > _pc_zz_(_pc[ 2]); mp::expansion< 1 > _pd_zz_(_pd[ 2]); mp::expansion< 1 > _pe_zz_(_pe[ 2]); /*-------------------------------------- lifted terms */ mp::expansion_add( mp::expansion_from_sqr(_pa[ 0]), mp::expansion_from_sqr(_pa[ 1]), mp::expansion_from_sqr(_pa[ 2]), _t_lift ) ; mp::expansion_sub( _t_lift , _pa[ 3] , _a_lift); mp::expansion_add( mp::expansion_from_sqr(_pb[ 0]), mp::expansion_from_sqr(_pb[ 1]), mp::expansion_from_sqr(_pb[ 2]), _t_lift ) ; mp::expansion_sub( _t_lift , _pb[ 3] , _b_lift); mp::expansion_add( mp::expansion_from_sqr(_pc[ 0]), mp::expansion_from_sqr(_pc[ 1]), mp::expansion_from_sqr(_pc[ 2]), _t_lift ) ; mp::expansion_sub( _t_lift , _pc[ 3] , _c_lift); mp::expansion_add( mp::expansion_from_sqr(_pd[ 0]), mp::expansion_from_sqr(_pd[ 1]), mp::expansion_from_sqr(_pd[ 2]), _t_lift ) ; mp::expansion_sub( _t_lift , _pd[ 3] , _d_lift); mp::expansion_add( mp::expansion_from_sqr(_pe[ 0]), mp::expansion_from_sqr(_pe[ 1]), mp::expansion_from_sqr(_pe[ 2]), _t_lift ) ; mp::expansion_sub( _t_lift , _pe[ 3] , _e_lift); /*-------------------------------------- 2 x 2 minors */ compute_det_2x2(_pa[ 0], _pa[ 1], _pb[ 0], _pb[ 1], _d2_ab_ ) ; compute_det_2x2(_pa[ 0], _pa[ 1], _pc[ 0], _pc[ 1], _d2_ac_ ) ; compute_det_2x2(_pa[ 0], _pa[ 1], _pd[ 0], _pd[ 1], _d2_ad_ ) ; compute_det_2x2(_pa[ 0], _pa[ 1], _pe[ 0], _pe[ 1], _d2_ae_ ) ; compute_det_2x2(_pb[ 0], _pb[ 1], _pc[ 0], _pc[ 1], _d2_bc_ ) ; compute_det_2x2(_pb[ 0], _pb[ 1], _pd[ 0], _pd[ 1], _d2_bd_ ) ; compute_det_2x2(_pb[ 0], _pb[ 1], _pe[ 0], _pe[ 1], _d2_be_ ) ; compute_det_2x2(_pc[ 0], _pc[ 1], _pd[ 0], _pd[ 1], _d2_cd_ ) ; compute_det_2x2(_pc[ 0], _pc[ 1], _pe[ 0], _pe[ 1], _d2_ce_ ) ; compute_det_2x2(_pd[ 0], _pd[ 1], _pe[ 0], _pe[ 1], _d2_de_ ) ; /*-------------------------------------- 3 x 3 minors */ compute_det_3x3(_d2_bc_, _pa_zz_, _d2_ac_, _pb_zz_, _d2_ab_, _pc_zz_, _d3_abc, +3) ; compute_det_3x3(_d2_bd_, _pa_zz_, _d2_ad_, _pb_zz_, _d2_ab_, _pd_zz_, _d3_abd, +3) ; compute_det_3x3(_d2_be_, _pa_zz_, _d2_ae_, _pb_zz_, _d2_ab_, _pe_zz_, _d3_abe, +3) ; compute_det_3x3(_d2_cd_, _pa_zz_, _d2_ad_, _pc_zz_, _d2_ac_, _pd_zz_, _d3_acd, +3) ; compute_det_3x3(_d2_ce_, _pa_zz_, _d2_ae_, _pc_zz_, _d2_ac_, _pe_zz_, _d3_ace, +3) ; compute_det_3x3(_d2_de_, _pa_zz_, _d2_ae_, _pd_zz_, _d2_ad_, _pe_zz_, _d3_ade, +3) ; compute_det_3x3(_d2_cd_, _pb_zz_, _d2_bd_, _pc_zz_, _d2_bc_, _pd_zz_, _d3_bcd, +3) ; compute_det_3x3(_d2_ce_, _pb_zz_, _d2_be_, _pc_zz_, _d2_bc_, _pe_zz_, _d3_bce, +3) ; compute_det_3x3(_d2_de_, _pb_zz_, _d2_be_, _pd_zz_, _d2_bd_, _pe_zz_, _d3_bde, +3) ; compute_det_3x3(_d2_de_, _pc_zz_, _d2_ce_, _pd_zz_, _d2_cd_, _pe_zz_, _d3_cde, +3) ; /*-------------------------------------- 4 x 4 minors */ unitary_det_4x4(_d3_cde, _d3_bde, _d3_bce, _d3_bcd, _d4bcde, +4) ; unitary_det_4x4(_d3_cde, _d3_ade, _d3_ace, _d3_acd, _d4acde, +4) ; unitary_det_4x4(_d3_bde, _d3_ade, _d3_abe, _d3_abd, _d4abde, +4) ; unitary_det_4x4(_d3_bce, _d3_ace, _d3_abe, _d3_abc, _d4abce, +4) ; unitary_det_4x4(_d3_bcd, _d3_acd, _d3_abd, _d3_abc, _d4abcd, +4) ; /*-------------------------------------- 5 x 5 result */ compute_det_5x5(_d4bcde, _a_lift, _d4acde, _b_lift, _d4abde, _c_lift, _d4abce, _d_lift, _d4abcd, _e_lift, _d5full, +4) ; /*-------------------------------------- leading det. */ return mp::expansion_est(_d5full) ; } __normal_call REAL_TYPE inball3w_i ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd , __const_ptr(REAL_TYPE) _pe , bool_type &_OK ) { /*--------------- inball3w predicate, "bound" version */ ia_flt _aex, _aey, _aez , _aew, _ali, _bex, _bey, _bez , _bew, _bli, _cex, _cey, _cez , _cew, _cli, _dex, _dey, _dez , _dew, _dli; ia_flt _aexbey, _bexaey , _aexcey, _cexaey , _bexcey, _cexbey , _cexdey, _dexcey , _dexaey, _aexdey , _bexdey, _dexbey ; ia_flt _ab_, _bc_, _cd_, _da_, _ac_, _bd_; ia_flt _abc, _bcd, _cda, _dab; ia_flt _d44; ia_rnd _rnd; // up rounding! _aex.from_sub(_pa[0], _pe[0]) ; // coord. diff. _aey.from_sub(_pa[1], _pe[1]) ; _aez.from_sub(_pa[2], _pe[2]) ; _aew.from_sub(_pa[3], _pe[3]) ; _bex.from_sub(_pb[0], _pe[0]) ; _bey.from_sub(_pb[1], _pe[1]) ; _bez.from_sub(_pb[2], _pe[2]) ; _bew.from_sub(_pb[3], _pe[3]) ; _cex.from_sub(_pc[0], _pe[0]) ; _cey.from_sub(_pc[1], _pe[1]) ; _cez.from_sub(_pc[2], _pe[2]) ; _cew.from_sub(_pc[3], _pe[3]) ; _dex.from_sub(_pd[0], _pe[0]) ; _dey.from_sub(_pd[1], _pe[1]) ; _dez.from_sub(_pd[2], _pe[2]) ; _dew.from_sub(_pd[3], _pe[3]) ; _ali = sqr(_aex) + sqr(_aey) // lifted terms + sqr(_aez) - _aew ; _bli = sqr(_bex) + sqr(_bey) + sqr(_bez) - _bew ; _cli = sqr(_cex) + sqr(_cey) + sqr(_cez) - _cew ; _dli = sqr(_dex) + sqr(_dey) + sqr(_dez) - _dew ; _aexbey = _aex * _bey ; // 2 x 2 minors _bexaey = _bex * _aey ; _ab_ = _aexbey - _bexaey ; _bexcey = _bex * _cey; _cexbey = _cex * _bey; _bc_ = _bexcey - _cexbey ; _cexdey = _cex * _dey; _dexcey = _dex * _cey; _cd_ = _cexdey - _dexcey ; _dexaey = _dex * _aey; _aexdey = _aex * _dey; _da_ = _dexaey - _aexdey ; _aexcey = _aex * _cey; _cexaey = _cex * _aey; _ac_ = _aexcey - _cexaey ; _bexdey = _bex * _dey; _dexbey = _dex * _bey; _bd_ = _bexdey - _dexbey ; _abc = // 3 x 3 minors _aez * _bc_ - _bez * _ac_ + _cez * _ab_ ; _bcd = _bez * _cd_ - _cez * _bd_ + _dez * _bc_ ; _cda = _cez * _da_ + _dez * _ac_ + _aez * _cd_ ; _dab = _dez * _ab_ + _aez * _bd_ + _bez * _da_ ; _d44 = // 4 x 4 result _dli * _abc - _cli * _dab + _bli * _cda - _ali * _bcd ; _OK = _d44.lo() >= (REAL_TYPE)0. ||_d44.up() <= (REAL_TYPE)0.; return ( _d44.mid() ) ; } __normal_call REAL_TYPE inball3w_f ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd , __const_ptr(REAL_TYPE) _pe , bool_type &_OK ) { /*--------------- inball3w predicate, "float" version */ REAL_TYPE static const _ER = + 18. * std::pow(mp::_epsilon, 1) ; REAL_TYPE _aex, _aey, _aez , _aew, _ali, _bex, _bey, _bez , _bew, _bli, _cex, _cey, _cez , _cew, _cli, _dex, _dey, _dez , _dew, _dli; REAL_TYPE _aexbey, _bexaey , _aexcey, _cexaey , _bexcey, _cexbey , _cexdey, _dexcey , _dexaey, _aexdey , _bexdey, _dexbey ; REAL_TYPE _ab_, _bc_, _cd_, _da_, _ac_, _bd_; REAL_TYPE _abc, _bcd, _cda, _dab; REAL_TYPE _AEZ, _BEZ, _CEZ, _DEZ; REAL_TYPE _ALI, _BLI, _CLI, _DLI; REAL_TYPE _AEXBEY, _BEXAEY , _CEXAEY, _AEXCEY , _BEXCEY, _CEXBEY , _CEXDEY, _DEXCEY , _DEXAEY, _AEXDEY , _BEXDEY, _DEXBEY ; REAL_TYPE _AB_, _BC_, _CD_, _DA_, _AC_, _BD_; REAL_TYPE _ABC, _BCD, _CDA, _DAB; REAL_TYPE _d44, _FT ; _aex = _pa [0] - _pe [0] ; // coord. diff. _aey = _pa [1] - _pe [1] ; _aez = _pa [2] - _pe [2] ; _aew = _pa [3] - _pe [3] ; _AEZ = std::abs (_aez) ; _bex = _pb [0] - _pe [0] ; _bey = _pb [1] - _pe [1] ; _bez = _pb [2] - _pe [2] ; _bew = _pb [3] - _pe [3] ; _BEZ = std::abs (_bez) ; _cex = _pc [0] - _pe [0] ; _cey = _pc [1] - _pe [1] ; _cez = _pc [2] - _pe [2] ; _cew = _pc [3] - _pe [3] ; _CEZ = std::abs (_cez) ; _dex = _pd [0] - _pe [0] ; _dey = _pd [1] - _pe [1] ; _dez = _pd [2] - _pe [2] ; _dew = _pd [3] - _pe [3] ; _DEZ = std::abs (_dez) ; _ali = _aex * _aex + _aey * _aey // lifted terms + _aez * _aez - _aew ; _ALI = std::abs (_ali) ; _bli = _bex * _bex + _bey * _bey + _bez * _bez - _bew ; _BLI = std::abs (_bli) ; _cli = _cex * _cex + _cey * _cey + _cez * _cez - _cew ; _CLI = std::abs (_cli) ; _dli = _dex * _dex + _dey * _dey + _dez * _dez - _dew ; _DLI = std::abs (_dli) ; _aexbey = _aex * _bey ; // 2 x 2 minors _bexaey = _bex * _aey ; _ab_ = _aexbey - _bexaey ; _AEXBEY = std::abs (_aexbey) ; _BEXAEY = std::abs (_bexaey) ; _AB_ = _AEXBEY + _BEXAEY ; _bexcey = _bex * _cey; _cexbey = _cex * _bey; _bc_ = _bexcey - _cexbey ; _BEXCEY = std::abs (_bexcey) ; _CEXBEY = std::abs (_cexbey) ; _BC_ = _BEXCEY + _CEXBEY ; _cexdey = _cex * _dey; _dexcey = _dex * _cey; _cd_ = _cexdey - _dexcey ; _CEXDEY = std::abs (_cexdey) ; _DEXCEY = std::abs (_dexcey) ; _CD_ = _CEXDEY + _DEXCEY ; _dexaey = _dex * _aey; _aexdey = _aex * _dey; _da_ = _dexaey - _aexdey ; _DEXAEY = std::abs (_dexaey) ; _AEXDEY = std::abs (_aexdey) ; _DA_ = _DEXAEY + _AEXDEY ; _aexcey = _aex * _cey; _cexaey = _cex * _aey; _ac_ = _aexcey - _cexaey ; _AEXCEY = std::abs (_aexcey) ; _CEXAEY = std::abs (_cexaey) ; _AC_ = _AEXCEY + _CEXAEY ; _bexdey = _bex * _dey; _dexbey = _dex * _bey; _bd_ = _bexdey - _dexbey ; _BEXDEY = std::abs (_bexdey) ; _DEXBEY = std::abs (_dexbey) ; _BD_ = _BEXDEY + _DEXBEY ; _abc = // 3 x 3 minors _aez * _bc_ - _bez * _ac_ + _cez * _ab_ ; _ABC = _AEZ * _BC_ + _BEZ * _AC_ + _CEZ * _AB_ ; _bcd = _bez * _cd_ - _cez * _bd_ + _dez * _bc_ ; _BCD = _BEZ * _CD_ + _CEZ * _BD_ + _DEZ * _BC_ ; _cda = _cez * _da_ + _dez * _ac_ + _aez * _cd_ ; _CDA = _CEZ * _DA_ + _DEZ * _AC_ + _AEZ * _CD_ ; _dab = _dez * _ab_ + _aez * _bd_ + _bez * _da_ ; _DAB = _DEZ * _AB_ + _AEZ * _BD_ + _BEZ * _DA_ ; _FT = // roundoff tol _DLI * _ABC + _CLI * _DAB + _BLI * _CDA + _ALI * _BCD ; _FT *= _ER ; _d44 = // 4 x 4 result _dli * _abc - _cli * _dab + _bli * _cda - _ali * _bcd ; _OK = _d44 > _FT || _d44 < -_FT ; return ( _d44 ) ; } ggforce/src/robust_predicate/predicate/orient_k.hpp0000644000176200001440000002667314672274110022320 0ustar liggesusers /* -------------------------------------------------------- * PREDICATE-k: robust geometric predicates in E^k. -------------------------------------------------------- * * This program may be freely redistributed under the * condition that the copyright notices (including this * entire header) are not removed, and no compensation * is received through use of the software. Private, * research, and institutional use is free. You may * distribute modified versions of this code UNDER THE * CONDITION THAT THIS CODE AND ANY MODIFICATIONS MADE * TO IT IN THE SAME FILE REMAIN UNDER COPYRIGHT OF THE * ORIGINAL AUTHOR, BOTH SOURCE AND OBJECT CODE ARE * MADE FREELY AVAILABLE WITHOUT CHARGE, AND CLEAR * NOTICE IS GIVEN OF THE MODIFICATIONS. Distribution * of this code as part of a commercial system is * permissible ONLY BY DIRECT ARRANGEMENT WITH THE * AUTHOR. (If you are not directly supplying this * code to a customer, and you are instead telling them * how they can obtain it for free, then you are not * required to make any arrangement with me.) * * Disclaimer: Neither I nor: Columbia University, The * Massachusetts Institute of Technology, The * University of Sydney, nor The National Aeronautics * and Space Administration warrant this code in any * way whatsoever. This code is provided "as-is" to be * used at your own risk. * -------------------------------------------------------- * * Last updated: 14 April, 2020 * * Copyright 2020-- * Darren Engwirda * de2363@columbia.edu * https://github.com/dengwirda/ * -------------------------------------------------------- */ // from predicate_k.hpp... /* -------------------------------------------------------- * * Compute an exact determinant using multi-precision * expansions, a'la shewchuk * * | ax ay +1. | * | bx by +1. | * | cx cy +1. | * * This is the planar "orientation" predicate in E^2. * -------------------------------------------------------- */ __normal_call REAL_TYPE orient2d_e ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , bool_type &_OK ) { /*--------------- orient2d predicate, "exact" version */ mp::expansion< 4 > _d2_ab_, _d2_ac_, _d2_bc_; mp::expansion< 12> _d3full; _OK = true; /*-------------------------------------- 2 x 2 minors */ compute_det_2x2(_pa[ 0], _pa[ 1], _pb[ 0], _pb[ 1], _d2_ab_ ) ; compute_det_2x2(_pa[ 0], _pa[ 1], _pc[ 0], _pc[ 1], _d2_ac_ ) ; compute_det_2x2(_pb[ 0], _pb[ 1], _pc[ 0], _pc[ 1], _d2_bc_ ) ; /*-------------------------------------- 3 x 3 result */ unitary_det_3x3(_d2_bc_, _d2_ac_, _d2_ab_, _d3full, +3) ; /*-------------------------------------- leading det. */ return mp::expansion_est(_d3full) ; } __normal_call REAL_TYPE orient2d_i ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , bool_type &_OK ) { /*--------------- orient2d predicate, "bound" version */ ia_flt _acx, _acy ; ia_flt _bcx, _bcy ; ia_flt _acxbcy, _acybcx ; ia_flt _sgn; ia_rnd _rnd; // up rounding! _acx.from_sub(_pa[0], _pc[0]) ; // coord. diff. _acy.from_sub(_pa[1], _pc[1]) ; _bcx.from_sub(_pb[0], _pc[0]) ; _bcy.from_sub(_pb[1], _pc[1]) ; _acxbcy = _acx * _bcy ; _acybcx = _acy * _bcx ; _sgn = _acxbcy - _acybcx ; // 2 x 2 result _OK = _sgn.lo() >= (REAL_TYPE)0. || _sgn.up() <= (REAL_TYPE)0. ; return ( _sgn.mid() ) ; } __normal_call REAL_TYPE orient2d_f ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , bool_type &_OK ) { /*--------------- orient2d predicate, "float" version */ REAL_TYPE static const _ER = + 4. * std::pow(mp::_epsilon, 1) ; REAL_TYPE _acx, _acy ; REAL_TYPE _bcx, _bcy ; REAL_TYPE _acxbcy, _acybcx ; REAL_TYPE _ACXBCY, _ACYBCX ; REAL_TYPE _sgn, _FT; _acx = _pa [0] - _pc [0] ; // coord. diff. _acy = _pa [1] - _pc [1] ; _bcx = _pb [0] - _pc [0] ; _bcy = _pb [1] - _pc [1] ; _acxbcy = _acx * _bcy ; _acybcx = _acy * _bcx ; _ACXBCY = std::abs(_acxbcy); _ACYBCX = std::abs(_acybcx); _FT = _ACXBCY + _ACYBCX ; // roundoff tol _FT *= _ER ; _sgn = _acxbcy - _acybcx ; // 2 x 2 result _OK = _sgn > +_FT || _sgn < -_FT ; return ( _sgn ) ; } /* -------------------------------------------------------- * * Compute an exact determinant using multi-precision * expansions, a'la shewchuk * * | ax ay az +1. | * | bx by bz +1. | * | cx cy cz +1. | * | dx dy dz +1. | * * This is the planar "orientation" predicate in E^3. * -------------------------------------------------------- */ __normal_call REAL_TYPE orient3d_e ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd , bool_type &_OK ) { /*--------------- orient3d predicate, "exact" version */ mp::expansion< 4 > _d2_ab_, _d2_ac_, _d2_ad_, _d2_bc_, _d2_bd_, _d2_cd_; mp::expansion< 12> _d3_abc, _d3_abd, _d3_acd, _d3_bcd; mp::expansion< 96> _d4full; _OK = true; mp::expansion< 1 > _pa_zz_(_pa[ 2]); mp::expansion< 1 > _pb_zz_(_pb[ 2]); mp::expansion< 1 > _pc_zz_(_pc[ 2]); mp::expansion< 1 > _pd_zz_(_pd[ 2]); /*-------------------------------------- 2 x 2 minors */ compute_det_2x2(_pa[ 0], _pa[ 1], _pb[ 0], _pb[ 1], _d2_ab_ ) ; compute_det_2x2(_pa[ 0], _pa[ 1], _pc[ 0], _pc[ 1], _d2_ac_ ) ; compute_det_2x2(_pa[ 0], _pa[ 1], _pd[ 0], _pd[ 1], _d2_ad_ ) ; compute_det_2x2(_pb[ 0], _pb[ 1], _pc[ 0], _pc[ 1], _d2_bc_ ) ; compute_det_2x2(_pb[ 0], _pb[ 1], _pd[ 0], _pd[ 1], _d2_bd_ ) ; compute_det_2x2(_pc[ 0], _pc[ 1], _pd[ 0], _pd[ 1], _d2_cd_ ) ; /*-------------------------------------- 3 x 3 minors */ unitary_det_3x3(_d2_cd_, _d2_bd_, _d2_bc_, _d3_bcd, +3) ; unitary_det_3x3(_d2_cd_, _d2_ad_, _d2_ac_, _d3_acd, +3) ; unitary_det_3x3(_d2_bd_, _d2_ad_, _d2_ab_, _d3_abd, +3) ; unitary_det_3x3(_d2_bc_, _d2_ac_, _d2_ab_, _d3_abc, +3) ; /*-------------------------------------- 4 x 4 result */ compute_det_4x4(_d3_bcd, _pa_zz_, _d3_acd, _pb_zz_, _d3_abd, _pc_zz_, _d3_abc, _pd_zz_, _d4full, +3) ; /*-------------------------------------- leading det. */ return mp::expansion_est(_d4full) ; } __normal_call REAL_TYPE orient3d_i ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd , bool_type &_OK ) { /*--------------- orient3d predicate, "bound" version */ ia_flt _adx, _ady, _adz , _bdx, _bdy, _bdz , _cdx, _cdy, _cdz ; ia_flt _bdxcdy, _cdxbdy , _cdxady, _adxcdy , _adxbdy, _bdxady ; ia_flt _sgn; ia_rnd _rnd; // up rounding! _adx.from_sub(_pa[0], _pd[0]) ; // coord. diff. _ady.from_sub(_pa[1], _pd[1]) ; _adz.from_sub(_pa[2], _pd[2]) ; _bdx.from_sub(_pb[0], _pd[0]) ; _bdy.from_sub(_pb[1], _pd[1]) ; _bdz.from_sub(_pb[2], _pd[2]) ; _cdx.from_sub(_pc[0], _pd[0]) ; _cdy.from_sub(_pc[1], _pd[1]) ; _cdz.from_sub(_pc[2], _pd[2]) ; _bdxcdy = _bdx * _cdy ; // 2 x 2 minors _cdxbdy = _cdx * _bdy ; _cdxady = _cdx * _ady ; _adxcdy = _adx * _cdy ; _adxbdy = _adx * _bdy ; _bdxady = _bdx * _ady ; _sgn = // 3 x 3 result _adz * (_bdxcdy - _cdxbdy) + _bdz * (_cdxady - _adxcdy) + _cdz * (_adxbdy - _bdxady); _OK = _sgn.lo() >= (REAL_TYPE)0. ||_sgn.up() <= (REAL_TYPE)0.; return ( _sgn.mid() ) ; } __normal_call REAL_TYPE orient3d_f ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd , bool_type &_OK ) { /*--------------- orient3d predicate, "float" version */ REAL_TYPE static const _ER = + 8. * std::pow(mp::_epsilon, 1) ; REAL_TYPE _adx, _ady, _adz , _bdx, _bdy, _bdz , _cdx, _cdy, _cdz ; REAL_TYPE _bdxcdy, _cdxbdy , _cdxady, _adxcdy , _adxbdy, _bdxady ; REAL_TYPE _ADZ, _BDZ, _CDZ ; REAL_TYPE _BDXCDY, _CDXBDY , _CDXADY, _ADXCDY , _ADXBDY, _BDXADY ; REAL_TYPE _sgn, _FT; _adx = _pa [0] - _pd [0] ; // coord. diff. _ady = _pa [1] - _pd [1] ; _adz = _pa [2] - _pd [2] ; _ADZ = std::abs (_adz) ; _bdx = _pb [0] - _pd [0] ; _bdy = _pb [1] - _pd [1] ; _bdz = _pb [2] - _pd [2] ; _BDZ = std::abs (_bdz) ; _cdx = _pc [0] - _pd [0] ; _cdy = _pc [1] - _pd [1] ; _cdz = _pc [2] - _pd [2] ; _CDZ = std::abs (_cdz) ; _bdxcdy = _bdx * _cdy ; // 2 x 2 minors _cdxbdy = _cdx * _bdy ; _cdxady = _cdx * _ady ; _adxcdy = _adx * _cdy ; _adxbdy = _adx * _bdy ; _bdxady = _bdx * _ady ; _BDXCDY = std::abs (_bdxcdy) ; _CDXBDY = std::abs (_cdxbdy) ; _CDXADY = std::abs (_cdxady) ; _ADXCDY = std::abs (_adxcdy) ; _ADXBDY = std::abs (_adxbdy) ; _BDXADY = std::abs (_bdxady) ; _FT = // roundoff tol _ADZ * (_BDXCDY + _CDXBDY) + _BDZ * (_CDXADY + _ADXCDY) + _CDZ * (_ADXBDY + _BDXADY) ; _FT *= _ER ; _sgn = // 3 x 3 result _adz * (_bdxcdy - _cdxbdy) + _bdz * (_cdxady - _adxcdy) + _cdz * (_adxbdy - _bdxady) ; _OK = _sgn > +_FT || _sgn < -_FT ; return ( _sgn ) ; } ggforce/src/robust_predicate/predicate/predicate_k.hpp0000644000176200001440000003502614672274110022750 0ustar liggesusers /* -------------------------------------------------------- * PREDICATE-k: robust geometric predicates in E^k. -------------------------------------------------------- * * Compute "robust" geometric predicates using filtered * floating-point + multi-precision expansions. * * The sign-correctness of each predicate is guaranteed * --- using exact arithmetic where necessary to * eliminate floating-point round-off. See Shewchuk for * additional detail * * J. R. Shewchuk (1997), Adaptive Precision Floating- * Point Arithmetic & Fast Robust Geometric Predicates * Discrete & Computational Geometry, 18, pp. 305-363. * * A translational version of BFS semi-static filtering * is employed, adapted from, e.g. * * C. Burnikel, S. Funke, and M. Seel (2001), Exact * geometric computation using cascading. * IJCGA (Special issue) 11 (3), pp. 245–266. * * O. Devillers and S. Pion (2002), Efficient Exact * Geometric Predicates for Delaunay Triangulations. * RR-4351, INRIA. inria-00072237 * -------------------------------------------------------- * * This program may be freely redistributed under the * condition that the copyright notices (including this * entire header) are not removed, and no compensation * is received through use of the software. Private, * research, and institutional use is free. You may * distribute modified versions of this code UNDER THE * CONDITION THAT THIS CODE AND ANY MODIFICATIONS MADE * TO IT IN THE SAME FILE REMAIN UNDER COPYRIGHT OF THE * ORIGINAL AUTHOR, BOTH SOURCE AND OBJECT CODE ARE * MADE FREELY AVAILABLE WITHOUT CHARGE, AND CLEAR * NOTICE IS GIVEN OF THE MODIFICATIONS. Distribution * of this code as part of a commercial system is * permissible ONLY BY DIRECT ARRANGEMENT WITH THE * AUTHOR. (If you are not directly supplying this * code to a customer, and you are instead telling them * how they can obtain it for free, then you are not * required to make any arrangement with me.) * * Disclaimer: Neither I nor: Columbia University, The * Massachusetts Institute of Technology, The * University of Sydney, nor The National Aeronautics * and Space Administration warrant this code in any * way whatsoever. This code is provided "as-is" to be * used at your own risk. * -------------------------------------------------------- * * Last updated: 15 April, 2020 * * Copyright 2020-- * Darren Engwirda * de2363@columbia.edu * https://github.com/dengwirda/ * -------------------------------------------------------- */ # pragma once # ifndef __PREDICATE_K__ # define __PREDICATE_K__ # define USE_KERNEL_FLTPOINT // define USE_KERNEL_INTERVAL namespace geompred { # define REAL_TYPE mp_float::real_type # define INDX_TYPE mp_float::indx_type namespace mp=mp_float; enum _kernel { ORIENT2D_f, ORIENT2D_i, ORIENT2D_e , ORIENT3D_f, ORIENT3D_i, ORIENT3D_e , BISECT2D_f, BISECT2D_i, BISECT2D_e , BISECT2W_f, BISECT2W_i, BISECT2W_e , BISECT3D_f, BISECT3D_i, BISECT3D_e , BISECT3W_f, BISECT3W_i, BISECT3W_e , INBALL2D_f, INBALL2D_i, INBALL2D_e , INBALL2W_f, INBALL2W_i, INBALL2W_e , INBALL3D_f, INBALL3D_i, INBALL3D_e , INBALL3W_f, INBALL3W_i, INBALL3W_e , LASTKERNEL } ; size_t _nn_calls[LASTKERNEL] = {0} ; # include "orient_k.hpp" # include "bisect_k.hpp" // include "linear_k.hpp" # include "inball_k.hpp" __inline_call REAL_TYPE orient2d ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc ) { /*------------ orient2d predicate, "filtered" version */ REAL_TYPE _rr; bool_type _OK; # ifdef USE_KERNEL_FLTPOINT _nn_calls[ORIENT2D_f] += +1; _rr = orient2d_f( // "float" kernel _pa, _pb, _pc, _OK ) ; if (_OK && std::isnormal(_rr)) return _rr ; # endif # ifdef USE_KERNEL_INTERVAL _nn_calls[ORIENT2D_i] += +1; _rr = orient2d_i( // "bound" kernel _pa, _pb, _pc, _OK ) ; if (_OK) return _rr ; # endif _nn_calls[ORIENT2D_e] += +1; _rr = orient2d_e( // "exact" kernel _pa, _pb, _pc, _OK ) ; if (_OK) return _rr ; return (REAL_TYPE) +0.0E+00; } __inline_call REAL_TYPE orient3d ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd ) { /*------------ orient3d predicate, "filtered" version */ REAL_TYPE _rr; bool_type _OK; # ifdef USE_KERNEL_FLTPOINT _nn_calls[ORIENT3D_f] += +1; _rr = orient3d_f( // "float" kernel _pa, _pb, _pc, _pd, _OK ) ; if (_OK && std::isnormal(_rr)) return _rr ; # endif # ifdef USE_KERNEL_INTERVAL _nn_calls[ORIENT3D_i] += +1; _rr = orient3d_i( // "bound" kernel _pa, _pb, _pc, _pd, _OK ) ; if (_OK) return _rr ; # endif _nn_calls[ORIENT3D_e] += +1; _rr = orient3d_e( // "exact" kernel _pa, _pb, _pc, _pd, _OK ) ; if (_OK) return _rr ; return (REAL_TYPE) +0.0E+00; } __inline_call REAL_TYPE bisect2d ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc ) { /*------------ bisect2d predicate, "filtered" version */ REAL_TYPE _rr; bool_type _OK; # ifdef USE_KERNEL_FLTPOINT _nn_calls[BISECT2D_f] += +1; _rr = bisect2d_f( // "float" kernel _pa, _pb, _pc, _OK ) ; if (_OK && std::isnormal(_rr)) return _rr ; # endif # ifdef USE_KERNEL_INTERVAL _nn_calls[BISECT2D_i] += +1; _rr = bisect2d_i( // "bound" kernel _pa, _pb, _pc, _OK ) ; if (_OK) return _rr ; # endif _nn_calls[BISECT2D_e] += +1; _rr = bisect2d_e( // "exact" kernel _pa, _pb, _pc, _OK ) ; if (_OK) return _rr ; return (REAL_TYPE) +0.0E+00; } __inline_call REAL_TYPE bisect2w ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc ) { /*------------ bisect2w predicate, "filtered" version */ if (_pa [ 2] == _pb [ 2] ) { // equal weights, do bisect2d return bisect2d(_pa, _pb, _pc) ; } else { REAL_TYPE _rr; // given weights, full kernel bool_type _OK; # ifdef USE_KERNEL_FLTPOINT _nn_calls[BISECT2W_f] += +1; _rr = bisect2w_f( // "float" kernel _pa, _pb, _pc, _OK ) ; if (_OK && std::isnormal(_rr)) return _rr ; # endif # ifdef USE_KERNEL_INTERVAL _nn_calls[BISECT2W_i] += +1; _rr = bisect2w_i( // "bound" kernel _pa, _pb, _pc, _OK ) ; if (_OK) return _rr ; # endif _nn_calls[BISECT2W_e] += +1; _rr = bisect2w_e( // "exact" kernel _pa, _pb, _pc, _OK ) ; if (_OK) return _rr ; return (REAL_TYPE) +0.0E+00; } } __inline_call REAL_TYPE bisect3d ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc ) { /*------------ bisect3d predicate, "filtered" version */ REAL_TYPE _rr; bool_type _OK; # ifdef USE_KERNEL_FLTPOINT _nn_calls[BISECT3D_f] += +1; _rr = bisect3d_f( // "float" kernel _pa, _pb, _pc, _OK ) ; if (_OK && std::isnormal(_rr)) return _rr ; # endif # ifdef USE_KERNEL_INTERVAL _nn_calls[BISECT3D_i] += +1; _rr = bisect3d_i( // "bound" kernel _pa, _pb, _pc, _OK ) ; if (_OK) return _rr ; # endif _nn_calls[BISECT3D_e] += +1; _rr = bisect3d_e( // "exact" kernel _pa, _pb, _pc, _OK ) ; if (_OK) return _rr ; return (REAL_TYPE) +0.0E+00; } __inline_call REAL_TYPE bisect3w ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc ) { /*------------ bisect3w predicate, "filtered" version */ if (_pa [ 3] == _pb [ 3] ) { // equal weights, do bisect3d return bisect3d(_pa, _pb, _pc) ; } else { REAL_TYPE _rr; // given weights, full kernel bool_type _OK; # ifdef USE_KERNEL_FLTPOINT _nn_calls[BISECT3W_f] += +1; _rr = bisect3w_f( // "float" kernel _pa, _pb, _pc, _OK ) ; if (_OK && std::isnormal(_rr)) return _rr ; # endif # ifdef USE_KERNEL_INTERVAL _nn_calls[BISECT3W_i] += +1; _rr = bisect3w_i( // "bound" kernel _pa, _pb, _pc, _OK ) ; if (_OK) return _rr ; # endif _nn_calls[BISECT3W_e] += +1; _rr = bisect3w_e( // "exact" kernel _pa, _pb, _pc, _OK ) ; if (_OK) return _rr ; return (REAL_TYPE) +0.0E+00; } } __inline_call REAL_TYPE inball2d ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd ) { /*------------ inball2d predicate, "filtered" version */ REAL_TYPE _rr; bool_type _OK; # ifdef USE_KERNEL_FLTPOINT _nn_calls[INBALL2D_f] += +1; _rr = inball2d_f( // "float" kernel _pa, _pb, _pc, _pd, _OK ) ; if (_OK && std::isnormal(_rr)) return _rr ; # endif # ifdef USE_KERNEL_INTERVAL _nn_calls[INBALL2D_i] += +1; _rr = inball2d_i( // "bound" kernel _pa, _pb, _pc, _pd, _OK ) ; if (_OK) return _rr ; # endif _nn_calls[INBALL2D_e] += +1; _rr = inball2d_e( // "exact" kernel _pa, _pb, _pc, _pd, _OK ) ; if (_OK) return _rr ; return (REAL_TYPE) +0.0E+00; } __inline_call REAL_TYPE inball2w ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd ) { /*------------ inball2w predicate, "filtered" version */ if (_pa [ 2] == _pb [ 2] && _pb [ 2] == _pc [ 2] && _pc [ 2] == _pd [ 2] ) { return inball2d ( // equal weights, do inball2d _pa, _pb, _pc, _pd ) ; } else { REAL_TYPE _rr; // given weights, full kernel bool_type _OK; # ifdef USE_KERNEL_FLTPOINT _nn_calls[INBALL2W_f] += +1; _rr = inball2w_f( // "float" kernel _pa, _pb, _pc, _pd, _OK ) ; if (_OK && std::isnormal(_rr)) return _rr ; # endif # ifdef USE_KERNEL_INTERVAL _nn_calls[INBALL2W_i] += +1; _rr = inball2w_i( // "bound" kernel _pa, _pb, _pc, _pd, _OK ) ; if (_OK) return _rr ; # endif _nn_calls[INBALL2W_e] += +1; _rr = inball2w_e( // "exact" kernel _pa, _pb, _pc, _pd, _OK ) ; if (_OK) return _rr ; return (REAL_TYPE) +0.0E+00; } } __inline_call REAL_TYPE inball3d ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd , __const_ptr(REAL_TYPE) _pe ) { /*------------ inball3d predicate, "filtered" version */ REAL_TYPE _rr; bool_type _OK; # ifdef USE_KERNEL_FLTPOINT _nn_calls[INBALL3D_f] += +1; _rr = inball3d_f( // "float" kernel _pa, _pb, _pc, _pd, _pe, _OK ) ; if (_OK && std::isnormal(_rr)) return _rr ; # endif # ifdef USE_KERNEL_INTERVAL _nn_calls[INBALL3D_i] += +1; _rr = inball3d_i( // "bound" kernel _pa, _pb, _pc, _pd, _pe, _OK ) ; if (_OK) return _rr ; # endif _nn_calls[INBALL3D_e] += +1; _rr = inball3d_e( // "exact" kernel _pa, _pb, _pc, _pd, _pe, _OK ) ; if (_OK) return _rr ; return (REAL_TYPE) +0.0E+00; } __inline_call REAL_TYPE inball3w ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , __const_ptr(REAL_TYPE) _pd , __const_ptr(REAL_TYPE) _pe ) { /*------------ inball3w predicate, "filtered" version */ if (_pa [ 3] == _pb [ 3] && _pb [ 3] == _pc [ 3] && _pc [ 3] == _pd [ 3] && _pd [ 3] == _pe [ 3] ) { return inball3d ( // equal weights, do inball3d _pa, _pb, _pc, _pd, _pe ) ; } else { REAL_TYPE _rr; // given weights, full kernel bool_type _OK; # ifdef USE_KERNEL_FLTPOINT _nn_calls[INBALL3W_f] += +1; _rr = inball3w_f( // "float" kernal _pa, _pb, _pc, _pd, _pe, _OK ) ; if (_OK && std::isnormal(_rr)) return _rr ; # endif # ifdef USE_KERNEL_INTERVAL _nn_calls[INBALL3D_i] += +1; _rr = inball3w_i( // "bound" kernel _pa, _pb, _pc, _pd, _pe, _OK ) ; if (_OK) return _rr ; # endif _nn_calls[INBALL3W_e] += +1; _rr = inball3w_e( // "exact" kernel _pa, _pb, _pc, _pd, _pe, _OK ) ; if (_OK) return _rr ; return (REAL_TYPE) +0.0E+00; } } # undef REAL_TYPE # undef INDX_TYPE # undef USE_KERNEL_FLTPOINT # undef USE_KERNEL_INTERVAL } # endif//__PREDICATE_K__ ggforce/src/robust_predicate/predicate/bisect_k.hpp0000644000176200001440000004343314672274110022262 0ustar liggesusers /* -------------------------------------------------------- * PREDICATE-k: robust geometric predicates in E^k. -------------------------------------------------------- * * This program may be freely redistributed under the * condition that the copyright notices (including this * entire header) are not removed, and no compensation * is received through use of the software. Private, * research, and institutional use is free. You may * distribute modified versions of this code UNDER THE * CONDITION THAT THIS CODE AND ANY MODIFICATIONS MADE * TO IT IN THE SAME FILE REMAIN UNDER COPYRIGHT OF THE * ORIGINAL AUTHOR, BOTH SOURCE AND OBJECT CODE ARE * MADE FREELY AVAILABLE WITHOUT CHARGE, AND CLEAR * NOTICE IS GIVEN OF THE MODIFICATIONS. Distribution * of this code as part of a commercial system is * permissible ONLY BY DIRECT ARRANGEMENT WITH THE * AUTHOR. (If you are not directly supplying this * code to a customer, and you are instead telling them * how they can obtain it for free, then you are not * required to make any arrangement with me.) * * Disclaimer: Neither I nor: Columbia University, The * Massachusetts Institute of Technology, The * University of Sydney, nor The National Aeronautics * and Space Administration warrant this code in any * way whatsoever. This code is provided "as-is" to be * used at your own risk. * -------------------------------------------------------- * * Last updated: 14 April, 2020 * * Copyright 2020-- * Darren Engwirda * de2363@columbia.edu * https://github.com/dengwirda/ * -------------------------------------------------------- */ // from predicate_k.hpp... /* -------------------------------------------------------- * * Compute an exact orientation wrt. bisector using * multi-precision expansions, a'la shewchuk * * |c-a|**2 - wa = |c-b|**2 - wb * * This is the unweighted "bisect" predicate in E^2. * -------------------------------------------------------- */ __normal_call REAL_TYPE bisect2d_e ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , bool_type &_OK ) { /*--------------- bisect2d predicate, "exact" version */ mp::expansion< 2 > _ab_xx_, _ab_yy_, _ac_xx_, _ac_yy_, _bc_xx_, _bc_yy_; mp::expansion< 4 > _tt_xx_, _tt_yy_; mp::expansion< 32> _absum_; _OK = true; /*----------------------------------- compute: d(p,q) */ _ab_xx_.from_sub(_pa[0], _pb[0]); _ab_yy_.from_sub(_pa[1], _pb[1]); _ac_xx_.from_sub(_pa[0], _pc[0]); _ac_yy_.from_sub(_pa[1], _pc[1]); _bc_xx_.from_sub(_pb[0], _pc[0]); _bc_yy_.from_sub(_pb[1], _pc[1]); mp::expansion_add(_ac_xx_, _bc_xx_, _tt_xx_) ; mp::expansion_add(_ac_yy_, _bc_yy_, _tt_yy_) ; mp::expansion_dot(_ab_xx_, _tt_xx_, _ab_yy_, _tt_yy_, _absum_) ; /*----------------------------------- return signed d */ return mp::expansion_est(_absum_) ; } __normal_call REAL_TYPE bisect2d_i ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , bool_type &_OK ) { /*--------------- bisect2d predicate, "bound" version */ ia_flt _acx, _acy, _bcx, _bcy, _abx, _aby, _sgn; ia_rnd _rnd; // up rounding! _abx.from_sub(_pa[0], _pb[0]) ; // coord. diff. _aby.from_sub(_pa[1], _pb[1]) ; _acx.from_sub(_pa[0], _pc[0]) ; _acy.from_sub(_pa[1], _pc[1]) ; _bcx.from_sub(_pb[0], _pc[0]) ; _bcy.from_sub(_pb[1], _pc[1]) ; _sgn = (_abx * (_acx + _bcx)) + (_aby * (_acy + _bcy)) ; _OK = _sgn.lo() >= (REAL_TYPE)0. || _sgn.up() <= (REAL_TYPE)0. ; return ( _sgn.mid () ) ; } __normal_call REAL_TYPE bisect2d_f ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , bool_type &_OK ) { /*--------------- bisect2d predicate, "float" version */ REAL_TYPE static const _ER = + 5. * std::pow(mp::_epsilon, 1) ; REAL_TYPE _acx, _acy; REAL_TYPE _bcx, _bcy; REAL_TYPE _acsqr, _bcsqr ; REAL_TYPE _sgn, _FT ; REAL_TYPE _ACSQR, _BCSQR ; _acx = _pa [0] - _pc [0] ; // coord. diff. _acy = _pa [1] - _pc [1] ; _bcx = _pb [0] - _pc [0] ; _bcy = _pb [1] - _pc [1] ; _acsqr = _acx * _acx + _acy * _acy ; _bcsqr = _bcx * _bcx + _bcy * _bcy ; _ACSQR = std::abs(_acsqr); _BCSQR = std::abs(_bcsqr); _FT = _ACSQR + _BCSQR ; // roundoff tol _FT *= _ER ; _sgn = _acsqr - _bcsqr ; // d_ab - d_bc _OK = _sgn > +_FT || _sgn < -_FT ; return _sgn ; } /* -------------------------------------------------------- * * Compute an exact orientation wrt. bisector using * multi-precision expansions, a'la shewchuk * * |c-a|**2 - wa = |c-b|**2 - wb * * This is the weighted "bisect" predicate in E^2. * -------------------------------------------------------- */ __normal_call REAL_TYPE bisect2w_e ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , bool_type &_OK ) { /*--------------- bisect2w predicate, "exact" version */ mp::expansion< 2 > _ab_xx_, _ab_yy_, _ab_ww_, _ac_xx_, _ac_yy_, _bc_xx_, _bc_yy_; mp::expansion< 4 > _tt_xx_, _tt_yy_; mp::expansion< 32> _ttsum_; mp::expansion< 34> _absum_; _OK = true; /*----------------------------------- compute: d(p,q) */ _ab_xx_.from_sub(_pa[0], _pb[0]); _ab_yy_.from_sub(_pa[1], _pb[1]); _ab_ww_.from_sub(_pa[2], _pb[2]); _ac_xx_.from_sub(_pa[0], _pc[0]); _ac_yy_.from_sub(_pa[1], _pc[1]); _bc_xx_.from_sub(_pb[0], _pc[0]); _bc_yy_.from_sub(_pb[1], _pc[1]); mp::expansion_add(_ac_xx_, _bc_xx_, _tt_xx_) ; mp::expansion_add(_ac_yy_, _bc_yy_, _tt_yy_) ; mp::expansion_dot(_ab_xx_, _tt_xx_, _ab_yy_, _tt_yy_, _ttsum_) ; mp::expansion_sub(_ttsum_, _ab_ww_, _absum_) ; /*----------------------------------- return signed d */ return mp::expansion_est(_absum_) ; } __normal_call REAL_TYPE bisect2w_i ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , bool_type &_OK ) { /*--------------- bisect2w predicate, "bound" version */ ia_flt _acx, _acy, _abw, _bcx, _bcy, _abx, _aby, _sgn; ia_rnd _rnd; // up rounding! _abx.from_sub(_pa[0], _pb[0]) ; // coord. diff. _aby.from_sub(_pa[1], _pb[1]) ; _abw.from_sub(_pa[2], _pb[2]) ; _acx.from_sub(_pa[0], _pc[0]) ; _acy.from_sub(_pa[1], _pc[1]) ; _bcx.from_sub(_pb[0], _pc[0]) ; _bcy.from_sub(_pb[1], _pc[1]) ; _sgn = (_abx * (_acx + _bcx)) + (_aby * (_acy + _bcy)) ; _sgn-= _abw ; _OK = _sgn.lo() >= (REAL_TYPE)0. || _sgn.up() <= (REAL_TYPE)0. ; return ( _sgn.mid () ) ; } __normal_call REAL_TYPE bisect2w_f ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , bool_type &_OK ) { /*--------------- bisect2w predicate, "float" version */ REAL_TYPE static const _ER = + 6. * std::pow(mp::_epsilon, 1) ; REAL_TYPE _acx, _acy; REAL_TYPE _bcx, _bcy; REAL_TYPE _acsqr, _bcsqr ; REAL_TYPE _a_sum, _b_sum ; REAL_TYPE _A_SUM, _B_SUM ; REAL_TYPE _sgn, _FT; _acx = _pa [0] - _pc [0] ; // coord. diff. _acy = _pa [1] - _pc [1] ; _bcx = _pb [0] - _pc [0] ; _bcy = _pb [1] - _pc [1] ; _acsqr = _acx * _acx + _acy * _acy ; _bcsqr = _bcx * _bcx + _bcy * _bcy ; _a_sum = _acsqr - _pa[2] ; _b_sum = _bcsqr - _pb[2] ; _A_SUM = std::abs(_acsqr) + std::abs(_pa[2]); _B_SUM = std::abs(_bcsqr) + std::abs(_pb[2]); _FT = _A_SUM + _B_SUM ; // roundoff tol _FT *= _ER ; _sgn = _a_sum - _b_sum ; // d_ab - d_bc _OK = _sgn > +_FT || _sgn < -_FT ; return _sgn ; } /* -------------------------------------------------------- * * Compute an exact orientation wrt. bisector using * multi-precision expansions, a'la shewchuk * * |c-a|**2 - wa = |c-b|**2 - wb * * This is the unweighted "bisect" predicate in E^3. * -------------------------------------------------------- */ __normal_call REAL_TYPE bisect3d_e ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , bool_type &_OK ) { /*--------------- bisect3d predicate, "exact" version */ mp::expansion< 2 > _ab_xx_, _ab_yy_, _ab_zz_, _ac_xx_, _ac_yy_, _ac_zz_, _bc_xx_, _bc_yy_, _bc_zz_; mp::expansion< 4 > _tt_xx_, _tt_yy_, _tt_zz_; mp::expansion< 48> _absum_; _OK = true; /*----------------------------------- compute: d(p,q) */ _ab_xx_.from_sub(_pa[0], _pb[0]); _ab_yy_.from_sub(_pa[1], _pb[1]); _ab_zz_.from_sub(_pa[2], _pb[2]); _ac_xx_.from_sub(_pa[0], _pc[0]); _ac_yy_.from_sub(_pa[1], _pc[1]); _ac_zz_.from_sub(_pa[2], _pc[2]); _bc_xx_.from_sub(_pb[0], _pc[0]); _bc_yy_.from_sub(_pb[1], _pc[1]); _bc_zz_.from_sub(_pb[2], _pc[2]); mp::expansion_add(_ac_xx_, _bc_xx_, _tt_xx_) ; mp::expansion_add(_ac_yy_, _bc_yy_, _tt_yy_) ; mp::expansion_add(_ac_zz_, _bc_zz_, _tt_zz_) ; mp::expansion_dot(_ab_xx_, _tt_xx_, _ab_yy_, _tt_yy_, _ab_zz_, _tt_zz_, _absum_) ; /*----------------------------------- return signed d */ return mp::expansion_est(_absum_) ; } __normal_call REAL_TYPE bisect3d_i ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , bool_type &_OK ) { /*--------------- bisect3d predicate, "bound" version */ ia_flt _acx, _acy, _acz , _bcx, _bcy, _bcz , _abx, _aby, _abz ; ia_flt _sgn; ia_rnd _rnd; // up rounding! _abx.from_sub(_pa[0], _pb[0]) ; // coord. diff. _aby.from_sub(_pa[1], _pb[1]) ; _abz.from_sub(_pa[2], _pb[2]) ; _acx.from_sub(_pa[0], _pc[0]) ; _acy.from_sub(_pa[1], _pc[1]) ; _acz.from_sub(_pa[2], _pc[2]) ; _bcx.from_sub(_pb[0], _pc[0]) ; _bcy.from_sub(_pb[1], _pc[1]) ; _bcz.from_sub(_pb[2], _pc[2]) ; _sgn = (_abx * (_acx + _bcx)) + (_aby * (_acy + _bcy)) + (_abz * (_acz + _bcz)) ; _OK = _sgn.lo() >= (REAL_TYPE)0. || _sgn.up() <= (REAL_TYPE)0. ; return ( _sgn.mid () ) ; } __normal_call REAL_TYPE bisect3d_f ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , bool_type &_OK ) { /*--------------- bisect3d predicate, "float" version */ REAL_TYPE static const _ER = + 6. * std::pow(mp::_epsilon, 1) ; REAL_TYPE _acx, _acy, _acz ; REAL_TYPE _bcx, _bcy, _bcz ; REAL_TYPE _acsqr, _bcsqr ; REAL_TYPE _sgn, _FT ; REAL_TYPE _ACSQR, _BCSQR ; _acx = _pa [0] - _pc [0] ; // coord. diff. _acy = _pa [1] - _pc [1] ; _acz = _pa [2] - _pc [2] ; _bcx = _pb [0] - _pc [0] ; _bcy = _pb [1] - _pc [1] ; _bcz = _pb [2] - _pc [2] ; _acsqr = _acx * _acx + _acy * _acy + _acz * _acz ; _bcsqr = _bcx * _bcx + _bcy * _bcy + _bcz * _bcz ; _ACSQR = std::abs(_acsqr); _BCSQR = std::abs(_bcsqr); _FT = _ACSQR + _BCSQR ; // roundoff tol _FT *= _ER ; _sgn = _acsqr - _bcsqr ; // d_ab - d_bc _OK = _sgn > +_FT || _sgn < -_FT ; return _sgn ; } /* -------------------------------------------------------- * * Compute an exact orientation wrt. bisector using * multi-precision expansions, a'la shewchuk * * |c-a|**2 - wa = |c-b|**2 - wb * * This is the weighted "bisect" predicate in E^3. * -------------------------------------------------------- */ __normal_call REAL_TYPE bisect3w_e ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , bool_type &_OK ) { /*--------------- bisect3w predicate, "exact" version */ mp::expansion< 2 > _ab_xx_, _ab_yy_, _ab_zz_, _ab_ww_, _ac_xx_, _ac_yy_, _ac_zz_, _bc_xx_, _bc_yy_, _bc_zz_; mp::expansion< 4 > _tt_xx_, _tt_yy_, _tt_zz_; mp::expansion< 48> _ttsum_; mp::expansion< 50> _absum_; _OK = true; /*----------------------------------- compute: d(p,q) */ _ab_xx_.from_sub(_pa[0], _pb[0]); _ab_yy_.from_sub(_pa[1], _pb[1]); _ab_zz_.from_sub(_pa[2], _pb[2]); _ab_ww_.from_sub(_pa[3], _pb[3]); _ac_xx_.from_sub(_pa[0], _pc[0]); _ac_yy_.from_sub(_pa[1], _pc[1]); _ac_zz_.from_sub(_pa[2], _pc[2]); _bc_xx_.from_sub(_pb[0], _pc[0]); _bc_yy_.from_sub(_pb[1], _pc[1]); _bc_zz_.from_sub(_pb[2], _pc[2]); mp::expansion_add(_ac_xx_, _bc_xx_, _tt_xx_) ; mp::expansion_add(_ac_yy_, _bc_yy_, _tt_yy_) ; mp::expansion_add(_ac_zz_, _bc_zz_, _tt_zz_) ; mp::expansion_dot(_ab_xx_, _tt_xx_, _ab_yy_, _tt_yy_, _ab_zz_, _tt_zz_, _ttsum_) ; mp::expansion_sub(_ttsum_, _ab_ww_, _absum_) ; /*----------------------------------- return signed d */ return mp::expansion_est(_absum_) ; } __normal_call REAL_TYPE bisect3w_i ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , bool_type &_OK ) { /*--------------- bisect3w predicate, "bound" version */ ia_flt _acx, _acy, _acz , _abw, _bcx, _bcy, _bcz , _abx, _aby, _abz ; ia_flt _sgn; ia_rnd _rnd; // up rounding! _abx.from_sub(_pa[0], _pb[0]) ; // coord. diff. _aby.from_sub(_pa[1], _pb[1]) ; _abz.from_sub(_pa[2], _pb[2]) ; _abw.from_sub(_pa[3], _pb[3]) ; _acx.from_sub(_pa[0], _pc[0]) ; _acy.from_sub(_pa[1], _pc[1]) ; _acz.from_sub(_pa[2], _pc[2]) ; _bcx.from_sub(_pb[0], _pc[0]) ; _bcy.from_sub(_pb[1], _pc[1]) ; _bcz.from_sub(_pb[2], _pc[2]) ; _sgn = (_abx * (_acx + _bcx)) + (_aby * (_acy + _bcy)) + (_abz * (_acz + _bcz)) ; _sgn-= _abw ; _OK = _sgn.lo() >= (REAL_TYPE)0. || _sgn.up() <= (REAL_TYPE)0. ; return ( _sgn.mid () ) ; } __normal_call REAL_TYPE bisect3w_f ( __const_ptr(REAL_TYPE) _pa , __const_ptr(REAL_TYPE) _pb , __const_ptr(REAL_TYPE) _pc , bool_type &_OK ) { /*--------------- bisect3w predicate, "float" version */ REAL_TYPE static const _ER = + 7. * std::pow(mp::_epsilon, 1) ; REAL_TYPE _acx, _acy, _acz ; REAL_TYPE _bcx, _bcy, _bcz ; REAL_TYPE _acsqr, _bcsqr ; REAL_TYPE _a_sum, _b_sum ; REAL_TYPE _A_SUM, _B_SUM ; REAL_TYPE _sgn, _FT; _acx = _pa [0] - _pc [0] ; // coord. diff. _acy = _pa [1] - _pc [1] ; _acz = _pa [2] - _pc [2] ; _bcx = _pb [0] - _pc [0] ; _bcy = _pb [1] - _pc [1] ; _bcz = _pb [2] - _pc [2] ; _acsqr = _acx * _acx + _acy * _acy + _acz * _acz ; _bcsqr = _bcx * _bcx + _bcy * _bcy + _bcz * _bcz ; _a_sum = _acsqr - _pa[3] ; _b_sum = _bcsqr - _pb[3] ; _A_SUM = std::abs(_acsqr) + std::abs(_pa[3]); _B_SUM = std::abs(_bcsqr) + std::abs(_pb[3]); _FT = _A_SUM + _B_SUM ; // roundoff tol _FT *= _ER ; _sgn = _a_sum - _b_sum ; // d_ab - d_bc _OK = _sgn > +_FT || _sgn < -_FT ; return _sgn ; } ggforce/src/robust_predicate/mpfloats.hpp0000644000176200001440000000410514672274110020355 0ustar liggesusers /* ------------------------------------------------------------ * robust multi-precision floating-point expansions... ------------------------------------------------------------ * * This program may be freely redistributed under the * condition that the copyright notices (including this * entire header) are not removed, and no compensation * is received through use of the software. Private, * research, and institutional use is free. You may * distribute modified versions of this code UNDER THE * CONDITION THAT THIS CODE AND ANY MODIFICATIONS MADE * TO IT IN THE SAME FILE REMAIN UNDER COPYRIGHT OF THE * ORIGINAL AUTHOR, BOTH SOURCE AND OBJECT CODE ARE * MADE FREELY AVAILABLE WITHOUT CHARGE, AND CLEAR * NOTICE IS GIVEN OF THE MODIFICATIONS. Distribution * of this code as part of a commercial system is * permissible ONLY BY DIRECT ARRANGEMENT WITH THE * AUTHOR. (If you are not directly supplying this * code to a customer, and you are instead telling them * how they can obtain it for free, then you are not * required to make any arrangement with me.) * * Disclaimer: Neither I nor: Columbia University, The * Massachusetts Institute of Technology, The * University of Sydney, nor The National Aeronautics * and Space Administration warrant this code in any * way whatsoever. This code is provided "as-is" to be * used at your own risk. * ------------------------------------------------------------ * * Last updated: 11 April, 2020 * * Copyright 2020-- * Darren Engwirda * de2363@columbia.edu * https://github.com/dengwirda/ * ------------------------------------------------------------ */ # pragma once # ifndef __MP_FLOATS__ # define __MP_FLOATS__ # include "basebase.hpp" namespace mp_float { typedef double real_type; typedef int indx_type; } # include # include # include // pragma STDC FENV_ACCESS ON # include "expansion/dd_float.hpp" # include "expansion/ia_float.hpp" # include "expansion/mp_float.hpp" # include "expansion/mp_utils.hpp" # endif//__MP_FLOATS__ ggforce/src/robust_predicate/basebase.hpp0000644000176200001440000001020114672274110020267 0ustar liggesusers /* ------------------------------------------------------------ * basic types, macros, compiler-settings, etc... ------------------------------------------------------------ * * This program may be freely redistributed under the * condition that the copyright notices (including this * entire header) are not removed, and no compensation * is received through use of the software. Private, * research, and institutional use is free. You may * distribute modified versions of this code UNDER THE * CONDITION THAT THIS CODE AND ANY MODIFICATIONS MADE * TO IT IN THE SAME FILE REMAIN UNDER COPYRIGHT OF THE * ORIGINAL AUTHOR, BOTH SOURCE AND OBJECT CODE ARE * MADE FREELY AVAILABLE WITHOUT CHARGE, AND CLEAR * NOTICE IS GIVEN OF THE MODIFICATIONS. Distribution * of this code as part of a commercial system is * permissible ONLY BY DIRECT ARRANGEMENT WITH THE * AUTHOR. (If you are not directly supplying this * code to a customer, and you are instead telling them * how they can obtain it for free, then you are not * required to make any arrangement with me.) * * Disclaimer: Neither I nor: Columbia University, The * Massachusetts Institute of Technology, The * University of Sydney, nor The National Aeronautics * and Space Administration warrant this code in any * way whatsoever. This code is provided "as-is" to be * used at your own risk. * ------------------------------------------------------------ * * Last updated: 02 March, 2020 * * Copyright 2013-2020 * Darren Engwirda * de2363@columbia.edu * https://github.com/dengwirda/ * ------------------------------------------------------------ */ # pragma once # ifndef __BASEBASE__ # define __BASEBASE__ # include # include # include /* ------------------------------------------------------------ * push compiler settings ------------------------------------------------------------ */ # if defined(_MSC_VER) # pragma warning(disable:4127) // constant conditionals # pragma warning(disable:4503) // decorated name length # elif defined(__LLVM__) # elif defined(__GNUC__) # endif # define __assert assert /* ------------------------------------------------------------ * global data type alias ------------------------------------------------------------ */ typedef void void_type ; typedef bool bool_type ; typedef char char_type ; /* ------------------------------------------------------------ * function call decorator ------------------------------------------------------------ */ # define __inline_call inline # define __normal_call # define __static_call static # define __friend_call friend # define __nocast_call explicit /* ------------------------------------------------------------ * copy // move forwarding ------------------------------------------------------------ */ # define __copy(T, x) std::forward(x) # define __move(T, x) std::forward(x) /* ------------------------------------------------------------ * unused parameter macros ------------------------------------------------------------ */ # define __unreferenced(x) ((void) x) /* ------------------------------------------------------------ * no--alias pointer types ------------------------------------------------------------ */ # define __const_ptr(T) T const *__restrict # define __write_ptr(T) T *__restrict # define __const_ref(T) T const &__restrict # define __write_ref(T) T &__restrict /* ------------------------------------------------------------ * integer "flip" routines ------------------------------------------------------------ */ # define __isflip(__i) ( (__i) < 0) # define __doflip(__i) (-(__i) - 2) # define __unflip(__i) (((__i) < 0) \ ? __doflip(__i) : (__i) ) /* ------------------------------------------------------------ * integer "flip" routines ------------------------------------------------------------ */ # define __setbit(x,b) ((x)|= (1ULL<<(b))) # define __popbit(x,b) ((x)&= ~(1ULL<<(b))) # define __flpbit(x,b) ((x)^= (1ULL<<(b))) # define __chkbit(x,b) (!!((x)&(1ULL<<(b))) ) # endif//__BASEBASE__ ggforce/src/robust_predicate/expansion/0000755000176200001440000000000014672274066020035 5ustar liggesusersggforce/src/robust_predicate/expansion/mp_basic.hpp0000644000176200001440000004106214672274110022314 0ustar liggesusers /* -------------------------------------------------------- * MPFLOAT: multi-precision floating-point arithmetic. -------------------------------------------------------- * * These are the low-level multi-precision kernels --- * computing elementary operations on "expansions" of * floating-point numbers such that rounding error is * eliminated. See Shewchuk for more detail: * * J. R. Shewchuk (1997): Adaptive Precision Floating- * Point Arithmetic & Fast Robust Geometric Predicates * Discrete & Computational Geometry, 18, pp. 305-363. * * This header is adapted from Shewchuk's original C89 * source (predicates.c). * * Related "clipped" operations for "double-double" * arithmetic are also included. Here expansion length * is capped at 2, with subsequent bits truncated: * * M. Joldes, J-M. Muller, V. Popescu (2017): Tight & * rigourous error bounds for basic building blocks of * double-word arithmetic. ACM Transactions on * Mathematical Software, ACM, 44 (2), pp. 1-27. * * Y. Hida, X. Li, and D. Bailey (2000): Quad-double * arithmetic: Algorithms, implementation, and * application. In the 15th IEEE Symposium on Computer * Arithmetic, pp. 155-162. * -------------------------------------------------------- * * This program may be freely redistributed under the * condition that the copyright notices (including this * entire header) are not removed, and no compensation * is received through use of the software. Private, * research, and institutional use is free. You may * distribute modified versions of this code UNDER THE * CONDITION THAT THIS CODE AND ANY MODIFICATIONS MADE * TO IT IN THE SAME FILE REMAIN UNDER COPYRIGHT OF THE * ORIGINAL AUTHOR, BOTH SOURCE AND OBJECT CODE ARE * MADE FREELY AVAILABLE WITHOUT CHARGE, AND CLEAR * NOTICE IS GIVEN OF THE MODIFICATIONS. Distribution * of this code as part of a commercial system is * permissible ONLY BY DIRECT ARRANGEMENT WITH THE * AUTHOR. (If you are not directly supplying this * code to a customer, and you are instead telling them * how they can obtain it for free, then you are not * required to make any arrangement with me.) * * Disclaimer: Neither I nor: Columbia University, The * Massachusetts Institute of Technology, The * University of Sydney, nor The National Aeronautics * and Space Administration warrant this code in any * way whatsoever. This code is provided "as-is" to be * used at your own risk. * -------------------------------------------------------- * * Last updated: 16 April, 2020 * * Copyright 2020-- * Darren Engwirda * de2363@columbia.edu * https://github.com/dengwirda/ * -------------------------------------------------------- */ # pragma once # ifndef __MP_BASIC__ # define __MP_BASIC__ namespace mp_float { # define REAL_TYPE mp_float::real_type # define INDX_TYPE mp_float::indx_type /*------------------------ have hardware FMA support? */ # if defined(FP_FAST_FMA) bool constexpr _has_fma = std::is_same::value; # elif defined(FP_FAST_FMAF) bool constexpr _has_fma = std::is_same::value; # else bool constexpr _has_fma = false; # endif /* -------------------------------------------------------- * multi-precision initialisation, a'la shewchuk -------------------------------------------------------- */ REAL_TYPE _splitter; REAL_TYPE _epsilon ; __normal_call void exactinit ( ) { /*-------------- find machine eps, etc, a'la shewchuk */ INDX_TYPE _alternate = +1 ; REAL_TYPE _lastcheck ; REAL_TYPE _halve = +0.5; REAL_TYPE _check = +1.0; /*-------------- find eps: bisect until 1. + eps ~ 1. */ _epsilon = _splitter = +1.00 ; do { _lastcheck = _check; _epsilon *= _halve; if (_alternate) _splitter *= +2.00 ; _alternate = !_alternate ; _check = 1.00 + _epsilon ; } while (_check != +1.00 && _check != _lastcheck) ; _splitter += 1.00 ; } /* -------------------------------------------------------- * multi-precision "add" routines, a'la shewchuk -------------------------------------------------------- */ __inline_call void one_one_add_fast ( REAL_TYPE _aa, REAL_TYPE _bb, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { REAL_TYPE _bvirt; _x1 = _aa + _bb; _bvirt = _x1 - _aa; _x0 = _bb - _bvirt; } __inline_call void one_one_add_full ( REAL_TYPE _aa, REAL_TYPE _bb, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { REAL_TYPE _bvirt, _avirt; _x1 = _aa + _bb; _bvirt = _x1 - _aa; _avirt = _x1 - _bvirt; REAL_TYPE _bround, _around; _bround = _bb - _bvirt; _around = _aa - _avirt; _x0 = _around + _bround; } __inline_call void two_one_add_full ( REAL_TYPE _a1, REAL_TYPE _a0, REAL_TYPE _bb, REAL_TYPE &_x2, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { REAL_TYPE _tt; one_one_add_full(_a0, _bb, _tt, _x0 ) ; one_one_add_full(_a1, _tt, _x2, _x1 ) ; } __inline_call void two_one_add_clip ( // dd_flt REAL_TYPE _a1, REAL_TYPE _a0, REAL_TYPE _bb, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { REAL_TYPE _t0, _t1 ; one_one_add_full(_a1, _bb, _t1, _t0 ) ; _t0 = _t0 + _a0 ; one_one_add_fast(_t1, _t0, _x1, _x0 ) ; } __inline_call void two_two_add_full ( REAL_TYPE _a1, REAL_TYPE _a0, REAL_TYPE _b1, REAL_TYPE _b0, REAL_TYPE &_x3, REAL_TYPE &_x2, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { REAL_TYPE _t1, _t0 ; two_one_add_full(_a1, _a0, _b0, _t1, _t0, _x0 ) ; two_one_add_full(_t1, _t0, _b1, _x3, _x2, _x1 ) ; } __inline_call void two_two_add_clip ( // dd_flt REAL_TYPE _a1, REAL_TYPE _a0, REAL_TYPE _b1, REAL_TYPE _b0, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { REAL_TYPE _t1, _t0 ; REAL_TYPE _s1, _s0 ; REAL_TYPE _w1, _w0 ; one_one_add_full(_a1, _b1, _s1, _s0 ) ; one_one_add_full(_a0, _b0, _t1, _t0 ) ; _s0 = _s0 + _t1 ; one_one_add_fast(_s1, _s0, _w1, _w0 ) ; _w0 = _w0 + _t0 ; one_one_add_fast(_w1, _w0, _x1, _x0 ) ; } /* -------------------------------------------------------- * multi-precision "sub" routines, a'la shewchuk -------------------------------------------------------- */ __inline_call void one_one_sub_fast ( REAL_TYPE _aa, REAL_TYPE _bb, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { REAL_TYPE _bvirt; _x1 = _aa - _bb; _bvirt = _aa - _x1; _x0 = _bvirt - _bb; } __inline_call void one_one_sub_full ( REAL_TYPE _aa, REAL_TYPE _bb, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { REAL_TYPE _bvirt, _avirt; _x1 = _aa - _bb; _bvirt = _aa - _x1; _avirt = _x1 + _bvirt; REAL_TYPE _bround, _around; _bround = _bvirt - _bb; _around = _aa - _avirt; _x0 = _around + _bround; } __inline_call void two_one_sub_full ( REAL_TYPE _a1, REAL_TYPE _a0, REAL_TYPE _bb, REAL_TYPE &_x2, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { REAL_TYPE _tt; one_one_sub_full(_a0, _bb, _tt, _x0 ) ; one_one_add_full(_a1, _tt, _x2, _x1 ) ; } __inline_call void two_one_sub_clip ( // dd_flt REAL_TYPE _a1, REAL_TYPE _a0, REAL_TYPE _bb, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { REAL_TYPE _t0, _t1 ; one_one_sub_full(_a1, _bb, _t1, _t0 ) ; _t0 = _t0 + _a0 ; one_one_add_fast(_t1, _t0, _x1, _x0 ) ; } __inline_call void two_two_sub_full ( REAL_TYPE _a1, REAL_TYPE _a0, REAL_TYPE _b1, REAL_TYPE _b0, REAL_TYPE &_x3, REAL_TYPE &_x2, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { REAL_TYPE _t1, _t0 ; two_one_sub_full(_a1, _a0, _b0, _t1, _t0, _x0 ) ; two_one_sub_full(_t1, _t0, _b1, _x3, _x2, _x1 ) ; } __inline_call void two_two_sub_clip ( // dd_flt REAL_TYPE _a1, REAL_TYPE _a0, REAL_TYPE _b1, REAL_TYPE _b0, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { REAL_TYPE _s0, _s1 ; REAL_TYPE _t0, _t1 ; REAL_TYPE _w0, _w1 ; one_one_sub_full(_a1, _b1, _s1, _s0 ) ; one_one_sub_full(_a0, _b0, _t1, _t0 ) ; _s0 = _s0 + _t1 ; one_one_add_fast(_s1, _s0, _w1, _w0 ) ; _w0 = _w0 + _t0 ; one_one_add_fast(_w1, _w0, _x1, _x0 ) ; } /* -------------------------------------------------------- * multi-precision "mul" routines, a'la shewchuk -------------------------------------------------------- */ __inline_call void one_split ( REAL_TYPE _aa, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { REAL_TYPE _cc, _ab ; _cc = _aa * _splitter; _ab = _cc - _aa; _x1 = _cc - _ab; _x0 = _aa - _x1; } __inline_call void one_one_mul_full ( REAL_TYPE _aa, REAL_TYPE _bb, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { if constexpr (_has_fma) { _x1 = _aa * _bb; _x0 = fma(_aa, _bb, -_x1); } else // use fpu { REAL_TYPE _ah, _al, _bh, _bl; _x1 = _aa * _bb; one_split (_aa, _ah, _al); one_split (_bb, _bh, _bl); REAL_TYPE _err1, _err2, _err3; _err1 = _x1 - (_ah * _bh); _err2 = _err1 - (_al * _bh); _err3 = _err2 - (_ah * _bl); _x0 = (_al * _bl) - _err3; } } __inline_call void one_one_mul_full ( REAL_TYPE _aa, REAL_TYPE _bb, REAL_TYPE _bh, REAL_TYPE _bl, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { if constexpr (_has_fma) { _x1 = _aa * _bb; _x0 = fma(_aa, _bb, -_x1); } else // use fpu { REAL_TYPE _ah, _al; _x1 = _aa * _bb; one_split (_aa, _ah, _al); REAL_TYPE _err1, _err2, _err3; _err1 = _x1 - (_ah * _bh); _err2 = _err1 - (_al * _bh); _err3 = _err2 - (_ah * _bl); _x0 = (_al * _bl) - _err3; } } __inline_call void one_one_mul_full ( REAL_TYPE _aa, REAL_TYPE _ah, REAL_TYPE _al, REAL_TYPE _bb, REAL_TYPE _bh, REAL_TYPE _bl, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { if constexpr (_has_fma) { _x1 = _aa * _bb; _x0 = fma(_aa, _bb, -_x1); } else // use fpu { _x1 = _aa * _bb; REAL_TYPE _err1, _err2, _err3; _err1 = _x1 - (_ah * _bh); _err2 = _err1 - (_al * _bh); _err3 = _err2 - (_ah * _bl); _x0 = (_al * _bl) - _err3; } } __inline_call void one_one_sqr_full ( REAL_TYPE _aa, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { if constexpr (_has_fma) { _x1 = _aa * _aa; _x0 = fma(_aa, _aa, -_x1); } else // use fpu { REAL_TYPE _ah, _al; _x1 = _aa * _aa; one_split (_aa, _ah, _al); REAL_TYPE _err1, _err3; _err1 = _x1 - (_ah * _ah); _err3 = _err1 - ((_ah + _ah) * _al); _x0 = (_al * _al) - _err3; } } __inline_call void one_one_sqr_full ( REAL_TYPE _aa, REAL_TYPE _ah, REAL_TYPE _al, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { if constexpr (_has_fma) { _x1 = _aa * _aa; _x0 = fma(_aa, _aa, -_x1); } else // use fpu { _x1 = _aa * _aa; REAL_TYPE _err1, _err3; _err1 = _x1 - (_ah * _ah); _err3 = _err1 - ((_ah + _ah) * _al); _x0 = (_al * _al) - _err3; } } __inline_call void two_one_mul_full ( REAL_TYPE _a1, REAL_TYPE _a0, REAL_TYPE _bb, REAL_TYPE &_x3, REAL_TYPE &_x2, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { if constexpr (_has_fma) { REAL_TYPE _t0, _t1, _t2, _t3 ; one_one_mul_full(_a0, _bb, _t2, _x0 ) ; one_one_mul_full(_a1, _bb, _t1, _t0 ) ; one_one_add_full(_t2, _t0, _t3, _x1 ) ; one_one_add_fast(_t1, _t3, _x3, _x2 ) ; } else // use fpu { REAL_TYPE _bh, _bl; REAL_TYPE _t0, _t1, _t2, _t3 ; one_split(_bb, _bh, _bl) ; one_one_mul_full(_a0, _bb, _bh, _bl, _t2, _x0 ) ; one_one_mul_full(_a1, _bb, _bh, _bl, _t1, _t0 ) ; one_one_add_full(_t2, _t0, _t3, _x1 ) ; one_one_add_fast(_t1, _t3, _x3, _x2 ) ; } } __inline_call void two_one_mul_clip ( // dd_flt REAL_TYPE _a1, REAL_TYPE _a0, REAL_TYPE _bb, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { if constexpr (_has_fma) { REAL_TYPE _t0, _t1; one_one_mul_full(_a1, _bb, _t1, _t0 ) ; _t0 = fma(_a0, _bb, _t0); one_one_add_fast(_t1, _t0, _x1, _x0 ) ; } else // use fpu { REAL_TYPE _t0, _t1, _ss ; one_one_mul_full(_a1, _bb, _t1, _t0 ) ; _ss = _a0 * _bb ; _t0 = _t0 + _ss ; one_one_add_fast(_t1, _t0, _x1, _x0 ) ; } } __inline_call void two_two_mul_clip ( // dd_flt REAL_TYPE _a1, REAL_TYPE _a0, REAL_TYPE _b1, REAL_TYPE _b0, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { if constexpr (_has_fma) { REAL_TYPE _t0, _t1, _ss; one_one_mul_full(_a1, _b1, _t1, _t0 ) ; _ss = _a0 * _b0 ; _ss = fma(_a1, _b0, _ss); _ss = fma(_a0, _b0, _ss); _t0 = _t0 + _ss ; one_one_add_fast(_t1, _t0, _x1, _x0 ) ; } else { REAL_TYPE _t0, _t1; REAL_TYPE _ss, _s1, _s2, _s3; one_one_mul_full(_a1, _b1, _t1, _t0 ) ; _s1 = _a0 * _b0 ; _s2 = _a1 * _b0 ; _s3 = _a0 * _b1 ; _ss = _s1 + _s2 + _s3 ; _t0 = _t0 + _ss ; one_one_add_fast(_t1, _t0, _x1, _x0 ) ; } } __inline_call void two_one_div_clip ( // dd_flt REAL_TYPE _a1, REAL_TYPE _a0, REAL_TYPE _bb, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { REAL_TYPE _t0, _t1, _p1, _p0, _dd; _t1 = _a1 / _bb; one_one_mul_full(_t1, _bb, _p1, _p0 ) ; _dd = _a1 - _p1; _dd = _dd - _p0; _dd = _dd + _a0; _t0 = _dd / _bb; one_one_add_fast(_t1, _t0, _x1, _x0 ) ; } __inline_call void two_two_div_clip ( // dd_flt REAL_TYPE _a1, REAL_TYPE _a0, REAL_TYPE _b1, REAL_TYPE _b0, REAL_TYPE &_x1, REAL_TYPE &_x0 ) { REAL_TYPE _t0, _t1, _ee; _t1 = _a1 / _b1 ; REAL_TYPE _r0, _r1 ; REAL_TYPE _w0, _w1 ; two_one_mul_clip(_b1, _b0, _t1, _r1, _r0 // rr = bb * t1 ) ; two_two_sub_clip(_a1, _a0, _r1, _r0, _w1, _w0 // ww = aa - rr ) ; _t0 = _w1 / _b1 ; REAL_TYPE _u0, _u1 ; two_one_mul_clip(_b1, _b0, _t0, _r1, _r0 // rr = bb * t0 ) ; two_two_sub_clip(_w1, _w0, _r1, _r0, _u1, _u0 // uu = ww - rr ) ; _ee = _u1 / _b1 ; REAL_TYPE _q0, _q1 ; // t1 + t0 + ee one_one_add_fast(_t1, _t0, _q1, _q0 ) ; two_one_add_clip(_q1, _q0, _ee, _x1, _x0 ) ; } # undef REAL_TYPE # undef INDX_TYPE } # endif//__MP_BASIC__ ggforce/src/robust_predicate/expansion/dd_float.hpp0000644000176200001440000003206114672274110022312 0ustar liggesusers /* -------------------------------------------------------- * MPFLOAT: multi-precision floating-point arithmetic. -------------------------------------------------------- * * "double-double" arithmetic. Here mp-expansion size * is capped at 2, with subsequent bits truncated: * * M. Joldes, J-M. Muller, V. Popescu (2017): Tight & * rigourous error bounds for basic building blocks of * double-word arithmetic. ACM Transactions on * Mathematical Software, ACM, 44 (2), pp. 1-27. * * Y. Hida, X. Li, and D. Bailey (2000): Quad-double * arithmetic: Algorithms, implementation, and * application. In the 15th IEEE Symposium on Computer * Arithmetic, pp. 155-162. * -------------------------------------------------------- * * This program may be freely redistributed under the * condition that the copyright notices (including this * entire header) are not removed, and no compensation * is received through use of the software. Private, * research, and institutional use is free. You may * distribute modified versions of this code UNDER THE * CONDITION THAT THIS CODE AND ANY MODIFICATIONS MADE * TO IT IN THE SAME FILE REMAIN UNDER COPYRIGHT OF THE * ORIGINAL AUTHOR, BOTH SOURCE AND OBJECT CODE ARE * MADE FREELY AVAILABLE WITHOUT CHARGE, AND CLEAR * NOTICE IS GIVEN OF THE MODIFICATIONS. Distribution * of this code as part of a commercial system is * permissible ONLY BY DIRECT ARRANGEMENT WITH THE * AUTHOR. (If you are not directly supplying this * code to a customer, and you are instead telling them * how they can obtain it for free, then you are not * required to make any arrangement with me.) * * Disclaimer: Neither I nor: Columbia University, The * Massachusetts Institute of Technology, The * University of Sydney, nor The National Aeronautics * and Space Administration warrant this code in any * way whatsoever. This code is provided "as-is" to be * used at your own risk. * -------------------------------------------------------- * * Last updated: 16 April, 2020 * * Copyright 2020-- * Darren Engwirda * de2363@columbia.edu * https://github.com/dengwirda/ * -------------------------------------------------------- */ # pragma once # ifndef __DD_FLOAT__ # define __DD_FLOAT__ # include "mp_basic.hpp" // namespace mp_float { // hmmm no... /* -------------------------------------------------------- * DD_FLT: (double-double) precision numbers -------------------------------------------------------- */ # define REAL_TYPE mp_float::real_type # define INDX_TYPE mp_float::indx_type class dd_flt; __inline_call dd_flt operator + ( // fwd. dec's dd_flt const&, REAL_TYPE ) ; __inline_call dd_flt operator + ( REAL_TYPE , dd_flt const&) ; __inline_call dd_flt operator + ( dd_flt const&, dd_flt const&) ; __inline_call dd_flt operator - ( dd_flt const&, REAL_TYPE ) ; __inline_call dd_flt operator - ( REAL_TYPE , dd_flt const&) ; __inline_call dd_flt operator - ( dd_flt const&, dd_flt const&) ; __inline_call dd_flt operator * ( dd_flt const&, REAL_TYPE ) ; __inline_call dd_flt operator * ( REAL_TYPE , dd_flt const&) ; __inline_call dd_flt operator * ( dd_flt const&, dd_flt const&) ; __inline_call dd_flt operator / ( dd_flt const&, REAL_TYPE ) ; __inline_call dd_flt operator / ( REAL_TYPE , dd_flt const&) ; __inline_call dd_flt operator / ( dd_flt const&, dd_flt const&) ; class dd_flt { /*------------------------------ doubledouble number type */ public : typedef REAL_TYPE real_type; typedef INDX_TYPE indx_type; indx_type static constexpr _size = 2 ; indx_type static constexpr _xlen = 2 ; real_type _xdat [ 2 ] ; public : /*------------------------------ access to expansion bits */ __inline_call real_type& hi ( ) { return this->_xdat[1] ; } __inline_call real_type& lo ( ) { return this->_xdat[0] ; } __inline_call real_type const&hi ( ) const { return this->_xdat[1] ; } __inline_call real_type const&lo ( ) const { return this->_xdat[0] ; } /*------------------------------ initialising constructor */ __inline_call dd_flt ( real_type _hi = real_type(+0.) , real_type _lo = real_type(+0.) ) { this->_xdat[0] = _lo ; this->_xdat[1] = _hi ; } __inline_call dd_flt ( // copy c'tor dd_flt const& _aa ) { this->_xdat[0] = _aa.lo(); this->_xdat[1] = _aa.hi(); } __inline_call dd_flt& operator = ( // assignment dd_flt const& _aa ) { this->_xdat[0] = _aa.lo(); this->_xdat[1] = _aa.hi(); return ( *this ) ; } __inline_call dd_flt& operator = ( // assignment real_type _aa ) { this->_xdat[0] = +0. ; this->_xdat[1] = (real_type)_aa; return ( *this ) ; } /*---------------------------------------- cast operators */ __inline_call operator real_type ( ) const { return (real_type)(hi()+lo()); } __inline_call operator indx_type ( ) const { return (indx_type)(hi()+lo()); } /*---------------------------------------- math operators */ __inline_call dd_flt operator + ( ) const { return dd_flt(+hi(), +lo()); } __inline_call dd_flt operator - ( ) const { return dd_flt(-hi(), -lo()); } /*------------------------------ helper: init. from a + b */ __inline_call void from_add ( real_type _aa, real_type _bb ) { mp_float::one_one_add_full(_aa, _bb, this->_xdat[1], this->_xdat[0]) ; } /*------------------------------ helper: init. from a - b */ __inline_call void from_sub ( real_type _aa, real_type _bb ) { mp_float::one_one_sub_full(_aa, _bb, this->_xdat[1], this->_xdat[0]) ; } /*------------------------------ helper: init. from a * a */ __inline_call void from_sqr ( real_type _aa ) { mp_float::one_one_sqr_full(_aa, this->_xdat[1], this->_xdat[0]) ; } /*------------------------------ helper: init. from a * b */ __inline_call void from_mul ( real_type _aa, real_type _bb ) { mp_float::one_one_mul_full(_aa, _bb, this->_xdat[1], this->_xdat[0]) ; } __inline_call dd_flt& operator+= ( // via double real_type _aa ) { dd_flt _tt = *this + _aa ; hi() = _tt.hi(); lo() = _tt.lo(); return ( *this ) ; } __inline_call dd_flt& operator-= ( real_type _aa ) { dd_flt _tt = *this - _aa ; hi() = _tt.hi(); lo() = _tt.lo(); return ( *this ) ; } __inline_call dd_flt& operator*= ( real_type _aa ) { dd_flt _tt = *this * _aa ; hi() = _tt.hi(); lo() = _tt.lo(); return ( *this ) ; } __inline_call dd_flt& operator/= ( real_type _aa ) { dd_flt _tt = *this / _aa ; hi() = _tt.hi(); lo() = _tt.lo(); return ( *this ) ; } __inline_call dd_flt& operator+= ( // via dd_flt dd_flt const& _aa ) { dd_flt _tt = *this + _aa ; hi() = _tt.hi(); lo() = _tt.lo(); return ( *this ) ; } __inline_call dd_flt& operator-= ( dd_flt const& _aa ) { dd_flt _tt = *this - _aa ; hi() = _tt.hi(); lo() = _tt.lo(); return ( *this ) ; } __inline_call dd_flt& operator*= ( dd_flt const& _aa ) { dd_flt _tt = *this * _aa ; hi() = _tt.hi(); lo() = _tt.lo(); return ( *this ) ; } __inline_call dd_flt& operator/= ( dd_flt const& _aa ) { dd_flt _tt = *this / _aa ; hi() = _tt.hi(); lo() = _tt.lo(); return ( *this ) ; } } ; /* -------------------------------------------------------- * double-double a + b operators -------------------------------------------------------- */ __inline_call dd_flt operator + ( dd_flt const& _aa, REAL_TYPE _bb ) { REAL_TYPE _x0, _x1; mp_float::two_one_add_clip( _aa.hi(), _aa.lo(), _bb, _x1, _x0 ) ; return ( dd_flt(_x1, _x0) ) ; } __inline_call dd_flt operator + ( REAL_TYPE _aa, dd_flt const& _bb ) { return ( +(_bb + _aa) ) ; } __inline_call dd_flt operator + ( dd_flt const& _aa, dd_flt const& _bb ) { REAL_TYPE _x0, _x1; mp_float::two_two_add_clip( _aa.hi(), _aa.lo(), _bb.hi(), _bb.lo(), _x1, _x0 ) ; return ( dd_flt(_x1, _x0) ) ; } /* -------------------------------------------------------- * double-double a - b operators -------------------------------------------------------- */ __inline_call dd_flt operator - ( dd_flt const& _aa, REAL_TYPE _bb ) { REAL_TYPE _x0, _x1; mp_float::two_one_sub_clip( _aa.hi(), _aa.lo(), _bb, _x1, _x0 ) ; return ( dd_flt(_x1, _x0) ) ; } __inline_call dd_flt operator - ( REAL_TYPE _aa, dd_flt const& _bb ) { return ( -(_bb - _aa) ) ; } __inline_call dd_flt operator - ( dd_flt const& _aa, dd_flt const& _bb ) { REAL_TYPE _x0, _x1; mp_float::two_two_sub_clip( _aa.hi(), _aa.lo(), _bb.hi(), _bb.lo(), _x1, _x0 ) ; return ( dd_flt(_x1, _x0) ) ; } /* -------------------------------------------------------- * double-double a * b operators -------------------------------------------------------- */ __inline_call dd_flt operator * ( dd_flt const& _aa, REAL_TYPE _bb ) { REAL_TYPE _x0, _x1; mp_float::two_one_mul_clip( _aa.hi(), _aa.lo(), _bb, _x1, _x0 ) ; return ( dd_flt(_x1, _x0) ) ; } __inline_call dd_flt operator * ( REAL_TYPE _aa, dd_flt const& _bb ) { return ( _bb * _aa ) ; } __inline_call dd_flt operator * ( dd_flt const& _aa, dd_flt const& _bb ) { REAL_TYPE _x0, _x1; mp_float::two_two_mul_clip( _aa.hi(), _aa.lo(), _bb.hi(), _bb.lo(), _x1, _x0 ) ; return ( dd_flt(_x1, _x0) ) ; } /* -------------------------------------------------------- * double-double a / b operators -------------------------------------------------------- */ __inline_call dd_flt operator / ( dd_flt const& _aa, REAL_TYPE _bb ) { REAL_TYPE _x0, _x1; mp_float::two_one_div_clip( _aa.hi(), _aa.lo(), _bb, _x1, _x0 ) ; return ( dd_flt(_x1, _x0) ) ; } __inline_call dd_flt operator / ( REAL_TYPE _aa, dd_flt const& _bb ) { return ( dd_flt(_aa) / _bb ) ; } __inline_call dd_flt operator / ( dd_flt const& _aa, dd_flt const& _bb ) { REAL_TYPE _x0, _x1; mp_float::two_two_div_clip( _aa.hi(), _aa.lo(), _bb.hi(), _bb.lo(), _x1, _x0 ) ; return ( dd_flt(_x1, _x0) ) ; } /* -------------------------------------------------------- * double-double equal operators -------------------------------------------------------- */ __inline_call bool operator == ( dd_flt const& _aa, dd_flt const& _bb ) { return _aa.hi() == _bb.hi() && _aa.lo() == _bb.lo() ; } __inline_call bool operator != ( dd_flt const& _aa, dd_flt const& _bb ) { return _aa.hi() != _bb.hi() || _aa.lo() != _bb.lo() ; } __inline_call bool operator < ( dd_flt const& _aa, dd_flt const& _bb ) { return _aa.hi() != _bb.hi() ? _aa.hi() < _bb.hi() : _aa.lo() < _bb.lo() ; } __inline_call bool operator > ( dd_flt const& _aa, dd_flt const& _bb ) { return _aa.hi() != _bb.hi() ? _aa.hi() > _bb.hi() : _aa.lo() > _bb.lo() ; } # undef REAL_TYPE # undef INDX_TYPE // } # endif//__DD_FLOAT__ ggforce/src/robust_predicate/expansion/mp_utils.hpp0000644000176200001440000003046114672274110022374 0ustar liggesusers /* -------------------------------------------------------- * MPFLOAT: multi-precision floating-point arithmetic. -------------------------------------------------------- * * This program may be freely redistributed under the * condition that the copyright notices (including this * entire header) are not removed, and no compensation * is received through use of the software. Private, * research, and institutional use is free. You may * distribute modified versions of this code UNDER THE * CONDITION THAT THIS CODE AND ANY MODIFICATIONS MADE * TO IT IN THE SAME FILE REMAIN UNDER COPYRIGHT OF THE * ORIGINAL AUTHOR, BOTH SOURCE AND OBJECT CODE ARE * MADE FREELY AVAILABLE WITHOUT CHARGE, AND CLEAR * NOTICE IS GIVEN OF THE MODIFICATIONS. Distribution * of this code as part of a commercial system is * permissible ONLY BY DIRECT ARRANGEMENT WITH THE * AUTHOR. (If you are not directly supplying this * code to a customer, and you are instead telling them * how they can obtain it for free, then you are not * required to make any arrangement with me.) * * Disclaimer: Neither I nor: Columbia University, The * Massachusetts Institute of Technology, The * University of Sydney, nor The National Aeronautics * and Space Administration warrant this code in any * way whatsoever. This code is provided "as-is" to be * used at your own risk. * -------------------------------------------------------- * * Last updated: 03 March, 2020 * * Copyright 2020-- * Darren Engwirda * de2363@columbia.edu * https://github.com/dengwirda/ * -------------------------------------------------------- */ # pragma once # ifndef __MP_UTILS__ # define __MP_UTILS__ namespace mp_float { # define REAL_TYPE mp_float::real_type # define INDX_TYPE mp_float::indx_type /*---------------- compute an exact 2 x 2 determinant */ template < size_t NN > __inline_call void compute_det_2x2 ( REAL_TYPE _aa, REAL_TYPE _bb , REAL_TYPE _cc, REAL_TYPE _dd , expansion & _final ) { expansion< 2 >_mulad, _mulbc ; _mulad.from_mul (_aa, _dd); _mulbc.from_mul (_bb, _cc); expansion_sub(_mulad, _mulbc, _final); } /* -------------------------------------------------------- * * Compute an exact 3 x 3 determinant. * * | a1 a2 v1 | * | b1 b2 v2 | * | c1 c2 v3 | * * as the product of 2 x 2 minors about a pivot column * P, shown here for P = 3. The entry V1 is associated * with the minor * * | b1 b2 | = D1 * | c1 c2 | * * and so on for (V2,D2), (V3,D3) etc. * -------------------------------------------------------- */ template < size_t NA, size_t NB, size_t NC, size_t ND, size_t NE, size_t NF, size_t NG > __inline_call void compute_det_3x3 ( expansion const& _det1p , expansion const& _val1p , expansion const& _det2p , expansion const& _val2p , expansion const& _det3p , expansion const& _val3p , expansion & _final , INDX_TYPE _pivot ) { /*---------------------------------- products Vi * Di */ INDX_TYPE constexpr N1 = mul_alloc (NA, NB) ; expansion _mul1p; expansion_mul(_det1p, _val1p, _mul1p); INDX_TYPE constexpr N2 = mul_alloc (NC, ND) ; expansion _mul2p; expansion_mul(_det2p, _val2p, _mul2p); INDX_TYPE constexpr N3 = mul_alloc (NE, NF) ; expansion _mul3p; expansion_mul(_det3p, _val3p, _mul3p); /*---------------------------------- sum (-1)^P * VDi */ INDX_TYPE constexpr MM = sub_alloc (N1, N2) ; expansion _sum_1; if (_pivot % 2 == +0) { expansion_sub(_mul2p, _mul1p, _sum_1); expansion_sub(_sum_1, _mul3p, _final); } else { expansion_sub(_mul1p, _mul2p, _sum_1); expansion_add(_sum_1, _mul3p, _final); } } /*--------------------- "unitary" case, with Vi = +1. */ template < size_t NA, size_t NB, size_t NC, size_t ND > __inline_call void unitary_det_3x3 ( expansion const& _det1p , expansion const& _det2p , expansion const& _det3p , expansion & _final , INDX_TYPE _pivot ) { INDX_TYPE constexpr MM = sub_alloc (NA, NB) ; expansion _sum_1; if (_pivot % 2 == +0) { expansion_sub(_det2p, _det1p, _sum_1); expansion_sub(_sum_1, _det3p, _final); } else { expansion_sub(_det1p, _det2p, _sum_1); expansion_add(_sum_1, _det3p, _final); } } /* -------------------------------------------------------- * * Compute an exact 4 x 4 determinant. * * | a1 a2 a3 v1 | * | b1 b2 b2 v2 | * | c1 c2 c3 v3 | * | d1 d2 d3 v4 | * * as the product of 3 x 3 minors about a pivot column * P, shown here for P = 4. The entry V1 is associated * with the minor * * | b1 b2 b3 | * | c1 c2 c3 | = D1 * | d1 d2 d3 | * * and so on for (V2,D2), (V3,D3) etc. * -------------------------------------------------------- */ template < size_t NA, size_t NB, size_t NC, size_t ND, size_t NE, size_t NF, size_t NG, size_t NH, size_t NI > __inline_call void compute_det_4x4 ( expansion const& _det1p , expansion const& _val1p , expansion const& _det2p , expansion const& _val2p , expansion const& _det3p , expansion const& _val3p , expansion const& _det4p , expansion const& _val4p , expansion & _final , INDX_TYPE _pivot ) { /*---------------------------------- products Vi * Di */ INDX_TYPE constexpr N1 = mul_alloc (NA, NB) ; expansion _mul1p; expansion_mul(_det1p, _val1p, _mul1p); INDX_TYPE constexpr N2 = mul_alloc (NC, ND) ; expansion _mul2p; expansion_mul(_det2p, _val2p, _mul2p); INDX_TYPE constexpr N3 = mul_alloc (NE, NF) ; expansion _mul3p; expansion_mul(_det3p, _val3p, _mul3p); INDX_TYPE constexpr N4 = mul_alloc (NG, NH) ; expansion _mul4p; expansion_mul(_det4p, _val4p, _mul4p); /*---------------------------------- sum (-1)^P * VDi */ INDX_TYPE constexpr M1 = sub_alloc (N1, N2) ; expansion _sum_1; INDX_TYPE constexpr M2 = sub_alloc (N3, N4) ; expansion _sum_2; if (_pivot % 2 == +0) { expansion_sub(_mul2p, _mul1p, _sum_1); expansion_sub(_mul4p, _mul3p, _sum_2); } else { expansion_sub(_mul1p, _mul2p, _sum_1); expansion_sub(_mul3p, _mul4p, _sum_2); } expansion_add(_sum_1, _sum_2, _final); } /*--------------------- "unitary" case, with Vi = +1. */ template < size_t NA, size_t NB, size_t NC, size_t ND, size_t NE > __inline_call void unitary_det_4x4 ( expansion const& _det1p , expansion const& _det2p , expansion const& _det3p , expansion const& _det4p , expansion & _final , INDX_TYPE _pivot ) { INDX_TYPE constexpr M1 = sub_alloc (NA, NB) ; expansion _sum_1; INDX_TYPE constexpr M2 = sub_alloc (NC, ND) ; expansion _sum_2; if (_pivot % 2 == +0) { expansion_sub(_det2p, _det1p, _sum_1); expansion_sub(_det4p, _det3p, _sum_2); } else { expansion_sub(_det2p, _det1p, _sum_1); expansion_sub(_det4p, _det3p, _sum_2); } expansion_add(_sum_1, _sum_2, _final); } /* -------------------------------------------------------- * * Compute an exact 5 x 5 determinant. * * | a1 a2 a3 a4 v1 | * | b1 b2 b3 b4 v2 | * | c1 c2 c3 c4 v3 | * | d1 d2 d3 d4 v4 | * | e1 e2 e3 e4 v5 | * * as the product of 4 x 4 minors about a pivot column * P, shown here for P = 5. The entry V1 is associated * with the minor * * | b1 b2 b3 b4 | * | c1 c2 c3 c4 | = D1 * | d1 d2 d3 d4 | * | e1 e2 e3 e4 | * * and so on for (V2,D2), (V3,D3) etc. * -------------------------------------------------------- */ template < size_t NA, size_t NB, size_t NC, size_t ND, size_t NE, size_t NF, size_t NG, size_t NH, size_t NI, size_t NJ, size_t NK > __inline_call void compute_det_5x5 ( expansion const& _det1p , expansion const& _val1p , expansion const& _det2p , expansion const& _val2p , expansion const& _det3p , expansion const& _val3p , expansion const& _det4p , expansion const& _val4p , expansion const& _det5p , expansion const& _val5p , expansion & _final , INDX_TYPE _pivot ) { /*---------------------------------- products Vi * Di */ INDX_TYPE constexpr N1 = mul_alloc (NA, NB) ; expansion _mul1p; expansion_mul(_det1p, _val1p, _mul1p); INDX_TYPE constexpr N2 = mul_alloc (NC, ND) ; expansion _mul2p; expansion_mul(_det2p, _val2p, _mul2p); INDX_TYPE constexpr N3 = mul_alloc (NE, NF) ; expansion _mul3p; expansion_mul(_det3p, _val3p, _mul3p); INDX_TYPE constexpr N4 = mul_alloc (NG, NH) ; expansion _mul4p; expansion_mul(_det4p, _val4p, _mul4p); INDX_TYPE constexpr N5 = mul_alloc (NI, NJ) ; expansion _mul5p; expansion_mul(_det5p, _val5p, _mul5p); /*---------------------------------- sum (-1)^P * VDi */ INDX_TYPE constexpr M1 = sub_alloc (N1, N2) ; expansion _sum_1; INDX_TYPE constexpr M2 = sub_alloc (N3, N4) ; expansion _sum_2; INDX_TYPE constexpr M3 = sub_alloc (M1, N5) ; expansion _sum_3; if (_pivot % 2 == +0) { expansion_sub(_mul2p, _mul1p, _sum_1); expansion_sub(_mul4p, _mul3p, _sum_2); expansion_sub(_sum_1, _mul5p, _sum_3); } else { expansion_sub(_mul1p, _mul2p, _sum_1); expansion_sub(_mul3p, _mul4p, _sum_2); expansion_add(_sum_1, _mul5p, _sum_3); } expansion_add(_sum_3, _sum_2, _final); } /*--------------------- "unitary" case, with Vi = +1. */ template < size_t NA, size_t NB, size_t NC, size_t ND, size_t NE, size_t NF > __inline_call void unitary_det_5x5 ( expansion const& _det1p , expansion const& _det2p , expansion const& _det3p , expansion const& _det4p , expansion const& _det5p , expansion & _final , INDX_TYPE _pivot ) { INDX_TYPE constexpr N1 = sub_alloc (NA, NB) ; expansion _sum_1; INDX_TYPE constexpr N2 = sub_alloc (NC, ND) ; expansion _sum_2; INDX_TYPE constexpr N3 = sub_alloc (N1, NE) ; expansion _sum_3; if (_pivot % 2 == +0) { expansion_sub(_det2p, _det1p, _sum_1); expansion_sub(_det4p, _det3p, _sum_2); expansion_sub(_sum_1, _det5p, _sum_3); } else { expansion_sub(_det1p, _det2p, _sum_1); expansion_sub(_det3p, _det4p, _sum_2); expansion_add(_sum_1, _det5p, _sum_3); } expansion_add(_sum_3, _sum_2, _final); } # undef REAL_TYPE # undef INDX_TYPE } # endif//__MP_UTILS__ ggforce/src/robust_predicate/expansion/mp_float.hpp0000644000176200001440000006403615024522725022346 0ustar liggesusers /* -------------------------------------------------------- * MPFLOAT: multi-precision floating-point arithmetic. -------------------------------------------------------- * * These are the high-level multi-precision objects --- * computing elementary operations on "expansions" of * floating-point numbers such that rounding error is * eliminated. See Shewchuk for more detail: * * J. R. Shewchuk (1997), Adaptive Precision Floating- * Point Arithmetic & Fast Robust Geometric Predicates * Discrete & Computational Geometry, 18, pp. 305-363. * * This header provides a stack allocated, compile-time * "expansion" object that wraps Shewchuk's operators, * inspired by similar run-time constructs, e.g. Lévy: * * B. Lévy (2016), Robustness and efficiency of * geometric programs: The Predicate Construction Kit * (PCK). Computer-Aided Design, 72, pp. 03-12. * * Here, various compile-time techniques and template * patterns are used to build a "zero-overhead" * framework that doesn't require run-time stack/heap * manipulation or pointer indirection. * -------------------------------------------------------- * * This program may be freely redistributed under the * condition that the copyright notices (including this * entire header) are not removed, and no compensation * is received through use of the software. Private, * research, and institutional use is free. You may * distribute modified versions of this code UNDER THE * CONDITION THAT THIS CODE AND ANY MODIFICATIONS MADE * TO IT IN THE SAME FILE REMAIN UNDER COPYRIGHT OF THE * ORIGINAL AUTHOR, BOTH SOURCE AND OBJECT CODE ARE * MADE FREELY AVAILABLE WITHOUT CHARGE, AND CLEAR * NOTICE IS GIVEN OF THE MODIFICATIONS. Distribution * of this code as part of a commercial system is * permissible ONLY BY DIRECT ARRANGEMENT WITH THE * AUTHOR. (If you are not directly supplying this * code to a customer, and you are instead telling them * how they can obtain it for free, then you are not * required to make any arrangement with me.) * * Disclaimer: Neither I nor: Columbia University, The * Massachusetts Institute of Technology, The * University of Sydney, nor The National Aeronautics * and Space Administration warrant this code in any * way whatsoever. This code is provided "as-is" to be * used at your own risk. * -------------------------------------------------------- * * Last updated: 07 April, 2020 * * Copyright 2020-- * Darren Engwirda * de2363@columbia.edu * https://github.com/dengwirda/ * -------------------------------------------------------- */ # pragma once # ifndef __MP_FLOAT__ # define __MP_FLOAT__ # include "mp_basic.hpp" namespace mp_float { /* -------------------------------------------------------- * EXPANSION: multi-precision floating-point numbers. -------------------------------------------------------- */ # define REAL_TYPE mp_float::real_type # define INDX_TYPE mp_float::indx_type template < size_t N = +1 // max. floats in expansion > class expansion { /*-------------- a compile-time multi-precision expansion */ public : typedef REAL_TYPE real_type; typedef INDX_TYPE indx_type; indx_type static constexpr _size = N ; real_type _xdat [ N ] ; indx_type _xlen = 0 ; public : /*------------------------------ initialising constructor */ __inline_call expansion () { // just default... } __inline_call expansion ( REAL_TYPE _xx ) { this->push(_xx) ; } /*------------------------------ append bits to expansion */ __inline_call void push ( real_type _xx ) { this->_xdat[this->_xlen++] = _xx ; } /*------------------------------ query the expansion size */ __inline_call indx_type count ( ) const { return this->_xlen ; } __inline_call indx_type alloc ( ) const { return this->_size ; } __inline_call bool empty ( ) const { return this->_xlen == +0 ; } /*------------------------------ access to expansion bits */ __inline_call real_type & operator[] ( indx_type _ii ) { //assert ( _ii < this->_size && // "expansion: index out of bounds") ; return ( _ii < this->_size ? this->_xdat[_ii] : this->_xdat[0] ) ; } __inline_call real_type const& operator[] ( indx_type _ii ) const { //assert ( _ii < this->_size && // "expansion: index out of bounds") ; return ( _ii < this->_size ? this->_xdat[_ii] : this->_xdat[0]) ; } public : /*------------------------------ helper: init. from a + b */ __inline_call void from_add ( real_type _aa, real_type _bb ) { static_assert( _size >= 2, "from-add: insufficient alloc.!") ; this->_xlen = +2 ; one_one_add_full(_aa, _bb, this->_xdat[1], this->_xdat[0]) ; } /*------------------------------ helper: init. from a - b */ __inline_call void from_sub ( real_type _aa, real_type _bb ) { static_assert( _size >= 2, "from-sub: insufficient alloc.!") ; this->_xlen = +2 ; one_one_sub_full(_aa, _bb, this->_xdat[1], this->_xdat[0]) ; } /*------------------------------ helper: init. from a * a */ __inline_call void from_sqr ( real_type _aa ) { static_assert( _size >= 2, "from-sqr: insufficient alloc.!") ; this->_xlen = +2 ; one_one_sqr_full(_aa, this->_xdat[1], this->_xdat[0]) ; } /*------------------------------ helper: init. from a * b */ __inline_call void from_mul ( real_type _aa, real_type _bb ) { static_assert( _size >= 2, "from-mul: insufficient alloc.!") ; this->_xlen = +2 ; one_one_mul_full(_aa, _bb, this->_xdat[1], this->_xdat[0]) ; } } ; /* -------------------------------------------------------- * shortcut utilities to construct basic expansions -------------------------------------------------------- */ __inline_call expansion<2> expansion_from_add ( REAL_TYPE _aa, REAL_TYPE _bb ) { expansion<2> _ex; _ex.from_add(_aa, _bb) ; return _ex; } __inline_call expansion<2> expansion_from_sub ( REAL_TYPE _aa, REAL_TYPE _bb ) { expansion<2> _ex; _ex.from_sub(_aa, _bb) ; return _ex; } __inline_call expansion<2> expansion_from_sqr ( REAL_TYPE _aa ) { expansion<2> _ex; _ex.from_sqr(_aa) ; return _ex; } __inline_call expansion<2> expansion_from_mul ( REAL_TYPE _aa, REAL_TYPE _bb ) { expansion<2> _ex; _ex.from_mul(_aa, _bb) ; return _ex; } /* -------------------------------------------------------- * alloc. requirements for operations on expansions -------------------------------------------------------- */ __inline_call INDX_TYPE constexpr add_alloc ( INDX_TYPE _na, INDX_TYPE _nb ) { return _na + _nb ; } __inline_call INDX_TYPE constexpr sub_alloc ( INDX_TYPE _na, INDX_TYPE _nb ) { return _na + _nb ; } __inline_call INDX_TYPE constexpr mul_alloc ( INDX_TYPE _na, INDX_TYPE _nb ) { return _na * _nb * +2 ; } /* -------------------------------------------------------- * add two multi-precision expansion, a'la shewchuk -------------------------------------------------------- */ template < size_t NE, size_t NF, size_t NH > __normal_call void fast_expansion_add_zeroelim ( expansion const& _ee , expansion const& _ff , expansion & _hh ) // adapted from: fast_expansion_sum_zeroelim { REAL_TYPE _qq, _qn, _hx; REAL_TYPE _ex = _ee [0]; REAL_TYPE _fx = _ff [0]; INDX_TYPE _ei = +0, _fi = +0 ; _hh._xlen = 0; if((_fx > _ex) == (_fx > -_ex)) { _qq = _ex; _ex = _ee[++_ei]; } else { _qq = _fx; _fx = _ff[++_fi]; } if((_ei < _ee._xlen) && (_fi < _ff._xlen)) { if((_fx > _ex) == (_fx > -_ex)) { one_one_add_fast( _ex, _qq, _qn, _hx); _qq = _qn; _ex = _ee[++_ei]; } else { one_one_add_fast( _fx, _qq, _qn, _hx); _qq = _qn; _fx = _ff[++_fi]; } if (_hx != +0.0) _hh.push (_hx) ; while ((_ei < _ee._xlen) && (_fi < _ff._xlen) ) { if((_fx > _ex) == (_fx > -_ex)) { one_one_add_full( _qq, _ex, _qn, _hx); _qq = _qn; _ex = _ee[++_ei] ; } else { one_one_add_full( _qq, _fx, _qn, _hx); _qq = _qn; _fx = _ff[++_fi] ; } if (_hx != +0.0) _hh.push (_hx) ; } } while (_ei < _ee._xlen) { one_one_add_full(_qq, _ex, _qn, _hx); _qq = _qn; _ex = _ee[++_ei]; if (_hx != +0.0) _hh.push (_hx) ; } while (_fi < _ff._xlen) { one_one_add_full(_qq, _fx, _qn, _hx); _qq = _qn; _fx = _ff[++_fi]; if (_hx != +0.0) _hh.push (_hx) ; } if((_qq != +0.0) || (_hh._xlen == +0)) { _hh.push(_qq) ; } } template < size_t NA, size_t NB, size_t NC > __inline_call void expansion_add ( expansion const& _aa , expansion const& _bb , expansion & _cc ) // adapted from: fast_expansion_sum_zeroelim { static_assert ( NC >= NA + NB , "expansion-add: insufficient alloc.!"); if (_aa._xlen == +1 && // 1-to-1 unrolling _bb._xlen == +1) { REAL_TYPE _t1, _t0; _cc._xlen = +0 ; one_one_add_full( _aa[0], _bb[0], _t1, _t0); if (_t0 != +0.0) _cc.push (_t0) ; if (_t1 != +0.0) _cc.push (_t1) ; if (_cc.empty()) _cc.push (+0.) ; } else if (_aa._xlen == +2 && // 2-to-1 unrolling _bb._xlen == +1) { REAL_TYPE _t2, _t1, _t0; _cc._xlen = +0 ; two_one_add_full( _aa[1], _aa[0], _bb[0], _t2, _t1, _t0); if (_t0 != +0.0) _cc.push (_t0) ; if (_t1 != +0.0) _cc.push (_t1) ; if (_t2 != +0.0) _cc.push (_t2) ; if (_cc.empty()) _cc.push (+0.) ; } else if (_aa._xlen == +1 && // 1-to-2 unrolling _bb._xlen == +2) { REAL_TYPE _t2, _t1, _t0; _cc._xlen = +0 ; two_one_add_full( _bb[1], _bb[0], _aa[0], _t2, _t1, _t0); if (_t0 != +0.0) _cc.push (_t0) ; if (_t1 != +0.0) _cc.push (_t1) ; if (_t2 != +0.0) _cc.push (_t2) ; if (_cc.empty()) _cc.push (+0.) ; } else if (_aa._xlen == +2 && // 2-to-2 unrolling _bb._xlen == +2) { REAL_TYPE _t3, _t2, _t1, _t0; _cc._xlen = +0 ; two_two_add_full( _aa[1], _aa[0], _bb[1], _bb[0], _t3, _t2, _t1, _t0); if (_t0 != +0.0) _cc.push (_t0) ; if (_t1 != +0.0) _cc.push (_t1) ; if (_t2 != +0.0) _cc.push (_t2) ; if (_t3 != +0.0) _cc.push (_t3) ; if (_cc.empty()) _cc.push (+0.) ; } else // the n-to-m loops { fast_expansion_add_zeroelim(_aa, _bb, _cc); } } /* -------------------------------------------------------- * sub two multi-precision expansion, a'la shewchuk -------------------------------------------------------- */ template < size_t NE, size_t NF, size_t NH > __normal_call void fast_expansion_sub_zeroelim ( expansion const& _ee , expansion const& _ff , expansion & _hh ) // adapted from: fast_expansion_diff_zeroelim { REAL_TYPE _qq, _qn, _hx; REAL_TYPE _ex = _ee [0]; REAL_TYPE _fx =-_ff [0]; INDX_TYPE _ei = +0, _fi = +0 ; _hh._xlen = 0; if((_fx > _ex) == (_fx > -_ex)) { _qq = _ex; _ex = _ee[++_ei]; } else { _qq = _fx; _fx =-_ff[++_fi]; } if((_ei < _ee._xlen) && (_fi < _ff._xlen)) { if((_fx > _ex) == (_fx > -_ex)) { one_one_add_fast( _ex, _qq, _qn, _hx); _qq = _qn; _ex = _ee[++_ei]; } else { one_one_add_fast( _fx, _qq, _qn, _hx); _qq = _qn; _fx =-_ff[++_fi]; } if (_hx != +0.0) _hh.push (_hx) ; while ((_ei < _ee._xlen) && (_fi < _ff._xlen) ) { if((_fx > _ex) == (_fx > -_ex)) { one_one_add_full( _qq, _ex, _qn, _hx); _qq = _qn; _ex = _ee[++_ei] ; } else { one_one_add_full( _qq, _fx, _qn, _hx); _qq = _qn; _fx =-_ff[++_fi] ; } if (_hx != +0.0) _hh.push (_hx) ; } } while (_ei < _ee._xlen) { one_one_add_full(_qq, _ex, _qn, _hx); _qq = _qn; _ex = _ee[++_ei]; if (_hx != +0.0) _hh.push (_hx) ; } while (_fi < _ff._xlen) { one_one_add_full(_qq, _fx, _qn, _hx); _qq = _qn; _fx =-_ff[++_fi]; if (_hx != +0.0) _hh.push (_hx) ; } if((_qq != +0.0) || (_hh._xlen == +0)) { _hh.push(_qq) ; } } template < size_t NA, size_t NB, size_t NC > __inline_call void expansion_sub ( expansion const& _aa , expansion const& _bb , expansion & _cc ) // adapted from: fast_expansion_diff_zeroelim { static_assert ( NC >= NA + NB , "expansion-sub: insufficient alloc.!"); if (_aa._xlen == +1 && // 1-to-1 unrolling _bb._xlen == +1) { REAL_TYPE _t1, _t0; _cc._xlen = +0 ; one_one_sub_full( _aa[0], _bb[0], _t1, _t0); if (_t0 != +0.0) _cc.push (_t0) ; if (_t1 != +0.0) _cc.push (_t1) ; if (_cc.empty()) _cc.push (+0.) ; } else if (_aa._xlen == +2 && // 2-to-1 unrolling _bb._xlen == +1) { REAL_TYPE _t2, _t1, _t0; _cc._xlen = +0 ; two_one_sub_full( _aa[1], _aa[0], _bb[0], _t2, _t1, _t0); if (_t0 != +0.0) _cc.push (_t0) ; if (_t1 != +0.0) _cc.push (_t1) ; if (_t2 != +0.0) _cc.push (_t2) ; if (_cc.empty()) _cc.push (+0.) ; } else if (_aa._xlen == +2 && // 2-to-2 unrolling _bb._xlen == +2) { REAL_TYPE _t3, _t2, _t1, _t0; _cc._xlen = +0 ; two_two_sub_full( _aa[1], _aa[0], _bb[1], _bb[0], _t3, _t2, _t1, _t0); if (_t0 != +0.0) _cc.push (_t0) ; if (_t1 != +0.0) _cc.push (_t1) ; if (_t2 != +0.0) _cc.push (_t2) ; if (_t3 != +0.0) _cc.push (_t3) ; if (_cc.empty()) _cc.push (+0.) ; } else // the n-to-m loops { fast_expansion_sub_zeroelim(_aa, _bb, _cc); } } /* -------------------------------------------------------- * add/sub multi-precision expansion utilities -------------------------------------------------------- */ template < size_t NA, size_t NC > __inline_call void expansion_add ( expansion const& _aa , REAL_TYPE _bb , expansion & _cc ) // add --- from-one { expansion_add( _aa, expansion<1>(_bb), _cc ) ; } template < size_t NA, size_t NC > __inline_call void expansion_sub ( expansion const& _aa , REAL_TYPE _bb , expansion & _cc ) // sub --- from-one { expansion_sub( _aa, expansion<1>(_bb), _cc ) ; } template < size_t NA, size_t NB, size_t NC, size_t ND > __inline_call void expansion_add ( expansion const& _aa, expansion const& _bb, expansion const& _cc, expansion & _dd ) // 3-way add kernel { expansion _ab ; expansion_add(_aa, _bb, _ab); expansion_add(_ab, _cc, _dd); } template < size_t NA, size_t NB, size_t NC, size_t ND, size_t NE > __inline_call void expansion_add ( expansion const& _aa, expansion const& _bb, expansion const& _cc, expansion const& _dd, expansion & _ee ) // 4-way add kernel { expansion _ab ; expansion_add(_aa, _bb, _ab); expansion _cd ; expansion_add(_cc, _dd, _cd); expansion_add(_ab, _cd, _ee); } /* -------------------------------------------------------- * scale a multi-precision expansion, a'la shewchuk -------------------------------------------------------- */ template < size_t NE, size_t NH > __normal_call void scale_expansion_zeroelim ( expansion const& _ee, REAL_TYPE _bb, expansion & _hh ) // adapted from: scale_expansion_zeroelim { REAL_TYPE _bh, _bl, _t1, _t0 , _ss, _hx, _qq; one_split(_bb, _bh, _bl) ; _hh._xlen = +0 ; one_one_mul_full( _ee[ 0 ], _bb, _bh, _bl, _qq, _hx) ; if (_hx != +0.0) _hh.push (_hx) ; INDX_TYPE _ei; for (_ei = +1; _ei < _ee._xlen; ++_ei) { one_one_mul_full(_ee[_ei], _bb, _bh, _bl, _t1, _t0) ; one_one_add_full( _qq, _t0, _ss, _hx); if (_hx != +0.0) _hh.push (_hx) ; one_one_add_fast( _t1, _ss, _qq, _hx); if (_hx != +0.0) _hh.push (_hx) ; } if((_qq != +0.0) || (_hh._xlen == +0)) { _hh.push(_qq) ; } } template < size_t NA, size_t NC > __inline_call void expansion_mul ( expansion const& _aa , REAL_TYPE _bb, expansion & _cc ) // adapted from: scale_expansion_zeroelim { static_assert ( NC >= NA * +2 , "expansion-mul: insufficient alloc.!"); if (_aa._xlen == +1) // 1-to-1 unrolling { REAL_TYPE _t1, _t0; _cc._xlen = +0 ; one_one_mul_full( _aa[0], _bb, _t1, _t0); if (_t0 != +0.0) _cc.push (_t0) ; if (_t1 != +0.0) _cc.push (_t1) ; if (_cc.empty()) _cc.push (+0.) ; } else if (_aa._xlen == +2) // 2-to-1 unrolling { REAL_TYPE _t3, _t2, _t1, _t0; _cc._xlen = +0 ; two_one_mul_full( _aa[1], _aa[0], _bb, _t3, _t2, _t1, _t0); if (_t0 != +0.0) _cc.push (_t0) ; if (_t1 != +0.0) _cc.push (_t1) ; if (_t2 != +0.0) _cc.push (_t2) ; if (_t3 != +0.0) _cc.push (_t3) ; if (_cc.empty()) _cc.push (+0.) ; } else // the n-to-1 loops { scale_expansion_zeroelim (_aa, _bb, _cc); } } /* -------------------------------------------------------- * multi-precision expansion product, a'la shewchuk -------------------------------------------------------- */ template < size_t NA, size_t NB, size_t NC, size_t NR > __normal_call void expansion_mul ( expansion const& _aa , expansion const& _bb , INDX_TYPE _i1, INDX_TYPE _i2 , expansion & _cc ) // see shewchuk: block-wise "distillation" { INDX_TYPE _nr = _i2 - _i1 + 1; if (_nr >= +3) // recursive splits { if constexpr ( NR >= +3 ) { INDX_TYPE _im = _i1 + _nr / 2 ; INDX_TYPE constexpr R1 = NR / 2 ; INDX_TYPE constexpr R2 = NR - R1; INDX_TYPE constexpr N1 = mul_alloc (R1, NA) ; INDX_TYPE constexpr N2 = mul_alloc (R2, NA) ; expansion _c1; expansion_mul( _aa, _bb, _i1, _im - 1, _c1); expansion _c2; expansion_mul( _aa, _bb, _im + 0, _i2, _c2); expansion_add(_c1, _c2, _cc) ; } else { assert( false && "expansion-mul: distill fail"); } } else if (_nr == +2) { if constexpr ( NR >= +2 ) { expansion _c1 ; expansion _c2 ; expansion_mul( _aa, _bb [_i1 + 0], _c1) ; expansion_mul( _aa, _bb [_i1 + 1], _c2) ; expansion_add(_c1, _c2, _cc) ; } else { assert( false && "expansion-mul: distill fail"); } } else if (_nr == +1) // do 1-by-n direct { expansion_mul(_aa, _bb [_i1], _cc); } } template < size_t NA, size_t NB, size_t NC > __inline_call void expansion_mul ( expansion const& _aa , expansion const& _bb , expansion & _cc ) // see shewchuk: block-wise "distillation" { if (_aa._xlen < _bb._xlen) { expansion_mul ( _bb, _aa, 0, _aa._xlen-1, _cc); } else { expansion_mul ( _aa, _bb, 0, _bb._xlen-1, _cc); } } /* -------------------------------------------------------- * -ve for multi-precision expansion, a'la shewchuk -------------------------------------------------------- */ template < size_t NN > __normal_call void expansion_neg ( expansion & _aa ) { INDX_TYPE _ii; for (_ii = +0; _ii < _aa._xlen; ++_ii) { _aa[_ii] *= -1 ; } } /* -------------------------------------------------------- * est. of multi-precision expansion, a'la shewchuk -------------------------------------------------------- */ template < size_t NN > __normal_call REAL_TYPE expansion_est ( expansion const& _aa ) { REAL_TYPE _rr = +0.; INDX_TYPE _ii; for (_ii = +0; _ii < _aa._xlen; ++_ii) { _rr += _aa[_ii]; } return _rr ; } /* -------------------------------------------------------- * form dot-products for multi-precision expansions -------------------------------------------------------- */ template < size_t AX, size_t BX, size_t AY, size_t BY, size_t NP > __inline_call void expansion_dot ( expansion const& _xa, expansion const& _xb, expansion const& _ya, expansion const& _yb, expansion & _dp ) // 2-dim dotproduct { expansion _xp ; expansion_mul(_xa, _xb, _xp); expansion _yp ; expansion_mul(_ya, _yb, _yp); expansion_add(_xp, _yp, _dp); } template < size_t AX, size_t BX, size_t AY, size_t BY, size_t AZ, size_t BZ, size_t NP > __inline_call void expansion_dot ( expansion const& _xa, expansion const& _xb, expansion const& _ya, expansion const& _yb, expansion const& _za, expansion const& _zb, expansion & _dp ) // 3-dim dotproduct { expansion _xp ; expansion_mul(_xa, _xb, _xp); expansion _yp ; expansion_mul(_ya, _yb, _yp); expansion _zp ; expansion_mul(_za, _zb, _zp); expansion_add(_xp, _yp, _zp, _dp); } # undef REAL_TYPE # undef INDX_TYPE } # endif//__MP_FLOAT__ ggforce/src/robust_predicate/expansion/ia_float.hpp0000644000176200001440000003707114672274110022322 0ustar liggesusers /* -------------------------------------------------------- * MPFLOAT: multi-precision floating-point arithmetic. -------------------------------------------------------- * * This program may be freely redistributed under the * condition that the copyright notices (including this * entire header) are not removed, and no compensation * is received through use of the software. Private, * research, and institutional use is free. You may * distribute modified versions of this code UNDER THE * CONDITION THAT THIS CODE AND ANY MODIFICATIONS MADE * TO IT IN THE SAME FILE REMAIN UNDER COPYRIGHT OF THE * ORIGINAL AUTHOR, BOTH SOURCE AND OBJECT CODE ARE * MADE FREELY AVAILABLE WITHOUT CHARGE, AND CLEAR * NOTICE IS GIVEN OF THE MODIFICATIONS. Distribution * of this code as part of a commercial system is * permissible ONLY BY DIRECT ARRANGEMENT WITH THE * AUTHOR. (If you are not directly supplying this * code to a customer, and you are instead telling them * how they can obtain it for free, then you are not * required to make any arrangement with me.) * * Disclaimer: Neither I nor: Columbia University, The * Massachusetts Institute of Technology, The * University of Sydney, nor The National Aeronautics * and Space Administration warrant this code in any * way whatsoever. This code is provided "as-is" to be * used at your own risk. * -------------------------------------------------------- * * Last updated: 10 April, 2020 * * Copyright 2020-- * Darren Engwirda * de2363@columbia.edu * https://github.com/dengwirda/ * -------------------------------------------------------- */ // very simple, light-weight interval arithmetic for the // construction of "filtered" numerical predicates. Only // OP = {+, -, *,} implemented... # pragma once # ifndef __IA_FLOAT__ # define __IA_FLOAT__ # include "mp_basic.hpp" // namespace mp_float { // hmmm no... /* -------------------------------------------------------- * IA-FLT: interval arithmetic -------------------------------------------------------- */ # define REAL_TYPE mp_float::real_type # define INDX_TYPE mp_float::indx_type // silliness with "volatile" to try to stop the compiler // from spuriously(!) optimising floating-point op's and // breaking rounding-mode behaviour... // really, proper compiler support is needed instead and // it's unclear whether this is actually reliable or not __normal_call REAL_TYPE add_up ( // for rnd up REAL_TYPE _aa, REAL_TYPE _bb ) { REAL_TYPE volatile _cc = (+_aa) + (+_bb) ; return +_cc ; } __normal_call REAL_TYPE add_dn ( REAL_TYPE _aa, REAL_TYPE _bb ) { REAL_TYPE volatile _cc = (-_aa) + (-_bb) ; return -_cc ; } __normal_call REAL_TYPE sub_up ( REAL_TYPE _aa, REAL_TYPE _bb ) { REAL_TYPE volatile _cc = (+_aa) - (+_bb) ; return +_cc ; } __normal_call REAL_TYPE sub_dn ( REAL_TYPE _aa, REAL_TYPE _bb ) { REAL_TYPE volatile _cc = (+_bb) - (+_aa) ; return -_cc ; } __normal_call REAL_TYPE mul_up ( REAL_TYPE _aa, REAL_TYPE _bb ) { REAL_TYPE volatile _cc = (+_aa) * (+_bb) ; return +_cc ; } __normal_call REAL_TYPE mul_dn ( REAL_TYPE _aa, REAL_TYPE _bb ) { REAL_TYPE volatile _cc = (+_aa) * (-_bb) ; return -_cc ; } class ia_flt; __inline_call ia_flt operator + ( // fwd. dec's ia_flt const&, REAL_TYPE ) ; __inline_call ia_flt operator + ( REAL_TYPE , ia_flt const&) ; __inline_call ia_flt operator + ( ia_flt const&, ia_flt const&) ; __inline_call ia_flt operator - ( ia_flt const&, REAL_TYPE ) ; __inline_call ia_flt operator - ( REAL_TYPE , ia_flt const&) ; __inline_call ia_flt operator - ( ia_flt const&, ia_flt const&) ; __inline_call ia_flt operator * ( ia_flt const&, REAL_TYPE ) ; __inline_call ia_flt operator * ( REAL_TYPE , ia_flt const&) ; __inline_call ia_flt operator * ( ia_flt const&, ia_flt const&) ; class ia_rnd { /*---------------------------------- interval FP-rnd type */ public : int volatile _rndstate = 0; public : /*---------------------------------- floating pt rounding */ __normal_call ia_rnd ( ) { _rndstate=fegetround(); fesetround (FE_UPWARD); } __normal_call ~ia_rnd ( ) { fesetround (_rndstate); } } ; class ia_flt { /*---------------------------------- interval number type */ public : typedef REAL_TYPE real_type; typedef INDX_TYPE indx_type; indx_type static constexpr _size = 2 ; indx_type static constexpr _xlen = 2 ; real_type _xdat [ 2 ] ; public : /*------------------------------ access to expansion bits */ __inline_call real_type& up ( ) { return this->_xdat[1] ; } __inline_call real_type& lo ( ) { return this->_xdat[0] ; } __inline_call real_type const&up ( ) const { return this->_xdat[1] ; } __inline_call real_type const&lo ( ) const { return this->_xdat[0] ; } /*------------------------------ initialising constructor */ __inline_call ia_flt ( real_type _lo = real_type(+0.) , real_type _up = real_type(+0.) ) { this->_xdat[0] = _lo ; this->_xdat[1] = _up ; } __inline_call ia_flt ( // copy c'tor ia_flt const& _aa ) { this->_xdat[0] = _aa.lo(); this->_xdat[1] = _aa.up(); } __inline_call ia_flt& operator = ( // assignment ia_flt const& _aa ) { this->_xdat[0] = _aa.lo(); this->_xdat[1] = _aa.up(); return ( *this ) ; } __inline_call ia_flt& operator = ( // assignment real_type _aa ) { this->_xdat[0] = (real_type)_aa; this->_xdat[1] = (real_type)_aa; return ( *this ) ; } /*---------------------------------------- set from float */ __inline_call void_type from_add ( real_type _aa, real_type _bb ) { lo() = add_dn(_aa, _bb) ; up() = add_up(_aa, _bb) ; } __inline_call void_type from_sub ( real_type _aa, real_type _bb ) { lo() = sub_dn(_aa, _bb) ; up() = sub_up(_aa, _bb) ; } __inline_call void_type from_mul ( real_type _aa, real_type _bb ) { lo() = mul_dn(_aa, _bb) ; up() = mul_up(_aa, _bb) ; } /*---------------------------------------- math operators */ __inline_call ia_flt operator + ( ) const { return ia_flt(+lo(), +up()); } __inline_call ia_flt operator - ( ) const { return ia_flt(-lo(), -up()); } __inline_call ia_flt& operator+= ( // via double real_type _aa ) { ia_flt _tt = *this + _aa ; up() = _tt.up(); lo() = _tt.lo(); return ( *this ) ; } __inline_call ia_flt& operator-= ( real_type _aa ) { ia_flt _tt = *this - _aa ; up() = _tt.up(); lo() = _tt.lo(); return ( *this ) ; } __inline_call ia_flt& operator*= ( real_type _aa ) { ia_flt _tt = *this * _aa ; up() = _tt.up(); lo() = _tt.lo(); return ( *this ) ; } __inline_call ia_flt& operator+= ( // via ia_flt ia_flt const& _aa ) { ia_flt _tt = *this + _aa ; up() = _tt.up(); lo() = _tt.lo(); return ( *this ) ; } __inline_call ia_flt& operator-= ( ia_flt const& _aa ) { ia_flt _tt = *this - _aa ; up() = _tt.up(); lo() = _tt.lo(); return ( *this ) ; } __inline_call ia_flt& operator*= ( ia_flt const& _aa ) { ia_flt _tt = *this * _aa ; up() = _tt.up(); lo() = _tt.lo(); return ( *this ) ; } /*---------------------------------------- mid-rad. forms */ __inline_call real_type mid ( ) const { real_type _mm = lo() + up() ; if (!std::isfinite(_mm)) { _mm = (lo() / (real_type)+2.)+ (up() / (real_type)+2.); } else { _mm /= (real_type)+2. ; } return _mm ; } __inline_call real_type rad ( ) const { real_type _r1 = up() - mid() ; real_type _r2 = mid() - lo() ; return std::max(_r1, _r2) ; } } ; /* -------------------------------------------------------- * interval-float a + b operators -------------------------------------------------------- */ __inline_call ia_flt operator + ( ia_flt const& _aa, REAL_TYPE _bb ) { REAL_TYPE _lo, _up; _lo = add_dn(_aa.lo(), _bb) ; _up = add_up(_aa.up(), _bb) ; return ( ia_flt(_lo, _up) ) ; } __inline_call ia_flt operator + ( REAL_TYPE _aa, ia_flt const& _bb ) { REAL_TYPE _lo, _up; _lo = add_dn(_aa, _bb.lo()) ; _up = add_up(_aa, _bb.up()) ; return ( ia_flt(_lo, _up) ) ; } __inline_call ia_flt operator + ( ia_flt const& _aa, ia_flt const& _bb ) { REAL_TYPE _lo, _up; _lo = add_dn(_aa.lo(), _bb.lo()) ; _up = add_up(_aa.up(), _bb.up()) ; return ( ia_flt(_lo, _up) ) ; } /* -------------------------------------------------------- * interval-float a - b operators -------------------------------------------------------- */ __inline_call ia_flt operator - ( ia_flt const& _aa, REAL_TYPE _bb ) { REAL_TYPE _lo, _up; _lo = sub_dn(_aa.lo(), _bb) ; _up = sub_up(_aa.up(), _bb) ; return ( ia_flt(_lo, _up) ) ; } __inline_call ia_flt operator - ( REAL_TYPE _aa, ia_flt const& _bb ) { REAL_TYPE _lo, _up; _lo = sub_dn(_aa, _bb.up()) ; _up = sub_up(_aa, _bb.lo()) ; return ( ia_flt(_lo, _up) ) ; } __inline_call ia_flt operator - ( ia_flt const& _aa, ia_flt const& _bb ) { REAL_TYPE _lo, _up; _lo = sub_dn(_aa.lo(), _bb.up()) ; _up = sub_up(_aa.up(), _bb.lo()) ; return ( ia_flt(_lo, _up) ) ; } /* -------------------------------------------------------- * interval-float a * b operators -------------------------------------------------------- */ __inline_call ia_flt operator * ( ia_flt const& _aa, REAL_TYPE _bb ) { REAL_TYPE _lo, _up; if (_bb > (REAL_TYPE) +0.) { _lo = mul_dn(_aa.lo(), _bb) ; _up = mul_up(_aa.up(), _bb) ; } else if (_bb < (REAL_TYPE)+0.) { _lo = mul_dn(_aa.up(), _bb) ; _up = mul_up(_aa.lo(), _bb) ; } else { _lo = (REAL_TYPE)+0. ; _up = (REAL_TYPE)+0. ; } return ( ia_flt(_lo, _up) ) ; } __inline_call ia_flt operator * ( REAL_TYPE _aa, ia_flt const& _bb ) { return ( _bb * _aa ) ; } __normal_call ia_flt operator * ( ia_flt const& _aa, ia_flt const& _bb ) { REAL_TYPE _lo, _up; if (_aa.lo() < (REAL_TYPE)+0.) { if (_aa.up() > (REAL_TYPE)+0.) { if (_bb.lo() < (REAL_TYPE)+0.) { if (_bb.up() > (REAL_TYPE)+0.) // mix * mix { REAL_TYPE _l1, _l2; _l1 = mul_dn(_aa.lo(), _bb.up()); _l2 = mul_dn(_aa.up(), _bb.lo()); _lo = std::min(_l1, _l2); REAL_TYPE _u1, _u2; _u1 = mul_up(_aa.lo(), _bb.lo()); _u2 = mul_up(_aa.up(), _bb.up()); _up = std::min(_u1, _u2); } else // mix * -ve { _lo = mul_dn(_aa.up(), _bb.lo()); _up = mul_up(_aa.lo(), _bb.lo()); } } else { if (_bb.up() > (REAL_TYPE)+0.) // mix * +ve { _lo = mul_dn(_aa.lo(), _bb.up()); _up = mul_up(_aa.up(), _bb.up()); } else // mix * +0. { _lo = (REAL_TYPE)+0. ; _up = (REAL_TYPE)+0. ; } } } else { if (_bb.lo() < (REAL_TYPE)+0.) { if (_bb.up() > (REAL_TYPE)+0.) // -ve * mix { _lo = mul_dn(_aa.lo(), _bb.up()); _up = mul_up(_aa.lo(), _bb.lo()); } else // -ve * -ve { _lo = mul_dn(_aa.up(), _bb.up()); _up = mul_up(_aa.lo(), _bb.lo()); } } else { if (_bb.up() > (REAL_TYPE)+0.) // -ve * +ve { _lo = mul_dn(_aa.lo(), _bb.up()); _up = mul_up(_aa.up(), _bb.lo()); } else // -ve * +0. { _lo = (REAL_TYPE)+0. ; _up = (REAL_TYPE)+0. ; } } } } else { if (_aa.up() > (REAL_TYPE)+0.) { if (_bb.lo() < (REAL_TYPE)+0.) { if (_bb.up() > (REAL_TYPE)+0.) // +ve * mix { _lo = mul_dn(_aa.up(), _bb.lo()); _up = mul_up(_aa.up(), _bb.up()); } else // +ve * -ve { _lo = mul_dn(_aa.up(), _bb.lo()); _up = mul_up(_aa.lo(), _bb.up()); } } else { if (_bb.up() > (REAL_TYPE)+0.) // +ve * +ve { _lo = mul_dn(_aa.lo(), _bb.lo()); _up = mul_up(_aa.up(), _bb.up()); } else // +ve * +0. { _lo = (REAL_TYPE)+0. ; _up = (REAL_TYPE)+0. ; } } } else // -ve * ??? { _lo = (REAL_TYPE)+0. ; _up = (REAL_TYPE)+0. ; } } return ( ia_flt(_lo, _up) ) ; } /* -------------------------------------------------------- * interval-float a ^ 2 operators -------------------------------------------------------- */ __normal_call ia_flt sqr ( ia_flt const& _aa ) { REAL_TYPE _lo, _up; if (_aa.up() < (REAL_TYPE)+0.) { _lo = mul_dn(_aa.up(), _aa.up()); _up = mul_up(_aa.lo(), _aa.lo()); } else if (_aa.lo() > (REAL_TYPE)+0.) { _lo = mul_dn(_aa.lo(), _aa.lo()); _up = mul_up(_aa.up(), _aa.up()); } else { if (-_aa.lo() > +_aa.up()) { _lo = (REAL_TYPE)+0.; _up = mul_up(_aa.lo(), _aa.lo()); } else { _lo = (REAL_TYPE)+0.; _up = mul_up(_aa.up(), _aa.up()); } } return ( ia_flt(_lo, _up) ) ; } # undef REAL_TYPE # undef INDX_TYPE // } # endif//__IA_FLOAT__ ggforce/src/cpp11.cpp0000644000176200001440000001167114672274110014117 0ustar liggesusers// Generated by cpp11: do not edit by hand // clang-format off #include "cpp11/declarations.hpp" #include // bSpline.cpp cpp11::writable::doubles_matrix<> splinePath(cpp11::doubles x, cpp11::doubles y, int degree, cpp11::doubles knots, int detail, cpp11::strings type); extern "C" SEXP _ggforce_splinePath(SEXP x, SEXP y, SEXP degree, SEXP knots, SEXP detail, SEXP type) { BEGIN_CPP11 return cpp11::as_sexp(splinePath(cpp11::as_cpp>(x), cpp11::as_cpp>(y), cpp11::as_cpp>(degree), cpp11::as_cpp>(knots), cpp11::as_cpp>(detail), cpp11::as_cpp>(type))); END_CPP11 } // bSpline.cpp cpp11::writable::list getSplines(cpp11::doubles x, cpp11::doubles y, cpp11::integers id, int detail, cpp11::strings type); extern "C" SEXP _ggforce_getSplines(SEXP x, SEXP y, SEXP id, SEXP detail, SEXP type) { BEGIN_CPP11 return cpp11::as_sexp(getSplines(cpp11::as_cpp>(x), cpp11::as_cpp>(y), cpp11::as_cpp>(id), cpp11::as_cpp>(detail), cpp11::as_cpp>(type))); END_CPP11 } // bezier.cpp cpp11::writable::doubles_matrix<> bezierPath(const cpp11::doubles& x, const cpp11::doubles& y, int detail); extern "C" SEXP _ggforce_bezierPath(SEXP x, SEXP y, SEXP detail) { BEGIN_CPP11 return cpp11::as_sexp(bezierPath(cpp11::as_cpp>(x), cpp11::as_cpp>(y), cpp11::as_cpp>(detail))); END_CPP11 } // bezier.cpp cpp11::writable::list getBeziers(const cpp11::doubles& x, const cpp11::doubles& y, const cpp11::integers& id, int detail); extern "C" SEXP _ggforce_getBeziers(SEXP x, SEXP y, SEXP id, SEXP detail) { BEGIN_CPP11 return cpp11::as_sexp(getBeziers(cpp11::as_cpp>(x), cpp11::as_cpp>(y), cpp11::as_cpp>(id), cpp11::as_cpp>(detail))); END_CPP11 } // concaveman.cpp cpp11::writable::doubles_matrix<> concaveman_c(cpp11::doubles_matrix<> p, cpp11::integers h, double concavity, double threshold); extern "C" SEXP _ggforce_concaveman_c(SEXP p, SEXP h, SEXP concavity, SEXP threshold) { BEGIN_CPP11 return cpp11::as_sexp(concaveman_c(cpp11::as_cpp>>(p), cpp11::as_cpp>(h), cpp11::as_cpp>(concavity), cpp11::as_cpp>(threshold))); END_CPP11 } // ellipseEnclose.cpp cpp11::writable::data_frame enclose_ellip_points(cpp11::doubles x, cpp11::doubles y, cpp11::integers id, double tol); extern "C" SEXP _ggforce_enclose_ellip_points(SEXP x, SEXP y, SEXP id, SEXP tol) { BEGIN_CPP11 return cpp11::as_sexp(enclose_ellip_points(cpp11::as_cpp>(x), cpp11::as_cpp>(y), cpp11::as_cpp>(id), cpp11::as_cpp>(tol))); END_CPP11 } // enclose.cpp cpp11::writable::data_frame enclose_points(cpp11::doubles x, cpp11::doubles y, cpp11::integers id); extern "C" SEXP _ggforce_enclose_points(SEXP x, SEXP y, SEXP id) { BEGIN_CPP11 return cpp11::as_sexp(enclose_points(cpp11::as_cpp>(x), cpp11::as_cpp>(y), cpp11::as_cpp>(id))); END_CPP11 } // pointPath.cpp cpp11::writable::list points_to_path(cpp11::doubles_matrix<> pos, cpp11::list_of< cpp11::doubles_matrix<> > path, bool close); extern "C" SEXP _ggforce_points_to_path(SEXP pos, SEXP path, SEXP close) { BEGIN_CPP11 return cpp11::as_sexp(points_to_path(cpp11::as_cpp>>(pos), cpp11::as_cpp >>>(path), cpp11::as_cpp>(close))); END_CPP11 } extern "C" { static const R_CallMethodDef CallEntries[] = { {"_ggforce_bezierPath", (DL_FUNC) &_ggforce_bezierPath, 3}, {"_ggforce_concaveman_c", (DL_FUNC) &_ggforce_concaveman_c, 4}, {"_ggforce_enclose_ellip_points", (DL_FUNC) &_ggforce_enclose_ellip_points, 4}, {"_ggforce_enclose_points", (DL_FUNC) &_ggforce_enclose_points, 3}, {"_ggforce_getBeziers", (DL_FUNC) &_ggforce_getBeziers, 4}, {"_ggforce_getSplines", (DL_FUNC) &_ggforce_getSplines, 5}, {"_ggforce_points_to_path", (DL_FUNC) &_ggforce_points_to_path, 3}, {"_ggforce_splinePath", (DL_FUNC) &_ggforce_splinePath, 6}, {NULL, NULL, 0} }; } extern "C" attribute_visible void R_init_ggforce(DllInfo* dll){ R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); R_forceSymbols(dll, TRUE); } ggforce/src/concaveman.cpp0000644000176200001440000000153214672274110015300 0ustar liggesusers#include #include #include #include "concaveman.h" #include [[cpp11::register]] cpp11::writable::doubles_matrix<> concaveman_c(cpp11::doubles_matrix<> p, cpp11::integers h, double concavity, double threshold) { typedef std::array point_type; std::vector points(p.nrow()); for (auto i = 0; i < p.nrow(); ++i) { points[i] = {p(i, 0), p(i, 1)}; } std::vector hull(h.size()); for (auto i = 0; i < h.size(); ++i) { hull[i] = h[i]; } auto chull = concaveman(points, hull, concavity, threshold); cpp11::writable::doubles_matrix<> res(chull.size(), 2); for (size_t i = 0; i < chull.size(); ++i) { res(i, 0) = chull[i][0]; res(i, 1) = chull[i][1]; } return res; } ggforce/src/bSpline.cpp0000644000176200001440000001031014672274110014554 0ustar liggesusers#include "deBoor.h" #include #include #include #include #include using namespace cpp11::literals; #include cpp11::writable::doubles createKnots(int nControl, int degree) { int nKnots = nControl + degree + 1; cpp11::writable::doubles knots; knots.reserve(nKnots); for (int i = 0; i < nKnots; i++) { if (i < degree + 1) { knots.push_back(0); } else if (i < nKnots - degree) { knots.push_back(knots[i-1] + 1); } else { knots.push_back(knots[i-1]); } } return knots; } std::vector createOpenKnots(int nControl, int degree) { int nKnots = nControl + degree + 1; std::vector knots (nKnots, 0); for (int i = 0; i < nKnots; i++) { if (i < 1) knots[i] = 0; else knots[i] = knots[i-1] + 1; } return knots; } std::vector createControls(const cpp11::doubles& x, const cpp11::doubles& y) { int nControls = x.size(); std::vector controls(nControls, Point()); for (int i = 0; i < nControls; i++) { controls[i] = Point(x[i], y[i]); } return controls; } [[cpp11::register]] cpp11::writable::doubles_matrix<> splinePath(cpp11::doubles x, cpp11::doubles y, int degree, cpp11::doubles knots, int detail, cpp11::strings type) { std::vector controls = createControls(x, y); std::vector knots_vec(knots.begin(), knots.end()); if (type[0] == "closed") { controls.push_back(controls[0]); controls.push_back(controls[1]); controls.push_back(controls[2]); } cpp11::writable::doubles_matrix<> res(detail, 2); double zJump = (knots_vec[knots_vec.size()-1-degree] - knots_vec[degree]); if (type[0] == "clamped") { zJump /= double(detail-1); } else { zJump /= double(detail); } for (int i = 0; i < detail; i++) { Point point; if (i == detail-1 && type[0] == "clamped") { point = controls[controls.size()-1]; } else { double z = knots_vec[degree] + i * zJump; int zInt = whichInterval(z, knots_vec); point = deBoor(degree, degree, zInt, z, knots_vec, controls); } res(i, 0) = point.x; res(i, 1) = point.y; } return res; } [[cpp11::register]] cpp11::writable::list getSplines(cpp11::doubles x, cpp11::doubles y, cpp11::integers id, int detail, cpp11::strings type) { std::vector nControls; std::vector pathID; nControls.push_back(1); pathID.push_back(id[0]); for (int i = 1; i < id.size(); i++) { if (id[i] == pathID.back()) { nControls.back()++; } else { nControls.push_back(1); pathID.push_back(id[i]); } } int nPaths = nControls.size(); cpp11::writable::doubles_matrix<> paths(nPaths * detail, 2); cpp11::writable::integers pathsID(nPaths * detail); int controlsStart = 0; R_xlen_t pathStart = 0; for (int i = 0; i < nPaths; i++) { cpp11::writable::doubles knots; int degree = nControls[i] <= 3 ? nControls[i] - 1 : 3; if (type[0] == "clamped") { knots = createKnots(nControls[i], degree); } else if (type[0] == "open") { knots = createOpenKnots(nControls[i], degree); } else if (type[0] == "closed") { if (nControls[i] < 3) { cpp11::stop("At least 3 control points must be provided for closed b-splines"); } degree = 3; knots = createOpenKnots(nControls[i] + 3, degree); } else { cpp11::stop("type must be either \"open\", \"closed\", or \"clamped\""); } cpp11::writable::doubles x_tmp(x.begin() + controlsStart, x.begin() + controlsStart + nControls[i]); cpp11::writable::doubles y_tmp(y.begin() + controlsStart, y.begin() + controlsStart + nControls[i]); cpp11::doubles_matrix<> path = splinePath(x_tmp, y_tmp, degree, knots, detail, type); for (R_xlen_t j = 0; j < path.nrow(); ++j) { pathsID[pathStart + j] = pathID[i]; paths(pathStart + j, 0) = path(j, 0); paths(pathStart + j, 1) = path(j, 1); } controlsStart += nControls[i]; pathStart += path.nrow(); } return cpp11::writable::list({ "paths"_nm = paths, "pathID"_nm = pathsID }); } ggforce/src/enclose.cpp0000644000176200001440000001424614672274110014624 0ustar liggesusers#include #include #include using namespace cpp11::literals; #include struct Circle { double x; double y; double r; }; struct Point { double x; double y; }; bool equalPoints(const Point &p1, const Point &p2) { return std::abs(p2.x - p1.x) < 1e-9 && std::abs(p2.y - p1.y) < 1e-9; } bool perpendicularPoints(const Point &p1, const Point &p2) { return std::abs(p2.x - p1.x) < 1e-9 || std::abs(p2.y - p1.y) < 1e-9; } bool horizontalPoints(const Point &p1, const Point &p2) { return std::abs(p2.y - p1.y) < 1e-9; } bool verticalPoints(const Point &p1, const Point &p2) { return std::abs(p2.x - p1.x) < 1e-9; } Circle circleByPoints(const Point &p1, const Point &p2, const Point &p3) { Circle results; double X1, Y1, X2, Y2, A1, A2; X1 = p2.x - p1.x; Y1 = p2.y - p1.y; X2 = p3.x - p2.x; Y2 = p3.y - p2.y; A1 = Y1/X1; A2 = Y2/X2; if (std::abs(A2 - A1) < 1e-9) { cpp11::stop("Error in circleByPoints: The 3 points are colinear"); } results.x = ( A1*A2*(p1.y - p3.y) + A2*(p1.x + p2.x) - A1*(p2.x+p3.x) )/( 2.0 * (A2 - A1) ); results.y = -1.0*( results.x - (p1.x + p2.x)/2.0 )/A1 + (p1.y + p2.y)/2.0; return results; } Circle encloseOne(const Point &p1) { Circle results; results.x = p1.x; results.y = p1.y; results.r = 0.0; return results; } Circle encloseTwo(const Point &p1, const Point &p2) { if (equalPoints(p1, p2)) return encloseOne(p1); Circle results; double dx = p2.x - p1.x; double dy = p2.y - p1.y; results.x = p1.x + dx/2.0; results.y = p1.y + dy/2.0; results.r = std::sqrt(dx*dx + dy*dy)/2.0; return results; } Circle encloseThree(const Point &p1, const Point &p2, const Point &p3) { if (equalPoints(p1, p2)) return encloseTwo(p1, p3); if (equalPoints(p1, p3)) return encloseTwo(p1, p2); if (equalPoints(p2, p3)) return encloseTwo(p1, p2); bool perp12 = perpendicularPoints(p1, p2); bool perp23 = perpendicularPoints(p2, p3); bool perp13 = perpendicularPoints(p1, p3); Circle results; if (perp12 && perp23 && perp13) { cpp11::stop("Error in encloseThree: The 3 points are colinear"); } else if (perp12 + perp23 + perp13 == 2) { if (perp12) { if (horizontalPoints(p1, p2)) { results.y = p1.y + (p2.y - p1.y)/2; } else { results.x = p1.x + (p2.x - p1.x)/2; } } if (perp23) { if (horizontalPoints(p2, p3)) { results.y = p2.y + (p3.y - p2.y)/2; } else { results.x = p2.x + (p3.x - p2.x)/2; } } if (perp13) { if (horizontalPoints(p1, p3)) { results.y = p1.y + (p3.y -p1.y)/2; } else { results.x = p1.x + (p3.x -p1.x)/2; } } } else { if (!perp12 && !perp23) { results = circleByPoints(p1, p2, p3); } else if (!perp12 && !perp13) { results = circleByPoints(p2, p1, p3); } else { results = circleByPoints(p1, p3, p2); } } double dx, dy; dx = p1.x - results.x; dy = p1.y - results.y; results.r = std::sqrt(float(dx*dx + dy*dy)); return results; } Circle encloseDefault(std::vector points) { switch(points.size()) { case 1: return encloseOne(points[0]); case 2: return encloseTwo(points[0], points[1]); case 3: return encloseThree(points[0], points[1], points[2]); default: cpp11::stop("Error in encloseDefault - expecting less than 4 points"); } } bool inCircle(Circle c, Point p) { double dx = p.x - c.x; double dy = p.y - c.y; return (dx*dx + dy*dy) - c.r*c.r <= 1e-3; } bool allInCircle(Circle c, std::vector points) { std::vector::iterator it; for (it = points.begin(); it != points.end(); ++it) { if (!inCircle(c, *it)) return false; } return true; } std::vector extendPerimeter(std::vector perimeter, Point p) { std::vector::iterator it, jt; for (it = perimeter.begin(); it != perimeter.end(); ++it) { if (equalPoints(*it, p)) return perimeter; } if (perimeter.size() < 2) { perimeter.push_back(p); return perimeter; } if (inCircle(encloseDefault(perimeter), p)) { return perimeter; } std::vector new_per; for (it = perimeter.begin(); it != perimeter.end(); ++it) { if (allInCircle(encloseTwo(*it, p), perimeter)) { new_per.push_back(p); new_per.push_back(*it); return new_per; } } for (it = perimeter.begin(); it != perimeter.end(); ++it) { for (jt = it + 1; jt != perimeter.end(); ++jt) { if (!inCircle(encloseTwo(*it, *jt), p) && !inCircle(encloseTwo(*it, p), *jt) && !inCircle(encloseTwo(*jt, p), *it) && allInCircle(encloseThree(*it, *jt, p), perimeter)) { new_per.push_back(*it); new_per.push_back(*jt); new_per.push_back(p); return new_per; } } } cpp11::stop("Error in extendPerimeter: Could not enclose points"); } Circle enclosePoints(std::vector points) { std::vector::iterator it = points.begin(); Circle center = {0.0, 0.0, 0.0}; std::vector perimeter; while (it != points.end()) { if (inCircle(center, *it)) { ++it; } else { perimeter = extendPerimeter(perimeter, *it); center = encloseDefault(perimeter); it = points.begin(); } } return center; } [[cpp11::register]] cpp11::writable::data_frame enclose_points(cpp11::doubles x, cpp11::doubles y, cpp11::integers id) { if (x.size() != y.size() || x.size() != id.size()) { cpp11::stop("x, y, and id must have same dimensions"); } cpp11::writable::doubles x0; cpp11::writable::doubles y0; cpp11::writable::doubles r; std::vector< std::vector > all_points; std::vector points; all_points.push_back(points); int currentId = id[0]; for (R_xlen_t i = 0; i < id.size(); ++i) { Point p_tmp = {x[i], y[i]}; if (id[i] != currentId) { currentId = id[i]; std::vector points; all_points.push_back(points); } all_points.back().push_back(p_tmp); } for (size_t i = 0; i < all_points.size(); ++i) { Circle center = enclosePoints(all_points[i]); x0.push_back(center.x); y0.push_back(center.y); r.push_back(center.r); } return cpp11::writable::data_frame({ "x0"_nm = x0, "y0"_nm = y0, "r"_nm = r }); } ggforce/src/pointPath.cpp0000644000176200001440000000474614672274110015146 0ustar liggesusers#include #include #include #include using namespace cpp11::literals; #include #include double distSquared(std::pair p, std::pair p1) { double x = p1.first - p.first; double y = p1.second - p.second; return x * x + y * y; } std::pair projection(std::pair a, std::pair b, std::pair p, bool clamp) { if (a.first == b.first && a.second == b.second) return a; double length2 = distSquared(a, b); std::pair norm(b.first - a.first, b.second - a.second); std::pair pa(p.first - a.first, p.second - a.second); double t = (norm.first * pa.first + norm.second * pa.second) / length2; if (clamp) { t = std::max(0.0, std::min(1.0, t)); } norm.first = t * norm.first + a.first; norm.second = t * norm.second + a.second; return norm; } void dist_to_path(double x, double y, const cpp11::list_of< cpp11::doubles_matrix<> >& path, std::vector &res, bool closed_poly) { double shortest_dist = -1; std::pair closest; std::pair point(x, y); for (R_xlen_t i = 0; i < path.size(); ++i) { for (R_xlen_t j = 0; j < path[i].nrow(); ++j) { if (j == path[i].nrow() && !closed_poly) break; std::pair a(path[i](j, 0), path[i](j, 1)); R_xlen_t k = j == path[i].nrow() - 1 ? 0 : j + 1; std::pair b(path[i](k, 0), path[i](k, 1)); std::pair close = projection(a, b, point, true); double dist = std::sqrt(distSquared(point, close)); if (shortest_dist < 0 || dist < shortest_dist) { shortest_dist = dist; closest = close; } } } res.clear(); res.push_back(closest.first); res.push_back(closest.second); res.push_back(shortest_dist); } [[cpp11::register]] cpp11::writable::list points_to_path(cpp11::doubles_matrix<> pos, cpp11::list_of< cpp11::doubles_matrix<> > path, bool close) { std::vector res_container; cpp11::writable::doubles_matrix<> proj(pos.nrow(), 2); cpp11::writable::doubles dist(pos.nrow()); for (R_xlen_t i = 0; i < pos.nrow(); ++i) { dist_to_path(pos(i, 0), pos(i, 1), path, res_container, close); proj(i, 0) = res_container[0]; proj(i, 1) = res_container[1]; dist[i] = res_container[2]; } return cpp11::writable::list({ "projection"_nm = proj, "distance"_nm = dist }); } ggforce/src/deBoor.h0000644000176200001440000000171514672274110014050 0ustar liggesusers// Taken from https://chi3x10.wordpress.com/2009/10/18/de-boor-algorithm-in-c/ #include // Class for dealing with points/vectors in a 2-dimensional space class Point { public: double x; double y; Point(); Point(double xInit, double yInit); // copy assignment operator Point operator=(const Point pt); // Arithmatic operators Point operator+(const Point pt) const; Point operator*(double m) const; Point operator/(double m) const; }; // Find the interval in knots where x resides int whichInterval(double x, std::vector knots); // Calculate the position along the B-spline given by x // The spline is defined by the degree, knots and ctrlPoints. When calling k // should equal degree but due to the recursive nature k will decrease to // zero during recursion. i gives the interval in knots that x resides in Point deBoor(int k, int degree, int i, double x, std::vector knots, std::vector ctrlPoints); ggforce/src/ellipseEnclose.cpp0000644000176200001440000002243314672274110016137 0ustar liggesusers#include #include #include #include #include #include #include using namespace cpp11::literals; #include #include struct Ellipse { double x; double y; double a; double b; double rad; }; bool points_on_line(const cpp11::doubles_matrix<>& points, Ellipse &enc) { double xmin, ymin, xmax, ymax; R_xlen_t n = points.nrow(); if (n == 1) { enc.x = points(0, 0); enc.y = points(0, 1); enc.a = 0; enc.b = 0; enc.rad = 0; return true; } if (n == 2) { xmin = points(0, 0); xmax = points(1, 0); ymin = points(0, 1); ymax = points(1, 1); } else { double x0 = xmin = xmax = points(0, 0); double y0 = ymin = ymax = points(0, 1); double xdiff = points(1, 0) - x0; bool vert = xdiff == 0; double slope = std::numeric_limits::infinity(); if (!vert) { slope = (points(1, 1) - y0) / xdiff; } for (int i = 2; i < n; i++) { xdiff = points(i, 0) - x0; if (vert && xdiff == 0) { ymin = std::min(ymin, points(i, 1)); ymax = std::max(ymax, points(i, 1)); continue; } if (slope == (points(i, 1) - y0) / xdiff) { if (points(i, 0) < xmin) { xmin = points(i, 0); ymin = points(i, 1); } else if (points(i, 0) > xmin) { xmax = points(i, 0); ymax = points(i, 1); } continue; } return false; } } if (xmin == xmax && ymin == ymax) { enc.x = xmin; enc.y = ymin; enc.a = 0; enc.b = 0; enc.rad = 0; } else { enc.x = (xmin + xmax) / 2; enc.y = (ymin + ymax) / 2; double diff_x = xmax - xmin; double diff_y = ymax - ymin; enc.a = std::sqrt(diff_x * diff_x + diff_y * diff_y) / 2; enc.b = enc.a * 0.1; enc.rad = std::atan(diff_y / diff_x); } return true; } cpp11::writable::doubles_matrix<> transpose(const cpp11::doubles_matrix<>& x) { cpp11::writable::doubles_matrix<> trans(x.ncol(), x.nrow()); for (R_xlen_t j = 0; j < x.ncol(); ++j) for (R_xlen_t i = 0; i < x.nrow(); ++i) { trans(j, i) = x(i, j); } return trans; } cpp11::writable::doubles_matrix<> make_q(const cpp11::doubles_matrix<>& p) { cpp11::writable::doubles_matrix<> Q(p.nrow() + 1, p.ncol()); for (R_xlen_t j = 0; j < p.ncol(); ++j) for (R_xlen_t i = 0; i < p.nrow(); ++i) { Q(i, j) = p(i, j); } for (R_xlen_t j = 0; j < p.ncol(); ++j) Q(p.nrow(), j) = 1.0; return Q; } // Q * diagonal(u) * Qadj cpp11::writable::doubles_matrix<> solve_x(const cpp11::doubles_matrix<>& Q, const cpp11::doubles& u, const cpp11::doubles_matrix<>& Qadj) { cpp11::writable::doubles_matrix<> res(Q.nrow(), Qadj.ncol()); for (R_xlen_t i = 0; i < Q.nrow(); ++i) for (R_xlen_t j = 0; j < Qadj.ncol(); ++j) { double cell = 0.0; for (R_xlen_t k = 0; k < u.size(); ++k) { cell += Q(i, k) * u[k] * Qadj(k, j); } res(i, j) = cell; } return res; } // diagonal(Qadj * inverse(X) * Q) cpp11::writable::doubles solve_m(const cpp11::doubles_matrix<>& Qadj, const cpp11::doubles_matrix<>& X, const cpp11::doubles_matrix<>& Q) { static auto solve = cpp11::package("base")["solve"]; cpp11::doubles_matrix<> Xinv = cpp11::as_cpp< cpp11::doubles_matrix<> >(solve(X)); cpp11::writable::doubles res; for (R_xlen_t i = 0; i < Qadj.nrow(); ++i) { double sum = 0.0; for (R_xlen_t k = 0; k < Xinv.ncol(); ++k) { double cell = 0.0; for (R_xlen_t j = 0; j < Qadj.ncol(); ++j) { cell += Qadj(i, j) * Xinv(j, k); } sum += cell * Q(k, i); } res.push_back(sum); } return res; } cpp11::writable::doubles_matrix<> prod_with_diag(const cpp11::doubles_matrix<>& A, const cpp11::doubles& b) { if (A.ncol() != b.size()) { cpp11::stop("A must have the same number of columns as there are elements in b"); } cpp11::writable::doubles_matrix<> res(A.nrow(), A.ncol()); for (R_xlen_t i = 0; i < A.nrow(); ++i) for (R_xlen_t j = 0; j < A.ncol(); ++j) { res(i, j) = A(i, j) * b[j]; } return res; } cpp11::writable::doubles_matrix<> prod(const cpp11::doubles_matrix<>& A, const cpp11::doubles_matrix<>& B) { if (A.ncol() != B.nrow()) { cpp11::stop("A must have the same number of columns as there are rows in B"); } cpp11::writable::doubles_matrix<> res(A.nrow(), B.ncol()); for (R_xlen_t i = 0; i < A.nrow(); ++i) for (R_xlen_t j = 0; j < B.ncol(); ++j) { double cell = 0.0; for (R_xlen_t k = 0; k < A.ncol(); ++k) { cell += A(i, k) * B(k, j); } res(i, j) = cell; } return res; } cpp11::writable::doubles_matrix<> prod_with_vec(const cpp11::doubles_matrix<>& A, const cpp11::doubles& b) { if (A.ncol() != b.size()) { cpp11::stop("A must have the same number of columns as there are elements in b"); } cpp11::writable::doubles_matrix<> res(A.nrow(), 1); for (R_xlen_t i = 0; i < A.nrow(); ++i) { double cell = 0.0; for (R_xlen_t k = 0; k < A.ncol(); ++k) { cell += A(i, k) * b[k]; } res(i, 0) = cell; } return res; } // ------------------------------------- fourth ------------------------------------------------ // ----------- third ----------------- // --------------- first -------------------- - second - // (1.0/d) * (points * u.asDiagonal() * points.adjoint() - (points * u)*(points * u).adjoint() ).inverse() cpp11::writable::doubles_matrix<> solve_a(const cpp11::doubles_matrix<>& points, const cpp11::doubles& u, const cpp11::doubles_matrix<>& second) { static auto solve = cpp11::package("base")["solve"]; cpp11::writable::doubles_matrix<> first = prod(prod_with_diag(points, u), transpose(points)); cpp11::doubles_matrix<> third = prod(second, transpose(second)); for (R_xlen_t i = 0; i < first.nrow(); ++i) for (R_xlen_t j = 0; j < first.ncol(); ++j) { first(i, j) -= third(i, j); } cpp11::writable::doubles_matrix<> fourth = cpp11::as_cpp< cpp11::writable::doubles_matrix<> >(solve(first)); for (R_xlen_t i = 0; i < fourth.nrow(); ++i) for (R_xlen_t j = 0; j < fourth.ncol(); ++j) { fourth(i, j) *= 1.0 / points.nrow(); } return fourth; } Ellipse solve_enc(const cpp11::doubles_matrix<>& A) { static auto svd = cpp11::package("base")["svd"]; Ellipse enc; cpp11::list svd_a = cpp11::as_cpp(svd(A)); cpp11::doubles d(svd_a["d"]); cpp11::doubles_matrix<> v(svd_a["v"]); enc.a = 1.0/std::sqrt(d[1]); enc.b = 1.0/std::sqrt(d[0]); if (v(0, 1) == v(1, 0)) { enc.rad = std::asin(v(1, 1)); } else if (v(0, 1) < v(1, 0)) { enc.rad = std::asin(-v(0, 0)); } else { enc.rad = std::asin(v(0, 0)); } return enc; } Ellipse khachiyan(const cpp11::doubles_matrix<>& points, double tol) { Ellipse enc; if (points_on_line(points, enc)) { return enc; } cpp11::doubles_matrix<> pointsAdj = transpose(points); R_xlen_t N = pointsAdj.ncol(); R_xlen_t d = pointsAdj.nrow(); cpp11::doubles_matrix<> Q = make_q(pointsAdj); cpp11::doubles_matrix<> Qadj = transpose(Q); cpp11::writable::doubles u(N); std::fill(u.begin(), u.end(), 1/double(N)); cpp11::writable::doubles u_tmp(N); double error = 1; while (error > tol) { cpp11::doubles_matrix<> X = solve_x(Q, u, Qadj); cpp11::doubles M = solve_m(Qadj, X, Q); R_xlen_t max_i = 0; double max = M[0]; for (R_xlen_t i = 1; i < M.size(); ++i) { if (M[i] > max) { max_i = i; max = M[i]; } } double step = (max - d - 1)/((d + 1)*(max - 1)); cpp11::writable::doubles u_tmp; u_tmp.reserve(N); for (R_xlen_t i = 0; i < u.size(); ++i) { u_tmp.push_back(u[i] * (1 - step)); } u_tmp[max_i] += step; error = 0.0; for (R_xlen_t i = 0; i < u.size(); ++i) { double du = u_tmp[i] - u[i]; error += du * du; u[i] = double(u_tmp[i]); } error = std::sqrt(error); } cpp11::doubles_matrix<> c = prod_with_vec(pointsAdj, u); cpp11::doubles_matrix<> A = solve_a(pointsAdj, u, c); enc = solve_enc(A); enc.x = c(0, 0); enc.y = c(1, 0); return enc; } [[cpp11::register]] cpp11::writable::data_frame enclose_ellip_points(cpp11::doubles x, cpp11::doubles y, cpp11::integers id, double tol) { if (x.size() != y.size() || x.size() != id.size()) { cpp11::stop("x, y, and id must have same dimensions"); } std::vector< int > splits; splits.push_back(0); int currentId = id[0]; for (R_xlen_t i = 0; i < id.size(); ++i) { if (id[i] != currentId) { currentId = id[i]; splits.push_back(i); } } splits.push_back(id.size()); cpp11::writable::doubles x0; cpp11::writable::doubles y0; cpp11::writable::doubles a; cpp11::writable::doubles b; cpp11::writable::doubles rad; for (size_t i = 0; i < splits.size() - 1; ++i) { int size = splits[i+1] - splits[i]; cpp11::writable::doubles_matrix<> points(size, 2); for (R_xlen_t j = 0; j < points.nrow(); ++j) { points(j, 0) = x[splits[i] + j]; points(j, 1) = y[splits[i] + j]; } Ellipse center = khachiyan(points, tol); x0.push_back(center.x); y0.push_back(center.y); a.push_back(center.a); b.push_back(center.b); rad.push_back(center.rad); } return cpp11::writable::data_frame({ "x0"_nm = x0, "y0"_nm = y0, "a"_nm = a, "b"_nm = b, "angle"_nm = rad }); } ggforce/src/bezier.cpp0000644000176200001440000000507214672274110014451 0ustar liggesusers#include #include #include #include using namespace cpp11::literals; #include double Bezier2(double t, const cpp11::doubles& w) { double t2 = t * t; double mt = 1-t; double mt2 = mt * mt; return w[0]*mt2 + w[1]*2*mt*t + w[2]*t2; } double Bezier3(double t, const cpp11::doubles& w) { double t2 = t * t; double t3 = t2 * t; double mt = 1-t; double mt2 = mt * mt; double mt3 = mt2 * mt; return w[0]*mt3 + 3*w[1]*mt2*t + 3*w[2]*mt*t2 + w[3]*t3; } [[cpp11::register]] cpp11::writable::doubles_matrix<> bezierPath(const cpp11::doubles& x, const cpp11::doubles& y, int detail) { cpp11::writable::doubles_matrix<> res(detail, 2); detail = detail - 1; double step = 1.0/detail; double t; if (x.size() == 3) { for (int i = 0; i < detail; i++) { t = i * step; res(i, 0) = Bezier2(t, x); res(i, 1) = Bezier2(t, y); } } else if (x.size() == 4) { for (int i = 0; i < detail; i++) { t = i * step; res(i, 0) = Bezier3(t, x); res(i, 1) = Bezier3(t, y); } } else { cpp11::stop("Only support for quadratic and cubic beziers"); } res(detail, 0) = x[x.size() - 1]; res(detail, 1) = y[y.size() - 1]; return res; } [[cpp11::register]] cpp11::writable::list getBeziers(const cpp11::doubles& x, const cpp11::doubles& y, const cpp11::integers& id, int detail) { std::vector nControls; std::vector pathID; nControls.push_back(1); pathID.push_back(id[0]); for (int i = 1; i < id.size(); i++) { if (id[i] == pathID.back()) { nControls.back()++; } else { nControls.push_back(1); pathID.push_back(id[i]); } } size_t nPaths = nControls.size(); cpp11::writable::doubles_matrix<> paths(nPaths * detail, 2); cpp11::writable::integers pathsID(nPaths * detail); int controlsStart = 0; R_xlen_t pathStart = 0; for (size_t i = 0; i < nPaths; i++) { cpp11::writable::doubles x_tmp(x.begin() + controlsStart, x.begin() + controlsStart + nControls[i]); cpp11::writable::doubles y_tmp(y.begin() + controlsStart, y.begin() + controlsStart + nControls[i]); cpp11::doubles_matrix<> path = bezierPath(x_tmp, y_tmp, detail); for (R_xlen_t j = 0; j < path.nrow(); ++j) { pathsID[pathStart + j] = pathID[i]; paths(pathStart + j, 0) = path(j, 0); paths(pathStart + j, 1) = path(j, 1); } controlsStart += nControls[i]; pathStart += path.nrow(); } return cpp11::writable::list({ "paths"_nm = paths, "pathID"_nm = pathsID }); } ggforce/NAMESPACE0000644000176200001440000001355514672274110013122 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(heightDetails,mark_label) S3method(makeContent,circ_enc) S3method(makeContent,ellip_enc) S3method(makeContent,hull_enc) S3method(makeContent,rect_enc) S3method(makeContent,shape) S3method(single_value,default) S3method(single_value,factor) S3method(widthDetails,mark_label) export(FacetCol) export(FacetGridPaginate) export(FacetMatrix) export(FacetRow) export(FacetStereo) export(FacetWrapPaginate) export(FacetZoom) export(GeomArc) export(GeomArc0) export(GeomArcBar) export(GeomAutoarea) export(GeomAutorect) export(GeomBezier0) export(GeomBspline0) export(GeomBsplineClosed0) export(GeomCircle) export(GeomMarkCircle) export(GeomMarkEllipse) export(GeomMarkHull) export(GeomMarkRect) export(GeomParallelSetsAxes) export(GeomShape) export(PositionAuto) export(PositionFloatstack) export(PositionJitterNormal) export(StatArc) export(StatArc0) export(StatArc2) export(StatArcBar) export(StatAutobin) export(StatAutodensity) export(StatBezier) export(StatBezier0) export(StatBezier2) export(StatBspline) export(StatBspline2) export(StatCircle) export(StatDelaunaySegment) export(StatDelaunaySegment2) export(StatDelaunayTile) export(StatDelvorSummary) export(StatDiagonal) export(StatDiagonal0) export(StatDiagonal2) export(StatDiagonalWide) export(StatEllip) export(StatErr) export(StatLink) export(StatLink2) export(StatParallelSets) export(StatParallelSetsAxes) export(StatPie) export(StatRegon) export(StatSina) export(StatSpiro) export(StatVoronoiSegment) export(StatVoronoiTile) export(facet_col) export(facet_grid_paginate) export(facet_matrix) export(facet_row) export(facet_stereo) export(facet_wrap_paginate) export(facet_zoom) export(gather_set_data) export(geom_arc) export(geom_arc0) export(geom_arc2) export(geom_arc_bar) export(geom_autodensity) export(geom_autohistogram) export(geom_autopoint) export(geom_bezier) export(geom_bezier0) export(geom_bezier2) export(geom_bspline) export(geom_bspline0) export(geom_bspline2) export(geom_bspline_closed) export(geom_bspline_closed0) export(geom_circle) export(geom_delaunay_segment) export(geom_delaunay_segment2) export(geom_delaunay_tile) export(geom_diagonal) export(geom_diagonal0) export(geom_diagonal2) export(geom_diagonal_wide) export(geom_ellipse) export(geom_link) export(geom_link0) export(geom_link2) export(geom_mark_circle) export(geom_mark_ellipse) export(geom_mark_hull) export(geom_mark_rect) export(geom_parallel_sets) export(geom_parallel_sets_axes) export(geom_parallel_sets_labels) export(geom_regon) export(geom_shape) export(geom_sina) export(geom_spiro) export(geom_voronoi_segment) export(geom_voronoi_tile) export(interpolateDataFrame) export(label_tex) export(linear_trans) export(n_pages) export(position_auto) export(position_jitternormal) export(power_trans) export(radial_trans) export(scale_depth) export(scale_depth_continuous) export(scale_depth_discrete) export(scale_x_unit) export(scale_y_unit) export(shapeGrob) export(stat_arc) export(stat_arc0) export(stat_arc2) export(stat_arc_bar) export(stat_bezier) export(stat_bezier0) export(stat_bezier2) export(stat_bspline) export(stat_bspline0) export(stat_bspline2) export(stat_bspline_closed) export(stat_circle) export(stat_delvor_summary) export(stat_diagonal) export(stat_diagonal0) export(stat_diagonal2) export(stat_diagonal_wide) export(stat_ellip) export(stat_err) export(stat_link) export(stat_link2) export(stat_parallel_sets) export(stat_parallel_sets_axes) export(stat_pie) export(stat_regon) export(stat_sina) export(stat_spiro) export(theme_no_axes) export(trans_reverser) import(ggplot2) import(rlang) import(vctrs) importFrom(MASS,fractions) importFrom(ggplot2,label_parsed) importFrom(ggplot2,layer) importFrom(grDevices,chull) importFrom(grid,addGrob) importFrom(grid,arcCurvature) importFrom(grid,bezierGrob) importFrom(grid,childNames) importFrom(grid,convertHeight) importFrom(grid,convertUnit) importFrom(grid,convertWidth) importFrom(grid,convertX) importFrom(grid,convertY) importFrom(grid,curveGrob) importFrom(grid,gList) importFrom(grid,gTree) importFrom(grid,gpar) importFrom(grid,grid.layout) importFrom(grid,grob) importFrom(grid,grobDescent) importFrom(grid,grobHeight) importFrom(grid,grobTree) importFrom(grid,grobWidth) importFrom(grid,heightDetails) importFrom(grid,is.unit) importFrom(grid,makeContent) importFrom(grid,nullGrob) importFrom(grid,polygonGrob) importFrom(grid,polylineGrob) importFrom(grid,rectGrob) importFrom(grid,segmentsGrob) importFrom(grid,setChildren) importFrom(grid,textGrob) importFrom(grid,unit) importFrom(grid,unit.c) importFrom(grid,valid.just) importFrom(grid,viewport) importFrom(grid,widthDetails) importFrom(grid,xsplineGrob) importFrom(gtable,gtable) importFrom(gtable,gtable_add_cols) importFrom(gtable,gtable_add_grob) importFrom(gtable,gtable_add_rows) importFrom(lifecycle,deprecated) importFrom(polyclip,polyclip) importFrom(polyclip,polylineoffset) importFrom(polyclip,polyminkowski) importFrom(polyclip,polyoffset) importFrom(scales,as.trans) importFrom(scales,asn_trans) importFrom(scales,atanh_trans) importFrom(scales,boxcox_trans) importFrom(scales,censor) importFrom(scales,date_trans) importFrom(scales,exp_trans) importFrom(scales,extended_breaks) importFrom(scales,format_format) importFrom(scales,identity_trans) importFrom(scales,log10_trans) importFrom(scales,log1p_trans) importFrom(scales,log2_trans) importFrom(scales,log_trans) importFrom(scales,logit_trans) importFrom(scales,probability_trans) importFrom(scales,probit_trans) importFrom(scales,reciprocal_trans) importFrom(scales,rescale) importFrom(scales,rescale_pal) importFrom(scales,reverse_trans) importFrom(scales,sqrt_trans) importFrom(scales,time_trans) importFrom(scales,trans_new) importFrom(stats,na.omit) importFrom(stats,runif) importFrom(stats,setNames) importFrom(tidyselect,eval_select) importFrom(tweenr,tween_t) importFrom(utils,packageVersion) importFrom(withr,with_seed) useDynLib(ggforce) useDynLib(ggforce, .registration = TRUE) ggforce/LICENSE0000644000176200001440000000006114672274110012674 0ustar liggesusersYEAR: 2019 COPYRIGHT HOLDER: Thomas Lin Pedersen ggforce/NEWS.md0000644000176200001440000002027615024472413012775 0ustar liggesusers# ggforce 0.5.0 * Fixed a bug that would cause reordering of data in some geoms (#314) * The concaveman package is no longer a dependency for `geom_mark_hull()` (#308) * Setting both label and description to `NA` will now turn off label drawing for that mark completely while still drawing the mark * Fix a bug in `geom_mark_rect()` where the mark would not be shown in all panels (#307) * Fixed a bug in the `geom_mark_*()` geoms where having `NA` values in the `filter` aesthetic would lead to weird errors. `NA` is now treated as `FALSE` (#306) * `shapeGrob()` is now exported for use by other packages (#303) * Fix a bug in `geom_autohistogram()` that prevented it to be used with continuous data (#297) * `facet_zoom()` now throws a better error when used with `coord_flip()` (#143) * You can now use `"inherit"`, `"inherit_fill"`, and `"inherit_col"` for the styling of the label box and connector in the `geom_mark_*()` family of geoms (#240) * Prepare for upcoming changes in ggplot2 # ggforce 0.4.2 * Fix a documentation issue reported by CRAN # ggforce 0.4.1 * Fixed a sanitizer error in the decent calculations used for the mark geoms * Fixed a typo bug in the vctrs implementations # ggforce 0.4.0 * Moved to vctrs internally * Updated error messaging to use cli * `geom_diagonal()`, `geom_diagonal_wide()`, `geom_parallel_sets()`, and `geom_sina()` are now bidirectional in the style of ggplot2 * `geom_mark_*()` now works correctly in the presence of `NA` values in `x` and `y` * The `zoom`, `zoom.x`, and `zoom.y` elements now uses proper registration of theme elements, inheriting from `strip.background`. * Fixed bug in `geom_sina()` when groups contained less than 3 points * Fixed bug in `geom_parallel_sets()` that erroneously removed grouping information in some configurations * Added `jitter_y` argument to `geom_sina()` to control whether y jittering is performed on integerish y values. * `facet_zoom()` now works with patchwork * Fix bug in `geom_mark_ellipse()` that caused wrong orientation of ellipses with groups of two. * `gather_set_data()` now supports tidyselect. * `position_jitternormal()` gains a `seed` argument in parallel to `ggplot2::position_jitter()` * `geom_sina()` now works when the group only have a single unique y value * `facet_zoom()` now works correctly with transformed scales * `facet_wrap_paginate()` now works correctly with `dir = 'v'` * `facet_matrix()` now supports a labeller * fix a bug in `geom_parallel_sets_axes()` that prevented coloring of axis fill * fix a bug in `stat_circle()` if the `x` and `y` aesthetics were inherited from the global mapping * `facet_zoom()` now works even when limits are set by the scales # ggforce 0.3.4 - Changed documentation to comply with new units package - Fixed unintentional re-ordering of shapes (#224) - Deprecate `scale_[x|y]_unit` in favor of `units::scale_[x|y]_units` # ggforce 0.3.2 - Changes to comply with latest ggplot2 release - Make sure ggforce pass test even if concaveman is not available # ggforce 0.3.1 - Better fix for gganimate compatibility (#157) # ggforce 0.3.0 - Added `facet_matrix()` in order to facet different data columns into different rows and columns in a grid, in order to make e.g. scatterplot matrices and pairs plot - Added `geom_autopoint()` and `position_auto()` to jitter points based on the type of positional scales in the panel - Added `geom_autohistogram()` and `geom_autodensity()` for facilitating distribution plots along the diagonal in a `facet_matrix()` plot. - Added `facet_row()` and `facet_col` to have one-dimensional `facet_wrap()` with possibility of variable sizing. - Stats should now always keep the old group variable (potentially with something added), making them work with gganimate - Removed the *Visual Guide* vignette to reduce compilation time. See the website for an overview of all functionality with compiled examples (https://ggforce.data-imaginist.com) # ggforce 0.2.2 - Fixed a regression in `geom_sina()` where the computation would fail with a warning due to `tolower()` being masked (#134, #135). # ggforce 0.2.1 - Fixed a bug in the calculation of open and closed b-splines, where the interval would exceed the defined region and result in an out-of-bounds memory error # ggforce 0.2.0 ## New features - `linear_trans` for composing linear transformation using `rotate`, `stretch`, `shear`, `reflect`, and `translate` - `facet_stereo` added for creating stereographic projections - `geom_voronoi_[tile|segment]`, `geom_delaunay_[tile|segment|segment2]`, and `stat_delvor_summary` has been added for tesselation and triangulation. - `geom_spiro` has been added for drawing spirographs - Add `geom_ellipse` for drawing regular and superellipses - Add `geom_regon` for drawing regular polygons - Add `geom_diagonal`, `geom_diagonal_wide` and `geom_parallel_sets` for drawing parallel sets diagrams and other visualizations based on diagonals. - Add `geom_shape` for drawing polygons with rounded corners and expanded/contracted sides. `geom_shape` replaces all `geom_polygon` internally. - Added `geom_bspline_closed` to draw polygons defined as b-splines - Add `geom_mark_[rect|circle|ellipse|hull]` to encircle a group of points and optionally add textual annotation to it - Add `position_jitternormal` to jitter points based on a normal distribution (@andrewheiss) ## Improvements - `facet_[wrap|grid]_paginate` will now try to make panels on the last page the same size as on full pages (#7) - `facet_zoom` now gains `xlim` and `ylim` arguments to control zoom range directly - `facet_zoom` now gains `zoom.data` to control which data gets plotted in which panel - Slimmed down the dependencies for the package. `plyr`, `lazyeval` and `dplyr` has all been removed - Rewrite `geom_sina` to match `geom_violin` and allow for dodging - Add `open`/`clamped` option to `geom_bspline ## Bug fixes - Fix interpolation of `x` and `y` values in `geom_link2` (@thomasp85 and @lepennec) - `stat_link` no longer replicates the group column - arcs and links no longer rename aesthetics when only one aesthetic is present (`drop = FALSE`) - `stat_bezier0` and `stat_bezier2` now return data in the expected format - Fix bug with `n_pages` due to internal changes in ggplot2 - Fix bug in `facet_zoom` in combination with secondary y-axis where the space for the y-axis would become huge - Correctly detect and error out when scales and coords does not work with `facet_zoom` - The *2 versions of line geoms no longer adds an `NA` to guides. # ggforce 0.1.1 ## New features - Zoom indicator styling can now be specified separetely for x and y zoom using `zoom.x` and `zoom.y` in theme (inherits from `zoom` that inherits from `strip.background`) ## Bug fixes - Fix bug in `facet_wrap_paginate` that threw errors when using it with free scales (#19) - Fixes bug in `facet_zoom` where y-axis would be incorrectly displayed when zooming on both axes without splitting the view (#23) - Fixes bug in `facet_zoom` where scale expansion where not taken into account when drawing the indicator area (#22) - Fixes a bug in `facet_zoom` that would throw errors with layers not containing the column that is zoomed by (#21) # ggforce 0.1.0 ## Major changes - `geom_edge_bundle` has been renamed `geom_bspline` and lost the tension argument. True edge bundle functionality has been moved to `ggraph` ## New features - `geom_bezier` for drawing quadratic and cubic beziers - `geom_link` for augmented segment/path drawing - `geom_sina` as an alternative to `geom_violin` and `geom_beeswarm` - `scale_[x|y]_unit` for using units vectors - `facet_[wrap|grid]_paginate` to split facetting into multiple pages - `facet_zoom` for contextual zooming # ggforce 0.0.1 ## Major changes - First commit ## New features - `geom_arc` / `stat_arc` for drawing circle segments - `geom_edge_bundle` / `stat_edge_bundle` for drawing edge bundles based on control points - `geom_arc_bar` /`stat_arc_bar` / `stat_pie` for drawing arcs and wedges with fill - `geom_circle` / `stat_circle` for drawing circles with radius based on coordinate system scale - `power_trans` for creating power transformations - `radial_trans` for creating transformation between radial and cartesian coordinates - `trans_reverser` for reversing a trans object ggforce/README.md0000644000176200001440000000514415024476316013161 0ustar liggesusers # ggforce [![R-CMD-check](https://github.com/thomasp85/ggforce/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/thomasp85/ggforce/actions/workflows/R-CMD-check.yaml) [![CRAN_Release_Badge](http://www.r-pkg.org/badges/version-ago/ggforce)](https://CRAN.R-project.org/package=ggforce) [![CRAN_Download_Badge](http://cranlogs.r-pkg.org/badges/ggforce)](https://CRAN.R-project.org/package=ggforce) [![Codecov test coverage](https://codecov.io/gh/thomasp85/ggforce/graph/badge.svg)](https://app.codecov.io/gh/thomasp85/ggforce) *Accelerating ggplot2* `ggforce` is a package aimed at providing missing functionality to `ggplot2` through the extension system introduced with `ggplot2` v2.0.0. Broadly speaking `ggplot2` has been aimed primarily at explorative data visualization in order to investigate the data at hand, and less at providing utilities for composing custom plots a la [D3.js](https://d3js.org). `ggforce` is mainly an attempt to address these “shortcomings†(design choices might be a better description). The goal is to provide a repository of geoms, stats, etc. that are as well documented and implemented as the official ones found in `ggplot2`. ## Installation You can install the released version of ggforce from [CRAN](https://CRAN.R-project.org) with: ``` r install.packages("ggforce") ``` And the development version from [GitHub](https://github.com/) with: ``` r # install.packages("devtools") devtools::install_github("thomasp85/ggforce") ``` ## Features `ggforce` is by design a collection of features with the only commonality being their tie to the `ggplot2` API. Because of this an overview of all features would get too long for a README. The package has a [website](https://ggforce.data-imaginist.com) where every feature is described and justified with examples and plots. There should be a plot in the README of a visualization package though, so without further ado: ``` r library(ggforce) #> Loading required package: ggplot2 ggplot(iris, aes(Petal.Length, Petal.Width, colour = Species)) + geom_point() + facet_zoom(x = Species == "versicolor") ``` ## Code of Conduct Please note that the ‘ggforce’ project is released with a [Contributor Code of Conduct](https://ggforce.data-imaginist.com/CODE_OF_CONDUCT.html). By contributing to this project, you agree to abide by its terms. ggforce/man/0000755000176200001440000000000014672274066012457 5ustar liggesusersggforce/man/geom_bspline.Rd0000644000176200001440000002331115024476446015407 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bspline.R \name{geom_bspline} \alias{geom_bspline} \alias{stat_bspline} \alias{stat_bspline2} \alias{geom_bspline2} \alias{stat_bspline0} \alias{geom_bspline0} \title{B-splines based on control points} \usage{ stat_bspline( mapping = NULL, data = NULL, geom = "path", position = "identity", na.rm = FALSE, n = 100, type = "clamped", show.legend = NA, inherit.aes = TRUE, ... ) geom_bspline( mapping = NULL, data = NULL, stat = "bspline", position = "identity", arrow = NULL, n = 100, type = "clamped", lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) stat_bspline2( mapping = NULL, data = NULL, geom = "path_interpolate", position = "identity", na.rm = FALSE, n = 100, type = "clamped", show.legend = NA, inherit.aes = TRUE, ... ) geom_bspline2( mapping = NULL, data = NULL, stat = "bspline2", position = "identity", arrow = NULL, n = 100, type = "clamped", lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) stat_bspline0( mapping = NULL, data = NULL, geom = "bspline0", position = "identity", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, type = "clamped", ... ) geom_bspline0( mapping = NULL, data = NULL, stat = "identity", position = "identity", arrow = NULL, lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, type = "clamped", ... ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{The geometric object to use to display the data for this layer. When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument can be used to override the default coupling between stats and geoms. The \code{geom} argument accepts the following: \itemize{ \item A \code{Geom} ggproto subclass, for example \code{GeomPoint}. \item A string naming the geom. To give the geom as a string, strip the function name of the \code{geom_} prefix. For example, to use \code{geom_point()}, give the geom as \code{"point"}. \item For more information and other ways to specify the geom, see the \link[ggplot2:layer_geoms]{layer geom} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \item{n}{The number of points generated for each spline} \item{type}{Either \code{'clamped'} (default) or \code{'open'}. The former creates a knot sequence that ensures the splines starts and ends at the terminal control points.} \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{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} \item{arrow}{Arrow specification, as created by \code{\link[grid:arrow]{grid::arrow()}}.} \item{lineend}{Line end style (round, butt, square).} } \description{ This set of stats and geoms makes it possible to draw b-splines based on a set of control points. As with \code{\link[=geom_bezier]{geom_bezier()}} there exists several versions each having there own strengths. The base version calculates the b-spline as a number of points along the spline and connects these with a path. The *2 version does the same but in addition interpolates aesthetics between each control point. This makes the *2 version considerably slower so it shouldn't be used unless needed. The *0 version uses \code{\link[grid:grid.xspline]{grid::xsplineGrob()}} with \code{shape = 1} to approximate a b-spline. } \section{Aesthetics}{ geom_bspline understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x} \item \strong{y} \item color \item linewidth \item linetype \item alpha \item lineend } } \section{Computed variables}{ \describe{ \item{x, y}{The coordinates for the path describing the spline} \item{index}{The progression along the interpolation mapped between 0 and 1} } } \examples{ # Define some control points cp <- data.frame( x = c( 0, -5, -5, 5, 5, 2.5, 5, 7.5, 5, 2.5, 5, 7.5, 5, -2.5, -5, -7.5, -5, -2.5, -5, -7.5, -5 ), y = c( 0, -5, 5, -5, 5, 5, 7.5, 5, 2.5, -5, -7.5, -5, -2.5, 5, 7.5, 5, 2.5, -5, -7.5, -5, -2.5 ), class = sample(letters[1:3], 21, replace = TRUE) ) # Now create some paths between them paths <- data.frame( ind = c( 7, 5, 8, 8, 5, 9, 9, 5, 6, 6, 5, 7, 7, 5, 1, 3, 15, 8, 5, 1, 3, 17, 9, 5, 1, 2, 19, 6, 5, 1, 4, 12, 7, 5, 1, 4, 10, 6, 5, 1, 2, 20 ), group = c( 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10 ) ) paths$x <- cp$x[paths$ind] paths$y <- cp$y[paths$ind] paths$class <- cp$class[paths$ind] ggplot(paths) + geom_bspline(aes(x = x, y = y, group = group, colour = after_stat(index))) + geom_point(aes(x = x, y = y), data = cp, color = 'steelblue') ggplot(paths) + geom_bspline2(aes(x = x, y = y, group = group, colour = class)) + geom_point(aes(x = x, y = y), data = cp, color = 'steelblue') ggplot(paths) + geom_bspline0(aes(x = x, y = y, group = group)) + geom_point(aes(x = x, y = y), data = cp, color = 'steelblue') } \author{ Thomas Lin Pedersen. The C++ code for De Boor's algorithm has been adapted from \href{https://chi3x10.wordpress.com/2009/10/18/de-boor-algorithm-in-c/}{Jason Yu-Tseh Chi implementation} } ggforce/man/geom_regon.Rd0000644000176200001440000001637015024476446015074 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/regon.R \name{geom_regon} \alias{geom_regon} \alias{stat_regon} \title{Draw regular polygons by specifying number of sides} \usage{ stat_regon( mapping = NULL, data = NULL, geom = "shape", position = "identity", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) geom_regon( mapping = NULL, data = NULL, stat = "regon", position = "identity", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{The geometric object to use to display the data for this layer. When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument can be used to override the default coupling between stats and geoms. The \code{geom} argument accepts the following: \itemize{ \item A \code{Geom} ggproto subclass, for example \code{GeomPoint}. \item A string naming the geom. To give the geom as a string, strip the function name of the \code{geom_} prefix. For example, to use \code{geom_point()}, give the geom as \code{"point"}. \item For more information and other ways to specify the geom, see the \link[ggplot2:layer_geoms]{layer geom} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \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{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} } \description{ This geom makes it easy to construct regular polygons (polygons where all sides and angles are equal) by specifying the number of sides, position, and size. The polygons are always rotated so that they "rest" on a flat side, but this can be changed with the angle aesthetic. The size is based on the radius of their circumcircle and is thus not proportional to their area. } \section{Aesthetics}{ geom_regon understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x0} x coordinate \item \strong{y0} y coordinate \item \strong{sides} the number of sides for regon \item \strong{r} the ratio of regon with respect to plot \item \strong{angle} regon rotation angle (unit is radian) \item color \item fill \item size \item linetype \item alpha \item lineend } } \section{Computed variables}{ \describe{ \item{x, y}{The coordinates for the corners of the polygon} } } \examples{ ggplot() + geom_regon(aes(x0 = runif(8), y0 = runif(8), sides = sample(3:10, 8), angle = 0, r = runif(8) / 10)) + coord_fixed() # The polygons are drawn with geom_shape, so can be manipulated as such ggplot() + geom_regon(aes(x0 = runif(8), y0 = runif(8), sides = sample(3:10, 8), angle = 0, r = runif(8) / 10), expand = unit(1, 'cm'), radius = unit(1, 'cm')) + coord_fixed() } ggforce/man/geom_diagonal_wide.Rd0000644000176200001440000002050115024476446016537 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/diagonal_wide.R \name{geom_diagonal_wide} \alias{geom_diagonal_wide} \alias{stat_diagonal_wide} \title{Draw an area defined by an upper and lower diagonal} \usage{ stat_diagonal_wide( mapping = NULL, data = NULL, geom = "shape", position = "identity", n = 100, strength = 0.5, na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, ... ) geom_diagonal_wide( mapping = NULL, data = NULL, stat = "diagonal_wide", position = "identity", n = 100, na.rm = FALSE, orientation = NA, strength = 0.5, show.legend = NA, inherit.aes = TRUE, ... ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{The geometric object to use to display the data for this layer. When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument can be used to override the default coupling between stats and geoms. The \code{geom} argument accepts the following: \itemize{ \item A \code{Geom} ggproto subclass, for example \code{GeomPoint}. \item A string naming the geom. To give the geom as a string, strip the function name of the \code{geom_} prefix. For example, to use \code{geom_point()}, give the geom as \code{"point"}. \item For more information and other ways to specify the geom, see the \link[ggplot2:layer_geoms]{layer geom} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{n}{The number of points to create for each of the bounding diagonals} \item{strength}{The proportion to move the control point along the x-axis towards the other end of the bezier curve} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \item{orientation}{The orientation of the layer. The default (\code{NA}) automatically determines the orientation from the aesthetic mapping. In the rare event that this fails it can be given explicitly by setting \code{orientation} to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} \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{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} } \description{ The \code{geom_diagonal_wide()} function draws a \emph{thick} diagonal, that is, a polygon confined between a lower and upper \link[=geom_diagonal]{diagonal}. This geom is bidirectional and the direction can be controlled with the \code{orientation} argument. } \section{Aesthetics}{ geom_diagonal_wide understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x} \item \strong{y} \item \strong{group} \item color \item linewidth \item linetype \item alpha \item lineend } } \section{Orientation}{ This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce from a combination of the given mappings and the types of positional scales in use. Thus, ggplot2 will by default try to guess which orientation the layer should have. Under rare circumstances, the orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. } \examples{ data <- data.frame( x = c(1, 2, 2, 1, 2, 3, 3, 2), y = c(1, 2, 3, 2, 3, 1, 2, 5), group = c(1, 1, 1, 1, 2, 2, 2, 2) ) ggplot(data) + geom_diagonal_wide(aes(x, y, group = group)) # The strength control the steepness ggplot(data, aes(x, y, group = group)) + geom_diagonal_wide(strength = 0.75, alpha = 0.5, fill = 'red') + geom_diagonal_wide(strength = 0.25, alpha = 0.5, fill = 'blue') # The diagonal_wide geom uses geom_shape under the hood, so corner rounding # etc are all there ggplot(data) + geom_diagonal_wide(aes(x, y, group = group), radius = unit(5, 'mm')) } ggforce/man/facet_row.Rd0000644000176200001440000000740714672274110014715 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/facet_row.R \name{facet_row} \alias{facet_row} \alias{facet_col} \title{One-dimensional facets} \usage{ facet_row( facets, scales = "fixed", space = "fixed", shrink = TRUE, labeller = "label_value", drop = TRUE, strip.position = "top" ) facet_col( facets, scales = "fixed", space = "fixed", shrink = TRUE, labeller = "label_value", drop = TRUE, strip.position = "top" ) } \arguments{ \item{facets}{A set of variables or expressions quoted by \code{\link[ggplot2:vars]{vars()}} and defining faceting groups on the rows or columns dimension. The variables can be named (the names are passed to \code{labeller}). For compatibility with the classic interface, can also be a formula or character vector. Use either a one sided formula, \code{~a + b}, or a character vector, \code{c("a", "b")}.} \item{scales}{Should scales be fixed (\code{"fixed"}, the default), free (\code{"free"}), or free in one dimension (\code{"free_x"}, \code{"free_y"})?} \item{space}{Should the size of the panels be fixed or relative to the range of the respective position scales} \item{shrink}{If \code{TRUE}, will shrink scales to fit output of statistics, not raw data. If \code{FALSE}, will be range of raw data before statistical summary.} \item{labeller}{A function that takes one data frame of labels and returns a list or data frame of character vectors. Each input column corresponds to one factor. Thus there will be more than one with \code{vars(cyl, am)}. Each output column gets displayed as one separate line in the strip label. This function should inherit from the "labeller" S3 class for compatibility with \code{\link[ggplot2:labeller]{labeller()}}. You can use different labeling functions for different kind of labels, for example use \code{\link[ggplot2:label_parsed]{label_parsed()}} for formatting facet labels. \code{\link[ggplot2:label_value]{label_value()}} is used by default, check it for more details and pointers to other options.} \item{drop}{If \code{TRUE}, the default, all factor levels not used in the data will automatically be dropped. If \code{FALSE}, all factor levels will be shown, regardless of whether or not they appear in the data.} \item{strip.position}{By default, the labels are displayed on the top of the plot. Using \code{strip.position} it is possible to place the labels on either of the four sides by setting \code{strip.position = c("top", "bottom", "left", "right")}} } \description{ These facets are one-dimensional versions of \code{\link[ggplot2:facet_wrap]{ggplot2::facet_wrap()}}, arranging the panels in either a single row or a single column. This restriction makes it possible to support a \code{space} argument as seen in \code{\link[ggplot2:facet_grid]{ggplot2::facet_grid()}} which, if set to \code{"free"} will allow the panels to be sized based on the relative range of their scales. Another way of thinking about them are one-dimensional versions of \code{\link[ggplot2:facet_grid]{ggplot2::facet_grid()}} (ie. \code{. ~ {var}} or \code{{var} ~ .}), but with the ability to position the strip at either side of the panel. However you look at it it is the best of both world if you just need one dimension. } \examples{ # Standard use ggplot(mtcars) + geom_point(aes(disp, mpg)) + facet_col(~gear) # It retains the ability to have unique scales for each panel ggplot(mtcars) + geom_point(aes(disp, mpg)) + facet_col(~gear, scales = 'free') # But can have free sizing along the stacking dimension ggplot(mtcars) + geom_point(aes(disp, mpg)) + facet_col(~gear, scales = 'free', space = 'free') # And you can position the strip where-ever you like ggplot(mtcars) + geom_point(aes(disp, mpg)) + facet_col(~gear, scales = 'free', space = 'free', strip.position = 'bottom') } ggforce/man/linear_trans.Rd0000644000176200001440000000272514672274110015423 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans_linear.R \name{linear_trans} \alias{linear_trans} \alias{rotate} \alias{stretch} \alias{shear} \alias{translate} \alias{reflect} \title{Create a custom linear transformation} \usage{ linear_trans(...) rotate(angle) stretch(x, y) shear(x, y) translate(x, y) reflect(x, y) } \arguments{ \item{...}{A number of transformation functions.} \item{angle}{An angle in radians} \item{x}{the transformation magnitude in the x-direction} \item{y}{the transformation magnitude in the x-direction} } \value{ \code{linear_trans} creates a trans object. The other functions return a 3x3 transformation matrix. } \description{ This function lets you compose transformations based on a sequence of linear transformations. If the transformations are parameterised the parameters will become arguments in the transformation function. The transformations are one of \code{rotate}, \code{shear}, \code{stretch}, \code{translate}, and \code{reflect}. } \examples{ trans <- linear_trans(rotate(a), shear(1, 0), translate(x1, y1)) square <- data.frame(x = c(0, 0, 1, 1), y = c(0, 1, 1, 0)) square2 <- trans$transform(square$x, square$y, a = pi / 3, x1 = 4, y1 = 8) square3 <- trans$transform(square$x, square$y, a = pi / 1.5, x1 = 2, y1 = -6) square <- rbind(square, square2, square3) square$group <- rep(1:3, each = 4) ggplot(square, aes(x, y, group = group)) + geom_polygon(aes(fill = factor(group)), colour = 'black') } ggforce/man/power_trans.Rd0000644000176200001440000000132614672274110015301 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans.R \name{power_trans} \alias{power_trans} \title{Create a power transformation object} \usage{ power_trans(n) } \arguments{ \item{n}{The degree of the power transformation} } \value{ A trans object } \description{ This function can be used to create a proper trans object that encapsulates a power transformation (x^n). } \examples{ # Power of 2 transformations trans <- power_trans(2) trans$transform(1:10) # Cubic root transformation trans <- power_trans(1 / 3) trans$transform(1:10) # Use it in a plot ggplot() + geom_line(aes(x = 1:10, y = 1:10)) + scale_x_continuous(trans = power_trans(2), expand = c(0, 1)) } ggforce/man/scale_unit.Rd0000644000176200001440000000125314672274110015063 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scale-unit.R \name{scale_unit} \alias{scale_x_unit} \alias{scale_y_unit} \title{Position scales for units data} \usage{ scale_x_unit(...) scale_y_unit(...) } \arguments{ \item{...}{Passed on to \code{units::scale_x_units()} or \code{units::scale_y_units()}} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} These are the default scales for the units class. These will usually be added automatically. To override manually, use \verb{scale_*_unit}. } \keyword{internal} ggforce/man/geom_ellipse.Rd0000644000176200001440000001642415024476446015417 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ellipse.R \name{geom_ellipse} \alias{geom_ellipse} \alias{stat_ellip} \title{Draw (super)ellipses based on the coordinate system scale} \usage{ stat_ellip( mapping = NULL, data = NULL, geom = "circle", position = "identity", n = 360, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) geom_ellipse( mapping = NULL, data = NULL, stat = "ellip", position = "identity", n = 360, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{The geometric object to use to display the data for this layer. When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument can be used to override the default coupling between stats and geoms. The \code{geom} argument accepts the following: \itemize{ \item A \code{Geom} ggproto subclass, for example \code{GeomPoint}. \item A string naming the geom. To give the geom as a string, strip the function name of the \code{geom_} prefix. For example, to use \code{geom_point()}, give the geom as \code{"point"}. \item For more information and other ways to specify the geom, see the \link[ggplot2:layer_geoms]{layer geom} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{n}{The number of points to sample along the ellipse.} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \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{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} } \description{ This is a generalisation of \code{\link[=geom_circle]{geom_circle()}} that allows you to draw ellipses at a specified angle and center relative to the coordinate system. Apart from letting you draw regular ellipsis, the stat is using the generalised formula for superellipses which can be utilised by setting the \code{m1} and \code{m2} aesthetics. If you only set the m1 the m2 value will follow that to ensure a symmetric appearance. } \section{Aesthetics}{ geom_arc understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x0} \item \strong{y0} \item \strong{a} \item \strong{b} \item \strong{angle} \item m1 \item m2 \item color \item fill \item linewidth \item linetype \item alpha \item lineend } } \section{Computed variables}{ \describe{ \item{x, y}{The coordinates for the points along the ellipse} } } \examples{ # Basic usage ggplot() + geom_ellipse(aes(x0 = 0, y0 = 0, a = 10, b = 3, angle = 0)) + coord_fixed() # Rotation # Note that it expects radians and rotates the ellipse counter-clockwise ggplot() + geom_ellipse(aes(x0 = 0, y0 = 0, a = 10, b = 3, angle = pi / 4)) + coord_fixed() # Draw a super ellipse ggplot() + geom_ellipse(aes(x0 = 0, y0 = 0, a = 6, b = 3, angle = -pi / 3, m1 = 3)) + coord_fixed() } ggforce/man/geom_bspline_closed.Rd0000644000176200001440000001760615024476446016752 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bspline_closed.R \name{geom_bspline_closed} \alias{geom_bspline_closed} \alias{stat_bspline_closed} \alias{geom_bspline_closed0} \title{Create closed b-spline shapes} \usage{ stat_bspline_closed( mapping = NULL, data = NULL, geom = "shape", position = "identity", na.rm = FALSE, n = 100, show.legend = NA, inherit.aes = TRUE, ... ) geom_bspline_closed( mapping = NULL, data = NULL, stat = "bspline", position = "identity", n = 100, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) geom_bspline_closed0( mapping = NULL, data = NULL, stat = "identity", position = "identity", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{The geometric object to use to display the data for this layer. When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument can be used to override the default coupling between stats and geoms. The \code{geom} argument accepts the following: \itemize{ \item A \code{Geom} ggproto subclass, for example \code{GeomPoint}. \item A string naming the geom. To give the geom as a string, strip the function name of the \code{geom_} prefix. For example, to use \code{geom_point()}, give the geom as \code{"point"}. \item For more information and other ways to specify the geom, see the \link[ggplot2:layer_geoms]{layer geom} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \item{n}{The number of points generated for each spline} \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{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} } \description{ This geom creates closed b-spline curves and draws them as shapes. The closed b-spline is achieved by wrapping the control points rather than the knots. The *0 version uses the \code{\link[grid:grid.xspline]{grid::xsplineGrob()}} function with \code{open = FALSE} and can thus not be manipulated as a shape geom in the same way as the base version (expand, contract, etc). } \section{Aesthetics}{ geom_bspline_closed understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x} \item \strong{y} \item color \item fill \item linewidth \item linetype \item alpha } } \section{Computed variables}{ \describe{ \item{x, y}{The coordinates for the path describing the spline} \item{index}{The progression along the interpolation mapped between 0 and 1} } } \examples{ # Create 6 random control points controls <- data.frame( x = runif(6), y = runif(6) ) ggplot(controls, aes(x, y)) + geom_polygon(fill = NA, colour = 'grey') + geom_point(colour = 'red') + geom_bspline_closed(alpha = 0.5) # The 0 version approximates the correct shape ggplot(controls, aes(x, y)) + geom_polygon(fill = NA, colour = 'grey') + geom_point(colour = 'red') + geom_bspline_closed0(alpha = 0.5) # But only the standard version supports geom_shape operations # Be aware of self-intersections though ggplot(controls, aes(x, y)) + geom_polygon(fill = NA, colour = 'grey') + geom_point(colour = 'red') + geom_bspline_closed(alpha = 0.5, expand = unit(2, 'cm')) } \author{ Thomas Lin Pedersen. The C++ code for De Boor's algorithm has been adapted from \href{https://chi3x10.wordpress.com/2009/10/18/de-boor-algorithm-in-c/}{Jason Yu-Tseh Chi implementation} } ggforce/man/gather_set_data.Rd0000644000176200001440000000140314672274110016050 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parallel_sets.R \name{gather_set_data} \alias{gather_set_data} \title{Tidy data for use with geom_parallel_sets} \usage{ gather_set_data(data, x, id_name = "id") } \arguments{ \item{data}{A tidy dataframe with some categorical columns} \item{x}{The columns to use for axes in the parallel sets diagram} \item{id_name}{The name of the column that will contain the original index of the row.} } \value{ A data.frame } \description{ This helper function makes it easy to change tidy data into a tidy(er) format that can be used by geom_parallel_sets. } \examples{ data <- reshape2::melt(Titanic) head(gather_set_data(data, 1:4)) head(gather_set_data(data, c("Class","Sex","Age","Survived"))) } ggforce/man/geom_diagonal.Rd0000644000176200001440000002461415024476446015540 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/diagonal.R \name{geom_diagonal} \alias{geom_diagonal} \alias{stat_diagonal} \alias{stat_diagonal2} \alias{geom_diagonal2} \alias{stat_diagonal0} \alias{geom_diagonal0} \title{Draw horizontal diagonals} \usage{ stat_diagonal( mapping = NULL, data = NULL, geom = "path", position = "identity", n = 100, strength = 0.5, na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, ... ) geom_diagonal( mapping = NULL, data = NULL, stat = "diagonal", position = "identity", n = 100, na.rm = FALSE, orientation = NA, strength = 0.5, show.legend = NA, inherit.aes = TRUE, ... ) stat_diagonal2( mapping = NULL, data = NULL, geom = "path_interpolate", position = "identity", na.rm = FALSE, orientation = NA, show.legend = NA, n = 100, strength = 0.5, inherit.aes = TRUE, ... ) geom_diagonal2( mapping = NULL, data = NULL, stat = "diagonal2", position = "identity", arrow = NULL, lineend = "butt", na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, n = 100, strength = 0.5, ... ) stat_diagonal0( mapping = NULL, data = NULL, geom = "bezier0", position = "identity", na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, strength = 0.5, ... ) geom_diagonal0( mapping = NULL, data = NULL, stat = "diagonal0", position = "identity", arrow = NULL, lineend = "butt", na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, strength = 0.5, ... ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{The geometric object to use to display the data for this layer. When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument can be used to override the default coupling between stats and geoms. The \code{geom} argument accepts the following: \itemize{ \item A \code{Geom} ggproto subclass, for example \code{GeomPoint}. \item A string naming the geom. To give the geom as a string, strip the function name of the \code{geom_} prefix. For example, to use \code{geom_point()}, give the geom as \code{"point"}. \item For more information and other ways to specify the geom, see the \link[ggplot2:layer_geoms]{layer geom} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{n}{The number of points to create for each segment} \item{strength}{The proportion to move the control point along the x-axis towards the other end of the bezier curve} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \item{orientation}{The orientation of the layer. The default (\code{NA}) automatically determines the orientation from the aesthetic mapping. In the rare event that this fails it can be given explicitly by setting \code{orientation} to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} \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{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} \item{arrow}{Arrow specification, as created by \code{\link[grid:arrow]{grid::arrow()}}.} \item{lineend}{Line end style (round, butt, square).} } \description{ A diagonal is a bezier curve where the control points are moved perpendicularly towards the center in either the x or y direction a fixed amount. The versions provided here calculates horizontal diagonals meaning that the x coordinate is moved to achieve the control point. The \code{geom_diagonal()} and \code{stat_diagonal()} functions are simply helpers that takes care of calculating the position of the control points and then forwards the actual bezier calculations to \code{\link[=geom_bezier]{geom_bezier()}}. } \section{Aesthetics}{ geom_diagonal and geom_diagonal0 understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x} \item \strong{y} \item \strong{xend} \item \strong{yend} \item color \item linewidth \item linetype \item alpha \item lineend } geom_diagonal2 understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x} \item \strong{y} \item \strong{group} \item color \item linewidth \item linetype \item alpha \item lineend } } \section{Computed variables}{ \describe{ \item{x, y}{The interpolated point coordinates} \item{index}{The progression along the interpolation mapped between 0 and 1} } } \section{Orientation}{ This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce from a combination of the given mappings and the types of positional scales in use. Thus, ggplot2 will by default try to guess which orientation the layer should have. Under rare circumstances, the orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. } \examples{ data <- data.frame( x = rep(0, 10), y = 1:10, xend = 1:10, yend = 2:11 ) ggplot(data) + geom_diagonal(aes(x, y, xend = xend, yend = yend)) # The standard version provides an index to create gradients ggplot(data) + geom_diagonal(aes(x, y, xend = xend, yend = yend, alpha = after_stat(index))) # The 0 version uses bezierGrob under the hood for an approximation ggplot(data) + geom_diagonal0(aes(x, y, xend = xend, yend = yend)) # The 2 version allows you to interpolate between endpoint aesthetics data2 <- data.frame( x = c(data$x, data$xend), y = c(data$y, data$yend), group = rep(1:10, 2), colour = sample(letters[1:5], 20, TRUE) ) ggplot(data2) + geom_diagonal2(aes(x, y, group = group, colour = colour)) # Use strength to control the steepness of the central region ggplot(data, aes(x, y, xend = xend, yend = yend)) + geom_diagonal(strength = 0.75, colour = 'red') + geom_diagonal(strength = 0.25, colour = 'blue') } ggforce/man/geom_link.Rd0000644000176200001440000002214415024476446014713 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/link.R \name{geom_link} \alias{geom_link} \alias{stat_link} \alias{stat_link2} \alias{geom_link2} \alias{geom_link0} \title{Link points with paths} \usage{ stat_link( mapping = NULL, data = NULL, geom = "path", position = "identity", na.rm = FALSE, show.legend = NA, n = 100, inherit.aes = TRUE, ... ) stat_link2( mapping = NULL, data = NULL, geom = "path_interpolate", position = "identity", na.rm = FALSE, show.legend = NA, n = 100, inherit.aes = TRUE, ... ) geom_link( mapping = NULL, data = NULL, stat = "link", position = "identity", arrow = NULL, lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, n = 100, ... ) geom_link2( mapping = NULL, data = NULL, stat = "link2", position = "identity", arrow = NULL, lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, n = 100, ... ) geom_link0( mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., arrow = NULL, arrow.fill = NULL, lineend = "butt", linejoin = "round", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{The geometric object to use to display the data for this layer. When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument can be used to override the default coupling between stats and geoms. The \code{geom} argument accepts the following: \itemize{ \item A \code{Geom} ggproto subclass, for example \code{GeomPoint}. \item A string naming the geom. To give the geom as a string, strip the function name of the \code{geom_} prefix. For example, to use \code{geom_point()}, give the geom as \code{"point"}. \item For more information and other ways to specify the geom, see the \link[ggplot2:layer_geoms]{layer geom} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \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{n}{The number of points to create for each segment} \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{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} \item{arrow}{Arrow specification, as created by \code{\link[grid:arrow]{grid::arrow()}}.} \item{lineend}{Line end style (round, butt, square).} \item{arrow.fill}{fill colour to use for the arrow head (if closed). \code{NULL} means use \code{colour} aesthetic.} \item{linejoin}{Line join style (round, mitre, bevel).} } \description{ This set of geoms makes it possible to connect points using straight lines. Before you think \code{\link[ggplot2:geom_segment]{ggplot2::geom_segment()}} and \code{\link[ggplot2:geom_path]{ggplot2::geom_path()}}, these functions have some additional tricks up their sleeves. geom_link connects two points in the same way as \code{\link[ggplot2:geom_segment]{ggplot2::geom_segment()}} but does so by interpolating multiple points between the two. An additional column called index is added to the data with a sequential progression of the interpolated points. This can be used to map color or size to the direction of the link. geom_link2 uses the same syntax as \code{\link[ggplot2:geom_path]{ggplot2::geom_path()}} but interpolates between the aesthetics given by each row in the data. } \section{Aesthetics}{ geom_link understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x} \item \strong{y} \item \strong{xend} \item \strong{yend} \item color \item size \item linetype \item alpha \item lineend } geom_link2 understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x} \item \strong{y} \item color \item size \item linetype \item alpha \item lineend } } \section{Computed variables}{ \describe{ \item{x, y}{The interpolated point coordinates} \item{index}{The progression along the interpolation mapped between 0 and 1} } } \examples{ # Lets make some data lines <- data.frame( x = c(5, 12, 15, 9, 6), y = c(17, 20, 4, 15, 5), xend = c(19, 17, 2, 9, 5), yend = c(10, 18, 7, 12, 1), width = c(1, 10, 6, 2, 3), colour = letters[1:5] ) ggplot(lines) + geom_link(aes(x = x, y = y, xend = xend, yend = yend, colour = colour, alpha = stat(index), size = after_stat(index))) ggplot(lines) + geom_link2(aes(x = x, y = y, colour = colour, size = width, group = 1), lineend = 'round', n = 500) # geom_link0 is simply an alias for geom_segment to put the link geoms in # line with the other line geoms with multiple versions. `index` is not # available here ggplot(lines) + geom_link0(aes(x = x, y = y, xend = xend, yend = yend, colour = colour)) } ggforce/man/geom_parallel_sets.Rd0000644000176200001440000002446515024476446016620 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parallel_sets.R \name{geom_parallel_sets} \alias{geom_parallel_sets} \alias{stat_parallel_sets} \alias{stat_parallel_sets_axes} \alias{geom_parallel_sets_axes} \alias{geom_parallel_sets_labels} \title{Create Parallel Sets diagrams} \usage{ stat_parallel_sets( mapping = NULL, data = NULL, geom = "shape", position = "identity", n = 100, strength = 0.5, sep = 0.05, axis.width = 0, na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, ... ) geom_parallel_sets( mapping = NULL, data = NULL, stat = "parallel_sets", position = "identity", n = 100, na.rm = FALSE, orientation = NA, sep = 0.05, strength = 0.5, axis.width = 0, show.legend = NA, inherit.aes = TRUE, ... ) stat_parallel_sets_axes( mapping = NULL, data = NULL, geom = "parallel_sets_axes", position = "identity", sep = 0.05, axis.width = 0, na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, ... ) geom_parallel_sets_axes( mapping = NULL, data = NULL, stat = "parallel_sets_axes", position = "identity", na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, ... ) geom_parallel_sets_labels( mapping = NULL, data = NULL, stat = "parallel_sets_axes", angle = -90, nudge_x = 0, nudge_y = 0, position = "identity", na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, ... ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{The geometric object to use to display the data for this layer. When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument can be used to override the default coupling between stats and geoms. The \code{geom} argument accepts the following: \itemize{ \item A \code{Geom} ggproto subclass, for example \code{GeomPoint}. \item A string naming the geom. To give the geom as a string, strip the function name of the \code{geom_} prefix. For example, to use \code{geom_point()}, give the geom as \code{"point"}. \item For more information and other ways to specify the geom, see the \link[ggplot2:layer_geoms]{layer geom} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{n}{The number of points to create for each of the bounding diagonals} \item{strength}{The proportion to move the control point along the x-axis towards the other end of the bezier curve} \item{sep}{The proportional separation between categories within a variable} \item{axis.width}{The width of the area around each variable axis} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \item{orientation}{The orientation of the layer. The default (\code{NA}) automatically determines the orientation from the aesthetic mapping. In the rare event that this fails it can be given explicitly by setting \code{orientation} to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} \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{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} \item{angle}{The angle of the axis label text} \item{nudge_x, nudge_y}{Horizontal and vertical adjustment to nudge labels by. Useful for offsetting text from the category segments.} } \description{ A parallel sets diagram is a type of visualisation showing the interaction between multiple categorical variables. If the variables has an intrinsic order the representation can be thought of as a Sankey Diagram. If each variable is a point in time it will resemble an alluvial diagram. } \details{ In a parallel sets visualization each categorical variable will be assigned a position on the x-axis. The size of the intersection of categories from neighboring variables are then shown as thick diagonals, scaled by the sum of elements shared between the two categories. The natural data representation for such as plot is to have each categorical variable in a separate column and then have a column giving the amount/magnitude of the combination of levels in the row. This representation is unfortunately not fitting for the \code{ggplot2} API which needs every position encoding in the same column. To make it easier to work with \code{ggforce} provides a helper \code{\link[=gather_set_data]{gather_set_data()}}, which takes care of the transformation. } \section{Aesthetics}{ geom_parallel_sets understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x|y} \item \strong{id} \item \strong{split} \item \strong{value} \item color \item fill \item size \item linetype \item alpha \item lineend } } \section{Orientation}{ This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce from a combination of the given mappings and the types of positional scales in use. Thus, ggplot2 will by default try to guess which orientation the layer should have. Under rare circumstances, the orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. } \examples{ data <- reshape2::melt(Titanic) data <- gather_set_data(data, 1:4) ggplot(data, aes(x, id = id, split = y, value = value)) + geom_parallel_sets(aes(fill = Sex), alpha = 0.3, axis.width = 0.1) + geom_parallel_sets_axes(axis.width = 0.1) + geom_parallel_sets_labels(colour = 'white') # Use nudge_x to offset and hjust = 0 to left-justify label ggplot(data, aes(x, id = id, split = y, value = value)) + geom_parallel_sets(aes(fill = Sex), alpha = 0.3, axis.width = 0.1) + geom_parallel_sets_axes(axis.width = 0.1) + geom_parallel_sets_labels(colour = 'red', angle = 0, nudge_x = 0.1, hjust = 0) } \author{ Thomas Lin Pedersen } ggforce/man/ggforce-extensions.Rd0000644000176200001440000000436614672274110016556 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/shape.R, R/arc_bar.R, R/arc.R, R/autodensity.R, % R/autohistogram.R, R/bezier.R, R/bspline.R, R/bspline_closed.R, % R/circle.R, R/diagonal.R, R/diagonal_wide.R, R/ellipse.R, R/errorbar.R, % R/facet_grid_paginate.R, R/facet_matrix.R, R/facet_row.R, R/facet_stereo.R, % R/facet_wrap_paginate.R, R/facet_zoom.R, R/ggproto-classes.R, % R/interpolate.R, R/link.R, R/mark_circle.R, R/mark_ellipse.R, % R/mark_hull.R, R/mark_rect.R, R/parallel_sets.R, R/position-jitternormal.R, % R/position_auto.R, R/position_floatstack.R, R/regon.R, R/sina.R, R/spiro.R, % R/voronoi.R \docType{data} \name{GeomShape} \alias{GeomShape} \alias{StatArcBar} \alias{StatPie} \alias{GeomArcBar} \alias{StatArc} \alias{GeomArc} \alias{StatArc2} \alias{StatArc0} \alias{GeomArc0} \alias{StatAutodensity} \alias{GeomAutoarea} \alias{StatAutobin} \alias{GeomAutorect} \alias{StatBezier} \alias{StatBezier2} \alias{StatBezier0} \alias{GeomBezier0} \alias{StatBspline} \alias{StatBspline2} \alias{GeomBspline0} \alias{GeomBsplineClosed0} \alias{StatCircle} \alias{GeomCircle} \alias{StatDiagonal} \alias{StatDiagonal2} \alias{StatDiagonal0} \alias{StatDiagonalWide} \alias{StatEllip} \alias{StatErr} \alias{FacetGridPaginate} \alias{FacetMatrix} \alias{FacetRow} \alias{FacetCol} \alias{FacetStereo} \alias{FacetWrapPaginate} \alias{FacetZoom} \alias{ggforce-extensions} \alias{GeomPathInterpolate} \alias{StatLink} \alias{StatLink2} \alias{GeomMarkCircle} \alias{GeomMarkEllipse} \alias{GeomMarkHull} \alias{GeomMarkRect} \alias{StatParallelSets} \alias{StatParallelSetsAxes} \alias{GeomParallelSetsAxes} \alias{PositionJitterNormal} \alias{PositionAuto} \alias{PositionFloatstack} \alias{StatRegon} \alias{StatSina} \alias{StatSpiro} \alias{StatVoronoiTile} \alias{StatVoronoiSegment} \alias{StatDelaunayTile} \alias{StatDelaunaySegment} \alias{StatDelaunaySegment2} \alias{StatDelvorSummary} \title{ggforce extensions to ggplot2} \description{ ggforce makes heavy use of the ggproto class system to extend the functionality of ggplot2. In general the actual classes should be of little interest to users as the standard ggplot2 api of using geom_* and stat_* functions for building up the plot is encouraged. } \keyword{datasets} ggforce/man/geom_bezier.Rd0000644000176200001440000002363015024476446015237 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bezier.R \name{geom_bezier} \alias{geom_bezier} \alias{stat_bezier} \alias{stat_bezier2} \alias{geom_bezier2} \alias{stat_bezier0} \alias{geom_bezier0} \title{Create quadratic or cubic bezier curves} \usage{ stat_bezier( mapping = NULL, data = NULL, geom = "path", position = "identity", na.rm = FALSE, show.legend = NA, n = 100, inherit.aes = TRUE, ... ) geom_bezier( mapping = NULL, data = NULL, stat = "bezier", position = "identity", arrow = NULL, lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, n = 100, ... ) stat_bezier2( mapping = NULL, data = NULL, geom = "path_interpolate", position = "identity", na.rm = FALSE, show.legend = NA, n = 100, inherit.aes = TRUE, ... ) geom_bezier2( mapping = NULL, data = NULL, stat = "bezier2", position = "identity", arrow = NULL, lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, n = 100, ... ) stat_bezier0( mapping = NULL, data = NULL, geom = "bezier0", position = "identity", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) geom_bezier0( mapping = NULL, data = NULL, stat = "bezier0", position = "identity", arrow = NULL, lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{The geometric object to use to display the data for this layer. When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument can be used to override the default coupling between stats and geoms. The \code{geom} argument accepts the following: \itemize{ \item A \code{Geom} ggproto subclass, for example \code{GeomPoint}. \item A string naming the geom. To give the geom as a string, strip the function name of the \code{geom_} prefix. For example, to use \code{geom_point()}, give the geom as \code{"point"}. \item For more information and other ways to specify the geom, see the \link[ggplot2:layer_geoms]{layer geom} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \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{n}{The number of points to create for each segment} \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{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} \item{arrow}{Arrow specification, as created by \code{\link[grid:arrow]{grid::arrow()}}.} \item{lineend}{Line end style (round, butt, square).} } \description{ This set of geoms makes it possible to connect points creating either quadratic or cubic beziers. bezier and bezier2 both work by calculating points along the bezier and connecting these to draw the curve. bezier0 directly draws the bezier using bezierGrob. In line with the \code{\link[=geom_link]{geom_link()}} and \code{\link[=geom_link2]{geom_link2()}} differences geom_bezier creates the points, assign an index to each interpolated point and repeat the aesthetics for the start point, while geom_bezier2 interpolates the aesthetics between the start and end points. } \details{ Input data is understood as a sequence of data points the first being the start point, then followed by one or two control points and then the end point. More than 4 and less than 3 points per group will throw an error. \code{\link[grid:grid.bezier]{grid::bezierGrob()}} only takes cubic beziers so if three points are supplied the middle one as duplicated. This, along with the fact that \code{\link[grid:grid.bezier]{grid::bezierGrob()}} estimates the curve using an x-spline means that the curves produced by geom_bezier and geom_bezier2 deviates from those produced by geom_bezier0. If you want true bezier paths use geom_bezier or geom_bezier2. } \section{Aesthetics}{ geom_bezier, geom_bezier2 and geom_bezier0 understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x} \item \strong{y} \item color \item linewidth \item linetype \item alpha \item lineend } } \section{Computed variables}{ \describe{ \item{x, y}{The interpolated point coordinates} \item{index}{The progression along the interpolation mapped between 0 and 1} } } \examples{ beziers <- data.frame( x = c(1, 2, 3, 4, 4, 6, 6), y = c(0, 2, 0, 0, 2, 2, 0), type = rep(c('cubic', 'quadratic'), c(3, 4)), point = c('end', 'control', 'end', 'end', 'control', 'control', 'end'), colour = letters[1:7] ) help_lines <- data.frame( x = c(1, 3, 4, 6), xend = c(2, 2, 4, 6), y = 0, yend = 2 ) # See how control points affect the bezier ggplot() + geom_segment(aes(x = x, xend = xend, y = y, yend = yend), data = help_lines, arrow = arrow(length = unit(c(0, 0, 0.5, 0.5), 'cm')), colour = 'grey') + geom_bezier(aes(x = x, y = y, group = type, linetype = type), data = beziers) + geom_point(aes(x = x, y = y, colour = point), data = beziers) # geom_bezier0 is less exact ggplot() + geom_segment(aes(x = x, xend = xend, y = y, yend = yend), data = help_lines, arrow = arrow(length = unit(c(0, 0, 0.5, 0.5), 'cm')), colour = 'grey') + geom_bezier0(aes(x = x, y = y, group = type, linetype = type), data = beziers) + geom_point(aes(x = x, y = y, colour = point), data = beziers) # Use geom_bezier2 to interpolate between endpoint aesthetics ggplot(beziers) + geom_bezier2(aes(x = x, y = y, group = type, colour = colour)) } ggforce/man/facet_grid_paginate.Rd0000644000176200001440000001043214672274110016673 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/facet_grid_paginate.R \name{facet_grid_paginate} \alias{facet_grid_paginate} \title{Split facet_grid over multiple plots} \usage{ facet_grid_paginate( facets, margins = FALSE, scales = "fixed", space = "fixed", shrink = TRUE, labeller = "label_value", as.table = TRUE, switch = NULL, drop = TRUE, ncol = NULL, nrow = NULL, page = 1, byrow = TRUE ) } \arguments{ \item{facets}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use \code{rows} and \code{cols} instead.} \item{margins}{Either a logical value or a character vector. Margins are additional facets which contain all the data for each of the possible values of the faceting variables. If \code{FALSE}, no additional facets are included (the default). If \code{TRUE}, margins are included for all faceting variables. If specified as a character vector, it is the names of variables for which margins are to be created.} \item{scales}{Are scales shared across all facets (the default, \code{"fixed"}), or do they vary across rows (\code{"free_x"}), columns (\code{"free_y"}), or both rows and columns (\code{"free"})?} \item{space}{If \code{"fixed"}, the default, all panels have the same size. If \code{"free_y"} their height will be proportional to the length of the y scale; if \code{"free_x"} their width will be proportional to the length of the x scale; or if \code{"free"} both height and width will vary. This setting has no effect unless the appropriate scales also vary.} \item{shrink}{If \code{TRUE}, will shrink scales to fit output of statistics, not raw data. If \code{FALSE}, will be range of raw data before statistical summary.} \item{labeller}{A function that takes one data frame of labels and returns a list or data frame of character vectors. Each input column corresponds to one factor. Thus there will be more than one with \code{vars(cyl, am)}. Each output column gets displayed as one separate line in the strip label. This function should inherit from the "labeller" S3 class for compatibility with \code{\link[ggplot2:labeller]{labeller()}}. You can use different labeling functions for different kind of labels, for example use \code{\link[ggplot2:label_parsed]{label_parsed()}} for formatting facet labels. \code{\link[ggplot2:label_value]{label_value()}} is used by default, check it for more details and pointers to other options.} \item{as.table}{If \code{TRUE}, the default, the facets are laid out like a table with highest values at the bottom-right. If \code{FALSE}, the facets are laid out like a plot with the highest value at the top-right.} \item{switch}{By default, the labels are displayed on the top and right of the plot. If \code{"x"}, the top labels will be displayed to the bottom. If \code{"y"}, the right-hand side labels will be displayed to the left. Can also be set to \code{"both"}.} \item{drop}{If \code{TRUE}, the default, all factor levels not used in the data will automatically be dropped. If \code{FALSE}, all factor levels will be shown, regardless of whether or not they appear in the data.} \item{ncol}{Number of columns per page} \item{nrow}{Number of rows per page} \item{page}{The page to draw} \item{byrow}{Should the pages be created row-wise or column wise} } \description{ This extension to \code{\link[ggplot2:facet_grid]{ggplot2::facet_grid()}} will allow you to split a facetted plot over multiple pages. You define a number of rows and columns per page as well as the page number to plot, and the function will automatically only plot the correct panels. Usually this will be put in a loop to render all pages one by one. } \note{ If either \code{ncol} or \code{nrow} is \code{NULL} this function will fall back to the standard \code{facet_grid} functionality. } \examples{ # Draw a small section of the grid ggplot(diamonds) + geom_point(aes(carat, price), alpha = 0.1) + facet_grid_paginate(color ~ cut:clarity, ncol = 3, nrow = 3, page = 4) } \seealso{ \code{\link[=n_pages]{n_pages()}} to compute the total number of pages in a paginated faceted plot Other ggforce facets: \code{\link{facet_stereo}()}, \code{\link{facet_wrap_paginate}()}, \code{\link{facet_zoom}()} } \concept{ggforce facets} ggforce/man/label_tex.Rd0000644000176200001440000000211114672274110014666 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/labeller.R \name{label_tex} \alias{label_tex} \title{A labeller function to parse TeX syntax} \usage{ label_tex(labels, ...) } \arguments{ \item{labels}{Data frame of labels. Usually contains only one element, but faceting over multiple factors entails multiple label variables.} \item{...}{ Arguments passed on to \code{\link[ggplot2:labellers]{ggplot2::label_parsed}} \describe{ \item{\code{multi_line}}{Whether to display the labels of multiple factors on separate lines.} }} } \description{ This function formats the strip labels of facet grids and wraps that contains TeX expressions. The latex2exp package must be installed. } \examples{ # requires latex2exp package be installed if (requireNamespace("latex2exp", quietly = TRUE)) { library(ggplot2) d <- data.frame(x = 1, y = 1, facet = "$\\\\beta$") ggplot(d, aes(x, y)) + geom_point() + facet_wrap(~ facet, labeller = label_tex) } } \seealso{ \link[ggplot2:labeller]{ggplot2::labeller}, \code{\link[latex2exp:TeX]{latex2exp::TeX()}} } ggforce/man/geom_mark_circle.Rd0000644000176200001440000003072215024476446016232 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mark_circle.R \name{geom_mark_circle} \alias{geom_mark_circle} \title{Annotate areas with circles} \usage{ geom_mark_circle( mapping = NULL, data = NULL, stat = "identity", position = "identity", expand = unit(5, "mm"), radius = expand, n = 100, label.margin = margin(2, 2, 2, 2, "mm"), label.width = NULL, label.minwidth = unit(50, "mm"), label.hjust = 0, label.fontsize = 12, label.family = "", label.lineheight = 1, label.fontface = c("bold", "plain"), label.fill = "white", label.colour = "black", label.buffer = unit(10, "mm"), con.colour = "black", con.size = 0.5, con.type = "elbow", con.linetype = 1, con.border = "one", con.cap = unit(3, "mm"), con.arrow = NULL, ..., na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{expand}{A numeric or unit vector of length one, specifying the expansion amount. Negative values will result in contraction instead. If the value is given as a numeric it will be understood as a proportion of the plot area width.} \item{radius}{As \code{expand} but specifying the corner radius.} \item{n}{The number of points used to draw each circle. Defaults to \code{100}.} \item{label.margin}{The margin around the annotation boxes, given by a call to \code{\link[ggplot2:element]{ggplot2::margin()}}.} \item{label.width}{A fixed width for the label. Set to \code{NULL} to let the text or \code{label.minwidth} decide.} \item{label.minwidth}{The minimum width to provide for the description. If the size of the label exceeds this, the description is allowed to fill as much as the label.} \item{label.hjust}{The horizontal justification for the annotation. If it contains two elements the first will be used for the label and the second for the description.} \item{label.fontsize}{The size of the text for the annotation. If it contains two elements the first will be used for the label and the second for the description.} \item{label.family}{The font family used for the annotation. If it contains two elements the first will be used for the label and the second for the description.} \item{label.lineheight}{The height of a line as a multipler of the fontsize. If it contains two elements the first will be used for the label and the second for the description.} \item{label.fontface}{The font face used for the annotation. If it contains two elements the first will be used for the label and the second for the description.} \item{label.fill}{The fill colour for the annotation box. Use \code{"inherit"} to use the fill from the enclosure or \code{"inherit_col"} to use the border colour of the enclosure.} \item{label.colour}{The text colour for the annotation. If it contains two elements the first will be used for the label and the second for the description. Use \code{"inherit"} to use the border colour of the enclosure or \code{"inherit_fill"} to use the fill colour from the enclosure.} \item{label.buffer}{The size of the region around the mark where labels cannot be placed.} \item{con.colour}{The colour for the line connecting the annotation to the mark. Use \code{"inherit"} to use the border colour of the enclosure or \code{"inherit_fill"} to use the fill colour from the enclosure.} \item{con.size}{The width of the connector. Use \code{"inherit"} to use the border width of the enclosure.} \item{con.type}{The type of the connector. Either \code{"elbow"}, \code{"straight"}, or \code{"none"}.} \item{con.linetype}{The linetype of the connector. Use \code{"inherit"} to use the border linetype of the enclosure.} \item{con.border}{The bordertype of the connector. Either \code{"one"} (to draw a line on the horizontal side closest to the mark), \code{"all"} (to draw a border on all sides), or \code{"none"} (not going to explain that one).} \item{con.cap}{The distance before the mark that the line should stop at.} \item{con.arrow}{An arrow specification for the connection using \code{\link[grid:arrow]{grid::arrow()}} for the end pointing towards the mark.} \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \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()}}.} } \description{ This geom lets you annotate sets of points via circles. The enclosing circles are calculated at draw time and the most optimal enclosure at the given aspect ratio is thus guaranteed. As with the other \verb{geom_mark_*} geoms the enclosure inherits from \code{\link[=geom_shape]{geom_shape()}} and defaults to be expanded slightly to better enclose the points. } \section{Annotation}{ All \verb{geom_mark_*} allow you to put descriptive textboxes connected to the mark on the plot, using the \code{label} and \code{description} aesthetics. The textboxes are automatically placed close to the mark, but without obscuring any of the datapoints in the layer. The placement is dynamic so if you resize the plot you'll see that the annotation might move around as areas become big enough or too small to fit the annotation. If there's not enough space for the annotation without overlapping data it will not get drawn. In these cases try resizing the plot, change the size of the annotation, or decrease the buffer region around the marks. } \section{Filtering}{ Often marks are used to draw attention to, or annotate specific features of the plot and it is thus not desirable to have marks around everything. While it is possible to simply pre-filter the data used for the mark layer, the \verb{geom_mark_*} geoms also comes with a dedicated \code{filter} aesthetic that, if set, will remove all rows where it evalutates to \code{FALSE}. There are multiple benefits of using this instead of prefiltering. First, you don't have to change your data source, making your code more adaptable for exploration. Second, the data removed by the filter aesthetic is remembered by the geom, and any annotation will take care not to overlap with the removed data. } \section{Aesthetics}{ geom_mark_circle understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x} \item \strong{y} \item x0 \emph{(used to anchor the label)} \item y0 \emph{(used to anchor the label)} \item filter \item label \item description \item color \item fill \item group \item size \item linetype \item alpha } } \examples{ ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_circle(aes(fill = Species, filter = Species != 'versicolor')) + geom_point() # Add annotation ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_circle(aes(fill = Species, label = Species)) + geom_point() # Long descriptions are automatically wrapped to fit into the width iris$desc <- c( 'A super Iris - and it knows it', 'Pretty mediocre Iris, but give it a couple of years and it might surprise you', "You'll never guess what this Iris does every Sunday" )[iris$Species] ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_circle(aes(fill = Species, label = Species, description = desc, filter = Species == 'setosa')) + geom_point() # Change the buffer size to move labels farther away (or closer) from the # marks ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_circle(aes(fill = Species, label = Species), label.buffer = unit(30, 'mm')) + geom_point() # The connector is capped a bit before it reaches the mark, but this can be # controlled ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_circle(aes(fill = Species, label = Species), con.cap = 0) + geom_point() # If you want to use the scaled colours for the labels or connectors you can # use the "inherit" keyword instead ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_circle(aes(fill = Species, label = Species), label.fill = "inherit") + geom_point() } \seealso{ Other mark geoms: \code{\link{geom_mark_ellipse}()}, \code{\link{geom_mark_hull}()}, \code{\link{geom_mark_rect}()} } \concept{mark geoms} ggforce/man/geom_shape.Rd0000644000176200001440000001601615024476446015057 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/shape.R \name{geom_shape} \alias{geom_shape} \title{Draw polygons with expansion/contraction and/or rounded corners} \usage{ geom_shape( mapping = NULL, data = NULL, stat = "identity", position = "identity", expand = 0, radius = 0, ..., na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{expand}{A numeric or unit vector of length one, specifying the expansion amount. Negative values will result in contraction instead. If the value is given as a numeric it will be understood as a proportion of the plot area width.} \item{radius}{As \code{expand} but specifying the corner radius.} \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \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()}}.} } \description{ This geom is a cousin of \code{\link[ggplot2:geom_polygon]{ggplot2::geom_polygon()}} with the added possibility of expanding or contracting the polygon by an absolute amount (e.g. 1 cm). Furthermore, it is possible to round the corners of the polygon, again by an absolute amount. The resulting geom reacts to resizing of the plot, so the expansion/contraction and corner radius will not get distorted. If no expansion/contraction or corner radius is specified, the geom falls back to \code{geom_polygon} so there is no performance penality in using this instead of \code{geom_polygon}. } \note{ Some settings can result in the dissappearance of polygons, specifically when contracting or rounding corners with a relatively large amount. Also note that x and y scale limits does not take expansion into account and the resulting polygon might thus not fit into the plot. } \section{Aesthetics}{ geom_shape understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x} \item \strong{y} \item color \item fill \item group \item size \item linetype \item alpha } } \examples{ shape <- data.frame( x = c(0.5, 1, 0.75, 0.25, 0), y = c(0, 0.5, 1, 0.75, 0.25) ) # Expand and round ggplot(shape, aes(x = x, y = y)) + geom_shape(expand = unit(1, 'cm'), radius = unit(0.5, 'cm')) + geom_polygon(fill = 'red') # Contract ggplot(shape, aes(x = x, y = y)) + geom_polygon(fill = 'red') + geom_shape(expand = unit(-1, 'cm')) # Only round corners ggplot(shape, aes(x = x, y = y)) + geom_polygon(fill = 'red') + geom_shape(radius = unit(1, 'cm')) } \author{ Thomas Lin Pedersen } ggforce/man/geom_autopoint.Rd0000644000176200001440000001373115024476446016002 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/autopoint.R \name{geom_autopoint} \alias{geom_autopoint} \title{A point geom specialised for scatterplot matrices} \usage{ geom_autopoint( mapping = NULL, data = NULL, stat = "identity", position = "auto", ..., na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \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()}}.} } \description{ This geom is a specialisation of \code{\link[ggplot2:geom_point]{ggplot2::geom_point()}} with two changes. It defaults to mapping \code{x} and \code{y} to \code{.panel_x} and \code{.panel_y} respectively, and it defaults to using \code{\link[=position_auto]{position_auto()}} to jitter the points based on the combination of position scale types. } \examples{ # Continuous vs continuous: No jitter ggplot(mpg) + geom_autopoint(aes(cty, hwy)) # Continuous vs discrete: sina jitter ggplot(mpg) + geom_autopoint(aes(cty, drv)) # Discrete vs discrete: disc-jitter ggplot(mpg) + geom_autopoint(aes(fl, drv)) # Used with facet_matrix (x and y are automatically mapped) ggplot(mpg) + geom_autopoint() + facet_matrix(vars(drv:fl)) } \seealso{ \link{facet_matrix} for how to lay out scatterplot matrices and \link{position_auto} for information about the position adjustments } ggforce/man/radial_trans.Rd0000644000176200001440000000503114672274110015376 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans.R \name{radial_trans} \alias{radial_trans} \title{Create radial data in a cartesian coordinate system} \usage{ radial_trans(r.range, a.range, offset = pi/2, pad = 0.5, clip = FALSE) } \arguments{ \item{r.range}{The range in radius that correspond to 0 - 1 in the unit circle.} \item{a.range}{The range in angles that correspond to 2*pi - 0. As radians are normally measured counterclockwise while radial displays are read clockwise it's an inverse mapping} \item{offset}{The offset in angles to apply. Determines that start position on the circle. pi/2 (the default) corresponds to 12 o'clock.} \item{pad}{Adds to the end points of the angle range in order to separate the start and end point. Defaults to 0.5} \item{clip}{Should input data be clipped to r.range and a.range or be allowed to extend beyond. Defaults to FALSE (no clipping)} } \value{ A trans object. The transform method for the object takes an r (radius) and a (angle) argument and returns a data.frame with x and y columns with rows for each element in r/a. The inverse method takes an x and y argument and returns a data.frame with r and a columns and rows for each element in x/y. } \description{ This function creates a trans object that converts radial data to their corresponding coordinates in cartesian space. The trans object is created for a specific radius and angle range that will be mapped to the unit circle so data doesn't have to be normalized to 0-1 and 0-2*pi in advance. While there exists a clear mapping from radial to cartesian, the inverse is not true as radial representation is periodic. It is impossible to know how many revolutions around the unit circle a point has taken from reading its coordinates. The inverse function will always assume that coordinates are in their first revolution i.e. map them back within the range of a.range. } \note{ While trans objects are often used to modify scales in ggplot2, radial transformation is different as it is a coordinate transformation and takes two arguments. Consider it a trans version of coord_polar and use it to transform your data prior to plotting. } \examples{ # Some data in radial form rad <- data.frame(r = seq(1, 10, by = 0.1), a = seq(1, 10, by = 0.1)) # Create a transformation radial <- radial_trans(c(0, 1), c(0, 5)) # Get data in x, y cart <- radial$transform(rad$r, rad$a) # Have a look ggplot() + geom_path(aes(x = x, y = y), data = cart, color = 'forestgreen') + geom_path(aes(x = r, y = a), data = rad, color = 'firebrick') } ggforce/man/geom_spiro.Rd0000644000176200001440000001706015024476446015113 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/spiro.R \name{geom_spiro} \alias{geom_spiro} \alias{stat_spiro} \title{Draw spirograms based on the radii of the different "wheels" involved} \usage{ stat_spiro( mapping = NULL, data = NULL, geom = "path", position = "identity", na.rm = FALSE, n = 500, revolutions = NULL, show.legend = NA, inherit.aes = TRUE, ... ) geom_spiro( mapping = NULL, data = NULL, stat = "spiro", position = "identity", arrow = NULL, n = 500, lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{The geometric object to use to display the data for this layer. When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument can be used to override the default coupling between stats and geoms. The \code{geom} argument accepts the following: \itemize{ \item A \code{Geom} ggproto subclass, for example \code{GeomPoint}. \item A string naming the geom. To give the geom as a string, strip the function name of the \code{geom_} prefix. For example, to use \code{geom_point()}, give the geom as \code{"point"}. \item For more information and other ways to specify the geom, see the \link[ggplot2:layer_geoms]{layer geom} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \item{n}{The number of points that should be used to draw a fully closed spirogram. If \code{revolutions < 1} the actual number of points will be less than this.} \item{revolutions}{The number of times the inner gear should revolve around inside the outer gear. If \code{NULL} the number of revolutions to reach the starting position is calculated and used.} \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{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} \item{arrow}{Arrow specification, as created by \code{\link[grid:arrow]{grid::arrow()}}.} \item{lineend}{Line end style (round, butt, square).} } \description{ This, rather pointless, geom allows you to draw spirograms, as known from the popular drawing toy where lines were traced by inserting a pencil into a hole in a small gear that would then trace around inside another gear. The potential practicality of this geom is slim and it excists mainly for fun and art. } \section{Aesthetics}{ stat_spiro and geom_spiro understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{R} \item \strong{r} \item \strong{d} \item x0 \item y0 \item outer \item color \item size \item linetype \item alpha } } \section{Computed variables}{ \describe{ \item{x, y}{The coordinates for the path describing the spirogram} \item{index}{The progression along the spirogram mapped between 0 and 1} } } \examples{ # Basic usage ggplot() + geom_spiro(aes(R = 10, r = 3, d = 5)) # Only draw a portion ggplot() + geom_spiro(aes(R = 10, r = 3, d = 5), revolutions = 1.2) # Let the inner gear circle the outside of the outer gear ggplot() + geom_spiro(aes(R = 10, r = 3, d = 5, outer = TRUE)) } ggforce/man/trans_reverser.Rd0000644000176200001440000000166314672274110016006 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans.R \name{trans_reverser} \alias{trans_reverser} \title{Reverse a transformation} \usage{ trans_reverser(trans) } \arguments{ \item{trans}{A trans object or an object that can be converted to one using \code{\link[scales:new_transform]{scales::as.trans()}}} } \value{ A trans object } \description{ While the scales package export a reverse_trans object it does not allow for reversing of already transformed ranged - e.g. a reverse exp transformation is not possible. trans_reverser takes a trans object or something coercible to one and creates a reverse version of it. } \examples{ # Lets make a plot p <- ggplot() + geom_line(aes(x = 1:10, y = 1:10)) # scales already have a reverse trans p + scale_x_continuous(trans = 'reverse') # But what if you wanted to reverse an already log transformed scale? p + scale_x_continuous(trans = trans_reverser('log')) } ggforce/man/facet_stereo.Rd0000644000176200001440000000436514672274110015407 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/facet_stereo.R \name{facet_stereo} \alias{facet_stereo} \title{Create a stereogram plot} \usage{ facet_stereo(IPD = 63.5, panel.size = 200, shrink = TRUE) } \arguments{ \item{IPD}{The interpupillary distance (in mm) used for calculating point displacement. The default value is an average of both genders} \item{panel.size}{The final plot size in mm. As IPD this is used to calculate point displacement. Don't take this value too literal but experiment until you get a nice effect. Lower values gives higher displacement and thus require the plots to be observed from a closer distance} \item{shrink}{If \code{TRUE}, will shrink scales to fit output of statistics, not raw data. If \code{FALSE}, will be range of raw data before statistical summary.} } \description{ This, arguably pretty useless function, lets you create plots with a sense of depth by creating two slightly different versions of the plot that corresponds to how the eyes would see it if the plot was 3 dimensional. To experience the effect look at the plots through 3D hardware such as Google Cardboard or by relaxing the eyes and focusing into the distance. The depth of a point is calculated for layers having a depth aesthetic supplied. The scaling of the depth can be controlled with \code{\link[=scale_depth]{scale_depth()}} as you would control any aesthetic. Negative values will result in features placed behind the paper plane, while positive values will result in features hovering in front of the paper. While features within each layer is sorted so those closest to you are plotted on top of those more distant, this cannot be done between layers. Thus, layers are always plotted on top of each others, even if the features in one layer lies behind features in a layer behind it. The depth experience is inaccurate and should not be used for conveying important data. Regard this more as a party-trick... } \examples{ # You'll have to accept a warning about depth being an unknown aesthetic ggplot(mtcars) + geom_point(aes(mpg, disp, depth = cyl)) + facet_stereo() } \seealso{ Other ggforce facets: \code{\link{facet_grid_paginate}()}, \code{\link{facet_wrap_paginate}()}, \code{\link{facet_zoom}()} } \concept{ggforce facets} ggforce/man/facet_matrix.Rd0000644000176200001440000001372614672274110015413 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/facet_matrix.R \name{facet_matrix} \alias{facet_matrix} \title{Facet by different data columns} \usage{ facet_matrix( rows, cols = rows, shrink = TRUE, switch = NULL, labeller = "label_value", flip.rows = FALSE, alternate.axes = FALSE, layer.lower = NULL, layer.diag = NULL, layer.upper = NULL, layer.continuous = NULL, layer.discrete = NULL, layer.mixed = NULL, grid.y.diag = TRUE ) } \arguments{ \item{rows, cols}{A specification of the data columns to put in the rows and columns of the facet grid. They are specified using the \code{\link[ggplot2:vars]{ggplot2::vars()}} function wherein you can use standard tidyselect syntax as known from e.g. \code{dplyr::select()}. These data values will be made available to the different layers through the \code{.panel_x} and \code{.panel_y} variables.} \item{shrink}{If \code{TRUE}, will shrink scales to fit output of statistics, not raw data. If \code{FALSE}, will be range of raw data before statistical summary.} \item{switch}{By default, the labels are displayed on the top and right of the plot. If \code{"x"}, the top labels will be displayed to the bottom. If \code{"y"}, the right-hand side labels will be displayed to the left. Can also be set to \code{"both"}.} \item{labeller}{A function that takes one data frame of labels and returns a list or data frame of character vectors. Each input column corresponds to one factor. Thus there will be more than one with \code{vars(cyl, am)}. Each output column gets displayed as one separate line in the strip label. This function should inherit from the "labeller" S3 class for compatibility with \code{\link[ggplot2:labeller]{labeller()}}. You can use different labeling functions for different kind of labels, for example use \code{\link[ggplot2:label_parsed]{label_parsed()}} for formatting facet labels. \code{\link[ggplot2:label_value]{label_value()}} is used by default, check it for more details and pointers to other options.} \item{flip.rows}{Should the order of the rows be reversed so that, if the rows and columns are equal, the diagonal goes from bottom-left to top-right instead of top-left to bottom-right.} \item{alternate.axes}{Should axes be drawn at alternating positions.} \item{layer.lower, layer.diag, layer.upper}{Specification for where each layer should appear. The default (\code{NULL}) will allow any layer that has not been specified directly to appear at that position. Putting e.g. \code{layer.diag = 2} will make the second layer appear on the diagonal as well as remove that layer from any position that has \code{NULL}. Using \code{TRUE} will put all layers at that position, and using \code{FALSE} will conversely remove all layers. These settings will only have an effect if the grid is symmetric.} \item{layer.continuous, layer.discrete, layer.mixed}{As above, but instead of referencing panel positions it references the combination of position scales in the panel. Continuous panels have both a continuous x and y axis, discrete panels have both a discrete x and y axis, and mixed panels have one of each. Unlike the position based specifications above these also have an effect in non-symmetric grids.} \item{grid.y.diag}{Should the y grid be removed from the diagonal? In certain situations the diagonal are used to plot the distribution of the column data and will thus not use the y-scale. Removing the y gridlines can indicate this.} } \description{ The \code{facet_matrix()} facet allows you to put different data columns into different rows and columns in a grid of panels. If the same data columns are present in both the rows and the columns of the grid, and used together with \code{\link[ggplot2:geom_point]{ggplot2::geom_point()}} it is also known as a scatterplot matrix, and if other geoms are used it is sometimes referred to as a pairs plot. \code{facet_matrix} is so flexible that these types are simply a subset of its capabilities, as any combination of data columns can be plotted against each other using any type of geom. Layers should use the \code{.panel_x} and \code{.panel_y} placeholders to map aesthetics to, in order to access the row and column data. } \note{ Due to the special nature of this faceting it slightly breaks the ggplot2 API, in that any positional scale settings are ignored. This is because each row and column in the grid will potentially have very different scale types and it is not currently possible to have multiple different scale specifications in the same plot object. } \examples{ # Standard use: ggplot(mpg) + geom_point(aes(x = .panel_x, y = .panel_y)) + facet_matrix(vars(displ, cty, hwy)) # Switch the diagonal, alternate the axes and style strips as axis labels ggplot(mpg) + geom_point(aes(x = .panel_x, y = .panel_y)) + facet_matrix(vars(displ, cty, hwy), flip.rows = TRUE, alternate.axes = TRUE, switch = 'both') + theme(strip.background = element_blank(), strip.placement = 'outside', strip.text = element_text(size = 12)) # Mix discrete and continuous columns. Use geom_autopoint for scale-based jitter ggplot(mpg) + geom_autopoint() + facet_matrix(vars(drv:fl)) # Have a special diagonal layer ggplot(mpg) + geom_autopoint() + geom_autodensity() + facet_matrix(vars(drv:fl), layer.diag = 2) \donttest{ # Show continuous panels in upper triangle as contours and rest as binned ggplot(mpg) + geom_autopoint() + geom_autodensity() + geom_density2d(aes(x = .panel_x, y = .panel_y)) + geom_bin2d(aes(x = .panel_x, y = .panel_y)) + facet_matrix(vars(drv:fl), layer.lower = 1, layer.diag = 2, layer.continuous = -4, layer.discrete = -3, layer.mixed = -3) } # Make asymmetric grid ggplot(mpg) + geom_boxplot(aes(x = .panel_x, y = .panel_y, group = .panel_x)) + facet_matrix(rows = vars(cty, hwy), cols = vars(drv, fl)) } \seealso{ \link{geom_autopoint}, \link{geom_autohistogram}, \link{geom_autodensity}, and \link{position_auto} for geoms and positions that adapts to different positional scale types } ggforce/man/geom_autohistogram.Rd0000644000176200001440000001766715024476446016662 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/autodensity.R, R/autohistogram.R \name{geom_autodensity} \alias{geom_autodensity} \alias{geom_autohistogram} \title{A distribution geoms that fills the panel and works with discrete and continuous data} \usage{ geom_autodensity( mapping = NULL, data = NULL, stat = "autodensity", position = "floatstack", ..., bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, trim = FALSE, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, outline.type = "upper" ) geom_autohistogram( mapping = NULL, data = NULL, stat = "autobin", position = "floatstack", ..., bins = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{bw}{The smoothing bandwidth to be used. If numeric, the standard deviation of the smoothing kernel. If character, a rule to choose the bandwidth, as listed in \code{\link[stats:bandwidth]{stats::bw.nrd()}}. Note that automatic calculation of the bandwidth does not take weights into account.} \item{adjust}{A multiplicate bandwidth adjustment. This makes it possible to adjust the bandwidth while still using the a bandwidth estimator. For example, \code{adjust = 1/2} means use half of the default bandwidth.} \item{kernel}{Kernel. See list of available kernels in \code{\link[=density]{density()}}.} \item{n}{number of equally spaced points at which the density is to be estimated, should be a power of two, see \code{\link[=density]{density()}} for details} \item{trim}{If \code{FALSE}, the default, each density is computed on the full range of the data. If \code{TRUE}, each density is computed over the range of that group: this typically means the estimated x values will not line-up, and hence you won't be able to stack density values. This parameter only matters if you are displaying multiple densities in one plot or if you are manually adjusting the scale limits.} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \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{outline.type}{Type of the outline of the area; \code{"both"} draws both the upper and lower lines, \code{"upper"}/\code{"lower"} draws the respective lines only. \code{"full"} draws a closed polygon around the area.} \item{bins}{Number of bins. Overridden by \code{binwidth}. Defaults to 30.} } \description{ These versions of the histogram and density geoms have been designed specifically for diagonal plotting with \code{\link[=facet_matrix]{facet_matrix()}}. They differ from \code{\link[ggplot2:geom_histogram]{ggplot2::geom_histogram()}} and \code{\link[ggplot2:geom_density]{ggplot2::geom_density()}} in that they defaults to mapping \code{x} and \code{y} to \code{.panel_x} and \code{.panel_y} respectively, they ignore the y scale of the panel and fills it out, and they work for both continuous and discrete x scales. } \examples{ # A matrix plot with a mix of discrete and continuous variables p <- ggplot(mpg) + geom_autopoint() + facet_matrix(vars(drv:fl), layer.diag = 2, grid.y.diag = FALSE) p # Diagonal histograms p + geom_autohistogram() # Diagonal density distributions p + geom_autodensity() # You can use them like regular layers with groupings etc p + geom_autodensity(aes(colour = drv, fill = drv), alpha = 0.4) } \seealso{ \link{facet_matrix} for creating matrix grids } ggforce/man/facet_zoom.Rd0000644000176200001440000000620614672274110015066 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/facet_zoom.R \name{facet_zoom} \alias{facet_zoom} \title{Facet data for zoom with context} \usage{ facet_zoom( x, y, xy, zoom.data, xlim = NULL, ylim = NULL, split = FALSE, horizontal = TRUE, zoom.size = 2, show.area = TRUE, shrink = TRUE ) } \arguments{ \item{x, y, xy}{An expression evaluating to a logical vector that determines the subset of data to zoom in on} \item{zoom.data}{An expression evaluating to a logical vector. If \code{TRUE} the data only shows in the zoom panels. If \code{FALSE} the data only show in the context panel. If \code{NA} the data will show in all panels.} \item{xlim, ylim}{Specific zoom ranges for each axis. If present they will override \code{x}, \code{y}, and/or \code{xy}.} \item{split}{If both \code{x} and \code{y} is given, should each axis zoom be shown separately as well? Defaults to \code{FALSE}} \item{horizontal}{If both \code{x} and \code{y} is given and \code{split = FALSE} How should the zoom panel be positioned relative to the full data panel? Defaults to \code{TRUE}} \item{zoom.size}{Sets the relative size of the zoom panel to the full data panel. The default (\code{2}) makes the zoom panel twice the size of the full data panel.} \item{show.area}{Should the zoom area be drawn below the data points on the full data panel? Defaults to \code{TRUE}.} \item{shrink}{If \code{TRUE}, will shrink scales to fit output of statistics, not raw data. If \code{FALSE}, will be range of raw data before statistical summary.} } \description{ This facetting provides the means to zoom in on a subset of the data, while keeping the view of the full dataset as a separate panel. The zoomed-in area will be indicated on the full dataset panel for reference. It is possible to zoom in on both the x and y axis at the same time. If this is done it is possible to both get each zoom separately and combined or just combined. } \examples{ # Zoom in on the versicolor species on the x-axis ggplot(iris, aes(Petal.Length, Petal.Width, colour = Species)) + geom_point() + facet_zoom(x = Species == 'versicolor') # Zoom in on versicolor on both axes ggplot(iris, aes(Petal.Length, Petal.Width, colour = Species)) + geom_point() + facet_zoom(xy = Species == 'versicolor') # Use different zoom criteria on each axis ggplot(iris, aes(Petal.Length, Petal.Width, colour = Species)) + geom_point() + facet_zoom(x = Species != 'setosa', y = Species == 'versicolor') # Get each axis zoom separately as well ggplot(iris, aes(Petal.Length, Petal.Width, colour = Species)) + geom_point() + facet_zoom(xy = Species == 'versicolor', split = TRUE) # Define the zoom area directly ggplot(iris, aes(Petal.Length, Petal.Width, colour = Species)) + geom_point() + facet_zoom(xlim = c(2, 4)) # Selectively show data in the zoom panel ggplot(iris, aes(Petal.Length, Petal.Width, colour = Species)) + geom_point() + facet_zoom(x = Species == 'versicolor', zoom.data = Species == 'versicolor') } \seealso{ Other ggforce facets: \code{\link{facet_grid_paginate}()}, \code{\link{facet_stereo}()}, \code{\link{facet_wrap_paginate}()} } \concept{ggforce facets} ggforce/man/geom_arc_bar.Rd0000644000176200001440000002234715024476446015354 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/arc_bar.R \name{geom_arc_bar} \alias{geom_arc_bar} \alias{stat_arc_bar} \alias{stat_pie} \title{Arcs and wedges as polygons} \usage{ stat_arc_bar( mapping = NULL, data = NULL, geom = "arc_bar", position = "identity", n = 360, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) stat_pie( mapping = NULL, data = NULL, geom = "arc_bar", position = "identity", n = 360, sep = 0, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) geom_arc_bar( mapping = NULL, data = NULL, stat = "arc_bar", position = "identity", n = 360, expand = 0, radius = 0, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{The geometric object to use to display the data for this layer. When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument can be used to override the default coupling between stats and geoms. The \code{geom} argument accepts the following: \itemize{ \item A \code{Geom} ggproto subclass, for example \code{GeomPoint}. \item A string naming the geom. To give the geom as a string, strip the function name of the \code{geom_} prefix. For example, to use \code{geom_point()}, give the geom as \code{"point"}. \item For more information and other ways to specify the geom, see the \link[ggplot2:layer_geoms]{layer geom} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{n}{The number of points used to draw a full circle. The number of points on each arc will then be calculated as n / span-of-arc} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \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{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{sep}{The separation between arcs in pie/donut charts} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} \item{expand}{A numeric or unit vector of length one, specifying the expansion amount. Negative values will result in contraction instead. If the value is given as a numeric it will be understood as a proportion of the plot area width.} \item{radius}{As \code{expand} but specifying the corner radius.} } \description{ This set of stats and geoms makes it possible to draw arcs and wedges as known from pie and donut charts as well as more specialized plottypes such as sunburst plots. } \details{ An arc bar is the thick version of an arc; that is, a circle segment drawn as a polygon in the same way as a rectangle is a thick version of a line. A wedge is a special case of an arc where the inner radius is 0. As opposed to applying coord_polar to a stacked bar chart, these layers are drawn in cartesian space, which allows for transformations not possible with the native ggplot2 approach. Most notable of these are the option to explode arcs and wedgets away from their center point, thus detaching it from the main pie/donut. } \section{Aesthetics}{ geom_arc_bar understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x0} \item \strong{y0} \item \strong{r0} \item \strong{r} \item \strong{start} - when using stat_arc_bar \item \strong{end} - when using stat_arc_bar \item \strong{amount} - when using stat_pie \item explode \item color \item fill \item linewidth \item linetype \item alpha } } \section{Computed variables}{ \describe{ \item{x, y}{x and y coordinates for the polygon} } \describe{ \item{x, y}{The start coordinates for the segment} } } \examples{ # If you know the angle spans to plot it is easy arcs <- data.frame( start = seq(0, 2 * pi, length.out = 11)[-11], end = seq(0, 2 * pi, length.out = 11)[-1], r = rep(1:2, 5) ) # Behold the arcs ggplot(arcs) + geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = r - 1, r = r, start = start, end = end, fill = r)) # geom_arc_bar uses geom_shape to draw the arcs, so you have all the # possibilities of that as well, e.g. rounding of corners ggplot(arcs) + geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = r - 1, r = r, start = start, end = end, fill = r), radius = unit(4, 'mm')) # If you got values for a pie chart, use stat_pie states <- c( 'eaten', "eaten but said you didn\'t", 'cat took it', 'for tonight', 'will decompose slowly' ) pie <- data.frame( state = factor(rep(states, 2), levels = states), type = rep(c('Pie', 'Donut'), each = 5), r0 = rep(c(0, 0.8), each = 5), focus = rep(c(0.2, 0, 0, 0, 0), 2), amount = c(4, 3, 1, 1.5, 6, 6, 1, 2, 3, 2) ) # Look at the cakes ggplot() + geom_arc_bar(aes( x0 = 0, y0 = 0, r0 = r0, r = 1, amount = amount, fill = state, explode = focus ), data = pie, stat = 'pie' ) + facet_wrap(~type, ncol = 1) + coord_fixed() + theme_no_axes() + scale_fill_brewer('', type = 'qual') } \seealso{ \code{\link[=geom_arc]{geom_arc()}} for drawing arcs as lines } ggforce/man/ggforce-package.Rd0000644000176200001440000000505014672274110015741 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ggforce-package.R \docType{package} \name{ggforce-package} \alias{ggforce} \alias{ggforce-package} \title{ggforce: Accelerating 'ggplot2'} \description{ \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} The aim of 'ggplot2' is to aid in visual data investigations. This focus has led to a lack of facilities for composing specialised plots. 'ggforce' aims to be a collection of mainly new stats and geoms that fills this gap. All additional functionality is aimed to come through the official extension system so using 'ggforce' should be a stable experience. } \examples{ rocketData <- data.frame( x = c(1, 1, 2, 2), y = c(1, 2, 2, 3) ) rocketData <- do.call(rbind, lapply(seq_len(500) - 1, function(i) { rocketData$y <- rocketData$y - c(0, i / 500) rocketData$group <- i + 1 rocketData })) rocketData2 <- data.frame( x = c(2, 2.25, 2), y = c(2, 2.5, 3) ) rocketData2 <- do.call(rbind, lapply(seq_len(500) - 1, function(i) { rocketData2$x[2] <- rocketData2$x[2] - i * 0.25 / 500 rocketData2$group <- i + 1 + 500 rocketData2 })) ggplot() + geom_link(aes( x = 2, y = 2, xend = 3, yend = 3, alpha = after_stat(index), size = after_stat(index) ), colour = 'goldenrod', n = 500) + geom_bezier(aes(x = x, y = y, group = group, colour = after_stat(index)), data = rocketData ) + geom_bezier(aes(x = y, y = x, group = group, colour = after_stat(index)), data = rocketData ) + geom_bezier(aes(x = x, y = y, group = group, colour = 1), data = rocketData2 ) + geom_bezier(aes(x = y, y = x, group = group, colour = 1), data = rocketData2 ) + geom_text(aes(x = 1.65, y = 1.65, label = 'ggplot2', angle = 45), colour = 'white', size = 15 ) + coord_fixed() + scale_x_reverse() + scale_y_reverse() + scale_alpha(range = c(1, 0), guide = 'none') + scale_size_continuous( range = c(20, 0.1), trans = 'exp', guide = 'none' ) + scale_color_continuous(guide = 'none') + xlab('') + ylab('') + ggtitle('ggforce: Accelerating ggplot2') + theme(plot.title = element_text(size = 20)) } \seealso{ Useful links: \itemize{ \item \url{https://ggforce.data-imaginist.com} \item \url{https://github.com/thomasp85/ggforce} \item Report bugs at \url{https://github.com/thomasp85/ggforce/issues} } } \author{ \strong{Maintainer}: Thomas Lin Pedersen \email{thomasp85@gmail.com} (\href{https://orcid.org/0000-0002-5147-4711}{ORCID}) Other contributors: \itemize{ \item RStudio [copyright holder] } } \keyword{internal} ggforce/man/n_pages.Rd0000644000176200001440000000171614672274110014355 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/facet_wrap_paginate.R \name{n_pages} \alias{n_pages} \title{Determine the number of pages in a paginated facet plot} \usage{ n_pages(plot) } \arguments{ \item{plot}{A ggplot object using either facet_wrap_paginate or facet_grid_paginate} } \value{ If the plot uses using either facet_wrap_paginate or facet_grid_paginate it returns the total number of pages. Otherwise it returns NULL } \description{ This is a simple helper that returns the number of pages it takes to plot all panels when using \code{\link[=facet_wrap_paginate]{facet_wrap_paginate()}} and \code{\link[=facet_grid_paginate]{facet_grid_paginate()}}. It partially builds the plot so depending on the complexity of your plot it might take some time to calculate... } \examples{ p <- ggplot(diamonds) + geom_point(aes(carat, price), alpha = 0.1) + facet_wrap_paginate(~ cut:clarity, ncol = 3, nrow = 3, page = 1) n_pages(p) } ggforce/man/figures/0000755000176200001440000000000015024476316014115 5ustar liggesusersggforce/man/figures/README-example-1.png0000644000176200001440000014526315024476316017362 0ustar liggesusers‰PNG  IHDR àzŒß4iCCPkCGColorSpaceGenericRGB8U]hU>›¹³+$΃Ԧ¦’þ5”´lRÑ„Úèþe³mÜ,“l´AÉìÝi&3ãü¤i)>AÁ¨à“àÿ[Á'!j«í‹-¢´P¢ƒ(øÐúG¡Ò ë¹3³»“¸k½ËÜùæœï~çÞsîÞ ¸,[–Þ%,®-åÓâ³ÇæÄÄ:tÁ}Ð }Ð-+Ž•*•&ã¿Úíï ÆÞ×ö·÷ÿgë®PGˆÝ…ج8Ê"âeþŲ]€AûÈ ×bø Ä;lœ âõWžð²Ï™‘2ˆ_E,(ªŒþÄÛˆç#öZsðÛŽ<5¨­)"ËEÉ6«šN#Ó½ƒû¶EÝkÄÛƒO³0}߸ö—*r–ᇟUäÜtˆ¯.i³Åÿe¹i ñ#]»¼…r ñ>ÄcU{¼èt©ª7ÑÀ+§Ô™g߃xuÁ<ÊÆîDüµ1_œ u~Rœ æàâ*-°z÷#°Mi*ˆËWh6Çòˆø¸æf}î-gi:×Ð9¥fŠA,î‹ãòV§>ÄW©ž—Bý_-·Æ%=†^œ tÈ0uüõúvW™â’9 Œ%/VµñBÈWµ'¤_¶tâÜÈMÛ“ÊŸ¿ŸåP““í\>ĘÉ@Á„yì0`D i|[`£§ èh¡è¥h¡øÕàìßÂ)ùþ·TjþÈëèÑ0B¦ÿ#ðЪÂïhU#¼ ~yh«uÐ fp#Ô1I/I’ƒø"“ä0!£ ’'ÉSdŒdÑ:J5Ç–"sdó¹ÑÔy#RŸ7‹¼‹èwAÆþgd˜à´ÏÅJŸ7ØÏØÏkÊ•×n^:}nW‹»FVŸ»Ösét$gj-tÈÚÔrÏÿÂ_ç×°_ç7Z þ~ëÛV·5ë4ÌV }ºo[ÄGó=Nd>¥-Ula³£¢Y5VúË}¹x»g[üä÷É?’kÉ÷’&ãÞä>áÎsŸrŸq߀È]à.r_r_qsŸGjÔyï4k± æi—QÜŸBZØ-<(d…=ÂÃÂdKO膄 a/zv7«]»ǰod«}¬€©sìn¬³Öá?TF–'|¦ãï3Nnã„#I?"…m»z„íõ¦v~K=Ú¯Æsñl<b|_|4>?Âpƒß‹¾QìñÔré²ËâŒi´µšêŠÃÉäãb ¯2* åÀ (ëºè»Ѧµ—hå°{28ÂoIþýÛy¥esŸ8ü';÷Z¶9à¬ÐûhË6€gã½ï¬>¦xöRx'Äbß8ÕƒÃÁWOÏ«ëõ[xn%ÞØ|½^ÿûýz}óÔ߸ ÿÿ%x ÅcÖË8eXIfMM*‡i   à_ÛÜ@IDATxì|ÕöÇO²éTBh¡w±#¬¨XQy">lˆŠ€øÛ…¿ÈõÙÅö@QDAQ,(*Hï=•„ôþ¿¿»™Ý™mÙžÝɹùlvfî;÷~gËÙsO i…¸0&À˜`L€ 0?õÓuø2L€ 0&À˜`L@`”_L€ 0&À˜`~%À¨_qóŘ`L€ 0&ÀXå×`L€ 0&À˜€_ °êWÜ|1&À˜`L€ 0@ù5À˜`L€ 0&àWa~½š—/V^^N•••^îÕØ]DDUWWû¤o=wE555TWW§çiº5·²²2»ç…† Ö××ÛmÃÖÂÂŒaµµµÖ•|Ä!°ó„[ll¬ÃþõXB‘‘‘TUUEÁе;.¿\;ËØŸIIIîœÊç0 @!èàƒÀ%&&†JJJ|ѵ®ûLNN¦ââbŸÝ—`†ç赊gŸ,¸»~‡ñå䈭ë=¶œ3<á¦ÿ-‡Þ§ønÀIO„÷–ÄL™+¸•––*».=+?Ð]:‰<¿  Ç§?þøƒz÷îM™™™6Á8p€Ž9bªKII¡®]»šöyƒ 0&À˜€#U5!„ì*QáÞϱR-íÅåD5â9ÄÆ *ŵkjC(6²ž5l´âCL€ €€_Ð%K–ТE‹èì³Ï–Ï=zô ûî»Ïê¼ñÆ”““cRµ÷ë×P+J|€ 0&À, Ô ë•wÖ$Ñæƒ‘T[B©ñu4ý²< 3X¶toË¡zçÇVb騬*‘OÓkL}³9†–®O ª® ¥§¯É¡V±lRcÄLÀ‚€ÏP,)¾÷Þ{4kÖ,ÊÎΦo¼‘FM·Ür µjÕJ3œ;wÒ³Ï>KíÛ·×ç&À˜`ŽÌZ–B‡‡S>QrŠ ôƪVôÏóŽ;:Í©:ô5oeЦíÿ}™J]™K‰u´~¤>㩦ׯ£û$ž½.‡¢#¼¯‰Õ „w˜@ð¹j0hþüù¤¬Ãiv –¶np(*,,¤¼¼^3ÁÆNãõ‹ pð¶|â‰'¤†gúôéV,{öìI‹/6i»téBo½õ–Fíܹ³<¦œ okhM}QðëŽS\\#3h³ñà¢%PQQ¡= Úc/x 6¡i‡&Ï[ºkQM•pB–“†-å®ÜhaGJÓÊí:óøê³×r<ê}D)ûzS¬4C鴮唙d÷Ö#3I,…CnTJÀ Î@5…Thÿ­§îÞîöÀváôÍ_Z¥IƒÐ¶žÔVô]XGgt¦Ý9Ú0AÕ!Ô!±@ÔÛ_í^N—ž|§â=Ž•5.ú"àÂÈ”)S(++‹&OžLʲ™eQQ8qÂ$€ÂIÐrâÅÇ… 0&À|K ZxpÏ]ÙŽJª„iƒ›*j 4õâ}”×üqVáþЂ áàc0WþG7Ÿyœ†t1Æ‚{vþ, Ê nhBÕ4~˜w”RkèŽa…ôêwÉ'dÜÐ:ÂõÒŒð.”wÂ@Ë7Æ ½^´©§{/,dûOß¾\¹÷ 'àô±Ç£îÝ»ÓÝwßm…kß¾}Ôºuk;òþûï§ H»¤¥K—Ò9çœÃ§1>À˜ð g¾ì@åB»Xß`þÑÿʪ,šrñ)ÔùæªÎõ:m¡"|PœõîI”G zéí>ãª<á¡.tŸBxŽ‹ò®æ±û*šwk>EƦReY!H+”_:°”Îë]F•B@NŒ®'ƒ¡säVL …ðù[dëÖ­´víZZ¸p¡ ÄPLxlܸQ¢ž0amß¾°¼>jÔ(?~<Ýpà ´aÃé)ßÂîO— 0&ÐlÊ« á©Î59'"šmLÊ…+DŒMey]9†çu{´K³±‘ ^>•ëÁÎ45AØ›ÚQÝĈk'‹ÐK,|*Äø™ Ø'`çmdÿWk`Û¹fÍ»§-_¾ÜT‡ÐLcÆŒ‘^ò â]Î… 0&ÀüFK×UKÜÊE+„PÖüžÜpø‘Ž=ÊÀŸaçÉ… 0à#àsÔU$°÷dáÓUjÜž 0&à9}óéó ©TgZ‚o nå”o¸~èx$­?GQB xnÏrJŒÑ €›D øÍ‡"¥ÐEýJ)Ââ[æçÑ2dRJ\ ëUGq§Êð¾¥ôÕÆ8ÑV9¡AØbÛËìðˆxkwc.ÞµÂd£éÔD£ß÷D‰ÐMr }¸»+šL8}³9–J+C©WV èà›4ÑÎÎÅŸív‹ ?÷EJÍð…â>AÌ… 4EÀ⣡©æ\Ϙ`z%Ð%îâð"„w¹¢À¤]…8[d&ª™ˆ©¡QKúÖê$á5ßd·´åpm<€ÐS˜7ÉlJ?ù-¾é“E \9è!|*å·ÝÍ$ŒFu\Ž—…6 Ÿ˜dHãk§ÞúA’JÇxj0¿[<è„OeL€ 0à'`k9‚­™¾C…ž/ÄÁn5Z„?²,‚!<7UòJ¬¼ü! #µ§3%÷D˜IðV·Çq=—‚Rñšˆ4Çb5Î5Dh¹õ=o=ßSέéw¦?GÃ×bL€ 0f#e)L•U‡ŽÇ ACÑZª/y”V±uVNBÐE*ËïÉ¢>™ Âmz‚µP«îß™íˆ0±ü+–Í- BJÅ8‘‹cÃXÔÅ•±¥Æ× ýŸöüªÚPJv®z.­„Ç?„|Ëb뇌eÞgAý3KJšOoßJË÷UßÞk õÁéçlÜuYËj¼Þðzæ¤ –dï+ÌIŠ‹óì,¹Ýzf>=ÿu¦¦”eì«O) äx£9êäãôáZ%#P…‰ÃÓG•ÉÏʾÙDƒ»ÔÒê­ÆMààÄ3ù²JŠŠ¥ O"újÑñÒ¹Dû±d~ýYž44Ö©Áo;l ŒæD'‰ì7žetôÁÙÿ¼ ’f/Å–"†Ð=—Sr’1L<è—üA?mÚN¢qÃ*¨S†Qk:¤Ѫmõ´õ°qžaB˜…vvü…µ¢­ylJ¤‹Vç'w^ M|'J ±ÈGa¸oûZدËÀmn?bäZZB:ÖИ³s Šh®:µŠ>øÑèø“ ØÎ¸¦ÜêûÓ“ïT¤áæ¢?!âÆíE椚³w¦7oO||<•””x³ËÑWJJŠ £…Ô«\´ðzµWÂÂÄžÈú¥þR³×–› @€‚ ů73g·ðCÑÖ¢ã"“ÐÊ-IRÔ±”ºd3 )ýîˤ_vÇSlt8 ë]ImZiµ|kwEІ}RóyÉÀ á%¯ýŠY±1Šöç‡Iõ‘*(ÜI5Èîœ0zöóÓR7ØžY5tïEæÏécE¡ôíæ(Ùæ¬•Ô1Í<¶ç¾H Ç¤(æÏ –ouówÈê­‘B —žý—\aåÍ÷ibb"!s_]¹oôW%¹ŸüC'*B©_û:½[p|îÍ5Ð3K5\»eÖФf®˜Ÿ£²é`8ýº3‚"Âèâþ•âÞZ›CxúŠï.ú"Ô(rÁû*ç¸'ykõõqm6ÈïËûâÚh«uYY™Ýq.x»hVp.x‡xVÚËïð$U¥¿Wˆ&ÿÎP°#5Ø}Þy~!uÎ0 ‘æZóÖÁ‚0zæ‹4óƭĘ:zft®Õq{ð>MMM¥¼¼<ª­õÜtÀÞuüy|êÂt!4[s½ã¼ãÔ­µsœ¯'ß©ø‘™‘‘áÌe¸M0®7Ñ€y¨L€ 0&ÐòÀ¡É²ÀÖvžM8"ÅX8Háœr'”šê;ØëÅ‹U‘\EJS.LÀ—š~çúòêÜ7`L€ ´(µbåAÛ:ÉVAØ$ÔËxžªÝ3«¬… |vLÕj?Ñ?âqªK»”«€÷°QM‰Ó®íLè&uÿÁ°mk'ÕÒKrMÓr †9òƒ‹€“Ö7Á5)-`L€ ,…¿ú]+©µ¬¬ ¥»/(YƒÌ˼ëD&¢ÿý’(½éáE®h~ó™Å4é8»˜mJÿ)–‰ã£*<ïý”HöƒÉgµª¡É# ¤#òÃß%–êŸ[–*Ë×Ka4NµŸzi¾ R¾#õòÊVT(l`«Åµo>£ˆ†ˆlJz(ì¢~6s}ìÊ\ÊH4Jé7‰yþ¾7S†¡‚óÃþ9¬’,2\éÏ!°° ¨ûችŠ.[Äa¶µ›ÙÔ>wkØÔ]rDþ¶E¼Ðiiíø ðLQ@í…ìg.U<ìóBúǯʣ!d~³)–¾Xo A4#±–¹<_ ™³¿L}„‰zãÂúî×®’n?·È©HŒaÛ‘Hªú·¯”ç¡ZÏ>lmj‡ xÂß1ì8õnkv& FP[ö¯‡õø¨ ëi¶ƒ|sM&í+@Ö„02Ðø³S× £0”¿mKE"÷;|}*j ôðˆ}"ͦÑ[¼XÄ‹œ»²ôP¯k „#ÑÿÝpLä€oZÈÃH·‰ ¹+RdH$¯×žZL§v1º_¹9†>ý=QÖ‡‰@ów '#؇*åõï“Äry´ÌûŽž‡šìáùþè¢téàûMœ7á¼B¡UÎvü|øx=½$M泇'ýÅýKé¢~Z´¹l@a^0ï›d¹T^)ì4±Lþè•y&VÇ3#úîïZ´ÎÌÎ[Jô܇¹_%Ó!‘÷?7à?õÒqµÒ²eËÜ¿0ŸÉ˜ha6Š¥ï·%kf½|sŠ&ª¨Kz}¶>Uj7Õ¶’oþ؆¦\¼ŸZÅÔÒÌ/;P‰ö®^.eU=tÑ~˜\ÒSK³5}#õâkß·’‚ ¦ÂÎNwògÎÇ„æU¤Q^è–‚ëù}Ê¥&4›0-…G8—ŸšYa">¹© ½æ3׿ŠzãÁD½¸³ZÕÒÜ›ŽÒñrƒ€Ñœš.îà dVšõ¥Ö9« Ô õxºf°sÙŠ†õ.‚~…Œ{jÉõ¿ß¶¢½yZûÙ¾J¡'®ÊuJ{ìés×:'àsü”ŒH38wî\ºè¢‹d6 5[؆"Å™R¨  @Ù•Ï›7o¦Ûo¿Ýtì®»î¢ë¯¿Þ´ïÍ üâJOO÷f—-¦/¤\‹‹³6|o1ìL47×ùŒ+vºàÃ6 ¯¹òc£ºEÚ|$Éæ|·ç&Rÿlá~,N㨃ÆHiy°(‰Ú¦UX Ÿ¨¯ª5PquA#‰FŸ¤ª»s"¼úYÙÔ§®§õÊØí=gÙ«PONÖ ùª*¯oîÚ&^ß"ŒT™*0<ì7ÿ:Kw]bÌÁîÉE÷å‡Z8w‰4¥B=^P•FÚ{Ò³ö\O¾S-VÚžy/X øEäj~â‰'Ä/ëš>}º/hJÕ/2¤9‹ŽÖ¾¹íºë®3Û©S'Ÿ¥âĵ+*´62¦ ó†]>‘_º¦Æ¼lf·q «pįü@Ãûƒ‹ó›Å[ç{ þ–‘aub™¶A£Á„óNxhd„Ô•–ßÃBkd=l&±Ä«.X’ ©&Ñ­M›O8úø*%²z°÷iLL a%ïW¿”zh¤µß…¸.ì]½Á=:"ÖÊîyíCªDÿÞ ÇäÉw*>#"\³}õ˽á‹xDÀ/(Þ$S¦L¡¬¬,š?û#NdJ¦ï¶ÄÒWãhâ{™VÚ5ô£·¨G„ÔrssI0Xô[¼W¦‰‰ŒNÙÂÛ?Zä³GúР‰¨s†çÂ'د}•tÖŠ¬“¶¯§v® ™×æxeìÜ pDÀç^ð[·n¥ñãÇË1@[¡”yóæI§£‹/¾˜fΜIýû÷§¥K—Ò‹/¾H°¯éС=õÔS¤,±)穟٠^M#0¶Ù Þþ}`/xûlÜ­a/x×Ƚõc&íá•ÌNÚ®zúçÐÃR8üqgÑ¡ùsÚØ»ÈV4|?¥'h½¢-ínmeÜ6­¯ÈFtÇ0³¾k#¬ÖÐâÁ,//O£}í»$Â(ªQx7Žíï½°PŽÞ‹„ë£a/x×™éý Ÿ/Á÷ìÙ“Ö¬Yc—ãòåËMu—\r >\.᲋ o0&À¼B  4\#|¢S‰ˆ í¨½r¸8ÒJµl›s"LjèàÁ®8ËKÇz/˜»Qs¬é±â0@µHx ˜˜?)L‡šw¿0YølÞ{ÀWgL@Ÿ’bj„~ËëæR)¼Ü¢Î&ªE*sqFz\ÓZ¼$6É20=®#–õ^’cÎ_êy"°}’8Î… 0Û|®µ}Y>ʘ`î(ª¬¥g¿M š Rx¯ßyî^êÔÊœ×;§8œ^]%³Å »¾D ϨÆOúkNÉ£§—u4yÊ„ö³KF¹Œб\1 ¯G #£ŽõÌ,¥¬VöèÐ¥‹°Iì'–Û×í1æv‡7>‚Ýß}A¡±ÿwcÿ®•ˆó*ƒßÿëÊ|á¡o>qÈþɺª¬¡*éÒ®yɬØK¿îŽ–N67Y,æ¥5+0_Éz ±KþO…Âä556žn>ó¸MelwãéÅôðÇf®"~—ŒjéŒdÝ“í#?툦5Ûc$³+O)¡®­›fn»'>Ê‚ƒ€Ïm@}‰m@}I×½¾ÙÔ>7¶µÏÆÝš–fZ'§Où´‹Äeôq7j3¯9}šeôÀ~ü‹N¢^ õÿºt/%D5‘³ô…ðt/¯Âe Î63ß$Ù¿¿¶µ)e&–çOë\LWœ”ou‹,m@•¿ìŒ1*£d ùK–P’“áóKBéÑO24c‡û¼\€ôûóÃiÖ²ÓØ¿´wV%wÒ¾tÞŠV´õh¤)Dægg¼Õ«…œzßû™Ò\fÜ#Dúϧ¯É•i@1wpýä·Bàø>B?«»óaü>ú5VmU ¡»®RL§ws¾ÓɺÁ6 zcšqXªß–Í8 ¾4`L€ 4Ià…µKåŽBBQýÖA>¿úCñ¬Ÿ8d¬ÿð—Ö²ÿ7šÐñçh„OÔ½ûK¦IÀÃ>„­u{„ÖÏùŲӺVR=ŽFg…O\ëÿ¾ñ†,ÆŽ%ý6ן÷M+ÍØ6t›(¡mª* £-G¢LÂ'ÚcnülN~â¨%Ä›„O´ƒ½'Òu~#4ªJ×Ï(¦ çwIø,™›ÔÂ'úC¸¥…0[㼂V?3 !ÀhÐÜ*(`-@y•µ°!´¾.R¢AnwEè4³ ¡2Uö"óqë-ƒÐ¼YÄú4ökYãÝ}c†%£À¬îùD¥ñ˜:=¨R iYUÓ_cˆÍ+BGY–r±”ïL)®‰"„Щ.ˆŸŠeyOK¹?Â+YÄoåÂôLÀówžéðܘ`n€† Z:o–^mlÛ<Æ&“—éš%[k!²gks,O4¬ª¯–ËÌ[m[UZá3=Þ÷öˆÙi¸†åØC¨¿XÎFé–Y%µr§ñ²4µOiÚAªm²hcáa…%xg5´½³ªDzJ˱ ûXpÞÓ’_kŠÓjî«AhYE†ªFSóqÞbú!Ô6 ÈTd+«’7nÒ~qv×I"ݸqFkvÖ Ó„KÀî \! €â ÚëíëMq´bS‚\JK³O]uTØ1Z 0îÜÆiËj¨´0[ˆjJµ4oŒ9pø”…™Kc}ºpþu…¹~QÞ2š{øuªi¨ºÓúªï‡”f š^"ì^ÔFDõrñ¾ª6„&È¥v6„¼”,™{¯Ô %àØy"–¦JØ3«žþuQÈ+Q¢Æ½"ˆGh>a—ùàeÕ4 [u‚ƒál;JO|)Mp~´È¯>ëæ*±ïà$UÕÌÅ´q¿¡±}ÚµŽî¸°iáWÕ…ÝÍC!ôÐ{Qrl“‘=êÙ1•”hôç²{^0UxòŠ,qölŽƒ‰UK ¨P8!ù*_»'ÓZÄ-kéR}y_‚™¦£Ô®øp†h‚T óŽŠŠ’©8)õëªí‰ôõæ!|˜BCê©ub5M<ÿœ¼ÁtéÎ2Úr,Šâ£DVœAÆåwu¿ßnmEù¥a”•TEgv=aªúéÄ:zäðsBø4 N@SÂZÑ‚.¯PT¨±hn7Š“ÂsÌrá¼d½t}.ï³ßãèx™z´©¢ÓºµŸÊ`úûž(‚`ÜChÓâmMioù\XJ‹4¡bv¬t9MèΜª¢Š -¢NiÚ±Y^ËÕýRaj°é`¤Ð´³Á¦TO%))‰ŠŠÜKH€™pPã¢'Î[–è¬}¥1bm”g7ÜW÷ųQîÙÌ˽{ˆïÓï·%›„O̪^äU/*§ýQ2¯º{3ÕžuI×Xº¤+ŽÙ^£=¯çqí {¯æ½o>qZT,ǯ-ý“†&œ&[aÙw`ÛKýÝÈ'_½f/?Ùì•/SÚ«. ƒ†AÌžá–õª¦67[‰¸œgv3›#¸z~Ϭj‘ ‰D&¤‘ É»b¬ÐÈéâþÜlN8ÀºûšQgQ °)ñp< À6 ÀãS™`–`[hY èÔ€S‰yÙÞ<Âzª§Z±Ï… 0&àO,€ú“6_‹ 0Ý8¥#–¼µBhEA8Ë8¿d[^WAëJÿ¢Må[½Êëò¤ ­ú+«/§SãN2‡– ×ý³l“ÔŽš*t°XÛŽDÐn'B7é`º<&Ђ~ > éòà˜hq†÷ɣВ¾TZBÕaùtϹ9ÂÞP¬Ý:QU¥ {§’HlID qôI·×)<ÄIo׸:åÚUµ–­¤xÑoTH$ý§Ã“r§U׋ÌJû¦Ñ‘šáWO%õeôi×7(=ܹ±;¸t³Wå—h¶ˆ5ŠðFUB ¯§§GçºlÚìá0z'$_9°’{¯p΄dŸgB²ÏÆÝš@Ì„4qÿ£´±| …T¥‘¡!š*"öSRX-Ž>±ÇnÍ8/Ü~½G(…ÒʼnçÒ´¬{4Ç=ÙÉ«) jC ¥R2E†F˜ººjÇí”_[(„_³sOfx}ÐyE„jà`òJ†À9éƒÖ¦yb¦§{Ò[Ï*Öw´.l@S… hž°e³G¬,ë<ùNE´ vB²$üû¼ü÷gÀ˜@ØR±C†8ªŽ8J‘{DüI¡Ël¨£¿Åñ¦ ÚćÆišÁFsUÉ/šcžî¤…§P§èá}æÕæk„O+­+£}U±´i¦ý¦6ÎÙ2J¯Æì@–o¢eEßÒ7=ÈÓmè™/;ˆ@î¡iBéü^…4¼w¡¬}­ßyÒ„nPÄ/m—w7=Ëï" Q—»/(¤¿I¦}yá2ãÐeKD {­¶7ȧÈÃgAEÀ/(…¦OŸNHEøå—_Ú„6………Ò¸{õêÕ4tèPjÛ¶­¦-R™í»á(˜2ꔇí³ù¨- 3Gl-ÏÛQ±›æçl:Œ¬@ñ7ëè+ôD»É¦ãînüëÈl«S Šh~ÞÇt}êRøDµ:íà3´°ë©¨®˜f{Es>²=~øyš—ý´æ¸­)ûŸ6 ŸJ=–ÿ1·‡ÚÜIïýÒZ¦é„ý£RVoO¢>mÊ©mr=÷U{¯T$8UªiáomhêÅ(&Ò(Ô*Áöùhòþý#,ŽŒ?”95õ¬ÌÏîUoêz­Ç{Táçê]y»Ú7·o>~@ûô1þz_µj•Ý™îÞ½›ªªªhݺu„|â÷Ýw;–FŽi:gË–-tíµ×šö'OžLãÆ3í{{#==ÝÛ]¶ˆþ.ZÈgÌÅ7\ñÈ>R‘KqÂN³TÄ¿T ¼¾wVíõi¾é5e¿ÑµY—K-+{Ô¥²¡Šj#ë(·¢€ T\g^†õâîª}N s°U¶Uí’çç—F ‡(³p‰¶âw<¯Š£î±aòGÐ×jºÀ—E}<¥Åj½¾[òçcr²ÑdBŠwš$àîk†#4‰6(øEu†LÏž=iñâÅ„P (]ºt¡·ÞzK#€vêÔ‰^{í5SwÈ;­©/ ò;ÊÝí‹kê¡O|0#Ü~LpѨ¨°¿Ü&4ObA˜…T-´&ö"""¤ÐäÊë-®!V,PkÝO e„÷¹£{ÔÄPš¬îÞžBE8 [š³’ºR ÁêêEvY‰0>gÆ––,m?-“fH‘ç'FÕPÞ ¡½S ™•5¡ÂɨRÖÇDÔQq…ök¡¬*T„`*õæÐLèßWŸ½–c¤}¼Oñ㺸¸˜êê´<iœ8O¿SYèÄ»êÙ˜´Ÿ4žõåÑÙEEEtâÄ “ ;P,·ã Kí(xãŸsÎ9¦ëàCÀWq@cbbXˆ2‘vm¿V]\ë=x[;úÂÂk¯uGm‚wæî|Oåš{ì © <;~ý#ý:«Ž”ÏW¸Ý—Äô¦ŸK—ý!Î&þžm7Ýiþ•ýMÓ=+=Æ;F¶£7:Î6}N&­,ùQ3VèeO!÷>˜ùO¹¤®nðXÖ$Šh§öáYty«áôaÁbS5ÆöJÇ™¦±Ádà¿9ïÉLE)ÂyiFÖý&ÛUÌá’7›ÎU6þ%Û éêSr„ hG!~B¯*–DE,Ì©Ô%½TÔ]78‡^ýGКÐá} (.¢ZÖ+ýá¹9ÞãD8¥O~§Êê:%»’.è«Õ$«Çç‹må"ÌÁX+çaO¾SÀµ+rë@'Ðìq@÷íÛGð‡09iÒ$ù+‚¥K—Ja“_xþâñ1ï8VK·ì™H”o”™{>(ø”&îû—×.ô\ûGèþÖãipìº ñ,aùŠïœÙHNuݵº°×éúŒø &À‚žÀäOJ2‘ª†jÚV¹›~)ùƒN‹?Y9ìÑó¨ä„‡«åö½ÖŽJ5Â¥hö±Wéá6ÆlEW¦\LxXÄØœ›ó¦æpXr5÷}º$éú©dl5 ÄÎ+9ïÒu)—Ó—E߉%ú:q5£=¦Ýò¡)~¶ýtyb‰¾ÝyŽe¦ýhý†Ss Y¤li1Sãjé¦!fgOӉͼñŸÉûÕšºPúûp¤ôjï(Â,qaL ¸øU*<ÛñP—åË—›vo¹å3fŒ´½d'Þ`-Ž€e0t´ŽÍ]ìíxMQ“CCªÍ˜Ðh«` §¨c"v§­¢¤Æ„öö ê!´ 60´”êqy{»^ÊJé;T (©lö…]¸ƒÜ” èÀɱýLq2•éA@ëÝMÙm¶çnQl^{ˆšY,‘ÃËݲ@¨E=í.–éQúÄôPL35]À”@ï¥sFµp8Ó:•W‹X¥É¬ýÔû½çùé“@À  úÄ̳bú#¡éýÓЭWÓ™[® ÿå›g<íý™wÈ8™!á!ãt>”y§&#Ï•;n£Aë/¦“ÿNgm¹’Ê„vQ)åBX½zÇír\Û-»ïSªäóÁªÃ4|Ûõ¦ú玼¬©ÿ±ä7ºÅ8/œÿUÑ÷¦ú:Ù–f··¶eý°óK.æŠ,Hw¤Ýdº6“sQ××å1dSº!å ¹ .Ц¶O§ñÚsdý»õ¬"A „" õV/¨4Ðøs ))–ÛéìVótZáð£ýID÷¥<ÂA?®ÿe-oßîÌÌLéPæ«èÞ¯?ûCx*{ ‚É gm½RFjÌ Ââ=·Ñ•ÉÙ›¦KÇqåÅßQi]9 Œí+…3¥ƒ‹¶Ý(âxjy"eåª^‹d“³E6 8ï¨K?áórö3T)ò´Ÿ¿ÍÚ£þ†”+éÎŒ[h_åAºiÑ–S}þÌvÓ™ñƒiwå>á ¥hãEªÍ…]_¥C-*XJ/ç¾+”ŒNI!BvʦײgQhH(MÚÿ­+ûËÔu¸÷‰çÐÃYækþV²>/Z!s°ß›ñJ‹7µÇÆf‘ªs«È¨­é‰gkêœÝ±gêìù®Ä^u¶Ï¦ÚÕ‰[ºvW´ÌâÔ#³ŠZ'Õ5uŠWëñ>MMM• SØ Þ5´ž|§be4##õ rë€'àWЀ§ÁdLÀ)•o¡è(B–¥À#ü½üE^@}DÒyJ÷šgKá•pÌùºh•ðþN²>Q¿±b+žèÍÜÿÉgË‹ —JYƒl•y9oKô¥œùVÕÈjô]ñt…¾ßÌ[`>Ñi1/õMÛ¨KdGð‰z80}wâGº§õXŠ,Êàøò!wlüÃR¼\Ž·Q§çC±fwF7³¦[Ïså¹1½à%x½ßažðxn+v‰êîí9è¨ÛørÚÍjñç¨TÛôŽöõ F)æf«ÔÖW‰¬E–çBG ‚³eAàû:὎?î–ÚZåú–u¼Ï˜Ð#@õxWyNLÀÇú œ¡Ñ1F¹T„°I<#~²ë•ç]b¹ûϲMb^»ÜûG[å’Ä dlO,k[圫U¶šê6XæG¹:ÙœþW]MÊ¥r÷²¤ Õ‡å6ÂD0DnO*MÔ ±íÝ],ÑÇSè.šzˆ«0eHËéJ©‚4‚ÝoËì\˜`z$Ô6 H•‰Ôh¾(°õ©©aïJWÙFEEIn®d¦qõÁÚ>??ßîÐaã›Ç`2ÉέΧ›o’Yx ½;;q=Ùñ¡Æ|âv§êtÅô½3iMñ¯Çu%ô~yÔ#¦‹<ÿXe.]²åfM_/wþ7 N(¬&êÛGdÑ»ÿ#5v KækËþ¤ñ›J¥ÖÑe;nUvå3<ÍǦ]+fç$xÊï¨ÜKHµÙ9ªƒ©ýÇ¿¡g¾dÚW6àÉÞ>2KÙ¥ƒUG¨R,×wˆh+r©‡›Ž+¨GiÙF9$¤ª„ƒÔµ¦}l ç¥"Hýä64Ç=ÝQ)wûi'$wÇê­óØ É}’ì„ä>;½žÉKðz½³áe¯xç×J{JõµŽ Áò@Õ!Ó¡°Ð0é4¤>Q¹®tņjµ)°Ñ\® µ„ví„0y^â™áÇ—Y¤ÊÄ1,ï«ÓeâKx¿Û>•zµð‰c›„w{|¨Ñ û(°ýV8)qaL€ è‰  zº›<& –"¦'hZQ{N¹Óø¯DØYFˆ4”M•HÑKë–´3%ºq_ÛV,ÍÚ±KÕ¶s¼‡±Ù*–!¥lµácL€ 0`"Àh0Ý-«. K½ïæ~L^ûÀ–TàýƒüOiõ‰µšiOH¿Y¸™í»!0"äÓ™NN7¦ŽÒ|¨ïÕ™ÚFdjú±µƒXžIÂ&Ô þ”‚kMis—²ëðùŽô›4çâÚðŒ·2Êag•4Ÿ-–üÕs‡æ÷¾Öã,Zò.`L ¸ ˜?áƒ{® ú†]wQ~m°{¬–ËÌCâŠ,AÊ.N‰ëGÑ¡‘TÒúŽ@·§Ý <ïBã­i£¥s„×pa_y^ü™4)óv§.§¦w:¿@c÷L¢‘{=N‘¿¿õx‚ðçLûKÿM÷îDÚgvûOµLö´—Îô©nóŸŽOÒ{§ÐžªÂT šÆ ×­ú¼Í˜hnì„dçxb0m§Ëq˜ìßfK'$xvØ>ÆêhòÞìôVÇõt`Aþg4/÷Í”°„ýp›{„ÝåYôà'éwa«‰ïJAýkÙÏ ›ÌŽÊ!鑌-KslàÁ;!¹\g¦œáÉw*gBR(êë™—àõu?y6ADÙqE\H˲Wh¾ô^þjÌJ¤ž'bin«Ü-ížõj᡹Ü]µ_} o3&À˜@𫊸?ýô“CTÛ·o§+V£˜‰;àJ&$’­<½1t%£NLía¶O—fê“ÄeeJX+y(-,E]%·ËêËešM« >À˜`AGÀohee%͘1ƒ–,YbÒœ9shÖ¬Y´~ýzºí¶ÛèÀýk‚ìÂà ÝhžF7¤\©™'„°—:<­9æÉÎßåÛéòícéü­×Ò„=æ@êÎöùVî)Ìðø¬ð+gO“íjEJËWrÞ¥ñ{¢G>Gê4·‰x›ÈnV”(°EÎôÑÉÆlCSÛÜ-+¾êàÒ/º' Šë/ãß‘)èî]ÓéŽí“é‡â_LÇ• ä…¿kßÃôÀþÇiO%kN.ü̘~±ݳg=üðÔ˜˜(Ï=÷œÕÜ÷íÛG÷ß?-Z´ˆ`ï±`ÁÚ»w/M›6ͪ­r€Ñ+$ç™m@íß KP¥åª¿ÐçE+¤W÷-©×ÈTJ'ÏÈT4j—Ö{AÍW÷úÔ©nÿ%„ÆïK~Ö´žp.ý«íDÍ1{;÷]/µ¹È­Žë"”Ðg]ߢÔðdy ‚ØÏ9ú:­É¡nÂîõ¶´ë513a#ûì‘—¨X<Ãsýº”ËM—ú¥äwšvh&AÈU ÎG0y”y9oÓ‚íÝ™í–ý(í[ú3Û€ºþ `P×™)g° ¨B‚Ÿ~ñ‚///§éÓ§SAA}ùå—ʵ5ÏRûõë'…OT 8–-[¦isüøqúùgób‡(+ËœyDÓØÃÁH+ÉÅuHÊ쬹UUUYGÎO>‹†§ •i8‘rÎ[eÜö­º‚øü±Wé¡¶ŽCAxµ>ÑÙ×'¾§{ëÇRJ„Qˆ´º@ã/ WˆÐDBÇÙ( âºB_Ì}‹žî`ÔÄ"ÔÐÃíïµ×%‹åøg³±Y?ùàSVÇáyÊpyÜRøÄÁ™GæÑW½?´:¯¥Àgœ'©Œ[â{\áá]Ùn©¯WçÍß©®Ó{¿ }úô‘$W­Ze—èÑ£G¥vTi VeÏû÷ï—ZRåØäÉ“iÜ8­†G©óÆsDD„7ºiq} E_KLÓ×Ô¶'€6už»õê%ou…õEMþ@8Q[ª>E³]VEYMü8+¡2Í9Øš'2yCpAlLK[Y„Aª !D.v8wAsª.°!õƵÕ}û6òÁ»[ Ñj©ßO\\'àîwjm­y¥Ãõ«òJÀ/¨3“Ça]9ä ^pÑÑÑšS!È®]kX]SSCÇŽÓ´ñÖNRRy«»ÓOëÖ­ ¦Çú–à Ï^Á3^ÿê÷€½¶ÎïÙ–¶7z•«Ï9)ª/9 Ú¦Ö&›–ÍÕçb»Um|“çw6tç+œÆ°}@T¯&ϵ¼ž­}äWßYµWS3©&^Æŵ, Ï75oËsôºBxÍyò£ÈWŸ½ÌKð)))ÒI–…"×î”'ߩО¦§ë?6²kDƒ¿µßœšB•––F………¦f؆=¡º`É¿º•–ADˆj•û¥÷yº3?…­gôçíò¢hnYzFu¥«’GX¶Ú ‹‘ÁÕ-+f·{”¢l¦¢Ô¶<9¶]–t¡<ˆ¥öP=9,‰ÆgܤmèæÞ3팶áQ"5§’óåŽÏPŒ!šb 1ôï¶ÆzÔ!uf¼6¿ Ë+n^M§yãõæÎ{@çàÕ ‡yø{žrÓß»gÔìP8Ak6hÐ š;w.`L€ 0&À˜€O °êS¼Ü9`L€ 0&À˜€%@-‰ð>`L€ 0&À˜€O œ’«³…¬/ 2…øªo_Œ7údv¶ï¸Ø+Jòl¯×/塭ὦxÊ­%~>*sƳ²Ýg®7p—.šêi+¨P¼˜ããã}r?uÉW}ûdÀÔ)òmƒ-êêjíÕžò…†ì$\œ'nørr7Ç´óWÒ_K°ó„[Kü|3”˜˜™ I¯ ßÍÈ“ïT„¨ã¢?A-%àEé«ÜΈY†8£\\#€fÄd,//wíÄÐÚQÞmŽêÞ @‰ꈭ{=ëÿ,O〶ÄÏG¼Oñß;œ Þµ÷ˆ'ß©ü‰ îÚˆ¸usðÍúusÏŠ¯Ï˜`L€ 0&°X Ø[ÃcL€ 0&À˜€> õ¼>o‰³ËÞ‘Ë>§ÐãÇ©®CGª¾ð"rtȧ2&À˜`LÀûXõ>Óæé±¶–âŸx”à”!lc {÷PÄÏ?RécO’p×lž1ñU™`L€ 0&`ƒK&6 ã¡ÈÏ?3 Ÿ¼©Å#ü×_‚q:pà9rÄT—’’B]»v5íó†}uÙä²{ˆXŠW ¬?ë³Ú*»ü̘`L€ 0€ àtýúõôè£Ò…^H/¿ü2Ýzë­tå•WZxã7(''‡’’’d]¿~ýXµ¢dû@õÐa.l>EN¹ô."ÁSmžTۻ鄰õRäÒÏ)¤ª’ê…p_~Ï$B;.L€ 0&À˜ð'¿H/¼ð=õÔSÔ¿=z47ŽFŽi•…cçÎôì³ÏRûöíýÉ@׎FeÌ °ß£Ð%T׺5Õõêmš›aÛVŠZ´Bêêä±Ð¼<Š™7—ÊïB(;)™8ñ`L€ 0&à{>@‘-âСCm&JFF†LcvøðaÊÎÎ6Í™s )OF«W¯¦¡C‡RÛ¶ÚåcœóÎ;ï˜Î9óÌ3é”SN1í{siü٥úv¾Íë4,YLÔ(|¢ô”?QLñ‡RHŸ¾6Ïqnoöà@IDAT÷ §â´MÎQædú@NNaj›½£ƒA¦âDV.®;O¸åç£kˆ¬Z+©8‘•‡ÓCZáqxÀ“ïTfímÐVú\ÍÍÍ¥ØØXù%¡PJLL”¦Zݽ{7!Þºuë(::šî»ï>;v¬Ô”*ç8q‚¾ÿþ{e—ºtéâѨ©#ø ñäÃÙF—Íz¨ÒNŽñp1*ƒ—¿¼ñAƒ/7.ZŽ˜ Ÿ9 ç‚×2kjÜðpĶ©>Zj½§Üôôùèêk)9¹¸FÀ“ïÔ:•òĵ«rë@&às_ –/h‚ %S—ž={ÒâÅ‹ ùbQ \¾õÖ[mV®\i: ¹ˆ¡1õEÁ8Ž‹€î^/B Éc¯ÔT×»?z„ÂÅrz}›,ªëÞÃêü¡Õ yŠë[%“äMõýúSÄšŒá™”£Ð:§¦‘€¨qü,>Bór©ÁF iâ<%33SæIæ\ðÖp1á\ðÖ¼œ9!_lÎ4ç6*`‡ýî_}öº;œ‡÷iªøÜÆwƒ£ Œ%Ø®áÉw*ÞãX=å¢/>@áÉ^VV&?è”_ÌXjoÓ¦†dQQAé °…CTïxñé¢TVRÌëÿ¥P1ª­¶—*}ä1"'MG.úˆÂ…' ôeuBÈ,Ÿò°ÜÇ¿p!`F®\!D… á²üÖÛ¨N8"¡T_4Âx.œ”DÁùecÇ‘°‡ûMýƒPýêËB¸-NLUTŸ,œ˜&=(Ô§¬élŠ×3&À˜`Z>—ì°{ê©§ÒçŸ.¯ ûN™Š ¹oß>ª‚´™“&M’š ,C.]º”Î9çýŸböñ3¡ÐÇ(¤¢œBj„Z]EQ¼«½#vö BðŒŽÆÅZ!û‰ØŸQïÏ—g¶ '£e_HáÂ'JÌ;oRhnŽÜŽX¾L^S}~ÌÿÞ'ªtBs$4ŸqOÍÚÏP¡i‚ýhhA>E.^$ûæL€ 0&À˜p…€ÏP æÎ;ï¤E‹Ñ 7Ü@¯½öM›6Í4Æ &ÐöíÛ©sçÎ4jÔ(?~¼l·aúå–[Lí‚}#D‹ á&áóA¶¢°Ý»ˆ Œ6Q"¿ÿ–Dn#«¶u‹<¾Ö:ãÒr†mÚh¬ÿk½QèUõÐ Ì„ímS%ôèQj&Šà‹ö{xcßMÏõL€ 0&À˜Pðù<.Ö¡CZ¸p!a™]‰ñ© bùòåʦ8ÇŒ#muça‰x›Ž&¦ ‹ © U°·-ì.m—F±0̆Q<®×¸Dáײ„Ô×QC˜KèhccìÂʲKÞgL€ 0&À˜@“ü¢UFa)|*ÇÕϰ÷Ôð)&ØŸ@µÂi¨A%ÈACYÓ·¿Æ4L“™3›¢_™'–è«Mh*®¼Zn[jA+.7ô¯z®Èo&Ñ1?«‘çUŸw¾´ U:”õ–³®«í¬TJ;<׷ΤºÌ6Úó…@]}öPu3ÞfL€ 0&À˜€Sü*€:5"7ªžèXº†ð'@aKY=ätÓŒ£Þx¢>ÿŒBsŽ‘aÿ>ŠT8 ¯s”†ìlªiLaªœ_Eu§ ’õH¹Y1þŸÆ¶BZŸÑšJœjr2ªí7€Ã-Ék‹–W]ãtúŠÜ. @£ŸêsÏ£êáËëñ?&À˜`L€ ¸BÀÞº®+}p[gÇ ˜F‡#Å–‚`Ì[¯QéãO“aËf ßµCÓêãæ>O¥OÍ$ÃŽí!le5ExÒ‡¯^E5C‡ÉÃu³©dælMe'Z8$…TC®(×ú| •uêB "RA“Eh<Ëx¨ÉfÜ€ 0&À˜`M` hS„¼Tzø •‘Å29‰ÐFáÖÛ®o´³4دY¾Ç°°Ä&SgJè±£Â{ݘ†SiûOƒðÊç˜`L€ 0`ÔO´’l^I ¡‘TŸd»^9©ñ:-â…Êåð„D¥‰Ã熸x«z„T’ýZÕð&À˜`L€ øŽ@P/Á#•œÜÞkˆ„ãaÅWT'âgƤgP݈Kœ¶“ÄB6þEÄǬ©¥úÁ§RýeW‡&ë×wíF¡;w˜Âa‰½þÔÓ(ÙŸ®¹Žè×µÔ ´šJQ‡R3êjãáðó½Å$ƧÔK{Òën03±@Ãÿû²<ÙŠjgÏ‘ÛøWý*œ›P”óÚµ§°Þ}ÈÙæú«÷$<êë.»œH£·UûÕë÷ÅÖ…‚ìâÝÚ+ºI¶`o‚>:nž¦”ôÑк[0;OR˜¶Ä÷8>ÛP"""èâv¨Ð|†VUjDM¥e"´›&íec¥"DÊ]‹qᘦ¾q_¶Uÿé>QBDÊMµð‰cˆCz¢˜´3F¶`lõ1±"¿|™¦ùá¹0&À˜`LÀU설"V'ì4±ünYêšÐšÚ ÛH‘ꡯ¾c6Õöè¥>lÚ–Bar2Õµ³ÖBªûRbxšN¨WÚ4M²­´‘jb¢Ü­qBÕAðqNHõiéJs»Ï °õlЊ©òZáÖ¬ìvÂL€ 0&À˜h$À¨ê¥P#‚ê…°¥r ÂмNdª9Õ˜MM bI=væÓ÷èt™±ˆ5Œ¨+¿ív“VRé£JØg"(< ‡¦ uÊ£òÜa"ØgU‰ òÊ9JÚ–^+œ“D)Ÿñ”|Æ?u}™ˆ!ŠR6U­E©SžË2¯¼úZc|Ø·Šå^<*/a›<Óþ¿1¾J8I‰­©Ò…ç~Ù}Ø?‰k˜`L€ 0&`‡€p¤†”AZŠ‹‹©\x÷v Ž=1b¹¹<:†jžlê>47—b^˜mZ¦—˜H±Y6yªpRjÔŠ%íèO>–i4k†œFµýO2°_~¢È_ õcU]<’jOlª›ú ÜV–Êqcª…Rµh'&JñO<*Lu}ÅÍ·R]¯>¦>bgüK¸ÎWSƒÏT>Å(|š*…mkÄ«I0Q]·îT—ÝÉTåÌb‰†mÚ(šjJ ±±V§eff’¯î‹ÕÅ‚ì@Y™Ö„A=|Ø–± ¨šˆsÛðª…}˜»¶eÎ]EŸ­À®J|¸[bm¼ÿÝí+XÎÃû455•òòòØîØÅ›ÖJD{9nÙnðÏÈÈp¦)· "¼†jãfÕ §ƒx³ÔZ¼Y¢>^`>qš´¶a7AõcOBð«;ÎF¯ÆCµ§AxX–ðïVÊCŠp‰lG¬ùA  QýO#|ÊÆâ_ÔâO¨L%€–ÍxR©²~BrõP¡qu³ '|µxpaL€ 0&À˜€'B=9¹Å+bpZ•ú ^ßž–[}£ÓFç#[×Âj£Ç¾§×çó™`L€ 0&à/~@óEœÊ¯¿þš¶[æ3·˜)êW¬X!ÂZæ[Ô4ÿnÍI'[9ò„ÐZ`ÞÓR}ò «.¤g£QXªWkG•Ƶ}ú)›ü̘`L€ 0  àt½¦>vìXÚ±c=ôÐC´xñb›pæÌ™C³fÍ"´¿í¶ÛèÀ6Û5×Áš¡çR]ç.òòõÂ>´!:šÊoÎCv2¹4δ4ª¸aŒ iÓ¦)Mâ¹bÜ*LJ‡’ú6Yqo•º~ý©D„‚ ß°^äh¥Z‘ÊS]ª®-=ò »wÉðIu"&&À˜`L€ Ÿ  ÈqèÐ!ê×ϸT O¶¡Ù;|ø0egg›xíÙ³G¶Q2 8–-[fªÇÆÎ;iútsæë¯¿^ ²šF^ÚAÎß”ÿÒV±wÜV[W¡ïF-«ÍSQ?@ëYo³]3„wl´ÐsÑ€—»½¢¤ø â ö¦æÓãÊç¿Þ\Ç v ?×Ï&ûŸît$ç(ïSd|ã÷ªk7Íáwj]9úìlâT®`>@sEè"$Ê,…]c¡È:¤@=*+¬¨  @Ù•Ï".g{¡!T R¢!í£/ Æë«¾}1Þ@é÷?0â…‹óðzã/4çy)-KD–.üÈÅg ר?“];ÓØº%~>ⵆ×¾{ Pqqž€'ß©üÙè<ç`jéówr5[æ·Æ›yaÕŲÚXj5:tè@³gÏVŸæÓmÄ|ãâ<ܳóÎ;üqºî:càzçÏÖ_Küj¯¬¬”±«E”¼ÆOG}ëµnÞ¼yó×^{M¯Sô鼚zM:ºx©HÅ‹šø,ÇsKxýþþûïtã7Ò’%K¨GŽðp üjJ >äsËØÀ€ÇŠV ÚÏ6mÚh°§ 'œEóÆ‚6jÎ… áx­ã ÿr¦»Çcu…^Ûø…–ò±B¥ž[‚0ê +n˘€5Ÿ{Ác™âÔSO¥Ï?ÿ\^}õêÕ„Œx @{°AƒÑæÍ›éàÁƒrIí‹/¾ ÁƒÍY‚dcþÇMhƒ: ,ÑAãÉÂgÞ,’O(Ú~dºA– 'NÈ÷€O.Æ2&  †¢øz&ݺu£¹sçÊðKþù'=òÈ#&v8tÒI„åuØÕ î«¯¾’¿¤'Nœè‘‘¼¯çÅý[€æoÈ!ÔºukëJ€‰4°ø¢…†ûl(ïÿ sVVõêÕËÿç+Ú$€^øQ†ô¨xà} ©'Ëý6/Ô 1hxO;í4éÛÐ CàK2Ýðk.ø¢¢"‚÷ £‚.1q^ oäèz\Çœ!€/U™xmBcϦ3Ô¸ 0€Š%zØŒ²™ o1–JÀ¯hK…ÌóN2!p*^RÎûÈ£<@aTšÑÀ#Ì#bO€ÐÀ¿GA3BØýñÇÔ»wï u CÄEàÄ3—À'€Â(:u üÁò­`I[ñ¦taôï¿ÿ–q­áŸ ø1XMˆ0&àŸ;!95 nô–äÞ{諒{÷Ê0LÈ~,v„°ãDäÅ‚…Ïà¸{°Á}æ™g¶å\‚“L[à¸>¼»Ñ@›Íÿû_úÏþ#SD#›~lsaLÀ}>ÃäþÐøÌ`!­á{ï½G³fÍ’É')Wo¹å–€Ô`)] —{Nls N š²+Ιµ¼Q+vÖHñÃBÑŠâÙ“ŒMÞ yäÈúöÛoéí·ß–þ 'Ÿ|2mÙ²…ðÌ… 0÷°ê7>KEËfóçÏ7y…B¨CX"˪Sü¾‰/7ÅÁ ã ¤±ù†N.¸råJ)|r¼`ÜP‹i(¦0ˆ)ªF›#Æ(´}ûö•+$?þø#qÆ„tÑ\˜pŸ/Á»ÏŽÏT@ºU8î äÖE]D©©©ªþßÄX lË/,ïa©…Oÿß o_©{¿þúkºù曽Ý5÷`ðãïcDQ‰ ÞÏÐ’ú³àºˆY=sæL‚(VwÖ®]ëÏ!𵘀î°Tw·´ù&ÅO½Yžë͂ݯŤà¼ýöÛ­Rúúu |1¿ÀûñEñÀ²ù¤œ¤bà aüøñú8ÏLCB!>wð€ZÕ4ôÂREwïÞÝô¹†ä*pH☀ûXuŸŸ©"ðØcÉè»ï¾[uÔw›j'"Øvri95máÂ…¦ Ã1%¯¾újÓ1ÞhYð#æ5x@UbŒz+à=2½ùæ›”““CÒ! 6¡\˜pŸ  î³ã3 lݺUÚCÁ&ê£>2qÁ2)–ª¼U Ý„¦“ˆ¼E”ûaú#aNx(ïáÄä‰0šžžNwÞy§| Kúzî¹çôgÄüH€Ñû6_Ê5JXey_,\˜`¢u7¬“"Ü&&&º3>‡ 0@U0x³ù À®KÑtBðÄ>&À˜€7 ¨Ã:¹+Œzs<Üh‰Xm‰w=Àæ ­‚Zèd'¢»A<& SJŒQ¤x°0ªÓÍÓ H,€ämÑÿ àD¡öœxæÂ˜hNFáI¯£¾ ëÔœóäk3@!Àh Ü‰0%–ÖÙs½Üpž"RJŒQ£>1¤ˆxØLÀc,€zŒ;°GKéŠÐÉžëö(ñq&À™€"Œú#à} sà±1o`ÔÛD[xjÏuìDÔÂ_<}& #JÀ{xÓ{ÖIGHx*LÀm,€ºŽOT@èTB%±çºB…Ÿ™Ð3 Jö%Fõ|§yn¾"À¨¯Èê¼_h6!l*NDì¹®óÎÓcLÀ.ÄU„QhI¹0&Ð4@›fÄ- (é/'":ù¥Á˜0€ç¼Zå°Nf6¼Å, °jI„÷5ÔND@¹0&À˜@Ó ŒÂƒ^ íÄÂhÓ̸EË"Àh˺ßNÍV ÏžëNáâFL€ 0‡ Œ"¤“"ŒrŒQ‡¸¸²…`´…ÜhGÓT<×!p²‘#R\ǘðŒ„OÅ^”cŒzÆ’Ïn,€÷ýs{ôJÎuEèd{N·Qò‰L€ 0·¨cŒBåÂZ@[ÐÝFÎuh8•G š:O• 0&Д£ÐŽÂ‘‰ Ð;@u~‡Ïuh:9ý¥Îo6O 0]€0Š`÷F9ƨ.n)OÂ@m@ æCXJW ì¹Ìw“ÇΘ@K'Àï[ú+@¿ógT÷B'´›Š='–Ú¹0&À˜€¾ÀNÞôÐŽrX'}ÝÛ–8@ƒô®+NDŠ='ç\ÒÉÃfL€ ¸A@‰1ŠezFÝȧ4;@›ý8?%ý¥"t²çºóì¸%`L@Ôï!ŒrŒQ=Þe}Ήп¯ŠçºâDÄBg€ß0`L ™@øT–è9Æh3ݾ¬ÓXu•ÿªˆØsÝÜùJL€ 0½PÞÃ^”cŒêå®êk,€ÈýT;±çz€Ü`L@Ôïc”—éupSu0@›é&b)]ɹ›Nö\o¦Á—eL€ ´ ð¾ÝìŸ*  ~¼Aì¹îGØ|)&À˜pH€cŒ:ÄÕ>&À¨C³ M'œˆðÌND>ÎÝ3&À˜€Ë Œ*Ù— %åÂ|M€PVœˆ°´¡“ `L€ 0` ûP؉"¤<êY †»œcdÔK÷ B'´œx°‘— r7L€ 0&Ðl ŒªÞ³óR³Ý ]^˜P7o+–Òá¹-'„Nv"r$ŸÆ˜`OÂ'4¢xpÀû€¿]A1@@]¸MjÏuœþÒxÜ” 0&ÀtAaaϬÕÅmõû$Xm9„NEË {N:›ÆÕL€ 0&Ðb(Â(´¢œ}©ÅÜv¯L”P!d*öœXfgÏuø`L€ 0%à=¼éáÈLå‡~ ï¾ûŽöíÛGݺu£aÆÑi§æ—)À„ï©§ž¢›o¾™²³³ýrÍ@¸Hh "ÆÇ¡²²2*(( ¼¼<:qâ‡M „Ãc`L€ 0  åMyy¹é{´¤¤$(œrg̘AçŸ>}ùå—„pTÿûßÿèÌ3ϤgŸ}Ö/ÜtïÞ½~¹^ \¤Ek@ÕNDì¹(/I`L€ 艀ðšÑ@ ëTXXHéééôꫯÒm·ÝfÂþôÓOÓc=FÇŽ£ÔÔTÓqÞð0ïu=ÁŽS±édÏõà¸g|XF±éÞ½»ð=÷Ü#µ¹EEER7ož\ß¾};}ûí·Ô§OºõÖ[©gÏž¦ó°rúÜsÏÑï¿ÿNiii²þ¼óÎ3ÕçççÓo¼A?ýôõîÝ›®¹æ:ùä“¥–x„ ôÀP=dû 6ÐK/½Dû÷ï§^½zÑC=DmÚ´1õ5þ|Z¼x±\©íß¿?Mž<™’““MõÁ°¡û%xʼn¨¸¸˜rss ¿v°ÔÎÂg0¼|¸ÔT>óÌ3R`…™˜˜(ëqlîܹtôèQzñÅiöìÙ´k×.- îºë.0`ÝrË-2¬ÕÊ•+ ÓRÇŽéÓO?•ýàŽ~úéMìwÜ!WŵgÏZ²d Ýyç²ÓI¾¡›%xh4ÕBg€sçá1&À˜`ðý„AEõWŒQh;_{í5zå•Whݺur‰ýõ×_—MXG–Q>±á…ÒüMúí·ß¨uëÖ¡S)FsrrèСC´~ýz©±D¨*¥`‰E² þúë/ÊÌ̤©S§*M¥¹–öQ …€ xĈtÉ%—LÔc3À.  Pc9[]pó²²²Ô‡ü²­†Ç̓‰.I}ƒý2¾`L€ 0&àŠ7}EE…)཯ìE~ æyXêÆ5† "'N¤¾}ûÒûï¿Oÿþ÷¿å¼ •TØ\béåøñãCE¥”víÚÑ´iÓä1¢mÛ¶Uªì>CÇüãââ4}]pÁÔªU+y–þa#Šå}xîC+ )lS“’’ìöhN  Ë–-£o¼ÑJøÄ„pã>úè#¿Ï 7 ö#Þ.0’†×lT`¯¢·‚1Þ,z+ð°Ä›^‹Ê½ÌjX²üñ§‡ùa^¸wøÐ[Ág ~+_RzšÞkx]ÂŽOo¯GÅ”KosÃw”6øþ †‚˜Üxeddød¸[·n•šFhcccM×€¦:Bl3Õå›o¾‘‚ŽA¹bÅ ÏSBwïÞ-ŽàÔ©S'Ú´i“útzþùç¥ #¥ -”zp8R_Ô¡o%¶*–Þñ¹ U< ]I§œrŠ xÄC»ùùçŸK‡i˜À± J1Œc̘1´sçN©lÒ‚rçέú äNi@ñK ¶ Ö›c©=òؘ`L€ 0à$-'ì>ÿñH¡úÐ`"L–´áÙ®”¡C‡Jã?ÿùO¹J ›QdLB4h}ðÁRpE{دÂfÎG(ð´‡÷ú½÷Þ+—å{ÛðˆWÛ€¢-âÂþꫯ–vÐþ"ÌV›Qp´žš 1œl ³ò„ýç´<ÒC}øá‡~KMå /,Gò¼3¤´mx ^Ë#öðÈKðÁp§´cä%x-`Ùã%øÀºS¾\‚WϦ[”ñ4±¯.ð‚‡MçË/¿,rX"‡º­…–Òmù£à¨‡2ÏÞùJŸ0td; 3ôÛÒ¦úRú ¤g‡Pxu)¶KP%Cúž>}ºTó*¶˜ $yüZà˜`L€ 0`$!®}ûöM½©•`Gõ¸†3ÎHä,Gm!˜C(ÖâP…Júï¿ÿÖÌ q¦,Ks9!YŽƒ÷™`L€ 0&àmpºÃ*ïp(€"¾•3Þľ à½irOL€ 0&À˜p€’ÑȽ³ù,[zÁ+Á`‘™öð²Â¶ú±`Á“˜­ (Çà†(ÿð ³W8 Ó`!ððâ˜`L€ 0& /5 È?Š8W(0sæL)|*}è³Ï>£®]»*‡l>#´Á¢E‹èì³Ï–Ï=zôžb–‘ ·J Uä>mªoË>xŸ 0&À˜`L ° 8@Xõþûï—é±à…`ôêåvÈv™~øa»³„ Õõ¬Y³žôpf=z´Ôš*Qý•“¡ñDøgŒ€•sø™ 0&À˜`L ¸8@SRRdLé²Ë.“a˜,C45]¬óçÏ7e@Ì*Ä·‚`ª.§„Œyyy„ «CE¼-Kï/ÔAVJŸ>}|¢!U„l˜¨½ý•ëû3懔az+ʽB½x;"ϯïæÏP=Î ï5ÌÏ[ú`{Íêù¾!|BÜ(ßÁvoWÏŸ%ŽæÍuGÀaPDÝW§¡²7|jʲ¹½68Ž74²@@˜:uª¦)RTÝsÏ=tÝu×Éú/¾ø‚ÆŽK#GŽ4µCôÿ믿޴ÿÀÈ౦^ÜÀ¢¿4¼ˆ( »âû·…Řp›VøÁÃE_  Ð0Z†a²5}gÂ0UUUÑO½†“;bL€ 0&àSåU!´é`$m;áÓëpçú"à”Sîܹ3ýöÛoòås‰ƒ ¢^½zé‹φ 0&À˜pŠ@N±ž[–JÐfU‹ðÞuõ!ôüÇ(Âié©Ëp#pøA*NžïÝ»7ýðæ˜ ŠÐ‰ðxÀ!›¸0&À˜`-ƒ@eM=¾8]3ÙzgM?·Hs<èwD6HYDr áÝlÓù£^’­8@o»í6B>ö?ü.¿üréˆd‹º3q@mÇǘ`L€ 0à$p° œb"ꩼÚ,54„Ð߇¢‚sBvF¶a=E}ö QM­È¨SGeS§SCb’Ö¾;|ß}÷IGn8lë¡8@ׯ_/Säa¢¹¹¹vçËq:í¢á &À˜`º$^Oõ ÖS³u̺Up =tˆ¢|`,¦;g6•>ô0‰üÁ¦ãîlÔ­ê¶mÛiÏÛ´i£é™(!wuëÖMf‚æsË–-4`ÀBbŸÈÈHÙm°ß®];Íù{÷î¥êêji>©Î"…øêx ”&’›4gq(€þßÿý{ççT•ýñ3“é) ÃÐAPµ-¢(v¥,ØE\],XY ¨ ö•ÕU׿º*êbTP±cDA‘&Hï3Ãô>ù¿ß_H2I&“¼´—ßá3äå¾ûν÷{_^Nn9çaéÕ«—œzê©ÜÊ^bÙ$@$@$f:æÔÉámkä׉R§­ý„ÄÅZå’Í3ýž¸ô§´­´jvü/«¥öØã‘ä“ìÐ Û¡C‡*qûöíj©#ü Cn»í6åq®/‘ïý÷ß„+‡{J¦;wV¾Õ®ï÷ïß/}úô‘·ß~[ú7nœlÚ´I¶ðµ¾téRh̘1²mÛ6•¾|ùryùå—eøðá>Õ߈‹< Øt4cÆ 5 züñÇËgœ¡þ°ùˆ£žFà§  ˆ\“O-’ç—eÊÚ]‰‚Ñó”ÊŸºUEnƒœk®… o"Öm·•¶ãÊY²d‰Š*9þ|5Ryûí·+”éœ7ožlݺUr"ùSO=¥þ¼ð rÅWÈ)§œ¢ü¥Ã@EDJ„2‡1ûñÇ«Íá‹/V£§p¡ùì³ÏÊ®]»T¤I¸Ð\¹r¥ªõƒ>(/¾øbø o½õ–ª4â²c|vΚ5KmLBd$Ý EØL @tˆÑ†¯8Ù<#žÎ½‡Qθ͛’c´©óº#û8¤µô ì§ûî»Oí³9÷Üs£™Øô=7 2yòd¥²¼¼\°!ü‘Gq(âÛo¿Uî1‘ˆ)öÑ£GË«¯¾ªì2D¬ìÒ¥‹ 6LFŽ©ü¸#ßÍ7ß,˜ÙÆHê7ß|#ðÓJñ8ŠŠÁÝÒÙgŸ­þðqÝQñ/¿üR5®ºê*e¡ã<…H€H€H€Ì@ îèþR½o¯$~ò‘X““Åj‰“ÊñWŠÕÏ`901MŽÁ½7ß|S‰ÚƒÐçÝ»w—«¯¾Ú#¾öíÛ«‘S=FN1 yã7Q(,X ûÛß”Á9xð`¹øâ‹å¦›n’k¯½VðþwÞÑ/Ék³¨}­`‰Ö×_­ŒP¬!ÀBV¬=  €ÙÔœq–Ôž0Hb*Ê¥!+[´!J¿›øßÿþW0»üÌ3Ϩéó+VÖkb$Ka[ÁÅåK/½$‹-RFeRR’ŠB‰ÂÇŽ«¦ê±G§ªªJ±ãÇWŒ0Eû ÓúñññÊÅ()f®o¸áihhûï¿_° *”Ò¬ºf͵Óï°Î±ó $€ƒƒz @tXúsª|ó[²Äk.2/þs±tní¿a£ Ê{«ReÅïÉ’žÜ L-[«¶cF HL™÷ë×OØÝ~æ™g ŒL‰Øý®ï€Ç:NÈI'$S¦LQFèE]¤F8aƒaä®21jŠý9—\r‰ 8PÍ`càëL1›}þùç+Ø5?dÈÁ2ËPJŒ6Üë‰Bc•N>ùd5ÕÞ¿pu8Hqq±Z`t]о֭[«Ýe¡þ…`tÛ /++KŠŠŠ¡:¤:áœ733SöìÙ£¦1BZƒ ÇC.3pÏ›MÐ.ô'Wo‘ÚfèÄg.žì¥  @…RÁâÝ‹ÇEãñŽÝVX—.Ægˆ¹±x  ˆj;‹âdÍÎ$ÑOÀhÐ ÆW¾iå—­âeÓÞDe|BQœ6²jVñèl|¢­˜2Ç`‘³`„T7>q6 Rgél|"ÒÂÁøD]< Øeõúë¯K‡Ô,¼"2ÒôéÓÕv3þ: €gåÕ±’š¨¹$r’J»ÈHN§¼z[^£EXòÏÍ‘W1SH x4@aUcë< «W¯8KE((,”EøÍììlµÍ;­($@$@$@ÑC }VÓµž˜‚ÏLñÏx„ƒûF—ïÑÃ2[êÑu‚mÿp‚ §¨ØÁ?VðÐ…´   è!šh•kNk\ 'ôÉÚŒÏÛFð BzRƒLzH/ŒZŠù4» MÞ¸q£r—ðÿ¹~ýzóylé‡Ç~xà§ D.¹µrÿؽj#R¼Å*Gw®R»áý¥Ð#¯VfÙ'ëw'HZ´eú«’ׇè5×\£|Oaw*¦Û1§¦0<±!)Ô‚…´p e´X,+ž±áÊ~±¯Ñå„JÚn¡j^.mC\-ÈÖóDê+îuÜ—fì7´+PŸåP÷7îIü±ßBÝ-+Ï~ì‚7£âY’§} çe鼌ûNn§©j—£ë5coDw›< øÂ N¸b GcL7ìF]§þj¤îpÐ¥?€Â¡.FÖA¿?ÍØoè3³öÚ1c¿ážÄŸÛfö{’ýfäÓÙ?]¼Eú§˜W‡”€GôßÿþwH+×\á¸)áCËhÁ¯_Äd…¿-3úÅhL ¸Ý-Õ_’pidf{`áË#ifì7gøÌ™±mhFäÍØ6´ ÷¥Û†g‰Yý€â “‘Ôo¸Ï(æ#àw¯Âãþ­·Þj>2l @@øm€Â7(â•RH€H€H€H€HÀ§à½Q0{ölo²1 ( П~úÉ«u"ˆ-‹p    hŽ€Gë;׬YÓœiþüùÍæc    ðh€~óÍ7^ùBÃNO @h ¼òÊ+2|øpÉÈÈhqE^zé%5j”¤¦¦¶øÚ–^àÑMOOo©>æ'   Óø¼è¹gËÃRZ_&‰1‰²¨ï ’Ÿ¶í{íµ×䤓NòɽñÆeÈ!A1@[´ þwìØ![¶lQ›6m’•+WÊÒ¥Kö#X1   ð…Ào¿Ë´ßºb©³ÖKEC¥ŒþùJ)­+óEíšÂÂB?ãÕÕÕR\\l;àÀùõ×_•ÏV=±  @]³yóf=I~ÿýw¾]uyþùç%??_+Û¶msЭŸ@”ËíÛ·ëo]¾ºÊãª./n&Ñkôå—_–ÜÜ\騱£tíÚUý!çÀU¸ÎfÊái   ˆ(lÚ¡¾V±J­µNÞ/üÔ!½¥oerîܹ¶Ëf̘!<òˆzÛm·ÉQG%“'O–=z('†©õcŽ9F¾üòK7nœÚƒsÝu×É‘G)[·nU×}ôÑÊ0-))‘N8AÎ=÷\9å”SdÚ´iêü®]»äÌ3Ï”³Ï>[ $Æ “úúzuNÿÏSçzè×´ôÕktúôé2fÌùè£Sóß~û­<þøãÊÊþÇ?þÑÒr™ŸH€H€H€š@UCu“úÕ[Ôhh“-H˜0a‚``‚¨[¯¾úª\~ùå²ÿ~™7ož2&¿øâ aúÔSOÙ4ŸwÞy‚ÑQœ‹/–eË–É| °Ñ`4Ú ®=âˆ#dÕªUòÝwßɺuëTž›nºI¶?üðƒ`4µ¬¬L>þøcûK¥¹''GÚ·o/555¶tìï±_CŠÍ屯‡MQ ¼…ñÙ¯_?¹ë®»¤´´T°¾àõ×_W [²d‰ZÚÂr™H€H€H€žÀͯ‘%}çÉ=ï—·û¼(G§eH1å#ò“O>±6b4SãØksüñÇËÆ塇R£žö…îÝ»WM¯wêÔIn¿ýv™:uªm­¨žº0¢ŠõØä„ÝíØT4vìX5Í£ÓïaÅZQ{ñ&}~_޽…â'Ÿ|R-dE®ºê*µù0ööÛoûR6¯!   °'€OG=‰MÝ0 ñªûÝĨ%6(!º$þ0Eþì³Ï:_*yyy‚`AØŸåååâþ<±žÓû°×°lÓü]t‘2L;ì05ò‰õœÎ#®ÞäiR©&ÄhýVo¯Á-þÐ ÃýÒé§Ÿ.;wöV…¡ù°6µ¢¢ÂPP†_ÜXèk?|mxA!Rˆµ#EEE!*=pÅ&'' Ö&c½r nëÀUÈ@ͱ±±j󟽛Õ‡T65¢ïðËÜl‚gIBB‚úr0[ÛðYÃ} w2fÜØ‚Q#³ ¾Ûð=Žõ‡‘"¸Ï`pBvïÞµJ§½+¤–‚ÑIÌ8ãûړໟAL­»“ƒªï‹ÅâéXb‰g”;ñ&»k›K÷j J`hêÆ'ÞÃjŸ8q¢|úé§ÊšF…H€H€H€HÀ?ùlÎøD XKêÉøDüXt6>õtOƧ·yÏñ8mû~ø¡Ò ŸS³g϶mDB"¦ß.\¨¶óûR8¯!   ˆ> P¬ÀZLC`*>§ì­hL/uÑ\`,…H€H€H€H€¼!àÑŰ.Ü-AàK î|Ýz5‡ØÙ穞ÖE¬_¿^9`0`€Z‡éM#˜‡H€H€ÌB V J³í@¼X´Er]r¹Ññ·}µZ´Æµ;4?B ±’›â¯¶C××hz·ìO„x«tim\}«kcd«Æ!Eó % ‡Á£ ðh€Ú×;Ýá+ Aî7lØ ÖÂë> E,ö$‹-R®à¸.àGT eÝ£>*kÖ¬QSúO<ñ„ S…µ¦  ˆ¥•±òÀâ©ÒŒ¯Úú©Óþ¾h¯$jÆ?r°"VÔôÖÖ[¤¦Î"1’'s.Ø+ ^[®K/,‹•‡–hþ&5£¹º6V’äÞ¿ì“xÇý.®/öz Ô"/É‘º†©oyõ™y*" x¶íšg§½{÷VŽS >¨þþ÷¿ Â0a×±;Á:Ñ—^zIfΜ©Ü7!Ö)Ây:ïÂÞ²e‹ ìÔ3Ï<#·Ür‹\xá…Ê}€;½L'  3€¡uËÿò¤ ,NÊ«a(Æj‘ÇEþïóL¿š ãðöùyRT'eU1š^íO3l_øÂ?½ùœñFž¬°¨úÂX,¯Ž•y_µò«¾0¾ï|³WBo¬ÄùiÌúU^0^ÿö¹òÊ+•£Ò§Ÿ~Zú÷ï¯*ô /ØB8]ýõ.+‰5£ÿýïm>®ªªª”ãS¦ö‚x¤}ûöµ¦bdkNíFð_ÿúW[ü‘ê¡¢l‰`ç˜#Ö¹¹¹¦kvBàfÄl‚¶á¯¹‹‘ØnÜh›YïI´ ®NÌ&úÌ—Yû ýlwn[÷‹6‚h•ÊšÆgYcbdýîD¿>¿iž†R­š1ç¨÷×I~é]»£©ÞkŒ¬Þž¬éuïÚ§¹ÏÂê-1’š¤ÕW3–!ø QÌGÀ+¾6S†$žê¿\ÿ„QKw(òêVáWíŸÿü§Š_êl$ÀW«V‡~5¡œ‚‚½(õŠóp¥ BEÁ 5Zð`… ¸BÍ&©n¡æ„>Ã3¶M7>Íè—F5úÎŒý†ûÏ3úÖC3›±ßp?Âøt( ô3.FA´Z›þXÁT¼_œµ5Ÿ Öä&ÕǦ?z­õ¡mª·N_òG¯XµÉYûú*wå4B›t`„'xe€âȇ(<í; Ölê¿„ÏÙ¿Ç'¦áñ¡¾ãŽ;ìO©c<¨í?ìp gÀöÒ®];¹õÖ[mIpÊ G­F v÷cĆ·¿8Пàft?´Tî|)"´X°G.ZZ×–æÇg ÛÍØoh>ÿfl›™ÑëÆµû-TŽè“5»ëˆö±Úb¢¶ö³q…\¼Å*§Y¦}>ÊZúذåo¥ Fvo+kw%hk*é~t©¦·é÷ºíÂf°‘©SN¬ü¶G«¯fu½=­Hºæjz-õsL±œÔËwãS×;í¬Bé˜S«éµJZ’ùf"õvFó«W# „iö‘#GʱÇ«ÖcœrÊ)jtð‚ .ë®»Î#ûîºKzöìé°~S¿›Ú¶m+ÇsŒšžß¾}»2<ßyçU–ž¯$@$@$`v±Ú@âäSÞLèýëéEj|c(NÿDTR›œ‘ëÏ6>+\PMÖ¸ ¯q–50¡8 M…^ðÚÅô÷·ß~«vª¯[·Nb}ôÑ‚?O‚C¸óçÏ·eý׿þ¥6M™2EEXêׯŸLš4I¹wÊÎÎVñå/ºè"[~ ˜ƒ@Œ¶V®YçbX ·ImÚ´ x«QÖ‹zãðk@1½o´`Ý6I8pÀ”k@_ÖÙ –Ñ C¡ë¶à¹nÁ¼¸­CQEŸËÔ×€âž7›` (únß¾}fkš˜y (>k¸/í—N™¥Cµ4üðÝÖ8ZŒâ )÷6=B°:PÂe„žÉz\ cðšk®Q;ßÑù˜F×##yVëûY<°½1>}/W’ @ôøjC²Ü1Ï"ÿX(»z=Ú,(ø)öržÜôJžÚèÔìÌà–~ˆ¿õÖ[nÏ»:áÍ5Þäq¥;i PøüÄÚÏo¼Qm6¯B¬ù Ĩc IÝ$@$@$Í^ù:Cæ})wÇÊšíq2ka®ü¬í¶÷WþþF®üð{’rš_Q+s—æÈÒŸSýUVׯӼÜ1¿üí¥¶šCÿ6RaçOÕèŠÂP\°`A‹Ôzs7yZT¨™= ¿9yòdA䣫¯¾Z^~ùeÙ±c‡Šén@ÙTA$@$@$`kù冦FἯùÞö¥ p…¨Mš«x‡Ë­LwxÉoö[äqͨ.Ò¢=Ák±Òôî¹*Tª?íÂÒ{7Xzˆ%VUþøã+Õð…Ž<Ô£ –O`ÜVB–›Ù_7„Ð÷h¿þú«À¥%Ä>®kÛ¶mªLý=^¡÷·ß~S!×õkíÏyìÑÅÈÃ?ÜVÞQG¥¢&lݺՖÆ   ð%PZ«EBrŒ>ˆÚ"Ì¥?ÃVóßDEó;Kš\¶ ÿûÎÑH·jÆv­ÊôûMŽ~Ê[Ú€n¸AæÎk»lÆŒ‚På+V¬SO=U¥Ãæ>|¸òôå—_ª‘QlÇ€ <õèÑCíç°¿!ÒÇ'ˆ&yùå—KŸ>}¤¤¤ÄA/ÞŸp rî¹ç <M›6M•¿îÈ¥—ˆ2‰ðë\ãíñíú/''‡Sð¶[†$@$@$Þò20 æ8J Ã1Qó êÙÞU$BÍDs.ÊŸBB|mµ—ÞY4l õG&L˜ f•¡_}õUe0:ë<ï¼óÔ†hœ—]v™,]ºT>ûì3¹ýöÛ݇ú&ü¶c“'®±»Gq„¬ZµJ¾ûî;5¢ºk×.¥K.?øàY½zµÚÔûñÇÛ_jè±GÔÐ’¨ŒH€H€H èR´8ð“OmôÕ GôIñVþîQþyžÈkÕèо±A0f1>(2ÓO½Aä¡Àã?ãs1@IDATƒ§GC½V‹RÕ§£+ãÛƒ"§S't’™Ä49Œ¼îÝ»K·nÝœr‰ B1ÿüóÏ‚@ŒlB† ¦"ÿ5¹@K8çœsÔ58wØa‡©éxû|­>bÄ•„ßï¿ÿ¾`dn1á—£¨ݸq£!Uí uqÜì6¸E‹ œÃë²ÿ~Y¸p¡ØOÃcÈ›“($@$@$@áG {^­Ì½O6æhFb•_$É Ž†•/µ>ý¨ é]'ËÖ¦Hb¼¨Kˆ´dÜ«R~ߟ ßnJÑŒömÍ¥ÈÄ!š[ÊŒ¦KZÒf•ãÇW%±#¢®D÷ ÃSçX£‰0¸•••Ê–«kàK]¸°rvKW\öëOaÏÁ¸½í¶Û”¡{ÅW¨º]{íµM®ÕõñêÑíСƒ¬_¿^ýé…edd¨áZ,‚Õ gi€ê4øJ$@$@áG '½^zvmÐ —:͘ñßøÔ[Ø»]àϬrÙàb9³o™WZ¤]f­ÔvX£yúé§ 6!¬¹'=†QRl¿øâ‹U~LÝû"£GVëI݆ ¢Fa±ÎtæÌ™jôÎ1…µ (†e)$@$@$@$ÍòZÕ þŒ”Ž;J§N¯©©M½8—õä“Oªh‘sæÌŒRbSè-•Q£Fɼyó”A‹VŒtbúúôérÓM7©°èÐ JXO(ñ*R  ÷W/#!ùF‘|ãÊ« )”ô}/›‘|gÊ+½„TQ[/ïo,•$KŒœÓÓq·´?õ×(å‡-É’`i]«ýQÕäÚ@DBªÕ껣0^âµõ¥˜Ž7Z I[…ªÍý?ÿüójj<°4‰0-cÑ9xð Ú¤„)}]0ªŠtûi|ýœÑ¯G@.ŒúH€H€HÀ ~/ª”Þî¨Yí´æÄÈ;߈Ü3f«´IóϹûÞâX¹wQ©ÿcvõÿ>yèÂ=’âŸÚ€!?X+¿—£ùÅŒU¾1[%×ËÝ£öKÜ!›&`eG“b™Ÿ|ò‰ÚÑ>pà@yíµ×»Ù}5>ÁátÆm0ŒO”Ë]ðÎôùžH€H€<¨¯·Êƒ‹´ËÖ8ÍôŒÕþG î^phó‡‡ËÝž‚Ïð{äýa|Bg£Þ™ Ú¸½&”'´`¹ýõ<åŒ>Eëb”ÃöW¿1n48”í ·²_xá[xtD©¼å–[­Š-ªG@[„‹™I€H€¢À×ÛË4Ç!Z³ÜØàrH/ŽK4Gòá(Û âµô R©…àÔÅj‘•[’äÒ‹õ$¾D ..N¬þ RR5‡îšVƒ…“ @dHM´7ÕÙÞ =”êýüsº×å¹Î¼Ô87D½f„RH 9nnŸæ.ãy  ˆNòÓ$6Q‹Ã­F+àØ’¼ÇçÑOh驹2ÊHÆâO{CÔ*[‡§‹£Î­k¥cv­XbÕ7Þb•ó–4Báÿ$à PpxŠH€H€\xtl•ÄÄ+#Ô* ’–¹MæŽ;dˆ¹ºÆ›´{5gñ)Ú´v£j•^ùÕrËðo. IžkÏ(T¾1ã4#õ>o@‰œz¢QHÀ3®õ̇gI€H€H  K¬¯=ô¿¶ÌOºÈ¿™‡´þHà ·_¹9ùùùÍeáùˆh? ˆ€E¹F Ü$&&Juuu@ÃP]ooõÁ7¡}.o¯ ÷|p‘ÐØµ¡d€{Q+Ì&hüÐáóf6Á³÷%Âç™MtØf|–à~„ßE_#Í„s_ã‰vEÒ³õMII g¬¬›Œ·Þ|¨„¯—à¡^ZZêëån¯Ãƒ(t›ñájfGôx¸Â‰®sì[·!'`Ĥ§§ ‚/˜MÐ.8þ.**2[ÓT”Ü“ååå¦k|â¾4c¿yëˆ>;5ŽèÍ÷ Ð@S¾þˆ6@ƒ‹%’ ¬ß _,ÓFÒ´%'ž =óÃs“ {Ê‘À’Ë»›>’¤˜Dù[»‰Ò9©ƒc¾#  DØ,ŠH€"ÀŠß“äÅ/2¥Ns:ùé÷{\± éÍ'áÜ·mû·ÌÛû–­ŠŸ|%ÿ>|Žßj€-$LÜLÚ,‹H€"˜b”?÷y–ÍøÔ›²ð‡t)¯¦ïGG¸½î¬Þí`|êõûûïsôC¾’@Ð Ð :rH$@‘I¡âþRn×8$¯ÐB1R“@Qm‰´ŠËhR¹’:ã÷P4)„ $à†ŸnÀ0™H€HÀ‘@BœUZ)GéŽéZ(ÆV)æÛéïØÊÈ}×1Is5¤íêw–ÄXc\G9ëå{ð† Po(1 €ñFdêi…ŠŒÑ-ê äÖá´‘QuÈÿÂF?ç6CÕ,!&^Rb“$Ý’&oõy. kË*E >2¢¥§ÙN 0€@^«zyðÂ=òëžl- PŒtÏ)”ì´¦ÓòE8NÛl´°Ïó²¼f•X¬š:H2âÒ ,ªH eh€¶Œs“ @ÔHM´Êéýê•ÐÂBŸ‘rCÀíÒÀGKMM””0^{¤ô›YëÉ)x³ö,ÛE$@$@$@aJ€# aÚ1¬ „3Íå[Ūy^Ê‘Vá\MU7DFÛRµ]bcbé|=½UÛP+›«¶J¼¶¾´[rç”@•f$@ÔŒ½Ê6‘ @€T5TË”õ·È–êíRg­—²ºrYÖ¡¤Ç¥¨DÿÔ–×WȤuÓegõ©µÖJö·¬ÿ[’lIöO1¯VÔÊk¯—bÍ¥SY}¹tIê(ÿ;êi‰‹± x$À)xxx’H€HÀžÀ9«.‘ŸËÖÉAÍ·$ŒOÈÔ ·Úg «ãWž'k+6Hq}‰T4TJ½f4_¿ñî°ªc¤V#Ÿ§ÿ4N¶Wï’’úRiÐþm©Ú&³·ÎÔ&±ÞA$@4ˆ°Y D2ÊúJóòz퟽l©Ü&»ª÷Ú'…Åñ¾š’›¨íÖ?$Víݪò5‚‘QŠÖVlTîœìµ4h|ß/øÔ>‰Ç$à’ P—X˜H$@$àL V›Vmºr«\YŒišî|}°ßcMbŒöÏY°Œ VûGñ@#ߦ:œ 4ÍÁ~y xG‘sF¶>[cEÐywTj/ÉMÈñNIseÅ·’S3I‚]}q<4ëDm hRkb΢z§öÃ’»HœZï‰{cR»KÌÙ`¶ÊPü h(N*# s˜Þiªœ‘=Dbã%MÛx4:w¸<ßûѰmôÌn7Ëñ4#4^2,é2¶Í¹òàaw†m}#­bO÷|@Ú'æk&h¬a)Y®n™LÈ¿ ÒšÁú†€@øÍ™„‹$ ðŽ@LLŒÌì6]ϼïGô¡9½»:ø¹àzéŸ‡Ï ~ÁQRb¼öCdaß磤µl¦‘8j$Mê"   h–@PG@ËÊÊdÕªU2hÐ —Û¶MÛI¹k—í\NNŽôèÑÃöž$@$@$@$@‘O hhUU•Ü}÷ÝjÊÆúì³ÏÊÞ½{%33S‘íÛ·/ ÐÈ¿ÇØ0 õ¿ÉvÎÓüIVikÏ‘¡ÙƒMÓ¶–4䪵ÓeEÙOê’?¥-ÿéý`K.w›wEÉ*ùß¾EÚù¹¼íX9*­§Û¼-9ñ]ÉJy}ß;Ú*E‹¶>qœ`óL8Ë;ž—·ö/‹æuà®.7È Ìc ©îÊ-I²âs‹$Xex?‹´Nwt§åk!+6'É7¿%Kb¼UFS*9iÆèõµ>¼.2Åݼy³Ü~ûíÒªU+õçÍÆeΜ9Ò©S'wY˜N$@!!ðKÙz™°nšý§N•ÿMÉ ¹ºò2™ÜþÒÔ'T…ž÷ÓxÙV»ÓV< Ñ!?Œ–ϾiKóåགOäöÍÿ°]úQÑ2™ÕõfÞút[š/oíOfmyÄvé‡EŸËœn3䌜“miát0yÝÍò}é¶*ýuãrmû+åŠvþmìY´2M>Xþ‡Þùþ·62íÌ9<¿ÆV–/ó¿K—ÏÖ¦ýq©U~Úš,7s@ºµ©õE¯‰"A1@+**äŽ;î‚‚Y²d‰K¼ÈSXX(û÷ï—eË–É!C¤C‡yKJJdÅŠ¶´üü|ÉË˳½7êÀbit)¯FlÒ.zbcc%111\ªcX=ââoç„„C.b SbEØøûÒŒý†v¡}áÞ¶+V2>õÛᎯ˨vçH‡¤vz’Ã+îIü…{Û*íáÍÆ²ÍƧžµ¸¡D¾/ûQç¯'µèµBspoo|êÏÞö/9«í©’jIÑ“ZôZZWæ`|êÏÚú¨œžw²$i#®}†øñÁ–ueŒO½üí|N¦t½\ÛâײX;ã—7úFýï—YòÐ%[¬O¿`oq¬ñyHï _dÉœ‹Šõl|%—‚b€uÔQªðÏ>ûÌe%¸iÓ&©®®–åË—Krr²L›6M&L˜ Æ ³]ƒ‘Ô)S¦ØÞOŸ>]&Nœh{oôFlÍ*ÙÙÙfmš˜¹mf1d\Ý|áÞopÂ.Œ~êõG”Ú¤úfï¹”ß (½œpy­ª[ï¶*¿Ônó²Ïq{ÞÓ‰úªZ,ù4Áh/˜‚ŽK‹—ìdßžWÕÒ*>Cе°¡¢Ù_I­’%;¡q¹—ù¾)¨,VŽó­É^ðÞŸÏÇ*‘ôd‘ÒJ{­"åÕ±~éÝ­u—+½¥U¿ô:ÖR¤®®qÖÁ9ï#›@P PoõîÝ[,X YYY*{÷îÝå¹çžs0@8âùôÓOmê0j‚5£F ~ýbFlÍxãð..6߯Ӥ¤$µÄcß¾}!½0ú>´×‡Që´´4Á,€Ù$55UýèÏxþåææ6Wž0M?™!jÀÁƒÕ—«n€b(>p ¶ipL­¶kwhª FT ìúÔ ^Q¾ÅŒíÒû mÓÍÔwf¾ÑOá~O>pØßeØêKTT-zµ^î~—dZ2ÜÖ]¿ýmÞ~Nrâ³edÎÙ² à=‡KþœqŒ–ÔÙ-‡Ì.Þh äŸ=fÊk¦h!=ãUŽZk­Ì;â e@úÊ/A»úÑî3åÒµm4D±”EU}©÷ãÚv$‹ÛúêŸ5_ËuÑD¯’òâseZû«äÑÏ8ä®×#nëêÑÍ›mUÒ„“Šä‰rÄkÕh“ðšñyçùûýÒ›žÔ — :(Oš­ŒYèŽÓlÑÛÏ=à—^7Í`²É„Üݲe‹´mÛVÈÝpà òÚk¯ ~}¾ûî»ròÉ'ÛŒO“qgsH€"Œ@»Ä<ùrÀ"ycß»Rm­‘S´=RºFX+ü¯îÝnýdö¶¹Ò`m‹óFËÔ¾¯OÔkÔ3¥»|tô|Áf$ÈЬÁ’ŸØF?íó+vÒÐïUù ð3mœ.VNÓ<ä%„ïhÚeíþ"=R»Ê‹{ÞÐŒñ8ù[‡‰rXJŸÛ¯_xd‡ù»fpn<-1Ú§þ %-Éqª_ÏÛ’×~«åöûåçíIg±Ê ’’è¿Þ–Ôy#“@È P¬éœ={¶ôë×OF%“&MRÓÞ2k£WDæmÅZ“€9 `3ÌåùcÍÙ¸´jXë¡rq÷Ñj€›G’œø,¹¤íh£ÔÙô´Ih-—¶c{î'´ú“àÏhÉϬ“>ݤ¦¦V›q4ÎHì]'²—O]wê3mªÁ¸»Ð>˜ò€Ãz ÍI ¦à±f«uëÖ‚5iµµæs%eEEEÍá¸óؼ²{öì1Ý<Ö@¥§§›rí.Ú…¾ÃÚ]³ ž%X:T^^n¶¦©ÏîK# Ðp„ûßEÁ^Œöã»­¦¦&¢Ö“ã> „Ç›`ðfî Ø¯vŸ+ˆgp£yc|±J,ŠH@#°³z·l¨Ø,Ø0B‰pîþMñ!÷uá^óU»F 8üPºÚPµ¿ÙVµS}6 ULe$B>ŒÙDˆx÷üþ°ZC‡ eõåò^ßyÒÖ€õy&ŒPQW!笾TŠëyNX¢õ›ë*Ñ쪆j¹vÃÚœMR«¹»Â&¯Ïû¿)ÉÍRXS$çþ|¹½ê¢O5½™qÍϲy*Ÿƒ«×ß,Û5c¹Z«{š%U–ô{YbÍç‡Øž#_ „ݨ¯ áu$@!ðàÖ«!•ZøI|éB.øuŠÀy8%| ùiŒƒñ‰šŽúùаÝ|ÆO¨Ê’ú2Á½†ˆS×mü»ß€‡®ë`|BáHƒ¿2xåùòkù)©/U›Ò ëÊm›î÷W-¯'¨!@4jºš %ß|Pø©ú‚u¸Z›z4z:ÓA?ßøE J[&7FÎReÕ‚}”6Æpw>Ê÷p@P{ì8†_«¾Êºòß\^z°®Xö×øî§ËQ„À~êû•žµ¶NÓ]Bg" 8 ê„oI€ ¤¸˜ÅèT"Q"Ž@RlRØÕ96&Öåý„‘P¸"òUb}Šºº>ν¸~DSñ ïÐõŽs‘@Ô˜r¾®ˆÑ‚–këéŽÍè¯'ñ5Ì$ië{%woR+MýÒh’긷:=ë$í>s4N;R…èôµ~Ý’;KÛ„¦¾D³âZIV¼ïa8áGô˜Œ£mNóQ¿„˜93{ˆÄÇún0ûÚN^G‘H€h$öëLA$02÷l¹¦ýxU"F~¦÷•eý¨ˆ2A¬‹j!Dêp(´# ±/,l¡–àe¿«ër\Æu_¥Ä&ËèÜaòŸ^ù]E}ž—tmƒ.‡i!U—ö{MëóëƒÝ)‡i&}¬ #ú—6ÃåÝn÷Y/$h#v~@[ÒôÚZ‡òÒè!‘rD? ‘ÒSŽõ¤PG‘òŽ~@ë§è4¼úèÚpÔ(’ÔC$@$@$@$à ^ab&    £pµ´Q$©Ç” j‹dîŽÿ¼žØêX—wž)ÛªF-Þÿ‘Ü÷Ã?•ÓñcÒ–'zãGñ«ƒßËý[ç*ágçœ*7vºÚ&~Vô<¸íIÍÅQœßúl™Úa¼!z?,\&mF9`¿ ÍùrE» Ñ»¶|£ÌÛû–Š^…{ëw_ÊÖÉ‚ïK½æ,~tÖ9Ò'­·jeUÙ¯òú¾w”®KòFK¯Ô¦© )ˆJH€BN€k@]tcÁ»€IFÇ‚‡£õ!?Ž–kƒÔkÿ Ǥ÷“g ØÑRœf\ ãsÆ–9(râ²ä£þóÒZú拃ßiÌg8\ö§´~òŸÞþmhYZø™Ü²é>½ƒ2Ž‘y0š½YúÖ¾%2kë£z‡f(u¿Ë!­¥ozrʆ[•CwýÚ§Éè6Ãô·>½~©ñ½á·»•±¬+˜ÕõÞú4ý­O¯~!Ó7Ít¸vN·rFÎÉiÁxÃ5 Á ì}\ê=«HÊÉ)øHê-Ö5¨nÙt¯áÑO¾FsŒ ‡â?gã êŠdÞî·üRîl|BÙŠ²UòµŸñÐOèýªd¹¬*ý‡>‹³ñ E}){SPmC­\µþ&ã×=²ýi9Xw(4§7ºìóTkî¯ÕŒ{„Ê´—ÙÚh3œÉû*•õUMŒOèšµõ©dÄ-_±ò:k4@ú{X¹PØS³_´ö‚h'ûk} b¯‹Ç® l¨Üäú„©1Úµ¿WnõCƒëKáuSå×'ýH…Þ­UÛýÐ ’ìÂá<³ùYÑ•RcSšÔ A ’ÒWAœvÄRw–ÍÅQéá_Ïñ= @d ÙýÇÚÀ‘©‡kÑY—I#2KפÎ,5zTâ+9¡ÕŸ\%{’ÎbÕú§÷qNnÑûĘÄ&ùñƒ¤_šŽÝ㜯£è=B»ÿ|•-²Pn|N“Ë1ú™›Ð4½IF7 ‰š³õVqéMÎkÆgvœïŽÝa|ºê·R-.|«¸Œ&å1H ò ¸þˆüv±$à7馪)LÝ@@HÀ1¹Ã5Cæ(¿uSÈÜM7õHê*gåœâž'ŸÝäússN÷Ë ƒÂî¸þiØ0tXJú,õ˜ÙäÚ mÇIǤöMÒ½MÀˆä#=îVÙãa#õOhÌ]4z«7^AµéE8Ê?±>ÛëaIv²Õ[½‰Z䦇»ß­²#Z“æõÅÞ ÎQH€ÌG€›\ô)7!¹€IFoBB“ë´]¾óö¼)EuÅjñàÌãBBÂŒ›rgån™úÛmR­í*?3sˆ\ßi’!|÷×›P»àÉé¼Ü³ Ñ»«j¯ÜóûÃZ}«el›rNë¡õz³ ¶Wí”Y¿?¦­­¬•KÚŽ–¡Ùƒ=êõöd¡6ݾpÿ{jÍæéÙ' BS!j 売/¤NÛœ78ùXéœÔÁµ²Oë·w|¨F€ÏÌ>E:$ŠädH^*á&$/A)7! t‹‰x´¦¦Æpdqqq¢G ª«s\loxa!P˜‘‘!%%¾oDA•½*211QжˆÕŠIWóHLLŒ¤¥¥Ii©ïëì•FJJŠ$%%Iaaa¸VÑçzÁÅ󤲲Ògáz!>k¸/‘Îl‚û±¡¡AñýjVøn«­­•²2ß7» ¸ÏZ·nìbY^€ 8.p paF«Ç¯"üR5Z ƒ_ f‹Ån¡æ„/z¾<Ì&x›µßðCûñYõ}€g úÍŒ¢·ËŒý†g ~Äêm4Sÿ᳆öER¿™m@ÁL÷“?m‰h¿P+**üi¿Ëkñ…ˆQèÆ/E³ >fIÃÆ'~Ù›íC&===¤ý†éQlÂj—ÐVâc{t”'TŠUû—\–`[SΟ¹½šw„ÍÍQ‡Ä|e8{ª+ž% R^^î)[@ϡ߰”¤]bž¡åÀ8Ã})Ïô¼ ´Ih~$ Ï|¿TWWÊ,”a`#»‘Òo`¦?ÿÂë`ã¾EŒ«5‘ „øy\tàm{ˆEÊ*äƒ~¯zõEÞ\3fýþ¨¼Wø©fxÆHY}…||ôë’ïûnêæÊóç<ÌØ?øR×AŸ÷K2\ì ÷§£®­m¨S¾5áîÄðãáË‹$ÕÒÔ’Qe†£ø½vã²±b³¶&¸VÒãReqß—$››Â±»X§("À]ðQÔÙl* øB¡Ha|V5T+ã:Æþ2Ùoá÷oy\~¤F•Êø„Þ ×LÑŒã×uC·¿rýÆ»”ƒxžøƒLX;M+ðWw ®¿líµšóýåªÏ`|bôoÊú[QTXëúÓ_deéÏšŸÒ2µy au§ošÖufåH І^fIÀoXªŒOg+Ë~qNjÑû¥EŸ716k´Ýð«µxàá(ß•¬ÔÏ^ ´]æ¿UþnŸǘrßXñ»CÄ"øÝ¢9·ßQµ;,êŒJÀج×F®Ñv]p¼¼ä'íT•žÄW  è,’"‰€«ˆ:OŠéxÄ•^„xÔ}Kú£;×&[šnnƒAªm3 Dq~ëtå?£ËáÊ×ï»P€Q_øïuŒæc3…H th€†Ž=K&ˆ piÛ¿H‚G|©—iáÿ”ÑOOòéõ’¼Q‚È:º@o¹¶ôè´#õ¤°z›;¢I}1ÒØ#¥kXÕ•#÷­ÏhÒo™ÚzÕüÄ6aWß@Uë‰Ï ¡‡¼™$hÇÓûJRlÓÈVªõ’ 4%@´)¦ ØøK›áreþ…*_Þ}S{«Í7z´»¬-:¼Xs¸~‘f„B°!¤ÚQ²¬ÿ‰ÕÂH†£Lép¹œ“3TU NȨqx3«ªêts§kdpæ±êaDOÉ$ïô}1l먊Íî>Cz$wU#ö©Z˜VôáS=çª8ê%ð’@Ä;¢”&8½…Cs3ºaÒì{yDL6¸NÉÌÌ”={ö˜Ö S(~cú;Á]MEûs“$¤$Hbr’”DFppÀ:BoFÐÂÁ S­¶ó[0m ë,ô7>kp)à@ùÀü#|¨§{ÖÌn˜ðÝ7L‘Œ÷Y^ž±nÄ<õ?χ@ÓÅ1Á)—¥ DWk hB¢%Qµ¥h 8ÁÒ•Äo§ˆá8™’ øG <çºük¯&   cuêLÓ<¿ã5Ù¶e—t´äË„¼ ¸[Ò‰߆/ý5òôΗ¤¨®X†fŸh[³èoEæ?;_–bÍ—âéÙƒåŒì!þªäõ$@$@QL€¨]ç#|ãŸWW‹Õ«5÷*p3óôŽ—´è!osúÆŽÓ@Qm± [}©¶NN’䓃_*‡wu½Ñ¯ #”㹫/·éý¨h™æ«s­ÜÔiŠ_zy1 @ôà¼]ß¿°g¾¶yE´hΦñ5£yù›·7|wºÚUŸ‡QN`ê†[µ˜ßuÊøÔQ|XcÑ?ÇîW¯¿Ysh^ë wÁþ÷d}Å&½¾’ @‹еõ½j§ö%[o—c´Z¶UírHãGðÍiñu„K#LŸû#åõa'íuÀ¹·¿zíõñ˜H€H ºеëïÉÝ4GӎΉá»gJ7»\<$ð$Ð-©³6^ïø‘.ÕÖlvJjïW…»&wÔ´:F)®/•ö‰ù~éåÅ$@$@ÑKÀñÛ*z9¨–Ë!Yñ¶/q„ ÌOh#ãò΋r2l~$¸«ë ÚÊÏ[èA£—kQŒz¦t÷«ú3»Þ¬iµÚôâGÙäv—ÊaÉýÒË‹I€H€¢—7!Ùõ=¦+ßë÷Š,*|_v[÷K~L®ŒÈ:Ó.I | dÇgÉ7ß•çw½¦íV/•“2“?·:Æï ·Ih-_xGžßýš ÁyRæ r|«~ë¥  è%@ÔEßÉ;WÌ ÉE“™dˆÎƒ‘F ¢Mí0ÞhµÔG$@$¥8¥Ïf“ @¨Õ-++“¯¾úÊc[ׯ_/K—.UqØ=fäÉ€Ø]½O~,ýYÖEFˆÄí•;åë+¤¬®<àlŒ(\wVï?ˆf)¨)’í;Uœy#9ÖÉí†_ @xÚ|UU•Ü}÷Ý+ƒ rIáÑG•5kÖH=ä‰'ž¹sçJ§N\æeb` ܹùy§àC[!÷t™.#rϰ½·ƒk7Ü!_o«Ö#Ýï–S²\ßg¶L!ÖôX¥ª¡Z>ïÿ–dÄ¥û¥—“ G (# ›7o–ñãÇKii©ÛšoÙ²E¾øâ yæ™gä–[n‘ /¼PæÍ›ç6?OŽÀ›û;Ÿ(é®-j£¡kW¨šÿ³ãeãªnøínÙT±Å­»t¡æÄý…=¯«€0>!£~¾BJëÊWhj~dÛÓ²`ÿûRÙP%0>!­™*5 |­ò½[“w|¨žUÊø„ž k¯×œô;úøõU?¯# ðŸ@PF@+**äŽ;î‚‚Y²d‰ËZÃHíÛ·¯!E†ÈâÅ‹ònÚ´IfÍšeK5j”œy¦ñ»Ôcb}fdd˜rú...N²³³mþ³ÚµáÿJÁ[2´ó`çì!ÿòo¹¬Ã+E åÑ3]ž eâÿÖ¾-ÕÚ¨œ½$Yå—† 2,û4ûd‡ãæúÍ!s¼Y²êcèÁ¾ª•Zà‡-±;åøìöÉ-:þðÇe¶hfú…EõŲӲGúgöÑ“‚òŠg f}ý ¥ð‚ûíóô, p¦}IMM X¡Rl±X$))IБ" ‘RUÖ³‚ruÔQªJŸ}ö™ÛªíÞ½[Zµje;㫽à¡`ÿ@ˆ¨ˆ©<³®óÔ.ggæzX47Už®Óóûî³\‰E,aYßøØø&Õ…ÿNp÷ÄçŒêÚÚÚˆú¼á>KKK3œ†–@D @ˆJý×^¡?´].Ê83k»ô{BïÃP³6ª|<€Íz?êŒÌxO¢Mfí7´Ë¬mC¿éúýi–W3÷›Yú(ZÚÁ5 ÑÒÓl' „  aÒ¬ D  ÑÒÓl' „  aÒ¬ D  ÑÒÓl' „  aÒ¬ D  ÑÒÓl' „  aÒ¬ D  ÑÒÓl' „  aÒ¬ D  ÑÒÓl' „  aÒ¬ D  ÑÒÓl' „  aÒ¬ D  ÑÒÓl' „  aÒ¬ D  ÑÒÓl' „ ¸`ÕãÀòÃ?H—.]¤gÏž.‹Ý¶m›ìÚµËv.''Gzôèa{Ï    È'ôÇ”;ï¼SÎ8ã yòÉ'eüøñ2räÈ&ôž}öYÙ»w¯dffªs}ûö¥Ú„H€H€H€H ² Å}ì±ÇäÞ{ï•~ýúÉØ±ceâĉ2lØ0IHHp ·qãF™3gŽtêÔÉ!oH€H€H€H€ÌC àh]]ìØ±C0š ÉËË“””Ù¹s§tíÚÕF²¢¢B eÿþý²lÙ22dˆtèÐÁvUUU²}ûv[Zbb¢$''ÛÞu`±X”*¼Z­V£Ô†ž˜˜‰‹ x×½½±±KšÑ6³õú̬ý†vAÌxOâ‚ûÒŒmC»ÌzOš¹mè³H»'õgDпTX`@ Ü Ù·oŸ¤¦¦ª•Þ’V­Z)cÓÞÝ´i“TWWËòåË•Q9mÚ4™0a‚)Õ¯[·nŒ7N+Ó§OW£©¶ƒ²²² Ö>êrssç2פuëÖk uøÁ.­3ó=™––.˜ ¯‡™ûÍpXa¢?ˆ"éY‚,ŠùÜÅ@}}½9ÜLIIIi½{÷– ˆnôuïÞ]ž{î9i/¾ø¢í:lR*((°½7êNÉlRw£Ê¥žôôt)-- eR6–t mI7ã(fÊËËÂ.”JñEˆçAQQQ(«²ñ,ÁfoÌ&0ª1’VRRb¶¦ fפ¶¶ÖtmÃw¾ƒ#íY‚ï{йÜÅMƒ£›øPC` ´k×Î$Œ=<Ètë@±! <ä xàwÜq¶ëŠ‹‹S÷F‹n¼àCjƘÖÔÔ-äúô¥h›Þ‡!¯”AÀgÀ¬ý†çúËŒ÷$Ú…éC3¶ ÷#ÄŒmóĬŸ7Ü“Ф~Ómƒ§T&-»V¿þa4¾ýöÛª¬ï„‘©š[¶lQ£0&¯¿þz©¬¬T_Fï¾û®œ|òÉ6ã3€U¤j    ø(Ú2uêT¹ùæ›Õ;~ÉÀ%“.S¦L‘Ù³g«ò£F’I“&©éŒŒ ™5k–ž¯$@$@$@$@&!£ Çm›7¦ÙuŸîøaÚ£¬¬L`€6'š‚ldó|3NÁcôÙŒëí°–÷מ={L9õ­¸çÍ&húÍ&x–`mr¤­·ó¦ðYÀ–T™Mp?â»KÇÌ&ønÃô{$­ÝÅ}:sø¼=®æŒOäÅæñi¯—Ç$@$@$@$@‘C ¨hä`aMI€H€H€H€E€h ÈR/ €K4@]ba" @ Ð Yê%   pI€¨K,L$    "K½$@$@$@$@. Ðu‰…‰$@$@$@$@"@4Pd©—H€H€H€HÀ% .±0‘H€H€H€H Ph€Š,õ’ ¸$@Ô%&’ Š Ð@‘¥^    —h€ºÄÂD    @ (²ÔK$@$@$@$à’ P—X˜H$@$@$@$(4@E–zI€H€H€H€\ ê I€H€H€H€E ƪI ”ZoYY™ÄÅÅ^LLLŒ$&&JuuµD0·\âã㥶¶ÖíùH=+ RUU©MðXoÜëuuuóDâI´Ëb±¨Ï[$ÖßSñ,Á}Y__ï)[DžÃsbÆg îG<û"²oaFÁò³ Öˆ¿õÖ[²lÙ2³5ÍÖ3. ™6mšú‘þ /ØÚɃð'0bĵÄíî»ïÿʲ†¦&Ð8÷À&bû¸ãŽ|É`l>ªªª’cŽ9F~ùåµÎ£Ÿé<öØcUžPü‡_¿fE Ç`–‰>ãZ¡`7¦,ö›1ƒ­3[γ[Á®Ëk9ôŸ“-çÆ+Œ'ðPTyêÔ©6÷KJ¿óÎ;m-™2eŠÌž=[íŸ4i’Ú!Ÿ-;w–‹.ºÈ–$@$@$@$@æ Æäÿþ÷?5]ƒuCöòÞ{ïÙÞ>\Î<óLµî&”S¨˜Ö?묳ÔzB[åxöÚ·o¯úÍŒ;ŽÃ¾ìÙ³§œrÊ)~hॡ пS®m Ë`–‰åeݺu f‘,‹\ˆÑ¦™Í·ÍÛeS™H$@$@$@$¾4É: „ LÁ‡Os›Ö~JW®\)˜´wŒïœ1ê·nݪvÂE%´Ö¬Y#{ö쑺]*®önT?üpÁúbJh ”––ÊŠ+ÜN»£Ïpþ ±9ÑŒþACÛ¾•Žg ÏJWÂÏ›+*¡Kó¶?àþì‡~.]º¸íÛе‚%›™€EsÅp·™è©mï¾û®À vä?÷ÜsÊÏŒgAŒú…  |§=ñÄ2hР€¸r.—ï]¸é¦›dݺuRYY)O>ù¤œp âìæž.¿ürå7yñ‡ˆÄE -l:üôÓOeäÈ‘M*‚>0a‚Z[øÕW_©|Xc”:ð‰|Í5×(÷fG}t“ŠðóÖIH¼í©p§…½ˆ2_›½{÷iÝYxôˆÚP,}]ºt©ÜsÏ=ê—¢*Í;WŨ·ï~ƨ·§úãßÿ]x衇Te***ä£>’ñãÇ;TýÖ¡C™3gŽC:ß„–>s˜Ip'ج·møR„Lžð0’6zôhõň%βaÃÁš5¬7Ä+~Ý›1Ô£s»Ãõ=_ßwß}jd355Õm5±®×~9Ž Üæç‰À€‚(Uýë_=ÄÏ›G‹öË[à‚ÐŒ¡UƒÞ,Ð+Q;¯ÓÁ¢4!B¦û0ZfƒÞ›õº.¾Àgœ!'žx¢ÅÆÒÌ™3 ¿êª«zèJllÁhè%—\âo‚CàÕW_•^½z Ö®]»Öm¡ü¼¹Eô!ì¹¶&ºª?o®¨„.Í›þpþ¬¡¶èsÆ\]¿E[ÉQ;Š Eß~û­êoü<ùä“ÕBlì®¶Ĩ·ÿEèMŒzûëyl,Lãê»qa\b# vL; ¦‘ìwÀwêÔI0šM %K–¨|øápÝu× ÖòžwÞyM*Ο·víÚ5ÉÇ„ÀÀ:BüX¸þúëýöúë¯Ë‹/¾(úúkûðófO#ôÇÞôGNNŽÚìgÿœÄgŸ·Ð÷_´Ô j P¸vyê©§äûï¿W} £S}XOˆ¸úF‰p‹Q-7¦»vb-ç­·Þ*UUU* vSwïÞ]Û÷F´Ñ¿\óÉ'Ÿ¸uû£2ñ¿€˜7ožÚô‡¥X{µ¼˜m€`i„¾<QZ ý‹´¯¿þZq‡|ø\}öÙg¶~ûË_þ"—]v™EmìûŸ·à÷§=õ~Xàó…ˆqØð‡@®ÁZ_üQH ¢ÖŨ'vÚÂýÒĉÕ—"vÄcÄ£ ×^{­â)z=Fý¥—^ªÖ2F}0nM×eÀpÁÚOô Öìb Rˆ}¿á˲¬¬LåÁúOlfÁ%ü<ÿüóòòË/«ŠvÚij]Ú…^¨–ÄŒ3Æ£ÞðkMôÔÈ¾ßøy ¯~÷ÔS¦L±Í"M:UÞxã ÁwÚ3Ï<#·Ýv[x5„µ15†âÔº†Js±ç±SSÍå3õÝFæüŠ××xº«F?±Ö)11Ñ]¦‡!lúCŒÒP"‡?oáÕWÞö<ŠÀ(…‚I€h0i³,    ‰Ú)xö= @hÐ w–J$@$@$@QK€hÔv=N$@$@$@¡!@44ÜY* D-n1Ú®gÃI )8ë‡;{縿:çœsZ%Áà­À›È*ð01{öl¹âŠ+¤cÇŽöÅ«ãŋˮ]»Tt«&'ƒ˜€Ð½pͦG ºüòË¥K—.A¬‹" sà.xsô#[A†øá‡äOú“{ì±6—cåååÊÇ*T÷Ýw’ŸŸßlYEEEr '('ׇ~x³ù‹‹‹•˜¯¾úJþüç?7Éß…ˆxµ|ùò&ç‚•€xèmÛ¶•3f(`pÅÁ¢ÏrH€ÌF€SðfëQ¶‡ €QÐ?þXý!dí/¿ü¢ÂöÝÿý^i‡_A=dªWD@&ß  cÐ5†#µ€© D-F4W­Zek'¦£1xÖYg ¢„Á`…`ÄT¨‚ó~ø¡JÇ4û< ˆÒræ™gª˜ðzÈ[•ÁÏÿ~úé'5E¸åˆr†){]`Dßw¿~žÔøIDATß}jõÊ+¯TË ~øa©¯¯×³ÈæÍ›åÎ;ïTçîºë.ùâ‹/Ô{d@^„0DøÐüã¶k0r{óÍ7«öÜpà ²gÏÛ9 ¸'@Ô=ž!øƒŒJdúzG¼8p ŠÛ~Þy穈EÆ “—^zI÷ë×O]Ù§O5m70:_{í5:t¨œ}öÙjúúÔSOUëDÿ(ÆçL…Ã@FT3¸­ìÛ·¯Íݸq£<öØcÊPÆÓã?^n¿ýve”¢Ð‚‚U/Ë#FŒÏ?ÿ\Î=÷\yýõ×Uzõê¥B„¶oß^Ž8â[=±QÒ`„c*PH€H€¼ `¥ À´u–Ví±a4i’U ´þýï·Ž;ÖÚºuk«öÔªMÅ«œÚT¼555ÕªMµÛØ!-//Ϫm<²j£‰J6 ¯Î8pÀª†Ö_ýÕ–É’%*6j¨ô \m ¨í¼ýÁÕW_mÕÖ¦Ú'9÷ïßß:räÈ&i×\sJ{ñÅUY«W¯¶åAO<ñDõþÖ[oµ¶iÓFÕ]Ï šVÍðÔߪògÍš¥ÞWVV*}¸NÍXUiÚ¨¨žÄW  7¸ Þ #YH Ú`ªSÒÍøÍXlêСƒJûþûïÕȦýtôÎ;eïÞ½²cÇ•Çþ¿œœ™?¾`šü…^PëC—-[¦²hÆœW;åíõÙcjõÅæ(Í ´²X,jÊ]OÀ¦!ŒÈêÒ©S'A; Øà„QÙ˜˜ý´ >\m¢²%¸8ÀHª.†`ê;å)$@$@î ÐuφgH j <ýôÓ¢O£»‚€]îÚˆ¨ÄÆZŃ©m¬ý´OÓ¯­ªª’óÏ?_¾þúkµË}РArñÅ«÷z__±îžà.ʾìÓO?]°s_Ô×^Wûa®’0ooL"133Ó>»Ëc{CS7^u./`" €"@”7 @‹ tïÞ]–.]*÷Þ{¯ÍèÛ´i“ÀRnn®mí¥nŒ-\¸PmR¨ªîçiþʃ!Ø®];±ß¥úÅÇÇ{¥úÈ#”•+W:äýàƒÞó €q _§“šH€LN`òäÉjªýž{Â=F4ß}÷]IHHììlE~E±Sþ3±ãSôì~¿ãŽ;Ô1FGeݺu2gÎ;']JKKÕF(l†Òÿ`ðB°< Þ~ûmU¦÷±9J[{ª_îñõú믜7Þx£hëD»àuÝú…XF°víZÕV=¯$@$@¾ ê7^EQMà˜cŽ‘yóæÉSO=¥Ö^b—8vˆÏ;WqÁˆ$v†Ã(9s¦ 2DE9Âx¬Õ}ºÚoSàá`À€ÊxÅnzmc’ÚE?qâD‡µ©XBðÆo('ýTñ € É HÌB$àž6a#ŸÎ‚QK¬½Ä† ÂsbTÓå¸DÂ(«¾YÊÛ2°‰)11Q`HërÝuשÍRöSñ¨?Âp:¯'Õ¯á+ €w8ê'æ"pC#Ÿ®ŒOdÇh¤n|â=òÊø„~¬ùl©ñ‰ë0¥?¢˜v‡/Q,%xöÙgeܸq8mԟƧ H€HÀgõ/$0 ŒjbM* O¬?Eüz¸žÂÚP €ñh€Ï”I€"˜üŠb:žB$@$84@Ç–šI€H€H€H€\àPP˜D$@$@$@$84@Ç–šI€H€H€H€\ ê “H€H€H€H€G€hàØR3 € 4@]@a @àü?rw‡›I1’IEND®B`‚ggforce/man/figures/lifecycle-questioning.svg0000644000176200001440000000171414672274110021137 0ustar liggesuserslifecyclelifecyclequestioningquestioning ggforce/man/figures/lifecycle-stable.svg0000644000176200001440000000167414672274110020051 0ustar liggesuserslifecyclelifecyclestablestable ggforce/man/figures/logo.svg0000644000176200001440000275626614672274110015622 0ustar liggesusers ggforce/man/figures/lifecycle-experimental.svg0000644000176200001440000000171614672274110021271 0ustar liggesuserslifecyclelifecycleexperimentalexperimental ggforce/man/figures/lifecycle-deprecated.svg0000644000176200001440000000171214672274110020670 0ustar liggesuserslifecyclelifecycledeprecateddeprecated ggforce/man/figures/lifecycle-superseded.svg0000644000176200001440000000171314672274110020734 0ustar liggesusers lifecyclelifecyclesupersededsuperseded ggforce/man/figures/logo.png0000644000176200001440000026662114672274110015574 0ustar liggesusers‰PNG  IHDRó‰ÀÊ‚iCCPsRGB IEC61966-2.1(‘u‘»KA‡?ã#¢‘¦°°­¢ø€ `‚D!ˆÄFm’ËKÈã¸K`+Ø ¢¯BÿmkAPAll¬mTι$ f—™ùö·;Ãî,XBi%£7 A&›×‚~¯s1¼ä´¾ÐB31WDÑÕɹ¹uÇç= f¼0kÕ?÷ïhÅuZ…'UË O ÖòªÉ;Â%‰ Ÿ »5¹ ð©GËüjr²Ìß&k¡ ,ÂÎd GkXIiay9®Lº Tîc¾ÄÏ.ÌKìëA'ˆ/Nf˜Â‡‡aÆÅ{`„AYQ'¨”?KNrñ*E4VI’"[Ô‚TKLˆ—™¦höÿo_õÄèH¹ºÍ ÍφñÞÖmøÙ2Œ¯#Ãø9†Æ'¸ÌVós‡0ö!úVUs€}ίªZt.6¡ûQh‘’Ô(fI$àí:ÂÐumËåžUö9y€Ðº|Õ5ìíC¿œ·¯üeg¾{K.¡ pHYs  šœ IDATxœì½y¼eUyçý]kOg¼ó½uk¢& ŠQfdPШÑLšN4&v:ÝIºßO’îÎôy“˜Ñ6oLÒvMâÊ$ˆPPÔDÍuÇ3Ÿ³÷^ëýc­µ÷¾hÒŒzŸÂåÞsÖÞ{íõ¬ç÷üžaÁ²ü°ËéÀ­öß˲,Ëò” àK€.üÿ‹Àø yS˲,ËòÝKüV}ß×cccºR©•ú·ìç–eY–åE(xÐtº\.éS7Lèó7UôÚ©=22¢ƒ p ݶŸ/à=/˳(Ë/ò‡C¶Ÿ¶!©ÕªøRsõÖï<+`ó”Ï×vöøÌC=8$é%‚f³Iš¦ov¼°,?¸,+óK[F€¿Þ P*•ec½Ã¯¼ªÌËÖ†T‰Ò!­¾â–Ç{üÆÐÑ0­V‹n·ëÆú$ðóÀâ ó(ËòƒÊ²2¿4Åþ#ð€0 ©–#Žxó)ŠwžW£J4@HÐ:Ùs”}µÁ ;s=ÅÅI’ µøàƒ@ò‚<Ù²|ß²¬Ì/-ÀeÀg€¡(Š(•JLVo<-àš“NZ"‹oUƒF›/ ÑWˆSÍ=»û|üîÜ-襂V«E’$ àMÀWžÇg[–P–•ù¥#OgÔj5¢0ä䉘ÿqM-+Bß¼NíX „­5Jc•\˜ÿ Ð ZÅ×vöøã¯49:¨Ç îš×»Ÿ÷§]–ïY–•ùÅ/5àÏw !ð}ŸÑ‘!ÖkÞ| ¼ýœ•P) M-ì[Xx]xËJ/\[úX3åÃw4øÒvE# Yl4‰ãØAï``}ë9Úeù¾eY™_¼â?‹!¸(•J”JkF|®8^ó–³Êlš²;õœB~¯ ™u~†>gV\ìëñé{\¿CÓ@¯×£ß﻾ø[ }žwY~@YVæ§¼ø<0áû>ÃÃäiÂU' ÞóŠ*›§|Ï@hg}±t—Ö 0×—9ì–Æx£´ÎÈ0)Œ‚%·Ÿº±â¾Ý}>ð•ÛI‚ `nnÎÝÛQŒ?}×ó8Ëò]Ȳ2¿¸d &Dt¡çyAÀЉQ¦Â&¿|I…Wo)Û7&2x )J–ÂúÉ`!²3ņ“Bà{(ûy) ‚­AHhõßÖâoîj¢Ê+8rl†~¿ï ÷ÀÛýÏãü,Ë¿#ËÊüâ2ðÀ/ !¨T*„AÀšÁëOÖ¼õì+†<ÜërÊg”ÓX[0JiÙ†¤Š¾3æ 2GZRPz»I§ÿV¹µÖ<|`À§ìpÇÁÁEÅ Nèt:îÞÿø¯@°^–F–•ù… ¼ø;@AÀØØÄm^ŠÏÏœ_á¸1_ ´O“H)P*;I!2…8í0ßëk,¸Û¬Ï7Qð¯-3Þaûáug‡[vÄD¥2 .‹L?ü“ýyY^YVæNÎÆøÅ«=Ï£R©0\+3é/ð[׌rÞ†—¿§ˆÂ†•œu–Òú½V…Á%eþ=­5©$MÁÌ£!å©”ÑM‰Í 3ñgOš1S]°ÊÊZpk®µUø¯=Ñå÷oê2W96;OÇ(s€×ßxÎgoY¾M–•ùù—ÀGË}ß7,uè³u…àª-‚·œU£ —æÚØ^Ï‘YÅu íþmþ¦ÑºÈc›Ÿ{‹‚…]>3;|â†Ä¯j¶\Û%6WÑÙf`ýpb 'Nö9h¡90Ÿò‰û[Üü„`÷œÞívÛ}ô&à'0dÙ²iÏn±@¡©­R‘g‡I)2KîâÖæFÉóí†Êç®8½G vM¨¢”"I’MÀ¯bÊ,ïb9”õ¼È²e~îEo>„RJ&''‘:áôÉ.¿síkG=c þ.„áØf(ü›mI/û7INŽ=ñ¥̓f¿–€¶”B+6\Ö¥2a®¥”U`™_©œíVÚmÂnFñSëÃ?rpÀû?9CSŒ±ØêÒjµô`XïϹÇX–çF–•ù¹•S0~ñ&ß÷)—ËÔÊ!ëj]Þvv™×Va¨äá"H¹å³ ,e%Î>g,³È5Ãi²†þ¼¤qP kÚG%‡¾f>°ð <•2~BÂèÆá¿Ù¥z*“cXØ.¥±õY,ÚÁm 1n ½Dó©o´ù—íŠGkºýý~ß‘dO`âÓ<—þ£,ËÊüÜÈð¿7!¨×ëø¾ÏŠò€w]PâU'”X3ê[…ÐÈ‚‡Z¬prWéœÐ2lv³J·G XØã·$aE³ñ5=ö}-¤uÄC¥!Åä© £¢ª¶!hR&L%enùÝ ie]1“K2PïP4¾÷žÙ˜;Ÿìñ·÷Äly¤iJ£Ñp·üyàÝ@–…²,ÏŽ,ûÌÏ®À¯c -BV¯ZE¿×áÚ“4|ë(ç¯/1R‘YèG"P€FiR•gf¥Pê`° ¹ÿ’ZÇ{o+1ÿ”OÜ3!«Aß(Ùðú”æAŸñãc6]1`xMŠö̆Ð>& KJ»Ü’~lFN•¶¡/ì5ó„Oæ÷åj7ŠÊ=Zõ8}MÈU'G›ï°{êC#ôz=´Ö[ìõ{Ye=k²l™ŸÀU˜ì­ZT«U†*>§Žwùé j¼|S _šL-£dÌsNd\Bnå_Æ„Fh£„É®›#â¦K*1–Þ‹4ë^Ù§<¢)+3V*è“{Ìg~·Ïª³b¦OÑhR¾Ì7 ÷`Økj{“Â*5öY4fQ:ÏJ3ÈB0H4÷îîñWwvØ12Óè1 ˆãLáÆ7²ìOÿÀ²l™p9ø*ðŸ€pjj Ïó8y"å¿\òî ël™‘κÉÜvJ¡¬ß)…IÉBDØÏÈ<)D`,£‹KAI“ö£~¶Ah4Z™ïŽlL@jz‹’Ä| ¤uØC+Aû¨dhM‚_1‰%† ³I'J˜ò,£¬à³§*ÿ›Æ¿6Ïj6 À¬ xåæˆÕ„ý Šváû>q‡˜¤™ë0µÓ³ÏÃûú¡•eeþþeSø×ÀTELLL0;{ŒŸ97ä÷ß0Âi«#j%™ASmë‹…h-ŒÂaCO¯æD¥Î-¸ƒ·©ÒKª¢¤uÍü.ÛÏ" lnH†V§´y캥DóDÅî: RH’‰)±W aâÚYB‰ËßÖVIZ˜B_ºÍÆlYV™Ô8BÍ“‚R(9yeÈ›Ï,Qó|ó bxlŠV«…Öz ø%àxŒRgeZËòÝË2ÌþÞÅÞ‹ÉI& CÂ0dÅpÄ˦cÞ}a•3ÖF&|£)@d³àÓŒÜÊi,¶a#ÈØl‘Ãn¥5z ÐJà/Ì­y6>päáƒ÷æìµÛ(¤¯Iã¥e‘JP™L™<-¦¶*Å“f£ÀúòBPŽh[RÄ¡ÝÝcB^Å¢ »?)mÆô=kË…á¶ð7w4xx¦ÌþùÝî’RË÷ÿË­‹¾'YVæïM.Åtû“R2<7¯ö‡G–}æ_ª˜N•V‡aH­Zeb8â´±&¸n”מR%ðDž;m¡§†RÊfMI‘)1εi›ÂúɈ;’÷…´I†7&ÌïöL&V! [£Ñ‰ uÐÃ+iÊÊ„‡´Æ‹`ÐtfMøË$œE®Ž+Ö_Ñgx}bÈ.I[2¿3`ÿ­£½†¤¾&Å+Yh-sâKÖ.Ÿ!2wÁk(•§fßSÖ¯÷Dfí±÷åKAä N[ñ¦3*ôºmÚº‚ò*¤iŠÖzµÖú—iŒ•ŽŸåwüC#ËÊüEïî΂€z½N¥rÞZøù ÞwÉ0«Gak…¥©—°¾Â V,Œp¾´ƒ£Â~8n öÞ²ðT@wV2urBÚôæ½úÎÓ*µ´{”Çш yàGÐØï¡c‘}CÛûYŸÕAsO¹?dv‡OÚ·ŸMA¤©®PøL–„ÓߦŒ®S‰¶þ»I€Ñ.8…Öàûb ªpùå`ÒA0Tö8cÄ©+4es¨€_2U_iz6¦nz?ðM–8$ËËÊüä| ´ûq€jµJ¥R¡îuùí««üÂÅ5¶® ‰i¥J J™…ÌXjBFLACV0a Òö~5¢ù´o§TО‘LšÐ<(‰c») ÂÐÚÎŽFµi…Fã AXÓÄ-Aû¨gU ¤0,vÚ‡á OÞql»O§‘WhiËH÷[‚á Jšì0!s¿ßl –1÷ò0™Eklß·è#µN¶^§i>'f.ò"Àƒµ£&”uîq’Ç´i1D†ôz=)±|¦ÓÉr—“‚,û̹¬Â×_,„ÀYã5¸tCÂû/b¤âe Ö¥Y‚Q²´(! w?;É\E Åÿvùì»#$8/„„õ¯êSÕHO3»ÃçèvKªS)“§Ä ¯Q%1ÌÊ"ƒ¸#Øù¹2q[d ÂZÖWôèÎx~00n€g®DšpH1qJÌÐÚá™ óï¢d–¨Ô¦…Úçô­KñÌŽ'EvÞYfgéS¥3eÏÛiz±É÷þÈ=]femâ8vùÞ_ÃqzVVÀK\–-3”€?Ä\륔ŒŒ 3^¸tCÊ/^ñÖ³k†¥"S¾L?…É`¥ AöOg•[Üä–J ë}̧uØËÊ¥ÔVhVœ+¼*+aª+Óg&ÔW*„g™ìAÞ6H𪊅½~ÖÐÏ1çÝcã'è-H’žDšú´bòô+NI¨®PYž¶“Œé.„Ï”ãì…=i-,Î}Ù&SŒ•»yÌ+Àò`cð&>/9}MÈùëC0Ÿò»7.rÇI©RåàÁƒî}&˜†ŸâG4ßûGÕ2Ÿ|x·B†aÈÔä“•”7œðGocËt`C0ÖϳËÃKUªø“cœµ+PÈ|e½-ŒT.¿Ù2Þ‰`îIŸ~Kà’'5PžTÔV¦6=2ßyq–´%3ì½=b0ïÑñ˜<9FÂÀb©Á‡ÆC†9Xzæç‰“b¦OK¨¬PxmÑK®Ä©ËLj‘gŽ™xµ6-qéœØ*«Ì¶Êè6I>†C.Î*› 7A¢r…/žÄ¡á²äª­%6ŒjvîoPž"Q ”’J©7?a½?[‹å¥"?jÊ<‰Ó Œ„aHµZeb¨ÄU›~í² o:³jNˆ°+QgäŽ#¹Œáa‘á76yÊC:õ[€ô"ë ǪTÐxÚ£¿è+»‰ '&ŽùÊF—ºs{n+1ÿ”‡N¦§ ”Ç4å1e•MV5ý†¤3+³þ`¥É„©“Sê+~ÉŒêâ¿ ƒÉ.{­XxiDÃÎ>/\jª&÷üÍ=;fÛ5 4½½É3ᬻ¡–\·ÐÜ>·»W\sZ™ªìq´¥èªaÇñˆÖú=À¹˜êµ?"ò£¢Ì!ð›À—ÍSSS¾Çùkpm•kO+›c»²¼BøÄ:rf‘iS®(dn9²Š"Șj4JÜqø™ó;}Z|¢EXuVÉ(AgVÒ>♕Köè ÊãŠÒ¨.t1EÒÌ= µÐ@PÑŒ®OóL- å1Åìã>2‚µçƬ=/¦:©ÀÃÖ+[(‹A.Ü©¶ÎžÑ2ÛØ¹)(£K&q Uàìä8åtL¿´ƒhë_#Ì&&í<C|ò˜MЗÏ”Éñ“{gzl{ª‰Ò‚±±1ƒJ©ÍÀ¯Ùi¹›ÖE?ì>³®>”\OêÑá:¢7ÇxyŸ8¿F52‹(UÆ/ó\0ØŠ !Až—\\ø.V¬5¤J1Xô9°-`qŸoÒ›3ðl­®§YiŸ‘õ)H£¤ Oúì½=´…Æ2I º6aã«ÈHáE´»ohò–0äÃ6^ÞÇÅ„ÝÆ²°Ë#1ñhǤ£Á÷Èë–$©aÄ=¹ô¨Sxm}_l†¶\‚â¾Wd¨Í3{ž³ÂKií—–s<ƒËs韞Ý` ýXñ䱘ÞÚàë xÝð'Fe>µ0ËÑzN’0??ïOzÀÛ€/.y±?dâ¿Ð7ðÊɘ¾S'T*¢0d² —oîñcgMpÂT`ûOk›zÈU/#¹.qËü›Üâ˜Zc]-Iw. í ÚýlÙ8%t«H§‚ý_ñËê+S”†òŠ”pHÑó hÕFi;G|æv¥Lž¤—äo?“Uw0·T×™ï©5Ä©ñmëëÓ‚oÃX*ïbâÆó¤ÀyswF•Bg¥AÖÊWd×sØ1ߎ$Ó:ÿ¹WÀmª©6Û‡îS‘Õr“õ/SÀOÞßâ†zœ$ªüÖÊiÖž¬ KÜÛirw³«^§¯5­V«”$Éç˜~lÛ¿ïUõ"–F˜=Šieû!`\JÉøø8Isù ¿ùš2¯?­Âªߦ\ZØfñ®ÖX()2èäþžÈ+ƒŒ5Ó Ž>rè¾Ù'ÌünŸ¹>(‘ýRÁôËøu£9òçT]!¬)ðæÿ~Áu0Ϭ ."û]ŽRt>O"ÏüÊÙlY_÷Ç#àüa!lr‰V¹ï y}´ } ø‡{šüþ—ìøñú .­3éÙó‡R²>Œ8³TaØÓë j5|ß§ßïï¶7½h¥½Èä‡ fÀ/cbÆH)©ÕjŒÔ+ŒË~åÕC\¹µœÅF TsÁ¯Ót ¹ÍÂæg o:}4KöÞÒ—&•QkÆ6'ÔV)ž¾3Âó4Â5„tuÌ~'\Û£2fxd­¶LwNZ¿4ÙJ_³âŒ˜ ¦ñ¾pŒ;T¹ÌìÜœƒÞ`Úÿ?$ñéeÀå–zL¼8|6Œh®9Yò¶³kŒW .ô\oh¬gjWr^Š˜‡aò4Äg¡@ ´»nŽhõ2è(„À/kÖ¾¼Oë°¤¾B iæžò8öpbѬ»¸Ïø‰‰etí#’]7—ˆÛ"«Xz&L÷ͺËú}8 yÐC¥QÅúWõ©N¨o/Qt—´Ù¦Y/i«›®ómÎ…˜žñur2°ØìM^.˜-V% FÖ§´x„uÍq¯èS™Jó0’»Æ3”Ë…šŠÐÛ±ÒÎ'v1óœÓÙ³ƒÈ»‰ ‘1Ó¶{X"ÑÍ‚{žÀ·~¶ÛôÜÑ:IJvßc­{±æOoYä¯ok1|¤Â[‡§8¯:DYÊìÝÇ“RëžJ‘£ ‰`ErF¹Â˜J¸§Õ *•¦ÝnG˜d“×czþ{^…/y©*sÓ®ç#À´”’¡z¡Z™Õ¥&zÝ0?q^ñª—ùŒF¬å°é‚9l4‹Ø“f{óâ ±gÃ!Æ%ÊX¸ê¤âØ×®'Ovè-HjÓ†=vÃ5IÚsÚäÖ˜Ò¨µwÊ„¼*)*´yÖ·uwŸ[›~F7¥eX{Ñ€ò„ËJËc¸Y1yf–‹™;eÈú‰Y˜ëx¥5‰Êë‘¥$‡°¢Ø¡3÷©•í±í{–´›¡«eV„YK^­!ô¾g2¾ýTsç=Þõfxâ)Í»ë+¹¬6Âô„)2q›©Ò-Œg.öm]# ‘7“&|~aŽOÏÎðŠ Ìx<º¸ÀеkPZÇñ´Öúý˜Úõ[1Íû_RòRƒÙðsÀ_xžG©T¢\Š8m¥à5›Íñ§•ÈŃ­?%Lø$OÌ´>¢ÖYv•[pžg✙ýµ¾£)6p±OÏÍX‹{óô×Ã,K•qŦ×ôj*c©Ý˜ZÁü“s;:³’t`Ç•VÕ ÅÔi Õi>µ0 o5gâÝ<à.¡­Uµ—-6€|CäG¿‚í*Zà ѵô%¹P“ƒìù5ÉbèîƒÂÎq¢4îëóÙ:|s{Ê«+£œU®Q“žµ´ùX²°iB1ç쾿oÐç®V“‡ÚM6xo¬ ñŠR)`w<àc­EîòsRÐ h·Ûî$Ž_ÀŒ—L|ú¥¤ÌŸ&À”&†aÈD)æ'Ï ¹rk™µ£Æ—’ÒtêÒ*qŽ&³VLf0‹Ô|È‘\BhÒž¤uL ~¨)+‚²YŒ&gØ &‚}·G,<åg–ÓmS§¨N*öÝ¢ûÒByÀêóLlIÌýIlh¾Ýh­t$qC2hë–5a]Ö2Ôö˜×œYÎÝNÿS88š[ì\ ›–U.R2.‰­˜Êü\ç#‘Ân"²@^iwM¹4.'û™­’šýó)}gƒ¯lïq–âÕµQVaî§;#së—>k&$‡×¥øòâ<÷¶l’>o­ ³5ˆñòÍ «Ûû}þ¾ßäN•+ÌÌ̸ª¬Ì)w|׫ô”—‚2‡éG}>€ïûLŒ£UÌ˦züæÕ£l˜ð d¡ ë|i Œ2‹NÙöŽ…u$Ž#„ºó‚ƒßXØã#­3¨Ñø%“ÏÆ I˜uØÝ˜¤“§¿ûeûüË‹Y™+ÀaàžçE#µ'ŽÇüÔ¹%.ÛR!ôÌKr!×U2#FtqVÁ-Mfrá“îœD†šƒÛBwùü4~§ýžgȬUç ¨L¦V‘4i,ØwÄÌãþÆW˜ÜS›NÙ}[„N—–ª/ÔŒ¬O^—RT„µLEæIèîäKÈ­ºóô¥0¾q~ú%Ibè´¸¿Õ ªàêJW—kÔí˜î,I½ÅXý¢›p ùTk‘»H9…tú}Úí¶³Ô­Ýc; òbTf‰a?b¦R©†¡9þôüˆ×ZfÅGà‰¬q^–”/r?0Mó— ùÂÔX TXx {|Ž<Õ4“§Ø}kdj„Ó|Š2+5åqsZD4¦²¸î`Áã‰/•ˆ»6>Œ±2ÒœpU#Ì?áÆÊ‰0¬å/ +†×§ŒŸ„¹Úkë§KY„±yœ¸˜Zê”8Ûà< †B IDAT¬ßëNÂ(ÆfEal£x¹Ïïæ3QK7 ÈŽ ;Ù .ø×9¬Ï+Ÿ`ï\‡ooðÀŽ˜Ó©sn¥ÎÚ Â&‘垯(lbÙ}KZä³Ó„m,ðv‹<ŸkÊ5ΌʌHUxû®šó*4YXx¦#iÌŸ-ÎñåA?Šˆ*UºÝ.ÍfÓ õ3˜¾p/ªRË›}.° £ÌBÁš5k*áêSþégÆ8w]ÄPÉ+°¬Â.d“Ä‘¤šAj-ž\Z d´€Ì/LmܳwÌc׿–ˆ;‚ö¢`huŠ@Ü”¤Zh½¤ßµÒ¦“GÒ ­I‘¾ž~I1´F1³Ów—2‹%…îœdí…ZG$ƒŽYòyÅ•'LÇŽ¸-ð#]¯žómuæçæ§`ä ë‚85¾«û¼©h‚›ëróökÇ|ª‘k<äÜ‹<æn˜ü‚¶ƒT«|£pR©r]EÌ<ºæ€ª ÔNÁ]ž{/Ö|âþ?÷±¼£!¿0²Šs+CŒz¦E¨ϵCrnˆ½Tç°Ý!$­5w´›üî¡§ñ“”ßàÕ!Öø‘(Kz:%v00›ŒßõlÐRŠ¿mÎóËóGT¿sæï?aˆG-p$ñ§Ùl LJèÏa"dÕ/´¼X,ó4¦eÏ¥AEãC%6ÔÛüüEC\°¡D葵rÍZöˆ‚ÏF¾Ø³ì"·dîsº£S4FÉžü—2q?‡w+Ïé1~bJó¤±Ï#nJZG%*µpÒnã~k/˜¤gSxòúíÃ’âYRJkŽ»hÀȆ„¹sOøtòª}/€ê„btSÂèñ ÂwžzsuÒ3"²Oè,‡y®rÓö.ýz“AKÐŽ“c’Ÿ~EKO,1T’Kæ%KqÐ]˜šâœ½7è%‹hég0Ù"'âžyŸžÉÞúÈí-æž–¼qhœ-¥òØ d‰,îåi |9›ÝQ)ÛÚMîh,RÖš×–ë¼¶Z§$rr±¨´.§ÜM™³é‘t”âÉ8ææn‹{t‡‘ºäšµ5Þ¸f( Åõ•æóO7øø¾6E•V§K§Ó!I0yïŽ|ŸkÿY“Z™#àbNÄ5–×*eë Í;Ί¸lK™‘ŠÌòtëRèä!–fk9åv–LR eÁ_ô,{¼÷®#úÙ‚Àª—Ŭï¾â,þS31¾½Áö'R. FyY¹Æ°ç[H-2táÆpåÜUp1úJóN‹[›‹Ô•âêr‹ËU†dÆZ—ÂYv·!<Ã%F¹•Ö<8èñÉÖ"O2àÌU%®\]cëpÄpàåcYÃjØÝpË¡6Ÿ=2à`ßl óóYŽÉÿðhJ™¦±ùG1µÆ†¥ž˜ Ý˜çÝ”xßÅà —¥%?òc]L:fî ºÖ=R…v¾WÆÒê¼¥W¨J”&mKv%¢{ÌË|= ¬Ý ®)®=³ÂÕ§T Í•ϳ» a')ƒè@’hîÛÛç#w7éô8Çæ¼j@ÈÜΟ Û¨£lkÆZñN›[›ó k¸$ªrq©Â¸çg ç–FV0b‡Ê\%ûŒ)š§Ó„[:-¾w¨Œ^½ºÆ¹eÖTBiÃsYüÞ‘3æ¦YE¶´X¤\ ÅM[̦ ç® YQó¸eOÂcß÷™™™qâ€wó<Uû|(s€ñ‰Çý¢^¯S©T¨ªy~óê.Þ\¢BÏÜR‘”Ñ:…ã*³d,nö7¥iì÷9ò`@{VBb¬£Œ4›®é*OÐ_ìùJ‰ÖŒ{ufÉnJYiߌMî;)íÃ’]_ˆù Ñ¬8-aÕyƒ¬É´1þub aüw¬â¸„W–é6sJÍïÝ8ÏèðÞMc¼ñ¸!ª¾ÄNg‰f:mó…¥ajST©æ–C-þø±YV¯üá›ÆY;jbåÎ¥qîDà‹ !¸ ¸n¬ù½¸å¡o­OqA¥NIÊ!‘§Ìº±Lb™müç|m!h§)3{˜Ý.¿44Ê+"ãk {BP€o“É¿tÃXãŽRüUc–OulŠxï–1NЍÒ@èÇ"ÉpïÛÝ¿o}Ý­˜ܳÀgö6™òxû)U^b™²­饚?¿·Á'ëS¢Ñh°¸¸è–Èo`JsŸÓ£užKeÀ5˜ì­ŠƒÔCõãå„K6h~áâ!¦‡=³XtÎåJªÁ†ÜÎ)¬¥¡ÐLÎü[Ú…|ðÞ#6A#ëh`úÔ„5çÐâ>¦ÅíÓ~½æDˆõ¯êQVHaNupÐ%Øù¥­#y´S Ûœ²î’^N¶Yì“Ûî3¹5¡<®òø0€ÖyÓ¿ÓŽ}æœR3?Í··íìò—·.²J†¼÷Ä1Î/áãEw Ô~Oç°±Xg\|AØdW+æc»¸¿ÑåºóÊ\uJ…5#%Y2žÖš™¶÷}k‹z3äm£¬ £ìZ9n´Ä‘NæÙr7"ÖŠÃI̶V“ovš\”ygm„1ÏøØžµæÙ!˜P¡&¯]Nís§vžÚoóÕ´ÍŠŸŸØ8̹ãå,1Fi,¡—̉.<ŸÀ0ØG{).ôøüþ&ûûNŸ¸zs…³V†DžÌ6n°èP:Òç/ïkòh3¤{´ÚmçOw€®ç9ò§Ÿ+e>“G}2˜PS¥R¡®Ü"¸îôˆ3ÖDø6è|.ç#çþâÒ\ãb®ÃUî\XÈóá黎=fèàpeL1uú€á a`×áo†¼7 àA˜Ø’°ú‚é¦ùŒizêÆ‹ûò½F3~b†‹yº¨{.{‹ämzpÖ `Y–&[8e40[i¸_º·Ek®\Qã²éCa¡ŽÚ}ß²Äèì$Wj£ŒùµeѪiØ6ÓåÓûì£ÏάòºÓ*ŒU½lGIRÍמèñ©mmÚ<ÎŽêœ]®S–yª*`­o[ÍÞ$²s·­ÙÕïsWk‘Vsšri©Êz?0i¦ˆ,ÏZ[(]0 Ù©–C€=ž ¸¾ÝdsÊtÄ“N‰(*¸µ•uR±VžÂÚK<²Øãú-v4{ Õ/[rþêˆÍc¡—ŸX‚(npùî$Š[võøçî?ªÒ§Ûí:¥ÞމSïäY–g[™‡1‡d¿Ýýbbb)§Žwùo¯©süd@52—UvQ¹ÖeåJyU“Ôjƒ/O§RÁüãýíÁðZÅŠÓbž¼±D¿a[äŠñSLžœ–Í*S<Á Û?UA%Kc‘~¯ìQY™f~­æ„ÅÝ7”éÌåñO!aÕYVœ1ÈŽpÅZ"wÖ’À$WämwŒÅÏ­i®ÄîûÍÑfÊn^ä¦Gº¼÷ø1®]Sg8”xBd~p¶àßas0Ÿ1ðÖ)ÕR¿ØI{O/øß:F©®ùÃëÆÙ4p¸‘òû7Ìóͧ®«NrnÅT5e1bòWU$³œË$1hj!MùøüQžêv¹¦TãMµ!¦d^¤âòÆ)XÊ”\y¥Ý2­y`ÐãCYQÊ[æ•SV”};?9êÑöón vŠíB—}¥Ø6Ûå“»|k¡Ç›O©ðªõ%6ŽúÔBߺ~Kàya¾ó,2·.4‹=ÅõOvù“mmâ ŽRй¹97ÝÞ dXü•gK™}à—€?Cn•J%F‡«ÔióŽsJ¼ýœ*C%/Û½\ÓÀ\g"²E­ 0ÑL¸‡¶G£šÝu°à±ïÎæ!¯`‰4«Ï ÁÑǪã)kΉ©M©¬V×ZîëЃî ®Ø^;ªÂ¦×ô(xœ&pè¡cßòk§/5Ç_ÓËŽV…œ=Îü_ó[³¸ìóºD ÷y·™h4 ]Å=»z|ø¶&«Eȯngu%X‚Fœ;Éõ+Íï³>\ös‰É.É gî» ë7šÿ^(>ºkO=Ýà¬M;ö¥œ¬ê\gCM£œ~Ñ오ܟ5Ûl’°­Ûàk œ–xW}”•^`ç'9çV×µÎÇPÀÑ4ᑸÇWmö„®[_ç k†©X¦ªx~´ο7ÏçÊ`•Ö$ucîžíðÅý “”×o©ð擪Œ—ósÅ\¼Ý…eÙ3ê¬ )Øð˜ »Æ\O±íÀ€ÿþÕyº²ŒUXXX`0¸yÿOÀÿâYh]ôl(ó«€Ï#`Zöø¾Ï¦qÁ•' ®=­Ìq£~æ{ {Ù,y^äJåœoå|gw£9ì6ÿlõØu‹ ÿ8¯Wk¢ź bÓ<`:Á Èà_w^0ÿDÀèñ å1óÒØÄ[‡M¼¹¨xaMS_e;h+„ïPIY§Ï°úœx©…rJb†áìd³.–¬0 ðæÇºüóýmô¢àõk†¸tºJÅw06—b2Œ›£4ó»—*‡ÈwŠìï9ß°tƒp ¶“(n>Øæ¯wÎ3’D\=<ÊI¥ a¡ãCû~f¶•ÎÜ›†RÜÑ\ä‰n‡õÒãŠR•SÃR¶ äåùÓÃWnÓÚŸÄÜÒmsOÒ¡6*¹dU…‹WT ÍÆ’wS- ‘[s·vz©æù_9ÔâñVÕc¯<®Ä…k#ÆÊ®FË5#ÌÛ#åî–2ˆ¼tÖE_ܱ:;fcnßÛãëûû4ÅÆIŸ-S÷ì‹ùÆá€~ ƒÁ€N§°\‡iŠð}Ë¢Ì0}·ÎcÇÆÇô:¼ã¬ˆŸ<·ÂšQÀ7P×nŸÇh9¢È­•Ác%•m2§,Tu DkЩàà¶cú¸©6ß3g.­9;6?ÂÔ7}4àè·|’¶¤:²ñªžé錦¹ßg÷m!ª+­ß©¾Í2D5Íq/ïsèÁ€Þ¼D)Ýœ°úü~˜oN™RÙ—ë[Ká,•+Ô:W'! Áõ»7̳}wÌÏmã’é*5_.ñÉœ,’RûÆZ‹ ŠŸË*£È¡¯Óóâßô~ï[3<23àmÓœ^®R‘^¦üž…ÅúdsùÇZsW»Ágçg8'(ñ–ê'øÆÍ60;_™{…͵/<Ó¢Jù§Ö7õ[œ0òæuÜ<2j3µ”ý~1KΆ(sÏîI(¸ñP“Oî^$(i®Ü\æÂµ%&Ê’r ²RÈg6”ÂBu5q0Nõb­ÙWüëS=>½½ÅÁvÊ)+C~ìe¶LŒV$•@2ßUܼ£Ç¾Ú¢¥+AÀì쬫Êú¦Ùž_õ¾³|?Ê\Åt4üY0¥‰år™ÉÑ:Sþ<¿xÉWœT±1HMššîR묫¹¿&X ±]Väå‹€íþ˜+ÒÐs‰ݼh4A]±éò>åaEëˆÇûBzǼìÅûž`ý¥}F7%Yhèðƒ ЩCÅÜ`³L¦N‰©¯L™y< :©˜:5F„ÆÓs ÀÁ¼"Ds1qÝŠ0÷ºÐÕÜõdßÖ`•øÏ['XW ²yR:/ t¾džfYdaó\ÌØrÝ6•†D+ñÈçúH7áú-þ~ç"§E5Þ42ÎT,!Ԁ̑ˆÜ§°ÊÔJžì÷¸·Ý@&)﮲5ˆò0—ÀnxÂþMiM*` 5‡Ò˜[ûm>7h°u"âç6²©RòD6¯î èØF-J^·ªÎ«WÖ²ÜågŒšÃN{G¢p_.0U´´9 ÊÛ!£H"jfú)·nsý¾¥AÀEÕ!Î(×2B òL«âønL44•âþN“o¶[T•æªr•ó¢ e)³L]ÃmNn,¥5}­y4îóån“f%天ˆK¦«œPñ¥ÌøŒÌBêüþ̽˜µ²§Üq´ÃC =Ò0erHrñºˆ­“a–ÖI¶Iæ1}Í¥'ûïüÎa±§øÖQ£0R•œ¹6äÔ•!'OÔ¢|­¹ê>gåµ›Ga~}OO=ÔáÎý!½â8¦Õj¹KýL¢ÕwÕºè»Uæ 1)˜S`ZöT«Uü¤É{_Qá5'—8n,xFÎI¥2%!3kï6Ù¬n9{:g‚;M>½0ËÙ~Äu•:›ƒˆªK`½C ylؽ |sÐão›ó ÞvÂ0L”™Š|§Vë³ãot¾„]83ý”Oî]ä¦C-¶®ô¹|S™Ó§Bj‘Äd½½Ý:p[¤ÌE¡­Ñ+/8ÒN¹áÉŸ{¼‚ 6†\¹¥ÂÚQá²DX¥_.µêî5$ÊéˆÎŒJ{ ypÿ€?¹½ÍÎù€r¥Ê‘#Gœ•>Š eÝÍÿEþoʼsNÓ+„xžÇÄÄ82írÉŹ|„UÃ~¶€+íI‘u¢(Òö.-NJ“ßšU8¹æëúMÁÞ¯F4ËœùÎü3Z™²ö¢>шÉ<³€gžòØ}k„JlÈËVÇd›‡MeX³âŒCëR¤ƒ»}.¥ð©¤¿hÆ((d¸ÔR»ÝV¸|BôÈg^¢­ð²¾×|'åKwøÐÍ ®š®ñžǨ2K²p¬}ݦ% PWo„Æ"Û£^p¥‹.¯ÚÜLjß/òhÀl?åã»ùÄS ^]å ÃcöïyÕÙbÎ7·àZ±wÐç3ó3ÄIÂ/ÖÇ9¿Tþ¶ð˜,Œë¼pL¦ÖždÀ¿ôšÜ˜6yç¦~|ý0#¡—¥Ò‰>­óg1J®i§&Wú3ûÜ|¤ÅùÇ…¼ûŒ:«êî ¼Wx®ÖÙ­/AvŒ¬'uvn¢é 4OÌÅ|r{›{öÙ:ðæ3*\´1¢Vrñw3°/sÃáJFÓ47lïXxÅŸzŠ¿¸½ÁGïkSž¤ÙjÑëõœR߉i]tàßRÖK™ËÀÿ ¼LESµZ£zœ9=à §—¸ü¤2•Pf8FÚ<æ& -lÜN¬r«ìvv!LkÚ™>#Ç¥¸;¢;#32EQHtGP_°á²>~ {Ö1Ä]ÓToqŸW¸'²{**Æ6'ŒlJˆjy£a`´UÆ¥“ì [1î[d‚4ÏáÖíénNœ5¤š/«Íõuñ[’ŸÜ8Âécå™MKì›ßÞ3 n¾:Š\†Y>^ŽÚsý„ÏïkrÃÓ-ÊqÈëFF9!*g›Ÿƒ«y³üšZÃ@+vô»lk5éÅ.‹ª\Rª2ìyYHÉ}ÍenåÏgâ݇“„»z¶%’ºæ¼é —NWXY ‰—=KŽD”Î ‚öwb¾1ÛãáÅ.‹"aݨÇUÇW8a,°¼„û~Ž(Üw³ÐWaδÖ$ 4¾ydÀ‡<ÝJ¨”nˆ8}uÈ–©€ÀË߯s¥ÌºÏyA!¹Ä®!×%ƽç"ç§šý‹)ðwÛZl?›'RŠn·ë”úÏ€ÿ‡ïкè™Ê,Çàt`ttO 6ÆüüËËœ³.d¬æáYÖ/±õÅ.YBŸ”YgrÇíð¹Âh:s¦à¡7/Ûœ0z|Ì®K$iîK»W ‚ê¸âø+{xU{2¢½Öün}·Ûv?nx!ëŠu÷m³yóÔŽ³ÑäyßnÑgþ¸µºEuèò®Ù߬F¹«» ¨‡ øÓ[,Þ¹n„³ÇË ‡yW ‡`TAw2+½¨¼Ï™‹yº{u‹" ï‘ûÕnÔXzûá²}/ö¸ª>Æåší½•³ÁYÖ˜½¶S$<Ôiñ/9&¼¹\çô°Ä˜çeÛÃ(kjw ?SHsG]­ù‡Öw'mÖL\»®Î–¡ˆ‰ÈG¢ós› «Óµ9r°zG£Ï§ö.òX£Ï©«^s|‰McÑÌО+w5¥Ð}Uçn‰Ò&™¾º§ÇŸèðÄlÌÆIŸK6—8mUÈšj˜7j.¢žÌ "Ïn3ä®yd·Æ gɓԎ¤aÏ|ÌMwÙ¶wÀÁfÊæi­kÎÚ°ÐÑüÑõ-žœõ©ÕjEÖ;Á*ÿñÂY¢Ìgaüâµ.zblâ&o?Óç=¯2~‡«4±˜EÈœ®OlÈ$]šøŽÄ*ĵí Ù5ltAZ’F³éês;ZûLè!MÌ¢ôCÍø–”éÓMÈI§YVÄÀ“7D4öûd™Êv±¯¿¤Ïä–Ôfcå$‡¶i¡.Û•Üã‹ -xmøL°¯Ûu½·ã¶)½§Ågîmóú•C¼{ó(õç‹R„ÍÎðCGîï“'ŽqM4Ù‚Ê!ºŸYVãÒÌR>øØ_~ºÅu#\YÅÃ%—äËÀÃy Âtô×8œ øøì1öö»ül}”×—ëT¤9_«xz„9ïi©;ÒÓŠ™Tñ™Nƒ N]Qâ='Œrb=Ê”A©¼á¾ÒšTçÊaürÍÎf¿ÛµÀcÍ?uF7œX¥ [ Ãw”mÖiFË6/[šõ;H4‡Ú)ÿ¼½Ívv@À›N¯ò¶3+¬ò²Íœ;'2ëñÚu€Í³Ã|i2S‹¹=)ÌQ¿)ôMk ¹_ŸO<Øæ‘C1kÆ<ÞõÊ nŽX9ìÙÃÔ÷Í?ÞÕáÏnjc$©b~~Þõö~Sjù€›ëILs²+¤”DQD¬õxåzÅÛÏ©r⊠Û)3Kb_•ùŽé ³þ™}Z›]Zc7Gâ(8ô@Àá‡{¤§ùýК”•ç HºfœÆ.™Ú#Ëš…=sÛ¢qÅq¯èãGΟÔôf%;¿T&Éú=˜1«+6]>À¯èì>RH—XÛ€k­³Í ·Ï¶Þ³È p¤‘pã]®°ÃJòã‡9}´´$:§® (åR@€™ç!Û”ÜÝ9ëX´nGz 7hñÙ=M&Tĵ#cl Ërî†-ƈÍF¡ÙÑïrW³ÁÂ`À¥Q…«*5&äÒþàj}k´UÊ#ƒ>wÚ<æ÷Ù4rõš:gŒ”–¸ÙXŠ?r IDAT:^O8°m¦ËŽv"ÅË×–¸h]ÄHIÖbÞÔñà|a;žå5b¥ylfÀ¶°+³Ö7•8o]D½dNÃtŠêŽÐq÷çÐXnܚσƒÛrÃþ…„'fb?’°g.¦•*VzlYåsÚš€ãWøžE îÄî?¤ vŽùØÝ]n~,a1®$ ÍfÓ­»›€w.q(ÆÇÇIãלäó“çU8yeHèX[ Ÿ"ƒJåØ?qùÇÖr»dâ²ÂÔá* ¡/´OÞÑ=jSín·ñâ£'&fIi 5×jî÷8öH@kV¢ˆÊ¦¯Ví¸×ààý!G YòpÀøI ë.2‘»ÔEËÈë`rÁR¹—š'¹ä°ÏYBóóý»wõùЭ *=ŸÞ8ÂÉÃ_fVÆ)¨[ nŸpÊç´ ªèW¹¹Ì“o\–UE¸ ¹w¦Ë›Cõ<®®rR©j "°ßZºa™„=ƒ_Zœca0àªR•W–ª¬ôBçR8È™mofD…&ÖðР˧;‹4ÊŠË×U9g<¯!ÎØ^Ü~æn\²Çýs]¾ðtƒ /[rÞêˆ #>å OB°´]”3 wYË,…!—nÙÝå ;:4Š­«®ØRfØÏÊ!Ïp޼ùœ˜we~©´Îr&Šp–£MžWÐìkîxªÇw9¸˜²a…Ç +}ÎÙ²aÂc¬æaΣ^J|Bžpä6}aQ†RðÀÞ˜¿º­Ëm;Q¹B;¯ÊÊ[ÿÿÙzïèÊ®ëÌównx9•Y‰d‘ŨIeÉ’ZÉ ¶%K£ví·ƒzÚ–×tÛ«Ç^Ó#gY¶»ÝjÙ²å–LJ²)R¤D‹•#P@!?<¼tÃ9óÇ ÷BËТ UÀ{ïÞsÏÞûÛßþö>;vì /óÇï­ñàÞ±I/mîaž =ýÒ¹C½ÑQ8IõYAy(èÆº*Í; ^wuÏ5xB *’ÁýÉ£Ù\\ýQÕ+>¡Aˆ:‚¥³µ©ÚÙÏŠÉ›6f}Ú«žƒª ¨_ðiï÷)¦®©C) ¡ß6o#1ðÈú ”Òp5M4÷=½õH"ÁR#áÏßàóÏ4ù½Cüë¦^­t2ã 0&'5¬A«¶›Ô©’Ìz¦dŽÓn$›ÛÏXì$üÅéU¾4ÓàýC£¼~´ŸBÃi‘‰#lB–û 6’„ol¬ñX}•Ÿ­öñ3ƒôš2æ5R8® Fâ ½6J(ŽE>³±ÊYºüÚMƒüÔt/5Óóë´s¹=«³7éY;U]kñÿ[c®óïî©ñð®Õ‚磳H0VŠÝ¼â %ôó´QíüZÄçmò™c½>?wW¯?P¢¯¤¯)•9Þ„lF7äÔˆ†‰öÌ"[ƒM•fÔc©è&Šf¤xêb—<ÚäÔõˆ›¦BÞwO…öé«xΖ\ãM HS} v?耨¡yd|!ð|¸gOÛwøÎ‰Ÿúb(,“¦)që­†!ýýý|äH̯=Ô"“µÙh#VÞ#¥2#‰¬âÈ.¸”öáà“$S2¥R7Jœþr •f¥¿¨¸éƒM  5¿kÿM¢g8ivƒ¯Ï6¹¹ÐÃNLn99ÑþiGÅÚѽ«iÂÑv“§u&”Ç?ŽlcXÀ'kÒ°„ "»–¶TœKºü°Ûä´×ehØçÞ9ÅÞ¢û.ô½ã^+ʼnµÏ®¶9ÙìP*)þË82Q¤àe…Dj‰P^Âê™gfï£Þ•œ^ÒLô©Õ„õ(å¶é_{í({‡Ãlóëe"¬:Z&0ù¶ÊJL‘‰¢Ý.¯%Ì®&œ^Š9³ÓL${Fþòç¸q2¤\4Ï[eÁÏY  ˆÖ mÇ 0J”dçbƒ¾G?ÀÁo!t$¶eÔfW²¸!™¯K.,ÆYk§4º:O·é‡#À<ÏsR¡ki©ŽqËãyKžÂêéAY‘´=âŽ>fDkO•è‚Æ5Ÿ™ïÙýp—ÒPªáQ(©N¤¬Ïø¨|eÄö,œ (ŽHü’¤Pƒm÷Fˆê³¾a³ÅóÈMÁÆÅ€Ê@„XÆ]1~$BøÂä‡Y´ÐÐHø|œÑ‡ïä¦Bè{ýöÉ6ûLƒÁ8äw q÷H™¢3D½2Ãk£+9ãÈå>9#±j‹ŽWàœ‚5hKšµÉg6øòå#²È/ MrC±äÎMÊ}¬‹òÂlÔ6<µYgR >Qéåp¡LÕØº5‡X•T‚â¥N›G[ –‹ ·O—ù߯u¸˜[W©  èûY‹R¾»Ðä×›„eŽ; |r¼Æîþ“N;ç–¥­¯ÜG }åìðx[uêY¡Šuäàtvîu­ÈÌ‘#2ñ•½‹+«)/ÍF¼0qu%Ex05ìÑÛ#¸ÿpÀ zÐú¿ûoÖ6Ó fëÍ­ô˜UÏÌ–V‚¦GÖbð|`&h†>$±báxÈâËA¶Ýߥ>ëÓiHuì >‰bs]°|Ñgr u7Õ·=eîeEg] áÜIãJÀÆLJÿ~©sw_?„õyÝGœ× 4dY<ã3°_Pê“fJ¥1*•£œQ ³q5„ÖÆ¢†ÍØã+k1øõuž;ßå?ᑉ &ÁïkUNy=³fœ3²Ä:S•“¸¥ÊBüÜKóLÜŽ8]øG9¾Úá×F§¸£R#°QKXg‘Õ¼A;¢s6¹|ªRüFß0‡ eóY¡ðVÁdsìTH^‰ºüY}…¹0æãxëTj±8ÇêŽlUzÞß^\ã+WÜ»£È‡ï©pçDÉU¹ˆ¥²rfþ;k”­Hò½™ûò&3 ¸½Ê¼­Ÿ‰ÞO( f`ƒëyÏe4öxKj"¬T›·2ë}m=áKÇÚ|þÅMÞ}g…_~S•ýã¾›±«¹$á ¾gˆßŒ\MReÖAÛˆ%½¬xJçöÂýÌÕ¢Ísð}¸¼,ùÖ+¾òR›×böNÜ{ äWßYfÿ´O­" ªÕ+tñz’Ina«1Û0HÒ†}!žgá¶BÆ‚¹Y:‚Ôž¥³âÓ?²r!À÷!éšrBAÑ?®gs‡RÒ¶G¡j¼b Øv8föR«ÆB“gמ-àùPMI€B6·€4„e(öHÚË>¥2ôí!Ó´¡üÌ04Y§ï3ßyY³†ÕR§®®Å|ûd›o¾Øæær™¯¼zœ‰ŠŸEK!(˜áfKå"®}àÏH¥ë¯šø°¦`ê *C¹}½fŽ´v&ú(œ«-S.t;<ßlЊ"~¥Úσå*Å¡Z^iÛF%°$Žv;|+n°Q–¼íP7NöÐzY*¤2ÎBó•(åt½Ësk-Î4»ì øìO sp$49£rG—™28ý¨`¥rn%ᙫN,GT+?w_î)Òc$°ž€$©t,/…EdÃ,R’(¢ÖÚ’‹+ '"Î.'\Z‹¹q*àO?ÐÇ» C÷.Æ™BšjÂÓ)ÀR?(#­µ±Wé9âvè†=°ÞnŒnÝX±²)™_O¹´”pìjÌÌJB$»Æ|>ú†‡w÷°sÔÇÏíaËvG‰ÒAUA»“n…ÙFÛvE½£l}UŸ ²a amÆgéT茛Ö/ûLÜSÛ–â…ŠõKu‘ƒ1½S’Ö²`ö‰"žÓ÷wñ z÷&¬]ñY¿lVÄÌ>Y¤d:¤&ïéRÛ–°rFû êhÊÔÝk—ª#)=ã’ @FýeNÙ-„kˆpÑ47 èÆŠ/mòÍ—ÛìE~{ßúŠ„žpMôÚ­+0L¼ËMõ—Í£,S3bk´6W³ï‚»&Í*±ä\\ç[W›ŒÈ"gO±ìÏâFv±Ro·xbsrªx¤TáÞz=á)dn],]Lcm5x1í05ðÖÉ·–ÍP}ër iþXî&|ùJƒ“Cý‚»wøÐx£ß4:çûzõŸÊÉ-S¥˜ÛHxür‡'g»ˆîÚYà—nîåÀXH%ÌÍJ_!ïXgœÚî5»¯¬w%Ç®E¿ºÄÕv›_ïâp¡DÉô ¥É)Kôi‡$ˆ‘|µÕàÏ7VÙ;Vàßß8Äžjb9ˆHÊœqèe[é$|~¦ÎßÏÔyëþ2Ÿ| ‡éšO)Ì¢ZÖ/¬£‰Ýœ¶ž›HxúJ›¿~i“s«¯?Xᓯ«±o4¤d©ŽÝÄÖy¥*“ÔZnB¯m®’ õÁuÿüJ›¿ÿñ&‡¶‡¼ûŽ2¿t J¥(tç“Ò‡Ó)…ðoJ2ÃTJC`™jõ¢MÅ$z‡¾ÐÇþÚª)q%)\¯§úÆ"û§}ªEïk‡a«Ež0ûXšóЦÓЈr°]{µˆÁÁl {^®'—,WZ5צp"EçÖ½ÛS”¯Ük7ë—|–‡$-+JCèÊx‚_2P³,™¼+âêÓÚ›Ú[nÓê?;‚æ’GmWÄ`*S J 3ÇK©Êˆ.kD¶ìÇÙØ"+IMR˜[Oø‡6yâ•oï僻úu^l G©­#„Ù­Öqd¢ã8D–n­¯*+•kå‹SµÅØg›_¼´Á7/·8R®ño&†è÷í(xðr䢎 ‹qÄ ÍM^n6xM±Â Mê׸H£½±ÕÃ¥Jq%y>jñõd“ÑŸÿëðGÊ9‡aïWzz³,G g7"ž\nr®Õå¶É_yÿ(“½æúr†e%©ÖŸsFS[r¹žðÂ|—^í€o½µÂCû®úN£`É¢¼ÁÚgê›kÌ_ô:®¶$—VbŽ/ļ²!=Åí; |õׇïó |ý»¨ìÜ(íØ¡»:¶6¤45ÃD&* =¾ú õ¶d¡.™¯§¼4sn1f½-™ñxäοû2ÛG}B?çœÌÚp5ˆS2O¤ 7ŒÃÚ¢~" !2y®3æ4MiG’l¢¤Qqa…vñ¾n‚‡¹u!(8‰ggÝãêCsûLdPè!‹¯„Lßëñ¡oGŠð#®¿Ò¼®Aažé•@wC0q[L±¦@eç=é÷ÎCg{X§ùÞj[Ë\o¥|핽ÜfPâӇƸ©¯˜sofC›ÿs‚ówa®ÉŠ]rë´4Ác@°r{݉è=pGÙ,wR¾8»ÁcW6™¦Ì/O°¿Tv':Xq¿+» ˜‹#¾³±N#‰8ù?ûGÙ„–ãÑùžÒâ+F¹wùJsƒÅR®±¿2:È‘ÁÏ39º‰¥"ÛP§ê]¾=¿É\36 8²;äC#ýLõúF"ª×XÊ,*K%LmT_Ê+‹ߟé0SO¨–ûÇC~ó‘>ö†Ø%×õ߬'8ÏÒ[ÖØ¾âÊz“ºœ¼†02à±m"à¡ÛzØ1äS s}ÙXy²pŸ•õNëýaÇæ*Œá ÄR)²õT‚N"™YNyþRÄ©¹˜•¦¤VŒô ìñyýÝe¶z ôd2Î<”ϳÚBXR+cÄ­´Ì»0{Ùþ¾0×^)¹•ÛZšê«hõŠ5d—å»mJ9àqúc %ê´¹€P"¤ÉÑrÕ–o<õ‹»SúƤ.m(¨M§TGRVg|–ÏÄë…ôŽKö&TG$^˜åoÂ%: î†íõÚ¨—kPNÌEü_]c0ø½£l¯†"åkºÖ€$n:¶Ue¿¥Ò©|¶„èú|dp‚Å"EsЕõ ™¨%Q’¯m¬ñâfƒŸ*õð¦Ú0ý¾§ÓkÇæÚìõ^Oþk}•“^‡Ÿ9ÐÇÇÇ(ø†Õ¶([1)§ynõ¼µÊ»÷ô0\õ(ù^-s{#ôrhHA''.wøo/5¨'’7ßXæßßÝËh62}Lª2Õ\<Ãßha¦†³ufÔ[Ч/uùúÉç–c <áe¼:^F¦ŒH±ÿ¬æc˜ Û'š©…¬úžØr½ÂÓe—8Uœ]ŒùÜÓ›üèT—ŸÛÓÏ;¶×¨äÊ-Võœ‚ÆÂa! `†…)eóO½i ž•GÚ\:Ëùí)±]M©ÒDXWJN­wùÜÅ:/-D¼¡w× ôQ6ïåÿ9TO^n7ùöú‡‚?íeÊ×lñ–ABÃÜ.ŠóqÌcÝÏÑâ¡Ý=üÖÎ)ͱ6vS ”[Û¥NÂѵ6ßXØd¶Ýåmû+üÑ£ô)Úq*¥Hܘ¤,j&RQïJfê O_éòô\‡rQð‰k¼ú†Ò–:»”f„ȧ0úÏTI’$sDÝD²Ü”\YOxü|——º ÷z¼ç¾ îëÃ÷34&É¢›Ò-úLxÙþ±$¤¦Y„»—ÕMÉRCrn!áÄ\Ìɹ˜HJŽìùÔ{+Üw0¤T0Mž¤?8IíØcmöÙè^êlnœ…é…P§|¾‡>âÈìé8ß×;-2s´àDçÚ¡÷¯ˆFô¢eý¹6ñ¶·ÑT!P¾¢4ž°±TÈQlÐ^öؘóð*z8mGBßN_ŸôàÁü !išEk_ Ö.ôß #®…O¶v,DvÀv‰Œ3†ãf/©lS©í ÅgVb¾ð|““—bù›W 3] \=Ж¥ôë2¢FªŒ¡N•rµÕl¨:`ûBלmSº` ®0÷µÐŽùŸê<9×f_áwÆÇ ôáuîÔDpÄFC¦<ßÚäl{“i|~³6ÈábÉÔå ò K:JòbÔá™n‹zoÊ-S%~v|‚‰R˜Á8²”$Uг?\lr¢Ñe Þpc;'k U|ìéžmÌÕЭÀèìJÌ®v¹´‘xŠCS~ÿ–~vá®-_Ìö™g4먜¾sôZÄÅÕá+úzàîƒ!}¤ÌX¯çš4ò2Ï ²³¾ìó1[Ô:$*kع½$lv$gæc^˜‰XX—lÆ<ÅÔ°Çí}Þ÷º*;Ç<Ê…lÝ-³mO ,ª+³fRfFƒvLµ"C àÄZ%ø¦æi÷i£©¸¶"9?ŸpôbÂüšu?™Uöa¶D%<{²îåÄäÑ#‡nSûT"X¾Â*ðÁ¾qvŠnúäO:)/µ›|½¾Â~/ä—ªýl7=Åù!÷ž+$JòBÔæ/k½ðC},3Xô]žn7½…ngþúÜ:×¢ˆ‡÷”øåÃU&j>å +c9ø­¬Z§áb¶Ã?œlr½•ò–›Ê|øUU&z}zŠºÉ?‘¦¡Æ =t•1麳´uèG¢G½¨¯²$M>x:°ž±K.,Çü¿ßß`nNò»ûG¹¬âà"›ù(#ã”f!En`»Ú‚ šÍÌK0­qX§“ÍâÐðéb+â3§Vxy)æÍµaªõ9†—ëê7lKÉÕ8âÛõ5Ò$áSµAn,”tþf˜zßD%`U&¼wøRwƒf%åCGúyíX•¢Ÿ9BMð(=¾ðÊz—¯/4¸ÜŽøøm5^»£f4*·1uóH&–ˆ%4ºŠùÍ„o]hóÜ|—JIðÞÛ+Ü·«HµàeXeFì±õL­Te,S3Ö‡ã_NøÎÙ63õ„;vÙû/ IDATø£÷õ²oÜw©žÕAĉ$È5e`ŒIJ¶œ±åZ ³­•_ÚÙÙáŒIn+¥¯oÓVy•Ðöe‰ÐVWÑh+šÅÕÉÓ§´áž›OˆRÅÎ1;oôùø;Cn? %Í+ð¡?Š89#·s’hhlû=-k¨ÙDD•-jª`øPÄÆ5Ÿ¨i.OxÅÐ^}ÎSAãJÒlŽ‚¢6¤ØXðñŒô Þw™“½eÏ¥=Zy¨_zågÐZ˜k´ºõ‹"µÓ“ –Z¬qj.æô|L¤ãƒÛG=>ôH‘ÓúªVÝÆÖ+UËÿÜEat³†]+eò…TÈ —~rzLj“ó«’ g®¥\ºž²°–uÙq÷”Ç#÷z|rG‘íc5ÜÈ(Wo4·NÅÙRšŠR )c´Â¬V"ÍÆ•™ÐAxz–ôÀÞ˜åc£ˈˆÅ—CVÏx> îKû$jÞC(Ay@2y—Þ«~AÑ·=!,+ç0¬P…-T|–ÛhïŸIåôš)Ö[’ÿþLƒom󦑿ã Ó•ÐåN~îAÓ5Û4Á~E2ËŸC!ÍZ$R“=X«$³Zc]ûÔ%žH*¾|yƒ¿:³ÎÍaëŸ`<´×’M³°»ã|·Í?®/1¡<~ºÚÇÞ @ÕŒu¥.óë«iÊ?67xR6¹u¼È/îd{U -„5 ñQüp±Åß^¬Ó)oÞ_æ=;z­zºQBdàS;qåôìTŸ3ü÷Ç7‘ìn"yñrÄcÑüÙá öÔ n´f*ë5Í=+Tv&“È OèęýÍTâ"¶…O–ÐèÆK—Þ$§ê]>sjãËåŽjMGTó"=&I‘ XIb¾³¹ÎB»Í¿­pO±¢¢ýd“Jt”b!Mx¼Ûäï:ëÜ?UáOneº:'§Ê]÷F,9߈øÜÌ:KIÌo­òúÝJAžk9âOG²v¢Xj¥ü`¶Ãÿ:Ó¤·ìñ¾»ª¼é@‰bhÊ‹ÖQ¨l³e£Œô¡{JA”Âr3áÄBÌ×OµXj¥Ü¿¯ÈŸýL?»G7jÊ2ý \?´çã„.癈†¬•ŠQ¢htW×Rž9ñÄ™.×7RíxèHßý`™±~Ïvæqß!Ÿw¼.ä–½‚jɰë¾u†71U*•a¹ígÚŽF’v”3r»?ÇÇÇùôà o¿µšÓ¾ÚšXGÜøÒÜ«7¯{\y²HÓ@n½ªÝŒžãwDÈ.ÄÁÔ]1~)¯j7Sæ…Ø‚£¬qãL·Ž_‹øâ›Ì\Nxx¤Æ;¶×è1*t'¥TYÚã› ×Ì´í¼Ò¿h¯¶¾Î~ž€-ïiÅ ÖÍnÆqh€‡Ç{(š–ÊH*Ö£”VªY鯶ùû‹”ËŠOÝ×ÇÝÓ%]¦Ã§Ï•Tz2ŵ„>Óä‰Ë]v û|ìÁG¦ n ®Í›ís‘Æ£9t‚&±®ÖS¾}ºÍ·Î¶¨”¼·Â/¿¥Ê@ÕsÑC¡›,’T¿¦IV7%—SfW$Ë Åü†¤Þ†µ¶`½ q"I¤ Iºª …LR!<TY¯ëŠâÉY2%M"ÂbJQ+éHºgnœLÀôÇ­»}vi§iuÐÂr=6ò›ûô€(U4c}ÏÏ¥ŸŸ}›Ïý·øŒ ç òeUk#J ¹FÙer|_³M:ç)Bc™nú¨­¶/IxIÉ-Zž™ýŸÞäñö[*f ÙÖM½%GrXOê?Œ!ÒÿmD×ÌÖ'-lÑð6cålž$ÐÊ-;§)N?žø§š¬-*Þ1ÕË«Ç*”¨Õæ[Ö˺…Åù ÷½b+ŒöÜ*d9˜º¥ÈØmû Rç6º|ùrƒæ#Žk<ØÓK¿¯7”ÊyÞ¹$âÙÍ‹Ýû¼·UkLáÖ0,¦ ÏtZ<´ûw•y`´Âr'¥‘¤,¶;’K˜§ÌÕ´@=ì%¨ üm–·ôÍñÉ;{¨¸ÜV9"çìjÌ+×#Ž.F4Rɽ»ŠÜ¿»È®ÁL7ô“óÂó ©‚¹„Ó×c.,'¬wSÖ#É-ÛõQ*»GÃj+æÖS®¬¦Ì,§,nH®¬{\kYK*\¾ºL£¶‡´: å",£'1–ÕÝ´žFÐZcgXgÇ‘û~€ð|‚b%Só¬iÜeöŧ˜i¨Ñý¨´ I¬÷æÆ´×Qk×P׎ñ‘;Öù“ŸëÑF£²}ea­”°ÙQ\YN™¹.¹º’2»”²Ö”ÄRR,Âøà†)[oðØ5¡kÐÒ8Û°á Ü©¢¶tꢫÈ4 ÊÂvãóÁH:…˜C—õ<غ¿TŠKóŠ÷üÇ” W#¤”[µÙ_è‰iV°­Z'𕥄Ê"¨g¦WZCQ ü¢|ÂYëÎv"ÏÖÐÓ¯±ªOÀù¥„Ï|¿ÎK3ŸØ9ȇ*Œ•²—͈œcVð 9¨b£¥;ôKeî9#ÖßÛöDè%Ј%ÿ4»Á.mp³ßÃGûÇÙV(¢Ìÿ,bYO¾R_år§Í#Å ® 1xÊl´Êi%Mø»Í:Ï%mÆv÷…4É£—|îbƒ¤hQ©âöíT§n Píe[¡Ìîr…°TAxëW/ò¹Ïþ.Ï^]¢ZðµŠH*Š ›*.®ÆlDŠm>·N¨„Ë›’ž¢d°b*ê*Á«Ó#è$’ç.G|ûL›¹Fʾ ŸÃ; ¼v$djP‹CêmÅÓç"ž9ßåâ²d!Bí%îÛAit…=Å2Åú2çžCþ7åZ¶ë­G3¢d•Æô]ú.û_ûNJµ~MºØežBÐZžçÚj uÓ[öX³ÉÄø~=åF&ȧþø«k$¾©ÔAåâ‚äÇçcž?—pa!!ÓcÛǯ¾ËcÛˆÏ@o@_UÐS±’b•í9•Ý‚Óô;A Ïödc˜}T&…U¹HäX „©i{ %miÖ”=M”R |ñà ìW'–šY„,„ú…©Rt­´²›Ü2ƒ A+“œkø™§Ó¬k)ëÉúU=!ôÙQÊ2èÖ•hHþ™ï×¹2+ùÂ=Ó –í¹„é+Å]În$NJ&ùtNFOi»¾œÑgÆ®Íëë°÷š*ŹFÄ9¾Ââ†â—†§Ø°ÄÂÚ¶R¼ØjðÅÕ%î Küç¾Q&‚À½Bñ5™ðív“Ïl¬°á)†ÊEŽ­¥$­2£ûŽ0zß]Œï»•òÀ(ÂÖ™M[xdˆf`Ç~*Ó¸’&z÷/"üwè¦z@Þn%IºmšKs<»x…ï_ž§ytÖÊ<“•”±ªä†!ŸÑÁΑªàG3]¾z¼MO>pO…ß¼½‡þŠG’*6»Šž‹ù§c~p©@Ïö›Üsˆ‰WÝÃÔÈÂ÷Bÿ‡$—ÏŸ%¹õ§ Ü‹ÒçmA©ÄÙïsøÁ(õ ¢Òuðü @{qs“ù¯‰A˜'aD críe&oôØì(ê›’IøÁ‰ˆïˆRÅí{}^{›Ï/¼'dßvBhJVJ <å N"%_ÍÉ6ZIqÆÃ(IbZ)1"e”Œ¦çÀ’]q¢÷¥'¬]év]ß×%I`}ƒVƒ@ÿ~œd«·EÎé{™|2 ²‹–f×Û®Œ´S$È}ˆRÙI˜È쉌̼‘rWþ·-ÝN*[„ìîc¤¤GÁú®û*H™5ÚXá0{­ö{«¯Î×b·ìÂ@è£XOÕ»|óÚ&/ÍÇÜVêåãã½T„oÌI;žM™r¢ÝâDs“!àOúF9X(éëPº¹”¦Ì&Ïu;<–ÆÌ×(í=ÌÈè6†öâ†é=ôŒN„E@ ¥ñºÊ@KÃz(¥uÂD,eòÉݯ~'ýKеA Õ^3¬Á¶€êg2¼ï°ózJJ”Lè6êtÖ—9¿±Ê+õeÚ«×i]¾NÔjà´é+5yaa“ ßî2XJ8¿˜ðãk•l»ç Üÿž{)ÖŒqú[ꬠ?éÒiÒ¨‚ðõµg=†XWê­^â†ôNìÐ÷åûøžÎu•’àùȸ˅g¿C}ÇkŪ^™š”-—´â!/>ƒ¬_ç+Ï{ LÆlZ·Ú„‰ÂEÏÛ¢¶Ê“\–ôvó›ImeÝg»¥Ó?9OiI¯zWò³už¼Öæ&¿ÆÇ‡ôÈÛÖ™(ɳÍÏ77ØãüL©‡=…%¡'F®Ë”çºmo79«$É]„7ßËðô¶S¬ P¨Ö¾qßh”"”ÒÑÈ¡£Á55 íuÔµrôÀíÌ>3ÍÆü%†o¸e!§ðÌô •Át„"¤<0BepTC7ÎK“„$ê’Æ]’ö&‹ÍW[´V¯³ÙºB³ï2B¦\yî;\?ñ½“»(÷ 1°óFzƦ ŠeGR´V9yôÇ$»ÒŽEiÃSf%­Æ€$¢s–·½Î<+{AæÞÍs]_¸Ìå ;oÈž¢¥w!Û#õ9 3OC¨øèÛ}nÚå16 î×#¤­÷<›æ™—K0 +š,hž5B2µœ» +ÍþM¢£¼-¥r{_Zˆ­²÷o¶àü5É™+’³W$®I–ÖÍàB_16 Cºñd ×g£ùÆ,„ JÝ«š–7ŒÊê’-‹­ Úù³s²cNõÏ<¥s®(׉e÷gDöyy¨çá&SH“«cH] 7çè‚.¯Ö2†¶_Ô6šÛFÏ@åüš)· 8#AŠÔJ÷ÿÆ ×9VùøÐý~)“¥§»->¿²DŠßéagX@¡ÙëW¢_lnðh§E¸m/Û~/ã7ßKexÜÁf„ÐÐY)”LÍ¿+„Iš”Láå7«ÑH‰ò²Ò„çùÀ¯ÓÝÜÈ¢”ç¡”D&±yf—Y–û|cÜH…çˆR?,¢”DõÃ72K™ê²NÑݬ³xö(«³xêŽ?úW¥2=#SLÞúÛ÷sò±¿¥yÇÇÅjæ|°õ]e>_á-_`çŽiÊ}Ã($¤)RêQüBxÈ4õ/tw?’AGO+ •Õ|£PQLmc†ž¡AƼ€Ÿ}Sàd•–á/˜”=NQd(¥ÎS-G¤ÓõLmæy:Z§FxYÅ@)ýº8ÛfêÒIÏ¦ŽŠ8ÒŸUß”œš•QíåR•¹$æñv“u»¼T®°8¶ê¶½Üvðú·ïÇB„g'vZ7lëêf!•M9´NUxÊ;¢œ‘ ÏCyÃéMì™|NÑm¬R™ÔŸa†®EÍ:Bzú¾§…ÏÌ\r”§y™&΀õ$é®Ù¤W(ReÇ=o`ÇݯG)Iwi.ͱ~å…YV.C¦ åãÿLÇ+‘VF TCô"ªƒˆbî„X½ÊDã ã¯ýYÒ$Æ Íb›gŒqæçžúk#G•AÍ&ÉT# ae”ÚQ„ë³ìÝ1Îüâ1î¿Åsû¶µ*¥»Ÿ,ªÌFe)GØÆ¶Ae>_dP9µhR9X­­¶ê÷j¶auC±º¡Øhé?ç–‹ë’µMÅJC¢„bl¦ÇáÍ+>öÓ‚ñaÁð€¢R6)«½/Û»©Ô¹x±mï\]B/˜›*ioLdw;µAx&òåÆÄx®‹H¹èš½±ùNäþfà‡õZîXeS©Œ¸²¯)˜Aý å&Q¸g-2ã´Ç£$?aÈÖàþ6÷Ãk­˜Ïž]çÜJÂ…^Þ0ØC¿v\?¬WÚ-žØXgx¤Pa¹—ËiÌ^_æ˜ïÓܶ—ÊÍ÷п}?“; ŠeGVÙ/ÏÉ2Ðïyž>"H8@ €LS=I…ÌÉéûÕ]OGf÷AP¬Pê™"‚„Ogc…ç¿ò÷ ŒM²ÿ7œó~®N—ePƒ°¸%·€f¡…‘(ÙJ‚A±Lßôú¦÷€RÈ4!jm5Vi./°¹tÆÒêsÏÑh4Hü"bpAý 7üô¿ÕÎ*qUKçŽq±UBLîs¿£ëÿ[“&¹2Ët:Ïèî7pé»_àÕ·.ˆ§†sÉW1’Ôp;žÙO–¤5y­d Êœœ—Ù†F™‘„V[qîªäÒœäü5ÉÕ%E£¥ÿ›SŒ)†az§âP/Œ BO†´Aú¾µ»–9! :ÀZbÚ•—çYAOÑwM¡¯§4è¶EE`B©=vC˜\T³mÕ”}ê¶\–‹:mU˜.éùa®©ß,š&Δ;›Ç{·ê,+Ý"þºÅ.?È^oЬVî›èž˜\ì» MþÓËËÜ]ìãWÆ)yv¢—ŽB—º]>·²Èfó[}ÃÜV*óT§Éo¯/r¬Xaûocû½ob×È”ƒÂóâðL7ºÀÀcw¼¦Ö1ËnáûzczžÞœJ¡96i ]’çDÁjç †T‡Çõ¦N”Lh¯.²¼0‡_(‘v»„¥*ë×η í¾Ù›âbÇ“Äó}——«ÜBf¹Ÿþ™^voÖ=§%<Ÿr‰Rs»ƒPJ‘vš¬ÎœæúésíÂEÿ“_`üæ{Úsˆ‰[î£Ü?dx謯pþÜ9¢‰{R¢rL¸Rငn‹¾¹g¹á-ïåÜwþÙÜqÐs ¦R¸3Ò„ÀÌÃÖû#GÙ£‚Ô·£ïºÁ‰K’gO¤¼pZòìé”õ†blnÚwÜï¼ìVŒC©à–U§¬ifJB!Ô)m*3´™$²gÙ„ô41'–m‡$ɇ$óú‰‰ ~çÁ˜÷ßÙƒeÙ,¡¥œ1à˜Qûï:ì+÷–,³ÑÜ~”•þY@Öóù¦ù>ëï5ŽA*~ÿ+kÜ-{xóté[[[r_e#õV¹œ»ãÍ:©äùåÎn²ºïèbw±äNuèJÅ¥¨Ãó› Ö£.wÊLúÏ¥ ÏWûX™dú·=xa¹JþË~þ–° êÈ‘åºvô„Y_”4Æ`ÞË®,e D¡Ü!|™xGçÍú2A±¢#°ùÌúÕó”F͵ڼÑËÞ3gz1s×orLå4®"Ûav”’T愇­¯³Ä•Øò^:¿ÕÏG¿>ºlÌ_buæ4+ŽÓ\ºF©o˜ûé›ÚÍÊ• \ìÖ{îÛ ÃÕ\AÕ¯C§Nõú ŒvÎ2¬³{´Ë»_ðÚ#~ÖÒkƒcdÐ\ïË4…&¬oJÖ75Lž™W\Y’¬lhX<{]2Ð Sc°g[ößô¸ÒÆ·×æóZŽÀŒHÊŒ%U’:zC÷I£ƒ'tÎü‘ß+ðâ©d«h$ISTÛQe mÆÇ‘EZ ?ž2Ãφè g°€ÑGë÷2T^PµíÉŒ ¶Ìù²Kïå¾·›F·²Ù‚}Æ(Zgä M ½²Öáó—ꬬÃ=¥^î­±ž&ÌÅ]Æ‚3Q‡ïmÔ‘IÌv/ ßy¢ÛanÇ>Ê·ÜÇȾÃì™Â K®üã Âót么&r›\<‘Íòô¬j,ÝJvéãO<„ü‰Ÿ!iª#´YC  Ò”bOÎÈt>Ý7½Ç°Û™Ae jŒgÒ‚¬l’{Úºôä"°pŽDô\è±ÆáR‡|ª¡ô ƒ• íJôoßOÿ¶}ì|Õ›él¬²yý ›‹W¹~ò9V/ŸGÆê‹x;#ú&!( ÎP>úy]ãö]Žñ!˜ñ(:Y¤oüŽ>-E§pq¢{‚//JÎ_•Ì.(.ÍKZE±¨¨Õ==Šá8tH1>ã#ÐS ökõNÊ.I*Í ì0K =A’dóÉ¬Ê td6ÝEg{h§5zÏ×RdëC“Ô¨ÖZ™Ñm„Fê{æ<$ãÍ|‘AkR*?2•ç¢D6Aåþ=Im-XOó´¯GÙšµþ»>RS¹…òÈåÖæ{›+»áL䈬ã¶US™cõwêü͹:oèàmý}Ìǰp™­èóR)yu©Â\œð=Õ¡ç†[Øó†pp÷Íx¾&²ÌUÆ8³AÚX<Ï@fe"nñlDRHdÜ/ƒØ€©ÿJdšàù#Î<Ïw ½5”4ÝÓæ,t”$MøA蜬{ëÕ‘V:×÷„f¬£Hqñšä¹S)/žMyîTJ» ;§7î#ᵯ†mãŠjÕŒj‰=Û IDATÿ1eÏa³ÁÅ™A ²z²2QYxæO¥ÐØ”ñɾggJ ߯9ÏÚyO•ätãfˆ!$I¦ÍÞÒ5ÕŠ”›¢oGvJ¢Èênz¬¬0ÚQKTá‡ylZû*Üþ㉌ȱa MïÛ™IúhØ%úzôé ™ßduB;{Ë’pޱ4F¾ÖM9QïòõÙM×ჽ£DþŸn—™¾QÆ_ó^^µóA©ÂõÏsíÅÇyla–±Ãpï?HuxÊ0»eØÚµÕœÚ|ãR5&EeÞ+{j9H ‚ÐIyãBxx† °‘,5Í0ˆô6ÖÂ\¬ê*¤qivðÌälƒ<ÏËàºq02I2ømØ…fÕ•‘ZêïÂ6ÆŠœ`ÃÁ_¥]I ž/ O L‹ž»wÏÓhÆ:¥T[„üÀ?`pÇ~vìgßëßOcá2sGŸ`em“œé£nrd/L ë`°¼®˜Y\¾®¯çœnððCÅŽ ¸÷NøÄ‡`û¤¢TÊòbƒÜèkxÆ?º³Ÿ¤‚‚¯-H©­7­ÁZgàôV;Af› O­QÛi¦·Âõ¢Ût=eÛÔ¢¶Nñ=ßMÊÕT1†ê‘Õr!ûaà°šîŒW˜(a¾wp-×S+¥mqÌé¶…=àÍîmeZ  ¹b¿È˦s 7¶ zú4åûx¾LMy á"®ð}„çé{8ƒ±ÆîJQö+WJs0:—çºûð<çT3­/K¡Õ¹ž°I¢MM W`Ü c—`ÖÓ"­ÞÉôMí&zÍ»X»|–ÏÍžáóÇ_f\œ£±ºÆFSòúûÛ'õ4W? †¡~M"9a>Â688£Ö.ì35{JÚ’”1ðÜ\[ 2càJ* ¡íÆ5BÊÔ·)Y ¥ž™˜Æ’:¿örMR¦ª}Œ¼“‘ýGÑ»h­-±yì‡Ì=ÿM¾ùÔE^ÿ*ÁïSŒä TXkEdI–eÎGd7‡ÛË€— —ç"¹Mýº‘i³4³)¤ùÝ$ÕßqžöóÌmÙŸ-¯ÀõeÁµE¸vŽ…330·¤ètõÆ 4»9”gLŽ>ýŸ÷ÝÑc†‰È¨íl¤nòÆ­ì_,™åä‘a’óÛz³){¼jµìUYéh’Âï>ºÊá¤Ê{wö:²ÇzH[J³ÃøWº)ß[hòÙ³kÔÛ0Ð7ÄÚè6&ïy#Ûî|hë zY„u÷bž–»n»)!”ë–ñ*MŒä±EuH:-Òvƒ¸¹F¼¹ŽJ"’æDmÊÕ}ÃôôÒÓ×OOßµAzú‡(K†ÔÒëa#Í7UÎa¹œÛ’|ÒDKyq‡ý=ïÿgì½ã,»®zÏï>áæº•sUçVGu·[9[V²-˲ ŽÏƒmŒóó˜ ðáÁ3ø ðû ¼±Á` 8GYH²Œd圻ÕA««ºr¾ùœ½çιmÞý|l·«êž°÷ ¿µÖo­íy {-ED‘qD«Ù¤U¯±47Íòü,k‹ó¬,̱0sžXø(äKdÈöŽÒ·ó22…’[GûœÆ¦äÂì¶}.CB1`«=‹,íšëØ]Åqû€£¶*¾¥NÑLËŽ­ȸÅâÉÃL½ô(ëg^æâñnÜ·Àå{šŒjmãNeÅØ#ë¼Ò‡§ÛÜyÍDyT× ‘ Ý“h¸ãnâêM­äkUMÙ\YƒÅÁâ Ì-ÁÒ*Ì,èŸÏ­@*:˂ͣÐ× Æ ¿F‡`tHqä¸à·>™áÈÉV{6[JI,Í¡d†©å`¶{['ÛÉf] ¢NÑUR\·'Œç“&pp°“v¡UÒz{½YÅŒ n™øQµC~ ¹k±âóë|ãô*OÍÖÈ;é¹üZ:ÞÀ–­ä ¤0°ÎÚ³¶jÛKâ5!M˜¿‹"οø8¹3ä²YÊå²™®L@¶˜¥sãV:º{Éæ dóEÂlÖÞ /I­Òô½æ:rB¯Üê'kž‚ü–X¢Ÿ×¨äuà…V*v¡x~@®P¤£§ ;´Ø÷Œ£ˆf½F³^c}y‰£/>ˉû¾DitC›(ŒèL«tžp×vÂcßà a5ëÆ4ü׆Át…Ù6# \UÊHDÊ` 'On=•t%<Ïóéݶ—ž-{hÕÖYŸàŸOæ‹O¿Â°˜=#s\wPñ¦Ý:[HyÝ6a¾Ó«¤ž0LHãP<j íMganÎÏ)V*0» ¨Õõ† !ÌšïúÐY†þ>Åæ‹àMÐѽÝP.A©¹¬r³¹Ó:†‚ÑQE˜y˜ z„kª01„G*3Œ¾h,õÙ°¾%2  ïTFÜåí"HÜq«&[o®œîXØŠ‹ÁŒ%ÊyÄë©Ñ+ªü>Sø£çxhºBÝϰéú;ÙtÍí”6àgsm1ª3 "áE£ì Éò™#¬œ;ÁÐÅW‘ï0 ¦5*³ç¨,LS_]¤±ºH}i–­[6ò–w¾‹|©ƒ “Åó<Â04ÉývŽÏ¬”è—°Â,bI^Á%¬¬'?×:fJV)(›NœYÔ m¬k”Û2Ì 9æÇ‘N„AÆË ƒ<Ï'Ìd(ttÒÕ7ÈàÆ-ì›fâÄQ&O>ÅùW˜›ž$ö²tŒl¢<¼‰Ž¡M”úGôº»N󞆀âùGL➟ÎèûÉ8¥.!bYqÊ5œhypáMjuƒ äJ]d tmØA\+õe;ô8÷|ù!ü•£¼ù`Äo|X±q$•±Žu6Úö(ÈÔR/¯À‰ Ák§`â[ÙR¸YIVÖDZîHJU–ð®`)¸­’°LJŧ¼Ly.ËǶw9 €éZÄ&×øË×–¨ä:Øu»nÿƒM ‚…ÇÚJÅq‹ÆÚ2­Ê •yÖ§N/M1<6F._äõ×^¥ÕŠJÒÙY¦Ü?D¾«BG'~R*—ß¼•\AÖ÷Sƒû´ÃL iºŸŠ%“Ú¼0ˆÔt6Ù?•I¹HØìr §êä£Ôe©6ê%.„°5}hž '’:¸þ–0›•$ôÔ%-|—?Hæ~#%‹³çYž›aîÜif&Î0?; òÆ(n#(”ñ2y¼LáùxaF??Ä2íÀòÅö&÷ ×"yNÒ‰›¶¿n-“–HkJ’° Nâô#? zúiÞyÕ2wܱaXÑŠaiNN&¦afQÇ«s‹ÐŒ¥"lƒ cŠÛFa|:;“‘?Ö˧§~š%s1ó… ¶Ôö&ß3o&%üÕç<üû›D†ÇëUN˘¦ÍiØï÷ööòŸ®–Üum9Ém¤Àý¡½q‚òœRc ‰tßI”]ë”._ÙRR:¥§/©Ü>ÙÒU,~ß2¥Ù ÿëÎnfj÷OUøæ™UŽË"ýû¯gìҷгy^&ÁŒ^½:*ŽXŸ=Çüñ—ð£*å|HΔ»zèÛÀÐæmds‚f½Æ÷|›‰Uźʰ¶¶Fµ©hµZDJÆuÞsÓA.¹öÆ„ ân—XJí‰Ó˜×$ÏÚ²Š©õMÇôNxÓÆ3ù¸XÕ iÊzÚ$b[æœÔ?í}ìÏm™Mµ__]ð3lŸöî 'Lxº»©^Yc}e‰êÚ*ÕµÖWV©·"jVL#–Ä" ,”É–»)ö)uâ C!mk2Iî-°ÝQ‰DÚYò÷ ×°mÝÚ¾Ÿ|d±têó'_¥1ù*bé« Kôt ÞrlÛ¬h]eèîÔ^¶Ü¡½kû~$â $Od¡ýïì/¼dÛ®e·Î‚ƒÏþv?ÎÑëœh5øß–gy½Ñh™•R”²a`KSV8“XìÐ#(=AÐܼ-rBÚ^åö¡âɃ›˜Ú°¿Zntd|;`^Ynð§¯ÌñÌb“Á+ßÎe׿‹Ž¡ ø™lj%‚‚ÆÚ2ç_~Œ™CO266ÊK®`dËvŠ„¹¾¯mÃX8”"›Í1ºuS>ÂPg›Ç»ðƒPg—ƒ€L&dã¶mÎÒ+{oa ‘Þ )%*V)h­ÙRÊÄÂ÷ôzÚVDÓÀ¶:z ܱeû!,Ìz:‡a‰ ß7Ùh™ˆ¸JÔÃÒDm^ÀèIÛ ˜Å æÞJÚ¤š‡¦EQÏ`/–»(”»Ìí1eÑlÔ©WÖ‰ZMêÕ*«ËKÌMM°xêYægfiy!å±íôlÙKÇÐ8®m×ÓÔ·ÓÎE?RG+ëÚŒ‘yc™\ü ¤wû~z·í£Y[§¾4Ëü¡'™~î<ñìy.Û/¸îJE©˜ˆX'e©Ô6iB‡ÙjðRì®ÔR·5ÅÆ6‰Ôu Uoni§ù_? ï“ô›n²‚ðHŒ•[“ááa~㊿¦œ°Íoe*a¡¹ËIMW%ëæÆ#Úg-Or»ùH$ñ±}i,½>›G³Æ¾ðøsGý9ŸÏ_G ogϧÇÁ:§Ì’1­ê:ÕEŽòÝd „…ÇÖk$Ð{† ìû‰ ×Á ¨^eòù‡8÷ØwøÐÇø£ßVŽºé™Ús$SêÂk$Ê=5 <+«pù›`ÿžv‘ІZ—–á¿ü‘ÏÑ'V;"ö/•øÓžANDM¾T]âféz³Mÿèïïç·®‰ùø5å¶Bylú›±CðLÌ'̲kÅM«yröµ‚¶EÏO=´j“eI}ù±uþâ'+œlö2põ/0ú¦ëÉw÷£'q˜'W’Êü“Ïÿ” ¾Ì¶Ý{Ø´c7å®nò¥rR»MÇKŠ áÛzñ3‚¨Œ÷ˆ€xiF˜U"›ME¸æ sJ'Džç'ÊûF10:ël½°eZ¹çLAE­ š¢é ‰†§­ŒÁJÊj¸¤–0Í–’(V ­X³ê €‡å|§¿“6íöï•û]ÙÛË¢cà,MÕz}iI!B ”ÒI7·DIe Q¯Q[[emyÊÚ*‹s³œ?{Š•ÅEÖ+5 ã”Æ(l¦Ô?FX0øXêk&bwÁ^¥ ­}w#h2ŽX=w‚Wÿöãþi*¡eOjÓˆ8~ò4üúÿî±g©ƒ¥ºäµþ5>ûç°ow¢Ð±„l¨¯Çðw_…û>]ä»x Vá¦|A–¿[]䙡5&VGf.ˆ™!…õ……I#…°T"©AÇR+¹h—I·¹¶A²»ì™ºB%3ìq´&¬ÃüzÌ_>¸Æ·dØ|ó¯qÙå7ÊÚ!Q‹fmåS‡X|í)†z¹éÍoftÛ.ü0L„M€£ZO`¬²Kfa¯2BM’J9²…’RCCaà«Í¬*\½­•Ê8Â'HX¸m;©<[*ŠÂ ¡;¡¬¿ô}ßYxó¦xƒÖë‚5 æ>Bs®•ò“‘CJûf×ôÇÄ­–k]“õL¹'Q°Dq¥Œt]^)Ó9…6JJ’:éh<©U:R±®Ž½–†/ÇI¾‡/uiÍÏ3 ,"!5{B/–ÈKt 9­mª Y¯³8}Žé3'9wìaÎ<6Ãz¥F¶g„âÀ(å±íùÝ êiffÍlîÄàØ °Y|ÏèܰƒØ+°ºV¥«3ñºVÜ,Ì¶Éøtó„TðÇÿ]ðÎÙ~ÞW,…ðû³‚ÿtý{”ÝZ}~³ù^ÀæQ턽€_îèf9Žønu…‡›.ΰXO:ê~¦kÊzY©,ÇYÿ «Szg4 ßHÖ\à 30`gfÛyÜÖ0(`f-æ»/Tùú‘<­ ·pù¯ßAix³‰}ÕÅVνN¼2C[·låæ»~rO.Qb“6Ž|›ð)ˆiÓZOÏœ!SY]—DrÊ–\#ñŽÆóñ<ß)¦­ñZO,•îVr ý^JiìÏÜó™ðÑ8Œ 0LI,b=8î^ ìvo­•Ôà8K­´Ï®YWöG édúÌI¦N¿Žï„™ –¡!¹B0›ÃtWW6W W(dõ4aâjl»£JÁ\H<¢‰ËmCˆþç mÚ˜=I½›6]úz‡F.¨ è~bážÙ¶æYä¨bÛGk!¥V(Ï(«°›—êQvq§éÂî "•ðÑl*‹0„}i³±ö {avQ LÒG/¢çyÈ82ÐÞs‚äÊ,.†N&gXM¬d;ÞeRÖ‘Rš¼FŠþ©ƒ©f þ¦KfÝw7áæKÈä‹xMKmTˆ¥UZ• ¢FU˜¸I\[' DÜ„¸A._ £«—Žîºúé&_ìÐke g›æÏ CƦ8ôâ8$â¥ÇïÊd?¥JLÖøù~@GwÝ¨í»Œ +âV‹Êê ë«Ë¬¯®r~â4³O>ÃÜÌ,A©‹ŽÁ tŽm£40¦=¹ä‡vpøØI®¸Ù€0”NÃùž›,,j}Z]ÓÝ‚g&ALì0U—xº^£õ |û–|3Š0ðY]k"\qåEØ¿‰wÿRgðoECÜ“÷ùØ•%ª EœÊm´§lŒœÇ#HºÀ …OU ¬¢+L†ÛÀ:ß"-s$¦U~Ë­BOî|ñ\“?} ÊÉì~ö~à.†G6T4««Ì~гOü 㣼í]ïfÖ‹4”fÐm*¤•T+…pV÷ sÈó}íøLÌ,eÌ«=H-?ÀжýæªÍȥݕ- ¬a‰› šÕu–«kLLOP=ô$•Ù³4—¦é¢ox”ñ‹vÓÕÛO¹§—0›%ÌhOUtiÇ%È&ôô>kàí2£AÀý˃CÃTªsÌ h)Ép°2 +5IÆMMÜ®ûõ+"~õúrÛx4[V˜:²²',ÚÿSå¬7ÒÿnËo"Ìu¦Wb¾øT{6ÑwíØy¥Ëç^§9{¿ºÀðÈ0]r5==&é¤ ¬&fK•,vN1¯0 Ÿ*,lLy(iòO… m+Cr› fR—°5\ûñRWÚT:´—N­RöZ†LZSå-{O•*«Ø½J'³„yçÉ,³.ô¤žãÂOu}•/}úOØõ¡ß3\P™›$nÖÁóéÙl¿|Q7ü*k #2ÅN¼ “¼': h®/SY˜¦º0CܨR™Ÿ¤ÜQ¢;ïsÓ{?BÑP›p)èÂ6|ë¼¶Y+…•\ÜlŒ iÒ?³¸Ø*»Ûsã”Ô}Þóç'xù‘ŸðÄýw³4uÚ­•ïû îçƒï¿Œþ … Åb–ÿñÙÉÜÿ:GDÌxòû¹n"_¨.QP×e‹ÈæP ¦ã‹2æx«É›óEb_[_átÔdÐx{¡ƒíA†cq“¿ |ò?”À'¾±Ä3gë(¥Úa¶'4úB¯kO®ð5@Ó?˜sÂuähm."!‰h]jçàÞw¨Ê7gw°ïýÿ™BÏ +“'X:ü$›6޲ñ’½ôŽ/•áuq§DXN¯#ã:IB$MßL(•ºG>!P8o'H’V*µ£ößΨä¿Íð&/Í'6Ji²†Ý6f¾éô£*ç¶ £/ü¶6A—˜±ÆÌ&°ïk²çjõ5šµ*Ëó³Ô××JR¯Vu¹'jÒ¬VÝÚFÍ&q9Ã8;qšŽm—˜:®~‡gþñψ²eÔê 7ÿîçÜÂôû §ûgž¼%%[¯'¯~¶ ¥û¢ýLŽõÙIšëËtoÚÅø·"£ˆ3|×_~–‹Þt…kõ´ò"lÂ46ÒSíy‰ Œ·­*ØP ÛYfC)õH&‘ÈÍ5h‘tªù™ [xËû70°q _þÓß#j6ÈçótwwóÊáótÝ÷*·Ý²‡ç^8CwGžæô¿Qꡉ" ¬È˜n,Óu@QiFüÙ³5þ¡„¼ç1è‡ä=ù8æ“‹³l 3¼¿ÔEÙóðÌÅŸZžc2Ûäƒ7åé-z,T$Aà»gnëšR$²k•YAK&w¤“ms¾œüÛRˆÀšeQ·^é•©&_x|•þ7_†f8zïWV&xÇÇ~ž¡QT›F¥û[­ÎJi<޵óFaAgi£~¶³§xi|0Ç›~Â-VRºŒ±MxÙ8Ø%h¬ÒxºÉUÏ”öÁ÷Lv;Æëx^  F • ’ãf)…Oy×t¼Ç’¨¥•¬^Ygyn†zuFµŠ¬-/Q]]¡¶¾JµVÏ£Q«²¶º‚ÄÃÏÉÊ„ÅNr]½dK]xA€ê“ÃΔRø™,žèXØÄë½›® Ð7’ð›…G¥ZE^qÑT’À r†è1C€çQ[[auÛ-µX>wœMâvœ+4ÊU]œá¹ïýªØË–™sôm»/¿úv=öM6íº˜L6ï ´L8ÂˆØ FÓÐb…ƒæžÀц]þA‡,Â8ë©“5O1êÌuC7™À.h€ ³ÙÆÓY¥V 7DÞ¤,ÿI)Ì!å"A¯mGGSCÁÖ©¿ú\ƒ¿{9ÏñyÅö…)–žú>×\~)]òk&)©A ¡¾J ³†"Ñl#?v~•ofHYO‘(«E‹IéØ8Âó:³ŒkXhc^¡±3«¢V‹VcV³A«Q'ŠZZñ¢ˆ¸¥{Kõ\q hÔëD­–3ˆ­(¢º¶F«ÕÒ£Í1¤­V‹86ìza(Ÿ~ˆ„†QBˆ.|‘#C ûtfsôZ&äï IDATdsÎzñ`^.¤b綘ÄÙ˜4ÿ:ù}j Q(²ù"õÆx!*Ž@e@aŒ€p{:!Îâ:ñ*óm!ˆ»žRøÛ®Flº yþa·Öa®H-Ûýßü*=ƒ#:[îûdry‚0À7cw‰#²Ù,¨ØM} €\¡dòåî>‚P¯ ß’·Ky&asž aLÂÒpˆõàô3!£Ûv²úô£ôõõ122™3g8ôôÓÜUîåc]F['£&÷¬¯1Ÿ‹øèME~ùª¢“á/~¸ûŽTyèü2‘„+Æ2üáÎaº ‹5É×_¨ð7säض'äW®,“ Ž-/*³‚–ÉÜ¢ppÚÆi( µÝáYˆ$®tŽPoŠ}¢ãK})3k1Ÿ~*‡?°ñ\}ÍUlÙû&ŠFQ \’25–U]T©BÙÿÁ+‰guÓÙítÌiIÒyoW÷"šÍ&ÍF“Êú*ksÓ,NO²º8¯Oà2(áÑŠb2ˆ §ùÒA?[Ð=Úž9ÂESS<Ï+!‚?ÌàüL†ÂXÆpšC» ÏOuX¥X]v`‚ÝFwÆT"œIìhc@c„-ÙĆ)Ò„a…««$a›ÑÅÎ.êO…¼h$Ê)Àž^mŸQ5*È×A)I¼iƒ^u‘< dÔB6køKîþ …ð}Æ®z•*f˜¡Œ%B âõ†ã<¨X1*né„¢Òp;Ì4hÕ*ÔgðekŠ#­aè“ÍÉ„¥ÎnúFÆéèî¥Q«²º´€Šc:ûhÖ«ônDÆ‘áᇩ¼‚Â÷}úG7ðšùÉòò2½½½H)Ùd¸¥PälÔ"+<:=/¬-‘ÙñÞ}Eöf’µÐWôøÐ%¥ÕZ¯tå<Dórsœ²QãïÌv©¶X›gÎÂe«íG#“lúÂ`‡ï%'Ö „;ÒÝ,<¶A\ÜBÆ÷øÀïü ý#ã`²Âı>T%ÐSYG!͈Oµç1ƒå„g ®±PJ8«K|¥’MqÔd}e™ùsgY˜™böÜYΟ;Ëôì"µ™ÓßgÃe7Óµá"Ê#[(Œ_IË'çøÏzA„ Ì1"•¬¥­¹m˜7ïba£KH¸í²‹Íö«´BZ·¹¯>È)[NµqU}\xÚ„2û%,WÐÂTTÒ¼.l¶W:xm ÇÕ¿úÇNÐl8¡ ¿%Æèðdì’è'ªW(m5ŠN[FÙÏdÉO=SÏãï¾ÜÁy€ ÌŒaó.Þv‰Ar²’xRœR”¶½p+2 Ö—¦™[šçé{îcæÐÓ¼ãÃ4–gŠùÔV—ÙÝM~ôv¼‚áMÛ2‚0tr×?ºÑ…_q344Äàà /¼|ˆ/®-ócÖX­KâH°yÐç‡o¤zøž^‹4uÀH’¡EhthÓ ž'ÈÚ¿Içý<-çúÐøDÅÚJS™ÀÀh)Ìé"™êa²½‘ÁŠVᜣO pºkÖßM#úàîbß¾™lÖý23mL « Jšz¢‡ƒÒ‚Ð1„„‰Y£F¥ÍFÚú*z]ÿ»V§Ro±¶^avf–ù¥æ—+ÔDYì|ä/Aì½ÿì³ÕïÑ=4ÎÆ«ÞFyd¶·¸­4â< Þ·t\¦Àžð åP "{^“H2§ÊÐ:1žÜ¶úÉ$Æv™Uë‰-‘Åfc šp‰7Eªó…6ƒ“$ƒ»5Léé–dcC'#“Ñ¥Í:§YgX¢‹ŒJ†Ji… ]fÃxèòð&nûã¯:4àPÉ3[v™M„ c˜"áGš°K(?õ<‰ü¹S0ý@Ÿt n¤ch;/a׿ŒlÔ`þ<ùÎ>ÖfÎeú8<Ó 9¸›g¢ñì+ø~@àA>PÌç™>uψe“jµÊÄÄkkk¼ÒªÑ1óÀû†hIÅbU²¥7 cxÌQ¬œ|XŬ·$¹ÐÓg· ½öˆétT¤ÑrÊ3JJo&À”gÚ±’CÆ¥Ò.^xfίƒÃÖ¦Xk,b,ÍUîWú©ŽN·ð³yd¤‹õ½Τ§o(c ¡kžž™+”D¦WvqfŠÅó“,/ÌR©T^‘+Òl¶8õäiJÁZçfâу¨\"· FK°QŸ´å¥„SN¾ÂÆRLþú;Q‹•É”G7#‚¤¬$ åÓÅY†´ lÇ‘H œkULŸL¨LÌf7áJ'º×ÁDY.'`¿fá0†ÎŠ¼ç¬‡nﱂLbˆÒ0I9±Hß+i!t„ÝãÊÉ}›Õ5¦^zŒl±Lßö„ù6—¡Œðk³ÌyžþèØ`¬Æ%Ï'ž)lÞÙ„.ÙTé‡V:Km ¢­MëüM2"X(ð³y:G·"„ ÛÑ¥sEÆA&×fèš•U2Q–lÇCTgèëëãæ›ofvv–…cOò{·uÒ]Ôs°ÃO‚USÝIÇ8ß{¥Ê݇ª\2–á—./Ñ‘MñDž<ÝàMc µ‹G²7VfÅZCúß7ýšR{ÞVlÔ[˜e÷Áü[©DÉAÓB푬Ú) NÏ·øÒSkŒÞÞO«Za~ò,£[.r¢caSµJ­Fƒù© Î{•Ù³§8wê2ÌÓ1º•® Q¿œ|®€Ÿ-~´äèSâe³Œ÷–8{ôâË>ùN'õ¯‹ü÷ßÈñÔáw|¾Êgîì¦+ïñÊTß|ãÅ*¯ÎÖÙXÎð‡·urp<ëäAGF*m£Û`¾§ˆ7mê_h»˜YÚ±TNÁMÓ\̎ݵe*‘6B &WbZ^-×ÜΉ‡ÀÔÉã\|õ  Q­RY[¦V©PY_gav†…™iV–—‰DHPî£k|W]ÎÅ7’D‘!ðÛ,¤¶Ú>{Þù+½÷+l¹öv¶ß˜åÈS3] U‡L^ÇwB¡jÊKÇØÿÞOà ½CÔWÉvöè† a,+; >~×¥¤>‚TØ,´·žØŽÕ ›òâ^€£WôÌq¡^(¥NÅžÎjº@ܨµ…çF9=Ï6l$Þl¶6E(1±§{]‚M¥<¸…¹.ÿ¹Ž.2s§ˆ‚_¸¶À·~ñg?^âwp`4K9'¨4¾^g©ý¬2û¾çxžaQIeËPÆ¢ Aè·[»Øú´øD‘•2ÝGF–veèÍE¬Íœ#ÛÑÍëÏÝG×½ßemm2S@ybé$¿g…‚L;¼Í}TR÷M’4v˜$ß=ˆf©ÌO1°ãv_{3ýg_çÄÑÇYîØŠèÛ„P‚pæÛwïÃîÂcøÀµÌ}žÊÜ$C&㹬¦}iëñŒgV&K.Œâš•±Õ+Œ®¹"5\I(¥»ƒ”Vlwì«m¿1ž0¹fZ¸Esum£œ¶…ÐAZ¬7÷Ú®bª2 æbsk!R]Y kJ±åú;é>s”fe•žÍ»±­’67 „ Sìäà­ïfõüiÊ#› rãD2ÂÙfÒ±\ˆ:´TÎ8o¡Òëcˆ¥6¤I…n€‹«ãV“å‰cÌ~–Å“‡¨,L·š„¹^!Ì馋 WÄÏd ó%Â\/L©+„V €ééiî¿ÿ~Z­åHш¹@0µó•g+œ«´ìèÏPÌ^žnïøÃO„Øê;»óÚ€›/Õ}Ý…n >pSȶјŸ[çé«”B|Q!J1Aö JS±i ¬öL èözÛf=}vsÒŸªY/ªféƒ=E_<ã{O?ÀèÁëyùäqVÖ+\ù«Ÿ¢Tè0Öoo2°ÙXÀŽ'Ô%)ß §'•i*‚ ›§Ð?ÌÄ3?a`ç¥d ŒìØOÏÐÏüè,y>¢ØMOm‚á]7é–C¥=ßȾk˜xò>V&ŽSÙ䌄l5Q°½Pšœ`áuÔža2 `šøÖó=>2naNw7Iø×2nokß;'K; ȆF!\’ʨª1 ¶åÐiˆyí­bKSm™fÓmAÍ ã!Ã|‘þÑ·ñHNúÔFL'0=:ǶQÝBûÇıB$SKÌp×Â)ŸxKÈéó1<[%Û%øÅ«û·†ä3ÉÅÍsfß„> BOää3Šk.ö¹r·O3JëòªÇC/é£wÚ”ÙB§(¶gG™šžÔ^W¡‡ x†}¢”Í=÷oÏî…l1©4 ô#Wu𕯽Bé¶²ëåÔ£?duú,;/q±–-Ex.>5žJÍȉ+kµ2?EuyRïÅQüL–ŽþqV'O²|î8]cÛžO®³ƒ·ÜÉÑ'~ÂÔ+gØtÓ[ñ39ãÈtœ™-v’éèbñÌúw¤±¶Äô‰Ã,ž9ÆŽëßN÷ÆZi}ß•TìgV…1J*íuL !Ì&ݤ;2J„ÑxAá…šj7ÛxO;2à 7ÜÆèFíĶCäQÊ]C‘ô'É=el§ö¾mÊ)r:«®¯§ :2èDØ\U6•¢KZ!²w´èOF&ËŸÜWFÆ[ ÌÌ4å”Ö^Û¢8jQ_]ÒüïÙ³ÌyŽó‡ž¦YY5çUkƒ•íè¢sl£ô0ÈBÏ –þ»éêÛµ92㧖ϽÎüñ—8ùð÷i¬-µ™¤†¦ðË·ÜuGH!'è( Y½¤C=>Wìñ5üwj ˜ ŸÒŠTJÓÒ±¹>Aà)Ó㜙¼Zù7bæl /¨-¬éN KfwÙx‡ô<Õ>·H™½2¢ @ÉgÐ_¥¶8ÍÖ„`êÅGèݲ?“KžJ)lŒãùÆS¥úbµÐênui–g¾þY*Ý[Ù2ÐÁî[߇çû”Ç(oæäCßcï»ï"ÛÑž Ø7Lgw7çç8}ì5¤R ì<ˆ;MÀÆ+nãÔ£wsþ•ÇÉttsìØ d÷&rOÜKÏÆ]IõB^°…¼¦¤â¥Gçº$:Qg¤8©±¦Ïe2±­#t$Jk§~ËYâ†e<’…ÈæÞ RNñ-j&ë¬ ÔÕÞÞÔ›•öLRÌRxAè=q×sª•»åžÝBe»µÎÀÙ5K¹=«ìúw–O Íó)Á›{êß5+k¬œ;ÎÊ™£ĬϞeùÜIVf'‘qL£VÕž+еá"ú¶^LßöýômߟÉ'ׂ8jQ™ŸbéÌV§NQ™?ÏúÌYÖ¦Ïê³¾.øÄqLǬ¯¯SlµmH SÒŸ%”;GÊÞS4kÛ?ýÓÒ«„»£‡0*k·ˆbˆbÏ­YiDŸÄ¨U)ä zR§¹˜yD\¯”õ)x•Vºt3(öv®pÏ×ÿŠ‹nýC{¯âÜs²6=A÷Æ‹°;¯¤L¬3‚è,»iŽ(ô !kë°ÿRfN=ÈÖµ%ò]}toÜÅÊä ÏáÜs±ùºw€‚å‰ãœžšÇ»âCÌ4Ö™;ôÝOü˜‹ßñ¿èÙ èÙ²—ó¯<Ι'îåÀû“¾¦×–Yœ:†ÍPÛ:¬ÖßÈp³ª8ÖÐß’gwFNé°Á °Qt;ÎÇŒ(rå/(Ïy]×&é%#€¬7oƒÐ& [ÿ¶úmÖXknRƒNSÚq†# i*¶—X#§8e`“ùÝvúˆ{Ë###tww3??OhR'.š1ÝH6Íg[‰µc¤mÄ®”¡°„Ñ+§ÜfC4PÕù«Àƒ#]ã8¦Òðô)$,•Ø[Díá„&áþç`zRmÖÆàö½9¾ýý%žú—o‘ñÚGïû —ÿòq1èÏ(nê~NÁSqè¾;?Êô‘gèܹ› WÔ÷ |Æ/¿…ÉfúГ í½’LG''^z–êÀ^ð(t#wÞÌ|å~zß=Œõu²õ²ëÉwõÒ»åb*sç9óÄ¿pð޳6{–BÏ»)=;ŠG”² ŸZ>/6¶Õq±L?·X—¡BOÛð’d›;sÉ4îÛáaKl¦%^QÿQ.³­Œ7·‚ä¼)颋µø©Ä\*³¬ÌÜ5ëý/< pÕ®ˆ.‘l ޹©Y —IPH’5×¹,ýîÍõUêK3¬}æÂ9ú{»¹âàÅ4ª[xåñ¹÷éG‘2&Ì—(ô3°ó¶Ýü>Jƒã.$‰šuZµuê+‹¬ÏœcîØ œù1*óçá“qá' CŠÅ"}}}lݺ• 6Ïçw.欬뵴à‘§‰Â»haæJ$¸Ö¡t„ÂÌš7g£#ìyω~¥²Ù>µHÒŠ•Îf'cïhhfÚÊXKoQ$ÊœÐ`ážóDÊÅ RÁ¦Þ€Í]’cWý­f 5w‚©ç¿Ë™§îÓ±ŠRî„E×{j6Õ5]ØA„ï3°óR=vWêcLëËsÄQ‹ ›cë ïæ•ï|–…¯Ð¨U™Š;}›“k( ….ä÷pvá ON™³Ù,W×Åhô0å†òEÊ0»DRWF˜$öˆU‘ÚC3óK&–i¸3à⮎ÎÇÛv5¢wYŽüèéÙLÏæÝFnlŒ¥3±ÍêµåY+‹Tg¨.ÍÒZ_EÅ-²¹²Õ ð“XÞ7\Úb¹‹-íäÔCßf¹¡àÖÿÓÀX[CMýwÿªÝãTÏ2ýÌÓ×QRòú¿~‹\gåá »êòèƒÉm/lš©Ñ&ª´QÕŠëêË’¶¤•ãI›pF{ïTÜ,“–‹-íóHe„Ä6¥Xá‰;°×IÅøIÌkÚ2-o7YaôéSá1 ¬Òq±0àM¤ Ö _°k0Äí!Ô¶«µÞvõõyÿüÓ¿ea¾D¾ÜM&ôQ­^c•áQzÊ]”ûú)lÞCÏàÍøAˆçûäKº â' Ç,3}ÎÏ>ðC^{ö)˜¼ß÷(ä²dïy4š-âXQiIªME3’¨Ž,Q³@o_/.ÚFýå{Yyº~–l¹ ß%w´§•Q Gä;:‰š ÝãZ­êQÅa†V£¦©&¹ˆÒ?UÜ"ÌY[š'Wê0Ý[-”ðÈ–ÊÄB)¢V“ ›uÊ„¡Gëû>ždsDÍ:™|%uSI¬Íz„Ú‹Û^ë¸E«^£ÅºûÈJø¾O«Ù jEn0}³ºFܨ¡¢±”ô]| ý;.Kn÷t—˜Š"¤Š‘­&ÓÏ=ÀÍ·ÝÊðÆÍd²yü0pºufЋt`2¹…ØvT©ò­-/òÃÏÿ?T×Vµ¨y>ÛozŸ®†x>õ•¦^|˜éWŸdñä«DõZrŸÿIåM÷—ËT¼<>>Îûßÿ~§È~©6Î$&!\’’”Ó‹ÍÙÃö6g&ö¨$‚©…™ifÃW=éGj¤;«ªM™ZRS?±Àv/ÅÔQz~—moô„åm›Ep$žåÅÚƒ+6ç(ý¶Âdƒ]‡’°Vü ÀC®¹ã\õŽ÷%ÐWJ3^ÇÄŽæ{J*3—KÓµÁðL ä!#‰}CX7oÊ%¥Ì‹¦kå®*,R&»` 1æþJI×ohÖjÛZµ6"¶á _°^׆)Ò¶…¦0ÂÕ`¥ŒiÔ«Dͦ;ZÆB‚¨ÕÔÇö(I6_À–çgyê¾»Y~q‰0›Gy±Œ ‚ß÷­&Qmo:À¦{“®,wû”²a8ÚZÙÒ¬4 ☟š`êÔ1fΞâÌá—8{ô•Õe'¯JƼü­¿&SìDI=wìg2Îo ÈB:::èë룫«‹\.G6›%“ɘaƒFƒ©©)Ž?Ni4åyž9Ã^: 7õ†ñÄF.5 ¶g‰Û8Úá4ÀÎð²{Š‹¯í ³§¦ýE#g+÷æ]ì§­4Kå&fÚ=p‰sq= X™3©’rTÐ\ÍCظHÿ½ƒã vgØÓóäégñvܨ…Íñ÷¾Qì¡õ“¿fynš¿ùEž¾ÿû”{úÚ¸…Ñ­;Ùså tt÷ DŠ(!ˆ„æÈ‚6 ß6§ÙY;ý¿6ëù¾b‘us ­<È8Æ3Ê­³¸8o¢Ïv@©6¥„/xŽ|•4H¤ãSŒ· Ú2ÆöyÝÔ ¿ =U4ŽMŒmº›ìû˜ ˜œ…pÆ#ÌdQJá¡©Ýêð ™z™@qûï±MÜú>Îs?¹›ºá4 âFRgŸƒ—_®‘¬“g‚šr$”66J¢9ß(ÅìÄ)¾÷ÙO³03Iee‰zµòs³ÊJÊŸ©ýþ{Ÿ½{÷òÖ·¾•R©¤ÃKó¬–×-MkãñãÇ9wîkkkn¬·¶kõCJI1o·Ý†œ† -’²®oÈ  “ü²ØU'ž•‹‡mX‡´¶ƒ»Üd³s§Ï]v!šñªR/´'„9?VÛv.´ÂÚ“Ý<¡kcÊÿARpóg"¼}oÇ^xDÇÍ!‡¼íד½˜è™oP?õ4µ™iæ'Ïrò•çÁ÷?÷6îÞÇÎK®f×e×PèìÒ“ìsöF&>38_J‰©ö¾DåmóÓ½Æbù~`2Ô‰×UJÒj4“˜RáÖ!ŠZšÓîÈúЍS<â Ë,ÉϼOý½t¥$q+Ö¼m)’ßOZ*á’RºöK;ÑÅÒ2&2ã• ‚0“@=—PÂÄ­$}Ȇü Ûˆ§Bvl®&à‹i•ÅÄ2–$’@h ÚÚ±ï· ‚›""ìU0iPß=‹Ù¤P"'ð[9C#Íœ*aæ§Ú@Ì^C(ÃóüD¹LÌ«UUÛ@; Ífe’wPvßòþòÀw¾ÆòÙ.ú¶î£%*Ì?wùÿJ˜¦Oìq IDATÉäg’°Â®ƒ±¢›þJ²27ËıÜxåy^{æÑ[=Bï0¥1JýctŽn¡4´ŽÁq¼ dæÐS¼v÷YŸhûÞîÝ»õyF!“=H”:Ù»T–ùYEƧ ­”’jµÊ–B†·Ž(ç<~úbC'üÉ]ÂV*ðÚiÉì²âš½>=eå"Ahý™œ“üç¿lÐO dJ1—€÷ß:§(• nAËÄß?SgÖ0[Ç—ä "¥Œ§6BåÆé"¸-`CROÖIØ$¬¹‰Çê øß]ä3þ„oß÷*\õ1Äàv½ËæE×0~ç¢ÐE¹µHsujµê²Y¯1wî4sçNë— C²…ݽtö Ð;4ÊŽƒW²uÿeäK‰ò™’-ÙrŒÛ8)‰ tµ°SCWc½ã–º6œ>êÔ;c½ŽñîµÑe…“XÒ…´J£;x_3¾EÓJŸŒ ’±tÝ[BxøÎ)(EÂùvž0F Ï”›•bè˜`öº2™½mßÛ&©|{””{û¹ñïá»÷?¨-Í⩘·è£ä‹%ój©r—[@“Ÿ@{¶Ze•“¯¾À‘§çÌ‘—Y𦶾ÚfìÒŸ|Ï £n ±¾ÌÈþkØy‰n€CwO”`ìқȖ{yü¯ÇÅÐarå•W2;;Ûæ­" !Ú4­ÔÅb‘ÙÙY~ðƒP(( T*w8ŽYZZâ²YÞ±§€R°©'àïoñ©/5Ù<,xø…˜\ÒlÂéé&ÿñ]”—@$¡Z‡º¯Å°—ãníB)ÅÔjÌïÿxžøŒô <ÌèkaÁðÀlÐÙë\ )cҤؔ40.ðLé*•}†TЊš¡ìaq¬…ÐN'ÙÜðï)±ûÑó|úÞOR;ø!¼7B¶€«1{>¢ÐÅ¿ø>pû[øêW¿Ê<Àüü<­(¢Xî"Ìd‘ *Ë TV–¨¬,1}úu¿û›d²9úÇ6±ýÀelÝw Û·Sêì&Èfq]W& ¦?ñÂL ¦âY<„/ŒÍQ®IÀ “'‚$½á%'BÊ(rs]®J`¾4l0×dãx?Ð5h‘$ºô}7÷L óabrÙj%äÓ2š;A¶ÞÁMi P.DqöÍ÷»Gùàú]¾öBÿØ&Æ·¿Ç?5~X=*É@œ9{’§îý>¯<þ µõÕ7TÜ ?^²ëö±ùÚw0üEë+„…€dz§‘;”¢¶4G5Ar¹œ[¿´‡¶^ÚwãƒõÇþ{çά¯¯sðàAÂ0t;ý½™™<–\ni¬+à¯ÞÕËOŽ×yþùÜ^æšÍYŽÍ·ø¿Y䎫%[Ft×””šgýŸo±pÎçoÞ×MÖ„§[zzó>ÍÈÆËÆ [§Šq;Ìö}ßS´l6N$M­Ö¦.ã~šzowØUè'ñÆDÒÆh¡²IèüÕëÊìkð×G>L´ûv¼Á­duðf™ž_"ŸÏóñœ÷¼ç=<òÈ#<ñÄäÇ.âÍïý§½È=_ø+f&NýŒ 4u&OaòÄ~ú/Sìì¢wxœ‘ÍÛݶ‹Á ›è§ÜÓO„جrÔl:ϧ¤4xž; Bøv‰íGÖ=kŽÜb!ª°YZ]î±p{š¥IÙÌe2¸ßÖµ€ÊX+±= {MÐ<éTヅVÂ&Af=z;[KÊ85{Ú0Çl8`þÆ¥Hvg…½Pî⽿ñ»`Â2+k›M®W×Y8?Éôé×9uèEN~‰ÙsgôDÒçäŠz( ŒÓ»u/#û®™b™úÊ"ðÌ,¸ô¸ÕÚÒ ‡ðy+¥€¢P(Íf©×ë :jã`kÄœ¼#¦”¢\.³¼¬³è™LÆ@›Ù–RÒh4È„‰Bx”²ïÜSàν—´,ù=ŸSç]%ÅJEñÌk’‡Ÿ–¼©³Ä/¼·àtŽ*+'&%ý>Ó ŠçŽÆ„Œô¥ `v½%“ØÊ9wÈ›Ÿ:WÙÖÓb• +€„bÛõ<§Ä$1œƒ BpÕæ›z¾þÜ«|î±×Y¿ß;ÅnÈ•Yžo8OÑÝÝÍwÞÉž={øâ׿ÍÒÌ.ÚCgßà*sú£”b}y‰õå%μö2A&K©ÜE¹o€Ñ-ÛÙ¸k›vï§wdœ Ûô†h%­×±1j*Ó©/6 &Ôp±·G2_¦f?'ì(7úÕ÷¦žh¯/£ÈÄÝú>Jè&¥b×d;À\.](gp\d®¬Ðµ{PÏX•zû¿Â†@$9”ºz §\¯GÜj2yâ˜Îm¼ô ˳çYY˜£Q«ánüs>ÂóéÝv1#û¯£sl¹Î ]ýù‚^±VƒL¡{ÎùÃÏP]œaü²›ÉË 'ü6ÕŬ" !(•J„aÈÊÊŠSÞt½83§ËMRJVWW]Rìä  ÙlÒ_òiÉQ’Lèif·PÎyܸ9Ï—PåË~L1ðØZÊòK»rì ñMD!Ü~Q‘oÞSá«÷6•ÇÁ<󕘿¬qn>ëPB[6;–vTž("c]s}ÝþØ’:«áû ³%š%Ö”¸«ÜÂ$Å,ïT/”M¯' ýÒÿù–NnÞÑâ~x7ÏÞý,òê#¶qfv…V«Õ…†††ð›U¾ø©ßatëET×Wð¶¢êë¨Ê¢~‡®5,ÏϰËù—sëkÎÞ³ÕjæY’œÓ2(Ç:Žc¦¦¦xüñÇué-ŽY\\äСCtttP¯×™ŸŸw 1¥ËËËxBÏËŽ¤;-“Æá)ó¿xS‘,aì±ãi$å+[Šx뎷í(¤Fsé÷::[â?~¯ÆòªÎ ´ÁìRVêY_†›mc8© 7†WEÔ%-ÔÉ }#;›[ïì›ÒÙ–;aîmþÖä†.Ëð¿ÔÏן[áÛ/üG‹—1»ºÈóÏ?Ïå—_î6¡P(°uë6\Çe·½‹—}€o}ù+´.ÿ(3ÇQÓGPK“¨êÒ¿«ØÖ’+)™›<ÃCßúç+tõ1¾cvìepÃ\%—/šçŽ5ÙÍ«ö}^ºD¥“P–³l=¾f¢¨å©R‰(£¨JŸ¼aÏIöô‘Jšr’†Å±lé8ܬ³çù 47É:—‹Çe¬›–féÕ¥E7´A¢" ¹póÚ¤ŒYžŸafâ4G_åÅŸÞÏô™?wu=Ïctt”½{÷²eˆ††˜žžæüùóìØ±ƒÇ{ŒcÇŽqòþ/!l¾þN=iÆPG+s“¬‹rµBvq†V½Â¶Ë®¥²¼@˜+·šL<ó•…óm÷µ%¦ ¨×ëœ>}Ú=”’f³I¥Raaa(Šˆ¢ˆ0 ÑjµZ”Ëeöï߯ëÉÅ"ÝÝÝd2VWW‘Rò™Ï|†×¦[¼e{_Àñùˆç&ô—|Žeè4å%3ѽ­µQbЭýÿ&ï!eB̲‰c‹È¤‚Œxƒ®)Ï÷©G±³¾0ÍÊí·.K‰d¼n⇠41£%‰Ï @ åx¥¶l;Gl‚WO'Ñ/ÝSôùµë;¹uW‹ï½ø"Ÿ{dúÿ9{ï(9®ëÎÿóªªsO÷LOÎ 20Ès&%ŠeSÙA²%¯~^ÛÒϲ׻^Ëþɲ½–œW²%+Û’,Z¤EQ) H‰ 1À`&çžžŽUõö÷^U%Y{~uf¦»«ª_½›¾÷Þïýâ9tèP€D !ÚÃg¾úMŽÜ}ƒC‡HûÿÀRa ì(VëfÄÎÛ‘¥UäÂ(þÄiü«g Rø1Ûí‡-‰ïûŠ tvŠ3O?F"Ý@CcŽ\{};ö²yÏz¶î$–HbÙ! ºO|-¸¡…ó¥);µµb ‰Væhjë$ O…•–’DPXÜ`õðu:I8¨aËBoC"h…Ê¥7,"jbƒÅñï=È‹Ï=Ã=ï|7›víS¸‰mkZ%õ|ÏeúÊ0çžy‚™Ña–fgX𢏶úŸ¶ nݺ•¦¦&n¾ùfºººBP­Vææ›o&N“Ëå¸ûî»9wî#O~„Å–ÛÞª="AÓÀ¶ìÜ…ïC¦¥™óϳõŽ·#}H2CyyŽ©SOá¿&oii!NÇ™žž¦££ƒÙÙYÇÙ°—ˆÅbp¸&Û!‘H„\.G.—Ãó<\×%ŸÏS.«:rÏóøö‹%&V\’Áä¤OÏjŒó²@ÿV‹?¼»‘l¼®9E UŸ3Ó5b¶à@ODG0‚Wæk<{¥L2j±µÅá@O,È ”±µÑòR‡a„n¶ëR©É€âÉ&£Ý!°ÓÖ¨,²RŠ¯Â”EZÂÄÚºŒÍ4'Õq‚ sWR»Û„•dAϦŽÝ[#¼~W’iéá ¼øÒK:p °Î[·neaì2ŵÒM´÷°d ¬í· GñÎ|R9ì-×cï¹YZÁ¿t ïÌCÈ•É0&DèTŽÃ‘_ü}Ö§™>ó,K#ç7Uú>Åü*Åü*³ãW¸pB¹sN$Êþ[_Ï5wÿ4ƒCÕ÷©C-Ýie R¼a.Í…žã¡Ïÿo~ã/>E4žÓ'uqœe;õÍBNÒõ ÆsCVO¡ÝK¨‘5f–A¬(•uÖ›ueaŽGyŒòŽ7òÍÏš_ùƒ’in ãg)Y[^äþOü/&&§ÈOQ+þd$:rï½÷ÒÞÞN±X¤§§'ðêŽ?Î 7Ü@CCžçqæÌÞÿþ÷3>>Λßt<ý8¹M»ÈmÞé#ßy÷Ï!„ V\ç©¿þM¶ÝùN¬Hßó}æ;¬\½.««× 5T©Tb``€L&"ù¦úΕúgÏ3`¥`jjŠ/|á Äãqâñ8Õj•d2‰ëº¬­­áy°;XuI ›ÿK’ÌXTñù‘i~0RæžI-êüUΞõX“ïº-ɯßÔÀ#JüúWyº™9)ùÓõ%¶öÚüå}9ús¾Æ©,{DêÂxø0@CC‡º}®ÛLj«±ªA0®ár)ϺšmBDè"±|}`/õ{êž¼b#èBßÇÕã«ü÷]­|{x†Ý‘H¨ ‰D8yò—‡/ʼnÄã¼úü“Ø›¯AdÛ±z÷C2‹¼r9?€ÕسÿÍØ[n€L»*&²ZDºUZ¶ìeÛï¤ÿº»é¿înÚv&ÑÔF¬¡ G4óªå@ø¾ÇÔÈEN<òÇy¶íû™½DaqŽZ¹Di=@'r×Â{ò ó|ëßdÊÏâϼʶ×*+¯+ÎŒ¶ó|U^j ç{øž¯æë§ei@…Äzz3ûuÔ½v>)‹dfT»¬ÌÏq‹ uDÙ¼m;ÑDœ•¹Y–ð¢iFF¯26_ ¾é =‡ï`ìÙïà–‹ÿ© çr9î»ï>öîÝËÙ³g9xð`€‹ÅèîîKKK,..244Äôô4…µ5z:yáß'·i7ñL5.Ê“\›'’l ÑØJµ°Â™¯ÿ=ÕõÕ@ÇÁ÷}’É$ òÔSOqäÈ‘ Ål°Îõ1ôèè(ÓÓÓd³YvïÞÍæÍ›inn¦¹¹™l6K*•bmmÅÅEÞiàu±„ͱò:U)i±–]Z›Ç`³Ã_<’ç›ÇJÿ'þ…ß§©›Ú[:ûY› 0?ÅøñG6\ÿ¦›nâÊ•¦L$8ŽC­V#ÿPŠÉìqƒbŸ={–#GްgϧùâgÞÃ;þSœ:u*L«JÒ'sرµ}àõ:ÐÇ…Wgؽ«‹HÄæ¿ûu.?»ÀÁh’Kj¬û>И#",+ø#±¦ÖiÉãc¹zíÉW +ü½("-Á/¹qþK¦‰ÁH„™e/§œd…•ü&¥Cc7Í Ö:ÇìØ¦É"¬>Q}ÎÊ¥vlÓê ²Îœèb™4O†Ù—¿n»Éږб¹¤Í¶‘£ðד‹ìnvø÷Oþ%ÕZ;3t:Íá}CŒœ}‘–î>v:Ê©‡žÁºY-ážD,Ž*N·@4¶ƒÕ2€Õ܇,¯á_9?ö"¢¡Rí,Žœ§sß áÏÕ}§zâ†maYR¹’GÛè=z…Ù JËsŒ>ók3cÄ39£ÚÒ²Hd[¸ñ^*…<Ûßø‹X–Ž¥}ÉÈŠ‹ŒvSÈxâ¹ÓˆÚó¸•Ç"æØÄI¤«òž•r‰Š‘=·¦+ï\pâÔj5œX‚X&‡‰‘êÜOûž×Ó×à ñÞBÔå¨5‚f gr˜:|¤À­”˜>÷Ü*ȶmÓÛÛK:楗^âðáÃAüº¼¼Ìðð0wÞyg¯^¹r%°Ò äóy†††¨èbùÉËœúòÇz˯íÄ«–)­.b;1N|öÿc}~2̃²ÿ~Ξ=(‹¡¡!J¥?d‰ ……BÅÅEZZZxï{ßËìì,>ðU‘<ôG_¢!éb‘H”d2A&“àš£›ÚÓEoŽXÌáêä ííÊå“S+,.1‰’±-5æUBQJ¾SÎóm«Êï|èúû›ùÐo}…WJFjU¬ùø?¼‹ñ‰%NÿùãxR²ìùlkŠðégÖˆEï8“PuCÐqƒeP‹£FT…yb#Èt$‚pZ gh¥©{–cLu”Tœ,ñ}2tÉLXBÕ—Ü—Êp‹ïql®È&ßæ3ŸþÅb‘7¿ùÍ>x€ùÖwh¤¥«—Tyžbq‘nÁÞ~ rymf/!RMX½ûÂF+Ù„Øý:de¹xq‚™ÑKl][!™k *a6Œš‘Ü\º…LçéŽ>Üj™üÔm;Ô*àMeèÞ+ciج7RáM;ÉmÖl+º§Ú÷=ÜJ4²°#ª3ËxBÂÖ?×µ=Š:Å*óéžÒ±”qêrßh  sj€v…f¯ÏORY]üODYÅÊ™Lß÷Y]]eÛ¶mX–Åúú:Ï=÷‡&‰.w±Xd×®]H)™˜˜ V«±mÛ6î¿ÿþ:Á,¾ÂÉÏ”L×&j¥uŠK³TòK& û¹á†64S˜*.CñãyÅb‘••jµMMMtuuqôèQ"‘gΜá‰ÇåÖ£s¼ý^‰m/SX‡BJÅK«% ÁâÊ'ŽÙ|wŦ°!_ˆ …êv"6Ãã ¼`gy£Ó€£½‰ËÕ ÿ»Áãñ&Þôƽ,,Ø<ØÆaZ¥®ö´ó¦7ÜIowŸýìx]$Ž%ûbq~¾”cøÙ*ÏE×¹asŒˆ-p5H·A˜ƒxçjmìÕsí¢˜F,!Bë Ö®w¡Mž9Li¶YÈb"1%­ÕH¸ù›{"ž°,"BÐf;¼9ÑÀëIóXqO|泬®®r÷Ýwã®Ìsì[_%¿´@õê%Ü•¿ÁÞÿÓX}Í}ع^p+øg¨=þ Õ?ݶé)Ø]ĈÎÝб“R¹ÀäKO³å–ŸÂ°qÔ/[AÓ…B©Ý%¶,‡l÷f¦^ú^µŒ‰n"˲ÉmÞÃ̹ç¨t©C^¥¯8é-Kûmi•ºç „¨Beë³sP˜Ði*Wû®€wB§g¤4ÖÙ(jÉÚÌí;Öik‹…ËgùI¼Y™L!…Bx<€•gΜaçδ··Jîüùó1^¹\æÔ©SìÚµ‹J¥ÂË/¿\wVu¿Å¥Y]ÝõÇ‚ÁÁA:::‚Ø×ü=•J‘Ï癜œäù矧­­íÛ·ÓÑÑA4ŶmŠÅ"=ô'Oždû@‘ÿñ[‚ÖuiC™V/'µx¾‹ï¹ÔÜ ¥2úo‚«“ðòEøÓO–¹š¯ñºd®åóW«‹Œ,–ø³}—¿ùÄ÷É5¥ÈfD´ÓÛÓÄ5G6±{W÷?pŠÍ§çyS*@BîH¤Øsn¥ÌGYå^Ÿ ˆ6³Bô¼ 6ò|•6B­j±j_"°)Ô|¥ <©rËJ)È8ôxKõ>Ãñ,¥Ð1²Òbõ ŸÓžË¬ÏóóÉ N””°¸7ÕÀÁXœ?ùú7ùè³ÏbE"$Ò ÜûË¿ÍwÿùxaÞÆ/­âѾMa‘8Ö¦#ˆ¾½ø£/âM_@4´"r½o@Ä 1pˆácŸ¦eó.R­ÝDi sƒB‹õÀ2Ì” ý}D®XCW_xœëï©Ë„“²=ƒ¬ÍŽ“éÚ†'ÆúK=º´žX^]]< uÍŠGKYU|¢´pb9ºPA†›R†)+õô‰=ŸZ1p¢Rß­±t¥^À~ôÑÜÜŒëº0۶Ͷmq±ïûœ?ž|>ÏáÇYZZâù矧µµ•®®.|ðA=eåÿþ°m;P •J…\cœÎC‚+ã‚Z­F¥RáàÁƒÜ{ï½ëZ­ÆÌÌ ÇŽãÕWÎrxO™ü AK³ ö¾’‘בâñ0³)%d3ê5ו ôÁ ×Âí7ÂW¿µÈLJˆÇàm× þév(ËŒ]-³¸²ÆÒ ,-Ãì<ñ½ã<ø-É¥ 6¿fµâSžË?ä—h´l~;ÓÌûr||uŽWç\\ÃßËrŸHÀ.h*}£hÞ!K™Ô¶$t­ۉ]bJØ”«g¿†Ü[!®(wRŸÏ¸á®î 2k ÈFl¶8i>·¾F‹„;i†¢1ºoîäk «|¡°ÊÄÔ ™æ6šÚº°Ï=Ž8ô6di voq ‘éÀjß‚pâØ[®WuÒËÈÕäüð=¬ö­X¹ªÝ‡xæsNKO?CoùUM­fYußzL=5BàØ1zÜɉÏ}D¥µ²Íú5•ÇVÕ]Õõ|XR) Ÿ G Rz˜ßû«‚” G[`7œÛj1ýÀÃQÏÁ»«LÕ0ÊíÖÖ|uz„ܦÝJi7½V*°Z—ÇýqG,cyy™|>O,¦ˆ'†‡‡éíí%Q4ÂW®\-4á. IDATaii‰[n¹………^}õUƒúÂ… ?ñ:?êº& ÐÙ¿÷«’¯~Óãág_ÀóÕª£:Qõ¦ÊÒHTו©ë6àÙbÁã±se~&ÕÁ–x’U!ù«¥9ž.¯ÓnGèDØ‹sc<Áã+‹ˆ¶Üj™©ó'ñ’͈ÎXM݈†v(¯â¿ò88QH6*÷4ÙÙN¬¦.D²ô8þ¥g°Ú·!·ßNþÊY¬µÚwÁŒj â1s‚r£}O@‰gr¬L S+­Ó<¸§®}PYAÛ‰P\œ!šlÀ‰'^ãB‡™„`Ö³¡Û¬­´énRG“ä t¼¬PaÙX†º6À* ž¡Ÿ¤iñÔÂbøÑ¯Ó{øvœx*À8ÖfÆîajÅWA§Žååe¤”444Íf)‹ŒŽŽˆö¹sçX^^æšk®aii‰'N)ŸÆÆF¾÷½ïQ.—‰ÅbìÝ»—­[·*K›Ë±¶¶¶ñbuRä8Û·o§­­Z­Æ¹3ÏpëuyÞp‡Ä-¯2|iXª‹._¾Ìã?ÎØØcccÔJc|ü–ù…wú´4Ô?è®Õp¿Záßê<˜¿›Ãl åÑ*Á6ýþÁñšgn —mÃέpóë=®{K…ÛßQÅŽÂȇ·'3Ä„Åu‰$;­8Ïã±X«næD"ÁP›Ç[êä¦èCêÕnI€êw©{Ò}°Ú×ô¥:­ÌÔtnÙª!63Zϲ´õö뾡ÖR3k+ÑíÇi²ãqnÏ41îÖøB~‰×¥Ãvè±#D„ÅÓ¾Ç}¿ö»TKëŒ>ùMµ¿3íˆd#¢¡ ѱ9þþÄYu÷±”¢.KbulC´ ÇðÇ^DZù ÏÐwäìhL­Žn|£q¥vsÍ ·DS #OÞOû®£jÂCo«ÝàVŠØÑ¸â‹f],Œrã‹„3NXjj†§{RëðÕKN ¼Fÿ›17A^ÚëéòR2ûòqÅ.Œ~,¼ÌÕÿ‘cZêjµJ¡P R©ÐÑÑÁÙ³g¹ë®»(•Jœ>}€-[¶066ÆÉ“'ioogqq‘H$ÂÃ? ÎG¥Z­288ˆëº ª¡è«««u½ÄÐØ® µšG4¥££ƒjµÊ¹3ÇÚ^¤¹ öí–<÷¢äØñYΞ=ËØØ¶ åõ1®šâ3å±w·$ {ÌQ/€¾oh¦7¾æº8øˆ†D ÆáæñéóY–âÔK¥ 1 iˆFàß¿ïŽçˆ ‹¨”¥Ïw½ sÕÊFaN§Óìmó¸a0€+¦Äc Ù£oДªªPÞôj¤ðÜêkXB-„a$©?µD²XðùÖ™u–©òÂj‰ŒíÐáDØ“H±3‘ä|­Âw× \¨TØñÄü43K ËâêØÖŽÛ«ÓPX„t3‰bµmAäz`e þ”V!™ÕBm!"q¬–MX]»v7?O´ºFë¶}J©I´ÕC½_[FIØ>Ï43óòq¢‰4 ýÚóõ-MeU\k;!š,U2NèºnÓ9dVà ¨!¬GgêK•žñƒÏƒ±âaÌh_Œi©¬¯R^™#·y7¦ ßgúì1fÎ=¢ßüÏ>Ö××™%›Í²¸¸È•+WH§ÓH)crrÇq¸|ù2W¯^套^RFehˆB¡ÀÎ;Y__§T*‘ËåXZZbÓ¦M\½z•½[ªÜvDpËaÁ/¿U°kPHØÌÌ,3réUÒÑ9‚3g]N¼(xòÁ©ó0¿X¥T*âX‹ tÍðSw•yÏÛ¡­U[[?X`U´Ùã*/ ¢Ö­')ck0½Éê³¶ºïÚ„ @ëlÏÝ(ÜBÀ…K0öX‚7F3 CÔiÏåYeA·jn¨Ë$ 3£º1GPÖu„.tø{Рa««åo+&]O*ƒ>h×CÓ‰`‘Ôbn| ©ØM¢ÙÛÊ£Óë|ñÒ ½"Á»šZØKгèÖx4¿ÂGV¨ø¥Bž£oùyƇ_ajô$Ρ·"‹+xg¾½ýVe¥YÄæ£ÈÒ2?ƒÿÊMbm:Šˆ*'Šè;€“ëeüñÑý=ij aÄ­!m;˜H-êI¨±Ëc¯Ð¶ã–Uß7hú·°âI•ÓU4¦!ã‡Q¾ÈŒÐÖX…ºv0»F€ŠÉuúLè0É”u$ýEר|j랟¼L¶wÁè žï±¾8ƒÚºýsNþPSCýáº.333,//ãº.Ñh”t:Œ@-•JA.Ù€]­­­lÛ¶T*ÅÄÄ}}}<ùä“Üxã”Ëe¤”tu4ñ³÷äyç$–­bÔ»}(”< ëëx~TbËR¼ÒRJÖÖaú puZpaÄãêL/>ùEÉ'¿m9Áàl”t¶ ®=]]’xL-í€ðñƶ¶žRTiÊHi«íXák¾þœïéZ‹úþ~ãùèßm ¤2÷Ų}3Œ¦Ê|®°ÂÉß-øf1Ïj*¬w(ÌÒº¢‚f ‰j]ôCí”ÔÅ †âÕzð:w,%ž SE ³‚›U×T©eU,K*¬.—íúÚ¼kS–Ã- >uq‰¿X˜àéfö%Ò´G¢ü\s+·g²|}y‘'OD÷¬X KA¶ƒrã&æ/ž¢ïèj-4Ñ€Êù5K Âä6íbòÔSÔŠk$ríÚ•ÕÑ:w\ǹåDKëÕ\¹ÏáÖ-ŒÒs h†»K_"p +p§Ì*2@µÞ¾£•‹ôÝ ñ¢¸4GÛŽCMéºx•R²£qvÞó X–ÍÔé|¯Þ]¬?*å–—J%J¥óóó?Rø÷ìÙC"‘`mmþþ~†‡UOôŽ;£»»›S§N3 m“Äã¡@y@cƒ$—1ЦbB R[6õ€8(Á«¹PX‡™yÁË—ajfßþöŸ$ñ˜ ­:;”åÞ¾E²e¤S‹BTÿ‹8ˆëÇ¡{X<ÝBîzêm+t« v#È‚jfÆ›nZ£¿¾ñŸ}r¾<Ïî#ð¡kû™8˹Q˜‘fR»™{#ô@ gà¤m„ëƒX±P©÷‰ ÎòdXÃm¼E× ÝpSaEÝÏ‚ žvÏÍõ¶6DùóC<;WäßÇ <»ç†T–ƒÉ‘(ïmn§èû\*(†ˆ¨#¨.Oâ?ƒhìÄêÝ –?uAmØÆN¬öm VÛ Vs?þâ(,Œâ žÆê܉ì=ÀÜ…èÜ{=‘xŠ`0[eV³¨lÌœ¦DS+©æ&N~Ÿmw¾sCñà ”¿¦ß£ÆÙ‚Ü -Ñi&å×Ií–›n3ôÀºzɪ­jÂè°C*š][™ ß­a9ÝP¢ÝvÛÁ-ÉO] ‘m¦©Coý5–Ç/RZž žçOð¼ìaÛ6‘H„ööv&''Éf³d2éêêâÔ©Stttày[ÊìØ¬ö«A:šqí`±«mpAYZYZcÐÖ,Ù½- fj”J°¼ óË’ÙE˜_†á ‚NèQª>8¨ªÍ9IG;´·@®ºÚ¡9§ÒWûŽGH§¥]n-µ±êõëèûêüž=]ð7‘Ô\C_—ľücj³Ë5ÓTaâZ©Ìã/ê¼² Y†ôº†ÿÝ7¹QÌë"X`K(k­=äß6 c ERǶàKÅÓ±…àÆ¶$»c<7_âcgçyv}_jn§Éq¸9áű Ý$“IJ/!Š+Øß‚œ¹ˆ,,bo»"qü«§q¯žÁÞv3V¶ßvm[ U"J+ÊZŸùäú2³ë³¬ÏM’íÝŠ^Ž`z¥”¾£‰Ç¥žïÔÝÝ<ÿODß5¯#ži ½þËUËkÄÒÑu&–µ‚¢Ó,‚+*;ÄÉ&üÑçÚKª¾Œ§#”c'¥¯i‡ôúëq4¦`E?,V'G¡mìSŠ/ÝÖáwÿ.Ï|â÷ðuYéÿߣ««‹B¡€mÛ$ &&&èììäâÅ‹´··ÓÞÞÎÙ³gY^Zà÷>¢,¡oB9ÍíŽZ7³¼ÆËaŒjÂ9c\¤°ˆ£]a_ÑMÇ2iôtÖÃRm®bÒ,–¡X‚ÉYÁêš`q; cS0»¶#imôvÁŽAI_`ßnIs“rËRE&zø§îsPBn8 ¥„j-ŒÅ…ŽÆô– GyMшçûZ Uk¢r‹-AØCi‚y¡øµÍÉÌ„:³`ž§ý~B2¡:ÿ!®öBk ÃVddP1³ñ ”¢K+æ¸Ã{8Ü瓯.󇓣¼!ãH²{2ô eöl3õY×ÓVNDzš~NÕ¬×Ý’/Ð *!Ðe뚺µž¯~7¯ÙvpQ¯gÒì:C[ M"øU*Ãô\ž€Ó¯Â¹³‚¯Þ «Jr°{;ôuÃîÐÝMM’ˆ£\ødRaf@]×l5‰‘³Á4’tLÝ]}̬ F¼±aäG§gLT&¬0Í$ ,©ƒ¦}/œ–¡>/‘¾¡(Ò׺r,بá“!WŸ9ð´_ÕsøoC-ÜÑYæ[ãy>¿Rd4͇Ú;9W,’M¥¹5ÝÈ“…UþãØg˜hßÕwÖæð ˆt Öæk7sQYÄL¢y ð}Dsö5?ÃøÓÿÈàM÷’lé ¬¯ZxRÊPÈ…`ç=ïáä>J÷›hèè J@ìX;cmvœÜ¦ÝuH¦©§Ö»PÔ»Çê™…3¦BK®>lÀ-¥0ŠÈ­AÂU¼¬ËY-‹h*C¦£€!T³š,\:ÜSnËHM©+7½‰¹W_`eb˜ÿ›c[Ňßãþ§\þí)jMÕp§R)Òé4333:tˆ‹/²eËfgg™›¡!‘gS\V'»*Q‚]Ÿ6 §³è¿›f!ü:…`ÂIÏßèšGœˆª…S­«¹–]x_{¬é$ öÁ`Ÿä®Â}½Óó0rƧ$‹+‚ï~W2¿¢¦TDcÉB*)éhƒ\´6CkNýœkTVÝHU"þ#˜FJ5_pu$=RCF 5Ú¦š#T*Y‰µ§ƒ’@«ËiyšÜL -½^`ƒ¦ªÏ Ê-¥)!U“(ÍC3?`ÈnlK°¿)Æó %¾4¼ÊÚ²àM­l‹Çq,‹7f›Ø›Hñ•¥ažš¾m[±¶ÜˆhhÅŸ¿‚ÌÏbx ¹tï…Ãê?€Õ¶EÇ×ÝT›6qá¡/pèç7Ð|*N“*e¥Ð)%ÉævÚvböüq:ú‚#ø-[÷áÕªuóͪ™ðF )Âú‰º[ïzK_ÅÀæ„¥ V*ùzt+B—¢Z&ÎV1~<Û èÙ\€ïVYSYÑt#¹‰BÐÐÑÏ–ÛÞÊÉ/þÙOd€búÛ->òË1n;,ø»«2|u‚cÇ|b±‹‹‹ttt°°°ÀääUvt•xß=Ë…>åñ·ÿì‘IKvn m“ìÛ.ØÜ«rÄ0[—óµ­ †D£Bnö”ñQyc“ï5^¡£8,TN™P‰ÐÊ€Y~X¯,(ÚºÛ‹@s£dh›q•%ž§€¸BIR,)÷}nfg_’Œ\¬¬A¾(‰Å”è4e!Ÿÿ–Ù÷%ke_£Ð*®õ‘DlͰ)MP®âiOèrMz‚º69_}NÛ«ÀbÜa"F-åîI?Œ±¥YíH½¹›1=qC„q/!±¹¹=Åõ­Iþut•žâ–D#·6dÉØ}Ñhëa(¿ÌWf.°8ý ~×.ì#ïÀêÚ…ÿòcÈX{ð:ìæ~¼WÇ¿üö®; Ù„³ï^fúc*ùEb-!†‰U-3‘ÒS€˜è¶G¸ø½¯Òsäb ÂÑ0Ѥºa|Ðë"õÜd;)ƒH¸)Ñ]YfM¥šÁ* }©ù½ çÖ´`ª¾ØÂüUœh‚d®MU³I˜>s,`Iµv‰§Üw]z¯y'cö‰ÿTcˆGAX’Ö&‹wÜ*yóõQÎ\’¡ÙLBæ¼Z§zTªs×,"Üæ2iõÏ`€žç–¥~u Ƨ/_–LÍÁ±gHgŽ0f‚¨£v‚)ô@ªq5¦£‰×XL_ÖI‘þ€ª!0,×ÍVˆâš/ ÔŸT…áö4¯À2q/æ GŸÔ(¥ ¥v¿ïläpKœÏ¯òskÜ’Êrmª¬ípw¦‰M±8ß_[åäÌËÌ}ç!¶Þ„Õ³aGðÇ_D8 CGbøÓ VAÄÒÔ¢i®¾øƒ·½U ‘Ê=H$€z–‚lÏ ‰¦fæ_9IÏÑ»&iHÏ"õÈX½S„¥Ý8 Ë14¼uK&1 XÚ²K5”] c‚Ÿº“B%4U¬miüÃVüÓê ‹—ΗÌõïÄs«øµ*Õõ<Å¥YÜJ‘Z±@ÛÎC¬ÍŒR\þÑ©§x~ïgcÜyØaKˆcÉápxGT?K¤m‚­è‡V6%Ø»ömuxß#”«’ÅUÉÄœäÒUŸ'ù|«àc9’XL‰HZ›¡¯KÒÕª*Æ:Û ›RÍøŽi®Ö@˜(H»ÕžÎoÀ- úl…ÂdzdøšeCD†7Ù×WßË„ õJ†:±2PD¶ög%ûw*ã;6 ÿå%³‹¯±ÌžT| v€D‹þ÷ôUê(©°,XrãêI «l( º¥ÂfcE…u "|ðA*JÇëŽEPßmŠT":fWq¼º¾qï53°§1·÷G9½TæŸ/ç96—ç-Ùö%“ì‰'ÙOp±\âÛùe?ÿ0rê ¢±Ú¶Bs3þÌ+Èj{û-ÊZ._Å+yêJË ¤Û{hèè#’hÀr’¹v숙 ¨Õ‹ô¶CÇîkyùÏÒ}èöÀB “{˜CÂ}‚4W]<,Ãf “ÓVþ#ñ'O˜Ñ7A%"¸†ñ&¤VÒ÷)-Ï“n '$º¥u. žËêäe.=ú5¢é,±†&R-ÄÒÈ&W±“$àdzïÃʺIJ$µš  ½-¡Ÿ±‘SJ áwEÊpÈæö%±ˆ §UÐÕ"¹f—­F•$ËI¡+ŸÉÉì„äø >—'=*ž¤» vl†=[T|ÛÝ.ÑL”µáµL¬\߀$ê~6zÛx”RÔý®aƒX#”€ZE¦*ëâqK¿VW”b®TIêp â€e‡Ê½ŽiD’Ž[8T]WÈðÄ–¡ÌUßOh–hF=0Ú±LƒÆƒ]Gô§_C‡¾ÉI«?e`‚»ÎmQÆFLJT|?lɔ꽦õ²ê‡Ó9\ ±¸±=É‘–M®ñ?_šàºD†·7¶Ð‰°;ždG,ÁÝ E¾¸4Ï« cpéYª]87¾«9ƒûôgÍýP-“e޼÷H·öPX˜d}î*+ãÃTÖVXºŒïy8Ñ8©Ö.:úiêÛF<ÛLSß6„mqõäcô]{·Êx L’õÄ{–…6~cÖh6èÞæ× –÷õD ¡‰ú|O¥l[ÛK ›=ŒP‡cg,Z¶îÕî³…>ë Ó”óŠŒ ÑØÊžûÞOcÿv·Z!?=Æì«§˜¾ÀºŒ@­ÎýzÍázð¯x|é;5º,n?hóú#{ 1Öè½혨ý¦…Éõ¥.fÒsŒ¥Ä3R'Õß2)Ȧ,=nÉQé]Íèù’å¼äüŸÇ^ðø“Gµý¬#€œ¹Hem…Sßø$‡ï"ÓÑG¬¹‹L÷f’MíXUÅå{•µeÖç'Yaæì³Ë&–näò÷Ó¶ã0ñlsÀ`̮Ҍ"ªÒÎäèT ·é[V=¤R;ÀÇä¡„°T~Õ7,"*lÀ9|©½/£ ¼Z•ÒÊéÖ.-APZžÅ«”Õ5"Q&/¿ÊøÕ)J¥2…õ¥ŠÙn¬½$‹ ¬Oœþ!!6:ê¾ò;º›-Æç}ÎŽ¹|åa—Å5ŸTRÒ–ôu@_»E»EG³ •0yW½ilU‡àiA6y(IH4ijz¦±^#[©¶í9A{Îæ–6¾«ë’‘)ÉØŒÏåIÉßžò)×$I&#im–tµIÚ›U5Yk“j„¨·ÔF䤑ãDÕqC`¢1åi¥WßÈAè!˜ïfzkTvÃþaa–RR«X¡…¬æ$P†gԇɑnà…`Á¡-³Šdpóꋚ¶‚0÷ìI4wXB½ß•>*"Vϸ O¨žkO†Z=xf!¤vÓ½©¿»§…—W*üËÈ*7Ÿçî†&nlȶmvÛjZů¶uðéåU.½ÅUDc'ø.d:YžeeáËD7&Ò³‡hW?ÖÚ1ƒNdX<¯IMYM£¾tÔV­Š®'ƒ!êÊ¥PnŽ£5®§c¡…Òܰ"#Pùd¡ãË"@ÈëfŸãú¡ÕU±“¾\Ô¶‚|¡ÐnVDj¾õ»'ëØK¤"H’IQOܯ¾GÔj‰s¨%ÁãÓëüñéyž__ã}­4éêÞDšG¢|se‘ï\¸L)×µóN¬DÿåG±Ë˹ñ&æ‡Ï0?1Ãb´™ÅΈ¦|,XœÅ?ÿ<,“òÖijn"Û9@,eæüót¼…h²!VQ§Ò W—IW)VN=uÒ û£-˼$é»\hËr@¦-¾ôœ^öyê|û­ðÿþ}…öÜ0äpë~›Ã;,2iµ¢N˜bR€úE¹·õ€­b¾Õ<5W-ðÐQûÝÒdW tµZ¡+¬^_*ìô%gÏ{üÛC¿}Î#‡Ã»·…ÛŽB·º`Ä ÷® ôú½h[JpyèêuO>Ž¥A9¡Î¡´/uÐà¡îÛ,œP3yrãÞ®¨Fñ¹©=É—oîæËWVùäÌU¶Z)®MfèFiv"¼¯¹7eš9^\㹓_f4’b-Ã]!ÞÐÈî{ß H*k«,]y™âòiJUrMRÍ5àåöá ‹åbž…ñ*ócˆ¥1VÆ^¥m÷ÑÉ"ðH”.ò±‚j1SÒé–VݘÓ2I`Å}_µëaâpµC¤¥‡Ôq¶-°‡h2£'cjëkä§FÔF‰ÅØqÇ[é74HR/®<· IDAT¾_«2{îyÚ,òeI¹V·'\»=ÂïÜ—¢­Qi媫ž‰Ù¦Ç×Ö¶ «Ùâ]7Çxû1ÊUÉå ã=[㫸´4)wwKŸEo› £YÐÖ¶vª²d'‡"pÁ5,à‡Ò—xú+ùRâë½-õ:C&µ€Ùist§Å}[„R†'|Îú\žòùè'|\O¹é-Í \ëé´4AW+4e  …2hµÔ¸@½7S©…{9xPÜ®ó†˜Ù| [?$Çu…"Ð"&î’"| dp3ÆÑ„ÚÌh[#dè–ÉÕÁF¬Þ•¶…`“†B ¦q $ÚúêXݸXunG¨{ô6Äðu› åzw$~kW3Ã=Uþu$ÏßNNr8ÑÀë³Mäl‡öH„{³9nHe˜¨•¹X^æYÇæò÷³ÿg?ˆ‚XC#]{o´½ïy¸å"^µL­\Ä­”ðª*¥C,]>ÃÈSвýB(WZ…Çæi‹¥î×—A^Zï¾ðÒþd0H´àš·ËÀDJIˆªÁÚü$±T†D®D®-PnµÄúÂv$Fª¥+¸¶)^1¼2y‰Úú ‰F‹TB!Ì–¥R”÷‰ñîÛâôµªB“ÕEYH©÷Ÿá…‹ØZÉJ " HDC}û79¼íÆ«ë’ùUÉEŸñy³<–Š>>ƒ=‚ÃÛ¶÷ š2‚ˆm@Ú04Û5šý-Ôâ˜}$:ゞÁ&dQ˜=ÁÞ­¶«ïXª(}~E2½$™^¼ð¢ÏrÁ§Pö)»>]m‚-}°c³dßvHªa2A‘ŠQ@QÝ”çy¡luØ Ì¦ëI’õéÎYÅÿ% Cägšô»`Ê7 íkó4 î•›PoŒ‹Ò¹¾ ÒO¥©cŽ êXT}‰«l¨ù>ŽªÒ”Ùï¦ ÓÕq´©7%©&îJˆˆ÷{kC”ßßÛÌÅ*¿ÿâ]]á7ں؛H!¥¤ÕqhޤЧ¸¡!ï”Á[ßJ¦³ˉâ{µ€ç˲m"É4N"E"×ì ´oßÏÓý[LŸ~šî·‚å¨x¹Îê‚DXºðÔQ£7fhZÐU]ÒsñôÐ3¤¤²ž§¼2O~j·\Dú.Ååyo} éö^í¦Û´lݯ\q [¼t.˜\aÇdzµ%×i@S”"3gŸãÝ×%ø•Û“<úr…‡ÏT87YãæÝš,"Ž ê*AUù\4ò Ã*CÛÒ#QëÊ0•«¬ GÍU1ckÆ¢¹A°µ+´ZUWYO_¨ò•‡ªRå+L-{´d½m6{7Ùô·ÙôµØdR&TcÃaÀ…û.PÂiQ1¤/Ã<µ)þ¨y’‘iŸsã.gG]fV=rYèïtµ Úš £YÐÚ(ȤBÒÉp_‡{Ìì9„ÉÍ€i᳑a…áû—Y»É¾  ¿V×á•QŸ—.yœ¿â3½$U=.ÙÒ/éï’ tCG« -2i˜œ…_û“&Î\\§Z­n´Ì…2:À]c¸Ñú€îvq½0î—¾__'C_Í´U. ´LXˆ0^)¸>鈅ÉH˜Ë¸ÒŒH,>(<¸Y/¨*7i:Á$!»ƒdK@&jóK[›¸­#Í·&ÖøÒÔ,[ì$oÊæÈ9*oûS™&NŸ–ùý7Ò±çZ•76ã]eXG-zXß§m×aªë«\øÏ’í$šÊâ$RD“ ÄRìhéûDÓìXaYØN„H<¥D¡|'a©áì–m“jé"ÝÚMµ°JµTÀ«–Y_˜b}î*žëR[ÏãVJê³Â¢²¶Bu=OiežÊÚ ‘T~­2@Û¶ªÈ%€]-]j*Y›£Ï™¢7¶øØzs6½¹o9œ`qÍcrÅçâ´Ë¹‹5ž8åRõ}š³»ûl®ß¥£I1“Fµ€›XÚhv D40älu¡‡É®ØÚ Æ-Á®~›=ý6o»!ÆzY2¿ê3±à3µèñâ„Ï̪rÏsYÁÁm»7Û v‰TÓ‚',c¤Âû°,cÂ8_XB3µÖ¹ô±1…ê$¦b̲!××í±¸v…ïÃZQ²”‡ñYŸ|Q29/yâiŸõФìúøH %ÉäüáÍöñÀÀ™©Õ!ÛkèƒLV(( ½&` Èì;k´‰•Œ2Qï3yA)•ÛmŠRlK0SªÑ™tÔk¯h¡]#WêØZ_ÃeõGÌR¤ A€Pónë«Î¤õº.ØÜ჻s\é«ñ§gøñÞÛÒÊÍ ´E"¼Ù±yàØбóH€›Ãhv!Dд*õ“¶({®eä°63A2Wµèv,Ž@àVËÔÖóËÖÍ.N,ãת¸Õ2~­ª L,‹ŽÝײéæ7SX˜dyôåün¹ˆåDq+EÊ«ËÔÖó цFR¹všv0Ð}±L'–àÙOþþ†5kßu4hΡ ],[P˜ŸàžÍE|ÓkN÷4›·-kÓÒ`³·7$¨Ô$«%Ÿg†«<úB™?ùZ‘\ƒà]7ŹçpŒ¾VS^ª×ЯSÒúoõ®¸çI,[è®òÈ‚â -h™„ ·ÙÜa#DχJM2·¢rÞß?Yåã_)S®Áõ{ln?dqË>‡–F¡ë®e@5-th¤ÛôC×cD!Þ$ñ|µ—#6Á“V2{=ÉdIš ÐßiFÔgŠeÉ <)qD4. î«Î ×ÈóCÄA+ÚU¯;N/}ÎLpƒËC´¯‹ÛÃ×<Êù%Ö¦ÇYfþâK”ëæIµï:ŠÕP«ª)ÄW×Z›»ÌÌų|Sx¸\»%J&Q0ûÅÖ{£æé’M Ég’‚{ö&¸gäK’K³5†g]N¿âñ½“5|KÒ–ìÛaß&›Î&»Îr‹ÔT#7ÔUw×äwÍ1Kd€P_*:žÝý6{þuï¯ÙUÞ÷~×Þûíç=uzoši4£Þ $YtlÀÄ8vâë´›8öÇ7÷“’ØØ8Ä×NÀ°16B˜&„PEuÍHšMïgfNû»÷^÷µžµÖ;’'¶±³õÑœsÞ²÷*Où=użûº’¸SûOå¼¼;å±VN«ŸÑIMÑÆÖµ1¬‹Ø´*8XÑ™ªŽ„„›¶4–Ûè„8Õ\R‹» ŽÁýö…PYÍ–/t”666Æß»\ó/oµvЇ42‘"ƒÑí6Å-…ê2ŽÐËíC ØEîžç\b“ÄôSÅ‘é>Ÿy`Ž'v÷øø…‹xËŠ!b¥Híf Æã­¬1a*#•mz¨kK*`ßÆï ‘oˆàCû¹dΦ‡3íŒÿ¼gš·"áP©ÌÖwü}Ö]s‡MÇ´ºÞL<$voU"/ÝóûôÛM.zß/Y×¥™‡-˜°“Šï²Ãœ_ÀÄ %~ŒÂ—h‚û^kê§w?ËÂäÎîyŽÖô$Y¿CfáºP_\,qÝ/þ–l¹Ì¿HŸž* sͳðo¹¶ÿ(µˆÇö˜ëæ¼é¸ºÊ†%±06\hx÷Éi×Hº¼š5ï§Ú&IhæÚš§õøÎ‹^8Úgí’˜›·¸óŠ+'"÷Œ<7~ 9K<²yݦ€Bú²{hGÊt” RÚ}‘F}ݾ¦—ÂLCóÂÁ>÷=ßã™}FêpýŸÐR)y-¶±Â‡Ü´[ß<Û—c‹rŽ`éj ¸:í4Ó™Ô|ô7ʼ|`^¯ç™ybb‚Ÿ¿2ã—n„Ibॄ÷ðÙ•÷ÃiîíôóÀs€>`ûÛ¾dŽ)³á{Ú|öyÖDE>²~”ÍÃ%J±wÐÙ‘x)ìžbØ·B(„Bâ¬{_Ânò»ÜÄ|L˜GÌ øáé¿ñÒ)syÄæ[ßÏyo¼‹b}Ì9¿Ä»-Lì+ŸL3½G?ýÏX´i…jBmˆB©FR®’”*è<#)UPIBœ êGIa XCۃإ<±Û˜eþøAfŽìfîØ~:³g_£åeó’b…b­Nu|)oy+.ºÞi›ÐÎÜòC|û#C¬7©™{Ïö¹ww›‡öwX»(aÛê„+7X131ùR…qU1kÄ£”-“ÕÚ!¸™VÆûú<²·ËKÇûÔ«Šëc®9¿Àª‰˜ÅÃcCÆf¸írú­È)ª$É«` ë¸Õ ÅDáØâ:=ÍáÓ9OïKypWÉÙœ +áÊ b¶®WŒ×•-ü°•b" åÙ–ÐÄ›îƒd²âVÙí2¦„bÿñœŸþD™½GÎaæ‘‘~þ*øgo33ÐÈrSs¨­½0à‰lý3vc”‡H!÷lgoc3KB›W[(>9Ÿò[|ïù6ëâw­fûX9¼ƒC ,pÙ`*€\Á¨Ï/ÆApç ——ÝÍ}b¡Ÿs߉x`ާ¦:¬¸ä&6Üø–l½ÔõºçB<Ö[Ó˜<©]O°ûÛ_ cc¼(e+¥4IÅ0wÌÏB‘<ˈ Eâb‰¬ßEçš<ë“vÛôóôZóäýÑU§:±ŒêÄ2j‹W2´x%Ã+Ö3¼b½9ž=P°‘¥}ædÿÆ­øô;Ç]ú^ªÙ=Ùç¹ã=N.dÌt2†ªŠKÖ¸bC‘¥Ã‘©xS^H«`çBT%Nƒ;ñDÈr¡“³çTÊ^ûÿL;#C³rQÄå› \¶)aé¨A&µ_ïÞ\ôÚýЋùœÔä̵4‡Og8•qèLF?Ïiõr’¢fËšˆ#Ö-LEâTÔ&r^½†§"«U=8‘óÁOT8pôfãç¯Öü³7ÚŸdQù|f™€ü.»jhqˆ…M DÚ‰-ªõë@mhz¼p@‰#Ä µ±7z©fª‘ñÅ'Üót‹[—ñÏŸ š±P¬¤Ï¥´ÿ\Ò±ùÜØVIx»KÆ+rÅi ¼÷ëaÐÌtsî>2ÏÚ=ËB¡Ê†ÞÎùoý(q’à0[€JÄB¡³”ÿì³ì»ÿ«¯Ë|•KEI¥ÆÈÊMŒ­Ù¢Í1ºú<¢¸@\(—Š&o[›|z ¤×´gÏrjçcê~Fz'yêÿä†*cÕØÙX»ÏõFÇ@Ó³­œ÷øæË-öM¥l^žð¾«*\µ±H¹ ÉJ~¥"Ê! 9P––ý1ôÖíkšÝœÓó9/ëóèÞ»OõY»$â¹yGåã1…Èïkf…C6¤dh2‰íg‚âé…2µÐ¥Àg1±Žà4ƒVWÓìjÎÌißÓãG¯ö8|&gËÅ›.O¸öˆ%ãʵß“4õð>¡ÁHÒþã9øõ"Ž5_«™ö ø—·GÖæ 4’?YIh¶Ü®LùY‰j>”‹fǬ³±ÝbÊ&ªxk:Š)%-yͦëÊí$_:Ñå7î›cn ~nÓW/®0Zˆ½6&ðÆã_☈“X&άL”4RçÝ—mææ¶Ÿóº>Gsp¡Ïo½|–ûOµ½ìV6¿ù'©ÛL1—a"«Šú­ýçE{fÒžj!1j{œ2-†\wNé$…"…ZÒðåá1еaJC£”ëã”GÆ©Œ/¡84‚;Ý"3­ü☢‹¬×%í4iÏœazï3´ö?C~⺽>(Í¿Û8Û–XR¬õ§|Š©b:×xfšnf$&K7’NO3ÝÐLÏç:“òµ›|}g›m«ÞvI™ V«FÔJFCE–>sŒƒ(Ëm²EbÛD»ðNPÐ#\Ç`òÉt3燯vùƳm^:‘²h8â–‹ ÜpAÕ‹#Fª’ËxÃÒ»KèI’åÄó,‡;„护î´oX¢€™ÍËGS~ðBîîsl*cdH1ßcjfn·ë™yllŒ\šóË·!W–›J#”ršUlé\ë {¢HGIUs² ‘=>ÿZ´–ÿŽÓ0"©U+llþã¾·ÜËŠxÁÓO5?ÜßáOŸi0?·,â­«êFãØG “FjÐÜàŸ¡¼ser2ãØ É"sŒï§G„¢ŸkvÍvøÊ¡9¾y¬Ál_3Q¢X!^±âèÊ£‹(T†ˆ 2ë6^mÈÒi§Egö YkhaŽr¯M¹9O­5Ïx–3¬àå^—ƒy[WÕ¸kÝÛFKT¬1dêºÿŸ:Ûæ‘3MNôz,¸qm™Ë—©¤ÀF9¦S, Kžme9“ñàοso‰33×2ó‡/Éù•;Æ&­Ã‰‹%K¥ˆÀ±QüæX Hb¥<ü6ÞÆ’U ¡5®iAî&g ÍÅF Ægéj É#•L kt3ž9Òã³?˜§5£ùøöÅ\µ¨â¿o‰Õ #ÜBÛçxkJ,'`$AFÙj3oBA&Ý,̧[©æ¥¹Ÿyeš]gû¼¡>ÂÚb‰™4åTž¢ã„.Š~–Y‡ q8Źfgcžã½7—k|´>ÆDSUÕ(¢¢E¥8›eìîw¹¯ß`º’ò¶5uÞºª>I#|Æ\fç4ÙIyq¶Ã}“ Îf}Þ±¥Ê­* KÖ]°" M‰©üÝTs²‘±wºÏ£Çº^èsÅšïÜQeÝXì$­P…©’“â…ï$á¬Ò\3ÓÒšîóâ‰>Ïèrt>eÇêoÞVæºóŠN kεýšWB'– Ã$öÚZè(×OôBÆéùŒÇRž=ÜãàTÊâáˆ[/)òÆ‹Š,‹l", *ñô‹b4 •S^âÑwÝ>ý2_O@«ûOe¼÷S9ÇN7aö¢E‹xß…=~í'ÆŒÔø‘Kö‹Àhíÿ~CM –D™YGìö™e¾ÐÙ%‹¨öƒ”ދާ´ÑÇbËKoaZ™tdë¥E D6i@ˆduúšÏ>4Ç÷^hóž•#ܵv˜¡$v옃Ë\’ïºôU¹—…&‰¤$SÚ@˜æ}›afÚ)ïܳ0Ï×/ðŸ^™æ’b;GÆY’$®q‚ÀHÀõ?Õïñt³Á÷çg¹ )ò õ1V'*6ó+SÄŽèÙn›ß[˜¡UÍùÐæQ.(3RˆI.FŠð•E™†}ÿ}ÿ,{:ܱ¥ÂÛ·T/G“ÈÅWµ]q6… ”k86ŸòÕWš|cO‹õ‹>xyË×”¨—" ±§1wÂt\´WåÒÀäBʃ¯vù³ZÌt2Þta‰[Î/±iYB¥¨('Êä{·Kñ‡¸å"¥(ÄžVsp-±‹ÆÍ`º‘óðÞ.ßÛÙá¹Ã}V.ŠxÇ5%®ÙR`ñhD¥å¢Ei¦ÈÌ™p’¸ââË]æ¹?AÃCq³0.QÅ¥R°÷xÆ{³Ï±3mÒ4õ̼lÙ2Þ¿­Í¿º}Ìl¿ÄׄÑܤtÀx>6+ÔHVÉ1U6”ØŽ‰qÒ8ÌürG»(?ybÓÖŽ–Ì0œ ”ãÇvÛMñ‡Gy®yåTŸ¯<Ýàåƒ)oY\çÖå5VT ßó 1ÞöÅ2ufL©*Îìàl‰­õ +wO‚×CM¢•ò¥ëGÐ IDATƒs<;Ùe-U®ª³¦Pv=ÎÂ+·Ïhç9O5ìí´XIÄå…2—–ÊTTäœs2Tkv÷»<Üm2[ÉX»´ÈM˪¬­7ôeÁeœ^'Ú}~pªÉKó]ÀÖ%.]^díhâÎæ–JälmO7†¡š}ÍÓ'ºüèD—³Ýœ‘šâ‚eE.YYdÝD⚘eÒ0Œ˚Xv­BfÏr8:›òø¡.»Nõhgš¥c[W$lY–°iiB©`öG”€ î#N,I Ñš 1×~ZÛ½´4zv!gç±>Oìïqt:…–ŽÁk \°:fÝ’˜zÅV † .XcQ¡ò“‡Ëxe,2æWg|ðw4G&ƒšyéÒ¥¼ÿ¿|û¨—ÐÚ'~‡ Â@¡âS4½= ^«âõ±bñ’çV@„ÂA6À{Ü_žÚ]ö㽨'@N3šy´ûðòÉßz¡Åî)^7ÆK+nn‘±!%Ï÷óïà Ó>el®><ŠQ¤œàBÖÃÎ#ÕšC>÷]à#m.+×¹cdŒjYÛëÜu5‚®­sw»<Õœg¾ÛãÕ!®/×Lü[c;ƘçµóœÉ,å©~›ÇU‹±±˜naãPÑ|N¬©i/#çû9=ž˜nñÃé&.-ð¾m56™¦ ¦×³\Ž8Íßqd˜¾ŸÃ©FƱù”ûµyþtÕã ¼¬Æ%«Š.5Wö@öXÖè\µV§¯9µqx:å…=^9m 5®ß\äMÛʬý¾Y™R8êÓÚÒ#ar¨¨®ç&#íølÎá³)ÏîñÜ‘>,ç¢õ ·ì(rÅyêe庆H>º0±8zeo»à‹‚„2_:Òç®OÁÙ™s’F/^Ìû/ìñ+wŒ¹2‹/'ë æ2÷3)…k€¯±E¹$wHïlËtaa4¬÷ŽHèH'ü)lˆ Ǹâü/»©õgeɘDªƒO™PÆcû;üê=3l)•øG['Ø4\$-îÞbOÉsÂŽ%²yîŸíbà»Ý8;žXùúm1Mú™G;/ÍvùµçOs¦‘ós˹ \¡¨$ž+Õl6;ÈntŠæÕN›ÏOM²-*ð õq–Ä ¥è“»6µRÚÔš{[ >3?Åõ«+|ló8«« å$ò¢%ÅWÑËsçÔIsÍŸçóûg8i^R缉„j+MfÔ‰R¶y¢Ù…÷Bƒb¡—óÝ}-þà…ÄðÁËjÜ|^…ñZD¹`êͳ`Ýie÷ç…i¥ý £Àㇺ|å¹ïëqÍyÞ~i…k7©Z(îz’Ù½p¦š(ÔÈ pt®pû(ô•ešWN¤|çÅ6÷½ÔåÔ\ÎU[n»¤Äu$ŒÔ"ÊE“³-å0ar’ø‡„öÂk߉ŒŸþlÌÁóƒ°E‹ñþí=~õŽq,ã;X½á%Ñ  H×~RaxF˜.ì¾>K iT€sNg‹¹©0–‚\õèµYáL˜]y‹hkëÔ|éÉ?ÚÓåâr…;WÕYY-8Bh*‚×ü£Œ`ëí æEå¾x`EhÏÈí<iÆ=GøÞñ&£ý××FØP,ãm\ƒ`”+NQ(º:ç‘Æ@´b($$ÃLYbSa@þYæ ‘‚0£ŒF4 ö™§:)œlñÇûæÙUyëè8‹mã‚B¦ùÂ|–ñJ§Åîv“B?ç]µ:—+~¿ìb‹ Îä/õ:<˜59UJ¹qy•w­¦žDNxh·–n:( •åì›ïñò|—]º˜qçyU®ZUr9Z™g „BГˆâäBÊþ™”§OvyyªG½ñÖ «\¹¦HÍg2·sýšsÂÝøD!`<Æi¦9ÝÈ86›±ÿlÊSǺŸOÙ¸4áæ J\»©ÄPÙ§EIIoö½VS†fÁkœwB7˜ˆF–›´ÖSs9û'Sž?ÚcÏdJ7˹lc·\ZdÛš„ájdïinšg»¥Üõ›'§ÎI™磗g|ü-cn0¢1dði`´{MèÏÒQ˜Í’ðU"A}+)e‚K¼·Újj%ƒöµœvR„kÇ*5ÅÒCÛyAI&ÐV¼ìFJúì,o—xçx¼ ±¹×Á©>¿òNOæ||Û"®^T¥d)ÄìpPÚڗƃì¸ÝzŸaví!µŒ! _™1E®‰BŽñx£ Ý×üû]gyèD›÷-áúê°Ó"e4ÊÃ6Ën¹†Wº-þûÙI.KJüB}œIâlb”±×¥\¨í@ÚãS³gyF·ùû[Æx÷šaF‹±ó8÷rcnÉ>Ëy_¹6vñ3Óm>³wš~œòÁ ëܺ©B%ñÁ‡¹|i¢Ð‡C4ZÓèi=ÒåwŸ™çD+å½×øÈUCLTã;×W¼I¶®-n†‰âÈE„á•‚3œ¯>×ä‹O7iôr~æÆ*?yu•ÅõÈÝS]¤# O¹Oˆàœ2уù ò9A|(èõ5{'S¾òd‹ûvu™iå\½¹À{®+qåæ‹†Mô@æ+ÇR>ø;ptòͼlÙ2Þ½µÅ¯ýÄø9Ò$8 @)G€bÇ Ó âOCĮ㈹fPƒy-$•%j.~ií“,—J&7l‹”s"HµŠÜÞªO¤”KHÉsMGŽx¼V ly+}Ûýœ{_jñ¥'›,ÊÞ³z˜«U(Ûi"¥å™nƒ`@[*8dÿ çîWöbƤ˜ñÿèl‡/˜£ÙP¼¡:ÊŽj²œèxî ƒ{¥Zóxkž]ÍçG®+UØ””Lþ:Aý¬_4¯ô»|»Õàh¡Ï¶å%n\ZeˈI@ÉlÜ®amæ…Ù.ß9Þ`²ßã¼e1W¬(qá’"õ¢0Š =ÃØYÀÐBLÍ®3}¾»¯Å®3}Ö/I¸|M‘mËŠ,ލ"oŽûÌ9Ñ!AÏaöœîóоϟ虞Øk \¸²À¦¥ ËFb{ȧ9m£7!-Ë}ó Ú3¯ùŽ?ø~{˜BŒ}“)íëòÜá>ÓÍœJÎ_³c]º¥1Ó šôùˆÓ¯³oßÔå·ß»È;'´ï1 ¾ ÚC[Ÿ®f6M vy«pÒL4†CR¯cwf†ùh;/m­&ÊrO<˜—{3A#žHéO&ö{ À9'c—·•Òœ˜ÍøÞËmîy¦Å2 |dã(;ÆKöøXï( G5$"­_¿Í¯‡›vE󃋕ʕY§™æ<2Ùâö-w"Þ=6ÁÆRÙ9¹äž¢ùeÝãÕé>ËG#n:ß$©ŒV½0òè€*Qœ>$$ëœ]vßýi–frhõ4§ç3ÍØy¬Ç£{{œn˜®ö“Í!­sê™ÇƸuCŸßzï„!hëE+ĦÐ\ŸC„’È 9¨R¿šÚÕ*XÏv®=ÌÆŽ#å,È)ß^7‰$Ä6 % ¯AË©•&mÑÜ–!¥W/Ó¢c<—‘2¥eâq4*4&ç¤h¤ÙÍùä½³üÉ“->¼q„¸eœbäµH¢<ã¸3ç-S ï2ƒÀùZËçEªü)“†šåÐÉrþ`ß,ŸÙ=ÃõqÞ7±ˆ²{Ë3BïVö¿…¼ÏŸÏMó™i~®>ÎûjÃŒÇq°ÖzàôM 4tƽ­ŸŸbÝâÿbÛb¶’>™ ¹\SŒ¼“*ÇÐÁ¡VŸ/œå‘3MÞº¥Ê?¼|˜jQYg«efmÌ*i _°ñ?9ãLÌ¥\ÃËgzüþó ñÓ5ÂT—̵„™[©)-òd"Ú2˜ØÅär±/µµM2‰ª4ÅÎíJzo°;ø«uàÓŽ1L¶‹%O‰xÃ-g‚ò޽Áê._-8ˆïà´Ýì§wù½GçiNÃO®áú%UÆ‹±w¤|‘‚ 6Íi-ûˆØj $8ÆãëÎ.ß¿%¨@îX«Ïÿ·w†#Ó9—ê\T­1žŒ&À‡²ü·üï³YÊ} ³œêt¸ºPæ’b‰õI‘ŠÍr4 ^ÞLkRàÞÖöš )nY=ÄŽ±2‹K‰×ê^^¹ù+üîd|ãØON7Ùº,áê5%¶-.0\Ьò„­ë‰i®9¾qï¾6OžèR))¶¯*pùê"ë'L‘†@öÁ´–ر¬½§Çп¢Áeζsî~±ÉCû»äJsáê;Ö(¾r,¦R°÷Q!¶ðcÚ 5zØÔR„Æ $sОrñé]ÇRîúÝ3óç¤sŽŽŽòÎó3þý»Æ-æ÷“€öóÄöÍ2£µMÑ'…8H™×HÛ“À^q?D {¾tÞµ£R>0¸ ’â‰G„¾ø#vv˜}&¸j¬×Î|pcJèÇ¢µb¶óÄöt“î¬âƒëF¸nIÕœTÈ„‘#çyD©<¡È4ÊXJØ <×Þy½vÍvøó£ ìžÌ¸¡6ÂõCuå=Àn*Zvæ…Íé~ŸçÛ Žu:,ÞSaC¡4d P‚%´…<ç…~›ÇÒ6G‹}.^Z掕5ÖT‹öœh?n™_Ø`®Ÿ±k¶Ã®…ÇÒ«F"Þ¾¥Æªá$€É‚(̘ÓÜ—:Z°û:ßÉÙ;Ýç©]öL÷idšË׸uk•uã‰;í1ËÍ$ÂÊ?Él4ÚÙG 䇸Ž4ÐèäžIye²ÏΓ=öϤ,ª+nÚZâšM%VŒÅæŠ$„°ÛkmPA¾…yÓž;€a–kvOyïïv™o˜zæøÀÀìvkë7U­ÆHˆÆg9‘óýi}ÊicéÀ‰e:,|q-k톤.3È4póY I+·IÚYž¯´² Ït÷sPΦ;™^‡­W¥LÑ;É3ÖL·Fr?ò2‚®gÏ]+ÆŠÍˊܲµB;Êùå‡ÎðÊl GK c¿µÌW6Ìüb{–4µ×0ØùeF’ÒÁÜJèÈ¢Œ0a§`).‰K+ ×.©±b8â '§¸ofž•!F’9·<¤H¤‰Äõ8fc©Âù•*ÇóŒOÌœf!ÏØR,Q@9¿‰„Ñ"eX“¹ºPåbʹÀéSšw¬ªóÎ5à "79#Ì„%KÖ5ax qpc_kª :Ó2Kâ\Ì´f÷\—oY`çdÊ¥¥:7 Sc·–.?_ë,ÕZ©Öìïux®Õàh»Íö¤È»jìIŠF0aÒe™XÍþ~gûmö%=ÊÊ+—V¸aq•j¹õõ++Ïõë¤PÌôRvÎvÙ½ÐådÚc¼ׯ-sé²b Ñ‚°§Ö®/¹¸VÛâ#TóÒé»N÷xñLŸÙ~Æš‰„[6•¹jm‰bâ#¢@böS÷ŠFHÓÔà|:}ÍÁé”CÓ)/žèñêTŸR ¶¯*pÖç¯HÜó2w?g9_¶Í·viöœ)°ÐêÑn›j)à»À‡Bp)ðu`uEÔ‡†®¸im¿e„åÃ1ÎÆÔžø¼¶Ã‘Ô7ÂWða+ñ ‹×0ÔD"¤ÛDäJÄ~åµ®K½°KŸË½×WœI¢FÓÜ;DƒîHQ·)Ú;"dÓ$9ß¼oži½V®ƒc–kڙ摽m~çþyò¦âß^º˜ G+`5½¬ƒHärC•Û¶—Y2{…“ÃcûºüÚÝó̱”©Ùȃè(ðvà¹PpÈï>$µZz½N’Îó³×Vø‰mVÅ.¯V´'Â\¡{Pù‚kÑ’âS>qÃv™ýëV« ¶°2t€™–»ÛôN¯Í¼“ÄÀoñKÖ–öðJkÉbÉò òÇf»és6(Ž‚ëöÒÀT3ã‹O6øÎ -®©ñöUu6Ö‹¦¬1€gò¯…;ÚGj]¡B±} ²^ö‹ÈÜ™Õ^X)Ì8»YÎ75øý½3lV5n®²¦P²ðWv"„ðŠp¹†SYoÌN3Óír{yˆëÊ–Æ EÔÀÙ]ÚÎEÒ\ûÀóÝ6ŸkÌR†ŸXWçŠE–”b‘8±7Ï<#¦¹æÑ3mþèÐ,47m(qåÊ«ê åÄWz…Ùd²_™]Sÿ4ãí¦9íòÇ/59ÝʸfC‰7n.³q"a¬[ÁëOAql`ÿéZ$‹/Ÿ—iJéæw^ióøA“RºiYÂE6Iå›/tùúó9q±Âüü<ý~ >|ïO| 3ËU~øÇõzb³}EÌ-sÞyq%õØíTXù䊔ÏÞ)~dq.)åá®'ßuD&-¡ 0TÑ´µÝðP9TUö»bó;"ÓžT­¢°žW¨ÒÜÀK] 7Y%l <ävÇÏà<¯Nö¹ûù&½Üe{­Â7Œ°¾VðÍøíwsͽæmz“Ö:@Þt‘ß„·+œ3¸žSÝœ{ŽÌóÃã–è2·±¤Pp ú8ÂË 4ºžj68ÓmsQRâ¶jUqÁiÛ×û.@Gkží¶y¬ßâL%åòåÞ¸¢ÆŠr2À²î¡ ¦ƒ›usÍÞù.N69ÒíQ«ÁU+K\»ºÌxE „ÅñiöO;:’qÊO­¡›iöM÷yöd½3}úJ³t$æ† %v¬(RJéI.¿Þî£ÐÙ¹ ÓI5§R¾ýJ›ÿöD’ }‘eív[´ño¿ tÎYÖ¿™åZáþë£(bxx˜áZ™ÕÕ~å¶a._[DÈÄ•ñEƒ½¥Â0¡í¡´ÀñЧ™—lÂL"E…#0vàq)žÙ Ô—r;)¢A)åm‚ÌØ³Àö teï«"Ã̩͘“’5s‘Õ 2¿4ƒc³)ŸüÎ,/îó÷Ïã®5#nçÖm‡„!Î¥$RŽAsë„Á: Ü{J- õd¹&µ¨© ñyìØµæp£ÏìŸåÑcÞ?¾„+«C#Ÿµä›ðyM-m‘°÷˜Í2¾57Åîv‹;JCüäÐU¹n§^ØyÙzZs,íóíNƒç¢6×­ªð¡ £”­M-æE˜5'ÂLÂqJ¦žïåìYèòÍ ¼0ÛæŽÍUÞwAeC±‹–ˆH4vj활ܮŸÏ5—¨I;ÕÌtr9ÒáÛûÛÌö2îÜVåÛ«,Š:ì„æ£8ýïÞt޼¢•j¾òlƒÏ<Ú†ê8Ó3st:aâ‡1¨ùÁõ?cf¹®ÁØÓKâ8f||œN»É]—ø{×TX7Q ‹ífÉX¼àø”÷šW$QBœOçd\!!Ÿ×í&x¦’‚ñšË³"Ù(™¨2Ï‘xwx°—tšðyàfŠû .§R¿šeþ è(ò‚M“kZ€tË0ëÑË4÷¾Ôâ¿>4ÏrŠ|`í—N”©›Š‹B‚â@(úp!î½Ðï[ÂHÉ Ãx±¬¥–µ1ßfªÍgvÏ Ú1ocS©B%’t)] ¢^SŠÝ}¬ßãÞùŽ´;¼·ZçšR•¥qlmï'¥¬i¥€ÓiÊ—›s<žµxÛÆ!®ZZeSÝä‹& «¶°Ï̵9¢WªÔr`ï|—?9<Ïc§[\»®Ä›Ël/0RЬ@óf—ÝNˈ¦=V2Vë‹Á0}/×¼8Ùã‹/6Ø=ÕãÒµ%Þº­Âª‘˜qÛ¢ØçFȉ ?ÇLÄ44ØyªÏo?Üd×Ù„()röÌá½ÓÀ;€Ç_—3ƒë/ËÌ`„øÏ¿§”¢V«‘Ä1%¼i“æ=—VY7‘x¸‡¡ì<žøT01Â×´÷K\Óò±ÌÃdñ¶:8”.NH-‹ìƒ$ÍÔ8“¼@„Køb'#Qž1P›‡árŒ©¡‹ ó€fª‘sÏ M~°«Ã¢¬Àm+†¸~I•R¤ÁŸX'ÐA+~‰Å>ÅÝÃ_b »¬<í_¦ÍÑ:M¶¸ïXƒ¸]à¦ú[K·&Zi|Ç´ð:xìëvx¡Õàt·Ãޤĭ•!VÄ& ¥Hðmþ—Æ0›e<Ôi²3êP¸ni•Ë'Ê %‘¯w‚¯ž —OvRžlòìL‡¨œ±yq[7TX=;ǵ®’{þAˆ“µ]Ã<×Oyò¸iƒtª±qq›6•¸de‘ÅC‘¥¿ê²Ú úçŽuùÒ3-<ÑÉ"Z­&½^_†ñ³ÀçìâÿÑõ¿ÂÌrÕ€ß~6Š"J¥ã£uÆ >zUw_:D%9ši/‘2±G#Ѐ>Mˆ_²¨|(+ÑmúÜØžËiÖæùJÏíñ©¨%„š-„çŽXCm~í4<0¾BárÒ½àò-„ŒGÝØÈ“ów?×àØäÆEU~ië„éGöÐŽ8þÂbˆ°¤O.ck†!³Ž© Ÿ×qähŒp;ÛIùÁ©&ÿm÷,›“ï[Äxœ Be»æÊ> Þ“tÏé¬Ïý ³ìo7¹½Tç=Õ:E9/¶|>\ëH™ðÖ\žq(íñÇ9ÚC9Û2Æ%c÷laD0%Ž€;Ô ²ë£"“ØÎrÎv2¾}r‡§lOøÀö!.XTð¹”Ø®©¡ícÛŽ&Ìg›½œÃsnó}miÎTø©Ë†X1;´'™eg›¿õÐ<+0×/pæì4yž ¤þ=àŸMþ®ÿf–kð§Àe`r»Ñ9-Mù•Ûêl^R Tð¶‰!z µc…@#»Ž˜öób?K'C³°JøÄ,hn´§ ×â6`¤0EOÈ6³EÖ‘h|a…;×-°_¤ÓáŒÍ IDAT¶þY|Á Êßa“wI|‘l9m™8Âv2e°=ñ‘é>¿þÝYöéóáu£¼eEñRlB5¹w`%QPÇo¸/ZŽ>Ër+ñpøµarŒYC“¬,>ÝÉøä®3ì<Ýç=#‹¹¸Ze(¶i0Ú?(ÓþT19 (ÜÏ£ý._9ËB·ÇÏÕǸ°Pf4Šœ†U„Q‡ºkMx¢ÓâsY&Æ#Þµa˜‹ÆÊŒcŠ Cp2¿LûN7¡w{®ŸqÏÑy¾vlóǼ{[óÆÓu4öÃ(ŽAe ïH.‚DL+IÓLsÿ¡÷ìnñÔÉ./òÛ*\±¦D½¤xpO=Ü`Úí6óóórÓ§€÷‡øß¸þ*Ì,×ÍÀ×€ÑB¡@­Vc¤ñÎ #îÜV`ûÊ¢ •¸âåA˜Sš^›["i¯•ˆ"<„õ÷–u7Ù:¸{GJJ´»IØÁ{“EjXU>^9N2—‹A«A,$V; §Ý$v.ïkŒ uß+mþèG ¨FÄÛV óöÕuJBdÐÓÏÝÉ×$œØ¥7Bóµ›èˆ–A{\Þ{üt‹óââ ,¶4ÂÅ•¥(r‰EæXø¯5z~Ô˜'Ê2΋ÜP®²Üz¿Å7 Œ,«%»ß×ðD·Åi‹ÖPÎKK\½¨ÂÚZÁZ.ÊiuÅk:WðÍ÷2žšîðìL›YÝg¢®¸im™ó*Šâðó3„¥hÈ›f^9ì›îóä‰ßÛßâð|ÊŠñ {¦cÚ}M£Ñ Ë2€Yà]À¯Ý™¿üÿU¾l¯CÀo3yžßÖívi÷röÏ–xho‡é…>®4ÇvâˆZáý ^šæ—v)yËˆQd´R¤0qå+=Æ„ppHŠGâH9§–8ÑÒÌG¦ÏÍHr÷°Ò_£Ü½ŒÝîu]¤¤ÔçcKi¨@79Oh@˜!òÂ¥b¢Ø¼´ÀçU¨ÔøÒ~¨Á’rÂjK´‚¯†¾!_˜î³ÁwU0ÆÈog:)ŸÙ=ÍÏòÖ+*üß·ŽpÞ†˜??6ÇΙë‹e*‘éi"7éaz¨ÈZ'¶–«LKü¨×æîÆm³©P¢¤¢`Mt@3抬I \šTX—9>òù£³íõÙ6Z¢Gn/°ë ñyçá{hãÙÞ8Tä²± ›k%ÚmÅݯ6ùÊî…D±a,1=Ì0 rtB…³í+B¿‹ª1•DñБ>ÇÒŽÍåÌ-4C/õ?îðW¼þ:4sxÿãBgdd„J¥Âx4ǯÞ>ÌÕëKÔÊ‘-Gô¡ÑÂâ‘˼Úi Mš!+iÍ{^Êú‰‚Û£VOó{.ð¥Çxky1×ÖêŒÆ&]bÂò…G®Á½]Åñ~?š9Íáv‡_ªs]¥Êh»,8²¼Ð¯|4µæ÷fx$kò®Muî\]g¢”P° cRRqhA¾çϘØÏ=5Ýæw÷Îp¦ßçT¹mc…åõØu¤…@Á(\’Œ8Îò¦;_ÝÝá3O·)Ö†™šš’ôK€/ÿ˜û_沿àúëff¹6w(¥ SàÆõŠ;·¸nc™¡’Q!´’ 7ï ÂUaoû.œÚÂY)"—L.ç- „R>n,ýÉÎ] ѡնVFV8›T\ÂpŽHܦcbð–‚„He^¡#/t–@kÍÎ}¾ô£žÞÛãÍ‹‡xÛê:êÅzðÈþ:¨D«È%ï"‘uÚ=×åOϳ/ïðî+j¼mG•RA˜Ô‡A±çTÏ?¶À+¯æÜTã’ÊCQ„¤…p™àïFÇ´Bz©ÝâÑÆQšqC©Ê-•£‘=®6øl€'‚ûjŽôûÜÛnðJÔaå’7/«qñx™r$wxe„JýØD±(LKá§§;|çø§z}VŽÇ\·¦ÈeËKŒUAè5Œ”b¾›ñ½]þdoŸ—gŒ =??/{ð2ðN`/Í×ß3˽ïþD)U- ”ËeVŽW¹jE›zKe#¾€Ý˜‘taP]n$Þð~f‰ P1°a~Ï\aö—Ào±A Rpu?#Q+ödL÷ hÊ2-ãiœo@ 6tðÙ^f´‘®&Ê `@c†Ïç×èä¼x¢Çypž§2>¼aŒw®­SRjI•ré°nMÜûÒcKÊŒ5Õš/˜ãë'æ¹~{‰÷^6ÄšñąؼÑ—Ÿ*ÌQ¬»Ž÷øãÇ›ìÞ=6ÁŽrÍÃ{÷­p†x!§$!HÓÖšCß›¦Ÿ¦¼¯6ÂmÕ!7Fa8Éô“ñ›e4ïŸÌRžéµ¹?mhÞ³v˜kWw[²ìM®mž€õ»¤ö¤My¿ŸkNµSšlò£é6g³>·mªòçUXT¬‚1)½íðé'8•39פÝîˆ]ÜÂ8·¾}¹þµ]“Ì,WøÀ¿(‹ŒSÎfùÕÛ‡yÓÖ2•Bd Ðwô´É—Ú;žÂÎ#Š s¨ÍÀ2—À!¯™-Æ®-ã UÊ%2àà©/x÷k?&É=©zÒµvºR(e^!šØì‘E‹6Ùc‘HY¦VŠN_óå5ø­ûg¹¸^áãÛ&ØT/9ï¹v³÷ÚFVD I1÷x«Ï¿Ûu–“ôøwoçòµe”2A@.^*8_„YÃ,Ó|íù¿ÿÐÛÒ:wO0'€Ô/Á—€ °PsìuøÜÔ$y?ã_Œ.ââb™²Rn/ä,,qrå@ßzá#]­ù~»Á[˜¡>ñ‹ŒsÙX…R¢,Ì6_ÌsMÆ ò覼0Ë4ìYèòéW¦xòL‹;·TùÐŽ!Æ«1¿ýÄß>ARbrr2ä_~“–þ7vý8˜Y® Lü­q3<{Û^{s'¼äÎMa”k8<ÕçOžnðÌž”ó{u®®3‘$ŽÂ¡hdï¯öD©0©žOµx¥Ób…V\’”¸¤TaÈ:ÓÂlа”üÔÐEóX§ÅÝz.\^âÚÅUÖ]1‡ŒFD¡ /™»»Éœ;Ôìó;»§xn®ƒ*U8Û‰h·Ût:.múà£À4?†ë¯Ã›ý—½ÚÀwk­oët:cÝ~Æ‘ù˜Nyrß+Gc–Ǿ¿ë o‰FÂZ˜NIÖ­Xï©õÚ}Æ@º‹HrJHŒ6§Y8íN”N³A†!$«mríþö±¯X(.ÝŽÓ åÆïzò÷,íBi¢Ïä^£Õˆ+Ö•Ù¾¦Èžf—Ïíœc¾—³u¸DÙzvebƒ¢ÑÏùãCó|zÏ«7*>vs7œW¡Z4‰å®ÒHÆ%# M™Ÿ Jc•b¬sņ2ç¯Jx±Ùâ+‡fˆQ,/”(*päæ»êœÜkçšb‰m•*Ý(â[­¾×œ§E¬IŠ”‰ÄJžs\£ Pl(¹¶TceVà™³¾tbŽ]ó6Ô‹Œ$…6\våZdÑ]n¹[âÊÏL·ùþé§U3ómZ­–T5íÞüŽ¥ûËõãÔÌç>÷=À"˜¾ÝIÞå=Û5¿pc‘ªÁÖƒ-}LNÉÞ’l+ØbKù¢I¨Á`4rÎ++ÒÌ6¼¶§’¹·op(ɦãˆñ~Sæ–é ñî{™†,5çÿŠí/Î4w¤F[綺Lο¨'¥ŸZ™®(bf„G³h­Ù3ÙçŸmšÖ,|æÊe¬­šË+`¦—óOŸ>ÅL’ò…ŸYÂò‘ˆ<δ¬dI´_H(¹^‚p¤ïV™±iLW×,7öÇtø×_Ÿa¬UâcËXšv–.+^Pù‡‰Ébü&´¥€Gšó|þì$×+üÌÐ(+“‚É&³ß’°a¢"\—;vâSYÆgç§y ßä®Mu~fÓ£cÝÇ•ïXÚȬ‰p²Ýç×_šâ‡ â(âìÔ”„™zÀ?ãoÈ.þ][Ì,W ø7ÀǪÕ*•J…ÕÃ)?ui›/¨°l8všèÜãlLÁ…·wsí“æÅŽ"å>«­d•0”Äœ]O¯uÌHB~dÇ žs¹—ÖøãPí½Å%6˜ap?q!æP{‹²[ܘtÂ\á‡rM•£Ék`ô¹Dá:–ÚŸ2F¹$έ·ö>¹ï™…”»Ÿoñà‹]6´†¸¬2ĪBÉe°ÉšDœ3‡p|fZ„Ió|¨1Ç‹­ÇEn±çh•^Ç4+¼ä°<÷á´ÏŸ6çÙ§z¬_Rà+jl-3^4¶– Ž4×Xèñð™6_>Þål–°°°àZöŸ°´ÜåoéúÛff¹–_Þ(­‹Æê%6õyÿå%Þº½æóÛØwñ6­ØÎ‹¬½æ’0„8žÂÂwopy½ˆæÚ…â¨C“«Vƒµ®’&nxïºemÔÛÚK6Ï}E—|×Ûë_ímÀÃÓ}¾ùb‹'_é1’'œêõ¹hsw^ZcËÒ‚ëÃ,2mª…äÞÒ2 ì –áøE¡OŸ {²NûϦ|ãù&?x¶ÇF]厑q–&koûtP·¶xÔ%Z[|!8›¦<Ûjðtcž*æÃC£\P,áÝdŠTçVz?Š•”fo´)Á|²Û摬I»¬¹}Õo_]§–DL÷RþðÀÏÁþ¦¦Ñ2}ª­6¾£<^×ßf–ë L|z%˜“)‹IÌåKüë;FÙ°Èd?¥¹a4±‰$Þ+\θÍÌúEKþ k›ÿÀt¥|!iÏ+çNið'xX—qÆ·?77‹c•~‡I#r¿X©NŒÂ,¡›ZkÜ!ÝçjGÜøÅqå+­šÝœÿ÷[³üôÕCìXUDŽLÉ­ß!‰ƒg»>Z{/»tX¨®Qd™hi﨔–=¡õ) èµ6‡ýÛTsàLÊ?ÿÚ»§üââå\Q«S°Žƒ\çîû¢EãsHUþ’̶\Ã9¾·0Ë]˜bi=áCçò¹Wç™/ 3??:·ŽcJŸþ‹ÉùÇ{ý]cf0ò§0žï¨T*144ÄD%ãý—Dܱ­ÂÚñÄiÛ0ÙD ¸<ø÷³ÜÃQ)Á3¿›Ë_4»Ùrñ*;§Ó|æ žù¤¹£¤‹FɘS@ ìÓ=Ð|?ÂÙ®.¥RÆeÇ(YlŽñDK"¨Â›—á§]­r’𗤞úê+3Ó<÷¿;/w ½i˜§±©¯¡©ô2¸û¹&_ùQ“±¹2·ÕÇX_,›ºd§ŒÝJ+¥ßFÛ'»ç*ÉQ6qc…44š7P«…jMë×Åq& ]Å~—yž[Þ)÷“ùG‘Ø”¦è>‰ÅÖõ°Vªœ´c0~†`œVàå¹Mµ´kåƒ2÷‰ãà,c·>pÁò"Wm(1÷øê¡Yš=ÍŠb‰¢2bPZ3…\s.´WvÞ±RÔ¢˜íåçUªìKû|«5ÇÁ^ŸeIÂH;¶×Ø}SÞœˆLf)Ÿ_˜áÉ8‘ç¤YÆüü¼@êÿÜ<3¸[7®¿‹šùÜkðUàj¥ÃÃu†ª6Íñ‰w޳qQÁƇ‹ÕBá±5 „jmf¤¨ÃH{ÓŒßw‘dZûFñŒûœj·¶ñæo“Gn¼ßîœké¶h°ØæŸ»ÎÚ­–ËåiI„òÚQYbT r°ÚÏLóA¯ÉÃ=C¡%]Mp¡'Äay4#§+ ³z§¤ˆöy§ÙemÝ¡Á&§¹æÌBÆ'¿3Ës¯¤|`t WVëÎcéÜe“&—¾é’<¢ ZÁ©~?â¹ÆïªÔùùáq**rÑŠœþ~»É§Û ´ÆG9}ö,í¶‹*=¼8ö?¥Ö¿Åëÿf–ëzŒ=½¨T*166F•&ﻤÄ–Ø´$1Ì&n!Tù¶ƒÐ ÏTHŒ¡“EëàŒ¬ ¾ÙÝÔjÄÐ &ðÜçš;Lî¼´¾os¨9ÃAQˆz²½­lL†G¾ƒç Ià|˜#®‡Æ–šð°›uòmŽÝ²(ÿ3´çµ£~ý)!Þ|h÷5÷¾Üâ[`ñB…ëË£l)VÌqÈi‘…ÜV° ³ƒk]$Ka4ð¡n‡»ç¦8Õéð†R·T†ØR(ÑÕ9/ô:|5ír_§IR,†šø,&úÑץȿc×ÿIÌ Æ,ø¦2‹Z­F¹TdÓ∛ÖfüäC¬ó‰ùRKðA'P9‰ÀüŽ%ÒÁ2ä=GÞ¡óĆº”hA%š_9â"ÆæÂÛ‹Âôò·œž2 J»8,ø±cç&Lë˜Þ ¯ôH©½:Úd°¡Y)) !§üü8ñ÷ ÒÁÐ!˜¿ Ççìp¿¾òæl;ã/´øÆm&Zeîgu¡ä„“ÿʹEî]/,í8ûZ³·ÛâñÆ':.LŠ´•â©BÄ©~n¯:¸~Óñ#ãÿëï¢Íü?º4Æ{ø›Àò~¿I§Óål#gßÂ÷¿Ü`¨¨Ù´¸àì»ØÁTºkŠ^ôÇ} ùUKƒÉ‡™T¤,3Èé–¾ÌO¼Ý¹ö %rø¶ÜSÆêF¥}KJDe¬B´îÄËܴĉì„C=86¦Ex¶Váçh%×@øÍ¾fÆ8çe]„©ãÀ È2ù[ŠL”9U)EµÇé:SC c’˜¿ËÅö•%®ÝZâG³MþÿöÎ<Ȳê®ãŸsï}K¿î×ÝÓÝÌ‚ 30 ‹e#!BHB4 &j¬R V¥´„P–ZHY•TiE+¤Ô¤pIYD R’ !‚Ęƒ0`2l™ÃÌÐ3ݯ—·ß{üãœß9çö `Öîû«‚éî÷ÞÝÞùßöý}·<¿—‘8aµåö.©È)²ýšÜ‰rCvlµ}ÖË“ªƒìL{|m¶Áž±vÍÎ07?/í‰ÿ\„q­¸¸øäh³Ì e†ºèŒ8Ž¡ßëqá ŠO^Pãœã+TJA¶8´pÊ!t \Îd’&^¤FíãBÙ dð,|±´bYØê–Á\ Zû„Oîw-Ö ?­Ã!Ê|Æ>VÞâ‹‹ám´ 2ïV‰"û~í½€ð¾Ãg£”€uì=ë|üí•Ó{E.JÐ!uyEâë0Ä‘÷Ê¥ô3Í}?hòwÿi\ï‹j£œP®0ÅnsË-d1ðÖ[‘cÍgÏvZ<؜牬ŽcöîÝ+Ÿzø€$àpÉÑ®Ì`îáŒRW«UJ¥k'*¼g]Æ•gVY¿¼”+c‰†…e ©­‚,X1rå%‰3v™Ü¡Ü Ì"rˆ4¹J¼e—S\Z§(ÚÄ}‘S;B@¼‡ñ¶A (0ûFÁb»‘´.î6p*'%²ðƒ<×÷¾7 O\³äòÞéüçEå…¦LÍ^¬¹ÀcwìësÿÓ-¾¹¹ÅÊæï¯q|¹âW‚­ü&"°µ=ÏCÍy¶èŒ™~V«%¥¦Œ?ˆûöŽN9ÚÜìÿO^À´˜ÍöûýK{½ûæzìhsÏÖyÚ§­*SN‚:ªò™Z±a b[+ˆ¦X&é} càÈv(™ÁÚ‚£:$GÂÅí öѶ«ÊmÆ-5î£L)q¾Í8 ,4ÕŠnßÙ^÷ÿH,¹M:%‘FEÕ%Ì-n<’°óá… l NÙ•ò”HJ‰ïsá5,L*.^¹Ìdï]¯¸ÝúièÙed âìã+\tj•{m¾´m’fš±®Z¥¤"7VHî!æÒ”›'wqw·Ã”f²Ñ ÓéHñõî­çØJ<Œ²,óBÅ$.~0­–å2«ë]®{÷ï\[aYÍOJ]iɈQPgI”ıù²w‹bº¡w¸—«Ú·`n3 ^÷U\ðÃÎB6{ËZÑÔî>áf#±¹tŠÅAž@&LÆßDÄö-šFêy?GÌg̼66ìPT£¤áÂ'Ðþ^É#ÐäšÇwtøì½Ó´_‹ù…¡qN«Ö¨Ç1ŠÙ,cK§ÉWûhT«´ÚmfggeÜ|C¤·hd1*³Èi˜)''IÂÀÀCÕ„ó×*®<=áâ“HdÅÉS°?Ë‚5JìÝ6ð¨«p2‡dC0£0¸CkCe…aÙ„¿Z"â*†üa昒´²ñ·²× ¼I9È»³y‘óXZ÷šÊÇ®î¤ÁÁ\>AûG)ïÏe̓óiw(¿ë¸ oÁ{Âgb $´Ø=“ò'çù—ÿžc¢UåÃËÆègðp·Íi—ù~RölÃXâg^çQõ²˜•Ìý}3/«š$ õúãõ?=:Ͻ'“€Ä{veF‘OD9N1k!da¦”"3†D7 Ž:ÂPHÉi}!ùب‹cµ¹Á‡Çv¥ïWÓµ7ªmÆØ…²J‘(_×Îųx©¸Ë*òéÅÝÈ+¦;¯x"ÚáÁþ.¤20Ï+»¶çWÛ³½„L´"ÏRž¡Ô©e^”dÍÁ´©îlô¹é[3<¸¥ÃðØ{Û3Ó¤i†Öº¡ìù¦?Óâ“Å3¿‘ü M³,»¸ÝnÓîÁ¾l”;7OQMàØ‘˜ZÙ@é•(K–ï–ß›xÚ×w}©È4S˜{8¤ù´,ty5Ìbcß_*ƒÌBÎkŸ0³Ô?FI‚_ø€£üUJâýð:@+ågjG›û’æxˆ5•º¸xnsQö.p/\Ì#YÌÓƒw,aêØp'@ÑÅJY Åt3㿞ïrÇ“zÕQvNN27?'n |EjCYì–y¡L·`ˆ©×ë”řǕøÐiŠË6 0>;k•iæïaŠ5—H3GÔ/ÀéLØÚ–ÉlbK’Oø…%1¥´…hŠ¢y7ß5_XEóŸ ²Þe•X],gÞ¹ÛM1F ÐAi*ÏW7g̤víÚ%—ÖÇ´ÎÞ!}©ÉRVf‘*†øÓ`¨‹*å2'Œ+.?UñѳY>,øCïFK_n^¬¯(Qç¿*o‰´W 0O¸  çÞz«ä•Ɉ/…]CÚõOã^Ç}ÞüÙÆèA‰MËm\×GÜ—ðšÉYSQz—!WyÏùóÚXl7P ¼6|L=ÕÌø÷§ZÜõƒŒÇ_Iév{4›Mùþø Í–B™½¬Â°‡¾+Š"J¥+ÆGY?ÖåêfîS)b»êRgµŒ5 Ù?\IÆÆ²f ýŽXYe.L¤…å±Ì.Û×˦’¨®%RÈúQÆ5^Ø–`ÿFX’ó÷#â\d³>-¦ ÓœÙýÑù #l±›s¿-Ü(Ìý|÷ù_|¤Å ;'ôz}q©~pæy)K¡ÌûËFL}zÐI­ZâÂ5}>½©Îš±ØÔ§Ë~ÎS¬pl"v¹š–2ì•Úš>M€É‹ÒÊ+\¯¯Ib;V O8ËÉ'á@»Lµ'B0Š—f¾„–FÉÞëÛÆ+špu§©çI3ýå7Ç Ž”å¼…vWÁ‘Ÿ%&ÏÇL2ñØc¿ÚHùÒ#³ÜùtL¿Ÿ155%ßÑnL\üýó•/)”ùõ%ÂdBÿˆÊå2CCƒŒT4WYâÒSJl8¶ä5ž$o5CËç:|àꬒuI ”Tº¦´(ßñÑž 1IDAT|äÛ:ÍTÎrÊ92Ë"ÇõnºMBaQ9G=ÏJ"Ç’xÖ½²Ÿ«ìÅÅÞ›¶~Ü_hõ•Êÿ]kÍžÙŒ{Ÿjòõ­/싘™Ì ¸S‘X’qñI¡Ìo,ƒ˜vËk*• £õÇŽÄ\rbßø¹aŽ©ÇÆÚ8À†WéLûÖC±D^¹%Áã™P¤sååˆÖ]ÖZ€ n}tÄôæ_ã5d¾­µŽ„ŒÐZD-=ÞÚ5ˆîêL£•‡ ú|€lT÷gÏ\—y2ùMCBã²C_ÃO7¹}‹fëî˜×ö5BÌ›1yæÛúF±Êü“Éñ˜®¬s3¦vÙ2V”¦¹ñܳ¦L5‰<„Sùî 4Ó–S[9 ,ó}¥1Lˆåk«b}u@²gÕUû¹TÒC-Ùä4à×ÚôÇQÀ(j7̺ßäâÝrGó`… &$ˆíŽ“jíZ28MX#·^bï8‚n_³w.å3÷ÎððŽ ínéi›~ƒ³ÿñüB£ÊüæäbÌ´‚±(Š˜Ÿ€¬ËÅë"®<£Ä¹kÌüiy“ñ Žúá·ù-)”ùÍKŒ¡”ùk0®w­6ÀŠzÌÆãR~û‚'N”Ìì#En̉<î…Ê)ñiª¥P¢"gC>†·/8¥VÊ©»å”^{漆õd?zÖÓ-‰"G¶¬äkèÒñܲöÙxéD›íhn{lŽžÙ¶;¥1צÙtôïb¨¡ŽÊž#A e~ë2 |T \.311ÁLcš«7–ø‹†Œ=ÂK+TdÜcCº¯se (Î㥅œ0k `!tà<0PJÓä`ŽáÚ»µJ94WÕ¦ƒÄ—û¬ÆSðjK” s í”YP vÐ@ä¢yë²ç鎴†í»»\Wƒ—Ú£LNî y·þø†0 7)…2¿}YÜ ¼`dd„$Ž8y<ãšó+œ¿®Êè€IÙúCn»Œµt*‰2…TµÞ÷X>“í‘i"a–Û•že5/‰;ïÓf’Óîs ¢m®-ð¥ƒ!DqÉu„„‰(SæzvO»¶t¹ý‰í,azzZêÅ[0qñ³â YªR(ó\Ü %IB­Vcb¸Ê†ñ&Ÿ8o Ö ¸14’œ Ni\·¸ßÞÒ ºÌmöÉ€KrÌžUƺ«È÷‡ê0Î5õneǨú¿K¾Mj×a—“÷ò%(±À‡Ï´5_ùþ÷nÓ<÷ZJ§×—z£Ä÷“­ y R(ó•¦|òg`”uÕªUt[³¼o=üÁ¥#,¯Çı±r¢ÀB®ßM-",Ê+¨«Á ]–YÆÁêÀå–óJtd3ÇÃÇ1Á|jã:ǶqÙœÓ+¼Gå‰ë=y Èæ#qudcð(2 —GžksÃÝ3Ì©QöMM‡Äò|èôoe‰H¡ÌGÆ€/c‹144DµZå˜j—ßÜXá=§TX5ç\l×l¯óÌ&Ô¦Á•›ÂÄ”²1°8èhÏÚ !T§ø€óÇ];&8ÿ\\}c…-Ù‚lº÷ìm·˜ícm»zܺ¹Ã}Û2溚F£!o¾üpp®BŒÊ|pef Çz¥õzÁjºÑ.—o(såYC D¹†×ß‹µœ6Q…’ä”͈G¸)ޱ°øácTQ\iÒÐvˆ» ÉSžÃ+¿vm”™«…I¯‰òKž<ÓšW)·nnñЋežÙi[ÝnL<üKÀS‡âÁ/E)”ùà‹ÂXè¯å(Š'Qšës|îŠ1NZ^v™ìR¢ÈR“ÅŽ-^;Õ¸ÉïLÑTâˆõòµcgI#?£—jÛfh>SŠqîußÒ–JGXb%ݾ¾¸ÙZîŒy¢¿{¶6ùÂæÒAvíÚCš9ÊžcðîE\|¥PæC'àFàÁ”²FFFн&¿zV…+Ϫ²v¢Dy¢|! Á&s-VW¼b!?°gR>»-ÊlŒ+¤¡Ò»ùÒÊ׋ía\Ò«ŸAåᘙ†fWóÄË=nùŸ½`6Ÿ !â³ö¿ÎAxž…,B™½,Ç"\Ç1TJ%Ök.;Eññw1V3ôíayG2È Ùp(¶¯éŠ{®„=e~\¶9kîÉøå_·)„Ùl —j6ÿ¸ÃmÿÛåÑ—;§;´Zmñr?¦þþÚ¡y¤…@¡Ì‡SÎÆÄÓ«£(bppñÑ:åîk|êâa®8cˆjYù2“u·C¨¤²YfÒ‘¥ö‰|YK€)‚·.Çj¿/}á½Ø¶@f™iÒ€`¬Ž‚ùvÆçîŸá?vTØÝè2ÝhH3ÄK˜âñƒýð Ù_ e>¼¾DJ)V®\I»Õä¼Õ×¾{ˆ“——¨•múI†²–Ø$¯ÌkB(˜i[~Âg®¿¨Z‡“ëu-p&ï·ØîéVÊwžïrÓ·›¼Ö`jzZ’[}LËè­­‰‡M e>2døsà÷ÀteU*&†Þµ¦Ë¯7ĆUeíåÛ ÅUöÍ"B’àÐZ™@0••äÍÁ[_~šs@«—ñÀ3mîy&å{;`¦Õc~~^Ð[_ÀäZrX¥Pæ#K~ “õ¾ Š"’$a|lCÌñëç–ùÄÆ:ƒ•È(tæ_~›O˜™Æ Ó­E€2¤ƒ¹17:ØŸK1€¯?µ³Ç_<0ÃssuvMÎÒô,˜ßÁPö¼rèS!¯'…2™r>&ž^®”bÙ²edYÆê¡×_RçÂõU†Ê‘K€¹º°öE£L{z] ,†(ÎOÉ~¯ÔÖ®÷Ì¥ÜöX›Û·j:Tyå§³{0õâïò§RÈJ¡ÌG®ÄÀo P­VM9k 欕]>|F O ^q i_r…¦â–@ùµÖŽRx×LŸ;ŸhsïvÅ3¯vév:´|WÓ5d[ÑšxJ¡ÌG¾ 7W+¥H’„±±1¢.ç®êqãå˘2ô|2BYæOƒýVÎË^‚iã(€Ðtûp÷–y¾ü½6»Û5ö웡Óé˜å€ßæùÝòK¡ÌG¬ÅàšÏ3Z§Z­RIg¹nÓ ü™Ëbú¶…2‰}\lÄOÀ:² ¾žzµÇ_=4Ë£¯–ÑDLNNŠoÆt5ýèÐÞj!oE e>ºD›0|d£¥R‰ÁÁA•qîjÅUg–yïi5G,–ò­Œ¢ÌÛvw¹kK›û~»gRZ­–”š¦ß><·YÈ[‘B™NI0Ô:Ÿ ­Õ˜*ñó«;\ÿÞVÔÓklážB ”ÁZßüÈ ÷ny©Óz½žXãk¿ÁÔŽ 9ФPæ£[F0\Y(•J¬\±‚êMnx_•w[¢l›%2­éö5[^éqí×§hèFHÙs+†Û¬ñú§*äH—B™‡œ‚éJ:5Š"†‡ëŒ (®8³Æ¦5ë——xvO—»žìrßö”f?ajjJ ˜OcJMÛç òö¥PæÅ# 3Tü6 V*•¨²vyJ6K‹Avìí0?ߢßï!“¿ 3ǸhM,¤#PJÀ Xr‘r¹¬W®\©•i|–ÿn°ï+¤BŽþ¯ÀÚþ>~8/ªB yër:ð-àg÷…rpåÿˆ*«}A×IEND®B`‚ggforce/man/figures/lifecycle-archived.svg0000644000176200001440000000170714672274110020361 0ustar liggesusers lifecyclelifecyclearchivedarchived ggforce/man/figures/lifecycle-defunct.svg0000644000176200001440000000170414672274110020221 0ustar liggesuserslifecyclelifecycledefunctdefunct ggforce/man/figures/lifecycle-maturing.svg0000644000176200001440000000170614672274110020421 0ustar liggesuserslifecyclelifecyclematuringmaturing ggforce/man/position_jitternormal.Rd0000644000176200001440000000452214672274110017375 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/position-jitternormal.R \name{position_jitternormal} \alias{position_jitternormal} \title{Jitter points with normally distributed random noise} \usage{ position_jitternormal(sd_x = NULL, sd_y = NULL, seed = NA) } \arguments{ \item{sd_x, sd_y}{Standard deviation to add along the x and y axes. The function uses \code{\link[stats:Normal]{stats::rnorm()}} with \code{mean = 0} behind the scenes. If omitted, defaults to 0.15. As with \code{\link[ggplot2:geom_jitter]{ggplot2::geom_jitter()}}, categorical data is aligned on the integers, so a standard deviation of more than 0.2 will spread the data so it's not possible to see the distinction between the categories.} \item{seed}{A random seed to make the jitter reproducible. Useful if you need to apply the same jitter twice, e.g., for a point and a corresponding label. The random seed is reset after jittering. If \code{NA} (the default value), the seed is initialised with a random value; this makes sure that two subsequent calls start with a different seed. Use \code{NULL} to use the current random seed and also avoid resetting (the behaviour of \pkg{ggplot} 2.2.1 and earlier).} } \description{ \code{\link[ggplot2:geom_jitter]{ggplot2::geom_jitter()}} adds random noise to points using a uniform distribution. When many points are plotted, they appear in a rectangle. This position jitters points using a normal distribution instead, resulting in more circular clusters. } \examples{ # Example data df <- data.frame( x = sample(1:3, 1500, TRUE), y = sample(1:3, 1500, TRUE) ) # position_jitter results in rectangular clusters ggplot(df, aes(x = x, y = y)) + geom_point(position = position_jitter()) # geom_jitternormal results in more circular clusters ggplot(df, aes(x = x, y = y)) + geom_point(position = position_jitternormal()) # You can adjust the standard deviations along both axes # Tighter circles ggplot(df, aes(x = x, y = y)) + geom_point(position = position_jitternormal(sd_x = 0.08, sd_y = 0.08)) # Oblong shapes ggplot(df, aes(x = x, y = y)) + geom_point(position = position_jitternormal(sd_x = 0.2, sd_y = 0.08)) # Only add random noise to one dimension ggplot(df, aes(x = x, y = y)) + geom_point( position = position_jitternormal(sd_x = 0.15, sd_y = 0), alpha = 0.1 ) } \concept{position adjustments} ggforce/man/geom_delvor.Rd0000644000176200001440000003113015024476446015244 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/voronoi.R \name{geom_voronoi} \alias{geom_voronoi} \alias{geom_delaunay} \alias{geom_voronoi_tile} \alias{geom_voronoi_segment} \alias{geom_delaunay_tile} \alias{geom_delaunay_segment} \alias{geom_delaunay_segment2} \alias{stat_delvor_summary} \title{Voronoi tesselation and delaunay triangulation} \usage{ geom_voronoi_tile( mapping = NULL, data = NULL, stat = "voronoi_tile", position = "identity", na.rm = FALSE, bound = NULL, eps = 1e-09, max.radius = NULL, normalize = FALSE, asp.ratio = 1, expand = 0, radius = 0, show.legend = NA, inherit.aes = TRUE, ... ) geom_voronoi_segment( mapping = NULL, data = NULL, stat = "voronoi_segment", position = "identity", na.rm = FALSE, bound = NULL, eps = 1e-09, normalize = FALSE, asp.ratio = 1, show.legend = NA, inherit.aes = TRUE, ... ) geom_delaunay_tile( mapping = NULL, data = NULL, stat = "delaunay_tile", position = "identity", na.rm = FALSE, bound = NULL, eps = 1e-09, normalize = FALSE, asp.ratio = 1, expand = 0, radius = 0, show.legend = NA, inherit.aes = TRUE, ... ) geom_delaunay_segment( mapping = NULL, data = NULL, stat = "delaunay_segment", position = "identity", na.rm = FALSE, bound = NULL, eps = 1e-09, normalize = FALSE, asp.ratio = 1, show.legend = NA, inherit.aes = TRUE, ... ) geom_delaunay_segment2( mapping = NULL, data = NULL, stat = "delaunay_segment2", position = "identity", na.rm = FALSE, bound = NULL, eps = 1e-09, normalize = FALSE, asp.ratio = 1, n = 100, show.legend = NA, inherit.aes = TRUE, ... ) stat_delvor_summary( mapping = NULL, data = NULL, geom = "point", position = "identity", na.rm = FALSE, bound = NULL, eps = 1e-09, normalize = FALSE, asp.ratio = 1, show.legend = NA, inherit.aes = TRUE, ... ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \item{bound}{The bounding rectangle for the tesselation or a custom polygon to clip the tesselation to. Defaults to \code{NULL} which creates a rectangle expanded 10\\% in all directions. If supplied as a bounding box it should be a vector giving the bounds in the following order: xmin, xmax, ymin, ymax. If supplied as a polygon it should either be a 2-column matrix or a data.frame containing an \code{x} and \code{y} column.} \item{eps}{A value of epsilon used in testing whether a quantity is zero, mainly in the context of whether points are collinear. If anomalous errors arise, it is possible that these may averted by adjusting the value of eps upward or downward.} \item{max.radius}{The maximum distance a tile can extend from the point of origin. Will in effect clip each tile to a circle centered at the point with the given radius. If \code{normalize = TRUE} the radius will be given relative to the normalized values} \item{normalize}{Should coordinates be normalized prior to calculations. If \code{x} and \code{y} are in wildly different ranges it can lead to tesselation and triangulation that seems off when plotted without \code{\link[ggplot2:coord_fixed]{ggplot2::coord_fixed()}}. Normalization of coordinates solves this. The coordinates are transformed back after calculations.} \item{asp.ratio}{If \code{normalize = TRUE} the x values will be multiplied by this amount after normalization.} \item{expand}{A numeric or unit vector of length one, specifying the expansion amount. Negative values will result in contraction instead. If the value is given as a numeric it will be understood as a proportion of the plot area width.} \item{radius}{As \code{expand} but specifying the corner radius.} \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{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{n}{The number of points to create for each segment} \item{geom}{The geometric object to use to display the data for this layer. When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument can be used to override the default coupling between stats and geoms. The \code{geom} argument accepts the following: \itemize{ \item A \code{Geom} ggproto subclass, for example \code{GeomPoint}. \item A string naming the geom. To give the geom as a string, strip the function name of the \code{geom_} prefix. For example, to use \code{geom_point()}, give the geom as \code{"point"}. \item For more information and other ways to specify the geom, see the \link[ggplot2:layer_geoms]{layer geom} documentation. }} } \description{ This set of geoms and stats allows you to display voronoi tesselation and delaunay triangulation, both as polygons and as line segments. Furthermore it lets you augment your point data with related summary statistics. The computations are based on the \code{\link[deldir:deldir]{deldir::deldir()}} package. } \section{Aesthetics}{ geom_voronoi_tile and geom_delaunay_tile understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x} \item \strong{y} \item alpha \item color \item fill \item linetype \item size } geom_voronoi_segment, geom_delaunay_segment, and geom_delaunay_segment2 understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x} \item \strong{y} \item alpha \item color \item linetype \item size } } \section{Computed variables}{ stat_delvor_summary computes the following variables: \describe{ \item{x, y}{If \code{switch.centroid = TRUE} this will be the coordinates for the voronoi tile centroid, otherwise it is the original point} \item{xcent, ycent}{If \code{switch.centroid = FALSE} this will be the coordinates for the voronoi tile centroid, otherwise it will be \code{NULL}} \item{xorig, yorig}{If \code{switch.centroid = TRUE} this will be the coordinates for the original point, otherwise it will be \code{NULL}} \item{ntri}{Number of triangles emanating from the point} \item{triarea}{The total area of triangles emanating from the point divided by 3} \item{triprop}{\code{triarea} divided by the sum of the area of all triangles} \item{nsides}{Number of sides on the voronoi tile associated with the point} \item{nedges}{Number of sides of the associated voronoi tile that is part of the bounding box} \item{vorarea}{The area of the voronoi tile associated with the point} \item{vorprop}{\code{vorarea} divided by the sum of all voronoi tiles} } } \examples{ \dontshow{if (requireNamespace("deldir", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # Voronoi # You usually wants all points to take part in the same tesselation so set # the group aesthetic to a constant (-1L is just a convention) ggplot(iris, aes(Sepal.Length, Sepal.Width, group = -1L)) + geom_voronoi_tile(aes(fill = Species)) + geom_voronoi_segment() + geom_text(aes(label = after_stat(nsides), size = after_stat(vorarea)), stat = 'delvor_summary', switch.centroid = TRUE ) # Difference of normalize = TRUE (segment layer is calculated without # normalisation) ggplot(iris, aes(Sepal.Length, Sepal.Width, group = -1L)) + geom_voronoi_tile(aes(fill = Species), normalize = TRUE) + geom_voronoi_segment() # Set a max radius ggplot(iris, aes(Sepal.Length, Sepal.Width, group = -1L)) + geom_voronoi_tile(aes(fill = Species), colour = 'black', max.radius = 0.25) # Set custom bounding polygon triangle <- cbind(c(3, 9, 6), c(1, 1, 6)) ggplot(iris, aes(Sepal.Length, Sepal.Width, group = -1L)) + geom_voronoi_tile(aes(fill = Species), colour = 'black', bound = triangle) # Use geom_shape functionality to round corners etc ggplot(iris, aes(Sepal.Length, Sepal.Width, group = -1L)) + geom_voronoi_tile(aes(fill = Species), colour = 'black', expand = unit(-.5, 'mm'), radius = unit(2, 'mm')) # Delaunay triangles ggplot(iris, aes(Sepal.Length, Sepal.Width)) + geom_delaunay_tile(alpha = 0.3, colour = 'black') # Use geom_delauney_segment2 to interpolate aestetics between end points ggplot(iris, aes(Sepal.Length, Sepal.Width)) + geom_delaunay_segment2(aes(colour = Species, group = -1), size = 2, lineend = 'round') \dontshow{\}) # examplesIf} } ggforce/man/theme_no_axes.Rd0000644000176200001440000000132414672274110015552 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/themes.R \name{theme_no_axes} \alias{theme_no_axes} \title{Theme without axes and gridlines} \usage{ theme_no_axes(base.theme = theme_bw()) } \arguments{ \item{base.theme}{The theme to use as a base for the new theme. Defaults to \code{\link[ggplot2:ggtheme]{ggplot2::theme_bw()}}.} } \value{ A modified version of base.theme } \description{ This theme is a simple wrapper around any complete theme that removes the axis text, title and ticks as well as the grid lines for plots where these have little meaning. } \examples{ p <- ggplot() + geom_point(aes(x = wt, y = qsec), data = mtcars) p + theme_no_axes() p + theme_no_axes(theme_grey()) } ggforce/man/geom_sina.Rd0000644000176200001440000003000315024476446014701 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sina.R \name{geom_sina} \alias{geom_sina} \alias{stat_sina} \title{Sina plot} \usage{ stat_sina( mapping = NULL, data = NULL, geom = "point", position = "dodge", scale = "area", method = "density", bw = "nrd0", kernel = "gaussian", maxwidth = NULL, adjust = 1, bin_limit = 1, binwidth = NULL, bins = NULL, seed = NA, jitter_y = TRUE, ..., na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE ) geom_sina( mapping = NULL, data = NULL, stat = "sina", position = "dodge", ..., na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{The geometric object to use to display the data for this layer. When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument can be used to override the default coupling between stats and geoms. The \code{geom} argument accepts the following: \itemize{ \item A \code{Geom} ggproto subclass, for example \code{GeomPoint}. \item A string naming the geom. To give the geom as a string, strip the function name of the \code{geom_} prefix. For example, to use \code{geom_point()}, give the geom as \code{"point"}. \item For more information and other ways to specify the geom, see the \link[ggplot2:layer_geoms]{layer geom} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{scale}{How should each sina be scaled. Corresponds to the \code{scale} parameter in \code{\link[ggplot2:geom_violin]{ggplot2::geom_violin()}}? Available are: \itemize{ \item \code{'area'} for scaling by the largest density/bin among the different sinas \item \code{'count'} as above, but in addition scales by the maximum number of points in the different sinas. \item \code{'width'} Only scale according to the \code{maxwidth} parameter } For backwards compatibility it can also be a logical with \code{TRUE} meaning \code{area} and \code{FALSE} meaning \code{width}} \item{method}{Choose the method to spread the samples within the same bin along the x-axis. Available methods: "density", "counts" (can be abbreviated, e.g. "d"). See \code{Details}.} \item{bw}{The smoothing bandwidth to be used. If numeric, the standard deviation of the smoothing kernel. If character, a rule to choose the bandwidth, as listed in \code{\link[stats:bandwidth]{stats::bw.nrd()}}. Note that automatic calculation of the bandwidth does not take weights into account.} \item{kernel}{Kernel. See list of available kernels in \code{\link[=density]{density()}}.} \item{maxwidth}{Control the maximum width the points can spread into. Values between 0 and 1.} \item{adjust}{A multiplicate bandwidth adjustment. This makes it possible to adjust the bandwidth while still using the a bandwidth estimator. For example, \code{adjust = 1/2} means use half of the default bandwidth.} \item{bin_limit}{If the samples within the same y-axis bin are more than \code{bin_limit}, the samples's X coordinates will be adjusted.} \item{binwidth}{The width of the bins. The default is to use \code{bins} bins that cover the range of the data. You should always override this value, exploring multiple widths to find the best to illustrate the stories in your data.} \item{bins}{Number of bins. Overridden by binwidth. Defaults to 50.} \item{seed}{A seed to set for the jitter to ensure a reproducible plot} \item{jitter_y}{If y is integerish banding can occur and the default is to jitter the values slightly to make them better distributed. Setting \code{jitter_y = FALSE} turns off this behaviour} \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \item{orientation}{The orientation of the layer. The default (\code{NA}) automatically determines the orientation from the aesthetic mapping. In the rare event that this fails it can be given explicitly by setting \code{orientation} to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} \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{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} } \description{ The sina plot is a data visualization chart suitable for plotting any single variable in a multiclass dataset. It is an enhanced jitter strip chart, where the width of the jitter is controlled by the density distribution of the data within each class. } \details{ There are two available ways to define the x-axis borders for the samples to spread within: \itemize{ \item{\code{method == "density"} A density kernel is estimated along the y-axis for every sample group, and the samples are spread within that curve. In effect this means that points will be positioned randomly within a violin plot with the same parameters. } \item{\code{method == "counts"}: The borders are defined by the number of samples that occupy the same bin. } } } \section{Aesthetics}{ geom_sina understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x} \item \strong{y} \item color \item group \item size \item alpha } } \section{Computed variables}{ \describe{ \item{density}{The density or sample counts per bin for each point} \item{scaled}{\code{density} scaled by the maximum density in each group} \item{n}{The number of points in the group the point belong to} } } \section{Orientation}{ This geom treats each axis differently and, thus, can thus have two orientations. Often the orientation is easy to deduce from a combination of the given mappings and the types of positional scales in use. Thus, ggplot2 will by default try to guess which orientation the layer should have. Under rare circumstances, the orientation is ambiguous and guessing may fail. In that case the orientation can be specified directly using the \code{orientation} parameter, which can be either \code{"x"} or \code{"y"}. The value gives the axis that the geom should run along, \code{"x"} being the default orientation you would expect for the geom. } \examples{ ggplot(midwest, aes(state, area)) + geom_point() # Boxplot and Violin plots convey information on the distribution but not the # number of samples, while Jitter does the opposite. ggplot(midwest, aes(state, area)) + geom_violin() ggplot(midwest, aes(state, area)) + geom_jitter() # Sina does both! ggplot(midwest, aes(state, area)) + geom_violin() + geom_sina() p <- ggplot(midwest, aes(state, popdensity)) + scale_y_log10() p + geom_sina() # Colour the points based on the data set's columns p + geom_sina(aes(colour = inmetro)) # Or any other way cols <- midwest$popdensity > 10000 p + geom_sina(colour = cols + 1L) # Sina plots with continuous x: ggplot(midwest, aes(cut_width(area, 0.02), popdensity)) + geom_sina() + scale_y_log10() ### Sample gaussian distributions # Unimodal a <- rnorm(500, 6, 1) b <- rnorm(400, 5, 1.5) # Bimodal c <- c(rnorm(200, 3, .7), rnorm(50, 7, 0.4)) # Trimodal d <- c(rnorm(200, 2, 0.7), rnorm(300, 5.5, 0.4), rnorm(100, 8, 0.4)) df <- data.frame( 'Distribution' = c( rep('Unimodal 1', length(a)), rep('Unimodal 2', length(b)), rep('Bimodal', length(c)), rep('Trimodal', length(d)) ), 'Value' = c(a, b, c, d) ) # Reorder levels df$Distribution <- factor( df$Distribution, levels(df$Distribution)[c(3, 4, 1, 2)] ) p <- ggplot(df, aes(Distribution, Value)) p + geom_boxplot() p + geom_violin() + geom_sina() # By default, Sina plot scales the width of the class according to the width # of the class with the highest density. Turn group-wise scaling off with: p + geom_violin() + geom_sina(scale = FALSE) } \author{ Nikos Sidiropoulos, Claus Wilke, and Thomas Lin Pedersen } ggforce/man/scale_depth.Rd0000644000176200001440000000231714672274110015212 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scale-depth.R \name{scale_depth} \alias{scale_depth} \alias{scale_depth_continuous} \alias{scale_depth_discrete} \title{Scales for depth perception} \usage{ scale_depth(..., range = c(0, 0.3)) scale_depth_continuous(..., range = c(0, 0.3)) scale_depth_discrete(..., range = c(0, 0.3)) } \arguments{ \item{...}{arguments passed on to continuous_scale or discrete_scale} \item{range}{The relative range as related to the distance between the eyes and the paper plane.} } \description{ These scales serve to scale the depth aesthetic when creating stereographic plots. The range specifies the relative distance between the points and the paper plane in relation to the distance between the eyes and the paper plane i.e. a range of c(-0.5, 0.5) would put the highest values midways between the eyes and the image plane and the lowest values the same distance behind the image plane. To ensure a nice viewing experience these values should not exceed ~0.3 as it would get hard for the eyes to consolidate the two pictures. } \examples{ ggplot(mtcars) + geom_point(aes(mpg, disp, depth = cyl)) + scale_depth(range = c(-0.1, 0.25)) + facet_stereo() } ggforce/man/interpolateDataFrame.Rd0000644000176200001440000000061414672274110017030 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/interpolate.R \name{interpolateDataFrame} \alias{interpolateDataFrame} \title{Interpolate layer data} \usage{ interpolateDataFrame(data) } \arguments{ \item{data}{A data.frame with data for a layer} } \value{ A similar data.frame with NA values interpolated } \description{ Interpolate layer data } \keyword{internal} ggforce/man/position_auto.Rd0000644000176200001440000000330514672274110015631 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/position_auto.R \name{position_auto} \alias{position_auto} \title{Jitter based on scale types} \usage{ position_auto(jitter.width = 0.75, bw = "nrd0", scale = TRUE, seed = NA) } \arguments{ \item{jitter.width}{The maximal width of the jitter} \item{bw}{The smoothing bandwidth to use in the case of sina jittering. See the \code{bw} argument in \link[stats:density]{stats::density}} \item{scale}{Should the width of jittering be scaled based on the number of points in the group} \item{seed}{A seed to supply to make the jittering reproducible across layers} } \description{ This position adjustment is able to select a meaningful jitter of the data based on the combination of positional scale types. IT behaves differently depending on if none, one, or both the x and y scales are discrete. If both are discrete it will jitter the datapoints evenly inside a disc, if one of them is discrete it will jitter the discrete dimension to follow the density along the other dimension (like a sina plot). If neither are discrete it will not do any jittering. } \examples{ # Continuous vs continuous: No jitter ggplot(mpg) + geom_point(aes(cty, hwy), position = 'auto') # Continuous vs discrete: sina jitter ggplot(mpg) + geom_point(aes(cty, drv), position = 'auto') # Discrete vs discrete: disc-jitter ggplot(mpg) + geom_point(aes(fl, drv), position = 'auto') # Don't scale the jitter based on group size ggplot(mpg) + geom_point(aes(cty, drv), position = position_auto(scale = FALSE)) ggplot(mpg) + geom_point(aes(fl, drv), position = position_auto(scale = FALSE)) } \seealso{ \link{geom_autopoint} for a point geom that uses auto-position by default } ggforce/man/geom_mark_ellipse.Rd0000644000176200001440000003146515024476446016433 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mark_ellipse.R \name{geom_mark_ellipse} \alias{geom_mark_ellipse} \title{Annotate areas with ellipses} \usage{ geom_mark_ellipse( mapping = NULL, data = NULL, stat = "identity", position = "identity", expand = unit(5, "mm"), radius = expand, n = 100, tol = 0.01, label.margin = margin(2, 2, 2, 2, "mm"), label.width = NULL, label.minwidth = unit(50, "mm"), label.hjust = 0, label.fontsize = 12, label.family = "", label.lineheight = 1, label.fontface = c("bold", "plain"), label.fill = "white", label.colour = "black", label.buffer = unit(10, "mm"), con.colour = "black", con.size = 0.5, con.type = "elbow", con.linetype = 1, con.border = "one", con.cap = unit(3, "mm"), con.arrow = NULL, ..., na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{expand}{A numeric or unit vector of length one, specifying the expansion amount. Negative values will result in contraction instead. If the value is given as a numeric it will be understood as a proportion of the plot area width.} \item{radius}{As \code{expand} but specifying the corner radius.} \item{n}{The number of points used to draw each ellipse. Defaults to \code{100}.} \item{tol}{The tolerance cutoff. Lower values will result in ellipses closer to the optimal solution. Defaults to \code{0.01}.} \item{label.margin}{The margin around the annotation boxes, given by a call to \code{\link[ggplot2:element]{ggplot2::margin()}}.} \item{label.width}{A fixed width for the label. Set to \code{NULL} to let the text or \code{label.minwidth} decide.} \item{label.minwidth}{The minimum width to provide for the description. If the size of the label exceeds this, the description is allowed to fill as much as the label.} \item{label.hjust}{The horizontal justification for the annotation. If it contains two elements the first will be used for the label and the second for the description.} \item{label.fontsize}{The size of the text for the annotation. If it contains two elements the first will be used for the label and the second for the description.} \item{label.family}{The font family used for the annotation. If it contains two elements the first will be used for the label and the second for the description.} \item{label.lineheight}{The height of a line as a multipler of the fontsize. If it contains two elements the first will be used for the label and the second for the description.} \item{label.fontface}{The font face used for the annotation. If it contains two elements the first will be used for the label and the second for the description.} \item{label.fill}{The fill colour for the annotation box. Use \code{"inherit"} to use the fill from the enclosure or \code{"inherit_col"} to use the border colour of the enclosure.} \item{label.colour}{The text colour for the annotation. If it contains two elements the first will be used for the label and the second for the description. Use \code{"inherit"} to use the border colour of the enclosure or \code{"inherit_fill"} to use the fill colour from the enclosure.} \item{label.buffer}{The size of the region around the mark where labels cannot be placed.} \item{con.colour}{The colour for the line connecting the annotation to the mark. Use \code{"inherit"} to use the border colour of the enclosure or \code{"inherit_fill"} to use the fill colour from the enclosure.} \item{con.size}{The width of the connector. Use \code{"inherit"} to use the border width of the enclosure.} \item{con.type}{The type of the connector. Either \code{"elbow"}, \code{"straight"}, or \code{"none"}.} \item{con.linetype}{The linetype of the connector. Use \code{"inherit"} to use the border linetype of the enclosure.} \item{con.border}{The bordertype of the connector. Either \code{"one"} (to draw a line on the horizontal side closest to the mark), \code{"all"} (to draw a border on all sides), or \code{"none"} (not going to explain that one).} \item{con.cap}{The distance before the mark that the line should stop at.} \item{con.arrow}{An arrow specification for the connection using \code{\link[grid:arrow]{grid::arrow()}} for the end pointing towards the mark.} \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \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()}}.} } \description{ This geom lets you annotate sets of points via ellipses. The enclosing ellipses are estimated using the Khachiyan algorithm which guarantees an optimal solution within the given tolerance level. As this geom is often expanded it is of lesser concern that some points are slightly outside the ellipsis. The Khachiyan algorithm has polynomial complexity and can thus suffer from scaling issues. Still, it is only calculated on the convex hull of the groups, so performance issues should be rare (it can easily handle a hull consisting of 1000 points). } \section{Aesthetics}{ \code{geom_mark_ellipse} understands the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x} \item \strong{y} \item x0 \emph{(used to anchor the label)} \item y0 \emph{(used to anchor the label)} \item filter \item label \item description \item color \item fill \item group \item size \item linetype \item alpha } } \section{Annotation}{ All \verb{geom_mark_*} allow you to put descriptive textboxes connected to the mark on the plot, using the \code{label} and \code{description} aesthetics. The textboxes are automatically placed close to the mark, but without obscuring any of the datapoints in the layer. The placement is dynamic so if you resize the plot you'll see that the annotation might move around as areas become big enough or too small to fit the annotation. If there's not enough space for the annotation without overlapping data it will not get drawn. In these cases try resizing the plot, change the size of the annotation, or decrease the buffer region around the marks. } \section{Filtering}{ Often marks are used to draw attention to, or annotate specific features of the plot and it is thus not desirable to have marks around everything. While it is possible to simply pre-filter the data used for the mark layer, the \verb{geom_mark_*} geoms also comes with a dedicated \code{filter} aesthetic that, if set, will remove all rows where it evalutates to \code{FALSE}. There are multiple benefits of using this instead of prefiltering. First, you don't have to change your data source, making your code more adaptable for exploration. Second, the data removed by the filter aesthetic is remembered by the geom, and any annotation will take care not to overlap with the removed data. } \examples{ ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_ellipse(aes(fill = Species, filter = Species != 'versicolor')) + geom_point() # Add annotation ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_ellipse(aes(fill = Species, label = Species)) + geom_point() # Long descriptions are automatically wrapped to fit into the width iris$desc <- c( 'A super Iris - and it knows it', 'Pretty mediocre Iris, but give it a couple of years and it might surprise you', "You'll never guess what this Iris does every Sunday" )[iris$Species] ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_ellipse(aes(fill = Species, label = Species, description = desc, filter = Species == 'setosa')) + geom_point() # Change the buffer size to move labels farther away (or closer) from the # marks ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_ellipse(aes(fill = Species, label = Species), label.buffer = unit(40, 'mm')) + geom_point() # The connector is capped a bit before it reaches the mark, but this can be # controlled ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_ellipse(aes(fill = Species, label = Species), con.cap = 0) + geom_point() # If you want to use the scaled colours for the labels or connectors you can # use the "inherit" keyword instead ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_ellipse(aes(fill = Species, label = Species), label.fill = "inherit") + geom_point() } \seealso{ Other mark geoms: \code{\link{geom_mark_circle}()}, \code{\link{geom_mark_hull}()}, \code{\link{geom_mark_rect}()} } \concept{mark geoms} ggforce/man/geom_mark_rect.Rd0000644000176200001440000003031415024476446015723 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mark_rect.R \name{geom_mark_rect} \alias{geom_mark_rect} \title{Annotate areas with rectangles} \usage{ geom_mark_rect( mapping = NULL, data = NULL, stat = "identity", position = "identity", expand = unit(5, "mm"), radius = unit(2.5, "mm"), label.margin = margin(2, 2, 2, 2, "mm"), label.width = NULL, label.minwidth = unit(50, "mm"), label.hjust = 0, label.fontsize = 12, label.family = "", label.lineheight = 1, label.fontface = c("bold", "plain"), label.fill = "white", label.colour = "black", label.buffer = unit(10, "mm"), con.colour = "black", con.size = 0.5, con.type = "elbow", con.linetype = 1, con.border = "one", con.cap = unit(3, "mm"), con.arrow = NULL, ..., na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{expand}{A numeric or unit vector of length one, specifying the expansion amount. Negative values will result in contraction instead. If the value is given as a numeric it will be understood as a proportion of the plot area width.} \item{radius}{As \code{expand} but specifying the corner radius.} \item{label.margin}{The margin around the annotation boxes, given by a call to \code{\link[ggplot2:element]{ggplot2::margin()}}.} \item{label.width}{A fixed width for the label. Set to \code{NULL} to let the text or \code{label.minwidth} decide.} \item{label.minwidth}{The minimum width to provide for the description. If the size of the label exceeds this, the description is allowed to fill as much as the label.} \item{label.hjust}{The horizontal justification for the annotation. If it contains two elements the first will be used for the label and the second for the description.} \item{label.fontsize}{The size of the text for the annotation. If it contains two elements the first will be used for the label and the second for the description.} \item{label.family}{The font family used for the annotation. If it contains two elements the first will be used for the label and the second for the description.} \item{label.lineheight}{The height of a line as a multipler of the fontsize. If it contains two elements the first will be used for the label and the second for the description.} \item{label.fontface}{The font face used for the annotation. If it contains two elements the first will be used for the label and the second for the description.} \item{label.fill}{The fill colour for the annotation box. Use \code{"inherit"} to use the fill from the enclosure or \code{"inherit_col"} to use the border colour of the enclosure.} \item{label.colour}{The text colour for the annotation. If it contains two elements the first will be used for the label and the second for the description. Use \code{"inherit"} to use the border colour of the enclosure or \code{"inherit_fill"} to use the fill colour from the enclosure.} \item{label.buffer}{The size of the region around the mark where labels cannot be placed.} \item{con.colour}{The colour for the line connecting the annotation to the mark. Use \code{"inherit"} to use the border colour of the enclosure or \code{"inherit_fill"} to use the fill colour from the enclosure.} \item{con.size}{The width of the connector. Use \code{"inherit"} to use the border width of the enclosure.} \item{con.type}{The type of the connector. Either \code{"elbow"}, \code{"straight"}, or \code{"none"}.} \item{con.linetype}{The linetype of the connector. Use \code{"inherit"} to use the border linetype of the enclosure.} \item{con.border}{The bordertype of the connector. Either \code{"one"} (to draw a line on the horizontal side closest to the mark), \code{"all"} (to draw a border on all sides), or \code{"none"} (not going to explain that one).} \item{con.cap}{The distance before the mark that the line should stop at.} \item{con.arrow}{An arrow specification for the connection using \code{\link[grid:arrow]{grid::arrow()}} for the end pointing towards the mark.} \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \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()}}.} } \description{ This geom lets you annotate sets of points via rectangles. The rectangles are simply scaled to the range of the data and as with the other \verb{geom_mark_*()} geoms expanded and have rounded corners. } \section{Aesthetics}{ \code{geom_mark_rect} understands the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x} \item \strong{y} \item x0 \emph{(used to anchor the label)} \item y0 \emph{(used to anchor the label)} \item filter \item label \item description \item color \item fill \item group \item size \item linetype \item alpha } } \section{Annotation}{ All \verb{geom_mark_*} allow you to put descriptive textboxes connected to the mark on the plot, using the \code{label} and \code{description} aesthetics. The textboxes are automatically placed close to the mark, but without obscuring any of the datapoints in the layer. The placement is dynamic so if you resize the plot you'll see that the annotation might move around as areas become big enough or too small to fit the annotation. If there's not enough space for the annotation without overlapping data it will not get drawn. In these cases try resizing the plot, change the size of the annotation, or decrease the buffer region around the marks. } \section{Filtering}{ Often marks are used to draw attention to, or annotate specific features of the plot and it is thus not desirable to have marks around everything. While it is possible to simply pre-filter the data used for the mark layer, the \verb{geom_mark_*} geoms also comes with a dedicated \code{filter} aesthetic that, if set, will remove all rows where it evalutates to \code{FALSE}. There are multiple benefits of using this instead of prefiltering. First, you don't have to change your data source, making your code more adaptable for exploration. Second, the data removed by the filter aesthetic is remembered by the geom, and any annotation will take care not to overlap with the removed data. } \examples{ ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_rect(aes(fill = Species, filter = Species != 'versicolor')) + geom_point() # Add annotation ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_rect(aes(fill = Species, label = Species)) + geom_point() # Long descriptions are automatically wrapped to fit into the width iris$desc <- c( 'A super Iris - and it knows it', 'Pretty mediocre Iris, but give it a couple of years and it might surprise you', "You'll never guess what this Iris does every Sunday" )[iris$Species] ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_rect(aes(fill = Species, label = Species, description = desc, filter = Species == 'setosa')) + geom_point() # Change the buffer size to move labels farther away (or closer) from the # marks ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_rect(aes(fill = Species, label = Species), label.buffer = unit(30, 'mm')) + geom_point() # The connector is capped a bit before it reaches the mark, but this can be # controlled ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_rect(aes(fill = Species, label = Species), con.cap = 0) + geom_point() # If you want to use the scaled colours for the labels or connectors you can # use the "inherit" keyword instead ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_rect(aes(fill = Species, label = Species), label.fill = "inherit") + geom_point() } \seealso{ Other mark geoms: \code{\link{geom_mark_circle}()}, \code{\link{geom_mark_ellipse}()}, \code{\link{geom_mark_hull}()} } \concept{mark geoms} ggforce/man/geom_circle.Rd0000644000176200001440000001733115024476446015221 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/circle.R \name{geom_circle} \alias{geom_circle} \alias{stat_circle} \title{Circles based on center and radius} \usage{ stat_circle( mapping = NULL, data = NULL, geom = "circle", position = "identity", n = 360, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) geom_circle( mapping = NULL, data = NULL, stat = "circle", position = "identity", n = 360, expand = 0, radius = 0, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{The geometric object to use to display the data for this layer. When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument can be used to override the default coupling between stats and geoms. The \code{geom} argument accepts the following: \itemize{ \item A \code{Geom} ggproto subclass, for example \code{GeomPoint}. \item A string naming the geom. To give the geom as a string, strip the function name of the \code{geom_} prefix. For example, to use \code{geom_point()}, give the geom as \code{"point"}. \item For more information and other ways to specify the geom, see the \link[ggplot2:layer_geoms]{layer geom} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{n}{The number of points on the generated path per full circle.} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \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{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} \item{expand}{A numeric or unit vector of length one, specifying the expansion amount. Negative values will result in contraction instead. If the value is given as a numeric it will be understood as a proportion of the plot area width.} \item{radius}{As \code{expand} but specifying the corner radius.} } \description{ This set of stats and geoms makes it possible to draw circles based on a center point and a radius. In contrast to using \code{\link[ggplot2:geom_point]{ggplot2::geom_point()}}, the size of the circles are related to the coordinate system and not to a separate scale. These functions are intended for cartesian coordinate systems and will only produce a true circle if \code{\link[ggplot2:coord_fixed]{ggplot2::coord_fixed()}} is used. } \note{ If the intend is to draw a bubble chart then use \code{\link[ggplot2:geom_point]{ggplot2::geom_point()}} and map a variable to the size scale } \section{Aesthetics}{ geom_circle understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x0} \item \strong{y0} \item \strong{r} \item color \item fill \item linewidth \item linetype \item alpha \item lineend } } \section{Computed variables}{ \describe{ \item{x, y}{The start coordinates for the segment} } } \examples{ # Lets make some data circles <- data.frame( x0 = rep(1:3, 3), y0 = rep(1:3, each = 3), r = seq(0.1, 1, length.out = 9) ) # Behold some circles ggplot() + geom_circle(aes(x0 = x0, y0 = y0, r = r, fill = r), data = circles) # Use coord_fixed to ensure true circularity ggplot() + geom_circle(aes(x0 = x0, y0 = y0, r = r, fill = r), data = circles) + coord_fixed() } \seealso{ \code{\link[=geom_arc_bar]{geom_arc_bar()}} for drawing arcs with fill } ggforce/man/stat_err.Rd0000644000176200001440000001353615024476446014577 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/errorbar.R \name{stat_err} \alias{stat_err} \title{Intervals in vertical and horizontal directions} \usage{ stat_err( mapping = NULL, data = NULL, geom = "segment", position = "identity", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{The geometric object to use to display the data for this layer. When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument can be used to override the default coupling between stats and geoms. The \code{geom} argument accepts the following: \itemize{ \item A \code{Geom} ggproto subclass, for example \code{GeomPoint}. \item A string naming the geom. To give the geom as a string, strip the function name of the \code{geom_} prefix. For example, to use \code{geom_point()}, give the geom as \code{"point"}. \item For more information and other ways to specify the geom, see the \link[ggplot2:layer_geoms]{layer geom} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \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{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} } \description{ \code{stat_err} draws intervals of points (\code{x}, \code{y}) in vertical (\code{ymin}, \code{ymax}) and horizontal (\code{xmin}, \code{xmax}) directions. } \section{Aesthetics}{ \code{stat_err()} understands the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x} \item \strong{xmin} \item \strong{xmax} \item \strong{y} \item \strong{ymin} \item \strong{ymax} \item alpha \item color \item group \item linetype \item linewidth } } \examples{ library(ggplot2) x <- 1:3 xmin <- x - 2.5 xmax <- x + 2.5 d <- data.frame( x = x, y = x, xmin = xmin, ymin = xmin, xmax = xmax, ymax = xmax, color = as.factor(x) ) ggplot( d, aes(x = x, y = y, xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, color = color) ) + stat_err(size = 2) } ggforce/man/shapeGrob.Rd0000644000176200001440000000350014672274110014644 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/shape.R \name{shapeGrob} \alias{shapeGrob} \title{The grob powering geom_shape} \usage{ shapeGrob( x = c(0, 0.5, 1, 0.5), y = c(0.5, 1, 0.5, 0), id = NULL, id.lengths = NULL, expand = 0, radius = 0, default.units = "npc", name = NULL, gp = gpar(), vp = NULL ) } \arguments{ \item{x}{A numeric vector or unit object specifying x-locations.} \item{y}{A numeric vector or unit object specifying y-locations.} \item{id}{A numeric vector used to separate locations in \code{x} and \code{y} into multiple polygons. All locations with the same \code{id} belong to the same polygon.} \item{id.lengths}{A numeric vector used to separate locations in \code{x} and \code{y} into multiple polygons. Specifies consecutive blocks of locations which make up separate polygons.} \item{expand}{An expansion size to expand each shape with, given in units or a numeric refering to \code{default.units}} \item{radius}{The corner radius to apply to each shape, given in units or a numeric refering to \code{default.units}} \item{default.units}{A string indicating the default units to use if \code{x}, \code{y}, \code{width}, or \code{height} are only given as numeric vectors.} \item{name}{ A character identifier. } \item{gp}{An object of class \code{"gpar"}, typically the output from a call to the function \code{\link[grid]{gpar}}. This is basically a list of graphical parameter settings.} \item{vp}{A Grid viewport object (or NULL).} } \value{ A grob of class \code{shape} or, of \code{expand} and \code{radius} are \code{0} a regular polygon grob } \description{ This is the underlying grob constructor for \code{\link[=geom_shape]{geom_shape()}}. It is exported for others to use but with limited support } \keyword{internal} ggforce/man/geom_arc.Rd0000644000176200001440000002247715024476446014534 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/arc.R \name{geom_arc} \alias{geom_arc} \alias{stat_arc} \alias{stat_arc2} \alias{geom_arc2} \alias{stat_arc0} \alias{geom_arc0} \title{Arcs based on radius and radians} \usage{ stat_arc( mapping = NULL, data = NULL, geom = "arc", position = "identity", na.rm = FALSE, show.legend = NA, n = 360, inherit.aes = TRUE, ... ) geom_arc( mapping = NULL, data = NULL, stat = "arc", position = "identity", n = 360, arrow = NULL, lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) stat_arc2( mapping = NULL, data = NULL, geom = "path_interpolate", position = "identity", na.rm = FALSE, show.legend = NA, n = 360, inherit.aes = TRUE, ... ) geom_arc2( mapping = NULL, data = NULL, stat = "arc2", position = "identity", n = 360, arrow = NULL, lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) stat_arc0( mapping = NULL, data = NULL, geom = "arc0", position = "identity", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) geom_arc0( mapping = NULL, data = NULL, stat = "arc0", position = "identity", ncp = 5, arrow = NULL, lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ... ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{The geometric object to use to display the data for this layer. When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument can be used to override the default coupling between stats and geoms. The \code{geom} argument accepts the following: \itemize{ \item A \code{Geom} ggproto subclass, for example \code{GeomPoint}. \item A string naming the geom. To give the geom as a string, strip the function name of the \code{geom_} prefix. For example, to use \code{geom_point()}, give the geom as \code{"point"}. \item For more information and other ways to specify the geom, see the \link[ggplot2:layer_geoms]{layer geom} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \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{n}{the smoothness of the arc. Sets the number of points to use if the arc would cover a full circle} \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{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} \item{arrow}{Arrow specification, as created by \code{\link[grid:arrow]{grid::arrow()}}.} \item{lineend}{Line end style (round, butt, square).} \item{ncp}{the number of control points used to draw the arc with curveGrob. Determines how well the arc approximates a circle section} } \description{ This set of stats and geoms makes it possible to draw circle segments based on a center point, a radius and a start and end angle (in radians). These functions are intended for cartesian coordinate systems and makes it possible to create circular plot types without using the \code{\link[ggplot2:coord_polar]{ggplot2::coord_polar()}} coordinate system. } \details{ An arc is a segment of a line describing a circle. It is the fundamental visual element in donut charts where the length of the segment (and conversely the angular span of the segment) describes the proportion of an entety. } \section{Aesthetics}{ geom_arc understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x0} \item \strong{y0} \item \strong{r} \item \strong{start} \item \strong{end} \item color \item linewidth \item linetype \item alpha \item lineend } } \section{Computed variables}{ \describe{ \item{x, y}{The start coordinates for the segment} \item{xend, yend}{The end coordinates for the segment} \item{curvature}{The curvature of the curveGrob to match a circle} } } \examples{ # Lets make some data arcs <- data.frame( start = seq(0, 2 * pi, length.out = 11)[-11], end = seq(0, 2 * pi, length.out = 11)[-1], r = rep(1:2, 5) ) # Behold the arcs ggplot(arcs) + geom_arc(aes(x0 = 0, y0 = 0, r = r, start = start, end = end, linetype = factor(r))) # Use the calculated index to map values to position on the arc ggplot(arcs) + geom_arc(aes(x0 = 0, y0 = 0, r = r, start = start, end = end, size = after_stat(index)), lineend = 'round') # The 0 version maps directly to curveGrob instead of calculating the points # itself ggplot(arcs) + geom_arc0(aes(x0 = 0, y0 = 0, r = r, start = start, end = end, linetype = factor(r))) # The 2 version allows interpolation of aesthetics between the start and end # points arcs2 <- data.frame( angle = c(arcs$start, arcs$end), r = rep(arcs$r, 2), group = rep(1:10, 2), colour = sample(letters[1:5], 20, TRUE) ) ggplot(arcs2) + geom_arc2(aes(x0 = 0, y0 = 0, r = r, end = angle, group = group, colour = colour), size = 2) } \seealso{ \code{\link[=geom_arc_bar]{geom_arc_bar()}} for drawing arcs with fill } ggforce/man/geom_mark_hull.Rd0000644000176200001440000003214015024476446015731 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mark_hull.R \name{geom_mark_hull} \alias{geom_mark_hull} \title{Annotate areas with hulls} \usage{ geom_mark_hull( mapping = NULL, data = NULL, stat = "identity", position = "identity", expand = unit(5, "mm"), radius = unit(2.5, "mm"), concavity = 2, label.margin = margin(2, 2, 2, 2, "mm"), label.width = NULL, label.minwidth = unit(50, "mm"), label.hjust = 0, label.fontsize = 12, label.family = "", label.lineheight = 1, label.fontface = c("bold", "plain"), label.fill = "white", label.colour = "black", label.buffer = unit(10, "mm"), con.colour = "black", con.size = 0.5, con.type = "elbow", con.linetype = 1, con.border = "one", con.cap = unit(3, "mm"), con.arrow = NULL, ..., na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{expand}{A numeric or unit vector of length one, specifying the expansion amount. Negative values will result in contraction instead. If the value is given as a numeric it will be understood as a proportion of the plot area width.} \item{radius}{As \code{expand} but specifying the corner radius.} \item{concavity}{A measure of the concavity of the hull. \code{1} is very concave while it approaches convex as it grows. Defaults to \code{2}.} \item{label.margin}{The margin around the annotation boxes, given by a call to \code{\link[ggplot2:element]{ggplot2::margin()}}.} \item{label.width}{A fixed width for the label. Set to \code{NULL} to let the text or \code{label.minwidth} decide.} \item{label.minwidth}{The minimum width to provide for the description. If the size of the label exceeds this, the description is allowed to fill as much as the label.} \item{label.hjust}{The horizontal justification for the annotation. If it contains two elements the first will be used for the label and the second for the description.} \item{label.fontsize}{The size of the text for the annotation. If it contains two elements the first will be used for the label and the second for the description.} \item{label.family}{The font family used for the annotation. If it contains two elements the first will be used for the label and the second for the description.} \item{label.lineheight}{The height of a line as a multipler of the fontsize. If it contains two elements the first will be used for the label and the second for the description.} \item{label.fontface}{The font face used for the annotation. If it contains two elements the first will be used for the label and the second for the description.} \item{label.fill}{The fill colour for the annotation box. Use \code{"inherit"} to use the fill from the enclosure or \code{"inherit_col"} to use the border colour of the enclosure.} \item{label.colour}{The text colour for the annotation. If it contains two elements the first will be used for the label and the second for the description. Use \code{"inherit"} to use the border colour of the enclosure or \code{"inherit_fill"} to use the fill colour from the enclosure.} \item{label.buffer}{The size of the region around the mark where labels cannot be placed.} \item{con.colour}{The colour for the line connecting the annotation to the mark. Use \code{"inherit"} to use the border colour of the enclosure or \code{"inherit_fill"} to use the fill colour from the enclosure.} \item{con.size}{The width of the connector. Use \code{"inherit"} to use the border width of the enclosure.} \item{con.type}{The type of the connector. Either \code{"elbow"}, \code{"straight"}, or \code{"none"}.} \item{con.linetype}{The linetype of the connector. Use \code{"inherit"} to use the border linetype of the enclosure.} \item{con.border}{The bordertype of the connector. Either \code{"one"} (to draw a line on the horizontal side closest to the mark), \code{"all"} (to draw a border on all sides), or \code{"none"} (not going to explain that one).} \item{con.cap}{The distance before the mark that the line should stop at.} \item{con.arrow}{An arrow specification for the connection using \code{\link[grid:arrow]{grid::arrow()}} for the end pointing towards the mark.} \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \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()}}.} } \description{ This geom lets you annotate sets of points via hulls. While convex hulls are most common due to their clear definition, they can lead to large areas covered that does not contain points. Due to this \code{geom_mark_hull} uses concaveman which lets you adjust concavity of the resulting hull. The hull is calculated at draw time, and can thus change as you resize the plot. In order to clearly contain all points, and for aesthetic purpose the resulting hull is expanded 5mm and rounded on the corners. This can be adjusted with the \code{expand} and \code{radius} parameters. } \section{Aesthetics}{ \code{geom_mark_hull} understand the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x} \item \strong{y} \item x0 \emph{(used to anchor the label)} \item y0 \emph{(used to anchor the label)} \item filter \item label \item description \item color \item fill \item group \item size \item linetype \item alpha } } \section{Annotation}{ All \verb{geom_mark_*} allow you to put descriptive textboxes connected to the mark on the plot, using the \code{label} and \code{description} aesthetics. The textboxes are automatically placed close to the mark, but without obscuring any of the datapoints in the layer. The placement is dynamic so if you resize the plot you'll see that the annotation might move around as areas become big enough or too small to fit the annotation. If there's not enough space for the annotation without overlapping data it will not get drawn. In these cases try resizing the plot, change the size of the annotation, or decrease the buffer region around the marks. } \section{Filtering}{ Often marks are used to draw attention to, or annotate specific features of the plot and it is thus not desirable to have marks around everything. While it is possible to simply pre-filter the data used for the mark layer, the \verb{geom_mark_*} geoms also comes with a dedicated \code{filter} aesthetic that, if set, will remove all rows where it evalutates to \code{FALSE}. There are multiple benefits of using this instead of prefiltering. First, you don't have to change your data source, making your code more adaptable for exploration. Second, the data removed by the filter aesthetic is remembered by the geom, and any annotation will take care not to overlap with the removed data. } \examples{ ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_hull(aes(fill = Species, filter = Species != 'versicolor')) + geom_point() # Adjusting the concavity lets you change the shape of the hull ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_hull(aes(fill = Species, filter = Species != 'versicolor'), concavity = 1 ) + geom_point() ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_hull(aes(fill = Species, filter = Species != 'versicolor'), concavity = 10 ) + geom_point() # Add annotation ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_hull(aes(fill = Species, label = Species)) + geom_point() # Long descriptions are automatically wrapped to fit into the width iris$desc <- c( 'A super Iris - and it knows it', 'Pretty mediocre Iris, but give it a couple of years and it might surprise you', "You'll never guess what this Iris does every Sunday" )[iris$Species] ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_hull(aes(fill = Species, label = Species, description = desc, filter = Species == 'setosa')) + geom_point() # Change the buffer size to move labels farther away (or closer) from the # marks ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_hull(aes(fill = Species, label = Species), label.buffer = unit(40, 'mm')) + geom_point() # The connector is capped a bit before it reaches the mark, but this can be # controlled ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_hull(aes(fill = Species, label = Species), con.cap = 0) + geom_point() # If you want to use the scaled colours for the labels or connectors you can # use the "inherit" keyword instead ggplot(iris, aes(Petal.Length, Petal.Width)) + geom_mark_hull(aes(fill = Species, label = Species), label.fill = "inherit") + geom_point() } \seealso{ Other mark geoms: \code{\link{geom_mark_circle}()}, \code{\link{geom_mark_ellipse}()}, \code{\link{geom_mark_rect}()} } \concept{mark geoms} ggforce/man/facet_wrap_paginate.Rd0000644000176200001440000000754114672274110016726 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/facet_wrap_paginate.R \name{facet_wrap_paginate} \alias{facet_wrap_paginate} \title{Split facet_wrap over multiple plots} \usage{ facet_wrap_paginate( facets, nrow = NULL, ncol = NULL, scales = "fixed", shrink = TRUE, labeller = "label_value", as.table = TRUE, switch = deprecated(), drop = TRUE, dir = "h", strip.position = "top", page = 1 ) } \arguments{ \item{facets}{A set of variables or expressions quoted by \code{\link[ggplot2:vars]{vars()}} and defining faceting groups on the rows or columns dimension. The variables can be named (the names are passed to \code{labeller}). For compatibility with the classic interface, can also be a formula or character vector. Use either a one sided formula, \code{~a + b}, or a character vector, \code{c("a", "b")}.} \item{nrow, ncol}{Number of rows and columns} \item{scales}{Should scales be fixed (\code{"fixed"}, the default), free (\code{"free"}), or free in one dimension (\code{"free_x"}, \code{"free_y"})?} \item{shrink}{If \code{TRUE}, will shrink scales to fit output of statistics, not raw data. If \code{FALSE}, will be range of raw data before statistical summary.} \item{labeller}{A function that takes one data frame of labels and returns a list or data frame of character vectors. Each input column corresponds to one factor. Thus there will be more than one with \code{vars(cyl, am)}. Each output column gets displayed as one separate line in the strip label. This function should inherit from the "labeller" S3 class for compatibility with \code{\link[ggplot2:labeller]{labeller()}}. You can use different labeling functions for different kind of labels, for example use \code{\link[ggplot2:label_parsed]{label_parsed()}} for formatting facet labels. \code{\link[ggplot2:label_value]{label_value()}} is used by default, check it for more details and pointers to other options.} \item{as.table}{If \code{TRUE}, the default, the facets are laid out like a table with highest values at the bottom-right. If \code{FALSE}, the facets are laid out like a plot with the highest value at the top-right.} \item{switch}{By default, the labels are displayed on the top and right of the plot. If \code{"x"}, the top labels will be displayed to the bottom. If \code{"y"}, the right-hand side labels will be displayed to the left. Can also be set to \code{"both"}.} \item{drop}{If \code{TRUE}, the default, all factor levels not used in the data will automatically be dropped. If \code{FALSE}, all factor levels will be shown, regardless of whether or not they appear in the data.} \item{dir}{Direction: either \code{"h"} for horizontal, the default, or \code{"v"}, for vertical.} \item{strip.position}{By default, the labels are displayed on the top of the plot. Using \code{strip.position} it is possible to place the labels on either of the four sides by setting \code{strip.position = c("top", "bottom", "left", "right")}} \item{page}{The page to draw} } \description{ This extension to \code{\link[ggplot2:facet_wrap]{ggplot2::facet_wrap()}} will allow you to split a facetted plot over multiple pages. You define a number of rows and columns per page as well as the page number to plot, and the function will automatically only plot the correct panels. Usually this will be put in a loop to render all pages one by one. } \note{ If either \code{ncol} or \code{nrow} is \code{NULL} this function will fall back to the standard \code{facet_wrap} functionality. } \examples{ ggplot(diamonds) + geom_point(aes(carat, price), alpha = 0.1) + facet_wrap_paginate(~ cut:clarity, ncol = 3, nrow = 3, page = 4) } \seealso{ \code{\link[=n_pages]{n_pages()}} to compute the total number of pages in a paginated faceted plot Other ggforce facets: \code{\link{facet_grid_paginate}()}, \code{\link{facet_stereo}()}, \code{\link{facet_zoom}()} } \concept{ggforce facets} ggforce/DESCRIPTION0000644000176200001440000000444715024531642013407 0ustar liggesusersPackage: ggforce Type: Package Title: Accelerating 'ggplot2' Version: 0.5.0 Authors@R: c(person(given = "Thomas Lin", family = "Pedersen", role = c("cre", "aut"), email = "thomasp85@gmail.com", comment = c(ORCID = "0000-0002-5147-4711")), person("RStudio", role = "cph")) Maintainer: Thomas Lin Pedersen Description: The aim of 'ggplot2' is to aid in visual data investigations. This focus has led to a lack of facilities for composing specialised plots. 'ggforce' aims to be a collection of mainly new stats and geoms that fills this gap. All additional functionality is aimed to come through the official extension system so using 'ggforce' should be a stable experience. URL: https://ggforce.data-imaginist.com, https://github.com/thomasp85/ggforce BugReports: https://github.com/thomasp85/ggforce/issues License: MIT + file LICENSE Encoding: UTF-8 Depends: ggplot2 (>= 3.5.0), R (>= 3.3.0) Imports: grid, scales, MASS, tweenr (>= 0.1.5), gtable, rlang, polyclip, stats, grDevices, tidyselect, withr, utils, lifecycle, cli, vctrs, systemfonts RoxygenNote: 7.3.2 LinkingTo: cpp11 Suggests: sessioninfo, deldir, latex2exp, reshape2, units (>= 0.8.0), covr Collate: 'aaa.R' 'shape.R' 'arc_bar.R' 'arc.R' 'autodensity.R' 'autohistogram.R' 'autopoint.R' 'bezier.R' 'bspline.R' 'bspline_closed.R' 'circle.R' 'concaveman.R' 'cpp11.R' 'diagonal.R' 'diagonal_wide.R' 'ellipse.R' 'errorbar.R' 'facet_grid_paginate.R' 'facet_matrix.R' 'facet_row.R' 'facet_stereo.R' 'facet_wrap_paginate.R' 'facet_zoom.R' 'ggforce-package.R' 'ggproto-classes.R' 'interpolate.R' 'labeller.R' 'link.R' 'mark_circle.R' 'mark_ellipse.R' 'mark_hull.R' 'mark_label.R' 'mark_rect.R' 'parallel_sets.R' 'position-jitternormal.R' 'position_auto.R' 'position_floatstack.R' 'regon.R' 'scale-depth.R' 'scale-unit.R' 'sina.R' 'spiro.R' 'themes.R' 'trans.R' 'trans_linear.R' 'utilities.R' 'voronoi.R' 'zzz.R' NeedsCompilation: yes Packaged: 2025-06-18 12:00:16 UTC; thomas Author: Thomas Lin Pedersen [cre, aut] (ORCID: ), RStudio [cph] Repository: CRAN Date/Publication: 2025-06-18 12:40:02 UTC