Create "arty" mosaic pictures with R (*not* statistical mosaic plots)

Question

I'd like to play around with images a bit and wondered if there are ways in R to produce mosaic pictures like these.

I guess for the background image one could use readJPEG (package jpeg) and rasterImage from package graphics.

But I'm lost with respect to how to compute and cluster color values etc. in order to arrange the foreground pictures.

EDIT

I found this post which goes "in the right direction". But I guess if you create a "true" mosaic where the actual picture is purely made up of small pictures (as opposed to having a combination of background and foreground pictures and finding the right amount of transparency as in this example), you have the problem that you'll need hundreds or possibly even thousands of pictures.

Answer 1

Thought this was a nice challenge to waste a few hours on. Here is a proof of concept function:

library(jpeg)
library(png)
library(plyr)

reduceCol <-  function(x,dim=c(1,1))
{
  arr <- array(dim=c(nrow(x),ncol(x),4))
  cols <- col2rgb(c(x),alpha=TRUE)
  arr[,,1] <- matrix(cols[1,],nrow(x),ncol(x),byrow=TRUE)
  arr[,,2] <- matrix(cols[2,],nrow(x),ncol(x),byrow=TRUE)
  arr[,,3] <- matrix(cols[3,],nrow(x),ncol(x),byrow=TRUE)
  arr[,,4] <- matrix(cols[4,],nrow(x),ncol(x),byrow=TRUE)



  Res <- array(dim=c(dim,4))
  if (dim[1]>1) seqRows <- as.numeric(cut(1:nrow(x),dim[1])) else seqRows <- rep(1,nrow(x))
  if (dim[2]>1) seqCols <- as.numeric(cut(1:ncol(x),dim[2])) else seqCols <- rep(1,ncol(x))


  for (i in 1:dim[1])
  {
    for (j in 1:dim[2])
    { 
      for (z in 1:4)
      {
        Res[i,j,z] <- mean(arr[seqRows==i,seqCols==j,z])
      }
    }
  }
  return(Res)
}

rgbarr2colmat <- function(mat) 
{
  Res <- array(dim=dim(mat)[1:2])
  for (i in 1:dim(mat)[1])
  {
    for (j in 1:dim(mat)[2])
    {
      Res[i,j] <- rgb(mat[i,j,1],mat[i,j,2],mat[i,j,3],mat[i,j,4],maxColorValue=255)
    }
  }
  return(Res)
}

artymosaic <- function(BG,pics,res=c(10,10))
{
  BGreduced <- reduceCol(BG,res)
  Picmeancol <- lapply(pics,reduceCol)

  blockPic <- array(dim=res)
  for (i in 1:res[1])
  {
    for (j in 1:res[2])
    {
      blockPic[i,j] <- which.min(sapply(Picmeancol,function(x)sum(abs(BGreduced[i,j,]-x))))
    }
  }
  blockPic <- t(blockPic)
  blockPic <- blockPic[,ncol(blockPic):1]

  # Open empty plot:
  par(mar=c(0,0,0,0))
  plot(1,xlim=c(0,1),ylim=c(0,1),type="n",bty="n",axes=FALSE)

  # plot moasics:
  seqRows <- seq(0,1,length=res[1]+1)
  seqCols <- seq(0,1,length=res[2]+1)
  for (i in 1:res[1])
  {
    for (j in 1:res[2])
    {
      rasterImage(pics[[blockPic[i,j]]],seqRows[i],seqCols[j],seqRows[i+1],seqCols[j+1],interpolate=FALSE)
    }
  }
}

artymosaic uses the background in raster format as first argument, a list of pictures in raster format as second and the resolution (numeric(2)) as third argument.

An example with the R logo made up of pictures of computers. I downloaded some pictures of google and uploaded them at http://sachaem47.fortyseven.versio.nl/files/pics/mosaic.zip. If these are extracted in a mosaic folder, and the R logo (http://cran.r-project.org/Rlogo.jpg) is downloaded in the working directory, we can make the "arty mosaic" as follows.

bg <- readJPEG("Rlogo.jpg")
BG <- as.raster(bg)

jpgs <- lapply(list.files("mosaic/",pattern="\\.jpg",full.names=TRUE),readJPEG)
pics <- lapply(jpgs,as.raster)

png("test.png")
artymosaic(BG,pics,c(50,50))
dev.off()

Looks spectacular right? The major drawback here is that I reuse the same image where appropriate and that I only used very few images. That could be changed but would require much much more images, which will cause the function to run much longer. Again, proof of concept.