circle_layout gains a new arugment direction to control the dicreti…

…on of plot adding

R/layout-chain-.R

@@ -521,12 +521,15 @@ chain_layout_add.circle_switch <- function(object, layout, object_name) {
             i = "Did you want to add a {.fn stack_switch}?"
         ))
     }
+    if (!is.waive(radial <- .subset2(object, "radial"))) {
+        layout@radial <- radial
+    }
+    if (!is.null(direction <- .subset2(object, "direction"))) {
+        layout@direction <- direction
+    }
     layout <- switch_chain_plot(
         layout, .subset2(object, "what"),
         quote(circle_switch())
     )
-    if (!is.waive(radial <- .subset2(object, "radial"))) {
-        layout@radial <- radial
-    }
     layout
 }

R/layout-circle-.R

@@ -13,6 +13,10 @@
 #' and applied uniformly to all plots within the layout. The parameters
 #' `theta` and `r.axis.inside` will always be ignored and will be set to
 #' `"x"` and `TRUE`, respectively, for all plots.
+#' @param direction A single string of `r oxford_or(c("inward", "outward"))`,
+#' indicating the direction in which the plot is added.
+#' - `outward`: The plot is added from the inner to the outer.
+#' - `inward`: The plot is added from the outer to the inner.
 #' @examples
 #' set.seed(123)
 #' small_mat <- matrix(rnorm(56), nrow = 7)
@@ -25,13 +29,14 @@
 #'     align_dendro(aes(color = branch), k = 3L) +
 #'     scale_color_brewer(palette = "Dark2")
 #' @export
