Work in progress

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: ggsankeyfier
 Type: Package
 Title: Create Sankey and Alluvial Diagrams Using 'ggplot2'
-Version: 0.1.8.0008
+Version: 0.1.8.0010
 Authors@R: c(person("Pepijn", "de Vries", role = c("aut", "cre", "dtc"),
     email = "pepijn.devries@outlook.com",
     comment = c(ORCID = "0000-0002-7961-6646")),
@@ -38,6 +38,7 @@ Imports:
     vwline
 Suggests:
     knitr,
+    ragg,
     rmarkdown,
     stringr,
     svglite,

NEWS.md

@@ -1,6 +1,7 @@
-ggsankeyfier v0.1.8.0008
+ggsankeyfier v0.1.8.0010
 -------------
 
+ * Added better stacking order features
  * Added check workflow
  * Added code coverage workflow and badge
  * Improved test coverage

R/draw_edges.r

@@ -4,7 +4,7 @@
   data <- data |>
     dplyr::mutate(
       res = {
-        resolution <- .data[["xend"]] - .data[["x"]]
+        resolution <- .data$xend - .data$x
         resolution[resolution < 0 & resolution > -1] <- -1
         resolution[is.na(resolution)] <- 0
         resolution[abs(resolution) < 0.25] <-
@@ -22,7 +22,7 @@
   # Note that edge_end_size is currently ignored.
   data$edge_size <-
     coord$transform(
-      dplyr::bind_cols(x = 0, y = data[["edge_size"]]), panel_params)[["y"]] -
+      dplyr::bind_cols(x = 0, y = data$edge_size), panel_params)[["y"]] -
     coord$transform(
       dplyr::bind_cols(x = 0, y = rep(0, nrow(data))), panel_params)[["y"]]
   # For very narrow edges take a small value, to avoid errors (it will not be visible to
@@ -98,14 +98,14 @@
               )
             }
           },
-          x = .data[["x"]], y = .data[["y"]], xend = .data[["xend"]],
-          yend = .data[["yend"]], y_size = .data[["edge_size"]], slope = .data[["slope"]],
-          ncp = .data[["ncp"]],
-          fill = .data[["fill"]], colour = .data[["colour"]], linetype = .data[["linetype"]],
-          linewidth = .data[["linewidth"]],
-          alpha = .data[["alpha"]], waist = .data[["waist"]], res = .data[["res"]],
-          connector = .data[["connector"]],
-          SIMPLIFY = F)
+          x = .data$x, y = .data$y, xend = .data$xend,
+          yend = .data$yend, y_size = .data$edge_size, slope = .data$slope,
+          ncp = .data$ncp,
+          fill = .data$fill, colour = .data$colour, linetype = .data$linetype,
+          linewidth = .data$linewidth,
+          alpha = .data$alpha, waist = .data$waist, res = .data$res,
+          connector = .data$connector,
+          SIMPLIFY = FALSE)
     ) |> dplyr::pull("bez")
 
   return(do.call(grid::gList, result))

R/ecosystem_services.r

@@ -2,7 +2,7 @@
 #'
 #' Data indicating a risk resulting from anthropological activities to the
 #' marine ecosystem and its capacity to supply services.
-#' This data set serves (aggregated from Piet _et al._ (submitted)) as an example
+#' This data set serves (aggregated from Piet _et al._ (2024)) as an example
 #' to illustrate the package's features.
 #' @format `ecosystem_services` is  a `data.frame` with
 #' `r nrow(ecosystem_services)` rows and `r ncol(ecosystem_services)` columns.
@@ -36,9 +36,10 @@
 #' for additional decoration of a Sankey diagram. It is therefore more detailed than
 #' the first alternative.
 #' @references
-#' Piet GJ, Bentley J, Jongbloed RH, Grundlehner A, Tamis JE, De Vries P
-#' (submitted) A Cumulative Impact Assessment on the North Sea Capacity to
-#' Supply Ecosystem Services. \doi{10.2139/ssrn.4450241}
+#' Piet GJ, Bentley JW, Jongbloed RH, Grundlehner A, Tamis JE, De Vries P (2024)
+#' A Cumulative Impact Assessment on the North Sea Capacity to Supply Ecosystem
+#' Services. Science of The Total Environment (498)
+#' [DOI:10.1016/j.scitotenv.2024.174149](https://doi.org/10.1016/j.scitotenv.2024.174149)
 #' @docType data
 #' @author Pepijn de Vries, Gerjan Piet, Jacob Bentley, Ruud Jongbloed, Anne Grundlehner, Jacqueline Tamis
 #' @examples

R/geom_edge.r

@@ -70,7 +70,7 @@ geom_sankeyedge <-
            position = "sankey", na.rm = FALSE, show.legend = NA,
            slope = 0.5, ncp = 100,
            width = "auto", align = c("bottom", "top", "center", "justify"),
-           order = c("ascending", "descending", "as_is"),
+           order = c("ascending", "descending", "ascending+", "descending+", "as_is"),
            h_space = "auto", v_space = 0,
            nudge_x = 0, nudge_y = 0,
            split_nodes = FALSE, split_tol = 1e-3,

