これは、数時間を無駄にするのに良い挑戦だと思いました。概念実証機能は次のとおりです。
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
最初の引数としてラスター形式の背景を使用し、2番目の引数としてラスター形式の画像のリストを使用し、3番目の引数として解像度(numeric(2))を使用します。
コンピューターの写真で構成されたRロゴの例。グーグルの写真をいくつかダウンロードして、http: //sachaem47.fortyseven.versio.nl/files/pics/mosaic.zipにアップロードしました。これらをモザイクフォルダに抽出し、Rロゴ(http://cran.r-project.org/Rlogo.jpg)を作業ディレクトリにダウンロードすると、次のように「アーティモザイク」を作成できます。
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()

見事に見えますよね?ここでの主な欠点は、必要に応じて同じ画像を再利用することと、使用する画像が非常に少ないことです。これは変更できますが、はるかに多くの画像が必要になるため、関数の実行時間が大幅に長くなります。繰り返しますが、概念実証です。