Status Quo
library(ggplot2)
library(tidyverse)
ggplot(diamonds) +
aes(y = .5, fill = cut) +
geom_bar() +
coord_polar()
ggplot(diamonds) +
aes(y = .5, fill = cut) +
layer(geom = "bar", stat = "count", position = "stack") +
coord_polar()
names(ggplot2::StatCount)
## [1] "default_aes" "extra_params" "super" "compute_group"
## [5] "required_aes" "setup_params" "dropped_aes"
StatPie <- ggproto("StatPie", StatCount)
ggplot(diamonds) +
aes(y = .5, fill = cut) +
layer(geom = "bar", stat = "pie", position = "stack") +
coord_polar()
ggplot2::StatCount$default_aes
## Aesthetic mapping:
## * `x` -> `after_stat(count)`
## * `y` -> `after_stat(count)`
## * `weight` -> 1
StatPie$default_aes <- aes(x = after_stat(count), y = .5, weight = 1)
ggplot(diamonds) +
aes(y = .5, fill = cut) +
layer(geom = "bar", stat = "pie", position = "stack") +
coord_polar()
ggplot(diamonds) +
aes(fill = cut) +
layer(geom = "bar", stat = "pie", position = "stack") +
coord_polar()
## Error:
## ! Problem while computing stat.
## ℹ Error occurred in the 1st layer.
## Caused by error in `setup_params()`:
## ! `stat_pie()` requires an x or y aesthetic.
ggplot2::StatCount$setup_params
## <ggproto method>
## <Wrapper function>
## function (...)
## setup_params(..., self = self)
##
## <Inner function (f)>
## function (self, data, params)
## {
## params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE)
## has_x <- !(is.null(data$x) && is.null(params$x))
## has_y <- !(is.null(data$y) && is.null(params$y))
## if (!has_x && !has_y) {
## cli::cli_abort("{.fn {snake_class(self)}} requires an {.field x} or {.field y} aesthetic.")
## }
## if (has_x && has_y) {
## cli::cli_abort("{.fn {snake_class(self)}} must only have an {.field x} {.emph or} {.field y} aesthetic.")
## }
## if (is.null(params$width)) {
## x <- if (params$flipped_aes)
## "y"
## else "x"
## params$width <- resolution(data[[x]]) * 0.9
## }
## params
## }
StatPie$setup_params <- function (self, data, params)
{
params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE)
has_x <- !(is.null(data$x) && is.null(params$x))
has_y <- !(is.null(data$y) && is.null(params$y))
# if (!has_x && !has_y) {
# cli::cli_abort("{.fn {snake_class(self)}} requires an {.field x} or {.field y} aesthetic.")
# }
# if (has_x && has_y) {
# cli::cli_abort("{.fn {snake_class(self)}} must only have an {.field x} {.emph or} {.field y} aesthetic.")
# }
if (is.null(params$width)) {
x <- if (params$flipped_aes)
"y"
else "x"
params$width <- resolution(data[[x]]) * 0.9
}
params
}
ggplot(diamonds) +
aes(fill = cut) +
layer(geom = "bar", stat = "pie", position = "stack") +
coord_polar()
## Warning in min(x, na.rm = na.rm): no non-missing arguments to min; returning
## Inf
## Warning in max(x, na.rm = na.rm): no non-missing arguments to max; returning
## -Inf
## Warning in min(d[d > tolerance]): no non-missing arguments to min; returning
## Inf
## Error:
## ! Problem while computing stat.
## ℹ Error occurred in the 1st layer.
## Caused by error in `compute_layer()`:
## ! `stat_pie()` requires the following missing aesthetics: x or y.
ggplot2::StatCount$required_aes
## [1] "x|y"
StatPie$required_aes <- character
ggplot(diamonds) +
aes(fill = cut) +
layer(geom = "bar", stat = "pie", position = "stack") +
coord_polar()
## Error in strsplit(self$required_aes, "|", fixed = TRUE): non-character argument
ggplot2::StatCount$extra_params
## [1] "na.rm" "orientation"
ggplot2::StatCount$super
## <ggproto method>
## <Wrapper function>
## function (...)
## super(...)
##
## <Inner function (f)>
## function ()
## {
## eval(`_inherit`, env, NULL)
## }
ggplot2::StatCount$compute_group
## <ggproto method>
## <Wrapper function>
## function (...)
## compute_group(..., self = self)
##
## <Inner function (f)>
## function (self, data, scales, width = NULL, flipped_aes = FALSE)
## {
## data <- flip_data(data, flipped_aes)
## x <- data$x
## weight <- data$weight %||% rep(1, length(x))
## count <- as.numeric(tapply(weight, x, sum, na.rm = TRUE))
## count[is.na(count)] <- 0
## bars <- data_frame0(count = count, prop = count/sum(abs(count)),
## x = sort(unique0(x)), width = width, flipped_aes = flipped_aes,
## .size = length(count))
## flip_data(bars, flipped_aes)
## }
ggplot2::StatCount$required_aes
## [1] "x|y"
ggplot2::StatCount$dropped_aes
## [1] "weight"
names(ggplot2::GeomBar)
## [1] "setup_data" "rename_size" "non_missing_aes" "extra_params"
## [5] "super" "required_aes" "draw_panel" "setup_params"
ggplot2::GeomBar$setup_data
## <ggproto method>
## <Wrapper function>
## function (...)
## setup_data(...)
##
## <Inner function (f)>
## function (data, params)
## {
## data$flipped_aes <- params$flipped_aes
## data <- flip_data(data, params$flipped_aes)
## data$width <- data$width %||% params$width %||% (min(vapply(split(data$x,
## data$PANEL), resolution, numeric(1), zero = FALSE)) *
## 0.9)
## data$just <- params$just %||% 0.5
## data <- transform(data, ymin = pmin(y, 0), ymax = pmax(y,
## 0), xmin = x - width * just, xmax = x + width * (1 -
## just), width = NULL, just = NULL)
## flip_data(data, params$flipped_aes)
## }
ggplot2::GeomBar$rename_size
## [1] TRUE
ggplot2::GeomBar$non_missing_aes
## [1] "xmin" "xmax" "ymin" "ymax"
ggplot2::GeomBar$extra_params
## [1] "just" "na.rm" "orientation"
ggplot2::GeomBar$super
## <ggproto method>
## <Wrapper function>
## function (...)
## super(...)
##
## <Inner function (f)>
## function ()
## {
## eval(`_inherit`, env, NULL)
## }
ggplot2::GeomBar$required_aes
## [1] "x" "y"
ggplot2::GeomBar$draw_panel
## <ggproto method>
## <Wrapper function>
## function (...)
## draw_panel(..., self = self)
##
## <Inner function (f)>
## function (self, data, panel_params, coord, lineend = "butt",
## linejoin = "mitre", width = NULL, flipped_aes = FALSE)
## {
## ggproto_parent(GeomRect, self)$draw_panel(data, panel_params,
## coord, lineend = lineend, linejoin = linejoin)
## }
ggplot2::GeomBar$setup_params
## <ggproto method>
## <Wrapper function>
## function (...)
## setup_params(...)
##
## <Inner function (f)>
## function (data, params)
## {
## params$flipped_aes <- has_flipped_aes(data, params)
## params
## }
ggplot2::geom_point
ggplot2::geom_point
## 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 = GeomPoint,
## position = position, show.legend = show.legend, inherit.aes = inherit.aes,
## params = list2(na.rm = na.rm, ...))
## }
## <bytecode: 0x7fd0051268e8>
## <environment: namespace:ggplot2>
look at StatIdentity
names(ggplot2::StatIdentity)
## [1] "compute_layer" "super"
ggplot2::StatIdentity$compute_layer
## <ggproto method>
## <Wrapper function>
## function (...)
## compute_layer(..., self = self)
##
## <Inner function (f)>
## function (self, data, params, layout)
## {
## data
## }
ggplot2::StatIdentity$super
## <ggproto method>
## <Wrapper function>
## function (...)
## super(...)
##
## <Inner function (f)>
## function ()
## {
## eval(`_inherit`, env, NULL)
## }
look at GeomPoint
names(ggplot2::GeomPoint)
## [1] "non_missing_aes" "draw_key" "default_aes" "super"
## [5] "required_aes" "draw_panel"
ggplot2::GeomPoint$non_missing_aes
## [1] "size" "shape" "colour"
ggplot2::GeomPoint$draw_key
## <ggproto method>
## <Wrapper function>
## function (...)
## draw_key(...)
##
## <Inner function (f)>
## function (data, params, size)
## {
## if (is.null(data$shape)) {
## data$shape <- 19
## }
## else if (is.character(data$shape)) {
## data$shape <- translate_shape_string(data$shape)
## }
## stroke_size <- data$stroke %||% 0.5
## stroke_size[is.na(stroke_size)] <- 0
## pointsGrob(0.5, 0.5, pch = data$shape, gp = gpar(col = alpha(data$colour %||%
## "black", data$alpha), fill = fill_alpha(data$fill %||%
## "black", data$alpha), fontsize = (data$size %||% 1.5) *
## .pt + stroke_size * .stroke/2, lwd = stroke_size * .stroke/2))
## }
ggplot2::GeomPoint$default_aes
## Aesthetic mapping:
## * `shape` -> 19
## * `colour` -> "black"
## * `size` -> 1.5
## * `fill` -> NA
## * `alpha` -> NA
## * `stroke` -> 0.5
ggplot2::GeomPoint$super
## <ggproto method>
## <Wrapper function>
## function (...)
## super(...)
##
## <Inner function (f)>
## function ()
## {
## eval(`_inherit`, env, NULL)
## }
ggplot2::GeomPoint$required_aes
## [1] "x" "y"
ggplot2::GeomPoint$draw_panel
## <ggproto method>
## <Wrapper function>
## function (...)
## draw_panel(..., self = self)
##
## <Inner function (f)>
## function (self, data, panel_params, coord, na.rm = FALSE)
## {
## if (is.character(data$shape)) {
## data$shape <- translate_shape_string(data$shape)
## }
## coords <- coord$transform(data, panel_params)
## stroke_size <- coords$stroke
## stroke_size[is.na(stroke_size)] <- 0
## ggname("geom_point", pointsGrob(coords$x, coords$y, pch = coords$shape,
## gp = gpar(col = alpha(coords$colour, coords$alpha), fill = fill_alpha(coords$fill,
## coords$alpha), fontsize = coords$size * .pt + stroke_size *
## .stroke/2, lwd = coords$stroke * .stroke/2)))
## }