├── .Rbuildignore ├── .gitignore ├── DESCRIPTION ├── Makefile ├── NAMESPACE ├── NEWS ├── NEWS.md ├── R ├── geom_scatterpie.R ├── geom_scatterpie_legend.R ├── recenter.R ├── scatterpie-package.R ├── utilities.R └── zzz.R ├── README.Rmd ├── README.md ├── docs └── index.html ├── man ├── geom-scatterpie.Rd ├── geom_scatterpie_legend.Rd ├── recenter.Rd └── scatterpie-package.Rd ├── scatterpie.Rproj └── vignettes └── scatterpie.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | Makefile 4 | docs 5 | README.Rmd 6 | README.md 7 | ^CRAN-SUBMISSION$ 8 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | *~ 5 | CRAN-SUBMISSION 6 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: scatterpie 2 | Title: Scatter Pie Plot 3 | Version: 0.2.4 4 | Authors@R: c( 5 | person(given = "Guangchuang", family = "Yu", 6 | email = "guangchuangyu@gmail.com", role = c("aut", "cre"), 7 | comment = c(ORCID = "0000-0002-6485-8781")), 8 | person(given = "Shuangbin", family = "Xu", 9 | email = "xshuangbin@163.com", role = "ctb", 10 | comment = c(ORCID="0000-0003-3513-5362")) 11 | ) 12 | Description: Creates scatterpie plots, especially useful for plotting pies on a map. 13 | Depends: 14 | R (>= 4.1.0), 15 | ggplot2 16 | Imports: 17 | ggforce, 18 | rlang, 19 | ggfun, 20 | stats, 21 | tidyr, 22 | dplyr, 23 | utils, 24 | yulab.utils (>= 0.1.6) 25 | Suggests: 26 | knitr, 27 | rmarkdown, 28 | prettydoc, 29 | maps, 30 | scales, 31 | cli 32 | VignetteBuilder: knitr 33 | License: Artistic-2.0 34 | Encoding: UTF-8 35 | RoxygenNote: 7.3.2 36 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | PKGNAME := $(shell sed -n "s/Package: *\([^ ]*\)/\1/p" DESCRIPTION) 2 | PKGVERS := $(shell sed -n "s/Version: *\([^ ]*\)/\1/p" DESCRIPTION) 3 | PKGSRC := $(shell basename `pwd`) 4 | 5 | all: rd check 6 | 7 | rd: 8 | Rscript -e 'roxygen2::roxygenise(".")' 9 | 10 | readme: 11 | Rscript -e 'rmarkdown::render("README.Rmd")' 12 | 13 | vignette: 14 | cd vignettes;\ 15 | Rscript -e 'rmarkdown::render("scatterpie.Rmd")';\ 16 | mv scatterpie.html ../docs/index.html 17 | 18 | build: 19 | # cd ..;\ 20 | # R CMD build $(PKGSRC) 21 | Rscript -e 'devtools::build()' 22 | 23 | install: 24 | cd ..;\ 25 | R CMD INSTALL $(PKGNAME)_$(PKGVERS).tar.gz 26 | 27 | check: 28 | #cd ..;\ 29 | #Rscript -e 'rcmdcheck::rcmdcheck("$(PKGNAME)_$(PKGVERS).tar.gz", args="--as-cran")' 30 | Rscript -e 'devtools::check()' 31 | 32 | check2: build 33 | cd ..;\ 34 | R CMD check --as-cran $(PKGNAME)_$(PKGVERS).tar.gz 35 | 36 | clean: 37 | cd ..;\ 38 | $(RM) -r $(PKGNAME).Rcheck/ 39 | 40 | 41 | 42 | windows: 43 | Rscript -e 'rhub::check_on_windows(".")';\ 44 | sleep 10; 45 | 46 | addtorepo: windows 47 | Rscript -e 'drat:::insert("../$(PKGNAME)_$(PKGVERS).tar.gz", "../drat/docs")';\ 48 | Rscript -e 'drat:::insert(ypages::get_windows_binary(), "../drat/docs")';\ 49 | cd ../drat;\ 50 | git add .; git commit -m '$(PKGNAME)_$(PKGVERS)'; git push -u origin master 51 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(ggplot_add,layer_scatterpie) 4 | export(geom_scatterpie) 5 | export(geom_scatterpie2) 6 | export(geom_scatterpie_legend) 7 | export(recenter) 8 | importFrom(dplyr,bind_rows) 9 | importFrom(dplyr,group_by) 10 | importFrom(dplyr,group_split) 11 | importFrom(ggforce,geom_arc_bar) 12 | importFrom(ggforce,geom_circle) 13 | importFrom(ggfun,get_aes_var) 14 | importFrom(ggplot2,aes) 15 | importFrom(ggplot2,aes_) 16 | importFrom(ggplot2,geom_segment) 17 | importFrom(ggplot2,geom_text) 18 | importFrom(ggplot2,ggplot_add) 19 | importFrom(rlang,"!!") 20 | importFrom(rlang,enquo) 21 | importFrom(rlang,sym) 22 | importFrom(stats,as.formula) 23 | importFrom(tidyr,gather) 24 | importFrom(utils,modifyList) 25 | importFrom(yulab.utils,yulab_msg) 26 | -------------------------------------------------------------------------------- /NEWS: -------------------------------------------------------------------------------- 1 | CHANGES IN VERSION 0.1.5 2 | ------------------------ 3 | o set legend order based on order of "cols" <2020-09-09, Wed> 4 | + https://github.com/GuangchuangYu/scatterpie/pull/28 5 | o Add in long format option to geom_scatterpie 6 | + https://github.com/GuangchuangYu/scatterpie/pull/22 7 | 8 | CHANGES IN VERSION 0.1.4 9 | ------------------------ 10 | o pie_scale parameter in geom_scatterpie <2019-11-08, Fri> 11 | 12 | CHANGES IN VERSION 0.1.3 13 | ------------------------ 14 | o fixed bug of round_digit 15 | 16 | CHANGES IN VERSION 0.1.2 17 | ------------------------ 18 | o import rvcheck::get_aes_var to compatible with ggplot2 v < 2.3.0 and >= 2.3.0 <2018-05-23, Wed> 19 | 20 | CHANGES IN VERSION 0.1.1 21 | ------------------------ 22 | o compatible with ggplot2 v=2.2.1.9000 23 | o import rlang and use tidyeval with tidyr::gather <2018-04-18, Wed> 24 | + https://github.com/GuangchuangYu/scatterpie/issues/9 25 | 26 | CHANGES IN VERSION 0.0.7 27 | ------------------------ 28 | o add parameter `sorted_by_radius`. 29 | + https://github.com/GuangchuangYu/scatterpie/issues/7 30 | 31 | CHANGES IN VERSION 0.0.7 32 | ------------------------ 33 | o add labeller parameter in geom_scatterpie_legend <2017-03-21, Tue> 34 | 35 | CHANGES IN VERSION 0.0.6 36 | ------------------------ 37 | o bug fixed of geom_scatterpie_legend <2016-02-14, Tue> 38 | + https://github.com/GuangchuangYu/scatterpie/issues/3 39 | 40 | CHANGES IN VERSION 0.0.5 41 | ------------------------ 42 | o add examples in geom_scatterpie <2016-12-02, Fri> 43 | o recenter to set the center of map data <2016-12-01, Thu> 44 | o geom_scatterpie_legend <2016-12-01, Thu> 45 | o geom_scatterpie <2016-11-30, Wed> -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # scatterpie 0.2.4 2 | 3 | + if `geom_scatterpie(data = NULL)`, the layer will try to use `plot$data` (2024-08-28, Wed) 4 | 5 | # scatterpie 0.2.3 6 | 7 | + supports labeling slices of pies (2024-06-05, Wed, #49) 8 | 9 | # scatterpie 0.2.2 10 | 11 | + introduce donut_radius and bg_circle_radius parameters to control the layer of pie (2024-04-03, Wed, #46) 12 | 13 | # scatterpie 0.2.1 14 | 15 | + introduce `breaks` parameter in `geom_scatterpie_legend()` (2023-06-07, Wed, #40) 16 | 17 | # scatterpie 0.2.0 18 | 19 | + increase R version of dependency to 4.1.0 as we used native pipe (2023-04-26, Wed) 20 | 21 | # scatterpie 0.1.9 22 | 23 | + allow label customization in scatterpie legend (2023-04-22, Sat, #38) 24 | + fixed the overlap issue with group mapping (2023-03-02, Thu, #37) 25 | 26 | # scatterpie 0.1.8 27 | 28 | + improve the legend of pie radius (2022-09-03, Sat, #35) 29 | 30 | # scatterpie 0.1.7 31 | 32 | + import `get_aes_var` from ggfun instead of rvcheck (2021-08-20) 33 | 34 | # scatterpie 0.1.6 35 | 36 | + fixed R check by suggesting rmarkdown package 37 | 38 | -------------------------------------------------------------------------------- /R/geom_scatterpie.R: -------------------------------------------------------------------------------- 1 | ##' scatter pie plot 2 | ##' 3 | ##' 4 | ##' @title geom_scatterpie 5 | ##' @rdname geom-scatterpie 6 | ##' @param mapping aes mapping 7 | ##' @param data data 8 | ##' @param cols cols the pie data 9 | ##' @param pie_scale amount to scale the pie size if there is no radius mapping exists 10 | ##' @param sorted_by_radius whether plotting large pie first 11 | ##' @param legend_name name of fill legend 12 | ##' @param long_format logical whether use long format of input data 13 | ##' @param label_radius numeric the radius of label position (relative the radius of pie), 14 | ##' default is NULL, when it is provided, the ratio or value label will be displayed. 15 | ##' @param label_show_ratio logical only work when \code{label_radius} is not NULL, 16 | ##' default is TRUE, meaning the ratio of label will be displayed. 17 | ##' @param label_threshold numeric the threshold is to control display the label, the ratio of 18 | ##' slice pie smaller than the threshold will not be displayed. default is 0. 19 | ##' @param donut_radius numeric the radius of donut chart (relative the radius of circle), default is NULL. 20 | ##' it should be between 0 and 1, if it is provided, the donut chart will be displayed instead of pie chart. 21 | ##' @param bg_circle_radius numeric the radius of background circle, default is FALSE, we suggest setting it 22 | ##' to between 1 and 1.5 . 23 | ##' @param ... additional parameters 24 | ##' @importFrom ggforce geom_arc_bar geom_circle 25 | ##' @importFrom utils modifyList 26 | ##' @importFrom tidyr gather 27 | ##' @importFrom rlang enquo 28 | ##' @importFrom rlang !! 29 | ##' @importFrom ggplot2 aes_ aes 30 | ##' @importFrom ggfun get_aes_var 31 | ##' @importFrom stats as.formula 32 | ##' @importFrom dplyr bind_rows group_by group_split 33 | ##' @export 34 | ##' @return layer 35 | ##' @author Guangchuang Yu 36 | ##' @examples 37 | ##' library(ggplot2) 38 | ##' d <- data.frame(x=rnorm(5), y=rnorm(5)) 39 | ##' d$A <- abs(rnorm(5, sd=1)) 40 | ##' d$B <- abs(rnorm(5, sd=2)) 41 | ##' d$C <- abs(rnorm(5, sd=3)) 42 | ##' 43 | ##' ggplot() + 44 | ##' geom_scatterpie( 45 | ##' aes(x=x, y=y), data=d, cols=c("A", "B", "C") 46 | ##' ) + 47 | ##' coord_fixed() 48 | ##' 49 | ##' ggplot() + 50 | ##' geom_scatterpie( 51 | ##' aes(x=x, y=y), data = d, cols=c("A", "B", "C"), 52 | ##' label_radius=1.05 53 | ##' ) + 54 | ##' coord_fixed() 55 | ##' 56 | ##' d <- tidyr::gather(d, key="letters", value="value", -x:-y) 57 | ##' ggplot() + geom_scatterpie(aes(x=x, y=y), data=d, cols="letters", long_format=TRUE) + coord_fixed() 58 | ##' p1 <- ggplot() + 59 | ##' geom_scatterpie( 60 | ##' mapping = aes(x=x, y=y), data=d, cols="letters", 61 | ##' long_format=TRUE, 62 | ##' donut_radius=.5 63 | ##' ) + 64 | ##' coord_fixed() 65 | ##' p1 66 | ##' p2 <- ggplot() + 67 | ##' geom_scatterpie( 68 | ##' mapping = aes(x=x, y=y), data=d, cols="letters", 69 | ##' long_format=TRUE, 70 | ##' donut_radius = .5, 71 | ##' bg_circle_radius = 1.2 72 | ##' ) + 73 | ##' coord_fixed() 74 | ##' p2 75 | ##' d |> dplyr::select(c(x, y)) |> dplyr::distinct() |> dplyr::mutate(Cell=c('A','A','B','C','B')) -> d2 76 | ##' d |> dplyr::left_join(d2) -> d3 77 | ##' d3$r_size <- c(2, 3, 4, 5, 6) * .01 78 | ##' 79 | ##' head(d3) 80 | ##' p3 <- ggplot() + 81 | ##' geom_scatterpie(data = d3, mapping = aes(x=x, y=y, r = r_size, color=Cell), cols="letters", 82 | ##' long_format=TRUE, donut_radius=.5, color = NA, linewidth=2, 83 | ##' bg_circle_radius=1.2) + coord_fixed() 84 | ##' p3 85 | ##' 86 | ##' p4 <- ggplot() + 87 | ##' geom_scatterpie(data = d3, 88 | ##' mapping = aes(x, y = y, r = r_size), 89 | ##' cols = 'letters', 90 | ##' long_format = TRUE, 91 | ##' label_radius = 1.1, 92 | ##' label_show_ratio = FALSE, 93 | ##' label_threshold = 0.06, 94 | ##' fontsize = 3 95 | ##' ) + 96 | ##' coord_fixed() 97 | ##' p4 98 | geom_scatterpie <- function(mapping = NULL, data = NULL, cols, pie_scale = 1, 99 | sorted_by_radius = FALSE, legend_name = "type", 100 | long_format = FALSE, label_radius = NULL, 101 | label_show_ratio = TRUE, label_threshold = 0, 102 | donut_radius = NULL, bg_circle_radius = NULL, ...) { 103 | 104 | structure(list( 105 | mapping = mapping, 106 | data = data, 107 | cols = cols, 108 | pie_scale = pie_scale, 109 | sorted_by_radius = sorted_by_radius, 110 | legend_name = legend_name, 111 | long_format = long_format, 112 | label_radius = label_radius, 113 | label_show_ratio = label_show_ratio, 114 | label_threshold = label_threshold, 115 | donut_radius = donut_radius, 116 | bg_circle_radius = bg_circle_radius, 117 | ... 118 | ), 119 | class = "layer_scatterpie" 120 | ) 121 | } 122 | 123 | 124 | ##' @rdname geom-scatterpie 125 | ##' @export 126 | geom_scatterpie2 <- function(mapping = NULL, data, cols, pie_scale = 1, 127 | sorted_by_radius = FALSE, legend_name = "type", 128 | long_format = FALSE, label_radius = NULL, 129 | label_show_ratio = TRUE, label_threshold = 0, 130 | donut_radius = NULL, bg_circle_radius = NULL, ...){ 131 | if (is.null(mapping)) 132 | mapping <- aes_(x = ~x, y = ~y) 133 | mapping <- modifyList(mapping, 134 | aes_(r0 = 0, 135 | fill = as.formula(paste0("~", legend_name)), 136 | amount=~value) 137 | ) 138 | 139 | if (!'r' %in% names(mapping)) { 140 | xvar <- get_aes_var(mapping, "x") 141 | size <- diff(range(data[, xvar], na.rm=TRUE))/ 50 * pie_scale 142 | data$r <- size 143 | mapping <- modifyList(mapping, aes_(r=~r)) 144 | if (!is.null(donut_radius)){ 145 | donut_radius <- .check_donut_radius(donut_radius) 146 | data$.R0 <- size * donut_radius 147 | mapping <- modifyList(mapping, aes_(r0 = ~.R0)) 148 | } 149 | } else { 150 | if (!is.null(donut_radius)) { 151 | rvar <- get_aes_var(mapping, 'r') 152 | donut_radius <- .check_donut_radius(donut_radius) 153 | data$.R0 <- data[[rvar]] * donut_radius 154 | mapping <- modifyList(mapping, aes_(r0 = ~.R0)) 155 | } 156 | } 157 | 158 | names(mapping)[match(c("x", "y"), names(mapping))] <- c("x0", "y0") 159 | if(long_format==TRUE){ 160 | df <- data 161 | names(df)[which(names(df) == cols)] = legend_name 162 | cols2 <- enquo(cols) 163 | } else{ 164 | data <- data[rowSums(data[, cols]) > 0, ] 165 | ## df <- gather_(data, "type", "value", cols) 166 | cols2 <- enquo(cols) 167 | df <- gather(data, "type", "value", !!cols2) 168 | df$type <- factor(df$type, levels = cols) # set legend order based on order of "cols" 169 | names(df)[which(names(df) == "type")] = legend_name 170 | } 171 | 172 | if (!"group" %in% names(mapping)){ 173 | xvar <- get_aes_var(mapping, 'x0') 174 | yvar <- get_aes_var(mapping, 'y0') 175 | df <- df |> dplyr::group_by(!!as.symbol(xvar), !! as.symbol(yvar)) |> 176 | dplyr::group_split() |> as.list() 177 | names(df) <- seq_len(length(df)) 178 | df <- dplyr::bind_rows(df, .id=".group.id") 179 | mapping <- modifyList(mapping, aes_(group = ~.group.id)) 180 | } 181 | 182 | if ('r' %in% colnames(df)){ 183 | rvar <- 'r' 184 | }else{ 185 | rvar <- get_aes_var(mapping, 'r') 186 | } 187 | 188 | if (!sorted_by_radius) { 189 | pie.layer <- .build_pie_layer(df, mapping, ...) 190 | if (!is.null(bg_circle_radius)){ 191 | circle.layer <- .add_circle_layer(data = df, mapping = mapping, rvar = rvar, 192 | bg_circle_radius = bg_circle_radius, ...) 193 | pie.layer <- list(circle.layer, pie.layer) 194 | } 195 | pie.layer <- .add_label_layer(pie.layer, df, mapping, label_radius, 196 | label_show_ratio, label_threshold, 197 | bg_circle_radius, ...) 198 | return(pie.layer) 199 | } 200 | 201 | lapply(split(df, df[,rvar, drop=TRUE])[as.character(sort(unique(df[,rvar, drop=TRUE]), decreasing=TRUE))], 202 | function(d) 203 | { 204 | pie.layer <- .build_pie_layer(d, mapping, ...) 205 | if (!is.null(bg_circle_radius)){ 206 | circle.layer <- .add_circle_layer(data = d, mapping = mapping, rvar = rvar, 207 | bg_circle_radius = bg_circle_radius, ...) 208 | pie.layer <- list(circle.layer, pie.layer) 209 | } 210 | pie.layer <- .add_label_layer(pie.layer, d, mapping, label_radius, 211 | label_show_ratio, label_threshold, bg_circle_radius, ...) 212 | return(pie.layer) 213 | } 214 | ) 215 | } 216 | 217 | 218 | ##' @importFrom ggplot2 ggplot_add 219 | ##' @method ggplot_add layer_scatterpie 220 | ##' @export 221 | ggplot_add.layer_scatterpie <- function(object, plot, object_name) { 222 | if (is.null(object$data)) object$data <- plot$data 223 | layer <- do.call(geom_scatterpie2, object) 224 | ggplot_add(layer, plot, object_name) 225 | } 226 | 227 | -------------------------------------------------------------------------------- /R/geom_scatterpie_legend.R: -------------------------------------------------------------------------------- 1 | ##' legend of scatterpie 2 | ##' 3 | ##' 4 | ##' @title geom_scatterpie_legend 5 | ##' @param radius radius vector 6 | ##' @param x x position 7 | ##' @param y y position 8 | ##' @param n number of circle 9 | ##' @param breaks A character vector of breaks, default is NULL. 10 | ##' @param labeller function to label radius 11 | ##' @param label_position a character string indicating the position of labels, 12 | ##' "right" (default) or "left" or any abbreviation of these 13 | ##' @param ... other text arguments passed on to \code{\link[ggplot2:layer]{ggplot2::layer()}} 14 | ##' @importFrom ggplot2 aes_ 15 | ##' @importFrom ggplot2 geom_segment 16 | ##' @importFrom ggplot2 geom_text 17 | ##' @export 18 | ##' @return layer 19 | ##' @author Guangchuang Yu 20 | geom_scatterpie_legend <- function(radius, x, y, n=5, breaks = NULL, labeller, label_position = "right", ...) { 21 | ## rvar <- as.character(mapping)["r"] 22 | ## if (is_fixed_radius(rvar)) { 23 | ## radius <- as.numeric(rvar) 24 | ## } else { 25 | ## rr <- range(data[, rvar]) 26 | ## radius <- sapply(seq(min(rr), max(rr), length.out=5), roundDigit) 27 | ## } 28 | 29 | #if (length(radius) > n) { 30 | # radius <- unique(sapply(seq(min(radius), max(radius), length.out=n), round_digit)) 31 | #} 32 | 33 | if (n <= 1 && is.null(breaks)){ 34 | stop('The n argument requires larger than 1.') 35 | } 36 | 37 | if (is.null(breaks)){ 38 | radius <- scales::breaks_extended(n = n)(radius) 39 | }else{ 40 | radius <- breaks 41 | } 42 | 43 | label <- FALSE 44 | if (!missing(labeller)) { 45 | if (!inherits(labeller, "function")) { 46 | stop("labeller should be a function for converting radius") 47 | } 48 | label <- TRUE 49 | } 50 | 51 | dd <- data.frame(r=radius, start=0, end=2*pi, x=x, y=y + radius - max(radius), maxr=max(radius)) 52 | 53 | if(label) { 54 | dd$label <- labeller(dd$r) 55 | } else { 56 | dd$label <- dd$r 57 | } 58 | 59 | label_position <- match.arg(label_position, c("right", "left")) 60 | if (label_position == "right") { 61 | hjust <- "left" 62 | sign <- `+` 63 | } else { 64 | hjust <- "right" 65 | sign <- `-` 66 | } 67 | 68 | list( 69 | geom_arc_bar(aes_(x0=~x, y0=~y, r0=~r, r=~r, start=~start, end=~end), data=dd, inherit.aes=FALSE), 70 | geom_segment(aes_(x=~x, xend=~sign(x, maxr*1.5), y=~y+r, yend=~y+r), data=dd, inherit.aes=FALSE), 71 | geom_text(aes_(x=~sign(x, maxr*1.6), y=~y+r, label=~label), data=dd, hjust=hjust, inherit.aes=FALSE, ... = ...) 72 | ) 73 | } 74 | -------------------------------------------------------------------------------- /R/recenter.R: -------------------------------------------------------------------------------- 1 | ##' re-center map data 2 | ##' 3 | ##' 4 | ##' @title recenter 5 | ##' @param mapdata map data, shoud be a data.frame 6 | ##' @param center center 7 | ##' @param longitude_column longitude column 8 | ##' @return updated map data 9 | ##' @export 10 | ##' @author ygc 11 | recenter <- function(mapdata, center, longitude_column='long') { 12 | if (center <= 0) { 13 | stop("center should be positive value...") 14 | } 15 | md2 <- mapdata 16 | md2$long <- md2$long + 360 17 | md2$group <- md2$group + max(md2$group) + 1 18 | 19 | mapdata <- rbind(mapdata, md2) 20 | long <- mapdata[,longitude_column] 21 | 22 | res <- subset(mapdata, long >= center-180 & long <= center+180) 23 | 24 | return(res) 25 | } 26 | 27 | 28 | -------------------------------------------------------------------------------- /R/scatterpie-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | 4 | -------------------------------------------------------------------------------- /R/utilities.R: -------------------------------------------------------------------------------- 1 | 2 | round_digit <- function (d) { 3 | if (d > 1) { 4 | round(d) 5 | } else { 6 | round(d, -as.integer(floor(log10(abs(d))))) 7 | } 8 | } 9 | 10 | 11 | 12 | is_fixed_radius <- function(rvar) { 13 | x <- suppressWarnings(as.numeric(rvar)) 14 | if (is.na(x)) { 15 | return(FALSE) 16 | } 17 | return(TRUE) 18 | } 19 | 20 | 21 | .build_pie_layer <- function(data, mapping, ...){ 22 | params <- list(...) 23 | if ("label" %in% names(mapping)){ 24 | mapping[['label']] <- NULL 25 | } 26 | params <- params[!names(params) %in% c("fontsize", "fontface", "fontfamily")] 27 | params$data <- data 28 | params$mapping <- mapping 29 | params$stat <- "pie" 30 | params$inherit.aes <- FALSE 31 | x <- do.call(geom_arc_bar, params) 32 | return(x) 33 | } 34 | 35 | .add_circle_layer <- function(data, mapping, rvar, bg_circle_radius, ...){ 36 | mapping.circle <- mapping[names(mapping) %in% c('x0', 'y0', 'r', 'color', 'colour')] 37 | dt <- .extract_mapping_df(data, mapping, extract_aes = c('x0', 'y0', 'color', 'colour'), col_var = rvar) 38 | dt[[rvar]] <- dt[[rvar]] * bg_circle_radius 39 | params <- list(data = dt, mapping = mapping.circle, inherit.aes = FALSE, fill = 'white', ...) 40 | params <- .check_aes_in_params(params, c("color", "colour")) 41 | circle.layer <- do.call(geom_circle, params) 42 | return(circle.layer) 43 | } 44 | 45 | .check_donut_radius <- function(x){ 46 | if (x > 1){ 47 | cli::cli_warn("The `donut.radius` should be range 0 and 1, it was set to 0.5 automatically.") 48 | x <- 0.5 49 | } 50 | return(x) 51 | } 52 | 53 | .extract_mapping_df <- function(data, 54 | mapping, 55 | extract_aes = c('x0', 'y0'), 56 | col_var = NULL 57 | ){ 58 | extract.var <- lapply(extract_aes, function(x)get_aes_var(mapping, x)) |> unlist() 59 | extract.var <- union(col_var, extract.var) 60 | df <- data[, colnames(data) %in% extract.var, drop=FALSE] |> dplyr::distinct() 61 | return(df) 62 | } 63 | 64 | .check_aes_in_params <- function(params, aes_var){ 65 | for (i in aes_var){ 66 | if (i %in% names(params)){ 67 | params[[i]] <- NULL 68 | } 69 | } 70 | return(params) 71 | } 72 | 73 | .build_data_for_label <- function(x, threshold, var = 'value', r = "r", rlabel = 1.05){ 74 | end_angle <- 2 * pi * cumsum(x[[var]])/sum(x[[var]]) 75 | start_angle <- dplyr::lag(end_angle, default = 0) 76 | mid_angle <- 0.5 * (start_angle + end_angle) 77 | x[[".RATIO"]] <- round(x[[var]]/sum(x[[var]]), 2) 78 | x[[var]] <- round(x[[var]], 2) 79 | x[['.RATIO']] <- ifelse(x[['.RATIO']] < threshold, NA, x[[".RATIO"]]) 80 | x[[var]] <- ifelse(x[['.RATIO']] < threshold, NA, x[[var]]) 81 | x[['hjust']] <- ifelse(mid_angle > pi, 1, 0) 82 | x[['vjust']] <- ifelse(mid_angle < pi/2 | mid_angle > 3 * pi/2, 0, 1) 83 | x[['x']] <- rlabel * x[[r]] * sin(mid_angle) + x[['x']] 84 | x[['y']] <- rlabel * x[[r]] * cos(mid_angle) + x[['y']] 85 | return(x) 86 | } 87 | 88 | #' @importFrom rlang sym 89 | .set_lab_mapping <- function(mapping, label_radius, label_show_ratio, bg_circle_radius){ 90 | lab.default <- aes(x=!!sym("x"), y=!!sym("y"), hjust=!!sym("hjust"), vjust=!!sym("vjust")) 91 | lab.mapping <- NULL 92 | if (!is.null(label_radius)){ 93 | if (!label_show_ratio){ 94 | lab.mapping = aes(label = !!sym("value")) 95 | }else{ 96 | lab.mapping <- aes(label = !!sym(".RATIO")) 97 | } 98 | lab.mapping <- modifyList(lab.default, lab.mapping) 99 | } 100 | 101 | if ("label" %in% names(mapping)){ 102 | if (is.null(label_radius)) label_radius <- 1.06 103 | lab.mapping <- mapping['label'] 104 | lab.mapping <- modifyList(lab.default, lab.mapping) 105 | } 106 | 107 | if (any(c('color', 'colour') %in% names(mapping)) && is.null(bg_circle_radius) && !is.null(lab.mapping)){ 108 | lab.mapping <- modifyList(lab.mapping, mapping['color'] %|aes|% mapping['colour']) 109 | } 110 | return(list(mapping=lab.mapping, rlabel=label_radius)) 111 | } 112 | 113 | .add_label_layer <- function(pie, data, mapping, label_radius, 114 | label_show_ratio, label_threshold, 115 | bg_circle_radius, ...){ 116 | val <- get_aes_var(mapping, 'amount') 117 | r.aes <- get_aes_var(mapping, 'r') 118 | dot.params <- list(...) 119 | params <- list() 120 | res1 <- .set_lab_mapping(mapping, label_radius, label_show_ratio, bg_circle_radius) 121 | 122 | if (is.null(res1$mapping)){ 123 | return(pie) 124 | } 125 | group.var <- get_aes_var(mapping, 'group') 126 | params$data <- split(data, data[[group.var]]) |> 127 | lapply(function(x).build_data_for_label(x, threshold=label_threshold, 128 | var=val, r=r.aes, rlabel = res1$rlabel)) |> 129 | dplyr::bind_rows() 130 | params$mapping <- res1$mapping 131 | params$inherit.aes <- FALSE 132 | if (!is.null(bg_circle_radius)){ 133 | params$show.legend <- FALSE 134 | } 135 | dot.params <- .extract_label_dot_params(dot.params) 136 | text.layer <- do.call('geom_text', c(params, dot.params)) 137 | return(list(pie, text.layer)) 138 | } 139 | 140 | 141 | 142 | `%|aes|%` <- function(a, b){ 143 | if (!is.null(a[[1]])) 144 | a 145 | else b 146 | } 147 | 148 | .extract_label_dot_params <- function(x){ 149 | nm1 <- c("size", "family", "fontface") 150 | nm2 <- c("fontsize", "fontfamily", "fontface") 151 | indx <- match(nm2, names(x)) 152 | indx <- indx[!is.na(indx)] 153 | if (length(indx)==0){ 154 | return(NULL) 155 | } 156 | x <- x[indx] 157 | indx <- match(names(x), nm2) 158 | names(x) <- nm1[indx] 159 | return(x) 160 | } 161 | 162 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | #' @importFrom yulab.utils yulab_msg 2 | .onAttach <- function(libname, pkgname) { 3 | packageStartupMessage(yulab.utils::yulab_msg(pkgname)) 4 | } 5 | 6 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: 3 | md_document: 4 | variant: gfm 5 | html_preview: false 6 | --- 7 | 8 | 9 | 10 | 11 | ```{r echo=FALSE, results="hide", message=FALSE} 12 | library("badger") 13 | ``` 14 | 15 | scatterpie: Scatterpie Plot 16 | --------- 17 | 18 | [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/scatterpie?color=green)](https://cran.r-project.org/package=scatterpie) 19 | `r badge_devel("guangchuangyu/scatterpie", "green")` 20 | ![](https://cranlogs.r-pkg.org/badges/grand-total/scatterpie?color=green) 21 | ![](https://cranlogs.r-pkg.org/badges/scatterpie?color=green) 22 | ![](https://cranlogs.r-pkg.org/badges/last-week/scatterpie?color=green) 23 | 24 | 25 | Creates scatterpie plots, especially useful for plotting pies on a map. 26 | 27 | 28 | 29 | ## :writing_hand: Authors 30 | 31 | Guangchuang YU 32 | 33 | School of Basic Medical Sciences, Southern Medical University 34 | 35 | 36 | [![saythanks](https://img.shields.io/badge/say-thanks-ff69b4.svg)](https://saythanks.io/to/GuangchuangYu) 37 | `r badger::badge_custom('follow me on', 'WeChat', 'green', 'https://guangchuangyu.github.io/blog_images/biobabble.jpg')` 38 | 39 | 40 | ## :arrow_double_down: Installation 41 | 42 | Get the released version from CRAN: 43 | 44 | ```r 45 | install.packages("scatterpie") 46 | ``` 47 | 48 | Or the development version from github: 49 | 50 | ```r 51 | ## install.packages("devtools") 52 | devtools::install_github("GuangchuangYu/scatterpie") 53 | ``` 54 | 55 | ## :book: Vignette 56 | 57 | For more details, please refer to the [online vignette](https://cran.r-project.org/package=scatterpie/vignettes/scatterpie.html). 58 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | ## scatterpie: Scatterpie Plot 4 | 5 | [![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/scatterpie?color=green)](https://cran.r-project.org/package=scatterpie) 6 | [![](https://img.shields.io/badge/devel%20version-0.1.4-green.svg)](https://github.com/guangchuangyu/scatterpie) 7 | ![](https://cranlogs.r-pkg.org/badges/grand-total/scatterpie?color=green) 8 | ![](https://cranlogs.r-pkg.org/badges/scatterpie?color=green) 9 | ![](https://cranlogs.r-pkg.org/badges/last-week/scatterpie?color=green) 10 | 11 | Creates scatterpie plots, especially useful for plotting pies on a map. 12 | 13 | ## :writing\_hand: Authors 14 | 15 | Guangchuang YU 16 | 17 | School of Basic Medical Sciences, Southern Medical University 18 | 19 | [![saythanks](https://img.shields.io/badge/say-thanks-ff69b4.svg)](https://saythanks.io/to/GuangchuangYu) 20 | [![](https://img.shields.io/badge/follow%20me%20on-WeChat-green.svg)](https://guangchuangyu.github.io/blog_images/biobabble.jpg) 21 | 22 | ## :arrow\_double\_down: Installation 23 | 24 | Get the released version from CRAN: 25 | 26 | ``` r 27 | install.packages("scatterpie") 28 | ``` 29 | 30 | Or the development version from github: 31 | 32 | ``` r 33 | ## install.packages("devtools") 34 | devtools::install_github("GuangchuangYu/scatterpie") 35 | ``` 36 | 37 | ## :book: Vignette 38 | 39 | For more details, please refer to the [online 40 | vignette](https://cran.r-project.org/package=scatterpie/vignettes/scatterpie.html). 41 | -------------------------------------------------------------------------------- /man/geom-scatterpie.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom_scatterpie.R 3 | \name{geom_scatterpie} 4 | \alias{geom_scatterpie} 5 | \alias{geom_scatterpie2} 6 | \title{geom_scatterpie} 7 | \usage{ 8 | geom_scatterpie( 9 | mapping = NULL, 10 | data = NULL, 11 | cols, 12 | pie_scale = 1, 13 | sorted_by_radius = FALSE, 14 | legend_name = "type", 15 | long_format = FALSE, 16 | label_radius = NULL, 17 | label_show_ratio = TRUE, 18 | label_threshold = 0, 19 | donut_radius = NULL, 20 | bg_circle_radius = NULL, 21 | ... 22 | ) 23 | 24 | geom_scatterpie2( 25 | mapping = NULL, 26 | data, 27 | cols, 28 | pie_scale = 1, 29 | sorted_by_radius = FALSE, 30 | legend_name = "type", 31 | long_format = FALSE, 32 | label_radius = NULL, 33 | label_show_ratio = TRUE, 34 | label_threshold = 0, 35 | donut_radius = NULL, 36 | bg_circle_radius = NULL, 37 | ... 38 | ) 39 | } 40 | \arguments{ 41 | \item{mapping}{aes mapping} 42 | 43 | \item{data}{data} 44 | 45 | \item{cols}{cols the pie data} 46 | 47 | \item{pie_scale}{amount to scale the pie size if there is no radius mapping exists} 48 | 49 | \item{sorted_by_radius}{whether plotting large pie first} 50 | 51 | \item{legend_name}{name of fill legend} 52 | 53 | \item{long_format}{logical whether use long format of input data} 54 | 55 | \item{label_radius}{numeric the radius of label position (relative the radius of pie), 56 | default is NULL, when it is provided, the ratio or value label will be displayed.} 57 | 58 | \item{label_show_ratio}{logical only work when \code{label_radius} is not NULL, 59 | default is TRUE, meaning the ratio of label will be displayed.} 60 | 61 | \item{label_threshold}{numeric the threshold is to control display the label, the ratio of 62 | slice pie smaller than the threshold will not be displayed. default is 0.} 63 | 64 | \item{donut_radius}{numeric the radius of donut chart (relative the radius of circle), default is NULL. 65 | it should be between 0 and 1, if it is provided, the donut chart will be displayed instead of pie chart.} 66 | 67 | \item{bg_circle_radius}{numeric the radius of background circle, default is FALSE, we suggest setting it 68 | to between 1 and 1.5 .} 69 | 70 | \item{...}{additional parameters} 71 | } 72 | \value{ 73 | layer 74 | } 75 | \description{ 76 | scatter pie plot 77 | } 78 | \examples{ 79 | library(ggplot2) 80 | d <- data.frame(x=rnorm(5), y=rnorm(5)) 81 | d$A <- abs(rnorm(5, sd=1)) 82 | d$B <- abs(rnorm(5, sd=2)) 83 | d$C <- abs(rnorm(5, sd=3)) 84 | 85 | ggplot() + 86 | geom_scatterpie( 87 | aes(x=x, y=y), data=d, cols=c("A", "B", "C") 88 | ) + 89 | coord_fixed() 90 | 91 | ggplot() + 92 | geom_scatterpie( 93 | aes(x=x, y=y), data = d, cols=c("A", "B", "C"), 94 | label_radius=1.05 95 | ) + 96 | coord_fixed() 97 | 98 | d <- tidyr::gather(d, key="letters", value="value", -x:-y) 99 | ggplot() + geom_scatterpie(aes(x=x, y=y), data=d, cols="letters", long_format=TRUE) + coord_fixed() 100 | p1 <- ggplot() + 101 | geom_scatterpie( 102 | mapping = aes(x=x, y=y), data=d, cols="letters", 103 | long_format=TRUE, 104 | donut_radius=.5 105 | ) + 106 | coord_fixed() 107 | p1 108 | p2 <- ggplot() + 109 | geom_scatterpie( 110 | mapping = aes(x=x, y=y), data=d, cols="letters", 111 | long_format=TRUE, 112 | donut_radius = .5, 113 | bg_circle_radius = 1.2 114 | ) + 115 | coord_fixed() 116 | p2 117 | d |> dplyr::select(c(x, y)) |> dplyr::distinct() |> dplyr::mutate(Cell=c('A','A','B','C','B')) -> d2 118 | d |> dplyr::left_join(d2) -> d3 119 | d3$r_size <- c(2, 3, 4, 5, 6) * .01 120 | 121 | head(d3) 122 | p3 <- ggplot() + 123 | geom_scatterpie(data = d3, mapping = aes(x=x, y=y, r = r_size, color=Cell), cols="letters", 124 | long_format=TRUE, donut_radius=.5, color = NA, linewidth=2, 125 | bg_circle_radius=1.2) + coord_fixed() 126 | p3 127 | 128 | p4 <- ggplot() + 129 | geom_scatterpie(data = d3, 130 | mapping = aes(x, y = y, r = r_size), 131 | cols = 'letters', 132 | long_format = TRUE, 133 | label_radius = 1.1, 134 | label_show_ratio = FALSE, 135 | label_threshold = 0.06, 136 | fontsize = 3 137 | ) + 138 | coord_fixed() 139 | p4 140 | } 141 | \author{ 142 | Guangchuang Yu 143 | } 144 | -------------------------------------------------------------------------------- /man/geom_scatterpie_legend.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom_scatterpie_legend.R 3 | \name{geom_scatterpie_legend} 4 | \alias{geom_scatterpie_legend} 5 | \title{geom_scatterpie_legend} 6 | \usage{ 7 | geom_scatterpie_legend( 8 | radius, 9 | x, 10 | y, 11 | n = 5, 12 | breaks = NULL, 13 | labeller, 14 | label_position = "right", 15 | ... 16 | ) 17 | } 18 | \arguments{ 19 | \item{radius}{radius vector} 20 | 21 | \item{x}{x position} 22 | 23 | \item{y}{y position} 24 | 25 | \item{n}{number of circle} 26 | 27 | \item{breaks}{A character vector of breaks, default is NULL.} 28 | 29 | \item{labeller}{function to label radius} 30 | 31 | \item{label_position}{a character string indicating the position of labels, 32 | "right" (default) or "left" or any abbreviation of these} 33 | 34 | \item{...}{other text arguments passed on to \code{\link[ggplot2:layer]{ggplot2::layer()}}} 35 | } 36 | \value{ 37 | layer 38 | } 39 | \description{ 40 | legend of scatterpie 41 | } 42 | \author{ 43 | Guangchuang Yu 44 | } 45 | -------------------------------------------------------------------------------- /man/recenter.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/recenter.R 3 | \name{recenter} 4 | \alias{recenter} 5 | \title{recenter} 6 | \usage{ 7 | recenter(mapdata, center, longitude_column = "long") 8 | } 9 | \arguments{ 10 | \item{mapdata}{map data, shoud be a data.frame} 11 | 12 | \item{center}{center} 13 | 14 | \item{longitude_column}{longitude column} 15 | } 16 | \value{ 17 | updated map data 18 | } 19 | \description{ 20 | re-center map data 21 | } 22 | \author{ 23 | ygc 24 | } 25 | -------------------------------------------------------------------------------- /man/scatterpie-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scatterpie-package.R 3 | \docType{package} 4 | \name{scatterpie-package} 5 | \alias{scatterpie} 6 | \alias{scatterpie-package} 7 | \title{scatterpie: Scatter Pie Plot} 8 | \description{ 9 | Creates scatterpie plots, especially useful for plotting pies on a map. 10 | } 11 | \author{ 12 | \strong{Maintainer}: Guangchuang Yu \email{guangchuangyu@gmail.com} (\href{https://orcid.org/0000-0002-6485-8781}{ORCID}) 13 | 14 | Other contributors: 15 | \itemize{ 16 | \item Shuangbin Xu \email{xshuangbin@163.com} (\href{https://orcid.org/0000-0003-3513-5362}{ORCID}) [contributor] 17 | } 18 | 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /scatterpie.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | Encoding: UTF-8 9 | 10 | AutoAppendNewline: Yes 11 | StripTrailingWhitespace: Yes 12 | 13 | BuildType: Package 14 | PackageUseDevtools: Yes 15 | PackageInstallArgs: --no-multiarch --with-keep.source 16 | PackageRoxygenize: rd,collate,namespace 17 | -------------------------------------------------------------------------------- /vignettes/scatterpie.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "scatterpie: scatter pie plot" 3 | author: 4 | - name: Guangchuang Yu 5 | email: guangchuangyu@gmail.com 6 | affiliation: Department of Bioinformatics, School of Basic Medical Sciences, Southern Medical University 7 | date: "`r Sys.Date()`" 8 | output: 9 | prettydoc::html_pretty: 10 | theme: cayman 11 | highlight: github 12 | toc: true 13 | pdf_document: 14 | toc: true 15 | vignette: > 16 | %\VignetteIndexEntry{scatterpie introduction} 17 | %\VignetteEngine{knitr::rmarkdown} 18 | %\usepackage[utf8]{inputenc} 19 | --- 20 | 21 | ```{r style, echo=FALSE, results="asis", message=FALSE} 22 | knitr::opts_chunk$set(tidy = FALSE, 23 | message = FALSE) 24 | ``` 25 | 26 | 27 | ```{r echo=FALSE, results="hide", message=FALSE} 28 | library("scatterpie") 29 | theme_set(theme_minimal()) 30 | ``` 31 | 32 | # Scatter Pie plot 33 | 34 | ```{r} 35 | set.seed(123) 36 | long <- rnorm(50, sd=100) 37 | lat <- rnorm(50, sd=50) 38 | d <- data.frame(long=long, lat=lat) 39 | d <- with(d, d[abs(long) < 150 & abs(lat) < 70,]) 40 | n <- nrow(d) 41 | d$region <- factor(1:n) 42 | d$A <- abs(rnorm(n, sd=1)) 43 | d$B <- abs(rnorm(n, sd=2)) 44 | d$C <- abs(rnorm(n, sd=3)) 45 | d$D <- abs(rnorm(n, sd=4)) 46 | d[1, 4:7] <- d[1, 4:7] * 3 47 | head(d) 48 | ``` 49 | 50 | 51 | ```{r fig.width=10} 52 | ggplot() + geom_scatterpie(aes(x=long, y=lat, group=region), data=d, 53 | cols=LETTERS[1:4]) + coord_equal() 54 | ``` 55 | 56 | ```{r fig.width=10} 57 | d$radius <- 6 * abs(rnorm(n)) 58 | p <- ggplot() + geom_scatterpie(aes(x=long, y=lat, group=region, r=radius), data=d, 59 | cols=LETTERS[1:4], color=NA) + coord_equal() 60 | p + geom_scatterpie_legend(d$radius, x=-140, y=-70) 61 | ``` 62 | 63 | 64 | The `geom_scatterpie` is especially useful for visualizing data on a 65 | map. 66 | 67 | ```{r fig.width=10} 68 | world <- map_data('world') 69 | p <- ggplot(world, aes(long, lat)) + 70 | geom_map(map=world, aes(map_id=region), fill=NA, color="black") + 71 | coord_quickmap() 72 | p + geom_scatterpie(aes(x=long, y=lat, group=region, r=radius), 73 | data=d, cols=LETTERS[1:4], color=NA, alpha=.8) + 74 | geom_scatterpie_legend(d$radius, x=-160, y=-55) 75 | 76 | p + geom_scatterpie(aes(x=long, y=lat, group=region, r=radius), 77 | data=d, cols=LETTERS[1:4], color=NA, alpha=.8) + 78 | geom_scatterpie_legend(d$radius, x=-160, y=-55, n=3, labeller=function(x) 1000*x^2) 79 | ``` 80 | 81 | 82 | 83 | 84 | # Session info 85 | 86 | Here is the output of `sessionInfo()` on the system on which this document was compiled: 87 | ```{r echo=FALSE} 88 | sessionInfo() 89 | ``` 90 | 91 | --------------------------------------------------------------------------------