You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
122 lines
4.4 KiB
122 lines
4.4 KiB
#' Vertically dodge position
|
|
#' @rdname position-dodgev
|
|
#' @author @@ggstance authors
|
|
#' @note position-dodgev(): unmodified from lionel-/ggstance/R/position-dodgev.R 73f521384ae8ea277db5f7d5a2854004aa18f947
|
|
#' @export
|
|
position_dodgev <- function(height = NULL) {
|
|
ggplot2::ggproto(NULL, PositionDodgev, height = height)
|
|
}
|
|
|
|
#' @rdname position-dodgev
|
|
#' @author @@ggstance authors
|
|
#' @note PositionDodgev(): based on from lionel-/ggstance/R/position-dodgev.R 73f521384ae8ea277db5f7d5a2854004aa18f947
|
|
#' @format NULL
|
|
#' @usage NULL
|
|
#' @export
|
|
PositionDodgev <- ggplot2::ggproto("PositionDodgev", ggplot2::Position,
|
|
required_aes = "y",
|
|
height = NULL,
|
|
setup_params = function(self, data) {
|
|
if (is.null(data$ymin) && is.null(data$ymax) && is.null(self$height)) {
|
|
warning("Height not defined. Set with `position_dodgev(height = ?)`",
|
|
call. = FALSE)
|
|
}
|
|
list(height = self$height)
|
|
},
|
|
|
|
compute_panel = function(data, params, scales) {
|
|
collidev(data, params$height, "position_dodgev", pos_dodgev, check.height = FALSE)
|
|
}
|
|
)
|
|
|
|
#' @rdname position-dodgev
|
|
#' @author @@ggstance authors
|
|
#' @note pos_dodgev(): unmodified from lionel-/ggstance/R/position-dodgev.R 73f521384ae8ea277db5f7d5a2854004aa18f947
|
|
pos_dodgev <- function(df, height) {
|
|
n <- length(unique(df$group))
|
|
if (n == 1) return(df)
|
|
|
|
if (!all(c("ymin", "ymax") %in% names(df))) {
|
|
df$ymin <- df$y
|
|
df$ymax <- df$y
|
|
}
|
|
|
|
d_height <- max(df$ymax - df$ymin)
|
|
|
|
# df <- data.frame(n = c(2:5, 10, 26), div = c(4, 3, 2.666666, 2.5, 2.2, 2.1))
|
|
# ggplot(df, aes(n, div)) + geom_point()
|
|
|
|
# Have a new group index from 1 to number of groups.
|
|
# This might be needed if the group numbers in this set don't include all of 1:n
|
|
groupidx <- match(df$group, sort(unique(df$group)))
|
|
|
|
# Find the center for each group, then use that to calculate ymin and lmax
|
|
df$y <- df$y + height * ((groupidx - 0.5) / n - .5)
|
|
df$ymin <- df$y - d_height / n / 2
|
|
df$ymax <- df$y + d_height / n / 2
|
|
|
|
df
|
|
}
|
|
|
|
#' @rdname position-dodgev
|
|
#' @author @@ggstance authors
|
|
#' @note collidev(): based on lionel-/ggstance/R/position.R 73f521384ae8ea277db5f7d5a2854004aa18f947
|
|
collidev <- function(data, height = NULL, name, strategy, ..., check.height = TRUE, reverse = FALSE) {
|
|
# Determine height
|
|
if (!is.null(height)) {
|
|
# Width set manually
|
|
if (!(all(c("ymin", "ymax") %in% names(data)))) {
|
|
data$ymin <- data$y - height / 2
|
|
data$ymax <- data$y + height / 2
|
|
}
|
|
} else {
|
|
if (!(all(c("ymin", "ymax") %in% names(data)))) {
|
|
data$ymin <- data$y
|
|
data$ymax <- data$y
|
|
}
|
|
|
|
# Width determined from data, must be floating point constant
|
|
heights <- unique(data$ymax - data$ymin)
|
|
heights <- heights[!is.na(heights)]
|
|
|
|
# # Suppress warning message since it's not reliable
|
|
# if (!zero_range(range(heights))) {
|
|
# warning(name, " requires constant height: output may be incorrect",
|
|
# call. = FALSE)
|
|
# }
|
|
height <- heights[1]
|
|
}
|
|
|
|
# Reorder by x position, then on group. The default stacking order reverses
|
|
# the group in order to match the legend order.
|
|
if (reverse) {
|
|
data <- data[order(data$ymin, data$group), ]
|
|
} else {
|
|
data <- data[order(data$ymin, -data$group), ]
|
|
}
|
|
|
|
|
|
# Check for overlap
|
|
intervals <- as.numeric(t(unique(data[c("ymin", "ymax")])))
|
|
intervals <- intervals[!is.na(intervals)]
|
|
|
|
if (length(unique(intervals)) > 1 & any(diff(scale(intervals)) < -1e-6)) {
|
|
warning(name, " requires non-overlapping y intervals", call. = FALSE)
|
|
# This is where the algorithm from [L. Wilkinson. Dot plots.
|
|
# The American Statistician, 1999.] should be used
|
|
}
|
|
|
|
data$group <- seq_len(nrow(data)) ## reset grouping
|
|
|
|
if (!is.null(data$xmax)) {
|
|
plyr::ddply(data, "ymin", strategy, ..., height = height)
|
|
} else if (!is.null(data$x)) {
|
|
data$xmax <- data$x
|
|
data <- plyr::ddply(data, "ymin", strategy, ..., height = height)
|
|
data$x <- data$xmax
|
|
data$yend <- data$y ## ALLOW FOR A YEND COLUMN
|
|
data
|
|
} else {
|
|
stop("Neither x nor xmax defined")
|
|
}
|
|
}
|
|
|