使用 R 创建“艺术”马赛克图片（*不是*统计马赛克图）

Posted 2023-02-16

【中文标题】使用 R 创建“艺术”马赛克图片（*不是*统计马赛克图）

【英文标题】：Create "arty" mosaic pictures with R (*not* statistical mosaic plots)

【发布时间】：2012-08-28 11:21:02

【问题描述】：

我想玩弄一下图片，想知道 R 中是否有办法生成 马赛克图片，例如 these。

我猜背景图片可以使用readJPEG（包jpeg）和rasterImage 来自包graphics。

但我不知道如何计算和聚类颜色值等以安排前景图片。

编辑

我发现这个post“朝着正确的方向发展”。但我想如果你创建一个“真正的”马赛克，其中实际图片完全由小图片组成（而不是像this example那样将背景和前景图片组合起来并找到合适的透明度），你有您需要数百甚至可能数千张图片的问题。

【参考方案1】：

认为这是一个很好的挑战，可以浪费几个小时。这是一个概念验证功能：

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 使用光栅格式的背景作为第一个参数，光栅格式的图片列表作为第二个参数，分辨率 (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()

看起来很壮观吧？这里的主要缺点是我在适当的地方重复使用相同的图像并且我只使用了很少的图像。这可以改变，但需要更多的图像，这将导致函数运行时间更长。再次，概念证明。

【讨论】：

我很想知道你会怎么做。也许你可以在完成后将它发布到 R-bloggers 上？