DEV update rounding

R/geom-brick.R

@@ -33,27 +33,34 @@ stat_brick <- function(mapping = NULL, data = NULL,
 StatBrick <- ggproto("StatBrick", Stat,
                      required_aes = c("x", "y"),
                      setup_params = function(data, params) {
+
+                       dat_1 <- data %>%
+                         group_by(x) %>%
+                         summarise(
+                           y = sum(y),
+                           .groups = "drop"
+                           )
+
+                       if(max(dat_1$y) > params$bricks_per_layer*params$brick_layers) {
+                         params$r <- (params$bricks_per_layer*params$brick_layers)/max(dat_1$y)
+                         message("Number of bricks has been scaled to a maximum of ",
+                                 params$bricks_per_layer*params$brick_layers,
+                                 " bricks. 1 brick equals ", round(1/params$r, 1),
+                                 " units.\nTo adjust, increase the number of 'brick_layers' and/or 'bricks_per_layer'")
+                       } else {
+                         params$r <- 1
+                       }
+
                        return(params)
                      },
                      compute_panel = function(data, scales, brick_layers = params$brick_layers,
                                               bricks_per_layer = params$bricks_per_layer,
-                                              type = params$type
+                                              type = params$type, r = params$r
                                               ) {
 
                        dat_1 <- data %>%
                          group_by(x, PANEL) %>%
-                         summarise(y = sum(y), .groups = "drop")
-
-                       if(max(dat_1$y) > bricks_per_layer*brick_layers) {
-                         r <- (bricks_per_layer*brick_layers)/max(dat_1$y)
-                         message("Number of bricks has been scaled to a maximum of ", bricks_per_layer*brick_layers,
-                                 " bricks. 1 brick equals ", round(1/r, 1),
-                                 " units.\nTo adjust, increase the number of 'brick_layers' and/or 'bricks_per_layer'")
-                       } else {
-                         r <- 1
-                       }
-
-                       dat_1 <- dat_1 %>%
+                         summarise(y = sum(y), .groups = "drop") %>%
                          mutate(y = round_preserve_sum(r*y))
 
                        do_fill <- "fill" %in% colnames(data)
@@ -72,9 +79,10 @@ StatBrick <- ggproto("StatBrick", Stat,
                          if(do_fill) {
                            ids <- which(data$x == dat_1$x[k])
                            fill_levels <- data$fill[ids]
-                           n_of_levels <- round_preserve_sum(data$y[ids]*r)
+                           n_of_levels <- robust_round(data$y[ids]*r, sum(x$brick_type))
 
                            x$fill <- make_new_fill(fill_levels, n_of_levels, x$brick_type)
+                           if(any(is.na(x$fill))) browser
                            x$fill <- switch(
                              type,
                              "ordered" = x$fill,

R/helpers.R

@@ -85,13 +85,27 @@ round_preserve_sum <- function(x, digits = 0) {
   y/up
 }
 
+#' Robust round
+#'
+#' @param x Vector of values
+#' @param N Value to preserve sum to
+robust_round <- function(x, N) {
+  n <- round(x)
+  add <- N-sum(n)
+  if(add > 0) {
+    id <- sort(x, index.return = TRUE, decreasing = TRUE)$ix[1:add]
+    n[id] <- n[id]+1
+  }
+  n
+}
+
 #' Fill
 #'
 #' Makes the vector for the fill aesthetic
 #'
 #' @param fill The fill vector
 #' @param n Vector representing the number of bricks for the fill level
-#' @param val Vector of length the same as fill of with 1 o 0.5 for whole or helf bricks
+#' @param val Vector of length the same as fill of with 1 o 0.5 for whole or half bricks
 make_new_fill <- function(fill, n, val) {
   val_cm <- c(0, cumsum(val))
   n_cm <- c(0, cumsum(n))

dev/dev.R

@@ -1,7 +1,7 @@
 mpg |>
   count(class, drv) |>
   ggplot() +
-  geom_brick(aes(class, n, fill = drv))
+  geom_brick(aes(class, n, fill = drv), bricks_per_layer = 3)
 
 mpg |>
   count(class, drv) |>
@@ -24,6 +24,7 @@ mpg |>
   mutate(n = 5*n) |>
   ggplot() +
   geom_brick(aes(class, n, fill = trans)) +
+  facet_wrap(~class) +
   scale_fill_manual(values = d10)
 
 ggsave("dev/images/pic1.png", height = 6, width = 8)
@@ -50,3 +51,33 @@ mpg |>
   scale_fill_manual(values = d10[c(1, 3, 5)])
 
 ggsave("dev/images/pic2.png", height = 3, width = 8)
+
+
+df <- expand_grid(
+  x = 1:6,
+  fill = letters[1:2],
+  facet = 1:3
+) |>
+  mutate(
+    n = rpois(n(), 50)*facet
+    )
+
+df |>
+  ggplot() +
+  geom_brick(aes(x, n, fill = fill)) +
+  facet_wrap(~facet, nrow = 3)
+
+
+
+x1 <- c(15.39359, 15.04373)
+N <- 31
+
+robust_round <- function(x, N) {
+  n <- round(x)
+  add <- N-sum(n)
+  id <- sort(x, index.return = TRUE, decreasing = TRUE)$ix[1:add]
+  n[id] <- n[id]+1
+  n
+}
+
+robust_round(x1, 31)