Skip to content
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
47 changes: 43 additions & 4 deletions R/stat-contour.r
Original file line number Diff line number Diff line change
Expand Up @@ -106,7 +106,7 @@ StatContourFilled <- ggproto("StatContourFilled", Stat,

isobands <- xyz_to_isobands(data, breaks)
names(isobands) <- pretty_isoband_levels(names(isobands))
path_df <- iso_to_path(isobands, data$group[1])
path_df <- iso_to_polygon(isobands, data$group[1])

path_df$level <- factor(path_df$level, levels = names(isobands))

Expand Down Expand Up @@ -197,12 +197,12 @@ isoband_z_matrix <- function(data) {
raster
}

#' Convert the output of isoband functions
#' Convert the output of isolines functions
#'
#' @param iso the output of [isoband::isolines()] or [isoband::isobands()]
#' @param iso the output of [isoband::isolines()]
#' @param group the name of the group
#'
#' @return A data frame that can be passed to [geom_path()] or [geom_polygon()].
#' @return A data frame that can be passed to [geom_path()].
#' @noRd
#'
iso_to_path <- function(iso, group = 1) {
Expand Down Expand Up @@ -235,6 +235,45 @@ iso_to_path <- function(iso, group = 1) {
)
}

#' Convert the output of isoband functions
#'
#' @param iso the output of [isoband::isobands()]
#' @param group the name of the group
#'
#' @return A data frame that can be passed to [geom_polygon()].
#' @noRd
#'
iso_to_polygon <- function(iso, group = 1) {
lengths <- vapply(iso, function(x) length(x$x), integer(1))

if (all(lengths == 0)) {
warn("stat_contour(): Zero contours were generated")
return(new_data_frame())
}

levels <- names(iso)
xs <- unlist(lapply(iso, "[[", "x"), use.names = FALSE)
ys <- unlist(lapply(iso, "[[", "y"), use.names = FALSE)
ids <- unlist(lapply(iso, "[[", "id"), use.names = FALSE)
item_id <- rep(seq_along(iso), lengths)

# Add leading zeros so that groups can be properly sorted
groups <- paste(group, sprintf("%03d", item_id), sep = "-")
groups <- factor(groups)

new_data_frame(
list(
level = rep(levels, lengths),
x = xs,
y = ys,
piece = as.integer(groups),
group = groups,
subgroup = ids
),
n = length(xs)
)
}

#' Pretty isoband level names
#'
#' @param isoband_levels `names()` of an [isoband::isobands()] object.
Expand Down