Create facets based on missingness/desired aspect ratio

[rjake]

Create facets based on missingness/desired aspect ratio

[rjake]

Maybe:

n <- 123
​ideal_ratio <- 1.6

base_rows <- ceiling(sqrt(n / ​ideal_ratio))
base_cols <- ceiling(n / base_rows)
​
alt_cols <- base_cols - 1
alt_rows <- ceiling(n / alt_cols)
​
wider <- list(
  rows = base_rows,
  cols = base_cols,
  res = base_rows * base_cols,
  delta = abs(​ideal_ratio - (base_cols / base_rows))
)
​
thinner <- list(
  cols = alt_cols,
  rows = alt_rows,
  res = alt_rows * alt_cols,
  delta = abs(​ideal_ratio - (alt_cols / alt_rows))
)
​
if (wider$delta < thinner$delta) {
  c(x = wider$cols, y = wider$rows)
} else {
  c(x = thinner$cols, y = thinner$rows)
}

Also review this cheatsheet
https://raw.githubusercontent.com/rstudio/cheatsheets/main/how-big-is-your-graph.pdf

See scratchwork

library(tidyverse)
ideal_facets <- function(facets, group_size, max_rows = NULL, try_cols = NULL, ...) {
  # group_size <- 17; max_rows = 3
  # if (is.null(try_cols)) {
  #   col_opts <- (group_size - 1):2
  # } else {
  #   col_opts <- try_cols
  # }
  #
  # if (!is.null(max_rows)) {
  #   if (group_size / max(col_opts) > max_rows) {
  #     return(facet_wrap(facets, nrow = 3, ...))
  #   }
  # }

  # else

  # remainder <-
  #   magrittr::divide_by( # easier to read
  #     (group_size - 1) %% col_opts,
  #     col_opts - 1
  #   )
  # ideal_cols <- col_opts[which.max(1 - remainder)]

  # rows <- ceiling(group_size / col_opts)
  # cols <- ceiling(group_size / rows)
  # ideal_cols <- col_opts[which.min(group_size / (rows * cols))]

  #remainder <- col_opts - (group_size %% col_opts)
  #ideal_cols <- col_opts[which.min(remainder)]

  # rows <- ceiling(group_size / col_opts)
  # total_grid <- rows * col_opts

  tibble(
    group_size = 15,
    cols = (group_size - 1):2,
    rows = ceiling(group_size / cols),
    total_grid = rows * cols,
    ratio = cols / rows,
    n_missing = total_grid - group_size,
    delta = abs(ratio - ideal_ratio)
  ) |>
    arrange(n_missing, delta) |>
    .print()

  # want delta to be prioritized in n = 13
  # want n_missing to be prioritized in n = 17
  # could find nearest perfect solution if positive then one way if negative, the other
  # nearest solution to 13 is 15 (not 9, wrong ratio), negative
  # nearest solution to 17 is 15, positive would indicate the other

n <- 123

base_rows <- ceiling(sqrt(n / 1.6))
base_cols <- ceiling(n / base_rows)

alt_cols <- base_cols - 1
alt_rows <- ceiling(n / alt_cols)

wider <- list(
  rows = base_rows,
  cols = base_cols,
  res = base_rows * base_cols,
  delta = abs(1.6 - (base_cols / base_rows))
)

thinner <- list(
  cols = alt_cols,
  rows = alt_rows,
  res = alt_rows * alt_cols,
  delta = abs(1.6 - (alt_cols / alt_rows))
)

if (wider$delta < thinner$delta) {
  c(x = wider$cols, y = wider$rows)
} else {
  c(x = thinner$cols, y = thinner$rows)
}

  ceiling(n / ceiling(n_div))
  9   5   9*5 = 45
  x   3         27

  8/5
  5/3
  161/100

  floor(n / 1.6)
  5/3
  123*(5/3)

  multiplication_table <-
    tibble(
      y = 1:20,
      x = 1:20
    ) |>
    # Get all combination of x and y
    complete(x, y) |>
    # Get the product of all combinations
    mutate(product = x * y) |>
    arrange(x, y) |>
    mutate(
      #id = row_number()
    ) |>
    print()

  ggplot(multiplication_table, aes(x, y)) +
    geom_tile(color = "grey80", fill = "white") +
    geom_text(
      data = ~filter(.x, x == 1 | y == 1),
      aes(label = product),
      fontface = "bold"
    ) +
    geom_text(
      data = ~filter(.x, x > 1 | y > 1),
      aes(label = product),
      color = "grey30"
    ) +
    scale_color_manual(values = c("white", "black")) +
    # We want the table to start with 1 in the upper-left corner
    scale_y_continuous(trans = "reverse") +
    # We want to always display the tables as squares
    coord_fixed() +
    theme_void()



  floor(n_div)^2 * 1.6
  nearest_solution <- ncol * ()

  123/8.76

  123 5
  x   3




  # bridget----
  # find the nearest n that has the target ratio
  ceiling(sqrt(group_size))^2 - group_size
  # step up from there
  ideal_ratio <- 1.6
  # for each row, want 1.6 cols
  # in n of 15, want to prioritize 3 rows over 5 rows bc 5/3 is closest to 1.6 ratio


  # -----------







  empty_squares <- col_opts - (((group_size - 1) %% col_opts) + 1)
  empty_grid <- empty_squares / total_grid
  missingness <- empty_grid / rows
  tibble(col_opts, rows, total_grid, empty_squares, empty_grid, missingness) |> print(n = Inf)
  ideal_cols <- col_opts[which.min(missingness)]

  #ggplot(tibble(x = letters[1:group_size])) +
    facet_wrap(facets, ncol = ideal_cols, ...)

  # ggplot2:::scale_apply
}

