Randomly cropping/tiling an image in R

Question

Is there anybody out there having a smart idea how to create n rectangular tiles from an image, each of different size with no overlapping. The solution given below is limited to n = 4.

randomTiles <- function(w, h, n){

  if(sample(c(TRUE, FALSE), 1)){
    tl <- c(0, sample(10:w-10, 1), 0, sample(round(h/10):h-round(h/10), 1))
    bl <- c(0, sample(tl[2]:w-round(w/10), 1), tl[4], h)
    tr <- c(tl[2], w, 0, tl[4])
    br <- c(bl[2], w, tl[4], h)
  }else{
    tl <- c(0, sample(10:w-10, 1), 0, sample(round(h/10):h-round(h/10), 1))
    tr <- c(tl[2], w, 0, sample(tl[4]:h-round(h/10), 1))
    bl <- c(0, tl[2], tl[4], h)
    br <- c(tl[2], w, tr[4], h)
  }
  tileFrame <- data.frame(xleft = c(tl[1], bl[1], tr[1], br[1]),
                          ybottom = c(tl[3], bl[3], tr[3], br[3]),
                          xright = c(tl[2], bl[2], tr[2], br[2]),
                          ytop = c(tl[4], bl[4], tr[4], br[4]),
                          col = rgb(runif(4), runif(4), runif(4)))
  return(tileFrame)

}

h <- 100
w <- 120
n <- 4

op <- par(mfrow = c(2,2))
for(i in 1:4){
  plot(h, xlim = c(0, w), ylim = c(h, 0), type = "n", xlab = "WIDTH", ylab = "HIGHT")
  tiles <- randomTiles(w = w, h = h, n = n)
  rect(tiles[,1], tiles[,2], tiles[,3], tiles[,4], col = tiles[,5])
}
par(op)

Thanks for any hint...

Answer 1

I was a little bored, so I gave it a go. Works pretty well, but I'm very much not an expert on random generators, so it is very possible that there are some hidden biases in the positions of the rectangles that this code generates.

UPDATE: This really grabbed my attention. I think the first version was in fact biased towards making smaller and smaller rectangles. I updated the code so that this doesn't happen anymore, I think.

library(data.tree)
library(tidyverse)

random_rects <- function (x, y, n) {
  rand_leaf <- function (nd) {
    while (data.tree::isNotLeaf(nd)) {
      nd <- if (runif(1) > .5) nd$r else nd$l
    }
    nd
  }
  split_node <- function (nd) {
    nd$div <- runif(1)
    nd$dir <- ifelse(runif(1) > .5, "h", "v")
    nd$AddChild("l")
    nd$AddChild("r")
  }
  set_dims <- function (nd) {
    p <- nd$parent
    nd$x0 = p$x0
    nd$x1 = p$x1
    nd$y0 = p$y0
    nd$y1 = p$y1
    if (p$dir == "h") {
      new_x <- p$x0 + (p$x1 - p$x0)*p$div
      if (nd$name == "l") {
        nd$x1 <- new_x
      } else {
        nd$x0 <- new_x
      }
    } else {
      new_y <- p$y0 + (p$y1 - p$y0)*p$div
      if (nd$name == "l") {
        nd$y1 <- new_y
      } else {
        nd$y0 <- new_y
      }
    }
  }
  get_dims <- function (nd) {
    tibble::tibble(x0 = nd$x0, x1 = nd$x1, y0 = nd$y0, y1 = nd$y1)
  }
  root <- data.tree::Node$new("home")
  for (i in seq_len(n - 1)) {
    nd <- rand_leaf(root)
    split_node(nd)
  }
  root$x0 <- 0
  root$x1 <- x
  root$y0 <- 0
  root$y1 <- y
  root$Do(set_dims, traversal = "pre-order", filterFun = data.tree::isNotRoot)
  dfs <- purrr::map(data.tree::Traverse(root, filterFun = data.tree::isLeaf), get_dims)
  list(tree = root, df = dplyr::bind_rows(dfs))
}

set.seed(1)

rect_list <- purrr::rerun(10, random_rects(40, 100, 20))

df <- dplyr::bind_rows(purrr::map(rect_list, ~ dplyr::mutate(.x$df, pos = factor(1:n()))), .id = "rep")

ggplot(df, aes(xmin = x0, xmax = x1, ymin = y0, ymax = y1, fill = pos)) +
  geom_rect(alpha = .7) +
  facet_wrap(~rep)

head(df)
#> # A tibble: 6 x 6
#>   rep      x0    x1    y0    y1 pos  
#>   <chr> <dbl> <dbl> <dbl> <dbl> <fct>
#> 1 1       0    15.3  0     3.56 1    
#> 2 1       0    15.3  3.56  5.21 2    
#> 3 1       0    15.3  5.21  5.47 3    
#> 4 1      15.3  40    0     2.70 4    
#> 5 1      15.3  25.3  2.70  5.47 5    
#> 6 1      25.3  40    2.70  5.47 6

^{Created on 2018-11-11 by the reprex package (v0.2.1)}