Designing our bathroom with R

[This article was first published on That’s so Random, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

R has been an indispensable tool since I started working with it about five years ago. Of course in my day job as a data scientist I couldn’t live without it, but it also proved to be a great aid in private life. Recently we bought our first house and R came to the rescue several times in the process. We compared the impact of different mortgages on our finances in ten and twenty years time and I kept an eye on our spending through a Shiny app (I’ll admit the latter would have been less time consuming if I would have done it in Excel, like normal people).

I would never had expected that R would also be the go-to tool for decorating our bathrooms. When looking for inspiration online and in showrooms we came across many ugly and boring examples. Just when we were about to settle for a design like this Ugly bathroom

we came to the luminous idea to create a random pattern from a few colors we liked. It is very difficult for human beings to produce a random pattern, since we tend to avoid clutters of the same color. Of course R’s random number generator does not suffer from this. Turning the random pattern into a nice design is (of course!) done with geom_tile from ggplot2. It is funny how you keep underestimating randomness, even when you work with data daily. I was looking for a nicely scattered design of the four colors we selected, rather we got Tetris-on-steroids patterns like this True random

Nature needed to be a bit constrained in order to produce the design we were after. An adjustment was made to the function by adding a parameter for the maximum number of adjacent tiles of the same color. Allowing for two adjacent tiles of the same color gave us a very nice result. Bathroom

Here are the functions that were used, the first two are helpers for the main function. Go ahead and redecorate your own bathroom!

library(ggplot2)
library(dplyr)
library(data.table)
library(magrittr)

# helper function that checks for the next tile to be sampled if there
# are any colors that should be excluded because the max adjacent was
# reached either vertically or horizontally
check_colors <- function(plot_data,
                         cur_width,
                         cur_height,
                         m_a){
  if(cur_height > m_a){
    colors_height <-
      plot_data[Height %in% (cur_height-(m_a)):(cur_height-1) &
                  Width == cur_width, color] %>% unique
  } else {
    
    colors_height <- NULL
  }
  
  if(cur_width > m_a){
    colors_width <-
      plot_data[Width %in% (cur_width-(m_a)):(cur_width-1) &
                  Height == cur_height, color] %>% unique
  } else {
    colors_width <- NULL
  }
  
  if(length(colors_height) > 1) colors_height <- NULL
  if(length(colors_width) > 1) colors_width <- NULL
  exclude <- c(colors_height, colors_width)
  if(length(exclude) == 0) exclude <- 0
  
  return(exclude)
}

# helper function that samples a tile color from a vector with remaining tiles
# excluding a color if necesarry. Returns the sample color and the vector with
# remaining colors for the next iteration.
sample_color <- function(exclude = 0,
                         cts){
  if(cts %>% is_in(exclude) %>% all){
    stop('There is no valid solution due to adjacency constraint, please try again')
  }
  
  valid_color <- FALSE
  while(valid_color == FALSE){
    color <- sample(cts, 1)
    if(color %>% is_in(exclude) %>% not) {
      valid_color <- TRUE
      return_list <- list(color = color,
                          cts =
                            cts[-((cts == color) %>% which.max)])
    }
  }
  return(return_list)
}

# This function will generate a random pattern of tiles.
tiles_pattern <- function(
  colors         = c('darkblue', 'cyan3', 'lightblue1', 'white'),   # vector with the colors
  nr_of_each_col = rep(40, 4),     # prevalence of each color in colors vector
  nr_height      = 8, # nr of tiles in vertical direction
  nr_width       = 20, # nr of tiles in horizontal directions
  max_adjacent   = 2)  # maximimum nr of adjacent tiles of the same color
{
  
  if(length(colors) != length(nr_of_each_col)){
    stop('nr_of_each_col vector should be same length as the colors vector')
  }
  if(sum(nr_of_each_col) != nr_height * nr_width){
    stop('Sum nr_of_each_col should equal nr_height * nr_width')
  }
  
  plot_data <- expand.grid(1:nr_height, 1:nr_width) %>% as.data.table
  colnames(plot_data) <- c('Height', 'Width')
  plot_data$color <- integer(nrow(plot_data))
  
  colors_to_sample <- rep(1:length(colors), nr_of_each_col)
  
  for(i in 1:(nr_width)){
    for(j in 1:nr_height){
      exclude_iter     <- check_colors(plot_data, i, j, max_adjacent)
      color_iter       <- sample_color(exclude_iter, colors_to_sample)
      plot_data[Height == j & Width == i, color := color_iter$color]
      colors_to_sample <- color_iter$cts
    }
  }
  
  plot_data[ ,color := color %>% as.character]
  
  # build the plot
  ggplot(plot_data, aes(Width, Height)) +
    geom_tile(aes(fill = color), col = 'grey') +
    scale_fill_manual(values = c('1' = colors[1],
                                 '2' = colors[2],
                                 '3' = colors[3],
                                 '4' = colors[4])) +
    xlab('') +
    ylab('') +
    guides(fill = FALSE) +
    theme_bw() +
    theme(
      plot.background = element_blank()
      ,panel.grid.major = element_blank()
      ,panel.grid.minor = element_blank()
      ,panel.border = element_blank()
      ,axis.ticks.x = element_blank()
      ,axis.ticks.y = element_blank()
      ,axis.text.x = element_blank()
      ,axis.text.y = element_blank()
    ) +
    coord_fixed()
}

To leave a comment for the author, please follow the link and comment on their blog: That’s so Random.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)