-circle_discrete <- function(data = NULL, ..., radial = NULL, theme = NULL) {
+circle_discrete <- function(data = NULL, ..., radial = NULL,
+                            direction = "outward", theme = NULL) {
     UseMethod("circle_discrete", data)
 }
 
 #' @export
 circle_discrete.default <- function(data = NULL, ..., radial = NULL,
-                                    theme = NULL) {
+                                    direction = "outward", theme = NULL) {
     # the observations are rows, we use matrix to easily
     # reshape it into a long formated data frame for ggplot,
     # and we can easily determine the number of observations
@@ -48,7 +53,7 @@ circle_discrete.default <- function(data = NULL, ..., radial = NULL,
     new_circle_layout(
         data = data,
         design = discrete_design(nobs = nobs),
-        radial = radial,
+        radial = radial, direction = direction,
         schemes = schemes, theme = theme
     )
 }
@@ -85,19 +90,22 @@ circle_discrete.formula <- circle_discrete.function
 #'     theme_bw()
 #' @export
 circle_continuous <- function(data = NULL, ..., radial = NULL,
-                              limits = NULL, theme = NULL) {
+                              direction = "outward", limits = NULL,
+                              theme = NULL) {
     UseMethod("circle_continuous", data)
 }
 
 #' @export
 circle_continuous.default <- function(data = NULL, ..., radial = NULL,
-                                      limits = NULL, theme = NULL) {
+                                      direction = "outward", limits = NULL,
+                                      theme = NULL) {
     assert_limits(limits)
     data <- data %|w|% NULL
     data <- fortify_data_frame(data = data, ...)
     schemes <- default_schemes()
     new_circle_layout(
-        data = data, design = limits, radial = radial,
+        data = data, design = limits,
+        radial = radial, direction = direction,
         schemes = schemes, theme = theme
     )
 }
@@ -115,7 +123,7 @@ circle_continuous.function <- function(data = NULL, ...) {
 circle_continuous.formula <- circle_continuous.function
 
 #' @importFrom methods new
-new_circle_layout <- function(data, design, radial, schemes = NULL,
+new_circle_layout <- function(data, design, radial, direction, schemes = NULL,
                               theme = NULL, name = NULL, call = caller_call()) {
     if (!is.null(theme)) assert_s3_class(theme, "theme", call = call)
     assert_s3_class(radial, "CoordRadial", allow_null = TRUE)
@@ -125,6 +133,7 @@ new_circle_layout <- function(data, design, radial, schemes = NULL,
             call = call
         )
     }
+    direction <- arg_match0(direction, c("inward", "outward"))
     if (is.null(name)) {
         if (is_continuous_design(design)) {
             name <- "circle_continuous"
@@ -137,7 +146,7 @@ new_circle_layout <- function(data, design, radial, schemes = NULL,
         name = name, data = data,
         schemes = schemes, # used by the layout
         design = design, theme = theme,
-        radial = radial
+        radial = radial, direction = direction
     )
 }
 
@@ -192,5 +201,5 @@ circle_layout <- function(data = NULL, ..., limits = waiver()) {
 #' @include layout-chain-.R
 methods::setClass("CircleLayout",
     contains = "ChainLayout",
-    list(radial = "ANY")
+    list(radial = "ANY", direction = "character")
 )

R/layout-circle-build.R

@@ -43,21 +43,36 @@ circle_build <- function(circle, schemes = NULL, theme = NULL) {
         radial <- ggproto(NULL, input_radial, theta = "x", r_axis_inside = TRUE)
     }
 
-    # for every plot track, all relative to the total radius `1`
     sizes <- vapply(plot_list, function(plot) {
         # for circular layout, we only support relative size
         if (is.na(size <- as.numeric(plot@size))) {
             size <- 1
         }
         size
     }, numeric(1L), USE.NAMES = FALSE)
+
+    # For each plot track, relative to the total radius:
+    # `0.4` is coord_radial used for scale size, I don't know what it means
     plot_track <- sizes / sum(sizes) * (1 - radial$inner_radius[1L] / 0.4)
-    plot_sizes <- 1 - cumsum(c(0, plot_track[-length(plot_track)]))
+
+    # For each plot, the plot size is calculated by adding the space for the
+    # inner radius of each track.
+    index <- seq_along(plot_list)
+    if (identical(circle@direction, "outward")) {
+        plot_sizes <- radial$inner_radius[1L] / 0.4 + cumsum(plot_track)
+    } else {
+        plot_sizes <- 1 - cumsum(c(0, plot_track[-length(plot_track)]))
+        # The plots are always build inward, so the order is reversed.
+        index <- rev(index)
+    }
+
+    # For each plot, the inner radius is calculated as the difference between
+    # the plot size and its track size.
     plot_inner <- plot_sizes - plot_track
     guides <- vector("list", length(plot_list))
     plot_table <- origin <- NULL
     design <- setup_design(circle@design)
-    for (i in rev(seq_along(plot_list))) { # from inner-most to the out-most
+    for (i in index) {
         plot_size <- plot_sizes[[i]]
         plot <- .subset2(plot_list, i)
         align <- plot@align # `AlignProto` object
@@ -154,8 +169,7 @@ circle_build <- function(circle, schemes = NULL, theme = NULL) {
         if (length(default_position) == 2) {
             default_position <- "inside"
         }
-        if (default_position == "none") {
-        } else {
+        if (!identical(default_position, "none")) {
             plot_theme$legend.key.width <- calc_element(
                 "legend.key.width",
                 plot_theme

R/layout-circle-switch.R

@@ -21,7 +21,8 @@
 #'     align_dendro(aes(color = branch), k = 3L) +
 #'     scale_color_brewer(palette = "Dark2")
 #' @export
-circle_switch <- function(radial = waiver(), what = waiver(), ...) {
+circle_switch <- function(radial = waiver(), direction = NULL,
+                          what = waiver(), ...) {
     rlang::check_dots_empty()
     if (!is.waive(radial)) {
         assert_s3_class(radial, "CoordRadial", allow_null = TRUE)
@@ -31,6 +32,11 @@ circle_switch <- function(radial = waiver(), what = waiver(), ...) {
         abs(diff(radial$arc)) < pi / 2L) {
         cli_abort("Cannot use circle of acute angle < 90 in {.arg radial}")
     }
+    if (!is.null(direction)) {
+        direction <- arg_match0(direction, c("inward", "outward"))
+    }
     if (!is.waive(what)) what <- check_stack_context(what)
-    structure(list(what = what, radial = radial), class = "circle_switch")
+    structure(list(what = what, radial = radial, direction = direction),
+        class = "circle_switch"
+    )
 }