diff --git a/DESCRIPTION b/DESCRIPTION index 1d8fa91..0f1a7aa 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -26,8 +26,9 @@ Suggests: rmarkdown, prettydoc, maps, - scales + scales, + cli VignetteBuilder: knitr License: Artistic-2.0 Encoding: UTF-8 -RoxygenNote: 7.3.0 +RoxygenNote: 7.3.1 diff --git a/NAMESPACE b/NAMESPACE index 538ef2a..c1c0207 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,7 +7,9 @@ importFrom(dplyr,bind_rows) importFrom(dplyr,group_by) importFrom(dplyr,group_split) importFrom(ggforce,geom_arc_bar) +importFrom(ggforce,geom_circle) importFrom(ggfun,get_aes_var) +importFrom(ggplot2,aes) importFrom(ggplot2,aes_) importFrom(ggplot2,geom_segment) importFrom(ggplot2,geom_text) diff --git a/R/geom_scatterpie.R b/R/geom_scatterpie.R index 4c94ab7..05b5f3a 100644 --- a/R/geom_scatterpie.R +++ b/R/geom_scatterpie.R @@ -8,14 +8,18 @@ ##' @param pie_scale amount to scale the pie size if there is no radius mapping exists ##' @param sorted_by_radius whether plotting large pie first ##' @param legend_name name of fill legend -##' @param long_format whether use long format of input data +##' @param long_format logical whether use long format of input data +##' @param donut_radius numeric the radius of donut chart (relative the radius of circle), default is NULL. +##' it should be between 0 and 1, if it is provided, the donut chart will be displayed instead of pie chart. +##' @param bg_circle_radius numeric the radius of background circle, default is FALSE, we suggest setting it +##' to between 1 and 1.5 . ##' @param ... additional parameters -##' @importFrom ggforce geom_arc_bar +##' @importFrom ggforce geom_arc_bar geom_circle ##' @importFrom utils modifyList ##' @importFrom tidyr gather ##' @importFrom rlang enquo ##' @importFrom rlang !! -##' @importFrom ggplot2 aes_ +##' @importFrom ggplot2 aes_ aes ##' @importFrom ggfun get_aes_var ##' @importFrom stats as.formula ##' @importFrom dplyr bind_rows group_by group_split @@ -30,8 +34,27 @@ ##' ggplot() + geom_scatterpie(aes(x=x, y=y), data=d, cols=c("A", "B", "C")) + coord_fixed() ##' d <- tidyr::gather(d, key="letters", value="value", -x:-y) ##' ggplot() + geom_scatterpie(aes(x=x, y=y), data=d, cols="letters", long_format=TRUE) + coord_fixed() +##' p1 <- ggplot() + +##' geom_scatterpie( +##' mapping = aes(x=x, y=y), data=d, cols="letters", +##' long_format=TRUE, +##' donut_radius=.5 +##' ) + +##' coord_fixed() +##' p1 +##' p2 <- ggplot() + +##' geom_scatterpie( +##' mapping = aes(x=x, y=y), data=d, cols="letters", +##' long_format=TRUE, +##' donut_radius = .5, +##' bg_circle_radius = 1.2 +##' ) + +##' coord_fixed() +##' p2 ##' @author Guangchuang Yu -geom_scatterpie <- function(mapping=NULL, data, cols, pie_scale = 1, sorted_by_radius = FALSE, legend_name = "type", long_format=FALSE, ...) { +geom_scatterpie <- function(mapping=NULL, data, cols, pie_scale = 1, + sorted_by_radius = FALSE, legend_name = "type", + long_format=FALSE, donut_radius=NULL, bg_circle_radius=NULL, ...) { if (is.null(mapping)) mapping <- aes_(x = ~x, y = ~y) mapping <- modifyList(mapping, @@ -45,6 +68,16 @@ geom_scatterpie <- function(mapping=NULL, data, cols, pie_scale = 1, sorted_by_r size <- diff(range(data[, xvar]))/ 50 * pie_scale data$r <- size mapping <- modifyList(mapping, aes_(r=size)) + if (!is.null(donut_radius)){ + donut_radius <- .check_donut_radius(donut_radius) + mapping <- modifyList(mapping, aes_(r0 = ~size * donut_radius)) + } + }else{ + if (!is.null(donut_radius)){ + rvar <- get_aes_var(mapping, 'r') + donut_radius <- .check_donut_radius(donut_radius) + mapping <- modifyList(mapping, aes_(r0 = ~rvar * donut_radius)) + } } names(mapping)[match(c("x", "y"), names(mapping))] <- c("x0", "y0") @@ -69,26 +102,45 @@ geom_scatterpie <- function(mapping=NULL, data, cols, pie_scale = 1, sorted_by_r if (!"group" %in% names(mapping)){ xvar <- get_aes_var(mapping, 'x0') yvar <- get_aes_var(mapping, 'y0') - df <- df |> dplyr::group_by(!!xvar, !!yvar) |> + df <- df |> dplyr::group_by(!!as.symbol(xvar), !! as.symbol(yvar)) |> dplyr::group_split() |> as.list() names(df) <- seq_len(length(df)) df <- dplyr::bind_rows(df, .id=".group.id") mapping <- modifyList(mapping, aes_(group = ~.group.id)) } - if (!sorted_by_radius) { - return(geom_arc_bar(mapping, data=df, stat='pie', inherit.aes=FALSE, ...)) - } - if ('r' %in% colnames(df)){ rvar <- 'r' }else{ rvar <- get_aes_var(mapping, 'r') } - - lapply(split(df, df[,rvar, drop=TRUE])[as.character(sort(unique(df[,rvar, drop=TRUE]), decreasing=TRUE))], function(d) { - geom_arc_bar(mapping, data=d, stat='pie', inherit.aes=FALSE, ...) - }) + + if (!sorted_by_radius) { + pie.layer <- geom_arc_bar(mapping, data=df, stat='pie', inherit.aes=FALSE, ...) + if (!is.null(bg_circle_radius)){ + mapping.circle <- mapping[names(mapping) %in% c('x0', 'y0')] + dt <- .extract_mapping_df(df, mapping, extract_aes = c('x0', 'y0'), col_var=rvar) + mapping.circle <- modifyList(mapping.circle, aes(r = !!as.symbol(rvar) * bg_circle_radius)) + circle.layer <- geom_circle(data = dt, mapping = mapping.circle, inherit.aes=FALSE, ...) + pie.layer <- list(circle.layer, pie.layer) + } + return(pie.layer) + } + + lapply(split(df, df[,rvar, drop=TRUE])[as.character(sort(unique(df[,rvar, drop=TRUE]), decreasing=TRUE))], + function(d) + { + pie.layer <- geom_arc_bar(mapping, data=d, stat='pie', inherit.aes=FALSE, ...) + if (!is.null(bg_circle_radius)){ + mapping.circle <- mapping[names(mapping) %in% c('x0', 'y0', 'r')] + d2 <- .extract_mapping_df(d, mapping, extract_aes = c('x0', 'y0', 'r'), col_var = rvar) + mapping.circle <- modifyList(mapping.circle, aes(r = !!as.symbol(rvar) * bg_circle_radius)) + circle.layer <- geom_circle(data = d2, mapping = mapping.circle, inherit.aes=FALSE, ...) + pie.layer <- list(circle.layer, pie.layer) + } + return(pie.layer) + } + ) } diff --git a/R/utilities.R b/R/utilities.R index 52c2885..6693e11 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -16,3 +16,22 @@ is_fixed_radius <- function(rvar) { } return(TRUE) } + +.check_donut_radius <- function(x){ + if (x > 1){ + cli::cli_warn("The `donut.radius` should be range 0 and 1, it was set to 0.5 automatically.") + x <- 0.5 + } + return(x) +} + +.extract_mapping_df <- function(data, + mapping, + extract_aes = c('x0', 'y0'), + col_var = NULL + ){ + extract.var <- lapply(extract_aes, function(x)get_aes_var(mapping, x)) |> unlist() + extract.var <- union(col_var, extract.var) + df <- data[, colnames(data) %in% extract.var, drop=FALSE] |> dplyr::distinct() + return(df) +} diff --git a/man/geom_scatterpie.Rd b/man/geom_scatterpie.Rd index ddc94d1..759d2c0 100644 --- a/man/geom_scatterpie.Rd +++ b/man/geom_scatterpie.Rd @@ -12,6 +12,8 @@ geom_scatterpie( sorted_by_radius = FALSE, legend_name = "type", long_format = FALSE, + donut_radius = NULL, + bg_circle_radius = NULL, ... ) } @@ -28,7 +30,13 @@ geom_scatterpie( \item{legend_name}{name of fill legend} -\item{long_format}{whether use long format of input data} +\item{long_format}{logical whether use long format of input data} + +\item{donut_radius}{numeric the radius of donut chart (relative the radius of circle), default is NULL. +it should be between 0 and 1, if it is provided, the donut chart will be displayed instead of pie chart.} + +\item{bg_circle_radius}{numeric the radius of background circle, default is FALSE, we suggest setting it +to between 1 and 1.5 .} \item{...}{additional parameters} } @@ -47,6 +55,23 @@ d$C <- abs(rnorm(5, sd=3)) ggplot() + geom_scatterpie(aes(x=x, y=y), data=d, cols=c("A", "B", "C")) + coord_fixed() d <- tidyr::gather(d, key="letters", value="value", -x:-y) ggplot() + geom_scatterpie(aes(x=x, y=y), data=d, cols="letters", long_format=TRUE) + coord_fixed() +p1 <- ggplot() + + geom_scatterpie( + mapping = aes(x=x, y=y), data=d, cols="letters", + long_format=TRUE, + donut_radius=.5 + ) + + coord_fixed() +p1 +p2 <- ggplot() + + geom_scatterpie( + mapping = aes(x=x, y=y), data=d, cols="letters", + long_format=TRUE, + donut_radius = .5, + bg_circle_radius = 1.2 + ) + + coord_fixed() +p2 } \author{ Guangchuang Yu