ggplot(tibble(x = letters[1:15])) +
  facet_wrap(~x)
  facet_wrap(~x, nrow = 5)
  ideal_facets(~x, group_size = 23, max_rows = 3, try_cols = 4:6)

1 / 24 / 2
1 / 24 / 3

map2(
  8:3,
  13,
  ~ggplot(tibble(x = letters[1:.y])) +
    facet_wrap(~x, ncol = .x) +
    labs(title = paste(.y, "facets, ncol = ", .x))
) |>
  do.call(what = gridExtra::grid.arrange)




data_frame0(
  PANEL = factor(id, levels = seq_len(n)),
  ROW = if (params$as.table) {
    as.integer((id - 1L) %/% dims[2] + 1L)
  } else {
    as.integer(dims[1] - (id - 1L) %/% dims[2])
  },
  COL = as.integer((id - 1L) %% dims[2] + 1L),
  .size = length(id)
)


layout[c("ROW", "COL")] <- layout[c("COL", "ROW")]


wrap_dims <- function(n, nrow = NULL, ncol = NULL) {
  if (is.null(ncol) && is.null(nrow)) {
    rc <- grDevices::n2mfrow(n)
    nrow <- rc[2]
    ncol <- rc[1]
  } else if (is.null(ncol)) {
    ncol <- ceiling(n / nrow)
  } else if (is.null(nrow)) {
    nrow <- ceiling(n / ncol)
  }
  if (nrow * ncol < n) {
    cli::cli_abort(c(
      "Need {n} panels, but together {.arg nrow} and {.arg ncol} only provide {nrow * ncol}",
      i = "Please increase {.arg ncol} and/or {.arg nrow}"
    ))
  }

  c(nrow, ncol)
}


#grDevices::n2mfrow <- function (nr.plots, asp = 1)
{
  nr.plots <- as.integer(nr.plots)
  if (asp == 1 && nr.plots <= 12L) {
    if (nr.plots <= 3L) {
      c(nr.plots, 1L)
    } else if (nr.plots <= 6L) {
      c((nr.plots + 1L) %/% 2L, 2L)
    } else {
      c((nr.plots + 2L) %/% 3L, 3L)
    }
  } else {
    nrow <- ceiling(sqrt(nr.plots / asp))
    rc <- c(nrow, ceiling(nr.plots / nrow))
    do <- TRUE
    while (do && prod(rc) > nr.plots) {
      if (do <- prod(n <- rc - 0:1) >= nr.plots) {
        rc <- n
      } else if (do <- prod(n <- rc - 1:0) >= nr.plots) {
        rc <- n
      }
    }
    rc
  }
}