R/geom_node.r

@@ -50,7 +50,7 @@ geom_sankeynode <-
            stat = "sankeynode",
            position = "sankey", na.rm = FALSE, show.legend = NA,
            width = "auto", align = c("bottom", "top", "center", "justify"),
-           order = c("ascending", "descending", "as_is"),
+           order = c("ascending", "descending", "ascending+", "descending+", "as_is"),
            h_space = "auto", v_space = 0,
            nudge_x = 0, nudge_y = 0,
            split_nodes = FALSE, split_tol = 1e-3,

R/geom_segment.r

@@ -19,7 +19,7 @@ GeomSankeysegment <-
 geom_sankeysegment <-
   function(mapping = NULL, data = NULL, stat = "sankeyedge",
            position    = "sankey", na.rm = FALSE, show.legend = NA,
-           order       = c("ascending", "descending", "as_is"),
+           order       = c("ascending", "descending", "ascending+", "descending+", "as_is"),
            width       = "auto", align = c("bottom", "top", "center", "justify"),
            h_space     = "auto", v_space = 0,
            nudge_x     = 0,      nudge_y = 0,

R/pivot_stages.r

@@ -65,7 +65,7 @@ pivot_stages_longer <-
     result <-
       data |>
       dplyr::ungroup() |>
-      dplyr::select(union(union(stages_from, values_from), additional_aes_from)) |>
+      dplyr::select(dplyr::any_of(union(union(stages_from, values_from), additional_aes_from))) |>
       dplyr::mutate(dplyr::across(dplyr::any_of(stages_from), ~ {
         if (is.factor(.)) . else {
           factor(., unique(.))
@@ -79,10 +79,10 @@ pivot_stages_longer <-
     result <-
       lapply(utils::head(seq_along(stages_from), -1), function(i) {
         result |>
-          dplyr::select(stages_from[i + (0:1)]) |>
+          dplyr::select(dplyr::any_of(stages_from[i + (0:1)])) |>
           dplyr::rename(node_from = stages_from[i], node_to = stages_from[i + 1]) |>
           dplyr::bind_cols(
-            result |> dplyr::select(union(values_from, additional_aes_from))
+            result |> dplyr::select(dplyr::any_of(union(values_from, additional_aes_from)))
           ) |>
           dplyr::group_by(dplyr::across(dplyr::any_of(c("node_from", "node_to", additional_aes_from)))) |>
           dplyr::summarise(
@@ -102,7 +102,7 @@ pivot_stages_longer <-
       tidyr::nest(to = c("node", "stage")) |>
       tidyr::pivot_longer(c("from", "to"), names_to = "connector") |>
       tidyr::unnest("value") |>
-      dplyr::mutate(node = factor(as.character(.data[["node"]]), lvls))
+      dplyr::mutate(node = factor(as.character(.data$node), lvls))
 
     return(result)
   }

R/position.r

@@ -17,7 +17,18 @@
 #' nodes and edges in a plot.
 #' Should be one of: `ascending` (default), sorts nodes and edges from large to small
 #' (largest on top); `descending` sorts nodes and edges from small to large (smallest
-#' on top); `as_is` will leave the order of nodes and edges as they are in `data`.
+#' on top); `ascending+` Same as `ascending` but it also arranges edges and nodes
+#' by its aesthetics; `descending+` Same as `descending` but it also
+#' arranges edges/nodes by its aesthetics;
+#' `as_is` will leave the order of nodes and edges as they are in `data`.
+#'
+#' You can also provide a custom function to control the stacking order of nodes and
+#' edges. The function needs to accept one argument (`data`) which can be either
+#' nodes or edges data. The function needs to add a column named `node_order` containing
+#' numbers by which the nodes need to be ordered. In case of edges you need to add
+#' two columns. One named `edge_order`, controlling the order of outgoing edges,
+#' and one named `edge_order_end` controlling the order of incoming edges.
+#' For more details see `vignette("stacking_order")`.
 #' @param h_space Horizontal space between split nodes (`numeric`). This argument is
 #' ignored when `split_nodes == FALSE`. Use `"auto"` to automatically position split nodes.
 #' @param v_space Vertical space between nodes (`numeric`). When set to zero (`0`),
@@ -88,12 +99,12 @@ PositionSankey <-
 #' @export
 position_sankey <-
   function(width = "auto", align = c("bottom", "top", "center", "justify"),
-           order = c("ascending", "descending", "as_is"),
+           order = c("ascending", "descending", "ascending+", "descending+", "as_is"),
            h_space = "auto", v_space = 0,
            nudge_x = 0, nudge_y = 0,
            split_nodes = FALSE, split_tol = 1e-3, direction = c("forward", "backward"), ...) {
+    if (is.character(order)) order <- rlang::arg_match(order)
     align     <- rlang::arg_match(align)
-    order     <- rlang::arg_match(order)
     direction <- rlang::arg_match(direction)
 
     ggplot2::ggproto(