Случайное обрезание / мозаичное изображение в R

Question

Есть ли у кого-нибудь умная идея, как создать n прямоугольных плиток из изображения, каждый разного размера без наложения. Приведенное ниже решение ограничено 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)

Спасибо за любую подсказку ...

Answer 1

Мне было немного скучно, поэтому я попробовал. Работает довольно хорошо, но я не очень разбираюсь в генераторах случайных чисел, поэтому вполне возможно, что в позициях прямоугольников, которые генерирует этот код, есть некоторые скрытые смещения.

ОБНОВЛЕНИЕ: Это действительно привлекло мое внимание. Я думаю, что первая версия была на самом деле смещена в сторону создания меньших и меньших прямоугольников. Я обновил код так, чтобы этого больше не происходило, я думаю.

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

^{Создано в 2018-11-11 пакетом Представление (v0.2.1)}